File Coverage

blib/lib/AnyEvent/GnuPG.pm

Criterion	Covered	Total	%
statement	435	625	69.6
branch	196	390	50.2
condition	25	68	36.7
subroutine	69	92	75.0
pod	21	21	100.0
total	746	1196	62.3

use strict;
use warnings;

package AnyEvent::GnuPG;

# ABSTRACT: AnyEvent-based interface to the GNU Privacy Guard

use Exporter 'import';
use AnyEvent;
use AnyEvent::Proc 0.104;
use Email::Address;
use Async::Chain;
use Try::Tiny;
use Carp qw(confess);

use constant RSA_RSA     => 1;
use constant DSA_ELGAMAL => 2;
use constant DSA         => 3;
use constant RSA         => 4;

use constant TRUST_UNDEFINED => -1;
use constant TRUST_NEVER     => 0;
use constant TRUST_MARGINAL  => 1;
use constant TRUST_FULLY     => 2;
use constant TRUST_ULTIMATE  => 3;

our $VERSION = '1.001';    # VERSION

our @EXPORT = qw();

our %EXPORT_TAGS = (
    algo  => [qw[ RSA_RSA DSA_ELGAMAL DSA RSA ]],
    trust => [
        qw[ TRUST_UNDEFINED TRUST_NEVER TRUST_MARGINAL TRUST_FULLY TRUST_ULTIMATE ]
    ],
);

Exporter::export_ok_tags(qw( algo trust ));

sub _options {
    my $self = shift;
    $self->{cmd_options} = shift if ( $_[0] );
    $self->{cmd_options};
}

sub _command {
    my $self = shift;
    $self->{command} = shift if ( $_[0] );
    $self->{command};
}

sub _args {
    my $self = shift;
    $self->{args} = shift if ( $_[0] );
    $self->{args};
}

sub _cmdline {
    my $self = shift;
    my $args = [ $self->{gnupg_path} ];

    # Default options
    push @$args, "--no-tty", "--no-greeting", "--yes";

    # Check for homedir and options file
    push @$args, "--homedir", $self->{homedir} if $self->{homedir};
    push @$args, "--options", $self->{options} if $self->{options};

    # Command options
    push @$args, @{ $self->_options };

    # Command and arguments
    push @$args, "--" . $self->_command;
    push @$args, @{ $self->_args };

    return $args;
}

sub _condvar {
    my $cb = shift;
    return $cb if ref $cb eq 'AnyEvent::CondVar';
    my $cv = AE::cv;
    $cv->cb($cb) if ref $cb eq 'CODE';
    $cb ||= '';
    $cv;
}

sub _croak {
    my ( $cv, $msg ) = @_;
    AE::log error => $msg;
    $cv->croak($msg);
    $cv;
}

sub _catch {
    my ( $cv1, $cb ) = @_;
    AE::cv {
        my $cv2 = shift;
        try {
            $cb->( $cv2->recv );
        }
        catch {
            s{ at \S+ line \d+\.\s+$}{};
            $cv1->croak($_)
        };
    }
}

sub _eq($_) { shift eq pop }    ## no critic

