#!/usr/pkg/bin/perl -w
#
#  pgpenvelope_encrypt
#    - call to pgpenvelope for enciphering
#
#  Copyright (C) 2000 Frank J. Tobin <ftobin@uiuc.edu>
#
#  This file is part of pgpenvelope
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, visit the following URL:
#  http://www.gnu.org/copyleft/gpl.html
#
#  $Id: pgpenvelope_encrypt,v 1.22 2001/05/12 18:56:36 ftobin Exp $
#

use 5.005;

use strict;
use English;
use FindBin;
use IO::Seekable;
use sigtrap 'handler' => 'die_signal_handler', 'normal-signals';

use GnuPG::Interface 0.30;

use PGPEnvelope::Common;
use PGPEnvelope::Config;
use PGPEnvelope::EncryptionKeyring;
use PGPEnvelope::SecretKeyring;
use PGPEnvelope::Terminal;

#####################################################################

my $terminal = PGPEnvelope::Terminal->new();
$terminal->setup();
my $output_handle = $terminal->output_handle();
select $output_handle;
$OUTPUT_AUTOFLUSH = 1;

#####################################################################

my $config = new PGPEnvelope::Config;
$config->getopt( \@ARGV );

my $homedir = $config->get( 'homedir' );
PGPEnvelope::Common->check_and_create_dir( $homedir );

my $is_filter = $config->get( 'filter' ) ? 1 : 0;

$config->parse_file
  ( File::Spec->catfile( $homedir, PGPEnvelope::Common->prefs_filename() ) );

my $encrypt_checkbox = $config->get( 'encrypt-to-recipients'   );
my $sign_checkbox    = $config->get( 'sign-for-recipients'     );
my $program          = $config->get( 'encryption-program'      );
my $program_args     = $config->get( 'encryption-program-call' );
my $short_key_info   = $config->get( 'show-short-key-info'     );

unless ( lc $program eq 'gpg' or lc $program eq 'gnupg' )
{
    PGPEnvelope::Common->die_gracefully( "$FindBin::Script: error: don't know how to interact with decryption_program $program.\n" );
}

##############################################################

my @recipients = @ARGV;
my @extra_encrypt_keys = @{ $config->get( 'encrypt-to-extra-key' ) };

my ( $call, @user_args ) = split( /\s+/, $program_args );

# we should change this to call => $call in the future,
# so we don't mandate the users upgrading GnuPG::Interface
my $gnupg = GnuPG::Interface->new( call => $call  );
$gnupg->options->hash_init
(  armor                  => 1,
   meta_interactive       => 1,
   encrypt_to             => [ @extra_encrypt_keys ],
   meta_pgp_5_compatible  => $config->get( 'pgp-5-compatible' ),
   textmode               => 1,
   extra_args             => [ @user_args ],
);

my $signing_key_id = $config->get( 'signing-key' ) || '';
if ( $signing_key_id )
{
    print "determining signing key...\n";
    $gnupg->options->meta_signing_key( select_signing_key( $signing_key_id ) );
}

$gnupg->options->comment( $config->get( 'comment' ) )
  if $config->get( 'comment' ) and $config->get( 'do-comment' );

my $recipient_keyring = PGPEnvelope::EncryptionKeyring->new( gnupg => $gnupg );
$recipient_keyring->load_keys( map { "<$_>" } @recipients )
  if $config->get( 'encrypt_to_recipients' );

##############################################################

$terminal->output_handle->format_name( 'NORMAL_MENU' );

my $menu_message = '';

MENU_WRITE: while ( 1 )
{
    # terminal clear and menu writing
    $terminal->clear_screen();
    write;
    
    $menu_message = '';
    
    # Get input.
    my $choice = $terminal->readkey();
    
    if ( $choice eq 'e' )
    {
	toggle_encryption();
	$menu_message = $encrypt_checkbox
	  ? 'Selected to encrypt.' : 'Selected not to encrypt.';
    }
    elsif ( $choice eq 's' )
    {
	toggle_signing();
	$menu_message = $sign_checkbox
	  ? 'Selected to sign.' : 'Selected not to sign.';
    }
    elsif ( $choice eq 'k' )
    {
	my @key_ids = select_encryption_keys();
	$menu_message = join( '', 'Selected encryption keys ',
			      join( ', ', @key_ids ),
			      '.',
			    );
    }
    elsif ( $choice eq 'b' )
    {
	make_subkey_selection();
    }
    elsif ( $choice eq 'h' )
    {
	display_menu_help();
	$terminal->wait_for_key();
    }
    elsif ( $choice eq 'l' or $choice eq 'm' )
    {
	list_keys( $choice );
	$terminal->wait_for_key();
    }
    elsif ( $choice eq 'i' )
    {
	import_keys();
	$terminal->wait_for_key();
    }
    elsif ( $choice eq 'o' )
    {
	select_signing_key();
	$menu_message = "Selected signing key $signing_key_id.";
    }
    elsif ( $choice eq 'c' )
    {
	PGPEnvelope::Common->die_gracefully( "$FindBin::Script: cancelling\n" );
    }
    elsif ( $choice eq "\n" )
    {
	if ( commit() )
	{
	    $terminal->wait_for_key();
	    exit 0;
	}
    }
    else
    {
	$menu_message
	  = "*** Invalid choice: '$choice'.  Please try again. ***";
	next;
    }

}

