add KeyData.pm, remove all poking of gpg
This commit is contained in:
jake
parent
d1e174113f
commit
4c0a67a307
8 changed files with 931 additions and 110 deletions
121
keyserver
121
keyserver
|
|
@ -1,21 +1,21 @@
|
||||||
#!/usr/bin/env perl
|
#!/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 Mojolicious::Lite -signatures;
|
||||||
use Mojo::Pg;
|
use Mojo::Pg;
|
||||||
use Smart::Comments;
|
use Smart::Comments;
|
||||||
use Mojo::File qw(tempdir tempfile);
|
use Mojo::File qw(tempdir tempfile);
|
||||||
use Mojo::Util qw(url_escape url_unescape);
|
use Mojo::Util qw(url_escape url_unescape);
|
||||||
use List::Util qw(uniq);
|
use List::Util qw(uniq);
|
||||||
#use Mojo::Cache;
|
use Encode qw(encode_utf8 decode_utf8);
|
||||||
#use Carp::Always;
|
|
||||||
## no critic (prototype)
|
## 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 $config = app->config(); # hypnotoad -f ./keyserver ./keyserver.conf
|
||||||
#my $cache = Mojo::Cache->new(max_keys => 5);
|
|
||||||
my $start_time;
|
my $start_time;
|
||||||
my $magic_delimiter = '||,;,||';
|
my $magic_delimiter = '||,;,||';
|
||||||
my $tmpdir;
|
my $tmpdir;
|
||||||
|
|
@ -85,7 +85,8 @@ my %operations = (
|
||||||
$keys++;
|
$keys++;
|
||||||
my $uids = $pg->db->select('gpg_uid',['uid', 'creationdate', 'expirationdate','flags'], { relatedto => $i->{id} })->hashes;
|
my $uids = $pg->db->select('gpg_uid',['uid', 'creationdate', 'expirationdate','flags'], { relatedto => $i->{id} })->hashes;
|
||||||
for my $uid (@{ $uids->to_array}) {
|
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;
|
next unless $uidstring;
|
||||||
{
|
{
|
||||||
no warnings 'uninitialized';
|
no warnings 'uninitialized';
|
||||||
|
|
@ -129,7 +130,7 @@ get '/pks/lookup/v1/:op/:search' => sub ($c) {
|
||||||
and (exists $operations{$c->param('op')})
|
and (exists $operations{$c->param('op')})
|
||||||
and ($c->param('search') =~ m/[\w\d]+/))
|
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"});
|
my ($res,$meta) = $operations{index}({ search => $c->param('search'), options => "mr,$other_options"});
|
||||||
if ($res) {
|
if ($res) {
|
||||||
if (ref $res eq 'ARRAY') {
|
if (ref $res eq 'ARRAY') {
|
||||||
|
|
@ -169,7 +170,8 @@ get '/pks/lookup' => sub ($c) {
|
||||||
and (exists $operations{lc $c->param('op')})
|
and (exists $operations{lc $c->param('op')})
|
||||||
and ($c->param('search') =~ m/[\w\d]+/))
|
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 ($res) {
|
||||||
if (ref $res eq 'ARRAY') {
|
if (ref $res eq 'ARRAY') {
|
||||||
if (defined $c->param('options') and lc $c->param('options') eq 'mr') {
|
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));
|
#$cache->set(operations => ($cache->get('operations') + 1));
|
||||||
operation();
|
operation();
|
||||||
my $output = "jjakke's keyserver ($VERSION)\n\n";
|
my $output = "jjakke's keyserver ($VERSION)\n\n";
|
||||||
$output .= `gpg --version`;
|
#$output .= `gpg --version`;
|
||||||
$output =~ s/Home: (.*)/Home: [redacted]/g;
|
#$output =~ s/Home: (.*)/Home: [redacted]/g;
|
||||||
$output .= "\n";
|
#$output .= "\n";
|
||||||
my $data = $pg->db->select('this_service', ['starttime', 'operations'])->array;
|
my $data = $pg->db->select('this_service', ['starttime', 'operations'])->array;
|
||||||
my $elapsed = time - $data->[0];
|
my $elapsed = time - $data->[0];
|
||||||
my $days = int($elapsed / 86400);
|
my $days = int($elapsed / 86400);
|
||||||
|
|
@ -262,54 +264,19 @@ sub add ($c) {
|
||||||
}
|
}
|
||||||
undef @keytexts;
|
undef @keytexts;
|
||||||
|
|
||||||
my $tmpfile = tempfile("$tmpdir/XXXXXXXXXXX");
|
#my $tmpfile = tempfile("$tmpdir/XXXXXXXXXXX");
|
||||||
|
|
||||||
open my $fh, '>', $tmpfile;
|
#open my $fh, '>', $tmpfile;
|
||||||
syswrite $fh, $keytext, length $keytext;
|
#syswrite $fh, $keytext, length $keytext;
|
||||||
close $fh;
|
#close $fh;
|
||||||
|
|
||||||
my $res = `gpg --with-colons --with-fingerprint --with-fingerprint --import --import-options import-show $tmpfile`;
|
my $KeyData = KeyData->new(key_data => $keytext, noisy => 0);
|
||||||
if ($? ne 0) {
|
my $data = $KeyData->machine_readable_gnupg;
|
||||||
return $c->render(text=>"not accepting (gpg bugged out)", status=>422);
|
# ## $data
|
||||||
}
|
|
||||||
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 $fingerprint = (split(/:/, (grep(/^fpr:/, split(/\n/, $data)))[0]))[9];
|
||||||
|
|
||||||
my $version = `gpg --list-packets $tmpfile`;
|
my @rows = split /\n/, $data;
|
||||||
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 %ok_records = (
|
my %ok_records = (
|
||||||
pub => 1, # public key
|
pub => 1, # public key
|
||||||
|
|
@ -353,6 +320,7 @@ sub add ($c) {
|
||||||
my $keyid = $data[4];
|
my $keyid = $data[4];
|
||||||
my $create = $data[5];
|
my $create = $data[5];
|
||||||
my $expire = $data[6];
|
my $expire = $data[6];
|
||||||
|
my $version = $data[7]; # jjakke edition
|
||||||
my $signatureclass = $data[10];
|
my $signatureclass = $data[10];
|
||||||
|
|
||||||
my $userid = $data[9];
|
my $userid = $data[9];
|
||||||
|
|
@ -363,16 +331,6 @@ sub add ($c) {
|
||||||
# rvk: fingerprint
|
# rvk: fingerprint
|
||||||
# grp: keygrips, delimieted by comma.
|
# 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') {
|
if ($record eq 'pub') {
|
||||||
$this_fullkey = 'next';
|
$this_fullkey = 'next';
|
||||||
$this_pubs_flags = $flag;
|
$this_pubs_flags = $flag;
|
||||||
|
|
@ -384,19 +342,21 @@ sub add ($c) {
|
||||||
if ($record eq 'uid') {
|
if ($record eq 'uid') {
|
||||||
push @these_uids, $userid;
|
push @these_uids, $userid;
|
||||||
$need_sig = 1;
|
$need_sig = 1;
|
||||||
|
say "Yep, need sig";
|
||||||
}
|
}
|
||||||
if ($need_sig and $record eq 'sig' and (
|
if ($need_sig and $record eq 'sig' and (
|
||||||
$signatureclass eq '[selfsig]'
|
$signatureclass eq '[selfsig]'
|
||||||
or $signatureclass eq '13x'
|
or $signatureclass eq '0x13'
|
||||||
or $signatureclass eq '12x'
|
or $signatureclass eq '0x12'
|
||||||
or $signatureclass eq '11x'
|
or $signatureclass eq '0x11'
|
||||||
or $signatureclass eq '10x'))
|
or $signatureclass eq '0x10'))
|
||||||
{
|
{
|
||||||
|
say "here we are";
|
||||||
$need_sig = 0;
|
$need_sig = 0;
|
||||||
$these_uids[-1] .= "$magic_delimiter$create:$expire:$flag";
|
$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;
|
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) {
|
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);
|
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});
|
my $test = $pg->db->select('gpg_key', ['id'], {fingerprint => $fingerprint});
|
||||||
if ($test) {
|
if ($test) {
|
||||||
$pg->db->delete('gpg_key', {fingerprint => $fingerprint});
|
$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', {
|
my $result = $pg->db->insert('gpg_key', {
|
||||||
fingerprint => $fingerprint,
|
fingerprint => $fingerprint,
|
||||||
keyid => $keyid,
|
|
||||||
version => $version,
|
version => $version,
|
||||||
flags => $flags,
|
flags => $flags,
|
||||||
armored => $armored,
|
armored => $armored,
|
||||||
|
|
@ -479,8 +429,7 @@ sub create_tables {
|
||||||
my $stmt = "
|
my $stmt = "
|
||||||
CREATE TABLE gpg_key (
|
CREATE TABLE gpg_key (
|
||||||
id SERIAL PRIMARY KEY,
|
id SERIAL PRIMARY KEY,
|
||||||
fingerprint VARCHAR(40) UNIQUE NOT NULL,
|
fingerprint VARCHAR(64) UNIQUE NOT NULL,
|
||||||
keyid VARCHAR(16),
|
|
||||||
version smallint,
|
version smallint,
|
||||||
flags VARCHAR(5),
|
flags VARCHAR(5),
|
||||||
armored text,
|
armored text,
|
||||||
|
|
|
||||||
|
|
@ -10,7 +10,8 @@
|
||||||
pgpass => 'password',
|
pgpass => 'password',
|
||||||
pghost => 'localhost:5432',
|
pghost => 'localhost:5432',
|
||||||
pgdb => 'jjakkekeyserverdb',
|
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`)
|
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_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)
|
secret_add => '/secret/add', # route for frens and family (keep it loaded; NOT '' or '/' as these will collide)
|
||||||
|
|
|
||||||
827
lib/KeyData.pm
Normal file
827
lib/KeyData.pm
Normal file
|
|
@ -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) <jake@jjakke.com>:
|
||||||
|
# 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);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
@ -1,6 +1,6 @@
|
||||||
% layout 'default';
|
% layout 'default';
|
||||||
% title 'Welcome';
|
% title 'Welcome';
|
||||||
<h1>Welcome to jjakke's keyserver!</h1>
|
<h1><%= $c->config->{serverh1header} %></h1>
|
||||||
<h2>Request a Public Key, using fingerprint</h2>
|
<h2>Request a Public Key, using fingerprint</h2>
|
||||||
|
|
||||||
<form method="GET" action="/pks/lookup">
|
<form method="GET" action="/pks/lookup">
|
||||||
|
|
|
||||||
|
|
@ -1,8 +1,9 @@
|
||||||
<!DOCTYPE html>
|
<!DOCTYPE html>
|
||||||
<html>
|
<html>
|
||||||
<head>
|
<head>
|
||||||
<title><%= title %></title>
|
<meta charset="utf-8"/>
|
||||||
<style>
|
<title><%= title %></title>
|
||||||
|
<style>
|
||||||
body {
|
body {
|
||||||
font-family: Arial, sans-serif;
|
font-family: Arial, sans-serif;
|
||||||
margin: 20px;
|
margin: 20px;
|
||||||
|
|
|
||||||
|
|
@ -1,6 +1,6 @@
|
||||||
% layout 'default';
|
% layout 'default';
|
||||||
% title 'Lookup';
|
% title 'Lookup';
|
||||||
<h1>Welcome to jjakke's keyserver!</h1>
|
<h1><%= $c->config->{serverh1header} %></h1>
|
||||||
<p><a href="/">index</a></p>
|
<p><a href="/">index</a></p>
|
||||||
<h2>Search results:</h2>
|
<h2>Search results:</h2>
|
||||||
% for my $item (@{ $c->stash('mydata') }) {
|
% for my $item (@{ $c->stash('mydata') }) {
|
||||||
|
|
@ -10,16 +10,21 @@
|
||||||
<pre class="blob">
|
<pre class="blob">
|
||||||
<%
|
<%
|
||||||
my %sigcls = (
|
my %sigcls = (
|
||||||
'10x' => 'self sig',
|
'0x10' => 'self sig',
|
||||||
'11x' => 'self sig',
|
'0x11' => 'self sig',
|
||||||
'12x' => 'self sig',
|
'0x12' => 'self sig',
|
||||||
'13x' => 'self sig',
|
'0x13' => 'self sig',
|
||||||
'18x' => 'subkey bind',
|
'0x18' => 'subkey bind',
|
||||||
'19x' => 'primary key bind',
|
'0x19' => 'primary key bind',
|
||||||
'20x' => 'revocation sig',
|
'0x20' => 'revocation sig',
|
||||||
'28x' => 'subkey revocation sig',
|
'0x28' => 'subkey revocation sig',
|
||||||
'30x' => 'cert revocation sig',
|
'0x30' => 'cert revocation sig',
|
||||||
|
'0x1F' => 'direct key sig',
|
||||||
);
|
);
|
||||||
|
|
||||||
|
my $PubKeyAlgos = PubKeyAlgos->new();
|
||||||
|
my $algo_and_bits = '';
|
||||||
|
|
||||||
for my $row (@row) {
|
for my $row (@row) {
|
||||||
my @data = split /:/, $row;
|
my @data = split /:/, $row;
|
||||||
my $record = $data[0];
|
my $record = $data[0];
|
||||||
|
|
@ -29,44 +34,83 @@
|
||||||
my $keyid = $data[4];
|
my $keyid = $data[4];
|
||||||
my $create = $data[5];
|
my $create = $data[5];
|
||||||
my $expire = $data[6];
|
my $expire = $data[6];
|
||||||
|
my $version = $data[7]; # jjakke edition
|
||||||
my $userid = $data[9];
|
my $userid = $data[9];
|
||||||
my $signatureclass = $data[10];
|
my $signatureclass = $data[10];
|
||||||
|
my $key_issuer = $data[12]; # jjakke edition
|
||||||
|
|
||||||
|
if ($flag and ($flag eq 'e' or $flag eq 'r')) {
|
||||||
|
$flag = "<span class=\"highlight\">$flag</span>"
|
||||||
|
}
|
||||||
|
|
||||||
if ($record eq 'pub') {
|
if ($record eq 'pub') {
|
||||||
|
no warnings qw(uninitialized numeric); # when debugging, comment this out.
|
||||||
|
$algo_and_bits = $PubKeyAlgos->valid($algo)->[0] . "/$keylen";
|
||||||
if ($expire) {
|
if ($expire) {
|
||||||
$string .= "public key: " . gmtime($create) . " -> " . ( $expire ? gmtime($expire) : 'n/a' ) . " | flags: $flag\n"
|
$string .= "public key: " . gmtime($create) . " -> " . gmtime($expire) . " | flags: $flag | v:$version\n";
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
$string .= "public key: <span class=\"date\">" . gmtime($create) . " -> " . ( $expire ? gmtime($expire) : 'n/a' ) . "</span> | flags: $flag\n"
|
$string .= "public key: <span class=\"date\">" . gmtime($create) . " -> n/a" . "</span> | flags: $flag | v:$version\n";
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
elsif ($record eq 'fpr') {
|
elsif ($record eq 'fpr') {
|
||||||
|
$algo_and_bits =~ s/\s+(\(.*\))//;
|
||||||
|
$algo_and_bits =~ s/\s?public key algorithm\s*//;
|
||||||
if (not $pubkey_fpr) {
|
if (not $pubkey_fpr) {
|
||||||
$string .= "fingerprint: <a href=\"/pks/lookup?op=get&search=$userid\">$userid</a>\n";
|
$string .= "fingerprint: <a href=\"/pks/lookup?op=get&search=$userid\">$userid</a> | $algo_and_bits\n";
|
||||||
$pubkey_fpr = 1;
|
$pubkey_fpr = 1;
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
$string .= "<span class=\"fingerprint\">fingerprint: $userid</span>\n";
|
$string .= "<span class=\"fingerprint\">fingerprint: $userid</span> | $algo_and_bits\n";
|
||||||
}
|
}
|
||||||
|
$algo_and_bits = '';
|
||||||
}
|
}
|
||||||
elsif ($record eq 'uid') {
|
elsif ($record eq 'uid') {
|
||||||
my $safe = $userid;
|
my $safe = Encode::decode_utf8($userid);
|
||||||
$safe =~ s/>/>/g if $safe;
|
$safe =~ s/>/>/g if $safe;
|
||||||
$safe =~ s/</</g if $safe;
|
$safe =~ s/</</g if $safe;
|
||||||
$string .= "\n<strong>$safe</strong>\n" if $safe;
|
$string .= "\n<strong>$safe</strong>\n" if $safe;
|
||||||
}
|
}
|
||||||
elsif ($record eq 'sig') {
|
elsif ($record eq 'sig') {
|
||||||
$string .= "signature: $keyid | <span class=\"date\">" . gmtime($create) . " -> ". ( $expire ? gmtime($expire) : 'n/a' ) . "</span> | ";
|
no warnings qw(uninitialized numeric); # when debugging, comment this out.
|
||||||
|
$string .= "signature: ";
|
||||||
|
# V6 keys 'MUST NOT' create keyids. However, they do have key issuer, which I will create a keyid from (high bits, not low bits like with V4) .
|
||||||
|
if ($keyid) {
|
||||||
|
$string .= $keyid
|
||||||
|
} elsif ($key_issuer) {
|
||||||
|
$string .= substr($key_issuer,0,16) . "[trun]";
|
||||||
|
}
|
||||||
|
|
||||||
|
if ($expire and (int $expire)) {
|
||||||
|
$string .= " | " . gmtime($create) . " -> ". gmtime($expire) . " | ";
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
$string .= " | <span class=\"date\">" . gmtime($create) . " -> n/a" . "</span> | ";
|
||||||
|
}
|
||||||
|
|
||||||
(exists $sigcls{$signatureclass})
|
(exists $sigcls{$signatureclass})
|
||||||
? ($string .= $sigcls{$signatureclass})
|
? ($string .= $sigcls{$signatureclass})
|
||||||
: ($string .= $signatureclass);
|
: ($string .= $signatureclass);
|
||||||
$string .= "\n";
|
$string .= "\n";
|
||||||
}
|
}
|
||||||
elsif ($record eq 'sub') {
|
elsif ($record eq 'sub') {
|
||||||
$string .= "\nsub key: " . gmtime($create) . " -> " . ( $expire ? gmtime($expire) : 'n/a' ) . " | flags: $flag\n"
|
no warnings qw(uninitialized numeric); # when debugging, comment this out.
|
||||||
|
$algo_and_bits = $PubKeyAlgos->valid($algo)->[0] . "/$keylen";
|
||||||
|
if ($expire) {
|
||||||
|
if (time > $expire) {
|
||||||
|
$string .= "\nsub key: " . gmtime($create) . " -> <span class=\"highlight\">" . ( $expire ? gmtime($expire) : 'n/a' ) . "</span> | flags: $flag\n"
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
$string .= "\nsub key: " . gmtime($create) . " -> " . ( $expire ? gmtime($expire) : 'n/a' ) . " | flags: $flag\n"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
$string .= "\nsub key: <span class=\"date\">" . gmtime($create) . " -> " . ( $expire ? gmtime($expire) : 'n/a' ) . "</span> | flags: $flag\n"
|
||||||
|
}
|
||||||
}
|
}
|
||||||
elsif ($record eq 'rev') {
|
elsif ($record eq 'rev') {
|
||||||
$string .= "<span class=\"highlight\">revocation: $keyid </span>| <span class=\"date\">" . gmtime($create) . "</span> | ";
|
no warnings qw(uninitialized numeric); # when debugging, comment this out.
|
||||||
|
$string .= "<span class=\"highlight\">revocation: $keyid </span>| " . gmtime($create) . " | ";
|
||||||
(exists $sigcls{$signatureclass})
|
(exists $sigcls{$signatureclass})
|
||||||
? ($string .= $sigcls{$signatureclass})
|
? ($string .= $sigcls{$signatureclass})
|
||||||
: ($string .= $signatureclass);
|
: ($string .= $signatureclass);
|
||||||
|
|
|
||||||
|
|
@ -1,6 +1,6 @@
|
||||||
% layout 'default';
|
% layout 'default';
|
||||||
% title 'Send a public key';
|
% title 'Send a public key';
|
||||||
<h1>Welcome to jjakke's keyserver!</h1>
|
<h1><%= $c->config->{serverh1header} %></h1>
|
||||||
<p><a href="/">index</a></p>
|
<p><a href="/">index</a></p>
|
||||||
<h2>Send a public key (secretly)</h2>
|
<h2>Send a public key (secretly)</h2>
|
||||||
|
|
||||||
|
|
|
||||||
1
todo
1
todo
|
|
@ -1 +0,0 @@
|
||||||
check /pks/add for warnings
|
|
||||||
Loading…
Reference in a new issue