File Coverage

blib/lib/Crypt/OpenPGP.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

package Crypt::OpenPGP;
use strict;
use 5.008_001;

use vars qw( $VERSION );
$VERSION = '1.07';

use Crypt::OpenPGP::Constants qw( DEFAULT_CIPHER );
use Crypt::OpenPGP::KeyRing;
use Crypt::OpenPGP::Plaintext;
use Crypt::OpenPGP::Message;
use Crypt::OpenPGP::PacketFactory;
use Crypt::OpenPGP::Config;

use Crypt::OpenPGP::ErrorHandler;
use base qw( Crypt::OpenPGP::ErrorHandler );

use File::HomeDir;
use File::Spec;

use vars qw( %COMPAT );

## pgp2 and pgp5 do not trim trailing whitespace from "canonical text"
## signatures, only from cleartext signatures.
## See:
##   http://cert.uni-stuttgart.de/archive/ietf-openpgp/2000/01/msg00033.html
$Crypt::OpenPGP::Globals::Trim_trailing_ws = 1;

{
    my $env = sub {
        my $dir = shift; my @paths;
        if (exists $ENV{$dir}) { for (@_) { push @paths, "$ENV{$dir}/$_" } }
        return @paths ? @paths : ();
    };

    my $home = sub {
        my( @path ) = @_;
        my $home_dir = File::HomeDir->my_home or return;
        return File::Spec->catfile( $home_dir, @path );
    };

    %COMPAT = (
        PGP2 => {
              'sign'    => { Digest => 'MD5', Version => 3 },
              'encrypt' => { Cipher => 'IDEA', Compress => 'ZIP' },
              'keygen'  => { Type => 'RSA', Cipher => 'IDEA',
                             Version => 3, Digest => 'MD5' },
              'PubRing' => [
                     $env->('PGPPATH','pubring.pgp'),
                     $home->( '.pgp', 'pubring.pgp' ),
              ],
              'SecRing' => [
                     $env->('PGPPATH','secring.pgp'),
                     $home->( '.pgp', 'secring.pgp' ),
              ],
              'Config'  => [
                     $env->('PGPPATH', 'config.txt'),
                     $home->( '.pgp', 'config.txt' ),
              ],
        },

        PGP5 => {
              'sign'    => { Digest => 'SHA1', Version => 3 },
              'encrypt' => { Cipher => 'DES3', Compress => 'ZIP' },
              'keygen'  => { Type => 'DSA', Cipher => 'DES3',
                             Version => 4, Digest => 'SHA1' },
              'PubRing' => [
                     $env->('PGPPATH','pubring.pkr'),
                     $home->( '.pgp', 'pubring.pkr' ),
              ],
              'SecRing' => [
                     $env->('PGPPATH','secring.skr'),
                     $home->( '.pgp', 'secring.skr' ),
              ],
              'Config'  => [
                     $env->('PGPPATH', 'pgp.cfg'),
                     $home->( '.pgp', 'pgp.cfg' ),
              ],
        },

        GnuPG => {
              'sign'    => { Digest => 'RIPEMD160', Version => 4 },
              'encrypt' => { Cipher => 'Rijndael', Compress => 'Zlib',
                             MDC => 1 },
              'keygen'  => { Type => 'DSA', Cipher => 'Rijndael',
                             Version => 4, Digest => 'RIPEMD160' },
              'Config'  => [
                     $env->('GNUPGHOME', 'options'),
                     $home->( '.gnupg', 'options' ),
              ],
              'PubRing' => [
                     $env->('GNUPGHOME', 'pubring.gpg'),
                     $home->( '.gnupg', 'pubring.gpg' ),
              ],
              'SecRing' => [
                     $env->('GNUPGHOME', 'secring.gpg'),
                     $home->( '.gnupg', 'secring.gpg' ),
              ],
        },
    );
}

sub version_string { __PACKAGE__ . ' ' . $VERSION }

sub pubrings { $_[0]->{pubrings} }
sub secrings { $_[0]->{secrings} }

