examine the host's cert with peer_cert()

1 files changed, 113 insertions, 21 deletions

diff --git a/gmi.pl b/gmi.pl
index baac889..4f0e8d3 100755
--- a/gmi.pl
+++ b/gmi.pl
@@ -10,7 +10,7 @@ use warnings;
 use feature qw(refaliasing);
 no warnings qw(experimental::refaliasing);
 
-our $VERSION = 'v0.0.27';
+our $VERSION = 'v0.0.28';
 
 # TODO: 
 # back() only works once; should fix this
@@ -56,6 +56,7 @@ my $timeout = 3;
 my $use_cert = 0;
 my $cert;
 my $key;
+my %known_hosts;
 
 my $term=new Term::ReadLine "hmm, what goes here?";
 my $OUT = $term->OUT || \*STDOUT;
@@ -241,34 +242,125 @@ sub url {
 		### $url
 
 		undef(@doc);
-	
-		eval {
-			local $SIG{ALRM} = sub {close ($cl); unshift(@doc,""); die "TIMEOUT";};
-			alarm $timeout;
-
-			# gemini spec: <URL><CR><LF>
-			# <URL> is an absolute path
-			print $cl "$current_url\r\n";
+		if (peer_cert($cl, $url->{host})) {
 
-			@doc = <$cl>;
+			eval {
+				local $SIG{ALRM} = sub {close ($cl); unshift(@doc,""); die "TIMEOUT";};
+				alarm $timeout;
+	
+				# gemini spec: <URL><CR><LF>
+				# <URL> is an absolute path
+				print $cl "$current_url\r\n";
+	
+				@doc = <$cl>;
+	
+				close($cl); # if this isnt here, the kernel will have to clean up unused ports
+	
+				alarm 0;
+			};
+	
+			if ($@) {
+				print $OUT "Timed out after $timeout seconds - server is taking too long.\n";
+				update_history( ["$current_url", "timed out"] );
+				### @doc
+			} else {
+				follow_status_code();
+			}
+		}
+		else {
+			print $OUT "Not connecting\n";
+		}
+	}
 
-			close($cl); # if this isnt here, the kernel will have to clean up unused ports
+	else {
+		print $OUT "error=$!, ssl_error=$SSL_ERROR\n";
+	}
+}
 
-			alarm 0;
-		};
+sub peer_cert {
+	# 1. compare figureprint if possible
+	# 2. is it expired?
+	# 3. if error: ask user for imput
+	my ($cl, $hostname) = @_;
+	my $peer_cert = CERT_asHash($cl->peer_certificates);
+	# IO::Socket::SSL::Utils already has done fingerprinting so we do not need to.
+	my $peer_fingerprint = $peer_cert->{fingerprint_sha256}; 
+	my $peer_not_before = $peer_cert->{not_before};
+	my $peer_not_after = $peer_cert->{not_after};
+	my $peer_commonName = $peer_cert->{subject}->{commonName};
+	my $peer_subjectAltNames = $peer_cert->{subjectAltNames};
+	### $peer_cert
+	### $peer_fingerprint
+	### $peer_not_before
+	### $peer_not_after
+	### $peer_commonName
+	### $peer_subjectAltNames
+
+	if ($hostname ne $peer_commonName) {
+		### hostname is not commonName
+		my $counter = 0;
+		my $subjectAltName = 0;
+		for (@$peer_subjectAltNames) {
+			if ($peer_subjectAltNames->[$counter][0] eq 'DNS') {
+				if (lc $peer_subjectAltNames->[$counter][1] eq lc $hostname) {
+					### Good subjectAltName
+					$subjectAltName = 1;
+				}
+			}
+			$counter++;
+		}
+		if (! $subjectAltName) {
+			print $OUT "The server offers a cert that doesn't match their domain name.\n";
+			return 0;
+		}
+	}
 
-		if ($@) {
-			print $OUT "Timed out after $timeout seconds - server is taking too long.\n";
-			update_history( ["$current_url", "timed out"] );
-			### @doc
-		} else {
-			follow_status_code();
+	# compare figureprint...
+	if ($known_hosts{$hostname}) {
+		# user HAS visited this domain before
+		if ($known_hosts{$hostname} eq $peer_fingerprint) {
+			# fingerprint same
+			;
+		}
+		else {
+			# fingerprint NOT same
+			print $OUT colored("!!! THE HOSTS FINGERPRINT IS NOT THE SAME !!!\n", 'bright_red');
+			print $OUT "Do you still wish to connect to it? y/N ";
+			chomp(my $yORn = <STDIN>);
+			if (lc $yORn eq 'y') {
+				print $OUT "Would you like to replace the current fingerprint with this one? y/N ";
+				chomp(my $yORn = <STDIN>);
+				if (lc $yORn eq 'y') {
+					$known_hosts{$hostname} = $peer_fingerprint;
+				}
+			}
+			else {
+				return 0;
+			}
 		}
 	}
-	
 	else {
-		print $OUT "error=$!, ssl_error=$SSL_ERROR\n";
+		# user has NOT visited this domain before TOFU
+		$known_hosts{$hostname} = $peer_fingerprint;
+	}
+
+	# check expiratory
+	if ($peer_not_before < $peer_not_after) {
+		### not expired
+		;
+	}
+	else {
+		### expired!
+		print $OUT "The host has an expired certificate. Connect anyway? y/N ";
+		chomp(my $yORn = <STDIN>);
+		if (lc $yORn eq 'y') {
+			;
+		}
+		else {
+			return 0;
+		}
 	}
+	return 1;
 }
 
 sub follow_status_code {