####################################################################


sub commit
{
    
    # make sure that recipients are selected if encrypting
    if ( $encrypt_checkbox
	 and not scalar $recipient_keyring->keys() )
    {
	print "You must select keys to encrypt to if encrypting.\n";
	$terminal->wait_for_key();
	return 0;
    }
    
    # make sure 'Encrypt' or 'Sign' was selected
    unless( $encrypt_checkbox or $sign_checkbox )
    {
	# Verify that the user does not want to encrypt or sign.
	while ( 1 )
	{
	    print( "You have not selected to encrypt or sign your mesage.\n",
		   "This will leave a plaintext message.\n",
		   'Are you sure you want to send a plaintext message? [y/N] '
		 );
	    my $choice = $terminal->readkey();
	    print "\n";
	    
	    my $lc_choice = lc $choice;
	    
	    unless ( $lc_choice eq 'y'
		     or $lc_choice eq 'n'
		     or $lc_choice eq "\n"
		   )
	    {
		print "Invalid choice '$lc_choice'.  Please try again\n\n";
	    }
	    
	    if ( $lc_choice eq 'y' )
	    {
		print STDOUT <STDIN>;
		return 1;
	    }
	    
	    return 0;
	}
    }
    
    
    print "Committing with $program ($call)...\n";
    
    my @encrypt_keys;
    
    foreach my $key ( $recipient_keyring->keys() )
    {
	if ( $key->count_subkeys() == 0 )
	{
	    push @encrypt_keys, $key->hex_id();
	}
	elsif ( my $subkey = $key->preferred_subkey_hex_id() )
	{
	    push @encrypt_keys, $subkey;
	}
	elsif ( $key->count_subkeys() >= 1 )
	{
	    push @encrypt_keys, $key->subkeys_ref->[0]->hex_id();
	}
	else
	{
	    die "WARNING: this program should not have reached this impassable point: please contact the author";
	}
    }
    
    $gnupg->options->push_recipients( @encrypt_keys );
    
    if ( $encrypt_checkbox )
    {
	print( 'performing encryption to ',
	       join( ', ', @encrypt_keys ),
	     );
	
	# handle any extra key recipients
	if ( @extra_encrypt_keys )
	{
	    print( ' and extra keys ',
		   join ', ', @extra_encrypt_keys,
		 );
	}
	
	print "...\n";
    }
    
    
    my $gnupg_command;
    
    if ( $encrypt_checkbox and $sign_checkbox )
    {
	$gnupg_command = 'sign_and_encrypt';
    }
    elsif ( $encrypt_checkbox )
    {
	$gnupg_command = 'encrypt';
    }
    elsif ( $sign_checkbox )
    {
	$gnupg_command = 'clearsign';
    }
    else
    {
	die 'unreachable code reached';
    }
    
    # because of the large-file-buffering issues,
    # we need to pass this stuff off to a tempfile
    # first.
    my $temp_in  = PGPEnvelope::Common->open_tempfile();
    
    $temp_in->print( $_ ) while <STDIN>;
    $temp_in->seek( SEEK_SET, 0 );
    
    my $handles = GnuPG::Handles->new( stdin  => $temp_in );
    $handles->options( 'stdin'  )->{direct} = 1;
    
    $gnupg->$gnupg_command( handles => $handles );
    
    wait;
    
    PGPEnvelope::Common->clear_fh( $temp_in );
    $temp_in->close();
    
    PGPEnvelope::Common->die_gracefully
	  ( "$FindBin::Script: $program ($call) exited with an error\n" )
	    if $CHILD_ERROR != 0;
    
    print "$FindBin::Script: $program ($call) finished successfully\n";
}




####################################################################