use constant PUBLIC => 1;
use constant SECRET => 2;

sub add_ring {
    my $pgp = shift;
    my($type, $ring) = @_;
    unless (ref($ring) eq 'Crypt::OpenPGP::KeyRing') {
        $ring = Crypt::OpenPGP::KeyRing->new( Filename => $ring )
            or return Crypt::OpenPGP::KeyRing->errstr;
    }
    if ($type == SECRET) {
        push @{ $pgp->{secrings} }, $ring;
    } else {
        push @{ $pgp->{pubrings} }, $ring;
    }
    $ring;
}

sub new {
    my $class = shift;
    my $pgp = bless { }, $class;
    $pgp->init(@_);
}

sub _first_exists {
    my($list) = @_;
    for my $f (@$list) {
        next unless $f;
        return $f if -e $f;
    }
}

sub init {
    my $pgp = shift;
    $pgp->{pubrings} = [];
    $pgp->{secrings} = [];
    my %param = @_;
    my $cfg_file = delete $param{ConfigFile};
    my $cfg = $pgp->{cfg} = Crypt::OpenPGP::Config->new(%param) or
        return Crypt::OpenPGP::Config->errstr;
    if (!$cfg_file && (my $compat = $cfg->get('Compat'))) {
        $cfg_file = _first_exists($COMPAT{$compat}{Config});
    }
    if ($cfg_file) {
        $cfg->read_config($param{Compat}, $cfg_file);
    }
    ## Load public and secret keyrings.
    for my $s (qw( PubRing SecRing )) {
        unless (defined $cfg->get($s)) {
            my @compats = $param{Compat} ? ($param{Compat}) : keys %COMPAT;
            for my $compat (@compats) {
                my $ring = _first_exists($COMPAT{$compat}{$s});
                $cfg->set($s, $ring), last if $ring;
            }
        }
        if (my $ring = $cfg->get($s)) {
            $pgp->add_ring($s eq 'PubRing' ? PUBLIC : SECRET, $ring);
        }
    }
    $pgp;
}

sub handle {
    my $pgp = shift;
    my %param = @_;
    my($data);
    unless ($data = $param{Data}) {
        my $file = $param{Filename} or
            return $pgp->error("Need either 'Data' or 'Filename' to decrypt");
        $data = $pgp->_read_files($file) or return $pgp->error($pgp->errstr);
    }
    my $msg = Crypt::OpenPGP::Message->new( Data => $data ) or
        return $pgp->error("Reading data packets failed: " .
            Crypt::OpenPGP::Message->errstr);
    my @pieces = $msg->pieces;
    return $pgp->error("No packets found in message") unless @pieces;
    while (ref($pieces[0]) eq 'Crypt::OpenPGP::Marker') {
        shift @pieces;
    }
    if (ref($pieces[0]) eq 'Crypt::OpenPGP::Compressed') {
        $data = $pieces[0]->decompress or
            return $pgp->error("Decompression error: " . $pieces[0]->errstr);
        $msg = Crypt::OpenPGP::Message->new( Data => $data ) or
            return $pgp->error("Reading decompressed data failed: " .
                Crypt::OpenPGP::Message->errstr);
        @pieces = $msg->pieces;
    }
    my $class = ref($pieces[0]);
    my(%res);
    if ($class eq 'Crypt::OpenPGP::OnePassSig' ||
        $class eq 'Crypt::OpenPGP::Signature') {
        my($valid, $sig) = $pgp->verify( Signature => $data );
        return $pgp->error("Error verifying signature: " . $pgp->errstr)
            if !defined $valid;
        $res{Validity} = $valid;
        $res{Signature} = $sig;
    } else {
        my $cb = $param{PassphraseCallback} || \&_default_passphrase_cb;
        my($pt, $valid, $sig) = $pgp->decrypt(
                      Data => $data,
                      PassphraseCallback => $cb,
                 );
        return $pgp->error("Decryption failed: " . $pgp->errstr)
            unless defined $pt;
        return $pgp->error("Error verifying signature: " . $pgp->errstr)
            if !defined($valid) && $pgp->errstr !~ /^No Signature/;
        $res{Plaintext} = $pt;
        $res{Validity} = $valid if defined $valid;
        $res{Signature} = $sig if defined $sig;
    }
    \%res;
}

