#!/usr/bin/perl -w
########################################
## Sending encrypted random challenges to UIDs of a given key.
## by Ralf Hüls <R.Huels@ping.de>
##
## After receiving a key fingerprint for certification, you'll
## want to ascertain that the key owner has control over all
## e-mail addresses listed with the UIDs on the public key.
## This program generates a unique random string for each
## UID on a given key and sends that string to the respective
## e-mail adresses in an e-mail encrypted to the key.
## The random challenges are logged so you can later verify
## the replies from the key owner.
##
## Usage: challenge
## The program will ask for the key ID interactively.
##
## Output:
## challenge.log  - List of Key ID, random string and Mail address
##
## Needs:
## - GnuPG 1.0.7 (http://www.gnupg.org/)
## - Perl 5      (http://www.perl.com/)
## - MIME::Lite and sendmail 
##   or Win32::OLE and Microsoft Outlook
## - Unix style "rm" utility.
##   I use Cygwin (http://sources.redhat.com/cygwin/) when
##   forced to work with Windows.
##
## (c) 25-06-2002 by Ralf Hüls <R.Huels@ping.de>
##
## This program is a dirty hack, use it at your own risk ;-)
## It may need some tweaking to fit your environment.
## Non-commercial use and distribution of this program is permitted.
## If you modify this program to create something useful or
## interesting, I'd like to hear about it.
##
## Ralf Hüls <R.Huels@ping.de> 
## http://www.teleute.ping.de/
## DSA key: E131C5A4
## RSA key: 4931A04F
####################################################################
##
## Uncomment whatever is appropriate
##
## Your e-mail address goes here:
##
#my $myadr='Ralf Huels <user@domain.invalid>';
##
use MIME::Lite; my $mime=1; my $outlook=0;
#use Win32::OLE; my $outlook=1; my $mime=0;
##
## GnuPG Options
##
my $opt6="--pgp6";
##
## GnuPG Options for RSA keys
##
my $opt2="--pgp2";
####################################################################
####################################################################
####################################################################

use strict;

my $sig;
my $key;
my $opt;
my $body;
my $line;
my @output;
my %challenge;

print "Key-ID:";
$key=<STDIN>;
chomp $key;
die "Bad key ID!" unless ((uc $key) =~ /^[0123456789ABCDEF]{8}$/) ;

open(S,"gpg --list-keys $key|") or die "Keys: $!"; 
@output=<S>;
close S;

$opt=$opt6;

foreach (@output)
  {
    if (/^pub.{6}R\//) {
      $opt=$opt2;
    }
    if (/^(uid|pub)/)
      {      
	next unless /<.*@.*>/;
	$sig=$_;
	chomp $sig;
	$sig=~s/.*<(.*@.*)>.*/$1/;
	next if defined $challenge{$sig};
        $challenge{$sig}=substr(`gpg --gen-random 0 32|gpg --print-md md5`,0,48);
	$challenge{$sig}=~s/ //g;
	die "Random: $!" if $?;
	print "$key;$challenge{$sig};$sig;\n";
	open(G,">challenge.tmp") or die "challenge.tmp: $!";
	print G "Hallo,\n";
	print G "ich wurde gebeten, den PGP-Schlüssel 0x$key zu signieren.\n";
	print G "Um zu bestätigen, daß Du Kontrolle über die Adresse $sig hast,\n";
	print G "sende bitte die folgenden 32 Bytes in einer signierten und \n";
	print G "verschlüsselten Mail an mich zurück.\n\n";
	print G "Hi,\n";
	print G "I was requested to sign the PGP key 0x$key.\n";
	print G "To confirm that you have control over the e-mail address $sig,\n";
	print G "please return the following 32 bytes to me in a signed and \n";
	print G "encrypted e-mail:\n\n";
	print G "$challenge{$sig}\n\n";
	close G;
	`gpg $opt --no-encrypt-to -ear $key challenge.tmp`;
	die "Encrypt: $!" if $?; 
	open F,'challenge.tmp.asc' or die "challenge.tmp.asc: $!";
	$body='';
	while (defined ($line=<F>))
	{
	    $body .= $line;
	}
	close F;
	if ($mime) {
	  MimeLight($sig);
	} elsif ($outlook) {
	  MailOutlook($sig);
	} 
	`rm -f challenge.tmp challenge.tmp.asc`;
	die "Cleanup: $!" if $?; 
      }
  }
    
if (-f "challenge.log") {
  open(G,">>challenge.log") or die "challenge.log: $!";
} else {
  open(G,">challenge.log") or die "challenge.log: $!";
}

foreach (keys %challenge) {
  print G "$key;$challenge{$_};$_;\n";
}
close G;


sub MailOutlook{
  my $ex;
  my $mail;
  my $mailitem = 0;

  $ex = new Win32::OLE 'Outlook.Application' 
    or die "Kann Outlook nicht ”ffnen!";
  $mail = $ex->CreateItem($mailitem);
  $mail->Recipients->Add($_[0]);
  $mail->{Subject} = "PGP-Keysigning";
  $mail->{Body} = $body;
  $mail->Send or warn "Warnung: $!";
 undef $mail;
 undef $ex;
}

sub MimeLight{
    my $msg;
    $msg = MIME::Lite->new(
			   From       => $myadr,
			   To         => $sig,
			   Subject    => "PGP-Keysigning",
			   Type       => "text/plain; charset=ISO-8859-1",
			   Data       => $body,
			   Encoding   => "7bit");
    $msg->send();
}