add server/client data to global hash for easy assess

3 files changed, 93 insertions, 57 deletions

diff --git a/TO_FIX.md b/TO_FIX.md
index 0dd263e..af0e0c1 100644
--- a/TO_FIX.md
+++ b/TO_FIX.md
@@ -23,5 +23,3 @@ handle signals like interrupt better
 recently-accepted-cert-cache for specific cert-req keys, doing a look up EACH and EVERY TIME can be expensive when it it likely that a single person will be looking around.
 
 reduce complexity in cert_req()
-
-put peer data in a global hash for easy access for logging and cgi scripts
diff --git a/config.toml.sample b/config.toml.sample
index 6ec5e6a..c1962c7 100644
--- a/config.toml.sample
+++ b/config.toml.sample
@@ -56,6 +56,9 @@ default_mime = 'text/plain'
 # 'simple', which is simply "if 'x' key exist, return the value for it"
 # 'regex' which is a bit more complex and uses Perl's built in regualar expression. See the vhost for an example of one.
 redirection = 'simple'
+# gone, a default context dones't really do anything besides let all vhost check for a .gone file if the original path doesn't exist.
+# vhost setting for this is somewhat more involved
+gone = true
 
 ### Not implimented yet
 # similar to .htaccess, .gmiaccess
@@ -97,6 +100,10 @@ assume_index = true
 #dir_listing = true
 #default_mime = 'text/plain'
 #
+## Regex settings:
+##   they are checked in the following order:
+##   certificate, redirection, gone
+#
 #redirection = 'regex'
 #redirect = {
 #    # note the beginning '/'. 
@@ -136,6 +143,7 @@ assume_index = true
 #      '../pubkeys2.txt',
 #   ],
 #}
+# if you dont want a vhost to be able to set gone, leave this hash empty or delete it entirely.
 #gone = {
 #   # this checks if a path location doesn't exist, but does if '.gone' is appended, which will return a gone gemini status
 #   append = true,
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;
+}