aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorjake <jake@jakes-mail.top>2022-01-30 21:37:28 -0500
committerjake <jake@jakes-mail.top>2022-01-30 21:37:28 -0500
commitd3331e07e7f2d7a77cb5eabe7af84ec6942a5018 (patch)
tree68bea650218c15ae60beec1af16397531df05f10
parentd7ba1380e1da738d1e614757e3a6308a891ef2ef (diff)
examine the host's cert with peer_cert()
-rwxr-xr-xgmi.pl134
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 {