##
## support for signing with a tpm-pkcs11 shadowed key directly using pkcs11
##

# see https://github.com/openSUSE/gpg_pkcs11_tpm for more information

use Crypt::PKCS11;
use Crypt::PKCS11::Attributes;

# currently needed to parse the private key
use Crypt::GCrypt::Sexp;

BEGIN {
  *Crypt::PKCS11::CKK_EC_EDWARDS = sub {0x00000040} unless defined &Crypt::PKCS11::CKK_EC_EDWARDS;
  *Crypt::PKCS11::CKM_EDDSA = sub {0x00001057} unless defined &Crypt::PKCS11::CKM_EDDSA;
}

my $pkcs11_config;
my $pkcs11_handle;


my $pgp_curve_nistp256 = "\x2a\x86\x48\xce\x3d\x03\x01\x07";
my $pgp_curve_nistp384 = "\x2b\x81\x04\x00\x22";
my $pgp_curve_ed25519  = "\x2b\x06\x01\x04\x01\xda\x47\x0f\x01";

##
## pkcs11 support
##

sub can_sign_with_pkcs11 {
  my ($info) = @_;
  return 0 unless $info && $info->{'algo'};
  return 0 unless $info->{'shadowed-tpm2-v1'} && $info->{'shadowed-tpm2-v1'}->[0] eq 'pkcs11';
  return 1 if $info->{'algo'} == 1;
  return 1 if $info->{'algo'} == 22 && $info->{'curve'} eq $pgp_curve_ed25519;
  return 1 if $info->{'algo'} == 19 && $info->{'curve'} eq $pgp_curve_nistp256;
  return 1 if $info->{'algo'} == 19 && $info->{'curve'} eq $pgp_curve_nistp384;
  return 0;
}

sub pkcs11_read_config {
  my ($gpghomedir) = @_;
  my $fd;
  open($fd, '<', "$gpghomedir/gpg-pkcs11-tpm.conf") || die("$gpghomedir/gpg-pkcs11-tpm.conf: $!\n");
  $pkcs11_config = {};
  while (<$fd>) {
    chomp;
    s/^\s+//;
    s/\s+$//;
    next if $_ eq '' || $_ =~ /^#/;
    $pkcs11_config->{$1} = 1 if /^(\S+)$/;
    $pkcs11_config->{$1} = $2 if /^(\S+)\s+(.*?)$/;
  }
  close($fd);
}

sub pkcs11_initialize {
  my ($gpghomedir) = @_;
  pkcs11_read_config($gpghomedir);
  die("pkcs11: no provider-library configured\n") unless $pkcs11_config->{'provider-library'};
  die("pkcs11: Crypt::PKCS11 module not loaded\n") unless defined &Crypt::PKCS11::new;
  $pkcs11_handle = Crypt::PKCS11->new;
  $pkcs11_handle->load($pkcs11_config->{'provider-library'});
}

