Remove 'root_relative'. Touch up cert_key_dir logic.

Touch up code that used 'root_relative'.
Add cert_key_dir_write_warning option.
Determine if a path is absolute or relative by the first character.

1 files changed, 101 insertions, 63 deletions

diff --git a/gmi.pl b/gmi.pl
index f8d97c9..2ccb072 100755
--- a/gmi.pl
+++ b/gmi.pl
@@ -7,7 +7,7 @@ use warnings;
 use 5.010;
 #use diagnostics;
 
-our $VERSION = 'v0.0.3b';
+our $VERSION = 'v0.0.4';
 
 # Modules
 use IO::Socket::SSL; # CPAN
@@ -49,10 +49,10 @@ our %GEM_RES_CODES = (
 );
 
 our @VALID_DEFAULT_SETTINGS = 
-	qw/bind ports tls assume_index dir_listing root root_relative working_dir cert_key_dir 
-	log_file log_to_stdout default_mime/;
+	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/;
 our @VALID_VHOST_SETTINGS = 
-	qw/auto_cert assume_index dir_listing root root_relative cert key default_mime/;
+	qw/auto_cert assume_index dir_listing root cert key default_mime/;
 
 my $ft = File::Type->new();
 
@@ -139,26 +139,38 @@ else {
 
 my $cert_key_dir;
 if (exists $config->{default}{cert_key_dir}) {
+	my $p = abs_or_rel($config->{default}{cert_key_dir});
 	# Absolute
-	if (substr($config->{default}{cert_key_dir},0,1) eq '/') {
+	if ($p eq 'abs') {
 		$cert_key_dir = $config->{default}{cert_key_dir};
 	}
 	# Relative
-	else {
+	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 -w $cert_key_dir and -x $cert_key_dir) {
-	;
+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;
+	mkdir $cert_key_dir
+		or die "Could not create cert_key_dir ($cert_key_dir) - $!";
 } else {
-	die "cert_key_dir option ($cert_key_dir) is not all of these: ".
-	"directory, readable, writable or executeable.";
+	die "cert_key_dir ($cert_key_dir) is not all of these: ".
+	"directory, readable, or executeable.";
 }
 
 # Logging
@@ -177,80 +189,89 @@ $| = 1; # Making the *current* Filehandle 'hot' so Perl flushes the buffer immed
 my $log;
 
 # VirtualHosts
-for my $item (keys %{ $config }) {
-	next if ($item eq 'default');
+for my $vhost (keys %{ $config }) {
+	next if ($vhost eq 'default');
 	my $error_free = 1;
 	my $cert_loc;
 	my $key_loc;
 
-	if (exists $config->{$item}{cert} and exists $config->{$item}{key}) {
+	if (exists $config->{$vhost}{cert} and exists $config->{$vhost}{key}) {
 
-		# checking if absolute location
-		if (substr($config->{$item}{cert},0,1) eq '/') {
-			if (-e $config->{$item}{cert}) {
-				$cert_loc = $config->{$item}{cert};
+		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 "'$config->{$item}{cert}' does not exist.";
+				say STDERR "'$config->{$vhost}{cert}' for '$vhost' does not exist.";
 				$error_free = 0;
 			}
 		}
-		if (substr($config->{$item}{key},0,1) eq '/') {
-			if (-e $config->{$item}{key}) {
-				$key_loc = $config->{$item}{key};
-			}
+		elsif ($p_c eq 'rel') {
+			if (-e "$cert_key_dir/$config->{$vhost}{cert}") {
+				$cert_loc = "$cert_key_dir/$config->{$vhost}{cert}";
+			} 
 			else {
-				say "'$config->{$item}{key}' does not exist.";
+				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;
+		}
 
-		# Is it relative?
-		if (! $cert_loc or ! $key_loc) {
-			if (-e "$cert_key_dir/$config->{$item}{cert}") {
-				$cert_loc = "$cert_key_dir/$config->{$item}{cert}";
-			} 
+		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 "'$cert_key_dir/$config->{$item}{cert}' does not exist.";
+				say STDERR "'$config->{$vhost}{key}' does not exist.";
 				$error_free = 0;
 			}
-
-			if (-e "$cert_key_dir/$config->{$item}{key}") {
-				$key_loc = "$cert_key_dir/$config->{$item}{key}";
+		}
+		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->{$item}{key}' does not exist.";
+				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->{$item}{auto_cert} and $config->{$item}{auto_cert} ne 'false') {
+		if (exists $config->{$vhost}{auto_cert} and $config->{$vhost}{auto_cert} eq 'true') {
 			# manage cert for user
-			$cert_loc = "$cert_key_dir/$item". '_cert.pem';
-			$key_loc = "$cert_key_dir/$item". '_key.pem';
+			$cert_loc = "$cert_key_dir/$vhost". '_cert.pem';
+			$key_loc = "$cert_key_dir/$vhost". '_key.pem';
 
 			if (! -e $cert_loc or ! -e $key_loc) {
-				say $out "$item cert/key pair generated in '$cert_key_dir'.";
-				gen_cert($item, $cert_key_dir)
+				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 "$item only has one part of a cert/key pair and/or auto_cert is not enabled.";
+			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}{$item} = $cert_loc;
-		$ssl_config{SSL_key_file}{$item} = $key_loc;
+		$ssl_config{SSL_cert_file}{$vhost} = $cert_loc;
+		$ssl_config{SSL_key_file}{$vhost} = $key_loc;
 	}
 	else {
-		say STDERR "Will not use cert/key for $item";
+		say STDERR "$vhost: Will will not be listening for incoming requests.";
 	}
 }
 
@@ -532,30 +553,40 @@ sub get_request_in_vhost_root {
 	}
 	### $r
 
-	# relative to working_dir
-	if (exists $config->{$vhost}{root} and exists $config->{$vhost}{root_relative} and
-							$config->{$vhost}{root_relative} eq 'true')
-	{
-		my $work_loc = "$working_dir/$config->{$vhost}{root}";
-		is_exists_and_readable("$work_loc/$r") ? return "$work_loc/$r" : return undef;
-	}
-
-	# not relative to working_dir
-	elsif (exists $config->{$vhost}{root} and (not exists $config->{$vhost}{root_relative} or 
-						$config->{$vhost}{root_relative} eq 'false')) 
-	{
-		my $work_loc = "$config->{$vhost}{root}";
-		is_exists_and_readable("$work_loc/$r") ? return "$work_loc/$r" : return undef;
+	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;
+		}
 	}
-
-	# use default's root
-	elsif (not exists $config->{$vhost}{root}) {
-		my $work_loc = "$working_dir/$config->{default}{root}";
-		is_exists_and_readable("$work_loc/$r") ? return "$work_loc/$r" : return undef;
+	
+	# 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;
+		}
 	}
 
 	else {
-		warn "$vhost has improper root/root_relative settings.";
+		say STDERR "default has improper root settings.";
 		return 0;
 	}
 }
@@ -675,3 +706,10 @@ sub check_vhost_settings {
 	}
 
 }
+
+sub abs_or_rel {
+	my ($p) = @_;
+	return undef unless (defined $p);
+
+	substr($p,0,1) eq '/' ? return 'abs' : return 'rel';
+}