sub _default_passphrase_cb {
    my($cert) = @_;
    my $prompt;
    if ($cert) {
        $prompt = sprintf qq(
You need a passphrase to unlock the secret key for
user "%s".
%d-bit %s key, ID %s

Enter passphrase: ), $cert->uid,
                     $cert->key->size,
                     $cert->key->alg,
                     substr($cert->key_id_hex, -8, 8);
    } else {
        $prompt = "Enter passphrase: ";
    }
    _prompt($prompt, '', 1);
}

sub _prompt {
    my($prompt, $def, $noecho) = @_;
    require Term::ReadKey;
    Term::ReadKey->import;
    print STDERR $prompt . ($def ? "[$def] " : "");
    if ($noecho) {
        ReadMode('noecho');
    }
    chomp(my $ans = ReadLine(0));
    ReadMode('restore');
    print STDERR "\n";
    $ans ? $ans : $def;
}

sub sign {
    my $pgp = shift;
    my %param = @_;
    $pgp->_merge_compat(\%param, 'sign') or
        return $pgp->error( $pgp->errstr );
    my($cert, $data);
    require Crypt::OpenPGP::Signature;
    unless ($data = $param{Data}) {
        my $file = $param{Filename} or
            return $pgp->error("Need either 'Data' or 'Filename' to sign");
        $data = $pgp->_read_files($file) or return $pgp->error($pgp->errstr);
    }
    unless ($cert = $param{Key}) {
        my $kid = $param{KeyID} or return $pgp->error("No KeyID specified");
        my $ring = $pgp->secrings->[0]
            or return $pgp->error("No secret keyrings");
        my $kb = $ring->find_keyblock_by_keyid(pack 'H*', $kid) or
            return $pgp->error("Could not find secret key with KeyID $kid");
        $cert = $kb->signing_key;
        $cert->uid($kb->primary_uid);
    }
    if ($cert->is_protected) {
        my $pass = $param{Passphrase};
        if (!defined $pass && (my $cb = $param{PassphraseCallback})) {
            $pass = $cb->($cert);
        }
        return $pgp->error("Need passphrase to unlock secret key")
            unless $pass;
        $cert->unlock($pass) or
            return $pgp->error("Secret key unlock failed: " . $cert->errstr);
    }
    my @ptarg;
    push @ptarg, ( Filename => $param{Filename} ) if $param{Filename};
    if ($param{Clearsign}) {
        push @ptarg, ( Mode => 't' );
        ## In clear-signed messages, the line ending before the signature
        ## is not considered part of the signed text.
        (my $tmp = $data) =~ s!\r?\n$!!;
        push @ptarg, ( Data => $tmp );
    } else {
        push @ptarg, ( Data => $data );
    }
    my $pt = Crypt::OpenPGP::Plaintext->new(@ptarg);
    my @sigarg;
    if (my $hash_alg = $param{Digest}) {
        my $dgst = Crypt::OpenPGP::Digest->new($hash_alg) or
            return $pgp->error( Crypt::OpenPGP::Digest->errstr );
        @sigarg = ( Digest => $dgst->alg_id );
    }
    push @sigarg, (Type => 0x01) if $param{Clearsign};
    my $sig = Crypt::OpenPGP::Signature->new(
                          Data => $pt,
                          Key  => $cert,
                          Version => $param{Version},
                          @sigarg,
                 );
    if ($param{Clearsign}) {
        $param{Armour} = $param{Detach} = 1;
    }
    my $sig_data = Crypt::OpenPGP::PacketFactory->save($sig,
        $param{Detach} ? () : ($pt));
    if ($param{Armour}) {
        require Crypt::OpenPGP::Armour;
        $sig_data = Crypt::OpenPGP::Armour->armour(
                          Data => $sig_data,
                          Object => ($param{Detach} ? 'SIGNATURE' : 'MESSAGE'),
                 ) or return $pgp->error( Crypt::OpenPGP::Armour->errstr );
    }
    if ($param{Clearsign}) {
        require Crypt::OpenPGP::Util;
        my $hash = Crypt::OpenPGP::Digest->alg($sig->{hash_alg});
        my $data = Crypt::OpenPGP::Util::dash_escape($data);
        $data .= "\n" unless $data =~ /\n$/;
        $sig_data = "-----BEGIN PGP SIGNED MESSAGE-----\n" .
                    ($hash eq 'MD5' ? '' : "Hash: $hash\n") .
                    "\n" .
                    $data .
                    $sig_data;
    }
    $sig_data;
}

