#!/usr/local/bin/perl
#
# Command line tool wrapper for OpenXPKI Secret Sharing 
# 2013-12-04 Martin Bartosch <m.bartosch@cynops.de>
# 2018-08-12 Martin Bartosch <mbartosch@whiterabbitsecurity.com>: shares can be encrypted with a passphrase
# 2022-10-12 Martin Bartosch <mbartosch@whiterabbitsecurity.com>: use pbkdf, fallback to old mechanism if necessary
#

# Stub implementation for OpenXPKI Crypto Token (only random numbers and prime tests required)
package DummyToken;
use strict;
use warnings;

sub new {
    my $self = {};
    bless $self;
    
    return $self;
}

sub command {
    my $self = shift;
    my $arg = shift;

    if ($arg->{COMMAND} eq 'create_random') {
        my $len = $arg->{RANDOM_LENGTH};
        my $rand = `openssl rand -base64 $len`;
	if ($? != 0) {
	    die "ERROR: could not run openssl";
	}
        chomp $rand;
        if (length($rand) < $len) {
            die "Error: could not create random value. Stopped";
        }
        return $rand;
    }

    if ($arg->{COMMAND} eq 'is_prime') {
        my $result = `openssl prime -hex $arg->{PRIME}`;
	chomp $result;
	if ($? != 0) {
	    die "ERROR: could not run openssl";
	}
	if ($result =~ m{ is\ not\ prime \z}xms) {
	    return;
	} elsif ($result =~ m{ is\ prime \z}xms) {
	    return 1;
	} else {
	    die "ERROR: invalid prime test result $result returned from openssl";
	}
    }
    die "token command " . $arg->{COMMAND} . " not implemented";
}



package main;

use strict;
use warnings;

use FindBin;
use lib "$FindBin::Bin/../lib";

use Getopt::Long;
use Pod::Usage;
use OpenXPKI::Crypto::Secret;
use MIME::Base64;
use Crypt::CBC;
use Data::Dumper;

use English;

my $cipher = 'Rijndael';
my $magic = 'CLCA';
# encrypt data encoded in hex
# NOTE: this is not a generic encryption method, it is only applicable to secret shares
sub encrypt {
    my $arg = shift;
    my $key = shift;
    my $pbkdf = shift || 'pbkdf2';

    $arg = uc($arg);

    if ($arg !~ m{ [0-9A-F]+ }xms) {
	die "invalid encryption input";
    }
    if (length ($arg) % 2 != 0) {
	$arg = 'F' . $arg;
    }
    
    my $cbc = Crypt::CBC->new(-key    =>  $key,
			      -cipher => $cipher,
			      -pbkdf   => $pbkdf,
	) || die "Couldn't create CBC object";

    my $inbytes = $magic . pack "H*", $arg;

    my $encrypted = $cbc->encrypt($inbytes);

    return encode_base64($encrypted, '');
}

sub decrypt {
    my $arg = shift;
    my $key = shift;   

    my $cbc;
    my $decrypted;

    $cbc = Crypt::CBC->new(-key    =>  $key,
			   -cipher => $cipher,
			   -pbkdf   => 'pbkdf2',
	) || die "Couldn't create CBC object";
    $decrypted = $cbc->decrypt(decode_base64($arg));
    
    if (substr($decrypted, 0, length($magic)) ne $magic) {
	# fall back to legacy opensslv1 key derivation
	$cbc = Crypt::CBC->new(-key    =>  $key,
			       -cipher => $cipher,
			       -nodeprecate,
	    ) || die "Couldn't create CBC object";
	$decrypted = $cbc->decrypt(decode_base64($arg));
    }	
    
    if (substr($decrypted, 0, length($magic)) ne $magic) {
	# decryption failure
	return;
    }

    my $result = uc(unpack ('H*', substr($decrypted, length($magic))));
    if ($result =~ m/^F(.*)/) {
	$result = $1;
    }
    return $result;
}