sub _parse_status {
    my ( $self, $cv, %actions ) = @_;
    my $commands;
    $self->{status_fd}->readlines_cb(
        sub {
            my $line = shift;
            unless ( defined $line ) {
                AE::log debug => "end of status parsing";
                $cv->send($commands);
            }
            if ( my ( $cmd, $arg ) =
                $line =~ m{^\[gnupg:\]\s+(\w+)\s*(.+)?\s*$}i )
            {
                $arg ||= '';
                my @args = $arg ? ( split /\s+/, $arg ) : ();
                AE::log debug => "got command: $cmd ($arg)";
                try {
                    for ( lc $cmd ) {
                        _eq('newsig')  && do { last };
                        _eq('goodsig') && do { last };
                        _eq('expsig')
                          && do { die "the signature is expired ($arg)" };
                        _eq('expkeysig') && do {
                            die
                              "the signature was made by an expired key ($arg)";
                        };
                        _eq('revkeysig') && do {
                            die
                              "the signature was made by an revoked key ($arg)";
                        };
                        _eq('badsig') && do {
                            die
                              "the signature has not been verified okay ($arg)";
                        };
                        _eq('errsig') && do {
                            die "the signature could not be verified ($arg)";
                        };
                        _eq('validsig') && do { last };
                        _eq('sig_id')   && do { last };
                        _eq('enc_to')   && do { last };
                        _eq('nodata')   && do {
                            for ($arg) {
                                _eq('1') && die "no armored data";
                                _eq('2')
                                  && die
                                  "expected a packet but did not found one";
                                _eq('3') && die "invalid packet found";
                                _eq('4')
                                  && die "signature expected but not found";
                                die "no data has been found";
                            }
                        };
                        _eq('unexpected')
                          && do { die "unexpected data has been encountered" };
                        _eq('trust_undefined')
                          && do { die "signature trust undefined: $arg" };
                        _eq('trust_never')
                          && do { die "signature trust is never: $arg" };
                        _eq('trust_marginal') && do { last };
                        _eq('trust_fully')    && do { last };
                        _eq('trust_ultimate') && do { last };
                        _eq('pka_trust_good') && do { last };
                        _eq('pka_trust_bad')  && do { last };
                        _eq('sigexpired')
                          or _eq('keyexpired') && do {
                            die "the key has expired since "
                              . ( scalar localtime $arg );
                          };
                        _eq('keyrevoked') && do {
                            die "the used key has been revoked by its owner";
                        };
                        _eq('badarmor')
                          && do { die "the ASCII armor is corrupted" };
                        _eq('rsa_or_idea')         && do { last };
                        _eq('shm_info')            && do { last };
                        _eq('shm_get')             && do { last };
                        _eq('shm_get_bool')        && do { last };
                        _eq('shm_get_hidden')      && do { last };
                        _eq('get_bool')            && do { last };
                        _eq('get_line')            && do { last };
                        _eq('get_hidden')          && do { last };
                        _eq('got_it')              && do { last };
                        _eq('need_passphrase')     && do { last };
                        _eq('need_passphrase_sym') && do { last };
                        _eq('need_passphrase_pin') && do { last };
                        _eq('missing_passphrase')
                          && do { die "no passphrase was supplied" };
                        _eq('bad_passphrase') && do {
                            die
                              "the supplied passphrase was wrong or not given";
                        };
                        _eq('good_passphrase') && do { last };
                        _eq('decryption_failed')
                          && do { die "the symmetric decryption failed" };
                        _eq('decryption_okay') && do { last };
                        _eq('decryption_info') && do { last };
                        _eq('no_pubkey')
                          && do { die "the public key is not available" };
                        _eq('no_seckey')
                          && do { die "the private key is not available" };
                        _eq('import_check') && do { last };
                        _eq('imported')
                          && do { @args = split /\s+/, $arg, 2; last };
                        _eq('import_ok') && do { last };
                        _eq('import_problem') && do {

                            for ($arg) {
                                _eq('0')
                                  && die
                                  "import failed with no specific reason";
                                _eq('1') && die "invalid certificate";
                                _eq('2') && die "issuer certificate missing";
                                _eq('3') && die "certificate chain too long";
                                _eq('4') && die "error storing certificate";
                                die "import failed";
                            }
                        };
                        _eq('import_res')       && do { last };
                        _eq('file_start')       && do { last };
                        _eq('file_done')        && do { last };
                        _eq('begin_decryption') && do { last };
                        _eq('end_decryption')   && do { last };
                        _eq('begin_encryption') && do { last };
                        _eq('end_encryption')   && do { last };
                        _eq('begin_signing')    && do { last };
                        _eq('delete_problem')   && do {

                            for ($arg) {
                                _eq('1') && die "delete failed: no such key";
                                _eq('2')
                                  && die
                                  "delete failed: must delete secret key first";
                                _eq('3')
                                  && die
                                  "delete failed: ambigious specification";
                                die "delete failed";
                            }
                        };
                        _eq('progress')    && do { last };
                        _eq('sig_created') && do { last };
                        _eq('key_created') && do { last };
                        _eq('key_not_created') && do {
                            die "the key from batch run has not been created";
                        };
                        _eq('session_key')   && do { last };
                        _eq('notation_name') && do { last };
                        _eq('notation_data') && do { last };
                        _eq('userid_hint')   && do { last };
                        _eq('policy_url')    && do { last };
                        _eq('begin_stream')  && do { last };
                        _eq('end_stream')    && do { last };
                        ( _eq('inv_recp') or _eq('inc_sgnr') ) && do {
                            my $prefix = 'invalid';
                            for ($cmd) {
                                _eq('inv_recp')
                                  && do { $prefix .= ' recipient' };
                                _eq('inv_sgnr') && do { $prefix .= ' sender' };
                            }
                            $prefix .= ': ';
                            for ( shift(@args) ) {
                                _eq('0') && die $prefix . "no specific reason";
                                _eq('1') && die $prefix . "not found";
                                _eq('2')
                                  && die $prefix . "ambigious specification";
                                _eq('3')  && die $prefix . "wrong key usage";
                                _eq('4')  && die $prefix . "key revoked";
                                _eq('5')  && die $prefix . "key expired";
                                _eq('6')  && die $prefix . "no CRL known";
                                _eq('7')  && die $prefix . "CRL too old";
                                _eq('8')  && die $prefix . "policy mismatch";
                                _eq('9')  && die $prefix . "not a secret key";
                                _eq('10') && die $prefix . "key not trusted";
                                _eq('11')
                                  && die $prefix . "missing certificate";
                                _eq('12')
                                  && die $prefix . "missing issuer certificate";
                                die $prefix . '???';
                            }
                        };
                        _eq('no_recp') && do { die "no recipients are usable" };
                        _eq('no_sgnr') && do { die "no senders are usable" };
                        _eq('already_signed')   && do { last };
                        _eq('truncated')        && do { last };
                        _eq('error')            && do { die $arg };
                        _eq('success')          && do { last };
                        _eq('attribute')        && do { last };
                        _eq('cardctrl')         && do { last };
                        _eq('plaintext')        && do { last };
                        _eq('plaintext_length') && do { last };
                        _eq('sig_subpacket')    && do { last };
                        _eq('sc_op_failure')
                          && do { die "smartcard failure ($arg)" };
                        _eq('sc_op_success')      && do { last };
                        _eq('backup_key_created') && do { last };
                        _eq('mountpoint')         && do { last };
                        AE::log note => "unknown command: $cmd";
                    }
                    my $result;
                    if ( $actions{ lc($cmd) } ) {
                        $result = $actions{ lc($cmd) }->(@args);
                    }
                    push @$commands => {
                        cmd    => $cmd,
                        arg    => $arg,
                        args   => \@args,
                        result => $result
                    };
                }
                catch {
                    s{\s+$}{};
                    $self->_abort_gnupg( $_, $cv );
                }
                finally {
                    AE::log debug => "arguments parsed as: ["
                      . ( join ', ', map { "'$_'" } @args ) . "]";
                }
            }
            else {
                return $self->_abort_gnupg(
                    "error communicating with gnupg: bad status line: $line",
                    $cv );
            }
        }
    );
    $cv;
}

