Bug #102719 for Mail-GnuPG: agent.t tests fails with since GnuPG 2.1

Dne St 13.Květen.2015 10:02:57, ppisar napsal(a): Show quoted text
[...] Show quoted text
Here is patch that fixes the test for me. I does not touch the module code except documentation. I think the most proper solution would be on gpg-1 site, but I don't believe that anybody would touch it. Especially if the breakage was intentional. -- Petr

From ca62a09a4a2973471593dc79b14741a18ad6027c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com> Date: Wed, 13 May 2015 17:31:53 +0200 Subject: [PATCH] Adapt to gpg-agent-2.1 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Since gnupg2 2.1, gpg-agent does not export GPG_AGENT_INFO which is needed for gpg from gnupg-1. CPAN RT#102719 Signed-off-by: Petr Písař <ppisar@redhat.com> --- Build.PL | 1 + lib/Mail/GnuPG.pm | 2 ++ t/agent.t | 35 +++++++++++++++++++++++++++++------ 3 files changed, 32 insertions(+), 6 deletions(-) diff --git a/Build.PL b/Build.PL index b8ac716..07f4f13 100644 --- a/Build.PL +++ b/Build.PL @@ -10,6 +10,7 @@ my $build = Module::Build->new 'David Bremner <ddb@cpan.org>'], (sign => 1), requires => { + 'Cwd' => 0, 'File::Spec' => 0, 'File::Temp' => 0, 'GnuPG::Interface' => 0, diff --git a/lib/Mail/GnuPG.pm b/lib/Mail/GnuPG.pm index 23ddb20..703ec60 100644 --- a/lib/Mail/GnuPG.pm +++ b/lib/Mail/GnuPG.pm @@ -48,6 +48,8 @@ use Errno qw(EPIPE); always_trust => always trust a public key # FIXME: we need more things here, maybe primary key id. + If you use gpg-agent from GnuPG-2.1 with gpg from GnuPG-1, you have + to set GPG_AGENT_INFO environment variable manually. =cut diff --git a/t/agent.t b/t/agent.t index 4e85b13..ac52c1e 100644 --- a/t/agent.t +++ b/t/agent.t @@ -4,6 +4,7 @@ use Test::More; use File::Temp qw(tempdir); use Mail::GnuPG; use MIME::Entity; +use Cwd; use strict; no warnings 'redefine'; # fix this later @@ -24,8 +25,10 @@ unless (0 == system("$preset --version 2>&1 >/dev/null")) { } my $tmpdir = tempdir( "mgtXXXXX", CLEANUP => 1); +# Change HOME because gpg-preset-passphrase does not understand to --homedir. +$ENV{HOME} = $tmpdir; -unless ( 0 == system("gpg --homedir $tmpdir --trusted-key 0x49539D60EFEA4EAD --import t/test-key.pgp 2>&1 >/dev/null")) { +unless ( 0 == system("gpg --trusted-key 0x49539D60EFEA4EAD --import t/test-key.pgp 2>&1 >/dev/null")) { plan skip_all => "unable to import testing keys"; goto end; } @@ -35,15 +38,35 @@ unless (open AGENT, "gpg-agent --disable-scdaemon --allow-preset --daemon|") { goto end; } +# GPG-1 agent my ($agent_pid,$agent_info); while (<AGENT>){ if (m/GPG_AGENT_INFO=([^;]*);/){ $agent_info=$1; - $ENV{'GPG_AGENT_INFO'}=$agent_info; - my @parts=split(':',$agent_info); - $agent_pid=$parts[1]; } } +# GPG-2.1 agent +if (!defined $agent_info) { + unless (open(CLIENT, q{printf '/serverpid\n/subst\n/echo ${get homedir}/S.gpg-agent:${get serverpid}:1\n' | gpg-connect-agent|})) { + plan skip_all => "unable to obtain GPG_AGENT_INFO"; + goto end; + } + { + local $/=''; + $agent_info=<CLIENT>; + } + close(CLIENT); + chomp $agent_info; +} +# The returned socket path can be relative to $HOME, but relative paths are +# not acceptable by gpg-1. (Seen with GPG-2.0 agent.) Make it absolute now. +if ($agent_info =~ /([^:]+)(:.*)/) { + $agent_info = Cwd::abs_path($1) . $2; +} +diag("GPG_AGENT_INFO: $agent_info"); +$ENV{'GPG_AGENT_INFO'}=$agent_info; +my @parts=split(':',$agent_info); +$agent_pid=$parts[1]; # gpg-preset-passphrase uses the fingerprint of the subkey, rather than the id. unless ( 0 == system ("$preset --preset -P passphrase " . @@ -58,7 +81,6 @@ plan tests => 20; my $mg = new Mail::GnuPG( key => '49539D60EFEA4EAD', - keydir => $tmpdir, use_agent => 1); isa_ok($mg,"Mail::GnuPG"); @@ -75,7 +97,8 @@ my $me = MIME::Entity->build(From => 'me@myhost.com', $copy = $me->dup; -is( $mg->mime_sign( $copy ), 0 ); +is( $mg->mime_sign( $copy ), 0, 'signing' ) or + diag(@{$mg->{last_message}}); my ($verify,$key,$who) = $mg->verify($copy); is( $verify, 0 ); -- 2.1.0