#! /usr/bin/env perl
use v5.12;
use warnings;
use Pod::Usage;
use Getopt::Long qw( :config gnu_getopt );
use IO::Handle;
use Fcntl;
use Crypt::SecretBuffer qw/ secret /;
use MIME::Base64 qw( encode_base64 decode_base64 );
use Crypt::MultiKey::PKey;
use Crypt::MultiKey::FIDO2;

=head1 USAGE

  crypt-multikey-new-pkey [OPTIONS] [OUT_FILENAME]
  # or
  echo $PASSWORD | crypt-multikey-new-pkey [OPTIONS] > OUT_FILENAME

This creates a new PKey (public/private keypair) protected by a password
(or specified C<--protection-scheme>) and exports it in PEM format.

=head1 OPTIONS

=over

=item --type (-t) ALGORITHM

Specify the public key cryptography algorithm: C<rsa>, C<secp256k1>, C<x25519>,
C<ml-kem>, or a more speciic type from C<perldoc Crypt::MultiKey::PKey>.
C<ml-kem> is a post-quantum algorithm that requires OpenSSL 3.5 or newer.

=item --protection-scheme (-p) SCHEME

Specify the method for encrypting or otherwise protecting the private half of
the key: C<none>, C<Password>, C<SSHAgentSignature>, C<YKChalResp>, C<FIDO2>.

The default is C<Password>.

=item --output (-o) FILENAME

Specify the output filename.  C<-> means STDOUT.  The file must not already exist.

=item --opt-ident PUBKEY_HEX

Specify an SSH Agent Identify to use for C<< -p SSHAgentSignature >>.

=item --fido2-create-cred

Implies 'Y' to the prompt asking whether to create a new FIDO2 credential.

=item --fido2-cred-id BASE64

Specify a pre-existing FIDO2 credential, for use with C<< -p FIDO2 >>.
You will also need to specify C<--fido2-cred-pubkey>.

=item --fido2-cred-pubkey BASE64

Specify the public key of a pre-existing FIDO2 credential.

=item --fido2-cred-cose-alg NAME

Specify an alternate algorithm for the FIDO2 credential.

=back

=cut

my %fido2_cred;
GetOptions(
   'type|t=s'              => \my $opt_type,
   'protection-scheme|p=s' => \my $opt_prot,
   'output|o=s'            => \my $opt_output,
   'ident=s'               => \my $opt_ident,
   'fido2-cred-id=s'       => \$fido2_cred{id},
   'fido2-cred-pubkey=s'   => \$fido2_cred{pubkey},
   'fido2-cred-cose-alg=s' => \$fido2_cred{cose_alg},
   'fido2-create-cred'     => \my $opt_fido2_create_cred,
   'help'                  => sub { pod2usage(1) },
) or pod2usage(2);
$opt_output= shift if !defined $opt_output && @ARGV == 1;
pod2usage(-exitval => 2, -message => "Unexpected non-option arguments")
   if @ARGV;

# Ensure the requested filename doesn't already exist.
# (code below checks again before writing it, but this stops mistakes early)
die "File $opt_output already exists\n"
   if defined $opt_output && $opt_output ne '-' && -e $opt_output;

# Normalize protection_scheme, and default is Password.
# "none" is required to request an unprotected private key.
my %prot_scheme= map +(lc($_) => $_), qw( Password FIDO2 SSHAgentSignature YKChalResp );
$prot_scheme{none}= undef;