sub _abort_gnupg {
    my ( $self, $msg, $cb ) = @_;
    my $cv = _condvar($cb);
    AE::log error => $msg if $msg;
    if ( $self->{gnupg_proc} ) {
        $self->{gnupg_proc}->fire_and_kill(
            10,
            sub {
                AE::log debug => "fired and killed";
                $self->_end_gnupg(
                    sub {
                        AE::log debug => "gnupg aborted";
                        $cv->croak($msg);
                    }
                );
            }
        );
    }
    $cv;
}

sub _end_gnupg {
    my ( $self, $cb ) = @_;
    my $cv = _condvar($cb);

    if ( ref $self->{input} eq 'GLOB' ) {
        close $self->{input};
    }

    if ( $self->{command_fd} ) {
        $self->{command_fd}->finish;
    }

    if ( 0 && $self->{status_fd} ) {
        $self->{status_fd}->A->destroy;
    }

    if ( $self->{gnupg_proc} ) {

        $self->{gnupg_proc}->wait(
            sub {
                if ( ref $self->{output} eq 'GLOB' ) {
                    close $self->{output};
                }

                for (
                    qw(protocol proc command options args status_fd command_fd input output next_status )
                  )
                {
                    delete $self->{$_};
                }

                AE::log debug => "gnupg exited";
                $cv->send;
            }
        );

    }
    else {
        $cv->send;
    }
    $cv;
}

