From 8cbc34cc274c6d37baba2ce76757d1411430ebee Mon Sep 17 00:00:00 2001
From: jake <jake@jakes-mail.top>
Date: Mon, 15 Aug 2022 10:35:28 -0400
Subject: Make fork() toggleable.

Touch up code that exit() - would end server otherwise.
Touch up log entries.
---
 gmi.pl | 67 +++++++++++++++++++++++++++++++++++++++++++++---------------------
 1 file changed, 46 insertions(+), 21 deletions(-)

(limited to 'gmi.pl')

diff --git a/gmi.pl b/gmi.pl
index 69a87e9..d950d50 100755
--- a/gmi.pl
+++ b/gmi.pl
@@ -7,7 +7,7 @@ use warnings;
 use 5.010;
 #use diagnostics;
 
-our $VERSION = 'v0.0.6';
+our $VERSION = 'v0.0.7';
 
 # Modules
 use IO::Socket::SSL; # CPAN
@@ -15,7 +15,7 @@ use IO::Socket::SSL::Utils; # CPAN
 use URL::XS qw(parse_url split_url_path parse_url_query); # CPAN
 #use Term::ANSIColor; # Core
 use Path::Naive qw(normalize_path); # CPAN
-use Smart::Comments; # CPAN
+#use Smart::Comments; # CPAN
 use URI::Encode qw(uri_encode); # CPAN
 use IO::Select;
 use TOML qw(from_toml);
@@ -50,7 +50,7 @@ our %GEM_RES_CODES = (
 
 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/;
+	log_file log_to_stdout default_mime cert_key_dir_write_warning fork/;
 our @VALID_VHOST_SETTINGS = 
 	qw/auto_cert assume_index dir_listing root cert key default_mime/;
 
@@ -275,6 +275,20 @@ for my $vhost (keys %{ $config }) {
 	}
 }
 
+# fork() toggle
+my $fork_toggled = 1;
+if (exists $config->{default}{fork}) {
+	if ($config->{default}{fork} eq 'true') {
+		$fork_toggled = 1;
+	}
+	elsif ($config->{default}{fork} eq 'false') {
+		$fork_toggled = 0;
+	}
+	else {
+		say STDERR "default: fork value ($config->{default}{fork}) is not true/false. Will assume true.";
+	}
+}
+
 # let the user know if an invalid option was used
 for my $option (keys %{ $config->{default} }) {
 	my $valid = 0;
@@ -312,14 +326,17 @@ say $out "Server Started on ". localtime();
 # Main server loop
 while () {
 	my $cl = $srv->accept() or next;
-	my $pid = fork();
-	if (not defined $pid) {
-		warn "Cannot make a child: $!";
-		next;
-	}
-	if ($pid) {
-		undef $cl;
-		next;
+
+	if ($fork_toggled) {
+		my $pid = fork();
+		if (not defined $pid) {
+			warn "Cannot make a child: $!";
+			next;
+		}
+		if ($pid) {
+			undef $cl;
+			next;
+		}
 	}
 
 	#close STDIN;
@@ -334,14 +351,14 @@ while () {
 	} elsif ($opened == -1) {
 		print $out "IO::Handle opened but the SSL handshake failed.\n";
 		$cl->close('SHUT_WR');
-		exit;
+		exit if ($fork_toggled);
 	} elsif (! $opened) {
 		print $out "Socket could not be opened.\n";
-		exit;
+		exit if ($fork_toggled);
 	}
 	else {
 		print $out "Something is very wrong.\n";
-		exit;
+		exit if ($fork_toggled);
 	}
 
 	my $data;
@@ -351,17 +368,18 @@ while () {
 	
 	eval {
 		# We do this because 'naughty' people/bots can clog up the ports doing nothing.
-		local $SIG{ALRM} = sub { 
+		local $SIG{ALRM} = sub {
+			# cannot goto, we are in a subroutine that gets called when ALRM is triggered.
 			say $out "$clhost - ($cl_sni) timed-out [". localtime(). ']';
 			$cl->close('SHUT_WR');
-			exit;
+			exit if ($fork_toggled);
 		};
 		alarm 5; # TODO make magic number not magic.
 
 		if ( ! sysread($cl, $data, 1024) ) {
-			$log = "$clhost - ($cl_sni) sysread failed ... Invalid certificate/key?";
+			$log = "$clhost - ($cl_sni) sysread failed";
+			alarm 0;
 			goto CLOSE;
-			exit;
 		}
 
 		alarm 0;
@@ -373,13 +391,19 @@ while () {
 	eval {
 		$url = parse_url($data);
 	};
+
+	# TODO: make user adjustable
+	$log = "$clhost - ($cl_sni) $data";
+
+	if (! $url) {
+		speak($cl, 'bad_request');
+		goto CLOSE;
+	}
 	$path = $url->{path};
 	### $data
 	### $url
 	# ## $path
 	
-	# TODO: make user adjustable
-	$log = "$clhost - ($cl_sni) $data";
 
 	my $vhost = $url->{host};
 	my $doc;
@@ -471,7 +495,8 @@ while () {
 	CLOSE:
 	$cl->close('SHUT_WR');
 	print $out "$log [". localtime(). "]\n";
-	exit;
+	
+	exit if ($fork_toggled);
 }
 
 $srv->close();
-- 
cgit v1.2.3