sub verify {
    my $pgp = shift;
    my %param = @_;
    my $wants_object = wantarray;
    my($data, $sig);
    require Crypt::OpenPGP::Signature;
    $param{Signature} or $param{SigFile} or
            return $pgp->error("Need Signature or SigFile to verify");
    my %arg = $param{Signature} ? (Data => $param{Signature}) :
                                  (Filename => $param{SigFile});
    $arg{IsPacketStream} = 1 if $param{IsPacketStream};
    my $msg = Crypt::OpenPGP::Message->new( %arg ) or
        return $pgp->error("Reading signature failed: " .
            Crypt::OpenPGP::Message->errstr);
    my @pieces = $msg->pieces;
    if (ref($pieces[0]) eq 'Crypt::OpenPGP::Compressed') {
        $data = $pieces[0]->decompress or
            return $pgp->error("Decompression error: " . $pieces[0]->errstr);
        $msg = Crypt::OpenPGP::Message->new( Data => $data ) or
            return $pgp->error("Reading decompressed data failed: " .
                Crypt::OpenPGP::Message->errstr);
        @pieces = $msg->pieces;
    }
    if (ref($pieces[0]) eq 'Crypt::OpenPGP::OnePassSig') {
        ($data, $sig) = @pieces[1,2];
    } elsif (ref($pieces[0]) eq 'Crypt::OpenPGP::Signature') {
        ($sig, $data) = @pieces[0,1];
    } else {
        return $pgp->error("SigFile contents are strange");
    }
    unless ($data) {
        if ($param{Data}) {
            $data = Crypt::OpenPGP::Plaintext->new( Data => $param{Data} );
        }
        else {
            ## if no Signature or detached sig in SigFile
            my @files = ref($param{Files}) eq 'ARRAY' ? @{ $param{Files} } :
                            $param{Files};
            my $fdata = $pgp->_read_files(@files);
            return $pgp->error("Reading data files failed: " . $pgp->errstr)
                unless defined $fdata;
            $data = Crypt::OpenPGP::Plaintext->new( Data => $fdata );
       }
    }
    my($cert, $kb);
    unless ($cert = $param{Key}) {
        my $key_id = $sig->key_id;
        my $ring = $pgp->pubrings->[0];
        unless ($ring && ($kb = $ring->find_keyblock_by_keyid($key_id))) {
            my $cfg = $pgp->{cfg};
            if ($cfg->get('AutoKeyRetrieve') && $cfg->get('KeyServer')) {
                require Crypt::OpenPGP::KeyServer;
                my $server = Crypt::OpenPGP::KeyServer->new(
                                Server => $cfg->get('KeyServer'),
                          );
                $kb = $server->find_keyblock_by_keyid($key_id);
            }
            return $pgp->error("Could not find public key with KeyID " .
                unpack('H*', $key_id))
                unless $kb;
        }
        $cert = $kb->signing_key;
    }

## pgp2 and pgp5 do not trim trailing whitespace from "canonical text"
## signatures, only from cleartext signatures. So we first try to verify
## the signature using proper RFC4880 canonical text, then if that fails,
## retry without trimming trailing whitespace.
## See:
##   http://cert.uni-stuttgart.de/archive/ietf-openpgp/2000/01/msg00033.html
    my($dgst, $found);
    for (1, 0) {
        local $Crypt::OpenPGP::Globals::Trim_trailing_ws = $_;
        $dgst = $sig->hash_data($data) or
            return $pgp->error( $sig->errstr );
        $found++, last if substr($dgst, 0, 2) eq $sig->{chk};
    }
    return $pgp->error("Message hash does not match signature checkbytes")
        unless $found;
    my $valid = $cert->key->public_key->verify($sig, $dgst) ?
      ($kb && $kb->primary_uid ? $kb->primary_uid : 1) : 0;

    $wants_object ? ($valid, $sig) : $valid;
}

