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