aboutsummaryrefslogtreecommitdiff
path: root/SBO-Lib/lib/SBO/Lib/Cryptography.pm
blob: 4fca2770f6e3a3adf7a8978e43327a4497214570 (plain)
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
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
package SBO::Lib::Cryptography;

use 5.016;
use strict;
use warnings;

our $VERSION = '2.7.2';

use Cwd;
use File::Temp "tempdir";
use IPC::Open3;

use constant {
  BAD_SIGNATURE => 'bad signature',
  EXPIRED_KEY => 'expired key',
  VALID_SIGNATURE => 'good signature',
};

use Exporter 'import';

our @EXPORT_OK = qw{
  has_valid_gpg_signature
  import_gpg_key
  verify_gpg_signed_file

  BAD_SIGNATURE
  EXPIRED_KEY
  VALID_SIGNATURE
};

our %EXPORT_TAGS = (
  all => \@EXPORT_OK,
);

=pod

=encoding UTF-8

=head2

  has_valid_gpg_signature(@output, $key_id);

C<has_valid_gpg_siganture()> validates whether the captured gpg status output
contains a good signature for the given GPG key.

=cut

sub has_valid_gpg_signature {
  my $output = shift;
  my $key_id = shift;

  # VALIDSIG contains the hex key ID, GOODSIG is required for certainty. More
  # information can be found in 'DETAILS' in the gnupg2 documentation folder.
  my $is_good_sig = 0;
  my $is_valid_sig = 0;

  my $line;
  foreach $line (@$output) {
    if ($line =~ /^\[GNUPG\:] VALIDSIG $key_id/) {
      $is_valid_sig = 1;
    } elsif ($line =~ /^\[GNUPG\:] GOODSIG /) {
      $is_good_sig = 1;
    }

    if ($is_good_sig && $is_valid_sig) {
      return 1;
    }
  }

  return 0;
}

=head2 import_gpg_key

  import_gpg_key($key);

C<import_gpg_key()> will import the key into the systems keychain.  An error will
be reported if the configured key fingerprint does not match the imported one.

=cut

sub import_gpg_key {
  script_error('import_gpg_key requires two arguments.') unless @_ == 2;

  my $key = shift;
  my $key_id = shift;

  my $key_source;
  if ($key =~ m!^http://! || $key =~ m!^https://!) {
    open3(undef, $key_source, ">&STDERR", "wget", $key, "-O", "-") || die("could not download key from $key");
  } else {
    open($key_source, "<", $key) || die("could not read '$key': $!");
  }

  my $old = $ENV{'GNUPGHOME'};

  $ENV{'GNUPGHOME'} = tempdir(CLEANUP => 1);

  my $gpg_cmd;
  open3($gpg_cmd, undef, undef, "gpg", "--batch", "--yes", "--import", "-") || die("could not import key: $!\n");

  while (my $line = <$key_source>) {
    print($gpg_cmd $line);
  }

  close($gpg_cmd);
  close($key_source);

  sleep(1);

  if (system(">/dev/null gpg --list-keys $key_id")) {
    die("GPG key '$key_id' not found.  Confirm the correct key is configured or is being imported.\n");
  }

  my $gpg_export;
  open($gpg_export, "-|", "gpg", "--export", $key_id) || die("could not export key: $!\n");

  $ENV{'GNUPGHOME'} = $old;

  my $gpg_import;
  open3($gpg_import, ">&STDOUT", ">&STDOUT", "gpg", "--batch", "--yes", "--import", "-") || die("could not import key: $!\n");

  while (my $line = <$gpg_export>) {
    print($gpg_import $line);
  }

  close($gpg_export);
  close($gpg_import);

  print("key imported\n");
}

=head2 verify_gpg_signed_file

  verify_gpg_signed_file($file_path, $key_id);

C<verify_gpg_signed_file()> verifies the C<file_path> is signed by C<key_id>. 

=cut

sub verify_gpg_signed_file {
  script_error('verify_gpg_signed_file requires two arguments.') unless @_ == 2;
  
  my $file_path = shift;
  my $key_id = shift;

  my @output;
  open3(undef, my $std_out, undef, "gpg", "--status-fd=1", "--verify", $file_path) or die("dead");
  while (my $line = <$std_out>) {
    push(@output, $line);
  }
  close($std_out);

  if (! has_valid_gpg_signature(\@output, $key_id)) {
    return BAD_SIGNATURE;
  }

  return VALID_SIGNATURE;
}