Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

Crypt::OpenPGP - finding and using preferred SK algorithm

by hv (Prior)
on Feb 03, 2004 at 16:40 UTC ( [id://326235]=sourcecode: print w/replies, xml ) Need Help??
Category: Cryptography
Author/Contact Info hv
Description:

Crypt::OpenPGP provides no overt mechanism to interrogate a self-signed key to determine the owner's preferred encryption mechanisms. After pointers in Crypt::OpenPGP - determining which cipher to use I came up with this sample code that shows how you can do that.

Caveats: delves into object innards, provided for education only, tested only with modern (v4) signatures, assumption that code is self-documenting may be dubious.

#!/usr/bin/perl -w
use Crypt::OpenPGP;
use Crypt::OpenPGP::KeyRing;

my($keyfile, $email) = @ARGV;
my $ring = Crypt::OpenPGP::KeyRing->new(Filename => $keyfile);
my $pgp = Crypt::OpenPGP->new(PubRing => $ring);
my $kb = $ring->find_keyblock_by_uid($email);
my $alg = $kb->preferred_sk_alg;
my $crypt = $pgp->encrypt(
    Data => 'squeamish ossifrage',
    Recipients => [ $email ],
    Armour => 1,
    ($alg ? (Cipher => $alg) : ()), # use default if no preference loc
+ated
);
print $crypt;
exit 0;

{
    package Crypt::OpenPGP::KeyBlock;
    sub preferred_sk_alg {
        my $self = shift;
        use Crypt::OpenPGP::Cipher;
        my $supported = Crypt::OpenPGP::Cipher->supported;
        my @prefs;
        for my $sig (@{ $self->get('Crypt::OpenPGP::Signature') }) {
            if ($sig->is_primary) {
                unshift @prefs, @{ $sig->preferred_sk_alg };
            } else {
                push @prefs, @{ $sig->preferred_sk_alg };
            }
        }
        for (@prefs) {
            return $_ if $supported->{$_};
        }
        return;
    }
}
{
    package Crypt::OpenPGP::Signature;
    sub is_primary {
        my $self = shift;
        my $packet = $self->find_subpacket(25); # primary user id
        ($packet && $packet->{data}) || 0;
    }
    sub preferred_sk_alg {
        my $self = shift;
        my $packet = $self->find_subpacket(11); # preferred SK algorit
+hms
        $packet ? $packet->{data} : [];
    }
}

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://326235]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others lurking in the Monastery: (3)
As of 2024-04-25 20:59 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found