view release on metacpan or  search on metacpan

lib/AnyEvent/GnuPG.pm  view on Meta::CPAN

                                  && 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};