sub _run_gnupg {
    my ( $self, $cv ) = @_;

    if ( defined $self->{input} and not ref $self->{input} ) {
        my $file = $self->{input};
        open( my $fh, '<', $file ) or die "cannot open file $file: $!";
        AE::log info => "input file $file opened at $fh";
        $self->{input} = $fh;
    }

    if ( defined $self->{output} and not ref $self->{output} ) {
        my $file = $self->{output};
        open( my $fh, '>', $file ) or die "cannot open file $file: $!";
        AE::log info => "output file $file opened at $fh";
        $self->{output} = $fh;
    }

    my $cmdline = $self->_cmdline;

    my $gpg = shift @$cmdline;

    my $status  = AnyEvent::Proc::reader();
    my $command = AnyEvent::Proc::writer();

    unshift @$cmdline, '--status-fd'  => $status;
    unshift @$cmdline, '--command-fd' => $command;

    my $err;

    AE::log debug => "running $gpg " . join( ' ' => @$cmdline );
    my $proc = AnyEvent::Proc->new(
        bin           => $gpg,
        args          => $cmdline,
        extras        => [ $status, $command ],
        ttl           => 600,
        on_ttl_exceed => sub { $self->_abort_gnupg( 'ttl exceeded', $cv ) },
        errstr        => \$err,
    );

    if ( defined $self->{input} ) {
        $proc->pull( $self->{input} );
    }

    if ( defined $self->{output} ) {
        $proc->pipe( out => $self->{output} );
    }

    $self->{command_fd} = $command;
    $self->{status_fd}  = $status;
    $self->{gnupg_proc} = $proc;

    AE::log debug => "gnupg ready";

    $proc;
}

sub _send_command {
    shift->{command_fd}->writeln(pop);
}

sub DESTROY {
    my $self = shift;

    $self->{gnupg_proc}->kill if $self->{gnupg_proc};
}

sub new {
    my $proto = shift;
    my $class = ref $proto || $proto;

    my %args = @_;

    my $self = {};
    if ( $args{homedir} ) {
        confess("Invalid home directory: $args{homedir}")
          unless -d $args{homedir} && -x _;
        $self->{homedir} = $args{homedir};
    }
    if ( $args{options} ) {
        confess("Invalid options file: $args{options}")
          unless -r $args{options};
        $self->{options} = $args{options};
    }
    if ( $args{gnupg_path} ) {
        confess("Invalid gpg path: $args{gnupg_path}")
          unless -x $args{gnupg_path};
        $self->{gnupg_path} = $args{gnupg_path};
    }
    else {
        my ($path) = grep { -x "$_/gpg" } split /:/, $ENV{PATH};
        confess("Couldn't find gpg in PATH ($ENV{PATH})") unless $path;
        $self->{gnupg_path} = "$path/gpg";
    }

    bless $self, $class;
}

sub version {
    shift->version_cb(@_)->recv;
}

sub version_cb {
    my ( $self, $cb ) = @_;
    my $cv = _condvar($cb);

    $self->_command("version");
    $self->_options( [] );
    $self->_args(    [] );

    my $version;

    my $proc = $self->_run_gnupg($cv);

    $proc->pipe( \$version );

    $proc->finish;

    $self->_end_gnupg(
        sub {
            if ( $version =~ m{\d(?:\.\d)*} ) {
                $cv->send( split m{\.} => $& );
            }
            else {
                $cv->croak(
                    "cannot obtain version number from string: '$version'");
            }
        }
    );

    $cv;
}

