Able to listen to more than one ip address, port. VHost adjustable

3 files changed, 157 insertions, 39 deletions

diff --git a/TO_FIX.md b/TO_FIX.md
index caad1fd..b610871 100644
--- a/TO_FIX.md
+++ b/TO_FIX.md
@@ -6,8 +6,6 @@ gmi.pl needs to accept an arguemnt, where the config.toml is located.
 
 remove magic numbers
 
-Be able to listen on more ports and different ip addresses -- make vhost adjustable.
-
 make log output user adjustable
 
 add client certificate stuff
diff --git a/config.toml.sample b/config.toml.sample
index adcc44b..fea0fb5 100644
--- a/config.toml.sample
+++ b/config.toml.sample
@@ -1,8 +1,11 @@
 [default]
-# only one bind addr for now.
-bind = '0.0.0.0'
-# only one port for now.
-ports = [1965]
+# Can be more than one bind, however beware:
+# '::' 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 = '::'
+# 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']
 
@@ -22,7 +25,7 @@ cert_key_dir = "certs" # avoid putting final '/'
 # Setting the following to 'false' will not emit an error.
 cert_key_dir_write_warning = true
 # For each accepted connection a fork() is called. This toggles if that should happen or not.
-# For debugging or memory reasons, it may help to set this to false, though it may result in clients timing out  # if your server is busy serving a client.
+# For debugging or memory reasons, it may help to set this to false, though it may result in clients timing out
 # Will cause 'timed-out' and 'sysread failed' to appear at the same time in log files.
 fork = true
 # When the server accept()s the client needs to send, per the Gemini spec: '<URL><CR><LF>'
@@ -51,7 +54,7 @@ default_mime = 'text/plain'
 
 # A Vhost is *required* since it both serves as vhost and server name identification (sni)
 # Vhost example - probably you want to see that it actually works right away
-# `$ ncat --ssl localhost 1965'. Quick! You have 5 seconds! type: 'gemini://localhost ' (don't forget the whitespace as required by gemini spec)
+# `$ ncat --ssl localhost 1965'. Quick! You have 5 seconds! type: 'gemini://localhost ' (don't forget the whitespace)
 # (ncat (probably) packaged with nmap)
 ['localhost']
 # Generate certificate and key automatically? Uses cert_key_dir
@@ -61,6 +64,8 @@ assume_index = true
 
 # A more realistic example
 #['example.com']
+#bind = ['172.16.0.53', '10.43.14.32']
+#ports = [10000,10001,10002]
 #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 6d50ce7..4136b52 100755
--- a/gmi.pl
+++ b/gmi.pl
@@ -7,12 +7,13 @@ use warnings;
 use 5.010;
 #use diagnostics;
 
-our $VERSION = 'v0.0.13';
+our $VERSION = 'v0.0.14';
 
 # Modules
 use IO::Socket::SSL; # CPAN
 use IO::Socket::SSL::Utils; # CPAN
 use IO::Socket::IP -register;
+use IO::Select;
 use URL::XS qw(parse_url split_url_path parse_url_query); # CPAN
 use Path::Naive qw(normalize_path); # CPAN
 #use Smart::Comments; # CPAN
@@ -26,6 +27,8 @@ use English qw( -no_match_vars );
 use Const::Fast;
 use Carp;
 
+# $IO::Socket::SSL::DEBUG = 15;
+
 local $PROGRAM_NAME = 'jakes-gemini-server';
 # Not worried about fork()-ed children
 local $SIG{CHLD} = 'IGNORE';
@@ -60,7 +63,7 @@ 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/;
 const our @VALID_VHOST_SETTINGS =>