sub get_passphrase {
    my $arg = shift || {};

    my $min_length = $arg->{MIN_LENGTH} || 8;

    system "stty -echo";
  TRY:
    while (1) {
	my $result;
	my $verify;
	print STDERR "Passphrase: ";
	chomp($result = <STDIN>);
	print STDERR "\n";
	if (length($result) < $min_length) {
	    print STDERR "\nMinimum length is $min_length characters, please repeat.\n";
	    next TRY;
	}
	if ($arg->{NOVERIFY}) {
	    system "stty echo";
	    return $result;
	}
	print STDERR "Passphrase verification: ";
	chomp($verify = <STDIN>);
	if (defined $result && defined $verify && ($result eq $verify)) {
	    system "stty echo";
	    return $result;
	} else {
	    print STDERR "\nERROR: Verification failed. Please repeat.\n";
	}
    }
}

my $k = 2;
my $n = 3;
my $bitlength;
my $help;
my $man;
my $batch;
my $encrypted_shares;
my $share_directory;
my $share_basename = ".share";
my $base64;

GetOptions(
    'help' => \$help,
    'man' => \$man,
    'k=i' => \$k,
    'n=i' => \$n,
    'bitlength=i' => \$bitlength,
    'encrypted-shares' => \$encrypted_shares,
    'base64' => \$base64,
    'share-dir|share-directory=s' => \$share_directory,
    'share-basename=s' => \$share_basename,
    'batch' => \$batch,
    )
    or pod2usage(-verbose => 0);

pod2usage(-exitstatus => 0, -verbose => 2) if ($man);
pod2usage(-verbose => 1)                   if ($help);

if ($encrypted_shares && (! $share_directory)) {
    print STDERR "ERROR: --encrypted-shares currently requires --share-dir\n";
    exit 1;
}

if ($base64 and $encrypted_shares) {
    print STDERR "ERROR: --base64 and --encrypted-shares are mutually exclusive\n";
    exit 1;
}

if (defined $share_directory) {
    if (! -d $share_directory) {
	print STDERR "ERROR: directory $share_directory does not exist\n";
	exit 1;
    }
    if (! defined $bitlength) {
	$bitlength = 256;
    }
} else {
    if (! defined $bitlength) {
	$bitlength = 128;
    }
}

if ($bitlength % 8 != 0) {
    print STDERR "ERROR: bitlength should be a multiple of 8\n";
    exit 1;
}

my $secret = OpenXPKI::Crypto::Secret->new(
    {
	TYPE => 'Split',
	QUORUM => {
	    N => $n,
	    K => $k,
	},
	TOKEN => DummyToken->new(),
    });

if (! $secret) {
    die "Could not instantiate secret. Stopped";
}

my $cmd = shift || exit 0;