sub gen_key {
    shift->gen_key_cb(@_)->recv;
}

sub gen_key_cb {
    my ( $self, %args ) = @_;
    my $cv = _condvar( delete $args{cb} );
    my $cmd;
    my $arg;

    my $algo = $args{algo};
    $algo ||= RSA_RSA;

    my $size = $args{size};
    $size ||= 1024;
    return _croak( $cv, "Keysize is too small: $size" ) if $size < 768;
    return _croak( $cv, "Keysize is too big: $size" )   if $size > 2048;

    my $expire = $args{valid};
    $expire ||= 0;

    my $passphrase = $args{passphrase} || "";
    my $name = $args{name};

    return _croak( $cv, "Missing key name" ) unless $name;
    return _croak( $cv, "Invalid name: $name" )
      unless $name =~ /^\s*[^0-9\<\(\[\]\)\>][^\<\(\[\]\)\>]+$/;

    my $email = $args{email};
    if ($email) {
        ($email) = Email::Address->parse($email)
          or _croak( $cv, "Invalid email address: $email" );
    }
    else {
        $email = "";
    }

    my $comment = $args{comment};
    if ($comment) {
        _croak( $cv, "Invalid characters in comment" ) if $comment =~ /[\(\)]/;
    }
    else {
        $comment = "";
    }

    $self->_command("gen-key");
    $self->_options( [] );
    $self->_args(    [] );

    my $proc = $self->_run_gnupg($cv);
    $proc->finish unless $self->{input};

    $self->_parse_status(
        $cv,
        progress => $args{progress},
        get_line => sub {
            my ($key) = @_;
            for ($key) {
                _eq('keygen.algo')
                  && $self->_send_command($algo)
                  && last;
                _eq('keygen.size')
                  && $self->_send_command($size)
                  && last;
                _eq('keygen.valid')
                  && $self->_send_command($expire)
                  && last;
                _eq('keygen.name')
                  && $self->_send_command($name)
                  && last;
                _eq('keygen.email')
                  && $self->_send_command($email)
                  && last;
                _eq('keygen.comment')
                  && $self->_send_command($comment)
                  && last;
                $self->_abort_gnupg( "unknown key: $key", $cv );
            }
        },
        need_passphrase_sym => sub {
            unless ( defined $passphrase ) {
                return $self->_abort_gnupg( "passphrase required", $cv );
            }
        },
        get_hidden => sub {
            $self->_send_command($passphrase);
        },
        key_created => sub {
            my $fingerprint = $_[1];
            $self->_end_gnupg( sub { $cv->send($fingerprint) } );
        }
    );

    $cv;
}

sub import_keys {
    shift->import_keys_cb(@_)->recv->{count};
}

sub import_keys_cb {
    my ( $self, %args ) = @_;
    my $cv = _condvar( delete $args{cb} );

    $self->_command("import");
    $self->_options( [] );

    my $count = 0;
    if ( ref $args{keys} eq 'ARRAY' ) {
        $self->_args( $args{keys} );
    }
    else {
        $self->{input} = $args{keys};
        $self->_args( [] );
    }

    my $proc = $self->_run_gnupg($cv);
    $proc->finish unless $self->{input};

    my $num_files = ref $args{keys} ? @{ $args{keys} } : 1;

    $self->_parse_status(
        $cv,
        imported   => sub { $count++ },
        import_res => sub {
            $self->_end_gnupg(
                _catch(
                    $cv,
                    sub {
                        $cv->send( { count => $count } );
                    }
                )
            );
        }
    );

    $cv;
}

sub import_key {
    shift->import_key_cb(@_)->recv;
}

sub import_key_cb {
    my ( $self, $keystr, $cb ) = @_;
    $self->import_keys_cb( keys => \"$keystr", cb => $cb );
}

sub export_keys {
    shift->export_keys_cb(@_)->recv;
}