sub encrypt {
    my $pgp = shift;
    my %param = @_;
    $pgp->_merge_compat(\%param, 'encrypt') or
        return $pgp->error( $pgp->errstr );
    my($data);
    require Crypt::OpenPGP::Cipher;
    require Crypt::OpenPGP::Ciphertext;
    unless ($data = $param{Data}) {
        my $file = $param{Filename} or
            return $pgp->error("Need either 'Data' or 'Filename' to encrypt");
        $data = $pgp->_read_files($file) or return $pgp->error($pgp->errstr);
    }
    my $ptdata;
    if ($param{SignKeyID}) {
        $ptdata = $pgp->sign(
                         Data       => $data,
                         KeyID      => $param{SignKeyID},
                         Compat     => $param{Compat},
                         Armour     => 0,
                         Passphrase => $param{SignPassphrase},
                         PassphraseCallback => $param{SignPassphraseCallback},
                  )
            or return;
    } else {
        my $pt = Crypt::OpenPGP::Plaintext->new( Data => $data,
                      $param{Filename} ? (Filename => $param{Filename}) : () );
        $ptdata = Crypt::OpenPGP::PacketFactory->save($pt);
    }
    if (my $alg = $param{Compress}) {
        require Crypt::OpenPGP::Compressed;
        $alg = Crypt::OpenPGP::Compressed->alg_id($alg);
        my $cdata = Crypt::OpenPGP::Compressed->new( Data => $ptdata,
            Alg => $alg ) or return $pgp->error("Compression error: " .
                Crypt::OpenPGP::Compressed->errstr);
        $ptdata = Crypt::OpenPGP::PacketFactory->save($cdata);
    }
    require Crypt::Random;
    my $key_data = Crypt::Random::makerandom_octet( Length => 32 );
    my $sym_alg = $param{Cipher} ?
        Crypt::OpenPGP::Cipher->alg_id($param{Cipher}) : DEFAULT_CIPHER;
    my(@sym_keys);
    if ($param{Recipients} && !ref($param{Recipients})) {
        $param{Recipients} = [ $param{Recipients} ];
    }
    if (my $kid = delete $param{KeyID}) {
        my @kid = ref $kid eq 'ARRAY' ? @$kid : $kid;
        push @{ $param{Recipients} }, @kid;
    }
    if ($param{Key} || $param{Recipients}) {
        require Crypt::OpenPGP::SessionKey;
        my @keys;
        if (my $recips = $param{Recipients}) {
            my @recips = ref $recips eq 'ARRAY' ? @$recips : $recips;
            my $ring = $pgp->pubrings->[0];
            my %seen;
            my $server;
            my $cfg = $pgp->{cfg};
            if ($cfg->get('AutoKeyRetrieve') && $cfg->get('KeyServer')) {
                require Crypt::OpenPGP::KeyServer;
                $server = Crypt::OpenPGP::KeyServer->new(
                                Server => $cfg->get('KeyServer'),
                          );
            }
            for my $r (@recips) {
                my($lr, @kb) = (length($r));
                if (($lr == 8 || $lr == 16) && $r !~ /[^\da-fA-F]/) {
                    my $id = pack 'H*', $r;
                    @kb = $ring->find_keyblock_by_keyid($id) if $ring;
                    @kb = $server->find_keyblock_by_keyid($id)
                        if !@kb && $server;
                } else {
                    @kb = $ring->find_keyblock_by_uid($r) if $ring;
                    @kb = $server->find_keyblock_by_uid($r)
                        if !@kb && $server;
                }
                for my $kb (@kb) {
                    next unless my $cert = $kb->encrypting_key;
                    next if $seen{ $cert->key_id }++;
                    $cert->uid($kb->primary_uid);
                    push @keys, $cert;
                }
            }
            if (my $cb = $param{RecipientsCallback}) {
                @keys = @{ $cb->(\@keys) };
            }
        }
        if ($param{Key}) {
            push @keys, ref $param{Key} eq 'ARRAY' ? @{$param{Key}} :
                                                       $param{Key};
        }
        return $pgp->error("No known recipients for encryption")
            unless @keys;
        for my $key (@keys) {
            push @sym_keys, Crypt::OpenPGP::SessionKey->new(
                                Key    => $key,
                                SymKey => $key_data,
                                Cipher => $sym_alg,
                          ) or
                return $pgp->error( Crypt::OpenPGP::SessionKey->errstr );
        }
    }
    elsif (my $pass = $param{Passphrase}) {
        require Crypt::OpenPGP::SKSessionKey;
        require Crypt::OpenPGP::S2k;
        my $s2k;
        if ($param{Compat} && $param{Compat} eq 'PGP2') {
            $s2k = Crypt::OpenPGP::S2k->new('Simple');
            $s2k->{hash} = Crypt::OpenPGP::Digest->new('MD5');
        } else {
            $s2k = Crypt::OpenPGP::S2k->new('Salt_Iter');
        }
        my $keysize = Crypt::OpenPGP::Cipher->new($sym_alg)->keysize;
        $key_data = $s2k->generate($pass, $keysize);
        push @sym_keys, Crypt::OpenPGP::SKSessionKey->new(
                            Passphrase => $pass,
                            SymKey     => $key_data,
                            Cipher     => $sym_alg,
                            S2k        => $s2k,
                      ) or
            return $pgp->error( Crypt::OpenPGP::SKSessionKey->errstr );
    } else {
        return $pgp->error("Need something to encrypt with");
    }
    my $enc = Crypt::OpenPGP::Ciphertext->new(
                        MDC    => $param{MDC},
                        SymKey => $key_data,
                        Data   => $ptdata,
                        Cipher => $sym_alg,
                  );
    my $enc_data = Crypt::OpenPGP::PacketFactory->save(
        $param{Passphrase} && $param{Compat} && $param{Compat} eq 'PGP2' ?
        $enc : (@sym_keys, $enc)
    );
    if ($param{Armour}) {
        require Crypt::OpenPGP::Armour;
        $enc_data = Crypt::OpenPGP::Armour->armour(
                          Data => $enc_data,
                          Object => 'MESSAGE',
                 ) or return $pgp->error( Crypt::OpenPGP::Armour->errstr );
    }
    $enc_data;
}

