Appease perlcritic. Refactoring and many other changes

Comment out Smart::Comments

1 files changed, 491 insertions, 481 deletions

diff --git a/gmi.pl b/gmi.pl
index d950d50..dae3adf 100755
--- a/gmi.pl
+++ b/gmi.pl
@@ -7,13 +7,12 @@ use warnings;
 use 5.010;
 #use diagnostics;
 
-our $VERSION = 'v0.0.7';
+our $VERSION = 'v0.0.8';
 
 # Modules
 use IO::Socket::SSL; # CPAN
 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 URI::Encode qw(uri_encode); # CPAN
@@ -22,391 +21,122 @@ use TOML qw(from_toml);
 use Data::Dumper;
 use Cwd;
 use File::Type;
-
-# Program name
-$0 = 'jakes-gemini-server';
-$SIG{CHLD} = 'IGNORE';
-
-our %GEM_RES_CODES = (
-	'input' => "10 Input",
-	'hidden_input' => "11 Sensitive Input",
-	'success' => "20 !s",
-	'redirect' => "30 !s",
-	'redirect_perm' => "31 !s",
-	'temp_failure' => "40 Temporary Failure",
-	'server_unavailable' => "41 Server Unavailable",
-	'cgi_error' => "42 CGI Error",
-	'proxy_error' => "43 Proxy Error",
-	'slow_down' => "44 Slow Down",
-	'failure' => "50 Permament Failure",
-	'not_found' => "51 Not Found",
-	'gone' => "52 Gone",
-	'proxy_req_refused' => "53 Proxy Request Refused",
-	'bad_request' => "59 Bad Request",
-	'cert_req' => "60 Certificate Required",
-	'cert_unauth' => "61 Certificate Unauthorized",
-	'cert_invalid' => "62 Certificate Invalid",
+use English qw( -no_match_vars );
+use Const::Fast;
+use Carp;
+
+local $PROGRAM_NAME = 'jakes-gemini-server';
+# Not worried about fork()-ed children
+local $SIG{CHLD} = 'IGNORE';
+
+const my $DEFAULT_GEMINI_PORT => 1965;
+const my $KBYTE => 1024;
+const my $SECS_IN_YEAR => 3_156_000;
+const my $UMASK_OCTAL_FOR_CERTS_KEYS => 0o077; # '-rwx------'
+
+const our %GEM_RES_CODES => (
+	'input'              => '10 Input',
+	'hidden_input'       => '11 Sensitive Input',
+	'success'            => '20 !s',
+	'redirect'           => '30 !s',
+	'redirect_perm'      => '31 !s',
+	'temp_failure'       => '40 Temporary Failure',
+	'server_unavailable' => '41 Server Unavailable',
+	'cgi_error'          => '42 CGI Error',
+	'proxy_error'        => '43 Proxy Error',
+	'slow_down'          => '44 Slow Down',
+	'failure'            => '50 Permament Failure',
+	'not_found'          => '51 Not Found',
+	'gone'               => '52 Gone',
+	'proxy_req_refused'  => '53 Proxy Request Refused',
+	'bad_request'        => '59 Bad Request',
+	'cert_req'           => '60 Certificate Required',
+	'cert_unauth'        => '61 Certificate Unauthorized',
+	'cert_invalid'       => '62 Certificate Invalid',
 );
 
-our @VALID_DEFAULT_SETTINGS = 
+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/;
-our @VALID_VHOST_SETTINGS = 
+const our @VALID_VHOST_SETTINGS =>
 	qw/auto_cert assume_index dir_listing root cert key default_mime/;
 
-my $ft = File::Type->new();
-
-my ($config, $err) = from_toml(_slurp("./config.toml")); 
+my ($config, $err) = from_toml(_slurp('./config.toml'));
 if ($err) {
-	warn "TOML config error: $err.\nWill (try to) listen on 'localhost:1965'"; 
-	$config = {
-		default => {
-			assume_index => 'true',
-			dir_listing => 'false',
-			bind => '0.0.0.0',
-			ports => [ 1965 ],
-			tls => ['v1.2', 'v1.3'],
-			root => "default_root",
-			default_mime => 'text/plain',
-			log_2_stdout => 'true',
-		},
-		localhost => {
-			auto_cert => 'true',
-		}
-	}
+	die "TOML config error: $err.";
 }
 ### $config
 
-# Hard coded SSL defaults
-my %ssl_config = (
-	LocalAddr => '0.0.0.0',
-	LocalPort => 1965,
-	Listen => 10,
+my %ssl_config = ssl_config($config);
+my $working_dir = working_dir($config);
+my $cert_key_dir = cert_key_dir($config);
+my $out = logging($config);
+select $out; ## no critic (InputOutput::ProhibitOneArgSelect)
+local $OUTPUT_AUTOFLUSH = 1;
+ssl_vhost_cert_key(\%ssl_config);
 
-	SSL_version => '!SSLv2:!SSLv3:!TLSv1:!TLSv1_1',
-
-	SSL_fast_shutdown => 1,
-	Timeout => 2,
-	SSL_error_trap => 1,
-	#SSL_server => 1,
-);
-
-# Override hard coded defaults for SSL stuff
-for my $item (keys %{ $config->{default} }) {
-	if ($item eq 'working_dir') {
-		;
-	}
-	elsif ($item eq 'bind') {
-		$ssl_config{LocalAddr} = $config->{default}{bind};
-		#say $config->{default}{bind};
-	}
-	elsif ($item eq 'ports') {
-		for my $port ( @{ $config->{default}{ports} } ) {
-			# TODO; enable more than one port.
-			$ssl_config{LocalPort} = $config->{default}{ports}[0];
-			#say $config->{default}{ports}[0];
-		}
-	}
-	elsif ($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_config{SSL_version} = '!SSLv2:!SSLv3:!TLSv1:!TLSv1_1:!TLSv1_2:!TLSv1_3';
+my $fork_toggled = fork_toggle($config);
 
-		for my $tls ( @{ $config->{default}{tls} } ) {
-			if ($tls eq 'v1.2') {
-				$ssl_config{SSL_version} =~ s/:!TLSv1_2//;
-			}
-			elsif ($tls eq 'v1.3') {
-				$ssl_config{SSL_version} =~ s/:!TLSv1_3//;
-			}
-			else {
-				say "TLS option '$tls' not supported - ignoring.";
-			}
-		}
-	}
-}
+# let the user know if an invalid option was used
+check_config_keys($config);
 
-my $working_dir;
-if (exists $config->{default}{working_dir}) {
-	$working_dir = $config->{default}{working_dir};
-	if (! (-e $working_dir and -r $working_dir and -d $working_dir) ) {
-		die "$working_dir is either: not existing, readable, or a directory.";
-	}
-}
-else {
-	$working_dir = getcwd;
-}
+### %ssl_config
 
-my $cert_key_dir;
-if (exists $config->{default}{cert_key_dir}) {
-	my $p = abs_or_rel($config->{default}{cert_key_dir});
-	# Absolute
-	if ($p eq 'abs') {
-		$cert_key_dir = $config->{default}{cert_key_dir};
-	}
-	# Relative
-	elsif ($p eq 'rel') {
-		$cert_key_dir = "$working_dir/$config->{default}{cert_key_dir}";
-	}
-	else {
-		die "cert_key_dir: neither absolute or relative.";
-	}
-}
-else {
-	$cert_key_dir = "$working_dir/certs";
-}
-# Create $cert_key_dir if needed
-if (-d $cert_key_dir and -r $cert_key_dir and -x $cert_key_dir) {
-	if (! -w $cert_key_dir) {
-		if (! (exists $config->{default}{cert_key_dir_write_warning} 
-			and $config->{default}{cert_key_dir_write_warning} eq 'false'))
-		{
-			say STDERR "cert_key_dir ($cert_key_dir) not writable, generating cert/key pair will cause crash.\n".
-				"(cert_key_dir_write_warning = 'false' to hide this warning.)";
-		}
-	}
-} elsif (! -e $cert_key_dir) {
-	mkdir $cert_key_dir
-		or die "Could not create cert_key_dir ($cert_key_dir) - $!";
-} else {
-	die "cert_key_dir ($cert_key_dir) is not all of these: ".
-	"directory, readable, or executeable.";
-}
+my $ft = File::Type->new();
 
-# Logging
-my $out;
-if (exists $config->{default}{log_to_stdout} and $config->{default}{log_to_stdout} eq 'true') {
-	$out = \*STDOUT;
-} elsif (exists $config->{default}{log_file} and $config->{default}{log_file}) {
-	open ($out, ">>", "$working_dir/$config->{default}{log_file}");
-}
-else {
-	say STDERR "Not log option specified, logging to STDOUT.";
-	$out = \*STDOUT;
-}
-select $out;
-$| = 1; # Making the *current* Filehandle 'hot' so Perl flushes the buffer immeditally.
 my $log;
 
-# VirtualHosts
-for my $vhost (keys %{ $config }) {
-	next if ($vhost eq 'default');
-	my $error_free = 1;
-	my $cert_loc;
-	my $key_loc;
-
-	if (exists $config->{$vhost}{cert} and exists $config->{$vhost}{key}) {
-
-		my $p_c = abs_or_rel($config->{$vhost}{cert});
-		if ($p_c eq 'abs') {
-			if (-e $config->{$vhost}{cert}) {
-				$cert_loc = $config->{$vhost}{cert};
-			}
-			else {
-				say STDERR "'$config->{$vhost}{cert}' for '$vhost' does not exist.";
-				$error_free = 0;
-			}
-		}
-		elsif ($p_c eq 'rel') {
-			if (-e "$cert_key_dir/$config->{$vhost}{cert}") {
-				$cert_loc = "$cert_key_dir/$config->{$vhost}{cert}";
-			} 
-			else {
-				say STDERR "'$cert_key_dir/$config->{$vhost}{cert}' does not exist.";
-				$error_free = 0;
-			}
-		}
-		else {
-			warn "'$config->{$vhost}{cert}' for '$vhost' cert option  is neither absolute or relative.";
-			$error_free = 0;
-		}
-
-		my $p_k = abs_or_rel($config->{$vhost}{key});
-		if ($p_k eq 'abs') {
-			if (-e $config->{$vhost}{key}) {
-				$key_loc = $config->{$vhost}{key};
-			}
-			else {
-				say STDERR "'$config->{$vhost}{key}' does not exist.";
-				$error_free = 0;
-			}
-		}
-		elsif ($p_k eq 'rel') {
-			if (-e "$cert_key_dir/$config->{$vhost}{key}") {
-				$key_loc = "$cert_key_dir/$config->{$vhost}{key}";
-			}
-			else {
-				say STDERR "'$cert_key_dir/$config->{$vhost}{key}' does not exist.";
-				$error_free = 0;
-			}
-		}
-		else {
-			warn "'$config->{$vhost}{key}' for '$vhost' key option  is neither absolute or relative.";
-			$error_free = 0;
-		}
-
-	}
-	else {
-		if (exists $config->{$vhost}{auto_cert} and $config->{$vhost}{auto_cert} eq 'true') {
-			# manage cert for user
-			$cert_loc = "$cert_key_dir/$vhost". '_cert.pem';
-			$key_loc = "$cert_key_dir/$vhost". '_key.pem';
-
-			if (! -e $cert_loc or ! -e $key_loc) {
-				gen_cert($vhost, $cert_key_dir);
-				say $out "$vhost cert/key pair generated in '$cert_key_dir'.";
-			}
-			else {
-				# TODO: make sure cert is valid, otherwise re-generate them
-			}
-		}
-		else {
-			say STDERR "$vhost only has one part of a cert/key pair and/or auto_cert is not true.";
-			$error_free = 0;
-		}
-	}
-	
-	if ($error_free) {
-		$ssl_config{SSL_cert_file}{$vhost} = $cert_loc;
-		$ssl_config{SSL_key_file}{$vhost} = $key_loc;
-	}
-	else {
-		say STDERR "$vhost: Will will not be listening for incoming requests.";
-	}
-}
-
-# 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;
-	for (@VALID_DEFAULT_SETTINGS) {
-		if ($option eq $_) {
-			$valid = 1;
-			last;
-		}
-	}
-	if (! $valid) {
-		say STDERR "'$option' is invalid in default.";
-	}
-}
-for my $vhost (keys %{ $config }) {
-	next if ($vhost eq 'default');
-	for my $option (keys %{ $config->{$vhost} }) {
-		my $valid = 0;
-		for (@VALID_VHOST_SETTINGS) {
-			if ($option eq $_) {
-				$valid = 1;
-				last;
-			}
-		}
-		if (! $valid) {
-			say STDERR "'$option' is invalid in $vhost.";
-		}
-	}
+my $srv = IO::Socket::SSL->new(%ssl_config)
+	or die "error=$ERRNO, ssl_error=$SSL_ERROR";
+say "$PROGRAM_NAME ($VERSION) started on ". localtime;
+if (! $fork_toggled) {
+	say 'forking disabled.';
 }
 
-### %ssl_config
-
-my $srv = IO::Socket::SSL->new(%ssl_config) or die "error=$!, ssl_error=$SSL_ERROR";
-say $out "Server Started on ". localtime();
-
 # Main server loop
 while () {
 	my $cl = $srv->accept() or next;
 
-	if ($fork_toggled) {
-		my $pid = fork();
-		if (not defined $pid) {
-			warn "Cannot make a child: $!";
-			next;
-		}
-		if ($pid) {
-			undef $cl;
-			next;
-		}
-	}
-
-	#close STDIN;
-	#close STDOUT;
-	#close STDERR;
-	#open($out, '>>', './logs');
+	maybe_fork(\$cl) and next;
 
-	my $opened = $cl->opened();
-	if ($opened == 1) {
-		#print $out "Everything works! Wow!\n";
-		;
-	} elsif ($opened == -1) {
-		print $out "IO::Handle opened but the SSL handshake failed.\n";
-		$cl->close('SHUT_WR');
-		exit if ($fork_toggled);
-	} elsif (! $opened) {
-		print $out "Socket could not be opened.\n";
-		exit if ($fork_toggled);
-	}
-	else {
-		print $out "Something is very wrong.\n";
-		exit if ($fork_toggled);
-	}
-
-	my $data;
 	my $clhost = $cl->peerhost();
 	my $clport = $cl->peerport();
 	my $cl_sni = $cl->get_servername();
-	
-	eval {
-		# We do this because 'naughty' people/bots can clog up the ports doing nothing.
-		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 if ($fork_toggled);
-		};
-		alarm 5; # TODO make magic number not magic.
 
-		if ( ! sysread($cl, $data, 1024) ) {
-			$log = "$clhost - ($cl_sni) sysread failed";
-			alarm 0;
-			goto CLOSE;
-		}
+	my $url;
+	my $path;
+	my $data;
+
+	# We do this because 'naughty' people/bots can clog up the ports doing nothing.
+	local $SIG{ALRM} = sub { timeout($cl, $clhost, $cl_sni) };
 
+	alarm 5; # TODO make magic number not magic.
+	if (! sysread $cl, $data, $KBYTE) {
+		$log = "$clhost - ($cl_sni) sysread failed";
 		alarm 0;
-	};
+		goto CLOSE;
+	}
+	alarm 0;
 
-	my $url;
-	my $path;
-	substr($data,-2,2,''); # removing \r\n
-	eval {
-		$url = parse_url($data);
-	};
+	# removing \r\n
+	substr $data, -2, 2, '';
 
-	# TODO: make user adjustable
+	# TODO: user log format
 	$log = "$clhost - ($cl_sni) $data";
 
-	if (! $url) {
+	eval {
+		$url = parse_url($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
 	### $url
 	# ## $path
-	
 
 	my $vhost = $url->{host};
-	my $doc;
 	my $doc_loc;
 
 	# only happens if someone is hacking/cracking
@@ -415,72 +145,43 @@ while () {
 		goto CLOSE;
 	}
 
-	$doc_loc = get_request_in_vhost_root($vhost, $path);
-	### $doc_loc
-	if (! defined $doc_loc) {
+	if (not $doc_loc = get_request_in_vhost_root($vhost, $path)) {
 		goto FAILURE;
 	}
+	### $doc_loc
 
-	my $cv = check_vhost_settings($vhost);
-	# we already know it exists and is readable
+	# not a directory
 	if (! -d $doc_loc) {
-		#$doc = _slurp($doc_loc);
 		goto DOC_ASSIGNED;
 	}
-	elsif (-d $doc_loc) {
-		# make sure 'dir' is 'dir/' 
-		if (substr($doc_loc,-1,1) ne '/') {
-			speak($cl, 'redirect', @{ split_url_path($path, 256) }[-1]. "/");
-			goto CLOSE;
-		}
 
-		# if assume_index
-		if (($cv == 1 or $cv == 3) and is_exists_and_readable($doc_loc. '/index.gmi') ) {
-			$doc_loc .= '/index.gmi';
-			#$doc = _slurp($doc_loc);
-			goto DOC_ASSIGNED;
-		}
-		# if dir_listing
-		elsif ($cv == 2 or $cv == 3) {
-			#$doc = dir_listing($doc_loc, $path);
-			goto DIR_LISTING;
-		}
-		else {
-			goto FAILURE;
-		}
+	# make sure 'dir' is 'dir/'
+	if (substr($doc_loc,-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]. '/');
+		goto CLOSE;
+	}
+
+	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';
+		#$doc = _slurp($doc_loc);
+		goto DOC_ASSIGNED;
+	}
+	# if dir_listing
+	elsif ($cv == 2 or $cv == 3) {
+		goto DIR_LISTING;
+	}
+	else {
+		goto FAILURE;
 	}
 
 	DOC_ASSIGNED:
 	#my $meta = $ft->checktype_contents($doc);
-	my $meta = $ft->checktype_filename($doc_loc);
-	if ($meta eq "application/octet-stream") {
-		# 'text/gemini' is non-standard mime-type
-		if ((substr($doc_loc, -4, 4) eq '.gmi') or (substr($doc_loc, -1, 1) eq '/' and ($cv == 2 or $cv == 3))) {
-			$meta = 'text/gemini';
-		}
-		# Manually support webm until better magic detection is used
-		elsif (substr($doc_loc, -4, 4) eq 'webm') {
-			open(my $fh, '<', $doc_loc);
-			my $h;
-			read($fh, $h, 1*1024);
-			if ($h =~ m/V_VP9/) {
-				$meta = 'video/VP9';
-			} elsif ($h =~ m/V_VP8/) {
-				$meta = 'video/VP8';
-			} else {
-				$meta = 'application/octet-stream';
-			}
-			close $fh;
-			undef($h);
-		}
-		elsif (exists $config->{$vhost}{default_mime}) {
-			$meta = $config->{$vhost}{default_mime};
-		}
-		elsif (exists $config->{default}{default_mime}) {
-			$meta = $config->{default}{default_mime};
-		}
-		### $meta
-	}
+	my $meta = detect_mime($doc_loc, $vhost);
 	speak($cl, 'success', $meta, $doc_loc);
 	goto CLOSE;
 
@@ -494,8 +195,8 @@ while () {
 
 	CLOSE:
 	$cl->close('SHUT_WR');
-	print $out "$log [". localtime(). "]\n";
-	
+	say "$log [". localtime(). ']';
+
 	exit if ($fork_toggled);
 }
 
@@ -503,25 +204,29 @@ $srv->close();
 
 sub _slurp {
 	my $filename = shift;
-	open(my $in, '<', $filename)
-		or warn "Cannot open '$filename' - $!"
-		and return undef;
-	local $/; # enable 'slurp mode'
+	open my $in, '<', $filename
+		or carp "Cannot open '$filename' - $ERRNO"
+		and return;
+	local $INPUT_RECORD_SEPARATOR = undef; # enable 'slurp mode'
 	my $contents = <$in>;
-	close $in;
+	close $in
+		or carp "Cannot close filehandle ($filename): $ERRNO";
 	return $contents;
 }
 
 sub dir_listing {
 	my ($doc_loc, $path) = @_;
-	return 0 if (! -d $doc_loc and ! -r $doc_loc);
-	
-	my $doc = "Dir listing for /";
+	return if (! -d $doc_loc || ! -r $doc_loc);
+
+	my $doc = 'Dir listing for /';
 	if ($path) { $doc .= "$path" };
 	$doc .= "\n\n";
 
-	opendir (my $dh, $doc_loc) or warn "$!" and return undef;
-	while (my $i = readdir($dh)) {
+	opendir my $dh, $doc_loc
+		or warn "Cannot open $doc_loc: $ERRNO"
+		and return; # No point in continuing.
+
+	while (my $i = readdir $dh) {
 		if (substr($i,0,1) eq '.') { # dont display hidden files
 			next;
 		}
@@ -536,7 +241,8 @@ sub dir_listing {
 		}
 		$doc .= "\n";
 	}
-	closedir $dh;
+	closedir $dh
+		or warn "Cannot close $doc_loc: $ERRNO";
 
 	return $doc;
 }
@@ -546,8 +252,8 @@ sub gen_cert {
 	my $cert_loc = "$path/$hostname". '_cert.pem';
 	my $key_loc = "$path/$hostname". '_key.pem';
 
-	my $not_before = time();
-	my $not_after = 20 * 3156000 + time(); # 20 years * 3156000 seconds (365 days) + time()
+	my $not_before = time;
+	my $not_after = 20 * $SECS_IN_YEAR + time;
 
 	my %cert = (
 		'subject' => { 'commonName' => $hostname },
@@ -556,84 +262,69 @@ sub gen_cert {
 	);
 	my ($cert, $key) = CERT_create(%cert);
 
-	my $old_umask = umask(077);
+	my $old_umask = umask $UMASK_OCTAL_FOR_CERTS_KEYS;
 	PEM_cert2file($cert, $cert_loc);
 	PEM_key2file($key, $key_loc);
 	CERT_free($cert);
 	KEY_free($key);
-	umask($old_umask);
+	umask $old_umask
+		or warn "umask: $ERRNO";
+	return;
 }
 
-# return appropriate path that should be _slurp()-ed
+# return appropriate path that can be sysread -> syswrite
 # WARNING: this has not been tested properly for security!! may serve any file somehow!
 # rude users can `ln -s /etc/passwd ./passwd` in their capsule directory. 
 sub get_request_in_vhost_root {
 	my ($vhost, $request) = @_;
 	my $r = '';
-	
-	# remove '..'
-	$request =~ s/\.\.//g if ($request);
 
-	# convert %20 into space
-	$request =~ s/%20/ /g if ($request);
-		 
-	$r = normalize_path($request) if ($request);
+	if ($request) {
+		# remove '..'
+		$request =~ s/[.]{2}//g;
+		# convert %20 into space
+		$request =~ s/%20/ /g;
 
-	# if requesting a dir
-	if ($request and substr($request,-1,1) eq '/') {
-		# normalize_path() removes the trailing '/'
-		$r = $r. '/';
+		$r = normalize_path($request);
+		if (substr($request, -1, 1) eq '/') {
+			# normalize_path() removes the trailing '/'
+			$r .= '/';
+		}
 	}
 	### $r
 
 	if (exists $config->{$vhost}{root}) {
-		my $p = abs_or_rel($config->{$vhost}{root});
-		if ($p eq 'abs') {
-			is_exists_and_readable("$config->{$vhost}{root}/$r")
-				? return "$config->{$vhost}{root}/$r" : return undef;
-		}
-		elsif ($p eq 'rel') {
-			is_exists_and_readable("$working_dir/$config->{$vhost}{root}/$r")
-				? return "$working_dir/$config->{$vhost}{root}/$r" : return undef;
-		}
-		else {
-			return undef;
+		my $p = accurate_path($config->{$vhost}{root}, $working_dir);
+		if (file_exists_and_readable("$p/$r")) {
+			return "$p/$r";
 		}
 	}
-	
 	# try default's root
-	elsif (not exists $config->{$vhost}{root} and exists $config->{default}{root}) {
-		my $p = abs_or_rel($config->{default}{root});
-		if ($p eq 'abs') {
-			is_exists_and_readable("$config->{default}{root}/$r") 
-				? return "$config->{default}{root}/$r" : return undef;
-		}
-		elsif ($p eq 'rel') {
-			is_exists_and_readable("$working_dir/$config->{default}{root}/$r")
-				? return "$working_dir/$config->{default}{root}/$r" : return undef;
-		}
-		else {
-			say $out "$vhost does not have a valid root and neither does default.";
-			return undef;
+	elsif (exists $config->{default}{root}) {
+		my $p = accurate_path($config->{default}{root}, $working_dir);
+		if (file_exists_and_readable("$p/$r")) {
+			return "$p/$r";
 		}
 	}
-
 	else {
-		say STDERR "default has improper root settings.";
-		return 0;
+		serr("default and $vhost have improper root settings.");
+		return;
 	}
+	return;
 }
 
-sub is_exists_and_readable {
+sub file_exists_and_readable {
 	my ($path) = @_;
-	(-e $path and -r $path) ? return 1 : return 0;
+	if (defined $path and ref \$path eq 'SCALAR') {
+		(-e $path and -r $path) ? return 1 : return 0;
+	}
+	return;
 }
 
 sub gem_code {
 	my ($code, @r) = @_;
 	exists $GEM_RES_CODES{$code}
-		or die "'$code' is an invalid Gemini Status."; 
-		# ^ this actually kills child, not parent
+		or die "'$code' is an invalid Gemini Status.";
 
 	my $res = $GEM_RES_CODES{$code};
 	for (@r) {
@@ -642,37 +333,44 @@ sub gem_code {
 	return $res;
 }
 
-# TODO: remove magic numbers
 sub speak {
 	my ($cl, $header, $meta, $doc_loc, $path) = @_;
 	### $meta
 	my $head = gem_code($header, $meta);
 	$log .= " $head";
-	syswrite($cl, "$head\r\n");
+	syswrite $cl, "$head\r\n"
+		or warn "syswrite failed: $ERRNO";
 
 	if ($doc_loc) {
-		if (is_exists_and_readable($doc_loc) and ! -d $doc_loc) {
+		if (file_exists_and_readable($doc_loc) and (! -d $doc_loc)) {
 			my $r;
-			open (my $fh, '<', $doc_loc);
+			## no critic (InputOutput::RequireBriefOpen)
+			open my $fh, '<', $doc_loc
+				or warn "Cannot open '$doc_loc': $ERRNO"
+				and return;
 			# An SSL packet can only have about 16k bytes 
 			# so, read less 16k, send it until eof
-			while (sysread($fh, $r, 15*1024)) { 
-				syswrite($cl, $r);
-				undef($r);
+			while (sysread $fh, $r, 15*$KBYTE) {
+				syswrite $cl, $r
+					or $log .= " $ERRNO"
+					and return;
+				undef $r;
 			}
-			close $fh;
+			close $fh
+				or warn "failed to close filehandle: $ERRNO";
 		}
-		elsif (is_exists_and_readable($doc_loc) and -d $doc_loc) {
+		elsif (file_exists_and_readable($doc_loc) and -d $doc_loc) {
 			my $doc;
 			$path ? ($doc = dir_listing($doc_loc, $path)) : ($doc = dir_listing($doc_loc));
-			
+
 			# It is possible that a dir listing can produce more than 16k bytes
 			my $offset = 0;
-			while (my $w = syswrite($cl, $doc, 15*1024, $offset)) {
+			while (my $w = syswrite $cl, $doc, 15*$KBYTE, $offset) {
 				$offset += $w;
 			}
 		}
 	}
+	return;
 }
 
 sub check_vhost_settings {
@@ -683,7 +381,7 @@ sub check_vhost_settings {
 	# 2 = dir_listing
 	# 3 = assume_index and dir_listing
 	my ($vhost) = @_;
-	
+
 	my $assume_index = 0;
 	my $dir_listing = 0;
 
@@ -698,7 +396,7 @@ sub check_vhost_settings {
 			$assume_index = 2;
 		}
 	}
-	
+
 	if (exists $config->{$vhost}{dir_listing}) {
 		if ($config->{$vhost}{dir_listing} eq 'true') {
 			### vhost dir listing is true 
@@ -709,16 +407,16 @@ sub check_vhost_settings {
 			$dir_listing = 2;
 		}
 	}
-	
+
+	# no vhost option, check default setting.
 	if ($assume_index == 0 and $dir_listing == 0) {
-		# no vhost option, lets check default setting.
 		if (exists $config->{default}{assume_index} and $config->{default}{assume_index} eq 'true') {
-			### default dir listing is true 
+			### default assume_index is true 
 			$assume_index = 1;
 		}
 
 		if (exists $config->{default}{dir_listing} and $config->{default}{dir_listing} eq 'true') {
-			### default dir listing is true 
+			### default dir_listing is true 
 			$dir_listing = 1;
 		}
 	}
@@ -737,12 +435,324 @@ sub check_vhost_settings {
 		### returning 0
 		return 0;
 	}
-
+	return;
 }
 
 sub abs_or_rel {
 	my ($p) = @_;
-	return undef unless (defined $p);
+	if (defined $p and ref \$p eq 'SCALAR') {
+		substr($p,0,1) eq '/'
+			? return 'abs' : return 'rel';
+	}
+	return;
+}
+
+# '"config value is invalid" at <line_numb> in <program>' is ugly.
+sub serr {
+	my ($s) = @_;
+	return say {*STDERR} $s;
+}
+
+sub cert_key_dir {
+	my ($conf_ref) = @_;
+	my $dir;
+	if (exists $conf_ref->{default}{cert_key_dir}) {
+		$dir = accurate_path($conf_ref->{default}{cert_key_dir}, $working_dir);
+	}
+	else {
+		$dir = "$working_dir/certs";
+	}
+
+	# Create cert_key_dir if needed
+	if (-d $dir and -r $dir and -x $dir) {
+		if (! -w $dir) {
+			if (! (exists $conf_ref->{default}{cert_key_dir_write_warning}
+				and $conf_ref->{default}{cert_key_dir_write_warning} eq 'false'))
+			{
+				serr("cert_key_dir ($dir) not writable.");
+			}
+		}
+	} elsif (! -e $dir) {
+		mkdir $dir
+			or die "Could not create cert_key_dir ($dir) - $ERRNO";
+	}
+	else {
+		die "cert_key_dir ($dir) is not all of these: ".
+		'directory, readable, or executeable.';
+	}
+
+	return $dir;
+}
+
+sub working_dir {
+	my ($conf_ref) = @_;
+	my $dir;
+	if (exists $conf_ref->{default}{working_dir}) {
+		$dir = $conf_ref->{default}{working_dir};
+		if (! (-e $dir and -r $dir and -d $dir) ) {
+			die "$working_dir is either: not existing, readable, or a directory.";
+		}
+	}
+	else {
+		$dir = getcwd;
+	}
+	return $dir;
+}
+
+sub ssl_config {
+	my ($conf_ref) = @_;
+	my %ssl = (
+		LocalAddr => '0.0.0.0',
+		LocalPort => $DEFAULT_GEMINI_PORT,
+		Listen => 10,
 
-	substr($p,0,1) eq '/' ? return 'abs' : return 'rel';
+		SSL_version => '!SSLv2:!SSLv3:!TLSv1:!TLSv1_1',
+
+		SSL_fast_shutdown => 1,
+		Timeout => 2,
+		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') {
+			# 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';
+
+			for my $tls ( @{ $conf_ref->{default}{tls} } ) {
+				if ($tls eq 'v1.2') {
+					$ssl{SSL_version} =~ s/:!TLSv1_2//;
+				}
+				elsif ($tls eq 'v1.3') {
+					$ssl{SSL_version} =~ s/:!TLSv1_3//;
+				}
+				else {
+					serr("TLS option '$tls' not supported - ignoring.");
+				}
+			}
+		}
+	}
+	return %ssl;
 }
+
+sub logging {
+	my ($conf_ref) = @_;
+	if (exists $conf_ref->{default}{log_to_stdout} and $conf_ref->{default}{log_to_stdout} eq 'true') {
+		return \*STDOUT;
+	}
+	elsif (exists $conf_ref->{default}{log_file} and $conf_ref->{default}{log_file}) {
+		my $p = abs_or_rel($conf_ref->{default}{log_file});
+		if ($p eq 'abs') {
+			open my $fh, '|-', "$conf_ref->{default}{log_file}"
+				or die "Cannot open log file: $ERRNO";
+			return $fh;
+		}
+		elsif ($p eq 'rel') {
+			open my $fh, '>>', "$working_dir/$conf_ref->{default}{log_file}"
+				or die "Cannot open log file: $ERRNO";
+			return $fh;
+		}
+		else {
+			die 'log_file: is neither absolute or relative.'
+		}
+	}
+	else {
+		serr('default: No log option specified, logging to STDOUT.');
+		return \*STDOUT;
+	}
+	return;
+}
+
+sub fork_toggle {
+	my ($conf_ref) = @_;
+	if (exists $conf_ref->{default}{fork}) {
+		if ($conf_ref->{default}{fork} eq 'true') {
+			return 1;
+		}
+		elsif ($conf_ref->{default}{fork} eq 'false') {
+			return 0;
+		}
+		else {
+			serr("fork value ($conf_ref->{default}{fork}) is not true/false. Assuming true.");
+			return 1;
+		}
+	}
+	else {
+		return 1;
+	}
+}
+
+sub ssl_vhost_cert_key {
+	my ($ssl_ref) = @_;
+	for my $vhost (keys %{ $config }) {
+		next if ($vhost eq 'default');
+		my $error_free = 1;
+		my $cert_loc;
+		my $key_loc;
+
+		if (exists $config->{$vhost}{cert} and exists $config->{$vhost}{key}) {
+			$cert_loc = accurate_path($config->{$vhost}{cert}, $cert_key_dir);
+			if (! -e $cert_loc) {
+				serr("$vhost: '$cert_loc' does not exist.");
+				$error_free = 0;
+			}
+
+			$key_loc = accurate_path($config->{$vhost}{key}, $cert_key_dir);
+			if (! -e $key_loc) {
+				serr("$vhost: '$key_loc' does not exist.");
+				$error_free = 0;
+			}
+		}
+		else {
+			if (exists $config->{$vhost}{auto_cert} and $config->{$vhost}{auto_cert} eq 'true') {
+				# manage cert for user
+				$cert_loc = "$cert_key_dir/$vhost". '_cert.pem';
+				$key_loc = "$cert_key_dir/$vhost". '_key.pem';
+
+				if ((! -e $cert_loc) or (! -e $key_loc)) {
+					gen_cert($vhost, $cert_key_dir);
+					say "$vhost cert/key pair generated in '$cert_key_dir'.";
+				}
+				else {
+					# TODO: make sure cert is valid, otherwise re-generate them
+				}
+			}
+			else {
+				serr("$vhost: only has one part of a cert/key pair and/or auto_cert is not true.");
+				$error_free = 0;
+			}
+		}
+
+		if ($error_free) {
+			$ssl_ref->{SSL_cert_file}{$vhost} = $cert_loc;
+			$ssl_ref->{SSL_key_file}{$vhost} = $key_loc;
+		}
+		else {
+			serr("$vhost: will not listen for incoming requests.");
+		}
+	}
+	return;
+}
+
+sub check_config_keys {
+	my ($conf_ref) = @_;
+	for my $vhost (keys %{ $conf_ref }) {
+		## no critic (References::ProhibitDoubleSigils)
+		my $array_ref = \@VALID_VHOST_SETTINGS;
+		if ($vhost eq 'default') {
+			$array_ref = \@VALID_DEFAULT_SETTINGS;
+		}
+		for my $option (keys %{ $conf_ref->{$vhost} }) {
+			my $valid = 0;
+			for (@$array_ref) {
+				if ($option eq $_) {
+					$valid = 1;
+					last;
+				}
+			}
+			if (! $valid) {
+				serr("$vhost: '$option' is invalid.");
+			}
+		}
+	}
+	return;
+}
+
+sub accurate_path {
+	my ($p, $rel) = @_;
+	my $aor = abs_or_rel($p);
+	if ($aor eq 'abs') {
+		return $p;
+	}
+	elsif ($aor = 'rel') {
+		return "$rel/$p";
+	}
+	else {
+		carp "Value is neither absolute or relative: $p";
+		return;
+	}
+}
+
+sub detect_mime {
+	my ($doc_loc, $vhost) = @_;
+	my $meta = $ft->checktype_filename($doc_loc);
+	# 'text/gemini' is non-standard mime-type
+	if ($meta eq 'application/octet-stream') {
+		## no critic (ControlStructures::ProhibitCascadingIfElse)
+		if ((substr($doc_loc, -4, 4) eq '.gmi') or (substr($doc_loc, -1, 1) eq '/')) {
+			return 'text/gemini';
+		}
+		# Manually support webm until better magic detection is used
+		elsif (substr($doc_loc, -4, 4) eq 'webm') {
+			return webm_type($doc_loc);
+		}
+		elsif (exists $config->{$vhost}{default_mime}) {
+			return $config->{$vhost}{default_mime};
+		}
+		elsif (exists $config->{default}{default_mime}) {
+			return $config->{default}{default_mime};
+		}
+		### $meta
+	}
+	return $meta;
+}
+
+sub webm_type {
+	my ($doc_loc) = @_;
+	my $mime;
+	open my $fh, '<', $doc_loc
+		or warn "Cannot open webm ($doc_loc) for mime detection: $ERRNO"
+		and return;
+	read $fh, $mime, 1*$KBYTE
+		or warn "Cannot read webm ($doc_loc) for mime detection: $ERRNO"
+		and return;
+	close $fh
+		or warn "Cannot close file handle: $ERRNO";
+	if ($mime =~ m/V_VP9/) {
+		return 'video/VP9';
+	} elsif ($mime =~ m/V_VP8/) {
+		return 'video/VP8';
+	} else {
+		# fall back
+		return 'application/octet-stream';
+	}
+}
+
+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;
+	}
+}
+
+1;