if ($cmd eq 'generate') {
    my @shares = $secret->compute({ BITLENGTH => $bitlength });
    my $secret = $secret->get_secret();

    if ($base64) {
	$secret = encode_base64(pack "H*", $secret, '');
	chomp $secret;

	# NOTE: shares have an odd number of nibbles, but pack/unpack works on hex bytes.
	# Solution: prepend a 'F' digit to the share if the original nibble length is odd
	# This must will be later removed during reconstruction.
	for (my $ii = 0; $ii < scalar(@shares); $ii++) {
	    if (length($shares[$ii]) % 2 != 0) {
		$shares[$ii] = 'F' . $shares[$ii];
	    }
	    $shares[$ii] = encode_base64(pack "H*", $shares[$ii], '');
	    chomp $shares[$ii];
	}
    }

    if ($encrypted_shares) {
	print STDERR "Creating shared secret of $bitlength random bits with ($k/$n) quorum.\n\n";
	print STDERR "Shares will be encrypted with a passphrase supplied by each share holder.\n\n";
	print STDERR "After creating the shares the program will print the $bitlength bit phrase\n";
	print STDERR "to STDOUT.\n";
	if ($share_directory) {
	    print STDERR "Generated shares will be written to directory $share_directory.\n";
	}
	print STDERR "\n";

	$secret = encode_base64(pack "H*", $secret, '');
	chomp $secret;

	for (my $ii = 0; $ii < scalar(@shares); $ii++) {
	    print STDERR "\nShare holder #" . ($ii + 1) . ", please enter the passphrase for your share (twice to verify):\n";
	    my $key = get_passphrase();
	    print STDERR "\n";
	    
	    $shares[$ii] = encrypt($shares[$ii], $key);

	    if ($share_directory) {
		my $file = File::Spec->catfile($share_directory, $share_basename . "-" . $ii);
		open my $fh, '>', $file or die "Could not open share file $file for writing. Stopped";
		chmod 0400, $file;
		print $fh $shares[$ii] . "\n";
		close $fh;
	    }
	}
	print "PASSPHRASE=$secret\n";
    } elsif ($batch) {
	print "K=$k\n";
	print "N=$n\n";
	print "PASSPHRASE=$secret\n";
	
	for (my $ii = 0; $ii < scalar @shares; $ii++) {
	    print "SHARE[$ii]=$shares[$ii]\n";
	}
    } else {
	print STDERR "Creating shared secret of $bitlength random bits with ($k/$n) quorum.\n\n";
	print STDERR "This program will first print the $n shares to STDERR, clearing the screen\n";
	print STDERR "with 200 newlines after each step.\n";
	print STDERR "After providing the shares the program will print the $bitlength bit phrase\n";
	print STDERR "to STDOUT.\n\n";

	print STDERR "Hit ENTER now to display the first share.\n";
	my $tmp = <>;
	for (my $ii = 0; $ii < $n; $ii++) {
	    print STDERR "Share holder #" . ($ii + 1) . ", this is your share:\n";
	    print STDERR $shares[$ii] . "\n\n";
	    print STDERR "Copy the share and hit ENTER to clear the screen.\n";
	    print STDERR "(NOTE: no sensitive data will be displayed immediately after the key press.)\n";
	    $tmp = <>;
	    for (my $jj = 0; $jj < 200; $jj++) {
		print STDERR "\n";
	    }
	    print STDERR "Share #" . ($ii + 1) . " has just been displayed.\n";
	    print STDERR "Hit ENTER to continue\n\n";
	    $tmp = <>;
	}
	print "PASSPHRASE=$secret\n";
    }
} elsif ($cmd eq 'get') {
    if ($encrypted_shares) {
	# special handling for encrypted shares
#	my %locked_shares = map { $_ => 1 } ( 0 .. $n - 1 );
	my %locked_share;

	for (my $ii = 0; $ii < $n; $ii++) {
	    # get encrypted share from disk
	    my $file = File::Spec->catfile($share_directory, $share_basename . "-" . $ii);
	    open my $fh, '<', $file or die "Could not open share file $file for reading. Stopped";
	    $locked_share{$ii} = <$fh>;
	    close $fh;
	    chomp $locked_share{$ii};
	}

	
      LOCKED_SHARE:
	while (! $secret->is_complete()) {
	    print STDERR "\nNeed to unlock " . ($k - ($n - (scalar keys %locked_share))) . " more shares.\n";
	    print STDERR "Please enter a share passphrase:\n";
	    my $key = get_passphrase({ NOVERIFY => 1 });
	    print STDERR "\n";
	    foreach my $ii (keys %locked_share) {
		my $decrypted = decrypt($locked_share{$ii}, $key);
		if (defined $decrypted) {
		    print STDERR "Decrypted share #" . ($ii + 1) . "\n";

		    eval {
			$secret->set_secret($decrypted);
		    };
		    if ($EVAL_ERROR) {
			print STDERR "Could not unlock share #" . ($ii + 1) . " (should not happen).\n";
		    } else {
			print STDERR "Successfully unlocked share #" . ($ii + 1) . "\n";
			delete $locked_share{$ii};
			next LOCKED_SHARE;
		    }
		}
	    }
	    print STDERR "INFO: No share could be unlocked with this passphrase.\n";
	}
    } else {
	# this is the "normal" case with clear text shares
	while (! $secret->is_complete()) {
	    if (! $batch) {
		for (my $ii = 0; $ii < 200; $ii++) {
		    print STDERR "\n";
		}
		print STDERR "Please enter share: ";
	    }
	    my $line = <>;
	    chomp $line;
	    if ($base64) {
		$line = unpack('H*', decode_base64($line));
		# if the line starts with the digit F this indicates that the original share had an odd number
		# of nibbles, strip it off
		if ($line =~ m/^f(.*)/) {
		    $line = $1;
		}
	    }

	    $line = uc($line);
	    eval {
		$secret->set_secret($line);
	    };
	    if ($EVAL_ERROR) {
		print STDERR "ERROR: invalid share entered, repeat please\n";
		if (! $batch) {
		    sleep 2;
		}
	    }
	}
    }

    my $passphrase;
    if ($base64 or $encrypted_shares) {
	$passphrase = encode_base64(pack "H*",  $secret->get_secret(), '');
	chomp $passphrase;
    } else {
	$passphrase = $secret->get_secret();
    }
    print "PASSPHRASE=$passphrase\n";
} else {
    print STDERR "ERROR: invalid command '$cmd'\n";
    exit 1;
}

