#!perl
use strict;
use warnings;
use Test::More tests => 48;
use Test::Exception;
use IO::Scalar;
BEGIN {
use_ok( 'Crypt::GpgME' );
}
delete $ENV{GPG_AGENT_INFO};
$ENV{GNUPGHOME} = 't/gpg';
my $ctx;
lives_ok (sub {
$ctx = Crypt::GpgME->new;
}, 'create new context');
isa_ok ($ctx, 'Crypt::GpgME');
my $plain = IO::Scalar->new(\q/test test test/);
my $called = 0;
sub pass_cb {
is (@_, 4, 'cb got 4 params');
my ($c, $uid_hint, $passphrase_info, $prev_was_bad) = @_;
isa_ok ($c, 'Crypt::GpgME');
ok($c == $ctx, 'context references are equal');
like ($uid_hint, qr/^[A-F0-9]{16}\s+[^<]+\s+<[^>]+>$/, 'uid hint looks sane');
like ($passphrase_info, qr/^[A-F0-9]/, 'passphrase info looks sane');
is ($prev_was_bad, ! !$called % 3, 'prev_was_bad looks sane');
++$called;
}
lives_ok (sub {
$ctx->set_passphrase_cb(\&pass_cb);
}, 'setting passphrase cb without user data');
is ($called, 0, 'just setting the cb doesn\'t call it');
eval {
$ctx->sign($plain, 'clear');
};
ok ($called > 0, 'signing calls the cb');
$called = 0;
sub pass_cb_ud {
is (@_, 5, 'cb got 5 params');
my ($c, $uid_hint, $passphrase_info, $prev_was_bad, $user_data) = @_;
isa_ok ($c, 'Crypt::GpgME');
ok($c == $ctx, 'context references are equal');
like ($uid_hint, qr/^[A-F0-9]{16}\s+[^<]+\s+<[^>]+>$/, 'uid hint looks sane');
like ($passphrase_info, qr/^[A-F0-9]/, 'passphrase info looks sane');
is ($prev_was_bad, ! !$called % 3, 'prev_was_bad looks sane');
is ($user_data, 'foo', 'user data looks sane');
++$called;
}
lives_ok (sub {
$ctx->set_passphrase_cb(\&pass_cb_ud, 'foo');
}, 'setting passphrase cb with user data');
is ($called, 0, 'just setting the cb doesn\'t call it');
eval {
$ctx->sign($plain, 'clear');
};
ok ($called > 0, 'signing calls the cb');