sub export_keys_cb {
    my ( $self, %args ) = @_;
    my $cv = _condvar( delete $args{cb} );

    my $options = [];
    push @$options, "--armor" if $args{armor};

    $self->{output} = $args{output};

    my $keys = [];
    if ( $args{keys} ) {
        push @$keys, ref $args{keys} ? @{ $args{keys} } : $args{keys};
    }

    if ( $args{secret} ) {
        $self->_command("export-secret-keys");
    }
    elsif ( $args{all} ) {
        $self->_command("export-all");
    }
    else {
        $self->_command("export");
    }

    $self->_options($options);
    $self->_args($keys);

    my $proc = $self->_run_gnupg($cv);

    $proc->finish unless $self->{input};

    $self->_end_gnupg( _catch( $cv, sub { $cv->send( {} ) } ) );

    $cv;
}

sub encrypt {
    shift->encrypt_cb(@_)->recv;
}

sub encrypt_cb {
    my ( $self, %args ) = @_;
    my $cv = _condvar( delete $args{cb} );

    my $options = [];
    croak("no recipient specified")
      unless $args{recipient} or $args{symmetric};

    for my $recipient (
        grep defined,
        (
            ref $args{recipient} eq 'ARRAY'
            ? @{ $args{recipient} }
            : $args{recipient}
        )
      )
    {
        # Escape spaces in the recipient. This fills some strange edge case
        $recipient =~ s/ /\ /g;
        push @$options, "--recipient" => $recipient;
    }

    push @$options, "--sign" if $args{sign};
    croak("can't sign an symmetric encrypted message")
      if $args{sign} and $args{symmetric};

    my $passphrase = $args{passphrase} || "";

    push @$options, "--armor" if $args{armor};
    push @$options, "--local-user", $args{"local-user"}
      if defined $args{"local-user"};

    push @$options, "--auto-key-locate", $args{"auto-key-locate"}
      if defined $args{"auto-key-locate"};

    push @$options, "--keyserver", $args{"keyserver"}
      if defined $args{"keyserver"};

    $self->{input} = $args{plaintext} || $args{input};
    $self->{output} = $args{output};
    if ( $args{symmetric} ) {
        $self->_command("symmetric");
    }
    else {
        $self->_command("encrypt");
    }
    $self->_options($options);
    $self->_args( [] );

    my $proc = $self->_run_gnupg($cv);
    $proc->finish unless $self->{input};

    $self->_parse_status(
        $cv,
        end_encryption => sub {
            $self->_end_gnupg(
                sub {
                    $cv->send;
                }
            );
        },
        need_passphrase => sub {
            unless ( defined $passphrase ) {
                return $self->_abort_gnupg( "passphrase required", $cv );
            }
        },
        get_hidden => sub {
            $self->_send_command($passphrase);
        },
        get_bool => sub {
            for (shift) {
                _eq('untrusted_key.override')
                  && do { $self->_send_command('y'); last }
            }
        },
    );

    $cv;
}

sub sign {
    shift->sign_cb(@_)->recv;
}

sub sign_cb {
    my ( $self, %args ) = @_;
    my $cv = _condvar( delete $args{cb} );

    my $options = [];
    my $passphrase = $args{passphrase} || "";

    push @$options, "--armor" if $args{armor};
    push @$options, "--local-user", $args{"local-user"}
      if defined $args{"local-user"};

    $self->{input} = $args{plaintext} || $args{input};
    $self->{output} = $args{output};
    if ( $args{clearsign} ) {
        $self->_command("clearsign");
    }
    elsif ( $args{"detach-sign"} ) {
        $self->_command("detach-sign");
    }
    else {
        $self->_command("sign");
    }
    $self->_options($options);
    $self->_args( [] );

    my $proc = $self->_run_gnupg($cv);
    $proc->finish unless $self->{input};

    $self->_parse_status(
        $cv,
        need_passphrase => sub {
            unless ( defined $passphrase ) {
                return $self->_abort_gnupg( "passphrase required", $cv );
            }
        },
        get_hidden => sub {
            $self->_send_command($passphrase);
        },
        sig_created => sub {
            $self->_end_gnupg( sub { $cv->send } );
        },
    );

    $cv;
}

sub clearsign {
    my $self = shift;
    $self->sign( @_, clearsign => 1 );
}