$opt_prot= lc($opt_prot // 'Password');
exists $prot_scheme{$opt_prot}
   or die "Available protection-scheme values:\n"
        . "  Password\n"
        . (Crypt::MultiKey::FIDO2->available? "  FIDO2\n" : "")
        . "  SSHAgentSignature\n"
        . "  YKChalResp\n"
        . "  none\n"
        . "\n";

my $interactive= -t STDIN;
my $prompt_fh;
# If running interactively and STDOUT is not also a TTY, we need to open
# a writable handle to the same terminal/console as STDIN.
if ($interactive) {
   if (-t STDOUT) {
      $prompt_fh= \*STDOUT;
   } else {
      if ($^O eq 'MSWin32') {
         open($prompt_fh, '>', 'CONOUT$') || die 'open(CONOUT$): '.$!;
      } else {
         open($prompt_fh, '>', '/dev/tty') || die "open(/dev/tty): $!";
      }
   }
   $prompt_fh->autoflush(1); # for prompts that don't end with \n
}

my $pkey= Crypt::MultiKey::PKey->new(
   generate          => $opt_type,
   protection_scheme => $prot_scheme{$opt_prot},
);
warn "generated ".$pkey->algorithm." public/private key pair\n";

if (!defined $pkey->protection_scheme) {
   warn "Generated an unprotected private key; ensure the file has sensible permissions.\n";
}
elsif ($pkey->protection_scheme eq 'Password') {
   my $secret= secret;
   if ($interactive) {
      $secret->append_console_line(
         input_fh => \*STDIN, prompt_fh => $prompt_fh,
         prompt => 'password: '
      ) or die "aborted.\n";
   } else {
      # If not interactive, assume we can just read from the STDIN pipe.
      $secret->append(scalar <STDIN>);
   }
   $secret->length
      or die "aborted.  (use '-p none' to export an unencrypted key)\n";
   $pkey->encrypt_private($secret);
   my $pkey2= Crypt::MultiKey::PKey->load($pkey->export);
   if ($interactive) {
      warn "Verifying...\n";
      $secret= secret();
      $secret->append_console_line(
         input_fh => \*STDIN, prompt_fh => $prompt_fh,
         prompt => 're-enter password: '
      ) or die "aborted.\n";
      $pkey2->decrypt_private($secret);
      warn "Verified.\n";
   } else {
      $pkey2->decrypt_private($secret);
   }
}
elsif ($pkey->protection_scheme eq 'SSHAgentSignature') {
   my $agent= $pkey->agent;
   my @keys= $pkey->usable_agent_keys
      or die "No usable keys are loaded in your agent.\n"
           . "Note that only types ssh-rsa, ssh-dsa, and ssh-ed25519 have a stable\n"
           . " signature algorithm that can be used for encryption.\n";
   my $sel;
   if (@keys > 1) {
      if ($interactive) {
         while (!defined $sel) {
            $prompt_fh->print("Choose an agent key to use:\n\n");
            $prompt_fh->printf(" %2d: %s %s %s\n", $_, @{$keys[$_]}{'type','pubkey_base64','comment'})
               for 0..$#keys;
            $prompt_fh->print("\nenter number [0-$#keys]: ");
            chomp($sel= <STDIN>);
            if ($sel =~ /^[0-9]+\z/ && $sel <= $#keys) {
               $sel= $keys[$sel];
            } else {
               $prompt_fh->print("invalid selection\n");
            }
         }
      } else {
         chomp($opt_ident= <STDIN>)
            unless defined $opt_ident;
         ($sel)= grep $_->{pubkey_base64} eq $opt_ident || $_->{comment} eq $opt_ident, @keys
            or die "No SSH Agent identity matched selection.\n";
      }
   } else {
      $sel= $keys[0];
   }
   warn "If required, authorize signature request\n";
   $pkey->encrypt_private($sel);
   warn "Verifying...\n";
   my $pkey2= Crypt::MultiKey::PKey->load($pkey->export);
   warn "If required, authorize signature request again\n";
   $pkey2->obtain_private;
   warn "Verified.\n";
}
elsif ($pkey->protection_scheme eq 'YKChalResp') {
   require Crypt::MultiKey::YubicoOTP;
   die "Can't locate the YubicoOTP commandline tools 'ykinfo' and 'ykchalresp'.\n"
      ."On Debian, use `apt install yk-personalization`.\n"
      unless Crypt::MultiKey::YubicoOTP->available;
   my @devices= Crypt::MultiKey::YubicoOTP::list_devices()
      or die "No yubico-otp devices found.\n";
   if (@devices > 1 && $interactive) {
      while (@devices > 1) {
         $prompt_fh->print("Multiple devices found:");
         $prompt_fh->printf(" %2d %12s (%s)\n", $_->idx, $_->serial, $_->path)
            for @devices;
         $prompt_fh->print("enter number or serial of device: ");
         chomp(my $sel= <STDIN>);
         if (my ($sel_dev)= grep $_->idx eq $sel || $_->serial eq $sel, @devices) {
            @devices= ($sel_dev);
         } else {
            $prompt_fh->print("no such device.\n");
         }
      }
   }
   warn "If required, touch device to authorize challenge/response\n";
   $pkey->encrypt_private($devices[0]);
   warn "Verifying...\n";
   my $pkey2= Crypt::MultiKey::PKey->load($pkey->export);
   warn "If required, touch device again to verify challenge/response\n";
   $pkey2->obtain_private;
   warn "Verified.\n";
}
elsif ($pkey->protection_scheme eq 'FIDO2') {
   die "Crypt::MultiKey was built without libfido2 support.\n"
      ."Make sure libfido2 and its headers are installed, then rebuild.\n"
      ."On Debian, use `apt install libfido2-dev`.\n"
      unless Crypt::MultiKey::FIDO2->available;

   my @devices= Crypt::MultiKey::FIDO2::list_devices()
      or die "No FIDO2 devices found\n";
   my $dev= $devices[0];
   if (@devices > 1) {
      warn "Found ".scalar(@devices)." authenticators.\n"
         . "Please touch desired authenticator...\n";
      # use indefinite timeout with ^C to abort, if interactive.
      my $timeout= $interactive? undef : 10;
      $dev= Crypt::MultiKey::FIDO2::select_device($timeout, \@devices);
   }
   die "No device selected.\n" unless defined $dev;

   # If the user specified FIDO2 credential on the command line, use that.
   # Else prompt to create a new credential.
   if (defined $fido2_cred{id}) {
      for ($fido2_cred{id}, $fido2_cred{pubkey}) {
         $_= decode_base64($_) if defined $_;
      }
      # delete unspecified keys
      defined $fido2_cred{$_} || delete $fido2_cred{$_}
         for keys %fido2_cred;
      $pkey->fido2_credential(\%fido2_cred);
      $pkey->fido2_aaguid($dev->aaguid);
   } else {
      unless ($opt_fido2_create_cred) {
         die "When running non-interactively, use --fido2-create-cred or specify a credential\n"
            unless $interactive;
         $prompt_fh->print("This will create a new credential, consuming a slot on your device.\n"
                         . "Proceed? [y/n] ");
         my $resp= <STDIN>;
         die "aborted.\n"
            unless $resp =~ /y/i;
      }
      warn "Creating credential.  Touch device to accept.\n";
      $pkey->create_credential($dev);
      warn join('',
         "You can re-enter this credential with:\n",
         (map {
            (my $opt= "fido2-cred-$_") =~ s/_/-/g;
            my $v= $pkey->fido2_credential->{$_};
            sprintf("  --%s:%s\n", $opt, $v =~ /[^\x20-\x7E]/? encode_base64($v, '') : $v)
         } sort keys %{$pkey->fido2_credential}),
         "\n"
      );
   }
   warn "Running challenge/response.  Touch device to accept.\n";
   $pkey->encrypt_private($dev);
   warn "Verifying...\n";
   my $pkey2= Crypt::MultiKey::PKey->load($pkey->export);
   warn "If required, touch device again to verify\n";
   $pkey2->obtain_private(fido2_devices => [$dev]);
   warn "Verified.\n";
}
else {
   die "unsupported protection_scheme '".$pkey->protection_scheme."'\n";
}

my $out;
if (defined $opt_output && $opt_output ne '-') {
   warn "Saving... \n";
   sysopen($out, $opt_output, Fcntl::O_RDWR() | Fcntl::O_CREAT() | Fcntl::O_EXCL() )
      or die "open(create exclusive): $!";
} else {
   say '' if -t STDOUT; # add a blank line if viewed on a TTY
}
my $buf= $pkey->export;
my $pos= 0;
# output could be a pipe, so write in a loop
while ($pos < $buf->length) {
   my $wrote= $buf->syswrite($out // \*STDOUT, $buf->len - $pos, $pos)
      or die "write: $!";
   $pos += $wrote;
}
warn "Done\n" if defined $out;

exit 0;
