1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
|
#!/usr/bin/perl
#
# Basic tests for PGP::Sign functionality.
#
# Copyright 1998-2001, 2004, 2007, 2018, 2020 Russ Allbery <rra@cpan.org>
#
# This program is free software; you may redistribute it and/or modify it
# under the same terms as Perl itself.
#
# SPDX-License-Identifier: GPL-1.0-or-later OR Artistic-1.0-Perl
use 5.020;
use autodie;
use warnings;
use lib 't/lib';
use File::Spec;
use IO::File;
use IPC::Cmd qw(can_run);
use Test::More;
use Test::PGP qw(gpg_is_gpg1 gpg_is_new_enough);
# Check that GnuPG is available. If so, load the module and set the plan.
BEGIN {
if (!can_run('gpg')) {
plan skip_all => 'gpg binary not available';
} elsif (!gpg_is_new_enough('gpg')) {
plan skip_all => 'gpg binary is older than 1.4.20 or 2.1.23';
} else {
use_ok('PGP::Sign');
}
}
# Locate our test data directory for later use.
my $data = 't/data';
# Open and load our data file. This is the sample data that we'll be signing
# and checking signatures against.
open(my $fh, '<', "$data/message");
my @data = <$fh>;
close($fh);
# The key ID and pass phrase to use for testing.
my $keyid = 'testing';
my $passphrase = 'testing';
# There are three possibilities: gpg is GnuPG v1, gpg is GnuPG v2 and v1 is
# not available, or gpg is GnuPG v2 and gpg1 is GnuPG v1. We ideally want to
# test both styles, but we'll take what we can get.
my @styles;
if (gpg_is_gpg1()) {
@styles = qw(GPG1);
} elsif (!can_run('gpg1')) {
@styles = qw(GPG);
} else {
@styles = qw(GPG GPG1);
}
# Run all the tests twice, once with GnuPG v2 and then with GnuPG v1.
for my $style (@styles) {
note("Testing PGPSTYLE $style");
local $PGP::Sign::PGPSTYLE = $style;
my $pgpdir = ($style eq 'GPG') ? 'gnupg2' : 'gnupg1';
local $PGP::Sign::PGPPATH = File::Spec->catdir($data, $pgpdir);
if ($style eq 'GPG1' && gpg_is_gpg1()) {
$PGP::Sign::PGPS = 'gpg';
$PGP::Sign::PGPV = 'gpg';
}
# Generate a signature.
my ($signature, $version) = pgp_sign($keyid, $passphrase, @data);
ok($signature, 'Sign');
is(PGP::Sign::pgp_error(), q{}, '...with no errors');
isnt($signature, undef, 'Signature');
is(PGP::Sign::pgp_error(), q{}, '...with no errors');
# Check signature.
is(pgp_verify($signature, $version, @data), $keyid, 'Verify');
is(PGP::Sign::pgp_error(), q{}, '...with no errors');
# The same without version, which shouldn't matter.
is(pgp_verify($signature, undef, @data), $keyid, 'Verify without version');
is(PGP::Sign::pgp_error(), q{}, '...with no errors');
# Check a failed signature by appending some nonsense to the data.
is(pgp_verify($signature, $version, @data, 'xyzzy'), q{},
'Verify invalid');
is(PGP::Sign::pgp_error(), q{}, '...with no errors');
# Test taking code from a code ref and then verifying the reulting
# signature. Also test accepting only one return value from pgp_sign().
my @code_input = @data;
my $data_ref = sub {
my $line = shift(@code_input);
return $line;
};
$signature = pgp_sign($keyid, $passphrase, $data_ref);
isnt($signature, undef, 'Signature from code ref');
is(PGP::Sign::pgp_error(), q{}, '...with no errors');
is(pgp_verify($signature, $version, @data), $keyid, 'Verifies');
is(PGP::Sign::pgp_error(), q{}, '...with no errors');
# Test whitespace munging.
{
local $PGP::Sign::MUNGE = 1;
($signature, $version) = pgp_sign($keyid, $passphrase, q{ });
}
is(pgp_verify($signature, $version, q{ }),
q{}, 'Munged does not match');
is(pgp_verify($signature, $version, q{}),
$keyid, '...but does match empty');
{
local $PGP::Sign::MUNGE = 1;
is(pgp_verify($signature, $version, q{ }),
$keyid, '...and does match munged');
}
# Test error handling.
is(pgp_verify('asfasdfasf', undef, @data), undef, 'Invalid signature');
my @errors = PGP::Sign::pgp_error();
my $errors = PGP::Sign::pgp_error();
like(
$errors[-1],
qr{^ Execution [ ] of [ ] gpg.? [ ] failed}xms,
'Invalid signature',
);
like(
$errors,
qr{\n Execution [ ] of [ ] gpg.? [ ] failed}xms,
'Errors contain newlines',
);
is($errors, join(q{}, @errors), 'Two presentations of errors match');
}
# Report the end of testing.
done_testing(21 * scalar(@styles) + 1);
|