sub clearsign_cb {
    my $self = shift;
    $self->sign_cb( @_, clearsign => 1 );
}

sub verify {
    shift->verify_cb(@_)->recv;
}

sub verify_cb {
    my ( $self, %args ) = @_;
    my $cv = _condvar( delete $args{cb} );

    return _croak( $cv, "missing signature argument" ) unless $args{signature};
    my $files = [];
    if ( $args{file} ) {
        $args{file} = [ $args{file} ] unless ref $args{file};
        @$files = ( $args{signature}, @{ $args{file} } );
    }
    else {
        $self->{input} = $args{signature};
    }

    my $options = [];

    push @$options, "--auto-key-locate", $args{"auto-key-locate"}
      if defined $args{"auto-key-locate"};

    push @$options, "--keyserver", $args{"keyserver"}
      if defined $args{"keyserver"};

    my @verify_options = ();

    push @verify_options => 'pka-lookups'        if $args{'pka-loopups'};
    push @verify_options => 'pka-trust-increase' if $args{'pka-trust-increase'};

    push @$options => ( '--verify-options' => join( ',' => @verify_options ) )
      if @verify_options;

    $self->_command("verify");
    $self->_options($options);
    $self->_args($files);

    my $proc = $self->_run_gnupg($cv);
    $proc->finish unless $self->{input};

    my $sig = { trust => TRUST_UNDEFINED, };

    $self->_parse_status(
        $cv,
        sig_id => sub {
            ( $sig->{sigid}, $sig->{data}, $sig->{timestamp} ) = @_;
        },
        goodsig => sub {
            ( $sig->{keyid}, $sig->{user} ) = @_;
        },
        validsig => sub {
            ( $sig->{fingerprint} ) = @_;
            $self->_end_gnupg( sub { $cv->send } );
        },
        policy_url => sub {
            ( $sig->{policy_url} ) = @_;
        },
        trust_never => sub {
            $sig->{trust} = TRUST_NEVER;
        },
        trust_marginal => sub {
            $sig->{trust} = TRUST_MARGINAL;
        },
        trust_fully => sub {
            $sig->{trust} = TRUST_FULLY;
        },
        trust_ultimate => sub {
            $sig->{trust} = TRUST_ULTIMATE;
        },
    );

    $cv;
}

sub decrypt {
    shift->decrypt_cb(@_)->recv;
}

sub decrypt_cb {
    my ( $self, %args ) = @_;
    my $cv = _condvar( delete $args{cb} );

    $self->{input} = $args{ciphertext} || $args{input};
    $self->{output} = $args{output};
    $self->_command("decrypt");
    $self->_options( [] );
    $self->_args(    [] );

    my $proc = $self->_run_gnupg($cv);
    $proc->finish unless $self->{input};

    my $passphrase = $args{passphrase} || "";

    my $sig = { trust => TRUST_UNDEFINED, };

    $self->_parse_status(
        $cv,
        need_passphrase => sub {
            unless ( defined $passphrase ) {
                return $self->_abort_gnupg( "passphrase required", $cv );
            }
        },
        get_hidden => sub {
            $self->_send_command($passphrase);
        },
        end_decryption => sub {
            $self->_end_gnupg( sub { $cv->send } );
        },
        sig_id => sub {
            ( $sig->{sigid}, $sig->{data}, $sig->{timestamp} ) = @_;
        },
        goodsig => sub {
            ( $sig->{keyid}, $sig->{user} ) = @_;
        },
        validsig => sub {
            ( $sig->{fingerprint} ) = @_;
        },
        policy_url => sub {
            ( $sig->{policy_url} ) = @_;
        },
        trust_never => sub {
            $sig->{trust} = TRUST_NEVER;
        },
        trust_marginal => sub {
            $sig->{trust} = TRUST_MARGINAL;
        },
        trust_fully => sub {
            $sig->{trust} = TRUST_FULLY;
        },
        trust_ultimate => sub {
            $sig->{trust} = TRUST_ULTIMATE;
        },
    );

    $cv;
}

1;

__END__