__END__

=head1 NAME

secret - Secret Splitting

=head1 USAGE

secret [OPTIONS] [get|generate]

=head1 DESCRIPTION

=head1 OPTIONS

=over 8

=item B<--k>

Quorum value K. Default: 2
K shares out of N are required to reconstruct the secret.

=item B<--n>

Quorum value N. Default: 3
K shares out of N are required to reconstruct the secret.

=item B<--batch>

Batch mode, does not print instructions for humans, instead only outputs the necessary
information.

=item B<--base64>

Shares and secret will be represented in Base64 format which is more compact than 
the default Hex format. Cannot be used with --encrypted-shares

=item B<--encrypted-shares>

Encrypt the shares with a passphrase entered by the user. Currently requires --share-dir.
Cannot be used with --base64

=item B<--share-dir>

Base directory in which to store encrypted shares. Requires --encrypted-shares.

=item B<--share-basename>

Base filename for storing encrypted shares. Default: .share

=item B<--help>

Display a short help summary.

=item B<--man>

Display full manual page.

=back

=head1 COMMANDS

=over 8

=item B<generate>

This command generates a random number (default: 128 bit), performs the actual secret 
splitting, generates and prints the secret parts. The output in batch mode has the format

  SECRET=....
  SHARE[0]=....
  SHARE[1]=....

A useful way to hide the output and to provide the data for later processing (e. g. during a key
ceremony) is to invoke the script via eval `...`:

eval `./bin/secret generate --k 3 --n 5 --batch`

After executing ths command you can access the values as shell variables.

In interactive mode (default) some verbose instructions are printed to STDERR, the final SECRET=...
is still printed to STOUT. This makes it possible to assign the secret value to a variable and
continue processing from there:

  PASSPHRASE=`./bin/secret generate  --k 3 --n 5` openssl genrsa -aes256 -passout env:PASSPHRASE -out key.pem 2048


=item B<get>

After reading the necessary components of the secret this command outputs the reconstructed secret to STDOUT.
Make sure to specify the same --k and --n parameters as during generation of shared secrets.

In --batch mode the script reads --k lines from STDIN without printing any information.

=back

=head1 EXAMPLES

  PASSPHRASE=`secret generate --k 3 --n 5 --encrypted-shares --share-dir private`

  PASSPHRASE=`secret get --k 3 --n 5 --encrypted-shares --share-dir private`
