summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--TO_FIX.md6
-rw-r--r--config.toml.sample28
-rwxr-xr-xgmi.pl132
3 files changed, 158 insertions, 8 deletions
diff --git a/TO_FIX.md b/TO_FIX.md
index 8ebd90d..af0e0c1 100644
--- a/TO_FIX.md
+++ b/TO_FIX.md
@@ -8,8 +8,6 @@ remove magic numbers
make log output user adjustable
-add client certificate stuff
-
add gmiaccess stuff
add cgi stuff
@@ -21,3 +19,7 @@ check if loaded cert/keys are actually valid
check values for keys in config file
handle signals like interrupt better
+
+recently-accepted-cert-cache for specific cert-req keys, doing a look up EACH and EVERY TIME can be expensive when it it likely that a single person will be looking around.
+
+reduce complexity in cert_req()
diff --git a/config.toml.sample b/config.toml.sample
index 3f22149..a75fc25 100644
--- a/config.toml.sample
+++ b/config.toml.sample
@@ -73,7 +73,7 @@ redirection = 'simple'
# Generate certificate and key automatically? Uses cert_key_dir
auto_cert = true
# Overrides default setting
-assume_index = true
+assume_index = true
# A more realistic example
#['example.com']
@@ -111,4 +111,28 @@ assume_index = true
# '/blog/2022/dec/(.+)' = '/blog/2022/jul/$1',
# # $1 $2 $3
# '/blog/(20..)/(.+)/(.+)' = '/newsgroup/$1-$2/$3',
-# }
+#}
+#
+#cert_req = {
+# # will accept ANY certificate
+# '/cert_required(.*) = 'any',
+# # Same as above but you can set the text that will accopany the header.
+# '/blog/secret(.*) = [
+# 'any', 'This is my secret place.'
+# ],
+# # Lock an area off with specific fingerprints (sha256)!
+# '/payment_club(.*)' = [
+# 'pubkey, 'Accepted members only',
+# # fingerprints (sha256) can have colons and be upper or lower case: program will normalize them.
+# '0b435dd2efc7c7569d97559c22d4a35abbd19cfd6d15d23989773a69df5556c2',
+# '...',
+# ],
+# # Suppose you have a LOT of pubkeys? This example will solve it.
+# '/secret_blog(.*)' = [
+# # file option allows you to specify files that should have a listing of accepted pubkeys
+# # the second option '0' just tells the server to serve default meta text
+# 'file', 0,
+# '../pubkeys1.txt',
+# '../pubkeys2.txt',
+# ],
+#}
diff --git a/gmi.pl b/gmi.pl
index 7fb9401..1cf1244 100755
--- a/gmi.pl
+++ b/gmi.pl
@@ -7,7 +7,7 @@ use warnings;
use 5.010;
#use diagnostics;
-our $VERSION = 'v0.16.2';
+our $VERSION = 'v0.17.0';
# Modules
use IO::Socket::SSL; # CPAN
@@ -59,6 +59,7 @@ const our %GEM_RES_CODES => (
'cert_req' => '60 Certificate Required',
'cert_unauth' => '61 Certificate Unauthorized',
'cert_invalid' => '62 Certificate Invalid',
+ 'custom' => '!s',
);
const our @VALID_DEFAULT_SETTINGS =>
@@ -67,7 +68,7 @@ const our @VALID_DEFAULT_SETTINGS =>
unix redirection redirect/;
const our @VALID_VHOST_SETTINGS =>
qw/auto_cert assume_index dir_listing root cert key default_mime bind ports
- unix redirection redirect/;
+ unix redirection redirect cert_req/;
my ($config, $err) = from_toml(_slurp('./config.toml'));
if ($err) {
@@ -103,6 +104,7 @@ check_config_keys($config);
my $ft = File::Type->new();
my $log;
+my $cl_cert;
my $sel = IO::Select->new();
select_add_listen($sel, @srv);
@@ -217,6 +219,7 @@ while (my @ready = $sel->can_read) {
say "$log [". localtime(). ']';
exit if ($fork_toggled);
+ undef $cl_cert;
}
#$srv->close();
@@ -224,6 +227,17 @@ while (my @ready = $sel->can_read) {
sub respond_to_client {
my ($cl, $vhost, $doc_loc, $path) = @_;
+ my ($cert_req, $cert_meta, $check_path) = cert_req($vhost, $path);
+ if ($cert_req) {
+ if ($cert_meta) {
+ speak($cl, 'custom', "60 $cert_meta");
+ }
+ else {
+ speak($cl, 'cert_req');
+ }
+ goto CLOSE;
+ }
+
my $redirection = redirection_parameter($vhost);
if ($redirection) {
my $redirect = check_for_config_redirection($vhost, $path, $redirection);
@@ -583,7 +597,11 @@ sub ssl_config {
my ($conf_ref) = @_;
my %ssl = (
SSL_version => '!SSLv2:!SSLv3:!TLSv1:!TLSv1_1',
+ SSL_server => 1,
Listen => 5,
+ # If peer sends us a cert, use the callback to accept it for future use.
+ SSL_verify_mode => SSL_VERIFY_PEER,
+ SSL_verify_callback => \&verify_cert_callback,
SSL_fast_shutdown => 1,
Timeout => 5, # !! Nothing to do with the config option !!
@@ -1043,9 +1061,9 @@ sub check_for_config_redirection {
if ($redirection >= 2) {
# regular expression compiling
for my $redirect (keys %{ $config->{$vhost}{redirect} }) {
- ### $redirect
+ # ## $redirect
my $redirect_replace = $config->{$vhost}{redirect}{$redirect};
- ### $redirect_replace
+ # ## $redirect_replace
my $regex_match;
#my $regex_replace;
@@ -1088,3 +1106,109 @@ sub redirection_parameter {
}
return;
}
+
+## no critic (unpack)
+sub verify_cert_callback {
+ ### @_;
+ ## perl arrays start at 0, not 1
+ #1. a true/false value that indicates what OpenSSL thinks of the certificate,
+ #2. a C-style memory address of the certificate store,
+ #3. a string containing the certificate's issuer attributes and owner attributes, and
+ #4. a string containing any errors encountered (0 if no errors).
+ #5. a C-style memory address of the peer's own certificate (convertible to PEM form with Net::SSLeay::PEM_get_string_X509()).
+ #6. The depth of the certificate in the chain. Depth 0 is the leaf certificate.
+ ## $pem
+ $cl_cert = CERT_asHash(PEM_string2cert(Net::SSLeay::PEM_get_string_X509($_[4])));
+ ### $cl_cert
+ return 1;
+}
+## use critic
+
+## no critic (deep, return, useless, complex)
+sub cert_req {
+ my ($vhost, $path) = @_;
+ $path ? ($path = "/$path") : ($path = '/');
+
+ if (exists $config->{$vhost}{cert_req}) {
+ my $cert_req = $config->{$vhost}{cert_req};
+ ### $cert_req
+ for my $key (keys %{ $cert_req }) {
+ ### $key
+ ### $path
+ my $regex = qr{$key};
+ if ($path =~ m/$regex/) {
+ ### yep, that path matched that key
+ my ($req, $meta);
+ if (ref $cert_req->{$key} eq 'ARRAY') {
+ $req = $cert_req->{$key}[0];
+ if ($req eq 'any' and defined $cl_cert) {
+ return 0;
+ }
+ elsif ($req eq 'pubkey' and defined $cl_cert) {
+ my $cl_cert_f = $cl_cert->{fingerprint_sha256};
+ $cl_cert_f =~ s/://g;
+ $cl_cert_f = lc $cl_cert_f;
+ for my $pubkey (@{ $cert_req->{$key} }) {
+ my $pk = $pubkey;
+ $pk =~ s/://g;
+ $pk = lc $pk;
+ ### $pk
+ ### $cl_cert_f
+ if ($pk eq $cl_cert_f) {
+ return 0;
+ }
+ }
+ }
+ elsif ($req eq 'file' and defined $cl_cert) {
+ my $cl_cert_f = $cl_cert->{fingerprint_sha256};
+ $cl_cert_f =~ s/://g;
+ $cl_cert_f = lc $cl_cert_f;
+
+ for my $file (@{ $cert_req->{$key} }) {
+ ### $file
+ ## no critic (RequireBriefOpen)
+ if (-e $file and -r $file) {
+ open my $fh, '<', $file
+ or serr("'$vhost': cert_req: '$file': $ERRNO");
+ while (<$fh>) {
+ my $pk = $_;
+ $pk =~ s/://g;
+ $pk = lc $pk;
+ chomp $pk;
+ ### $pk
+ ### $cl_cert_f
+ if ($pk eq $cl_cert_f) {
+ close $fh
+ or warn "$vhost: $file: $ERRNO";
+ return 0;
+ }
+ }
+ close $fh
+ or warn "$vhost: $file: $ERRNO";
+ }
+ }
+ }
+
+ ### $req
+ if ($cert_req->{$key}[1]) {
+ return 1, $cert_req->{$key}[1];
+ }
+ else {
+ return 1;
+ }
+ }
+ # must be string, hopefully 'any'
+ elsif ($cert_req->{$key} eq 'any' and defined $cl_cert) {
+ return 0;
+ }
+ else {
+ serr("'$vhost': certs: when not an array, it must be 'any'.");
+ return 1;
+ }
+ ### fall back to require certificate, the regex *DID* match.
+ return 1, 'System Error';
+ }
+ }
+ }
+ return;
+}