sbotools2

Cryptography.pm (4557B)

---

 package SBO::Lib::Cryptography;
 
 use 5.016;
 use strict;
 use warnings;
 
 our $VERSION = '2.9.0';
 
 use Cwd;
 use File::Temp "tempdir";
 use IPC::Open3;
 
 use Exporter 'import';
 
 # Minimal definitions of some GPG raw output messages.
 use constant {
   BADSIG => 'bad signature',
   EXPSIG => 'signature expired',
   EXPKEYSIG => 'signed by expired key',
   ERRSIG => 'signature verification not possible',
   GOODSIG => 'good signature',
   REVKEYSIG => 'good signature by revoked public key',
   NO_PUBKEY => 'public key unavailable',
   VALIDSIG => 'valid signature',
   # An unknown message type.
   UNKNOWN => 'unknown',
 };
 
 our @EXPORT_OK = qw{
   import_gpg_key
   parse_gpg_output
   verify_gpg_signed_file
 
   BADSIG
   EXPSIG
   EXPKEYSIG
   ERRSIG
   GOODSIG
   REVKEYSIG
   NO_PUBKEY
   VALIDSIG
   UNKNOWN
 };
 
 our %EXPORT_TAGS = (
   all => \@EXPORT_OK,
 );
 
 =pod
 
 =encoding UTF-8
 
 =cut
 
 # Messages on Signature status which should only turn up once.
 our %is_signature_status = (
   &BADSIG => 1,
   &ERRSIG => 1,
   &EXPSIG => 1,
   &EXPKEYSIG => 1,
   &GOODSIG => 1,
   &REVKEYSIG => 1,
 );
 
 =head2
 
   parse_gpg_output(@output, $key_id);
 
 =cut
 
 sub parse_gpg_output {
   my $output = shift;
   my $key_id = shift;
 
 
   my $line;
   my $status = '';
 
   foreach $line (@$output) {
     my $msg = parse_gpg_line($line, $key_id);
 
     if (exists($is_signature_status{$msg})) {
       # Only one signature expected.
       if ($status ne '') {
         return UNKNOWN;
       }
 
       $status = $msg;
     }
 
     if ($msg eq NO_PUBKEY) {
       return NO_PUBKEY;
     } elsif ($msg eq VALIDSIG) {
       # VALIDSIG contains the full hex key ID to be certain it is signed by the
       # right key. information can be found in 'DETAILS' in the gnupg2
       # documentation folder.
       return $status;
     }
   }
 
   return UNKNOWN;
 }
 
 sub parse_gpg_line {
   my $line = shift;
   my $key_id = shift;
 
   if ($line =~ /^\[GNUPG\:] BADSIG/) {
     return BADSIG;
   } elsif ($line =~ /^\[GNUPG\:] EXPSIG/) {
     return EXPSIG;
   } elsif ($line =~ /^\[GNUPG\:] EXPKEYSIG/) {
     return EXPKEYSIG;
   } elsif ($line =~ /^\[GNUPG\:] ERRSIG/) {
     return ERRSIG;
   } elsif ($line =~ /^\[GNUPG\:] GOODSIG/) {
     return GOODSIG;
   } elsif ($line =~ /^\[GNUPG\:] REVKEYSIG/) {
     return REVKEYSIG;
   } elsif ($line =~ /^\[GNUPG\:] NO_PUBKEY/) {
     return NO_PUBKEY;
   } elsif ($line =~ /^\[GNUPG\:] VALIDSIG $key_id/) {
     return VALIDSIG;
   } else {
     return UNKNOWN;
   }
 }
 
 =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);
 
   sleep(1);
 
   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);
 
   return parse_gpg_output(\@output, $key_id);
 }