828 lines
26 KiB
Perl
828 lines
26 KiB
Perl
|
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);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|