summaryrefslogtreecommitdiff
path: root/gmi.pl
diff options
context:
space:
mode:
Diffstat (limited to 'gmi.pl')
-rwxr-xr-xgmi.pl67
1 files changed, 46 insertions, 21 deletions
diff --git a/gmi.pl b/gmi.pl
index 69a87e9..d950d50 100755
--- a/gmi.pl
+++ b/gmi.pl
@@ -7,7 +7,7 @@ use warnings;
use 5.010;
#use diagnostics;
-our $VERSION = 'v0.0.6';
+our $VERSION = 'v0.0.7';
# Modules
use IO::Socket::SSL; # CPAN
@@ -15,7 +15,7 @@ use IO::Socket::SSL::Utils; # CPAN
use URL::XS qw(parse_url split_url_path parse_url_query); # CPAN
#use Term::ANSIColor; # Core
use Path::Naive qw(normalize_path); # CPAN
-use Smart::Comments; # CPAN
+#use Smart::Comments; # CPAN
use URI::Encode qw(uri_encode); # CPAN
use IO::Select;
use TOML qw(from_toml);
@@ -50,7 +50,7 @@ our %GEM_RES_CODES = (
our @VALID_DEFAULT_SETTINGS =
qw/bind ports tls assume_index dir_listing root working_dir cert_key_dir
- log_file log_to_stdout default_mime cert_key_dir_write_warning/;
+ log_file log_to_stdout default_mime cert_key_dir_write_warning fork/;
our @VALID_VHOST_SETTINGS =
qw/auto_cert assume_index dir_listing root cert key default_mime/;
@@ -275,6 +275,20 @@ for my $vhost (keys %{ $config }) {
}
}
+# fork() toggle
+my $fork_toggled = 1;
+if (exists $config->{default}{fork}) {
+ if ($config->{default}{fork} eq 'true') {
+ $fork_toggled = 1;
+ }
+ elsif ($config->{default}{fork} eq 'false') {
+ $fork_toggled = 0;
+ }
+ else {
+ say STDERR "default: fork value ($config->{default}{fork}) is not true/false. Will assume true.";
+ }
+}
+
# let the user know if an invalid option was used
for my $option (keys %{ $config->{default} }) {
my $valid = 0;
@@ -312,14 +326,17 @@ say $out "Server Started on ". localtime();
# Main server loop
while () {
my $cl = $srv->accept() or next;
- my $pid = fork();
- if (not defined $pid) {
- warn "Cannot make a child: $!";
- next;
- }
- if ($pid) {
- undef $cl;
- next;
+
+ if ($fork_toggled) {
+ my $pid = fork();
+ if (not defined $pid) {
+ warn "Cannot make a child: $!";
+ next;
+ }
+ if ($pid) {
+ undef $cl;
+ next;
+ }
}
#close STDIN;
@@ -334,14 +351,14 @@ while () {
} elsif ($opened == -1) {
print $out "IO::Handle opened but the SSL handshake failed.\n";
$cl->close('SHUT_WR');
- exit;
+ exit if ($fork_toggled);
} elsif (! $opened) {
print $out "Socket could not be opened.\n";
- exit;
+ exit if ($fork_toggled);
}
else {
print $out "Something is very wrong.\n";
- exit;
+ exit if ($fork_toggled);
}
my $data;
@@ -351,17 +368,18 @@ while () {
eval {
# We do this because 'naughty' people/bots can clog up the ports doing nothing.
- local $SIG{ALRM} = sub {
+ local $SIG{ALRM} = sub {
+ # cannot goto, we are in a subroutine that gets called when ALRM is triggered.
say $out "$clhost - ($cl_sni) timed-out [". localtime(). ']';
$cl->close('SHUT_WR');
- exit;
+ exit if ($fork_toggled);
};
alarm 5; # TODO make magic number not magic.
if ( ! sysread($cl, $data, 1024) ) {
- $log = "$clhost - ($cl_sni) sysread failed ... Invalid certificate/key?";
+ $log = "$clhost - ($cl_sni) sysread failed";
+ alarm 0;
goto CLOSE;
- exit;
}
alarm 0;
@@ -373,13 +391,19 @@ while () {
eval {
$url = parse_url($data);
};
+
+ # TODO: make user adjustable
+ $log = "$clhost - ($cl_sni) $data";
+
+ if (! $url) {
+ speak($cl, 'bad_request');
+ goto CLOSE;
+ }
$path = $url->{path};
### $data
### $url
# ## $path
- # TODO: make user adjustable
- $log = "$clhost - ($cl_sni) $data";
my $vhost = $url->{host};
my $doc;
@@ -471,7 +495,8 @@ while () {
CLOSE:
$cl->close('SHUT_WR');
print $out "$log [". localtime(). "]\n";
- exit;
+
+ exit if ($fork_toggled);
}
$srv->close();