package SBO::Lib::Cryptography;

use 5.016;
use strict;
use warnings;

our $VERSION = '2.8.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);
}