diff options
Diffstat (limited to 'gmi.pl')
| -rwxr-xr-x | gmi.pl | 165 |
1 files changed, 99 insertions, 66 deletions
@@ -7,7 +7,7 @@ use warnings; use 5.010; #use diagnostics; -our $VERSION = 'v0.0.11'; +our $VERSION = 'v0.0.12'; # Modules use IO::Socket::SSL; # CPAN @@ -68,6 +68,7 @@ if ($err) { ### $config my %ssl_config = ssl_config($config); +my %inet_config = inet_config($config); my $working_dir = working_dir($config); my $cert_key_dir = cert_key_dir($config); my $out = logging($config); @@ -87,8 +88,11 @@ my $ft = File::Type->new(); my $log; -my $srv = IO::Socket::SSL->new(%ssl_config) - or die "error=$ERRNO, ssl_error=$SSL_ERROR"; +#my $srv = IO::Socket::SSL->new(%ssl_config) +# or die "error=$ERRNO, ssl_error=$SSL_ERROR"; +my $srv = IO::Socket::INET->new(%inet_config) + or die "error=$ERRNO"; + say "$PROGRAM_NAME ($VERSION) started on ". localtime; if (! $fork_toggled) { say 'forking disabled.'; @@ -96,11 +100,20 @@ if (! $fork_toggled) { # Main server loop while () { - my $cl = $srv->accept() or next; - - maybe_fork(\$cl) and next; + my $cl = $srv->accept or next; + maybe_fork() and next; my $clhost = $cl->peerhost(); + + IO::Socket::SSL->start_SSL($cl, %ssl_config) + or do { + # TODO: user log format + say "$clhost - $SSL_ERROR [". localtime. ']'; + $cl->shutdown('SHUT_RDWR'); + exit if ($fork_toggled); + next; + }; + my $clport = $cl->peerport(); my $cl_sni = $cl->get_servername(); @@ -108,19 +121,31 @@ while () { my $path; my $data; + my $timedout = 0; # We do this because 'naughty' people/bots can clog up the ports doing nothing. - local $SIG{ALRM} = sub { timeout($cl, $clhost, $cl_sni) }; + local $SIG{ALRM} = sub { $timedout = 1 }; - alarm $timeout; # TODO make magic number not magic. - if (! sysread $cl, $data, $KBYTE) { + alarm $timeout; + + # ALRM interrupts this + sysread $cl, $data, $KBYTE + or $data = ''; + + alarm 0; + + if ($timedout) { $log = "$clhost - ($cl_sni) sysread failed"; - alarm 0; goto CLOSE; } - alarm 0; - - # removing \r\n - substr $data, -2, 2, ''; + if ($data) { + # removing \r\n + substr $data, -2, 2, ''; + } + else { + # TODO: user log format + $log = "$clhost - ($cl_sni) no read"; + goto CLOSE; + } # TODO: user log format $log = "$clhost - ($cl_sni) $data"; @@ -146,6 +171,22 @@ while () { goto CLOSE; } + respond_to_client($cl, $vhost, $doc_loc, $path); + CLOSE: + $cl->stop_SSL or warn "error: $ERRNO, ssl_error: $SSL_ERROR"; + $cl->shutdown('SHUT_RDWR'); + ### $cl + + say "$log [". localtime(). ']'; + + exit if ($fork_toggled); +} + +$srv->close(); + +sub respond_to_client { + my ($cl, $vhost, $doc_loc, $path) = @_; + if (not $doc_loc = get_request_in_vhost_root($vhost, $path)) { goto FAILURE; } @@ -184,25 +225,17 @@ while () { #my $meta = $ft->checktype_contents($doc); my $meta = detect_mime($doc_loc, $vhost); speak($cl, 'success', $meta, $doc_loc); - goto CLOSE; + return; DIR_LISTING: speak($cl, 'success', 'text/gemini', $doc_loc, $path); - goto CLOSE; + return; FAILURE: speak($cl, 'failure'); - goto CLOSE; - - CLOSE: - $cl->close('SHUT_WR'); - say "$log [". localtime(). ']'; - - exit if ($fork_toggled); + return; } -$srv->close(); - sub _slurp { my $filename = shift; open my $in, '<', $filename @@ -503,32 +536,17 @@ sub working_dir { sub ssl_config { my ($conf_ref) = @_; my %ssl = ( - LocalAddr => '0.0.0.0', - LocalPort => $DEFAULT_GEMINI_PORT, - Listen => 10, - SSL_version => '!SSLv2:!SSLv3:!TLSv1:!TLSv1_1', + Listen => 5, SSL_fast_shutdown => 1, - Timeout => 2, # !! Nothing to do with the config option !! - # used if /no/ SSL connection was established + Timeout => 5, # !! Nothing to do with the config option !! + # used if /no/ SSL was established SSL_error_trap => 1, #SSL_server => 1, ); - - for my $item (keys %{ $conf_ref->{default} }) { - if ($item eq 'bind') { - $ssl{LocalAddr} = $conf_ref->{default}{bind}; - #say $conf_ref->{default}{bind}; - } - elsif ($item eq 'ports') { - for my $port ( @{ $conf_ref->{default}{ports} } ) { - # TODO; enable more than one port. - $ssl{LocalPort} = $conf_ref->{default}{ports}[0]; - #say $conf_ref->{default}{ports}[0]; - } - } - elsif ($item eq 'tls') { + for my $item (keys %{ $conf_ref->{default} } ) { + if ($item eq 'tls') { # don't allow any on the assuption the config has specified which to allow # (only 1.2 and 1.3 per the Gemini Spec) $ssl{SSL_version} = '!SSLv2:!SSLv3:!TLSv1:!TLSv1_1:!TLSv1_2:!TLSv1_3'; @@ -549,6 +567,29 @@ sub ssl_config { return %ssl; } +sub inet_config { + my ($conf_ref) = @_; + my %inet = ( + LocalAddr => '0.0.0.0', + LocalPort => $DEFAULT_GEMINI_PORT, + Listen => 10, + Timeout => 5, # !! Nothing to do with config option !! + # used when a connection to the socket doesnt do anything + ); + for my $item (keys %{ $conf_ref->{default} }) { + if ($item eq 'bind') { + $inet{LocalAddr} = $conf_ref->{default}{bind}; + } + elsif ($item eq 'ports') { + for my $port ( @{ $conf_ref->{default}{ports} } ) { + # TODO; enable more than one port. + $inet{LocalPort} = $conf_ref->{default}{ports}[0]; + } + } + } + return %inet; +} + sub logging { my ($conf_ref) = @_; if (exists $conf_ref->{default}{log_to_stdout} and $conf_ref->{default}{log_to_stdout} eq 'true') { @@ -732,28 +773,20 @@ sub webm_type { } } -sub timeout { - my ($cl, $clhost, $cl_sni) = @_; - # TODO: user log format - say "$clhost - ($cl_sni) timed-out [". localtime() . ']'; - $cl->close('SHUT_WR'); - exit if ($fork_toggled); - return; -} - sub maybe_fork { - my ($cl_ref) = @_; - my $pid = fork; - if (not defined $pid) { - warn "Cannot make a child: $ERRNO"; - } - if ($pid) { - undef $cl_ref; - return 1; - } - else { - local $PROGRAM_NAME = "chld: $PROGRAM_NAME"; - return 0; + if ($fork_toggled) { + my $pid = fork; + if (not defined $pid) { + warn "Cannot make a child: $ERRNO"; + return; + } + if ($pid) { + return 1; + } + else { + local $PROGRAM_NAME = "chld: $PROGRAM_NAME"; + return; + } } } |