Add UNIX sockets

Comment out Smart::Comments

1 files changed, 161 insertions, 44 deletions

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;
+}