sub toggle_encryption
{
    $encrypt_checkbox = not $encrypt_checkbox;
    
    $recipient_keyring->load_keys( map { "<$_>" } @recipients )
      if $encrypt_checkbox and not $recipient_keyring->keys_loaded();
}


sub toggle_signing
{
    $sign_checkbox = not $sign_checkbox;
}


sub select_encryption_keys
{
    print "Select Encryption Keys:\n";
    
    my @key_ids = prompt_for_key_ids( $recipient_keyring, @recipients );
    @key_ids = @recipients unless @key_ids;
    
    $recipient_keyring->load_keys( @key_ids );
 
    return @key_ids;
}


sub display_menu_help
{
    my $output_handle = $terminal->output_handle;
    print $output_handle <<EOF;

e         Toggles whether to encrypt the message
s         Toggles whether to sign the message.
k         Select keys to encrypt to by ordinary or hex IDs, or indexes.
b         Select specfic subkey to encrypt to.
h         This help.
l         Lists keys from keyring.
m         Lists keys with signatures from keyring.
i         Imports a key from a keyserver.
o         Select the secret key to sign with.
c         Cancel sending a message
<enter>   Commits to processing message.  Do this after you have
          made all of your settings.

Index numbers are the numbers listed nex to each key in the main menu.

When prompted to select keys, and index numbers are allowed,
one can use single indexes as well as ranges of index numbers.

For example, suppose there there were 5 keys indexed that one could
choose from.  One can select keys using '3', '2-4', '-3', and '3-'.
'2-4' is the same as '2,3,4', while for '-3' and '3-', the minimum
or maximum index respectively is used in place of the missing number.
For example, '-3' is '1-3', and '3-' is '3-5'.
Simply '-' is all current current matches ( '1-5' )..

Unshortened hex key id's are used to prevent problems with collisions
between short 8-character hex ids.

EOF
#'
}


sub list_keys
{	
    my ( $arg ) = @_;
    print "List Keys:\n";
    
    my @key_ids = prompt_for_key_ids( $recipient_keyring, @recipients );
    @key_ids = @recipients unless @key_ids;
    
    $arg eq 'l'
      ? $recipient_keyring->print_keys( @key_ids )
	: $recipient_keyring->print_keys_with_sigs( @key_ids );
}


sub import_keys
{
    print "Import Key From Keyserver:\n";
    
    my @key_ids = prompt_for_key_ids( $recipient_keyring, @recipients );
    @key_ids = @recipients unless @key_ids;
    
    $recipient_keyring->import_keys( @key_ids );
}


sub prompt_for_key_ids
{
    my ( $keyring, @defaults ) = @_;
    
    print
      "Enter strings to match, hex IDs, index numbers,\n",
      "or ranges of index numbers separated by commas:\n";
    
    my $line = $terminal->readline
      ( join( '', '[ ', join( ', ', @defaults ), ' ] ' )  );
    
    # remove spaces on each end
    $line =~ s/^\s+//;
    $line =~ s/\s+$//;
    
    # split by commas
    my @key_ids;
    my @inputs = split /\s*\,\s*/, $line;
    
    return select_key_ids( $keyring, @inputs );
}


sub prompt_for_index
{
    my ( $default ) = @_;
    
    my $prompt =  defined $default ? "[ $default ] " : '';

    print( "Enter an index number: ");
    
    my $line = $terminal->readline( $prompt );
    
    $line =~ s/^\s+//;
    $line =~ s/\s+$//;
    return $line;
}



sub select_key_ids
{
    my ( $keyring, @selects ) = @_;
    my @key_ids;
    
    # check for index numbers (aren't they cool? :) )
    foreach ( @selects )
    {
	if ( /^\d+$/ )
	{
	    push @key_ids, $keyring->keys_ref->[$_-1]->hex_id()
	      if $keyring->keys_ref->[$_-1];
	}
	elsif ( /^(\d*)\-(\d*)$/ )
	{
	    my $first = $1 ? $1 - 1 : 0;
	    my $last  = $2 ? $2 - 1 : scalar $keyring->keys() - 1;
	    
	    $last = $first if $last < $first;
	    
	    for ( my $i = $first; $i <= $last; $i++ )
	    {
		push @key_ids, $keyring->keys_ref->[$i]->hex_id()
		  if $keyring->keys_ref->[$i];
	    }
	}
	else
	{
	    push @key_ids, $_;
	}
    }
    
    return @key_ids;
}


