Add UNIX sockets

Comment out Smart::Comments

3 files changed, 175 insertions, 44 deletions

diff --git a/TO_FIX.md b/TO_FIX.md
index b610871..cc0d880 100644
--- a/TO_FIX.md
+++ b/TO_FIX.md
@@ -23,3 +23,5 @@ check values for keys in config file
 redirection via config
 
 handle signals like interrupt better
+
+reduce complexity in listen_config()
diff --git a/config.toml.sample b/config.toml.sample
index fea0fb5..cdbe8bf 100644
--- a/config.toml.sample
+++ b/config.toml.sample
@@ -3,11 +3,19 @@
 # '::' and/or '0.0.0.0' is a 'bind' to all ('::' seems to work for IPv4 as well) - vhost with their own bind and the same ports will result in an error.
 # 'Address already in use' or something similar.
 # To bind to more than one address, make the value an array ie: ['192.168.0.24', '10.0.1.1']
+# bind can also be set to 'no' which means if vhosts are to be accessed via internet, the vhost will need their own bind option.
 bind = '::'
 # To bind to more than one port, make the value an array ie: [1965, 1966, 1967]
 ports = 1965
 # Can specify one or both of these.
 tls = ['v1.2', 'v1.3']
+# UNIX socket, will make all vhost accessible via this socket unless they have their own 'unix' parameter.
+# Ports parameter will not matter in regards to unix socket.
+# unix can be set to 'no' where it will not make an unix socket, although vhost can have their own unix parameter.
+# The path of the unix socket needs to be readable/writable.
+# If the socket file exists when attempting to use it then this program will delete that file and make a new one.
+# By default, if unix does not exist, there will be no unix socket.
+unix = 'no'
 
 ## The following options are specific to default and will not work with vhost 
 # Working dir is used as a relative location if a 'pathy' option (like log_file) is not absolute.
@@ -64,8 +72,12 @@ assume_index = true
 
 # A more realistic example
 #['example.com']
+# bind can be set to a string or a list or 'no' which will not be accessible via IP address.
 #bind = ['172.16.0.53', '10.43.14.32']
 #ports = [10000,10001,10002]
+# example.com can only be accesed through this socket, other vhost
+# unix can be set to some path or to 'no' which will not include it in default's unix path if it is set.
+#unix = '/some/other/path/to/unix.sock'
 #auto_cert = false
 # Location to the cert/key pair is relative to cert_key_dir unless the path is absolute
 # The existance of cert and key option will cause auto_cert to be ignored.
diff --git a/gmi.pl b/gmi.pl
index 94c391e..971bc63 100755
--- a/gmi.pl
+++ b/gmi.pl
@@ -7,12 +7,13 @@ use warnings;
 use 5.010;
 #use diagnostics;
 
-our $VERSION = 'v0.14.0';
+our $VERSION = 'v0.15.1';
 
 # Modules
 use IO::Socket::SSL; # CPAN
 use IO::Socket::SSL::Utils; # CPAN
 use IO::Socket::IP -register;
+use IO::Socket::UNIX;
 use IO::Select;
 use URL::XS qw(parse_url split_url_path parse_url_query); # CPAN
 use Path::Naive qw(normalize_path); # CPAN
@@ -27,7 +28,7 @@ use English qw( -no_match_vars );
 use Const::Fast;
 use Carp;
 
-# $IO::Socket::SSL::DEBUG = 15;
+#$IO::Socket::SSL::DEBUG = 15;
 
 local $PROGRAM_NAME = 'jakes-gemini-server';
 # Not worried about fork()-ed children
