From 60f0f0d97f58f62b842caf6397a757d2b59237a1 Mon Sep 17 00:00:00 2001 From: jake Date: Sun, 4 Sep 2022 18:15:37 -0400 Subject: add server/client data to global hash for easy assess --- gmi.pl | 140 +++++++++++++++++++++++++++++++++++++++-------------------------- 1 file changed, 85 insertions(+), 55 deletions(-) (limited to 'gmi.pl') diff --git a/gmi.pl b/gmi.pl index ab0b0e4..d8e88a9 100755 --- a/gmi.pl +++ b/gmi.pl @@ -7,7 +7,7 @@ use warnings; use 5.010; #use diagnostics; -our $VERSION = 'v0.18.1'; +our $VERSION = 'v0.18.2'; # Modules use IO::Socket::SSL; # CPAN @@ -70,13 +70,13 @@ const our @VALID_VHOST_SETTINGS => qw/auto_cert assume_index dir_listing root cert key default_mime bind ports unix redirection redirect cert_req gone/; + my ($config, $err) = from_toml(_slurp('./config.toml')); if ($err) { die "TOML config error: $err."; } ### $config - my $working_dir = working_dir($config); my $cert_key_dir = cert_key_dir($config); my $out = logging($config); @@ -104,11 +104,29 @@ check_config_keys($config); my $ft = File::Type->new(); my $log; -my $cl_cert; my $sel = IO::Select->new(); select_add_listen($sel, @srv); +my %data = ( + srv_sockhost => undef, + srv_port => undef, + srv_sni => undef, + srv_server_protocol => 'gemini', + srv_software => "$PROGRAM_NAME ($VERSION)", + + cl_host => undef, + cl_port => undef, + + cl_base_class => undef, # IO::Socket::IP or IO::Socket::UNIX + cl_data => undef, + cl_cert => undef, + cl_path => undef, + cl_path_translated => undef, + cl_query_string => undef, + cl_vhost => undef, +); + say "$PROGRAM_NAME ($VERSION) started on ". localtime; if (! $fork_toggled) { say 'forking disabled.'; @@ -120,7 +138,8 @@ while (my @ready = $sel->can_read) { my $fh = shift @ready; $cl = $fh->accept; - my ($fh_sockhost, $fh_port, $clhost, $clport) = get_fh_data($fh, $cl); + #my ($fh_sockhost, $fh_port, $clhost, $clport) = get_fh_data($fh, $cl); + get_fh_data($fh, $cl, \%data); ### $fh_sockhost ### $fh_port @@ -133,25 +152,25 @@ while (my @ready = $sel->can_read) { IO::Socket::SSL->start_SSL($cl, %ssl_config) or do { # TODO: user log format - say "$clhost - $SSL_ERROR [". localtime. ']'; + say "$data{cl_host} - $SSL_ERROR [". localtime. ']'; $cl->shutdown('SHUT_RDWR'); exit if ($fork_toggled); next; }; ### nice, start_SSL worked - my $cl_sni = $cl->get_servername(); + #my $cl_sni = $cl->get_servername(); + $data{srv_sni} = $cl->get_servername(); - if (! check_fh_port_with_host_listen_port($cl_sni, $fh_sockhost, $fh_port)) { + if (! check_fh_port_with_host_listen_port($data{srv_sni}, $data{srv_sockhost}, $data{srv_port})) { # TODO: user log format - $log = "$clhost - ($cl_sni) client request on wrong port"; + $log = "$data{cl_host} - ($data{srv_sni}) client request on wrong port"; speak($cl, 'proxy_req_refused'); goto CLOSE; } my $url; my $path; - my $data; my $timedout = 0; # We do this because 'naughty' people/bots can clog up the ports doing nothing. @@ -160,49 +179,48 @@ while (my @ready = $sel->can_read) { alarm $timeout; # ALRM interrupts this - sysread $cl, $data, $KBYTE - or $data = ''; + sysread $cl, $data{cl_data}, $KBYTE + or $data{cl_data} = ''; alarm 0; if ($timedout) { - $log = "$clhost - ($cl_sni) sysread failed"; + $log = "$data{cl_host} - ($data{srv_sni}) sysread failed"; goto CLOSE; } - if ($data) { + if ($data{cl_data}) { # removing \r\n - substr $data, -2, 2, ''; + substr $data{cl_data}, -2, 2, ''; } else { # TODO: user log format - $log = "$clhost - ($cl_sni) no read"; + $log = "$data{cl_host} - ($data{srv_sni}) no read"; goto CLOSE; } # TODO: user log format - $log = "$clhost - ($cl_sni) $data"; + $log = "$data{cl_host} - ($data{srv_sni}) $data{cl_data}"; eval { - $url = parse_url($data); # if parse_url() fails, it makes the program die. + $url = parse_url($data{cl_data}); # if parse_url() fails, it makes the program die. } or do { ### parse_url failed speak($cl, 'bad_request'); goto CLOSE; }; - $path = $url->{path}; + $data{cl_path} = $url->{path}; ### $data ### $url # ## $path - my $vhost = $url->{host}; - my $doc_loc; + $data{cl_vhost} = $url->{host}; # only happens if someone is hacking/cracking - if ($vhost ne $cl_sni) { + if ($data{cl_vhost} ne $data{srv_sni}) { speak($cl, 'bad_request'); goto CLOSE; } - respond_to_client($cl, $vhost, $doc_loc, $path); + respond_to_client($cl, $data{cl_vhost}, $data{cl_path}); CLOSE: if (ref $fh ne 'IO::Socket::UNIX') { # stop_SSL doesnt work with IO::Socket::UNIX for some reason, @@ -219,13 +237,13 @@ while (my @ready = $sel->can_read) { say "$log [". localtime(). ']'; exit if ($fork_toggled); - undef $cl_cert; + undef_data(\%data); } #$srv->close(); sub respond_to_client { - my ($cl, $vhost, $doc_loc, $path) = @_; + my ($cl, $vhost, $path) = @_; my ($cert_req, $cert_meta, $check_path) = cert_req($vhost, $path); if ($cert_req) { @@ -251,23 +269,23 @@ sub respond_to_client { goto DOC_GONE; } - if (not $doc_loc = get_request_in_vhost_root($vhost, $path)) { + if (not $data{cl_path_translated} = get_request_in_vhost_root($vhost, $path)) { goto FAILURE; } ### $doc_loc # checking if the path already has .gone for 'some reason' - if (substr($doc_loc, -5, 5) eq '.gone') { ## no critic (MagicNumbers) + if (substr($data{cl_path_translated}, -5, 5) eq '.gone') { ## no critic (MagicNumbers) goto DOC_GONE; } # not a directory - if (! -d $doc_loc) { + if (! -d $data{cl_path_translated}) { goto DOC_ASSIGNED; } # make sure 'dir' is 'dir/' - if (substr($doc_loc,-1,1) ne '/') { + if (substr($data{cl_path_translated},-1,1) ne '/') { ## no critic (ValuesAndExpressions::ProhibitMagicNumbers) # if the '256' (maximum array return size) is not there, the program dies. speak($cl, 'redirect', @{ split_url_path($path, 256) }[-1]. '/'); @@ -277,8 +295,8 @@ sub respond_to_client { my $cv = check_vhost_settings($vhost); # if assume_index - if (($cv == 1 or $cv == 3) and file_exists_and_readable($doc_loc. '/index.gmi')) { - $doc_loc .= '/index.gmi'; + if (($cv == 1 or $cv == 3) and file_exists_and_readable($data{cl_path_translated}. '/index.gmi')) { + $data{cl_path_translated} .= '/index.gmi'; #$doc = _slurp($doc_loc); goto DOC_ASSIGNED; } @@ -292,12 +310,12 @@ sub respond_to_client { DOC_ASSIGNED: #my $meta = $ft->checktype_contents($doc); - my $meta = detect_mime($doc_loc, $vhost); - speak($cl, 'success', $meta, $doc_loc); + my $meta = detect_mime($data{cl_path_translated}, $vhost); + speak($cl, 'success', $meta, $data{cl_path_translated}); return; DIR_LISTING: - speak($cl, 'success', 'text/gemini', $doc_loc, $path); + speak($cl, 'success', 'text/gemini', $data{cl_path_translated}, $path); return; DOC_GONE: @@ -668,6 +686,7 @@ sub ip_config { return @a; } +# this sets the logging location, stdout or some file, not the log output itself sub logging { my ($conf_ref) = @_; if (exists $conf_ref->{default}{log_to_stdout} and $conf_ref->{default}{log_to_stdout} eq 'true') { @@ -1001,23 +1020,19 @@ sub check_fh_port_with_host_listen_port { } sub get_fh_data { - my ($fh, $cl) = @_; - my $fh_sockhost; - my $fh_port; - my $clhost; - my $clport; + my ($fh, $cl, $data_ref) = @_; if (ref $fh eq 'IO::Socket::IP') { - $fh_sockhost = $fh->sockhost; - $fh_port = $fh->sockport; - $clhost = $cl->peerhost(); - $clport = $cl->peerport(); + $data_ref->{srv_sockhost} = $fh->sockhost; + $data_ref->{srv_port} = $fh->sockport; + $data_ref->{cl_host} = $cl->peerhost(); + $data_ref->{cl_port} = $cl->peerport(); } elsif (ref $fh eq 'IO::Socket::UNIX') { - $fh_sockhost = 'UNIX'; - $fh_port = 'UNIX'; - $clhost = $cl->hostpath(); - $clport = 'UNIX'; + $data_ref->{srv_sockhost} = 'UNIX'; + $data_ref->{srv_port} = 'UNIX'; + $data_ref->{cl_host} = $cl->hostpath(); + $data_ref->{cl_port} = 'UNIX'; } - return $fh_sockhost, $fh_port, $clhost, $clport; + return; } sub select_add_listen { @@ -1116,7 +1131,7 @@ sub verify_cert_callback { #5. a C-style memory address of the peer's own certificate (convertible to PEM form with Net::SSLeay::PEM_get_string_X509()). #6. The depth of the certificate in the chain. Depth 0 is the leaf certificate. ## $pem - $cl_cert = CERT_asHash(PEM_string2cert(Net::SSLeay::PEM_get_string_X509($_[4]))); + $data{cl_cert} = CERT_asHash(PEM_string2cert(Net::SSLeay::PEM_get_string_X509($_[4]))); ### $cl_cert return 1; } @@ -1139,11 +1154,11 @@ sub cert_req { my ($req, $meta); if (ref $cert_req->{$key} eq 'ARRAY') { $req = $cert_req->{$key}[0]; - if ($req eq 'any' and defined $cl_cert) { + if ($req eq 'any' and defined $data{cl_cert}) { return 0; } - elsif ($req eq 'pubkey' and defined $cl_cert) { - my $cl_cert_f = $cl_cert->{fingerprint_sha256}; + elsif ($req eq 'pubkey' and defined $data{cl_cert}) { + my $cl_cert_f = $data{cl_cert}->{fingerprint_sha256}; $cl_cert_f =~ s/://g; $cl_cert_f = lc $cl_cert_f; for my $pubkey (@{ $cert_req->{$key} }) { @@ -1157,8 +1172,8 @@ sub cert_req { } } } - elsif ($req eq 'file' and defined $cl_cert) { - my $cl_cert_f = $cl_cert->{fingerprint_sha256}; + elsif ($req eq 'file' and defined $data{cl_cert}) { + my $cl_cert_f = $data{cl_cert}->{fingerprint_sha256}; $cl_cert_f =~ s/://g; $cl_cert_f = lc $cl_cert_f; @@ -1197,7 +1212,7 @@ sub cert_req { } # must be string, hopefully 'any' elsif ($cert_req->{$key} eq 'any') { - if (defined $cl_cert) { + if (defined $data{cl_cert}) { return 0; } else { @@ -1227,7 +1242,7 @@ sub check_for_gone { } } } - + if (exists $config->{default}{gone} and $config->{default}{gone} eq 'true') { if (path_in_vhost_root_translated($vhost, "$path.gone")) { return 1; @@ -1272,3 +1287,18 @@ sub path_in_vhost_root_translated { return; } } + +sub undef_data { + my ($data_ref) = @_; + undef $data{srv_sockhost}; + undef $data{srv_port}; + undef $data{srv_sni}; + undef $data{cl_host}; + undef $data{cl_port}; + undef $data{cl_base_class}; + undef $data{cl_cert}; + undef $data{cl_path}; + undef $data{cl_path_translated}; + undef $data{cl_query_string}; + return 1; +} -- cgit v1.2.3