view release on metacpan or  search on metacpan

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

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

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

}

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__

=pod

=head1 NAME

AnyEvent::GnuPG - AnyEvent-based interface to the GNU Privacy Guard

=head1 VERSION

version 1.001

=head1 SYNOPSIS

    use AnyEvent::GnuPG qw( :algo );

    my $gpg = AnyEvent::GnuPG->new();

    $gpg->encrypt(
        plaintext   => "file.txt",
        output      => "file.gpg",
        armor       => 1,
        sign        => 1,
        passphrase  => $secret
    );
    
    $gpg->decrypt(
        ciphertext    => "file.gpg",
        output        => "file.txt"
    );
    
    $gpg->clearsign(
        plaintext => "file.txt",
        output => "file.txt.asc",
        passphrase => $secret,
        armor => 1,