@@ -61,9 +62,11 @@ const our %GEM_RES_CODES => (
 
 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 timeout/;
+	log_file log_to_stdout default_mime cert_key_dir_write_warning fork timeout
+	unix/;
 const our @VALID_VHOST_SETTINGS =>
-	qw/auto_cert assume_index dir_listing root cert key default_mime bind ports/;
+	qw/auto_cert assume_index dir_listing root cert key default_mime bind ports
+	unix/;
 
 my ($config, $err) = from_toml(_slurp('./config.toml'));
 if ($err) {
@@ -82,7 +85,9 @@ my $timeout = timeout_secs($config);
 
 my $listen_config = listen_config($config); #, %ssl_config, %ip_config);
 ### $listen_config
+
 my @srv = ip_config($listen_config);
+### @srv
 
 my %ssl_config = ssl_config($config);
 ssl_vhost_cert_key(\%ssl_config);
@@ -92,18 +97,14 @@ my $fork_toggled = fork_toggle($config);
 # let the user know if an invalid option was used
 check_config_keys($config);
 
-### %ssl_config
+# ## %ssl_config
 
 my $ft = File::Type->new();
 
 my $log;
 
 my $sel = IO::Select->new();
-for my $lsn (@srv) {
-	## no critic (DoubleSigil)
-	$sel->add(IO::Socket::IP->new(%$lsn))
-		or die "$ERRNO";
-}
+select_add_listen($sel, @srv);
 
 say "$PROGRAM_NAME ($VERSION) started on ". localtime;
 if (! $fork_toggled) {
@@ -115,13 +116,15 @@ while (my @ready = $sel->can_read) {
 	my $cl;
 
 	my $fh = shift @ready;
-	my $fh_sockhost = $fh->sockhost;
-	my $fh_port = $fh->sockport;
 	$cl = $fh->accept;
+	my ($fh_sockhost, $fh_port, $clhost, $clport) = get_fh_data($fh, $cl);
 
-	maybe_fork() and next;
+	### $fh_sockhost
+	### $fh_port
+	### $clhost
+	### $clport
 
-	my $clhost = $cl->peerhost();
+	maybe_fork() and next;
 
 	### before start_SSL
 	IO::Socket::SSL->start_SSL($cl, %ssl_config)
@@ -134,7 +137,6 @@ while (my @ready = $sel->can_read) {
 		};
 	### nice, start_SSL worked
 
-	my $clport = $cl->peerport();
 	my $cl_sni = $cl->get_servername();
 
 	if (! check_fh_port_with_host_listen_port($cl_sni, $fh_sockhost, $fh_port)) {
@@ -157,7 +159,6 @@ while (my @ready = $sel->can_read) {
 	# ALRM interrupts this
 	sysread $cl, $data, $KBYTE
 		or $data = '';
-
 	alarm 0;
 
 	if ($timedout) {
@@ -200,8 +201,16 @@ while (my @ready = $sel->can_read) {
 
 	respond_to_client($cl, $vhost, $doc_loc, $path);
 	CLOSE:
-	$cl->stop_SSL or warn "error: $ERRNO,  ssl_error: $SSL_ERROR";
-	$cl->shutdown('SHUT_RDWR');
+	if (ref $fh ne 'IO::Socket::UNIX') {
+		# stop_SSL doesnt work with IO::Socket::UNIX for some reason, 
+		# but shutdown does. stop_SSL is supposed to return $cl to 
+		# it's original class (ie IO::Socket::UNIX or IO::Socket::IP)
+		$cl->stop_SSL or warn "error: $ERRNO,  ssl_error: $SSL_ERROR";
+		$cl->shutdown('SHUT_RDWR');
+	}
+	else {
+		$cl->close( (SSL_fast_shutdown=>0) );
+	}
 	### $cl
 
 	say "$log [". localtime(). ']';
@@ -597,19 +606,42 @@ sub ssl_config {
 sub ip_config {
 	my ($listening_ref) = @_;
 	my @a;
-	for my $ip (keys %{ $listening_ref }) {
-		for my $port (keys %{ $listening_ref->{$ip} }) {
-			my %listener = (
-				LocalAddr => $ip,
-				LocalPort => $port,
-				Listen => 10,
-				Timeout => 5, # !! Nothing to do with config option !!
-				              # used when a connection to the socket doesnt do anything
-			);
-			push @a, \%listener;
-		}
-	}
-	### @srv
+	my %paths;
+	for my $socket (keys %{ $listening_ref }) {
+		# if IP socket
+		if ($socket ne 'unix') {
+			for my $port (keys %{ $listening_ref->{$socket} }) {
+				my %listener = (
+					LocalAddr => $socket,
+					LocalPort => $port + 0, # coax into number
+					Listen => 10,
+					Timeout => 5, # !! Nothing to do with config option !!
+					              # used when a connection to the socket doesnt do anything
+				);
+				push @a, \%listener;
+			}
+		}
+		# else an UNIX socket
+		else {
+			for my $unix (keys %{ $listening_ref->{unix}{path} }) {
+				if (exists $paths{ $listening_ref->{unix}{path}{$unix} }) {
+					next;
+				}
+				else {
+					$paths{ $listening_ref->{unix}{path}{$unix} } = 1;
+					## no critic (RequireCheckedSyscalls) # doesn't matter if success or not
+					unlink $listening_ref->{unix}{path}{$unix};
+					my %listener = (
+						Type => SOCK_STREAM(),
+						Local => $listening_ref->{unix}{path}{$unix},
+						Listen => 1,
+					);
+					push @a, \%listener
+				}
+			}
+		### %paths
+		}
+	}
 	return @a;
 }
 
@@ -829,14 +861,18 @@ sub timeout_secs {
 	}
 }
 
+## no critic (Complex, DeepNest)
 sub listen_config {
 	my ($conf_ref, $ssl_ref, $ip_ref) = @_;
 	my %listen;
 	my @default_bind;
 	my @default_ports;
-	if (exists $conf_ref->{default}{bind}) {
-			#@default_bind = give_array($conf_ref->{default}{bind});
-			push @default_bind, give_array($conf_ref->{default}{bind});
+	if (exists $conf_ref->{default}{bind} and $conf_ref->{default}{bind} ne 'no') {
+		#@default_bind = give_array($conf_ref->{default}{bind});
+		push @default_bind, give_array($conf_ref->{default}{bind});
+	}
+	elsif (exists $conf_ref->{default}{bind} and $conf_ref->{default}{bind} eq 'no') {
+		;
 	}
 	else {
 		# Listen to all
@@ -849,6 +885,11 @@ sub listen_config {
 		push @default_ports, $DEFAULT_GEMINI_PORT;
 	}
 
+	if (exists $conf_ref->{default}{unix} and $conf_ref->{default}{unix} ne 'no') {
+		#$listen{unix}{default}{path} = $conf_ref->{default}{unix};
+		$listen{unix}{path}{default} = $conf_ref->{default}{unix};
+	}
+
 	for my $vhost (keys %{ $conf_ref }) {
 		next if ($vhost eq 'default');
 
@@ -856,26 +897,36 @@ sub listen_config {
 		if (exists $conf_ref->{$vhost}{ports}) {
 			for my $port (give_array($conf_ref->{$vhost}{ports})) {
 				# Vhost has bind
-				if (exists $conf_ref->{$vhost}{bind}) {
+				if (exists $conf_ref->{$vhost}{bind} and $conf_ref->{$vhost}{bind} ne 'no') {
 					for my $bind (give_array($conf_ref->{$vhost}{bind})) {
 						push @{ $listen{$bind}{$port} }, $vhost;
 					}
 				}
+				elsif (exists $conf_ref->{$vhost}{bind} and $conf_ref->{$vhost}{bind} eq 'no') {
+					;
+				}
 				# vhost does not have bind - use default
 				else {
-					for my $bind (@default_bind) {
-						push @{ $listen{$bind}{$port} }, $vhost;
+					if (@default_bind) {
+						for my $bind (@default_bind) {
+							push @{ $listen{$bind}{$port} }, $vhost;
+						}
 					}
 				}
 			}
 		}
 		# vhost's bind and default ports
 		elsif (exists $conf_ref->{$vhost}{bind}) {
-			for my $bind (give_array($conf_ref->{$vhost}{bind})) {
-				for my $port (@default_ports) {
-					push @{ $listen{$bind}{$port} }, $vhost;
+			if ($conf_ref->{$vhost}{bind} ne 'no') {
+				for my $bind (give_array($conf_ref->{$vhost}{bind})) {
+					for my $port (@default_ports) {
+						push @{ $listen{$bind}{$port} }, $vhost;
+					}
 				}
 			}
+			elsif ($conf_ref->{$vhost}{bind} eq 'no') {
+				;
+			}
 		}
 		# vhost uses default everything
 		else {
@@ -885,10 +936,24 @@ sub listen_config {
 				}
 			}
 		}
+
+		# check vhost unix socket otherwise check for default unix socket
+		if (exists $conf_ref->{$vhost}{unix}) {
+			for my $unix_sock_path (give_array($conf_ref->{$vhost}{unix})) {
+				if ($unix_sock_path ne 'no') {
+					$listen{unix}{path}{$vhost} = $unix_sock_path;
+					push @{ $listen{unix}{listen} }, $vhost;
+				}
+			}
+		}
+		elsif (exists $listen{unix}{path}{default} and $listen{unix}{path}{default} ne 'no') {
+			push @{ $listen{unix}{listen} }, $vhost;
+		}
 	}
 	# ## %listen
 	return \%listen;
 }
+## use critic
 
 sub give_array {
 	my ($ref) = @_;
@@ -913,11 +978,63 @@ sub give_array {
 
 sub check_fh_port_with_host_listen_port {
 	my ($sni, $fh_sockhost, $fh_port) = @_;
-
-	for my $dns_host (@{ $listen_config->{$fh_sockhost}{$fh_port} }) {
-		if ($dns_host eq $sni) {
-			return 1;
+	if ($fh_sockhost ne 'UNIX') {
+		for my $dns_host (@{ $listen_config->{$fh_sockhost}{$fh_port} }) {
+			if ($dns_host eq $sni) {
+				return 1;
+			}
+		}
+	}
+	else {
+		for my $dns_host (@{ $listen_config->{unix}{listen} }) {
+			### $dns_host
+			### $sni
+			# explictly given a unix path
+			if (($dns_host eq $sni) and exists $listen_config->{unix}{path}{$sni}) {
+				return 1;
+			}
+			# default's unix path
+			elsif (($dns_host eq $sni) and exists $listen_config->{unix}{path}{default}) {
+				return 1;
+			}
 		}
 	}
 	return 0;
 }
+
+sub get_fh_data {
+	my ($fh, $cl) = @_;
+	my $fh_sockhost;
+	my $fh_port;
+	my $clhost;
+	my $clport;
+	if (ref $fh eq 'IO::Socket::IP') {
+		$fh_sockhost = $fh->sockhost;
+		$fh_port = $fh->sockport;
+		$clhost = $cl->peerhost();
+		$clport = $cl->peerport();
+	} elsif (ref $fh eq 'IO::Socket::UNIX') {
+		$fh_sockhost = 'UNIX';
+		$fh_port = 'UNIX';
+		$clhost = $cl->hostpath();
+		$clport = 'UNIX';
+	}
+	return $fh_sockhost, $fh_port, $clhost, $clport;
+}
+
+sub select_add_listen {
+	my ($sell, @srvv) = @_;
+	for my $lsn (@srvv) {
+		### $lsn
+		## no critic (DoubleSigil)
+		if (exists $lsn->{LocalAddr}) {
+			$sell->add(IO::Socket::IP->new(%$lsn))
+				or die "$ERRNO";
+		}
+		elsif (exists $lsn->{Local}) {
+			$sell->add(IO::Socket::UNIX->new(%$lsn))
+				or die "$ERRNO";
+		}
+	}
+	return;
+}