From e2a4adfe9349562b447cd2640e797317ff7f9d8e Mon Sep 17 00:00:00 2001 From: jake Date: Fri, 19 Aug 2022 20:05:36 -0400 Subject: Able to listen to more than one ip address, port. VHost adjustable --- gmi.pl | 177 +++++++++++++++++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 146 insertions(+), 31 deletions(-) (limited to 'gmi.pl') diff --git a/gmi.pl b/gmi.pl index 6d50ce7..4136b52 100755 --- a/gmi.pl +++ b/gmi.pl @@ -7,12 +7,13 @@ use warnings; use 5.010; #use diagnostics; -our $VERSION = 'v0.0.13'; +our $VERSION = 'v0.0.14'; # Modules use IO::Socket::SSL; # CPAN use IO::Socket::SSL::Utils; # CPAN use IO::Socket::IP -register; +use IO::Select; use URL::XS qw(parse_url split_url_path parse_url_query); # CPAN use Path::Naive qw(normalize_path); # CPAN #use Smart::Comments; # CPAN @@ -26,6 +27,8 @@ use English qw( -no_match_vars ); use Const::Fast; use Carp; +# $IO::Socket::SSL::DEBUG = 15; + local $PROGRAM_NAME = 'jakes-gemini-server'; # Not worried about fork()-ed children local $SIG{CHLD} = 'IGNORE'; @@ -60,7 +63,7 @@ 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/; const our @VALID_VHOST_SETTINGS => - qw/auto_cert assume_index dir_listing root cert key default_mime/; + qw/auto_cert assume_index dir_listing root cert key default_mime bind ports/; my ($config, $err) = from_toml(_slurp('./config.toml')); if ($err) { @@ -68,14 +71,20 @@ if ($err) { } ### $config -my %ssl_config = ssl_config($config); -my %ip_config = ip_config($config); + my $working_dir = working_dir($config); my $cert_key_dir = cert_key_dir($config); my $out = logging($config); -my $timeout = timeout_secs($config); select $out; ## no critic (InputOutput::ProhibitOneArgSelect) local $OUTPUT_AUTOFLUSH = 1; + +my $timeout = timeout_secs($config); + +my $listen_config = listen_config($config); #, %ssl_config, %ip_config); +### $listen_config +my @srv = ip_config($listen_config); + +my %ssl_config = ssl_config($config); ssl_vhost_cert_key(\%ssl_config); my $fork_toggled = fork_toggle($config); @@ -89,8 +98,12 @@ my $ft = File::Type->new(); my $log; -my $srv = IO::Socket::IP->new(%ip_config) - or die "error=$ERRNO"; +my $sel = IO::Select->new(); +for my $lsn (@srv) { + ## no critic (DoubleSigil) + $sel->add(IO::Socket::IP->new(%$lsn)) + or die "$ERRNO"; +} say "$PROGRAM_NAME ($VERSION) started on ". localtime; if (! $fork_toggled) { @@ -98,12 +111,19 @@ if (! $fork_toggled) { } # Main server loop -while () { - my $cl = $srv->accept or next; +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; + maybe_fork() and next; my $clhost = $cl->peerhost(); + ### before start_SSL IO::Socket::SSL->start_SSL($cl, %ssl_config) or do { # TODO: user log format @@ -112,10 +132,18 @@ while () { exit if ($fork_toggled); next; }; + ### 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)) { + # TODO: user log format + $log = "$clhost - ($cl_sni) client request on wrong port"; + speak($cl, 'proxy_req_refused'); + goto CLOSE; + } + my $url; my $path; my $data; @@ -181,7 +209,7 @@ while () { exit if ($fork_toggled); } -$srv->close(); +#$srv->close(); sub respond_to_client { my ($cl, $vhost, $doc_loc, $path) = @_; @@ -567,26 +595,22 @@ sub ssl_config { } sub ip_config { - my ($conf_ref) = @_; - my %ip = ( - 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') { - $ip{LocalAddr} = $conf_ref->{default}{bind}; - } - elsif ($item eq 'ports') { - for my $port ( @{ $conf_ref->{default}{ports} } ) { - # TODO; enable more than one port. - $ip{LocalPort} = $conf_ref->{default}{ports}[0]; - } - } - } - return %ip; + 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 + return @a; } sub logging { @@ -805,4 +829,95 @@ sub timeout_secs { } } -1; +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}); + } + else { + # Listen to all + push @default_bind, '::'; + } + if (exists $conf_ref->{default}{ports}) { + push @default_ports, give_array($conf_ref->{default}{ports}); + } + else { + push @default_ports, $DEFAULT_GEMINI_PORT; + } + + for my $vhost (keys %{ $conf_ref }) { + next if ($vhost eq 'default'); + + # Vhost's port and vhost's bind or default's bind + if (exists $conf_ref->{$vhost}{ports}) { + for my $port (give_array($conf_ref->{$vhost}{ports})) { + # Vhost has bind + if (exists $conf_ref->{$vhost}{bind}) { + for my $bind (give_array($conf_ref->{$vhost}{bind})) { + push @{ $listen{$bind}{$port} }, $vhost; + } + } + # vhost does not have bind - use default + else { + 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; + } + } + } + # vhost uses default everything + else { + for my $port (@default_ports) { + for my $bind (@default_bind) { + push @{ $listen{$bind}{$port} }, $vhost; + } + } + } + } + # ## %listen + return \%listen; +} + +sub give_array { + my ($ref) = @_; + + ## no critic (Cascading, DoubleSigil) + if (ref $ref eq 'ARRAY') { + return @$ref; + } + elsif (ref $ref eq 'SCALAR') { + return ( $ref ); + } + elsif (ref \$ref eq 'ARRAY') { + return @$ref; + } + elsif (ref \$ref eq 'SCALAR') { + return ( $ref ); + } + else { + confess 'not array or scalar nor a reference to such.'; + } +} + +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; + } + } + return 0; +} -- cgit v1.2.3