sub make_subkey_selection
{
    my $selection;
    
    while ( 1 )
    {
    	print "Please select the key you wish to set the subkey for, or enter nothing to return.\n";
	$selection = prompt_for_index();
	
	return if $selection eq '';
	
	last if $selection =~ /^\d+$/ and $recipient_keyring->keys->[$selection-1];
	
	print "Invalid selection: '$selection'\n";
	$terminal->wait_for_key();
    }
    
    my $key = $recipient_keyring->keys->[$selection-1];

    query_and_set_preferred_subkey( $key );
}


sub query_and_set_preferred_subkey
{
    my ( $key ) = @_;
    
    $key->clear_preferred_subkey_hex_id();
    
    my $keyid = $key->short_hex_id();
    my $subkey_keyring = PGPEnvelope::Keyring->new();
    $subkey_keyring->keys( $key->subkeys() );
    $subkey_keyring->set_keys_loaded();
    
    unless ( $subkey_keyring->count_keys() > 1 )
    {
	print( "\n",
	       "There are not multiple subkeys attached to $keyid.\n",
	     );
	
	$terminal->wait_for_key();
	return;
    }
    
    until ( $key->preferred_subkey_hex_id() )
    {
	print "\n";
	$key->print();
	print "\n";
	
	print "Subkeys attached to $keyid:\n";
	
	$subkey_keyring->print();
	
	print( "\n",
	       "There are multiple subkeys attached to the primary key $keyid.\n",
	       "Subkeys are the parts of the key you enrypt to.\n",
	       "Please select a subkey to use for the encryption from the above list of subkeys.\n\n",
	     );
	
	my $index = prompt_for_index();
	
	last if not $index;
	
	if ( $index =~ /^\d+$/ and $subkey_keyring->keys->[$index-1] )
	{
	    my $subkey = $subkey_keyring->keys->[$index-1];
	    
	    $key->preferred_subkey_hex_id( $subkey->hex_id() );
	    # we've really destroyed encapsulation, but oh well....
	    $recipient_keyring->clear_indexed_key_info_loaded();
	    
	    $menu_message = "Selected subkey " . $subkey->short_hex_id() . " for key $keyid";
	    last;
	}
	else
	{
	    print "Invalid response: '$index'\n";
	    wait_for_key();
	}
    }
}


sub select_signing_key
{
    my ( $initial_keyid ) = @_;
    
    my $secret_keyring = PGPEnvelope::SecretKeyring->new( gnupg => $gnupg );
    
    while ( 1 )
    {
	my @key_ids;
	
	if ( $initial_keyid )
	{ 
	    @key_ids = select_key_ids( $secret_keyring, $initial_keyid );
	    undef $initial_keyid;
	}
	else
	{
	    @key_ids = prompt_for_key_ids( $secret_keyring, 'default' ),
	}
	
	if ( scalar @key_ids == 0 )
	{
	    $signing_key_id = '';
	    $gnupg->options->clear_meta_signing_key();
	    last;
	}
	
	$secret_keyring->load_keys( @key_ids );
	
	if ( $secret_keyring->count_keys() == 1 )
	{
	    my $signing_key = $secret_keyring->keys_ref->[0];
	    $signing_key_id = $signing_key->hex_id();
	    $gnupg->options->clear_meta_signing_key();
	    $gnupg->options->meta_signing_key( $signing_key );
	    return;
	}
	
	$secret_keyring->print();
	
	print
	  'There is not a unique key for the id "',
	  join( ', ', @key_ids ),
	  "\" on your keyring.\n";
    }
}


####################################################################


format NORMAL_MENU = 
/////////////// @||||||||||||||||||||||||||||||||||||||| \\\\\\\\\\\\\\
join( ' ', 'pgpenvelope', PGPEnvelope::Common->version(), '- standard mailing' )
@*
join( '', ( $short_key_info ? $recipient_keyring->get_short_indexed_key_info() : $recipient_keyring->get_indexed_key_info() ) )
Recipients: @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
            join ( ', ', @recipients )
Signing Key: @<<<<<<<<<<<<<<<<
             $signing_key_id || 'default'

[@] (e) encrypt message                (l) list keys
 $encrypt_checkbox ? 'X' : ''
[@] (s) sign message                   (m) list keys with signatures
 $sign_checkbox ? 'X' : ''
    (k) select keys to encrypt to      (i) import keys from keyserver
    (b) select specific subkey         (o) select signing key
    (h) help                           (c) cancel
                                       <enter> commit

@||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
$menu_message
Please select an option from above:
.



sub die_signal_handler
{
    my ( $signal_name ) = @_;
    print "$FindBin::Script: Signal $signal_name caught.  Cleaning up.\n";
    $terminal->cleanup() if $terminal;
    PGPEnvelope::Common->die_gracefully->( "Exiting.\n" );
}