sub decrypt {
    my $pgp = shift;
    my %param = @_;
    my $wants_verify = wantarray;
    my($data);
    unless ($data = $param{Data}) {
        my $file = $param{Filename} or
            return $pgp->error("Need either 'Data' or 'Filename' to decrypt");
        $data = $pgp->_read_files($file) or return $pgp->error($pgp->errstr);
    }
    my $msg = Crypt::OpenPGP::Message->new( Data => $data ) or
        return $pgp->error("Reading data packets failed: " .
            Crypt::OpenPGP::Message->errstr);
    my @pieces = $msg->pieces;
    return $pgp->error("No packets found in message") unless @pieces;
    while (ref($pieces[0]) eq 'Crypt::OpenPGP::Marker') {
        shift @pieces;
    }
    my($key, $alg);
    if (ref($pieces[0]) eq 'Crypt::OpenPGP::SessionKey') {
        my($sym_key, $cert, $ring) = (shift @pieces);
        unless ($cert = $param{Key}) {
            $ring = $pgp->secrings->[0]
                or return $pgp->error("No secret keyrings");
        }
        my($kb);
        while (ref($sym_key) eq 'Crypt::OpenPGP::SessionKey') {
            if ($cert) {
                if ($cert->key_id eq $sym_key->key_id) {
                    shift @pieces
                        while ref($pieces[0]) eq 'Crypt::OpenPGP::SessionKey';
                    last;
                }
            } else {
                if ($kb = $ring->find_keyblock_by_keyid($sym_key->key_id)) {
                    shift @pieces
                        while ref($pieces[0]) eq 'Crypt::OpenPGP::SessionKey';
                    last;
                }
            }
            $sym_key = shift @pieces;
        }
        return $pgp->error("Can't find a secret key to decrypt message")
            unless $kb || $cert;
        if ($kb) {
            $cert = $kb->encrypting_key;
            $cert->uid($kb->primary_uid);
        }
        if ($cert->is_protected) {
            my $pass = $param{Passphrase};
            if (!defined $pass && (my $cb = $param{PassphraseCallback})) {
                $pass = $cb->($cert);
            }
            return $pgp->error("Need passphrase to unlock secret key")
                unless $pass;
            $cert->unlock($pass) or
                return $pgp->error("Seckey unlock failed: " . $cert->errstr);
        }
        ($key, $alg) = $sym_key->decrypt($cert) or
            return $pgp->error("Symkey decrypt failed: " . $sym_key->errstr);
    }
    elsif (ref($pieces[0]) eq 'Crypt::OpenPGP::SKSessionKey') {
        my $sym_key = shift @pieces;
        my $pass = $param{Passphrase};
        if (!defined $pass && (my $cb = $param{PassphraseCallback})) {
            $pass = $cb->();
        }
        return $pgp->error("Need passphrase to decrypt session key")
            unless $pass;
        ($key, $alg) = $sym_key->decrypt($pass) or
            return $pgp->error("Symkey decrypt failed: " . $sym_key->errstr);
    }
    my $enc = $pieces[0];

    ## If there is still no symkey and symmetric algorithm, *and* the
    ## first packet is a Crypt::OpenPGP::Ciphertext packet, assume that
    ## the packet is encrypted using a symmetric key, using a 'Simple' s2k.
    if (!$key && !$alg && ref($enc) eq 'Crypt::OpenPGP::Ciphertext') {
        my $pass = $param{Passphrase} or
            return $pgp->error("Need passphrase to decrypt session key");
        require Crypt::OpenPGP::Cipher;
        require Crypt::OpenPGP::S2k;
        my $ciph = Crypt::OpenPGP::Cipher->new('IDEA');
        my $s2k = Crypt::OpenPGP::S2k->new('Simple');
        $s2k->{hash} = Crypt::OpenPGP::Digest->new('MD5');
        $key = $s2k->generate($pass, $ciph->keysize);
        $alg = $ciph->alg_id;
    }

    $data = $enc->decrypt($key, $alg) or
        return $pgp->error("Ciphertext decrypt failed: " . $enc->errstr);

    ## This is a special hack: if decrypt gets a signed, encrypted message,
    ## it needs to be able to pass back the decrypted text *and* a flag
    ## saying whether the signature is valid or not. But in some cases,
    ## you don't know ahead of time if there is a signature at all--and if
    ## there isn't, there is no way of knowing whether the signature is valid,
    ## or if there isn't a signature at all. So this prepopulates the internal
    ## errstr with the string "No Signature\n"--if there is a signature, and
    ## there is an error during verification, the second return value will be
    ## undef, and the errstr will contain the error that occurred. If there is
    ## *not* a signature, the second return value will still be undef, but
    ## the errstr is guaranteed to be "No Signature\n".
    $pgp->error("No Signature");

    my($valid, $sig);
    $msg = Crypt::OpenPGP::Message->new( Data => $data,
                                         IsPacketStream => 1 );
    @pieces = $msg->pieces;

    ## If the first packet in the decrypted data is compressed,
    ## decompress it and set the list of packets to the result.
    if (ref($pieces[0]) eq 'Crypt::OpenPGP::Compressed') {
        $data = $pieces[0]->decompress or
            return $pgp->error("Decompression error: " . $pieces[0]->errstr);
        $msg = Crypt::OpenPGP::Message->new( Data => $data,
                                             IsPacketStream => 1 );
        @pieces = $msg->pieces;
    }

    my($pt);
    if (ref($pieces[0]) eq 'Crypt::OpenPGP::OnePassSig' ||
        ref($pieces[0]) eq 'Crypt::OpenPGP::Signature') {
        $pt = $pieces[1];
        if ($wants_verify) {
            ($valid, $sig) =
                $pgp->verify( Signature => $data, IsPacketStream => 1 );
        }
    } else {
        $pt = $pieces[0];
    }

    $wants_verify ? ($pt->data, $valid, $sig) : $pt->data;
}

