From 4c0a67a307010e17b273cc530c307a56db29977d Mon Sep 17 00:00:00 2001 From: jake Date: Fri, 15 Nov 2024 22:37:01 -0500 Subject: [PATCH] add KeyData.pm, remove all poking of gpg --- keyserver | 121 ++--- keyserver.conf.example | 3 +- lib/KeyData.pm | 827 ++++++++++++++++++++++++++++++ templates/index.html.ep | 2 +- templates/layouts/default.html.ep | 5 +- templates/pkslookup.html.ep | 80 ++- templates/secretadd.html.ep | 2 +- todo | 1 - 8 files changed, 931 insertions(+), 110 deletions(-) create mode 100644 lib/KeyData.pm delete mode 100644 todo diff --git a/keyserver b/keyserver index bfcbca4..558a483 100755 --- a/keyserver +++ b/keyserver @@ -1,21 +1,21 @@ #!/usr/bin/env perl -# this program should be ran as a seperate user but dedicated user +# this program should be ran as a dedicated user use Mojolicious::Lite -signatures; use Mojo::Pg; use Smart::Comments; use Mojo::File qw(tempdir tempfile); use Mojo::Util qw(url_escape url_unescape); use List::Util qw(uniq); -#use Mojo::Cache; -#use Carp::Always; +use Encode qw(encode_utf8 decode_utf8); ## no critic (prototype) +use lib qw(lib); +use KeyData; -app->plugin('Config'); +plugin Config => {file => $ARGV[1]}; -my $VERSION = "0.0.1"; +my $VERSION = "1.0.0"; -my $config = app->config; -#my $cache = Mojo::Cache->new(max_keys => 5); +my $config = app->config(); # hypnotoad -f ./keyserver ./keyserver.conf my $start_time; my $magic_delimiter = '||,;,||'; my $tmpdir; @@ -85,7 +85,8 @@ my %operations = ( $keys++; my $uids = $pg->db->select('gpg_uid',['uid', 'creationdate', 'expirationdate','flags'], { relatedto => $i->{id} })->hashes; for my $uid (@{ $uids->to_array}) { - my $uidstring = url_unescape($uid->{uid}); + # uhhhh... I assume it gets double encoded at some point + my $uidstring = decode_utf8(url_unescape($uid->{uid})); next unless $uidstring; { no warnings 'uninitialized'; @@ -129,7 +130,7 @@ get '/pks/lookup/v1/:op/:search' => sub ($c) { and (exists $operations{$c->param('op')}) and ($c->param('search') =~ m/[\w\d]+/)) { - my $other_options = $c->params('options'); + my $other_options = $c->param('options'); my ($res,$meta) = $operations{index}({ search => $c->param('search'), options => "mr,$other_options"}); if ($res) { if (ref $res eq 'ARRAY') { @@ -169,7 +170,8 @@ get '/pks/lookup' => sub ($c) { and (exists $operations{lc $c->param('op')}) and ($c->param('search') =~ m/[\w\d]+/)) { - my ($res, $meta) = $operations{lc $c->param('op')}({ search => $c->param('search'), options => $c->param('options')}); + my $search = encode_utf8($c->param('search')); + my ($res, $meta) = $operations{lc $c->param('op')}({ search => $search, options => $c->param('options')}); if ($res) { if (ref $res eq 'ARRAY') { if (defined $c->param('options') and lc $c->param('options') eq 'mr') { @@ -199,9 +201,9 @@ sub stats { #$cache->set(operations => ($cache->get('operations') + 1)); operation(); my $output = "jjakke's keyserver ($VERSION)\n\n"; - $output .= `gpg --version`; - $output =~ s/Home: (.*)/Home: [redacted]/g; - $output .= "\n"; + #$output .= `gpg --version`; + #$output =~ s/Home: (.*)/Home: [redacted]/g; + #$output .= "\n"; my $data = $pg->db->select('this_service', ['starttime', 'operations'])->array; my $elapsed = time - $data->[0]; my $days = int($elapsed / 86400); @@ -262,54 +264,19 @@ sub add ($c) { } undef @keytexts; - my $tmpfile = tempfile("$tmpdir/XXXXXXXXXXX"); + #my $tmpfile = tempfile("$tmpdir/XXXXXXXXXXX"); - open my $fh, '>', $tmpfile; - syswrite $fh, $keytext, length $keytext; - close $fh; + #open my $fh, '>', $tmpfile; + #syswrite $fh, $keytext, length $keytext; + #close $fh; - my $res = `gpg --with-colons --with-fingerprint --with-fingerprint --import --import-options import-show $tmpfile`; - if ($? ne 0) { - return $c->render(text=>"not accepting (gpg bugged out)", status=>422); - } - my $fingerprint = (split(/:/, (grep(/^fpr:/, split(/\n/, $res)))[0]))[9]; - # --with-colons show more relevent data with an imported key. - $res = `gpg --with-colons --with-fingerprint --with-fingerprint --list-sigs $fingerprint`; - `gpg --batch --delete-keys --yes $fingerprint`; + my $KeyData = KeyData->new(key_data => $keytext, noisy => 0); + my $data = $KeyData->machine_readable_gnupg; + # ## $data + my $fingerprint = (split(/:/, (grep(/^fpr:/, split(/\n/, $data)))[0]))[9]; - my $version = `gpg --list-packets $tmpfile`; - my @versions; - my $record; - my $nonext = 0; - my $pub_count = 0; - for my $string (split /\n/, $version) { - if ($string =~ m/^(:[\w\s]*:)/) { - $record = $1; - $nonext = 1; - next; - } - if ($nonext) { - $nonext = 0; - if ($string =~ m/(version (\d+))/) { - $record .= $2; - ## strictly for machine readable format, so only public key info is needed. - if ($record =~ s/^:public key packet:/pub:/) { - $pub_count++; - if ($pub_count >= 2) { - return $c->render(text=>"not accepting (only one public key per upload)", status=>422); - } - } - #$record =~ s/:signature packet:/sig:/; - #$record =~ s/:public sub key packet:/sub:/; - #$record =~ s/:secret key packet:/sec:/; - #$record =~ s/:user [iI][dD] packet:/uid/; # version-less - push @versions, $record; - } - } - } - - my @rows = split /\n/, $res; + my @rows = split /\n/, $data; my %ok_records = ( pub => 1, # public key @@ -353,6 +320,7 @@ sub add ($c) { my $keyid = $data[4]; my $create = $data[5]; my $expire = $data[6]; + my $version = $data[7]; # jjakke edition my $signatureclass = $data[10]; my $userid = $data[9]; @@ -363,16 +331,6 @@ sub add ($c) { # rvk: fingerprint # grp: keygrips, delimieted by comma. - my $version; - my %version_records = ( - pub => 1, - sig => 1, - sub => 1, - ); - if (exists $version_records{$record}) { - $version = get_version($record, \@versions); - } - if ($record eq 'pub') { $this_fullkey = 'next'; $this_pubs_flags = $flag; @@ -384,19 +342,21 @@ sub add ($c) { if ($record eq 'uid') { push @these_uids, $userid; $need_sig = 1; + say "Yep, need sig"; } if ($need_sig and $record eq 'sig' and ( $signatureclass eq '[selfsig]' - or $signatureclass eq '13x' - or $signatureclass eq '12x' - or $signatureclass eq '11x' - or $signatureclass eq '10x')) + or $signatureclass eq '0x13' + or $signatureclass eq '0x12' + or $signatureclass eq '0x11' + or $signatureclass eq '0x10')) { + say "here we are"; $need_sig = 0; $these_uids[-1] .= "$magic_delimiter$create:$expire:$flag"; } - $version ? ($blob .= "$row,$version\n") : ($blob .= "$row\n"); + $blob .= $row . "\n"; exists $ok_records{$record} and $ok_records{$record} or $reject = 1; } @@ -410,20 +370,11 @@ sub add ($c) { }; sub push_to_database($blob, $fullkey, $version, $flags, $armored, @these_uids) { - my $id = insert_gpg_key($fullkey, substr($fullkey, -16), $version, $flags, $armored, $blob); + my $id = insert_gpg_key($fullkey, $version, $flags, $armored, $blob); insert_gpg_uid($id, @these_uids); -}; - -sub get_version($record, $versions) { - my @selector = split /:/, $versions->[0]; - if ($record eq $selector[0]) { - shift @$versions; - return $selector[1]; - } - return; } -sub insert_gpg_key ($fingerprint, $keyid, $version, $flags, $armored, $blob) { +sub insert_gpg_key ($fingerprint, $version, $flags, $armored, $blob) { my $test = $pg->db->select('gpg_key', ['id'], {fingerprint => $fingerprint}); if ($test) { $pg->db->delete('gpg_key', {fingerprint => $fingerprint}); @@ -431,7 +382,6 @@ sub insert_gpg_key ($fingerprint, $keyid, $version, $flags, $armored, $blob) { my $result = $pg->db->insert('gpg_key', { fingerprint => $fingerprint, - keyid => $keyid, version => $version, flags => $flags, armored => $armored, @@ -479,8 +429,7 @@ sub create_tables { my $stmt = " CREATE TABLE gpg_key ( id SERIAL PRIMARY KEY, - fingerprint VARCHAR(40) UNIQUE NOT NULL, - keyid VARCHAR(16), + fingerprint VARCHAR(64) UNIQUE NOT NULL, version smallint, flags VARCHAR(5), armored text, diff --git a/keyserver.conf.example b/keyserver.conf.example index b83d89c..11cc410 100644 --- a/keyserver.conf.example +++ b/keyserver.conf.example @@ -10,7 +10,8 @@ pgpass => 'password', pghost => 'localhost:5432', pgdb => 'jjakkekeyserverdb', - servermessage => '', # Message banner for http access (blank for no message banner) + serverh1header => 'Welcome to jjakke\'s keyserver!', + servermessage => '', # Message banner (like an alert or something) for http access (blank for no message banner) pksadd => 1, # 1/0 for allowing/disallowing public key upload (eg with `gpg --send-keys`) secret_add_ok => 1, # 1/0 for allowing/disallowing public key upload (secretly) secret_add => '/secret/add', # route for frens and family (keep it loaded; NOT '' or '/' as these will collide) diff --git a/lib/KeyData.pm b/lib/KeyData.pm new file mode 100644 index 0000000..4ff6f21 --- /dev/null +++ b/lib/KeyData.pm @@ -0,0 +1,827 @@ +use v5.38; +use feature 'class'; +no warnings qw(experimental::class); + +# https://perldoc.perl.org/functions/pack#pack-TEMPLATE,LIST + +class KeyData { + use MIME::Base64; + use Carp qw(carp croak); + #use Smart::Comments; + + field $key_data :param; + field $noisy :param; + field @packets; + + ADJUST { + $self->readpgp; + } + + method dearmor_pgp_key () { + if ($key_data =~ m/-----BEGIN PGP PUBLIC KEY BLOCK-----/) { + $key_data =~ s/-----BEGIN PGP PUBLIC KEY BLOCK-----\s*//s; + $key_data =~ s/Comment:(.*)\s*//g; + $key_data =~ s/Version:(.*)\s*//g; + $key_data =~ s/Hash:(.*)\s*//g; + $key_data =~ s/Charset:(.*)\s*//g; + $key_data =~ s/-----END PGP PUBLIC KEY BLOCK-----\s*//s; + $key_data = decode_base64($key_data); + } + elsif ($key_data =~ m/-----BEGIN PGP/) { + carp 'This isn\'t key data.'; + return 'stop'; + } + } + + method add ($Class) { + push @packets, $Class; + } + + method readpgp () { + if ($key_data =~ m/-----BEGIN PGP/) { + $key_data = $self->dearmor_pgp_key(); + } + + return if $key_data eq 'stop'; + + my $offset = 0; + my $i = 0; + while ($offset < length($key_data)) { + my $packet_size = $self->parse_pgp_packet(substr($key_data, $offset)); + return unless $packet_size; + $offset += $packet_size; + say "offset: $offset\n" if $noisy; + } + } + + method parse_pgp_packet ($data) { + my $byte = unpack('B8', substr($data, 0, 1)); # Packet Header + ## # $byte + my @bits = split(//, $byte); + if ($bits[0] != 1) { + carp "Invalid data"; + return; + } + my $format = 'legacy'; + ($bits[1] == 0 ? say 'Legacy Format' : (say 'OpenPGP Format' and $format = 'modern')) if $noisy; + if ($bits[1] == 1) { + $format = 'modern'; + } + my $tag = ''; + if ($format eq 'legacy') { + for my $b (@bits[2..5]) { + $tag .= $b; + } + $tag = scalar reverse $tag; + $tag = unpack('C', pack('b4', $tag)); + } + else { + for my $b (@bits[2..7]) { + $tag .= $b; + } + $tag = scalar reverse $tag; + $tag = unpack('C', pack('b6', $tag)); + } + + my $length_field; + my $length_of_length; + if ($format eq 'legacy') { + # https://www.rfc-editor.org/rfc/rfc9580#section-4.2.2 + if ($bits[7] and $bits[6]) { + $length_of_length = 'bullshit'; + die; + } + elsif ($bits[7]) { + $length_of_length = 2; + $length_field = unpack('n', substr($data, 1, $length_of_length)); + } + elsif ($bits[6]) { + $length_of_length = 3; + $length_field = unpack('N', substr($data, 1, $length_of_length)); + } + else { + $length_of_length = 1; + $length_field = unpack('C', substr($data, 1, $length_of_length)); + } + } + else { # modern + # https://www.rfc-editor.org/rfc/rfc9580#section-4.2.1 + my $first_octet = unpack('C', substr($data, 1, 1)); + my $second_octet = unpack('C', substr($data, 2, 1)); + + if ($first_octet < 192) { + $length_of_length = 1; + $length_field = $first_octet; + } + if ($first_octet >= 192 and $first_octet < 255) { + $length_of_length = 2; + $length_field = ((($first_octet - 192) << 8) + ($second_octet) + 192); # probably fine + } + if ($first_octet == 255) { + $length_of_length = 5; + #$subpacket_length = [4-octet scalar starting at 2nd_octet]; + $length_field = (unpack('N', substr $data, 1, 4)); # idk + warn "Give me the key that caused this to be emited"; + } + } + + my %tags = ( + 0 => 'Reserved (Lol!)', + 1 => 'Public Key Encrypted Session Key Packet', + 2 => 'Signature Packet', + 3 => 'Symmetric Key Encrypted Session Key Packet', + 4 => 'One-Pass Signature Packet', + 5 => 'Secret Key Packet', + 6 => 'Public Key', + 7 => 'Secret Subkey Packet', + 8 => 'Compressed Data Packet', + 9 => 'Symmetrically Encrypted Data Packet', + 10 => 'Marker Packet', + 11 => 'Literal Data Packet', + 12 => 'Trust Packet', + 13 => 'User ID Packet', + 14 => 'Public Subkey Packet', + 17 => 'User Attribute Packet', + 18 => 'Symmetrically Encrypted and Integrity Protected Data Packet', + 19 => 'Reserved', + 20 => 'Reserved', + 21 => 'Padding Packet', + ); + exists $tags{$tag} + and say $tags{$tag} . " with length: $length_field" + or say 'Unknown Packet' if $noisy; + + if ($tag == 2) { # sigs + my $sigs = Signature->new(noisy => $noisy); + $sigs->go($data, $length_field, $length_of_length); + $self->add($sigs); + } + elsif ($tag == 6) { # pubkey + my $pubs = PublicKey->new(pub_or_sub => 'pub', noisy => $noisy); + $pubs->go($data, $length_field, $length_of_length); + $self->add($pubs); + } + elsif ($tag == 14) { # subpubkey + my $subpubs = PublicKey->new(pub_or_sub => 'sub', noisy => $noisy); + $subpubs->go($data, $length_field, $length_of_length); + $self->add($subpubs); + } + elsif ($tag == 13) { # user id + my $uid = UserID->new(uid => substr($data, 2, $length_field)); + say $uid->uid() if $noisy; + $self->add($uid); + } + else { + carp "Not handling this data '$tags{$tag}' ($tag)"; + return; + } + + return $length_field + $length_of_length + 1; # Return the number of bytes we just processed + } + + # like `gpg --with-colons --list-keys --with-fingerprint --with-fingerprint` but not it. + method machine_readable_gnupg () { + # https://github.com/gpg/gnupg/blob/master/doc/DETAILS + # 1 type of record + # 2 validity + # 3 key length + # 4 pub algo + # 5 keyid (fingerprint - 16) + # 6 creation date + # 7 expiration date + # 8 Certificate S/N, UID hash, trust signature info jjakke-edition: pub/sub/sig: key-version + # 9 ownertrust + # a uid: userid jjakke-edition: sig: signature target + # b signature class + # c key capabilities + # d issuer certificate fingerprint 'or other info' + # + # below is spaced out for me to read better + # + # 1 2 3 4 5 6 7 8 9 a + # pub:u:255:22:9904E01052985080:1730221618:1856365618: :u: + # 1 23456789 a b + # fpr:::::::::50B750CC829A462D016AD9679904E01052985080: + # 1 2 3 4 5 6 7 8 9 a + # uid: : : : : : : : :Jake Thoughts (jjakke) : + # 1 2 3 4 5 6 7 8 9 a b c d + # sig: : :22:9904E01052985080:1730221618: : : : :[selfsig]: :13x: + # 1 2 3 4 5 6 7 8 9 a + # sub:u:255:18:190FCA50206CE28A:1730221618:1856365618: : : + # 2 3 4 5 6 7 8 9 a + # fpr: : : : : : : : :B99D79A47141D942494EBCF2190FCA50206CE28A: + # 1 2 3 4 5 6 7 8 9 a b c d + # sig: : :22:9904E01052985080:1730221618: : : : :[keybind]: :18x: + my $string = ''; + my $i = 0; + for my $class (@packets) { + if (builtin::blessed $class eq 'PublicKey') { + $string .= $class->pub_or_sub(); + $string .= ":REPLACEME:".$class->key_bits().":".$class->pub_key_algo().":"; + if ($class->version() == '4') { + # https://www.rfc-editor.org/rfc/rfc9580#section-5.5.4.2 + $string .= substr($class->fingerprint(), -16); + } else { + # https://www.rfc-editor.org/rfc/rfc9580#section-5.5.4.3 + $string .= substr($class->fingerprint(), 0, 16); + } + $string .= ":".$class->creation_time().":"; + my $revoked = 0; + my $expiration = 0; + my $k = 0; + for my $Signature (@packets) { + if ($k > $i and builtin::blessed $Signature eq 'Signature') { + if ($Signature->sigtype() eq '0x13' + or $Signature->sigtype() eq '0x12' + or $Signature->sigtype() eq '0x11' + or $Signature->sigtype() eq '0x10' + or $Signature->sigtype() eq '0x18' + or $Signature->sigtype() eq '0x19' + or $Signature->sigtype() eq '0x1F') + { + if ($Signature->key_expiration_time()) { + $expiration = $class->creation_time() + $Signature->key_expiration_time(); + $string .= $class->creation_time() + $Signature->key_expiration_time(); + } + last; + } + if ($Signature->sigtype() eq '0x20' or $Signature->sigtype() eq '0x28') { + $revoked = 1; + last; + } + } + $k++; + next; + } + if ($revoked) { + $string =~ s/REPLACEME/r/; + } + if ($expiration and $expiration < time) { + $string =~ s/REPLACEME/e/; + } + $string =~ s/REPLACEME/-/; + $string .= ":" . $class->version()."::\n"; + + $string .= "fpr:::::::::" . $class->fingerprint() . ":\n"; + } + elsif (builtin::blessed $class eq 'UserID') { + $string .= "uid:::::::::" . $class->uid() . ":\n"; + } + elsif (builtin::blessed $class eq 'Signature') { + no warnings 'uninitialized'; + my $keyid = $class->keyid_issuer(); # v6 doesn't generate these + $keyid =~ s/\s//g; + $keyid = lc $keyid; + my $fpr_issuer = $class->fpr_issuer; # so that's what this is for + $fpr_issuer =~ s/\s//g; + $fpr_issuer = lc $fpr_issuer; + # 1 2 3 4 5 6 7 8 9 a b c d + # sig: : :22:9904E01052985080:1730221618: : : : :[keybind]: :18x: + $class->sigtype eq '0x20' ? ($string .= "rev") : ($string .= 'sig'); + $string .= ":::" . $class->pub_key_algo . ":" . $keyid . ":" . $class->creation . ":" . + $class->expiration . ":". $class->version . "::". $class->signature_target .":" . + $class->sigtype . "::" . $fpr_issuer . ":\n"; + } + $i++; + } + return $string; + } +} + +class PublicKey { + use Digest::SHA qw(sha1_hex sha256_hex); + + field $version :reader; # 4/6 are supported. + field $creation_time :reader; + field $expiration_time :reader; + field $pub_key_algo :reader; + field $fingerprint :reader; + field $key_bits :reader; + field $pub_or_sub :param; + field $noisy :param; + + method go ($data, $length_field, $length_of_length) { + my $offset = $length_of_length + 1; + $version = unpack('C', substr($data, $offset++, 1)); + say "Key Version: $version" if $noisy; + $creation_time = $self->octet_time(substr($data, $offset, 4)); + say "Creation date: " . scalar gmtime $creation_time if $noisy; + $offset += 4; + if ($version == 3 or $version == 2) { + my $_expiration = unpack('n', substr($data, $offset, 2)); + # ^ 'days' so... + $self->set_expiration( $_expiration * 86400 ); + $offset += 2; + } + $pub_key_algo = unpack('C', substr($data, $offset++, 1)); + my $PubKeyAlgos = PubKeyAlgos->new(); + say "Pubkey Algo: " . $PubKeyAlgos->valid($pub_key_algo)->[0] . " ($pub_key_algo)" if $noisy; + + # https://www.rfc-editor.org/rfc/rfc9580#section-5.5.2.3 4o length of pubkey material in the next field. + if ($version == 6) { + $offset += 4; # skipping... + } + my $KeyBits = PublicKeyKeyBits->new(); + $key_bits = $KeyBits->get_bits($data, $pub_key_algo, $offset); + # ^ an misspelled scalar name causes segv when compiling O_O + + $self->calculate_fingerprint($data, $length_field, $length_of_length); + } + + method calculate_fingerprint ($data, $length_field, $length_of_length) { + if ($version == 4) { + $fingerprint = sha1_hex(pack("C",0x99) . pack("n",$length_field) . substr($data,$length_of_length+1,$length_field)); + say "Calculated fingerprint: $fingerprint" if $noisy; + } + elsif ($version == 6) { + $fingerprint = sha256_hex(pack("C",0x9B) . pack("N",$length_field) . substr($data,$length_of_length+1,$length_field)); + say "Calculated fingerprint: $fingerprint" if $noisy; + } + else { + warn "Calculated fingerprint: unable to calcuate for version $version"; # v3 mainly + # v3: The fingerprint of a version 3 key is formed by hashing the body (but not the 2-octet length) + # of the MPIs that form the key material (public modulus n, followed by exponent e) with MD5 + } + } + + method pub_or_sub () { + return $pub_or_sub; + } + + method octet_time ($data) { + my $_time; + $_time = (unpack('N', substr $data, 0, 4)); + return $_time; + } + + method set_expiration ($epoch) { + $expiration_time = $creation_time + $epoch; + } +} + +class PublicKeyKeyBits { + # TODO: fix up later, good enough for now + # https://www.rfc-editor.org/rfc/rfc9580#section-3.2 + # https://www.rfc-editor.org/rfc/rfc9580#section-5.5.5 + method get_bits ($data, $algo, $offset) { + if ($algo == 1 or $algo == 2 or $algo == 3 or $algo == 16 or $algo == 17) { # RSA, Elgamal, DSA + return unpack('n', substr($data, $offset++, 2)); + } + elsif ($algo == 18) { # ECDH + my $oid_len = unpack('C', substr($data, $offset++, 1)); + my $hex = $self->get_oid_hex($data, $offset,$oid_len); + my $Curves = ECCCurves->new(); + if ($Curves->valid( $hex )) { + return $Curves->octets( $hex )->[4] * 8; + } + } + elsif ($algo == 19) { # ECDSA + my $oid_len = unpack('C', substr($data, $offset++, 1)); + my $hex = $self->get_oid_hex($data, $offset,$oid_len); + my $Curves = ECCCurves->new(); + if ($Curves->valid( $hex )) { + return $Curves->octets( $hex )->[4] * 8; + } + } + elsif ($algo == 22) { # EdDSA (deprecated) + # NOTE: https://www.rfc-editor.org/rfc/rfc9580#section-11.2.3 + # For example, the length of an EdDSALegacy public key for the curve Ed25519Legacy is 263 bits: + # 7 bits to represent the 0x40 prefix octet and 32 octets for the native value of the public key. + # + # I don't understand why gpg lists 255 as the bit size. + + #my $oid_len = unpack('C', substr($data, $offset++, 1)); + #my $hex = $self->get_oid_hex($data, $offset,$oid_len); + #my $Curves = ECCCurves->new(); + #if ($Curves->valid( $hex )) { + #return $Curves->octets( $hex )->[4] * 8; + #} + return 256; + } + elsif ($algo == 25) { # X25519 + # https://www.rfc-editor.org/rfc/rfc7748#section-6.1 + return 32 * 8; + } + elsif ($algo == 26) { # X448 + # https://www.rfc-editor.org/rfc/rfc7748#section-6.2 + return 56 * 8; + } + elsif ($algo == 27) { # Ed25519 + # https://www.rfc-editor.org/rfc/rfc8032#section-5.1.5 + return 256; + } + elsif ($algo == 28) { # Ed448 + # https://www.rfc-editor.org/rfc/rfc8032#section-5.2.5 + return 456; + } + } + + method get_oid_hex ($_data, $_offset, $_count) { + my $i = 0; + my $hex = ''; + while ($i != $_count) { + $hex .= sprintf("%02X", unpack('C', substr($_data, $_offset++, 1))); + $i++; + } + return $hex; + } +} + +class UserID { + field $uid :param; + + method uid () { + return $uid; + } +} + +class Signature { + field $noisy :param; + + field $version :reader; # 4/6 are supported. + field $sigtype :reader; + field $pub_key_algo :reader; + field $hash_algo :reader; + + field $creation :reader; + field $expiration :reader; + field $key_expiration_time :reader; # for primary/sub key + field $keyid_issuer :reader; # likely substr($fpr_issuer, -16); + field $signature_target :reader; + field $fpr_issuer :reader; + field $key_flags :reader; + + field %subpackets; + + ADJUST { + %subpackets = ( # not the full list of them, just the ones *I* care about. + 2 => 'Signature Creation Time', # 4o + 3 => 'Signature Expiration Time', # 4o nubmer of seconds after sig creation time + 9 => 'Key Expiration Time', # 4o number of seconds after key creation time + 16 => 'Issuer Key ID', # 8o (not existing for v6+ keys) + 27 => 'Key Flags', # N octets of flags + 31 => 'Signature Target', # what signature this refers to + 33 => 'Issuer Fingerprint', # 1o key ver, N octets. v4 = 20o, v6 = 32o. MUST MATCH + ); + } + + method go($data, $length_field, $length_of_length) { + my $offset = $length_of_length + 1; + $version = unpack('C', substr($data, $offset++, 1)); # version + say "version: $version" if $noisy; + + $sigtype = sprintf("0x%X", unpack('C', substr($data, $offset++, 1))); + my $SignatureType = SignatureType->new(); + say "signature type: ". $SignatureType->valid($sigtype) . " ($sigtype)" if $noisy; + + $pub_key_algo = unpack('C', substr($data, $offset++, 1)); + my $PubKeyAlgos = PubKeyAlgos->new(); + say "algo: " . $PubKeyAlgos->valid($pub_key_algo)->[0] . " ($pub_key_algo)" if $noisy; + + $hash_algo = unpack('C', substr($data, $offset++, 1)); + my $HashAlgos = HashAlgos->new(); + say "hash: " . $HashAlgos->valid($hash_algo)->[0] . " ($hash_algo)" if $noisy; + + my $hashed_subpacket_count; + my $unhashed_subpacket_count; + if ($version == 4) { # 2o + $hashed_subpacket_count = unpack('n', substr($data, $offset, 2)); + ## $hashed_subpacket_count + $offset += 2; + $unhashed_subpacket_count = unpack('n', substr($data, $offset + $hashed_subpacket_count, 2)); + ## $unhashed_subpacket_count + } + else { # 6 4o + $hashed_subpacket_count = unpack('N', substr($data, $offset, 4)); + ## $hashed_subpacket_count + $offset += 4; + $unhashed_subpacket_count = unpack('N', substr($data, $offset + $hashed_subpacket_count, 4)); + ## $unhashed_subpacket_count + } + $self->subpackets(substr($data, $offset, $hashed_subpacket_count)); + $offset += $hashed_subpacket_count; + if ($version == 4) { + $offset += 2; + } else { + $offset += 4; + } + $self->subpackets(substr($data, $offset, $unhashed_subpacket_count)); + } + + method subpackets ($data) { + my $offset = 0; + my $length = length($data); + # ## $length + while ($offset < length($data)) { + # ## $offset + my ($length_of_length, $subpacket_length, $typeid) = $self->subpacket_length($data, $offset); + # ## $length_of_length + # ## $subpacket_length + # ## $typeid + $offset += $length_of_length; + if (exists $subpackets{$typeid}) { + #print "$subpackets{$typeid} !! "; + if ($typeid == 33) { + (undef, $fpr_issuer) = $self->issuer_fingerprint( + substr($data, $offset + $length_of_length, $subpacket_length) ); + say $fpr_issuer if $noisy; + } + if ($typeid == 2) { + $creation = $self->octet_time( + substr($data, $offset + $length_of_length, $subpacket_length) ); + say scalar gmtime $creation if $noisy; + } + if ($typeid == 27) { + $key_flags = sprintf("%02X ", + unpack('C', substr $data, $offset+$length_of_length, $subpacket_length)); + # TODO + say "0x$key_flags" if $noisy; + + } + if ($typeid == 3) { + $expiration = $self->octet_time( + substr($data, $offset + $length_of_length, $subpacket_length) ); + say scalar gmtime ( $creation + $expiration); + } + if ($typeid == 9) { + $key_expiration_time = $self->octet_time( + substr($data, $offset + $length_of_length, $subpacket_length) ); + say $key_expiration_time if $noisy; + } + if ($typeid == 16) { + $keyid_issuer = $self->key_id( + substr($data, $offset + $length_of_length, $subpacket_length) ); + say $keyid_issuer if $noisy; + } + if ($typeid == 31) { + $signature_target = $self->_signature_target( + substr($data, $offset + $length_of_length, $subpacket_length) ); + say $signature_target if $noisy; + } + } + + $offset += $subpacket_length + 1; + } + } + + method _signature_target ($data) { + my $offset = 0; + my $algo = unpack('C', substr($data, $offset++, 1)); + my $hash = unpack('C', substr($data, $offset++, 1)); + my $_signature_target; + + # lmk when you see it (give key too) + warn "_signature_target is untested"; + while ($offset < length($data)) { + $_signature_target .= sprintf("%02X ", unpack('C', substr($data, $offset++, 1))); + } + return $_signature_target; + } + + # TODO doesnt verify lengths for the versions, rfc says it MUST match. + method issuer_fingerprint ($data) { + my $_fingerprint = ''; + my $offset = 0; + my $_version = unpack('C', substr($data, $offset++, 1)); + while ($offset < length($data)) { + $_fingerprint .= sprintf("%02X ", unpack('C', substr($data, $offset++, 1))); + } + return $_version,$_fingerprint; + } + + # TODO RFC say they MUST match the repective bits on fingerprints + method key_id ($data) { + my $_keyid_issuer = ''; + my $offset = 0; + while ($offset < length($data)) { + $_keyid_issuer .= sprintf("%02X ", unpack('C', substr($data, $offset++, 1))); + } + return $_keyid_issuer; + } + + method octet_time ($data) { + return (unpack('N', substr $data, 0, 4)); + } + + # returns length_of_length, length subpacket, and typeid + method subpacket_length ($data, $offset) { + my ($length_of_length, $subpacket_length); + my $first_octet = unpack('C', substr $data, $offset, 1); + my $second_octet = unpack('C', substr $data, $offset+1, 1); + + my $typeid; + + if ($first_octet < 192) { + $length_of_length = 1; + $subpacket_length = $first_octet - 1; # The subpacket length field covers the encoded Subpacket + # Type ID and the subpacket-specific data, and it does not + # include the subpacket length field itself. + $typeid = $second_octet; + } + if ($first_octet >= 192 and $first_octet < 255) { + $length_of_length = 2; + $subpacket_length = ((($first_octet - 192) << 8) + ($second_octet) + 192) - 2; + $typeid = unpack('C', substr $data, $offset+2, 1); + } + if ($first_octet == 255) { + $length_of_length = 5; + #$subpacket_length = [4-octet scalar starting at 2nd_octet]; + $subpacket_length = (unpack('N', substr $data, $offset+1, 4)) - 5; # idk + warn "give me the key that caused this to be emitted"; + $typeid = unpack('C', substr $data, $offset+4, 1); + } + return $length_of_length, $subpacket_length, $typeid; + } +} + +class SignatureType { + field %types; + ADJUST { + %types = ( + '0x00' => 'Binary Signature', + '0x01' => 'Text Signature', + '0x02' => 'Standalone Signature', + '0x10' => 'Generic Certification Signature', + '0x11' => 'Persona Certification Signature', + '0x12' => 'Casual Certification Signature', + '0x13' => 'Positive Certification Signature', + '0x18' => 'Subkey Binding Signature', + '0x19' => 'Primary Key Binding Signature', + '0x1F' => 'Direct Key Signature', + '0x20' => 'Key Revocation Signature', + '0x28' => 'Subkey Revocation Signature', + '0x30' => 'Certification Revocation Signature', + '0x40' => 'Timestamp Signature', + '0x50' => 'Third-Party Confirmation Signature', + '0xFF' => 'Reserved', + ); + } + method valid ($type) { + exists $types{$type} + and return $types{$type}; + } +} + +class Sigs::key_flags { + field %key_flags; + field %key_flags_letters; + + ADJUST { + %key_flags = ( + 0x01 => 'May be used to create User ID or Direct Key signatures', + 0x02 => 'May be used to sign data', + 0x04 => 'May be used to encrypt communications', + 0x08 => 'May be used to encrypt storage', + 0x10 => 'Private component of this key may have been split by a secret-sharing mechanism', + 0x20 => 'May be used for authentication.', + 0x80 => 'Private component may be in the pocession of more than one person', + 0x0004 => 'Reserved (ADSK)', + 0x0008 => 'Reserved (timestamping)', + ); + %key_flags_letters = ( + 0x01 => 'Create UID|DK signatures', + 0x02 => 'S', + 0x04 => 'Ec', + 0x08 => 'Es', + 0x10 => 'Private component may have been split', + 0x20 => 'A', + 0x80 => 'Private component may be in the pocession of more than one person', + 0x0004 => 'Reserved (ADSK)', + 0x0008 => 'Reserved (timestamping)', + ); + } + # can just look at the bits to see what the sig says the key can do. +} + +# https://www.rfc-editor.org/rfc/rfc9580#section-9.1 +class PubKeyAlgos { + field %algos; + + ADJUST { + %algos = ( # Algo .... Not adding the other details + 0 => ['Reserved'], + 1 => ['RSA (Encrypt or Sign)'], + 2 => ['RSA Encrypt-Only'], + 3 => ['RSA Sign-Only'], + 16 => ['Elgamal (Encrypt-Only)'], + 17 => ['DSA (Digital Signature Algorithm)'], + 18 => ['ECDH public key algorithm'], + 19 => ['ECDSA public key algorithm'], + 20 => ['Reserved OR Elgamal Encrypt or Sign'], + 21 => ['Reserved for Diffie-Hellman (X9.42)'], + 22 => ['EdDSALegacy (deprecated)'], + 23 => ['Reserved (AEDH)'], + 24 => ['Reserved (AEDSA)'], + 25 => ['X25519'], + 26 => ['X448'], + 27 => ['Ed25519'], + 28 => ['Ed448'], + ); + # 27 & 25 are 'MUSTs' for rfc9580 + # 17 & 16 were previous 'MUSTs' for rfc4880 + } + + method valid ($number) { + exists $algos{$number} + and return $algos{$number}; + if ($number < 110 or $number > 100) { + return ['Private or Experimental Use']; + } + } +} + +# https://www.rfc-editor.org/rfc/rfc9580#section-9.2 +class ECCCurves { + use Storable qw(dclone); + field %helpme; + + ADJUST { + %helpme = ( + # ASN.1 OID OID Len Curve OID Octets Curve Name Usage Field Size + '1.2.840.10045.3.1.7' => [8, '2A8648CE3D030107', 'NIST P-256', 'ECDSA,ECDH', 32], + '1.3.132.0.34' => [5, '2B81040022', 'NIST P-384',' ECDSA,ECDH', 48], + '1.3.132.0.35' => [5, '2B81040023', 'NIST P-521', 'ECDSA,ECDH', 66], + '1.3.36.3.3.2.8.1.1.7' => [9, '2B2403030208010107', 'brainpoolP256r1','ECDSA,ECDH', 32], + '1.3.36.3.3.2.8.1.1.11' => [9, '2B240303020801010B', 'brainpoolP384r1','ECDSA,ECDH', 48], + '1.3.36.3.3.2.8.1.1.13' => [9, '2B240303020801010D', 'brainpoolP512r1','ECDSA,ECDH', 64], + '1.3.6.1.4.1.11591.15.1' => [9, '2B06010401DA470F01', 'Ed25519Legacy','EdDSALegacy', 32], + '1.3.6.1.4.1.3029.1.5.1' => [10,'2B060104019755010501', 'Curve25519Legacy', 'ECDH', 32] + ); + } + + method valid ($something) { + ( $self->OID($something) or $self->octets($something) ) ? 1 : 0; + } + + method OID ($oid) { + exists $helpme{$oid} + and return $helpme{oid}; + } + + method octets ($octets) { + my %octets; + for my $oid (keys %helpme) { + my $temp = $helpme{$oid}->[1]; + $octets{$temp} = dclone($helpme{$oid}); + $octets{$temp}->[1] = $oid; + } + exists $octets{$octets} + and return $octets{$octets}; + } +} + +# https://www.rfc-editor.org/rfc/rfc9580#section-9.5 +class HashAlgos { + field %algos; + + ADJUST { + %algos = ( + # Algo Text Name v6 signature salt size OID + 0 => ['Reserved', 'Reserved', 0], + 1 => ['MD5', 'MD5', 0], + 2 => ['SHA-1', 'SHA1', 0], + 3 => ['RIPEMD-160','RIPEMD160', 0], + 4 => ['Reserved', 'Reserved', 0], + 5 => ['Reserved', 'Reserved', 0], + 6 => ['Reserved', 'Reserved', 0], + 7 => ['Reserved', 'Reserved', 0], + 8 => ['SHA2-256', 'SHA256', 16], + 9 => ['SHA2-384', 'SHA384', 24], + 10 => ['SHA2-512', 'SHA512', 32], + 11 => ['SHA2-224', 'SHA224', 16], + 12 => ['SHA3-256', 'SHA3-256', 16], + 13 => ['Reserved', 'Reserved', 0], + 14 => ['SHA3-512', 'SHA3-512', 32], + ); + } + + method valid ($n) { + exists $algos{$n} + and return $algos{$n}; + if ($n < 110 or $n > 100) { + return ('Private or Experimental Use','Private or Experimental Use', 0); + } + } +} + +# https://www.rfc-editor.org/rfc/rfc9580#section-9.6 +class AEADAlgos { + field %algos; + + ADJUST { + %algos = ( # name, nonce length (octets), authentication tag length (octets) + 0 => ['Reserved', 0, 0], + 1 => ['EAX', 16, 16], + 2 => ['OCB', 15, 16], + 3 => ['GCM', 12, 16], + ); + } + + method valid ($n) { + exists $algos{$n} + and return $algos{$n}; + if ($n < 110 or $n > 100) { + return ('Private or Experimental Use','Private or Experimental Use', 0); + } + } +} diff --git a/templates/index.html.ep b/templates/index.html.ep index d8dc3fd..60aa3ed 100644 --- a/templates/index.html.ep +++ b/templates/index.html.ep @@ -1,6 +1,6 @@ % layout 'default'; % title 'Welcome'; -

Welcome to jjakke's keyserver!

+

<%= $c->config->{serverh1header} %>

Request a Public Key, using fingerprint

diff --git a/templates/layouts/default.html.ep b/templates/layouts/default.html.ep index 96a7d21..42cb48d 100644 --- a/templates/layouts/default.html.ep +++ b/templates/layouts/default.html.ep @@ -1,8 +1,9 @@ - <%= title %> -