diff options
Diffstat (limited to 'gmi.pl')
| -rwxr-xr-x | gmi.pl | 134 |
1 files changed, 113 insertions, 21 deletions
@@ -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 { |