sub keygen {
    my $pgp = shift;
    my %param = @_;
    require Crypt::OpenPGP::Certificate;
    require Crypt::OpenPGP::Key;
    require Crypt::OpenPGP::KeyBlock;
    require Crypt::OpenPGP::Signature;
    require Crypt::OpenPGP::UserID;

    $param{Type} or
        return $pgp->error("Need a Type of key to generate");
    $param{Size} ||= 1024;
    $param{Version} ||= 4;
    $param{Version} = 3 if $param{Type} eq 'RSA';

    my $kb_pub = Crypt::OpenPGP::KeyBlock->new;
    my $kb_sec = Crypt::OpenPGP::KeyBlock->new;

    my($pub, $sec) = Crypt::OpenPGP::Key->keygen($param{Type}, %param);
    die Crypt::OpenPGP::Key->errstr unless $pub && $sec;
    my $pubcert = Crypt::OpenPGP::Certificate->new(
                             Key        => $pub,
                             Version    => $param{Version}
                ) or
        die Crypt::OpenPGP::Certificate->errstr;
    my $seccert = Crypt::OpenPGP::Certificate->new(
                             Key        => $sec,
                             Passphrase => $param{Passphrase},
                             Version    => $param{Version}
                ) or
        die Crypt::OpenPGP::Certificate->errstr;
    $kb_pub->add($pubcert);
    $kb_sec->add($seccert);

    my $id = Crypt::OpenPGP::UserID->new( Identity => $param{Identity} );
    $kb_pub->add($id);
    $kb_sec->add($id);

    my $sig = Crypt::OpenPGP::Signature->new(
                             Data    => [ $pubcert, $id ],
                             Key     => $seccert,
                             Version => $param{Version},
                             Type    => 0x13,
               );
    $kb_pub->add($sig);
    $kb_sec->add($sig);

    ($kb_pub, $kb_sec);
}

sub _read_files {
    my $pgp = shift;
    return $pgp->error("No files specified") unless @_;
    my @files = @_;
    my $data = '';
    for my $file (@files) {
        $file ||= '';
        local *FH;
        open FH, $file or return $pgp->error("Error opening $file: $!");
        binmode FH;
        { local $/; $data .=  }
        close FH or warn "Warning: Got error closing $file: $!";
    }
    $data;
}

{
    my @MERGE_CONFIG = qw( Cipher Armour Digest );
    sub _merge_compat {
        my $pgp = shift;
        my($param, $meth) = @_;
        my $compat = $param->{Compat} || $pgp->{cfg}->get('Compat') || return 1;
        my $ref = $COMPAT{$compat}{$meth} or
            return $pgp->error("No settings for Compat class '$compat'");
        for my $arg (keys %$ref) {
            $param->{$arg} = $ref->{$arg} unless exists $param->{$arg};
        }
        for my $key (@MERGE_CONFIG) {
            $param->{$key} = $pgp->{cfg}->get($key)
                unless exists $param->{$key};
        }
        1;
    }
}

1;

__END__