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

1 files changed, 146 insertions, 31 deletions

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