sub pkcs11_generate_token_url {
  my ($slot_id) = @_;
  my $token_info = $pkcs11_handle->GetTokenInfo($slot_id) or die("pkcs11_generate_token_url: could not get token info for slot $slot_id\n");
  return undef unless %$token_info;
  my $uri = '';
  for my $what (['model' => 'model'], ['manufacturerID' => 'manufacturer'], ['serialNumber' => 'serial'], ['label' => 'token']) {
    my $d = $token_info->{$what->[0]};
    $d = '' unless defined $d;
    $d =~ s/\s+$//;
    $d =~ s/([\000-\040<>;\"#\?&\+=%[\177-\377])/sprintf("%%%02X",ord($1))/sge;
    $uri .= ";$what->[1]=$d";
  }
  $uri =~ s/^./pkcs11:/;
  return $uri;
}

sub pkcs11_open_session {
  $pkcs11_handle->Initialize;
  my $slot_id = $pkcs11_config->{'slot-id'};
  if (!defined $slot_id) {
    my $slot_list = $pkcs11_handle->GetSlotList(1) or die "GetSlotList: " . $pkcs11_handle->errstr;
    for my $sid (@$slot_list) {
      next if $pkcs11_config->{'token'} && (pkcs11_generate_token_url($sid) || '') ne $pkcs11_config->{'token'};
      $slot_id = $sid;
      last;
    }
    die("no slot found\n") unless defined $slot_id;
  }
  my $session = $pkcs11_handle->OpenSession($slot_id, Crypt::PKCS11::CKF_SERIAL_SESSION) or die "OpenSession: " . $pkcs11_handle->errstr;
  if (defined $pkcs11_config->{'login'}) {
    $session->Login(Crypt::PKCS11::CKU_USER, $pkcs11_config->{'login'}) or die "login error: " . $session->errstr;
  }
  return $session;
}

sub pkcs11_mechanism {
  my ($mechanism) = @_;
  my $mech_obj = Crypt::PKCS11::CK_MECHANISM->new;
  $mech_obj->set_mechanism($mechanism) if defined $mechanism;
  return $mech_obj;
}

sub pkcs11_find_signing_key {
  my ($session, $label) = @_;
  my $object_template = Crypt::PKCS11::Attributes->new->push(
    Crypt::PKCS11::Attribute::Label->new->set($label),
    Crypt::PKCS11::Attribute::Sign->new->set(1),
  );
  $session->FindObjectsInit($object_template);
  my $objects = $session->FindObjects(1);
  return $objects && @$objects ? $objects->[0] : undef;
}

my %pkcs11_pkcs1prefix = (
  'sha1'   => '3021300906052b0e03021a05000414',
  'sha224' => '3031300d06096086480165030402040500041c',
  'sha256' => '3031300d060960864801650304020105000420',
  'sha384' => '3041300d060960864801650304020205000430',
  'sha512' => '3051300d060960864801650304020305000440',
);

sub pkcs11_sign {
  my ($session, $key, $keyalgo, $hashalgo, $data) = @_;
  my $mech;
  if ($keyalgo == 1) {
    $mech = Crypt::PKCS11::CKM_RSA_PKCS;
    die("unsupported hash algorithm for rsa\n") unless $pkcs11_pkcs1prefix{$hashalgo};
    $data = pack('H*', $pkcs11_pkcs1prefix{$hashalgo}).$data;
  } elsif ($keyalgo == 19) {
    $mech = Crypt::PKCS11::CKM_ECDSA;
  } elsif ($keyalgo == 22) {
    $mech = Crypt::PKCS11::CKM_EDDSA;
  }
  die("unsupported key type $keyalgo\n") unless defined $mech;
  $session->SignInit(pkcs11_mechanism($mech), $key) or die "Failed to init signing: " . $session->errstr;
  my $sig = $session->Sign($data) or die "Failed to sign: " . $session->errstr;
  if ($mech == Crypt::PKCS11::CKM_ECDSA || $mech == Crypt::PKCS11::CKM_EDDSA) {
    my $s1 = substr($sig, 0, length($sig) / 2, '');
    die("signature size must be even\n") if length($s1) != length($sig);
    return ($s1, $sig);
  }
  return $sig;
}

sub sign_with_pkcs11 {
  my ($phrasefile, $info, $hash, $hashalgo, $replyv4) = @_;
  die("sign_with_tpm: missing fingerprint\n") unless $info->{'fingerprint'};
  die("bad hash $hash\n") unless $hash =~ /^((?:[0-9a-fA-F][0-9a-fA-F])+)\@(0[01][0-9a-fA-F]{8})$/;
  my $extra = $2;
  $hash = $1;
  $hashalgo = lc($hashalgo);
  my $pgphashalgo = get_pgphashalgo($hashalgo);
  die("sign_with_pkcs11: bad hashalgo $hashalgo\n") unless $pgphashalgo;
  die("bad info\n") unless @{$info->{'shadowed-tpm2-v1'} || []} == 3 && $info->{'shadowed-tpm2-v1'}->[0] eq 'pkcs11';
  my $session = $info->{'pkcs11_session'} || pkcs11_open_session();
  $info->{'pkcs11_session'} = $session;		# so we can reuse it
  my $label = $info->{'shadowed-tpm2-v1'}->[2];
  my $key = $info->{'pkcs11_key'} || pkcs11_find_signing_key($session, $label);
  die("could not find private key '$label'\n") unless $key;
  $info->{'pkcs11_key'} = $key;		# so we can reuse it
  my @sig = pkcs11_sign($session, $key, $info->{'algo'}, $hashalgo, pack('H*', $hash));
  my $sigdata = join('', map {encodempi($_)} @sig);
  return wrap_into_pgpsig_v4($extra, $info->{'fingerprint'}, $info->{'algo'}, $pgphashalgo, $hash, $sigdata) if $replyv4;
  return wrap_into_pgpsig_v3($extra, $info->{'fingerprint'}, $info->{'algo'}, $pgphashalgo, $hash, $sigdata);
}

sub pkcs11_init {
  eval { pkcs11_initialize($ENV{GNUPGHOME}) };
  warn($@) if $@; 
  return $@ ? 0 : 1 
}

return { 'init' => \&pkcs11_init };
# vim: syntax=perl
