view release on metacpan or  search on metacpan

lib/Crypt/OpenPGP.pm  view on Meta::CPAN

            return $pgp->error("Could not find public key with KeyID " .
                unpack('H*', $key_id))
                unless $kb;
        }
        $cert = $kb->key_by_id($sig->key_id);
    }

## 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 (defined($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);
    }
    my $key_data = Crypt::OpenPGP::Util::get_random_bytes(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,