-	qw/auto_cert assume_index dir_listing root cert key default_mime/;
+	qw/auto_cert assume_index dir_listing root cert key default_mime bind ports/;
 
 my ($config, $err) = from_toml(_slurp('./config.toml'));
 if ($err) {
@@ -68,14 +71,20 @@ if ($err) {
 }
 ### $config
 
-my %ssl_config = ssl_config($config);
-my %ip_config = ip_config($config);
+
 my $working_dir = working_dir($config);
 my $cert_key_dir = cert_key_dir($config);
 my $out = logging($config);
-my $timeout = timeout_secs($config);
 select $out; ## no critic (InputOutput::ProhibitOneArgSelect)
 local $OUTPUT_AUTOFLUSH = 1;
+
+my $timeout = timeout_secs($config);
+
+my $listen_config = listen_config($config); #, %ssl_config, %ip_config);
+### $listen_config
+my @srv = ip_config($listen_config);
+
+my %ssl_config = ssl_config($config);
 ssl_vhost_cert_key(\%ssl_config);
 
 my $fork_toggled = fork_toggle($config);
@@ -89,8 +98,12 @@ my $ft = File::Type->new();
 
 my $log;
 
-my $srv = IO::Socket::IP->new(%ip_config)
-	or die "error=$ERRNO";
+my $sel = IO::Select->new();
+for my $lsn (@srv) {
+	## no critic (DoubleSigil)
+	$sel->add(IO::Socket::IP->new(%$lsn))
+		or die "$ERRNO";
+}
 
 say "$PROGRAM_NAME ($VERSION) started on ". localtime;
 if (! $fork_toggled) {
@@ -98,12 +111,19 @@ if (! $fork_toggled) {
 }
 
 # Main server loop
-while () {
-	my $cl = $srv->accept or next;
+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;
+
 	maybe_fork() and next;
 
 	my $clhost = $cl->peerhost();
 
+	### before start_SSL
 	IO::Socket::SSL->start_SSL($cl, %ssl_config)
 		or do {
 			# TODO: user log format
@@ -112,10 +132,18 @@ while () {
 			exit if ($fork_toggled);
 			next;
 		};
+	### 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)) {
+		# TODO: user log format
+		$log = "$clhost - ($cl_sni) client request on wrong port";
+		speak($cl, 'proxy_req_refused');
+		goto CLOSE;
+	}
+
 	my $url;
 	my $path;
 	my $data;
@@ -181,7 +209,7 @@ while () {
 	exit if ($fork_toggled);
 }
 
-$srv->close();
+#$srv->close();
 
 sub respond_to_client {
 	my ($cl, $vhost, $doc_loc, $path) = @_;
@@ -567,26 +595,22 @@ sub ssl_config {
 }
 
 sub ip_config {
-	my ($conf_ref) = @_;
-	my %ip = (
-		LocalAddr => '0.0.0.0',
-		LocalPort => $DEFAULT_GEMINI_PORT,
-		Listen => 10,
-		Timeout => 5, # !! Nothing to do with config option !!
-		              # used when a connection to the socket doesnt do anything
-	);
-	for my $item (keys %{ $conf_ref->{default} }) {
-		if ($item eq 'bind') {
-			$ip{LocalAddr} = $conf_ref->{default}{bind};
-		}
-		elsif ($item eq 'ports') {
-			for my $port ( @{ $conf_ref->{default}{ports} } ) {
-				# TODO; enable more than one port.
-				$ip{LocalPort} = $conf_ref->{default}{ports}[0];
-			}
-		}
-	}
-	return %ip;
+	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
+	return @a;
 }
 
 sub logging {
@@ -805,4 +829,95 @@ sub timeout_secs {
 	}
 }
 
-1;
+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});
+	}
+	else {
+		# Listen to all
+		push @default_bind, '::';
+	}
+	if (exists $conf_ref->{default}{ports}) {
+		push @default_ports, give_array($conf_ref->{default}{ports});
+	}
+	else {
+		push @default_ports, $DEFAULT_GEMINI_PORT;
+	}
+
+	for my $vhost (keys %{ $conf_ref }) {
+		next if ($vhost eq 'default');
+
+		# Vhost's port and vhost's bind or default's bind
+		if (exists $conf_ref->{$vhost}{ports}) {
+			for my $port (give_array($conf_ref->{$vhost}{ports})) {
+				# Vhost has bind
+				if (exists $conf_ref->{$vhost}{bind}) {
+					for my $bind (give_array($conf_ref->{$vhost}{bind})) {
+						push @{ $listen{$bind}{$port} }, $vhost;
+					}
+				}
+				# vhost does not have bind - use default
+				else {
+					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;
+				}
+			}
+		}
+		# vhost uses default everything
+		else {
+			for my $port (@default_ports) {
+				for my $bind (@default_bind) {
+					push @{ $listen{$bind}{$port} }, $vhost;
+				}
+			}
+		}
+	}
+	# ## %listen
+	return \%listen;
+}
+
+sub give_array {
+	my ($ref) = @_;
+
+	## no critic (Cascading, DoubleSigil)
+	if (ref $ref eq 'ARRAY') {
+		return @$ref;
+	}
+	elsif (ref $ref eq 'SCALAR') {
+		return ( $ref );
+	}
+	elsif (ref \$ref eq 'ARRAY') {
+		return @$ref;
+	}
+	elsif (ref \$ref eq 'SCALAR') {
+		return ( $ref );
+	}
+	else {
+		confess 'not array or scalar nor a reference to such.';
+	}
+}
+
+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;
+		}
+	}
+	return 0;
+}