From e5fefd1500041620517b19f5c0493059f64a842b Mon Sep 17 00:00:00 2001 From: jake Date: Mon, 22 Aug 2022 11:25:20 -0400 Subject: Add UNIX sockets Comment out Smart::Comments --- gmi.pl | 205 +++++++++++++++++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 161 insertions(+), 44 deletions(-) (limited to 'gmi.pl') diff --git a/gmi.pl b/gmi.pl index 94c391e..971bc63 100755 --- a/gmi.pl +++ b/gmi.pl @@ -7,12 +7,13 @@ use warnings; use 5.010; #use diagnostics; -our $VERSION = 'v0.14.0'; +our $VERSION = 'v0.15.1'; # Modules use IO::Socket::SSL; # CPAN use IO::Socket::SSL::Utils; # CPAN use IO::Socket::IP -register; +use IO::Socket::UNIX; use IO::Select; use URL::XS qw(parse_url split_url_path parse_url_query); # CPAN use Path::Naive qw(normalize_path); # CPAN @@ -27,7 +28,7 @@ use English qw( -no_match_vars ); use Const::Fast; use Carp; -# $IO::Socket::SSL::DEBUG = 15; +#$IO::Socket::SSL::DEBUG = 15; local $PROGRAM_NAME = 'jakes-gemini-server'; # Not worried about fork()-ed children @@ -61,9 +62,11 @@ const our %GEM_RES_CODES => ( const 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 fork timeout/; + log_file log_to_stdout default_mime cert_key_dir_write_warning fork timeout + unix/; const our @VALID_VHOST_SETTINGS => - qw/auto_cert assume_index dir_listing root cert key default_mime bind ports/; + qw/auto_cert assume_index dir_listing root cert key default_mime bind ports + unix/; my ($config, $err) = from_toml(_slurp('./config.toml')); if ($err) { @@ -82,7 +85,9 @@ my $timeout = timeout_secs($config); my $listen_config = listen_config($config); #, %ssl_config, %ip_config); ### $listen_config + my @srv = ip_config($listen_config); +### @srv my %ssl_config = ssl_config($config); ssl_vhost_cert_key(\%ssl_config); @@ -92,18 +97,14 @@ my $fork_toggled = fork_toggle($config); # let the user know if an invalid option was used check_config_keys($config); -### %ssl_config +# ## %ssl_config my $ft = File::Type->new(); my $log; my $sel = IO::Select->new(); -for my $lsn (@srv) { - ## no critic (DoubleSigil) - $sel->add(IO::Socket::IP->new(%$lsn)) - or die "$ERRNO"; -} +select_add_listen($sel, @srv); say "$PROGRAM_NAME ($VERSION) started on ". localtime; if (! $fork_toggled) { @@ -115,13 +116,15 @@ while (my @ready = $sel->can_read) { my $cl; my $fh = shift @ready; - my $fh_sockhost = $fh->sockhost; - my $fh_port = $fh->sockport; $cl = $fh->accept; + my ($fh_sockhost, $fh_port, $clhost, $clport) = get_fh_data($fh, $cl); - maybe_fork() and next; + ### $fh_sockhost + ### $fh_port + ### $clhost + ### $clport - my $clhost = $cl->peerhost(); + maybe_fork() and next; ### before start_SSL IO::Socket::SSL->start_SSL($cl, %ssl_config) @@ -134,7 +137,6 @@ while (my @ready = $sel->can_read) { }; ### nice, start_SSL worked - my $clport = $cl->peerport(); my $cl_sni = $cl->get_servername(); if (! check_fh_port_with_host_listen_port($cl_sni, $fh_sockhost, $fh_port)) { @@ -157,7 +159,6 @@ while (my @ready = $sel->can_read) { # ALRM interrupts this sysread $cl, $data, $KBYTE or $data = ''; - alarm 0; if ($timedout) { @@ -200,8 +201,16 @@ while (my @ready = $sel->can_read) { respond_to_client($cl, $vhost, $doc_loc, $path); CLOSE: - $cl->stop_SSL or warn "error: $ERRNO, ssl_error: $SSL_ERROR"; - $cl->shutdown('SHUT_RDWR'); + if (ref $fh ne 'IO::Socket::UNIX') { + # stop_SSL doesnt work with IO::Socket::UNIX for some reason, + # but shutdown does. stop_SSL is supposed to return $cl to + # it's original class (ie IO::Socket::UNIX or IO::Socket::IP) + $cl->stop_SSL or warn "error: $ERRNO, ssl_error: $SSL_ERROR"; + $cl->shutdown('SHUT_RDWR'); + } + else { + $cl->close( (SSL_fast_shutdown=>0) ); + } ### $cl say "$log [". localtime(). ']'; @@ -597,19 +606,42 @@ sub ssl_config { sub ip_config { my ($listening_ref) = @_; my @a; - for my $ip (keys %{ $listening_ref }) { - for my $port (keys %{ $listening_ref->{$ip} }) { - my %listener = ( - LocalAddr => $ip, - LocalPort => $port, - Listen => 10, - Timeout => 5, # !! Nothing to do with config option !! - # used when a connection to the socket doesnt do anything - ); - push @a, \%listener; - } - } - ### @srv + my %paths; + for my $socket (keys %{ $listening_ref }) { + # if IP socket + if ($socket ne 'unix') { + for my $port (keys %{ $listening_ref->{$socket} }) { + my %listener = ( + LocalAddr => $socket, + LocalPort => $port + 0, # coax into number + Listen => 10, + Timeout => 5, # !! Nothing to do with config option !! + # used when a connection to the socket doesnt do anything + ); + push @a, \%listener; + } + } + # else an UNIX socket + else { + for my $unix (keys %{ $listening_ref->{unix}{path} }) { + if (exists $paths{ $listening_ref->{unix}{path}{$unix} }) { + next; + } + else { + $paths{ $listening_ref->{unix}{path}{$unix} } = 1; + ## no critic (RequireCheckedSyscalls) # doesn't matter if success or not + unlink $listening_ref->{unix}{path}{$unix}; + my %listener = ( + Type => SOCK_STREAM(), + Local => $listening_ref->{unix}{path}{$unix}, + Listen => 1, + ); + push @a, \%listener + } + } + ### %paths + } + } return @a; } @@ -829,14 +861,18 @@ sub timeout_secs { } } +## no critic (Complex, DeepNest) sub listen_config { my ($conf_ref, $ssl_ref, $ip_ref) = @_; my %listen; my @default_bind; my @default_ports; - if (exists $conf_ref->{default}{bind}) { - #@default_bind = give_array($conf_ref->{default}{bind}); - push @default_bind, give_array($conf_ref->{default}{bind}); + if (exists $conf_ref->{default}{bind} and $conf_ref->{default}{bind} ne 'no') { + #@default_bind = give_array($conf_ref->{default}{bind}); + push @default_bind, give_array($conf_ref->{default}{bind}); + } + elsif (exists $conf_ref->{default}{bind} and $conf_ref->{default}{bind} eq 'no') { + ; } else { # Listen to all @@ -849,6 +885,11 @@ sub listen_config { push @default_ports, $DEFAULT_GEMINI_PORT; } + if (exists $conf_ref->{default}{unix} and $conf_ref->{default}{unix} ne 'no') { + #$listen{unix}{default}{path} = $conf_ref->{default}{unix}; + $listen{unix}{path}{default} = $conf_ref->{default}{unix}; + } + for my $vhost (keys %{ $conf_ref }) { next if ($vhost eq 'default'); @@ -856,26 +897,36 @@ sub listen_config { if (exists $conf_ref->{$vhost}{ports}) { for my $port (give_array($conf_ref->{$vhost}{ports})) { # Vhost has bind - if (exists $conf_ref->{$vhost}{bind}) { + if (exists $conf_ref->{$vhost}{bind} and $conf_ref->{$vhost}{bind} ne 'no') { for my $bind (give_array($conf_ref->{$vhost}{bind})) { push @{ $listen{$bind}{$port} }, $vhost; } } + elsif (exists $conf_ref->{$vhost}{bind} and $conf_ref->{$vhost}{bind} eq 'no') { + ; + } # vhost does not have bind - use default else { - for my $bind (@default_bind) { - push @{ $listen{$bind}{$port} }, $vhost; + if (@default_bind) { + for my $bind (@default_bind) { + push @{ $listen{$bind}{$port} }, $vhost; + } } } } } # vhost's bind and default ports elsif (exists $conf_ref->{$vhost}{bind}) { - for my $bind (give_array($conf_ref->{$vhost}{bind})) { - for my $port (@default_ports) { - push @{ $listen{$bind}{$port} }, $vhost; + if ($conf_ref->{$vhost}{bind} ne 'no') { + for my $bind (give_array($conf_ref->{$vhost}{bind})) { + for my $port (@default_ports) { + push @{ $listen{$bind}{$port} }, $vhost; + } } } + elsif ($conf_ref->{$vhost}{bind} eq 'no') { + ; + } } # vhost uses default everything else { @@ -885,10 +936,24 @@ sub listen_config { } } } + + # check vhost unix socket otherwise check for default unix socket + if (exists $conf_ref->{$vhost}{unix}) { + for my $unix_sock_path (give_array($conf_ref->{$vhost}{unix})) { + if ($unix_sock_path ne 'no') { + $listen{unix}{path}{$vhost} = $unix_sock_path; + push @{ $listen{unix}{listen} }, $vhost; + } + } + } + elsif (exists $listen{unix}{path}{default} and $listen{unix}{path}{default} ne 'no') { + push @{ $listen{unix}{listen} }, $vhost; + } } # ## %listen return \%listen; } +## use critic sub give_array { my ($ref) = @_; @@ -913,11 +978,63 @@ sub give_array { sub check_fh_port_with_host_listen_port { my ($sni, $fh_sockhost, $fh_port) = @_; - - for my $dns_host (@{ $listen_config->{$fh_sockhost}{$fh_port} }) { - if ($dns_host eq $sni) { - return 1; + if ($fh_sockhost ne 'UNIX') { + for my $dns_host (@{ $listen_config->{$fh_sockhost}{$fh_port} }) { + if ($dns_host eq $sni) { + return 1; + } + } + } + else { + for my $dns_host (@{ $listen_config->{unix}{listen} }) { + ### $dns_host + ### $sni + # explictly given a unix path + if (($dns_host eq $sni) and exists $listen_config->{unix}{path}{$sni}) { + return 1; + } + # default's unix path + elsif (($dns_host eq $sni) and exists $listen_config->{unix}{path}{default}) { + return 1; + } } } return 0; } + +sub get_fh_data { + my ($fh, $cl) = @_; + my $fh_sockhost; + my $fh_port; + my $clhost; + my $clport; + if (ref $fh eq 'IO::Socket::IP') { + $fh_sockhost = $fh->sockhost; + $fh_port = $fh->sockport; + $clhost = $cl->peerhost(); + $clport = $cl->peerport(); + } elsif (ref $fh eq 'IO::Socket::UNIX') { + $fh_sockhost = 'UNIX'; + $fh_port = 'UNIX'; + $clhost = $cl->hostpath(); + $clport = 'UNIX'; + } + return $fh_sockhost, $fh_port, $clhost, $clport; +} + +sub select_add_listen { + my ($sell, @srvv) = @_; + for my $lsn (@srvv) { + ### $lsn + ## no critic (DoubleSigil) + if (exists $lsn->{LocalAddr}) { + $sell->add(IO::Socket::IP->new(%$lsn)) + or die "$ERRNO"; + } + elsif (exists $lsn->{Local}) { + $sell->add(IO::Socket::UNIX->new(%$lsn)) + or die "$ERRNO"; + } + } + return; +} -- cgit v1.2.3