Change socket behavior in preperation for unix sockets

1 files changed, 99 insertions, 66 deletions

diff --git a/gmi.pl b/gmi.pl
index 4248d9a..b427ca5 100755
--- a/gmi.pl
+++ b/gmi.pl
@@ -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;
+		}
 	}
 }