source: keysigning/gpg-challenge.pl @ 40

#!/usr/bin/perl
#
#  Copyright 2002-2006 Ingo Kloecker <mail@ingo-kloecker.de>
#
#  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, write to the Free Software
#  Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
#

use strict;
use File::Temp qw(tempfile);

my $myKeyID="0123456789ABCDEF";
my $myEmailAddress="Full Name <name\@example.com>";
my $myFirstName="Firstname";
my $policyURL="http://www.example.com/gpg/policy";
my $occasion="something";

foreach my $keyID (@ARGV) {
    if ( $keyID !~ /[A-F0-9]{8}/i )
    {
        die "\"$keyID\" doesn't look like a valid Key-ID!\n";
    }

    printf stderr "Key ID: $keyID\n";

    my (%uids);

    open( GPG, "gpg --with-colon --list-sigs --fixed-list-mode $keyID 2>/dev/null|" )
        || die "Cannot run gpg\n";

    my $uid = "";

    while ( <GPG> ) {
        if ( /^uid/ ) {
            if ( defined( $uid ) && $uid ne "" ) {
                $uids{$uid} = $uid;
            }
            my @fields = split /:/;
            if ( ( $fields[1] ne "r" ) && ( $fields[1] ne "e" ) ) {
                # user ID wasn't revoked and hasn't expired
                $uid = $fields[9];
                # convert some UTF-8 to latin1
                $uid =~ s/Ã\\x9f/ß/g;
                $uid =~ s/Ã\\x89/É/g;
                $uid =~ s/ä/ä/g;
                $uid =~ s/á/á/g;
                $uid =~ s/é/é/g;
                $uid =~ s/è/è/g;
                $uid =~ s/ø/ø/g;
                $uid =~ s/ö/ö/g;
                $uid =~ s/ü/ü/g;
                $uid =~ s/Ä\\x8c/C/g;
                $uid =~ s/Å\\x99/r/g;
                $uid =~ s/\\x3a/:/g;
                printf STDERR "Found valid user id $uid.\n"
            }
        }
        elsif ( /^sig.*:$myKeyID:.*x:$/ ) {
            $uid = "";
            printf STDERR "This user id was already signed by me.\n"
        }
    }
    close GPG;

    if ( defined( $uid ) && $uid ne "" ) {
        $uids{$uid} = $uid;
    }

    foreach $uid ( keys %uids )
    {
        # Get a random string:
        my $challenge;
        open ( RANDOM, "head -c 18 /dev/urandom | mimencode|" )
            || die "Cannot get random string\n";
        while ( <RANDOM> )
        {
            $challenge .= $_;
        }
        chomp $challenge;
        close RANDOM;

        # Create the encrypted part of the body of the message:
        my $body = << "EOF";
Hi,

You are receiving this email because you gave me your OpenPGP key
details for key-signing at $occasion.

This message is a challenge to help verify that you can read email sent
to $uid and encrypted to the key with ID $keyID.

You should have received an email for each UID, each containing a random
string of data.  Please reply from each of the UIDs a message was sent
to, including the random string, making sure you sign the message.  (You
may encrypt your reply, but this is not necessary.)

After receiving your reply and checking that the challenge string
matches the original, I will upload your key to a key server unless you
specify otherwise.

My key-signing policy can be found at:

    $policyURL

BEGIN CHALLENGE
$challenge
END CHALLENGE

Regards,
$myFirstName
EOF

        my ($tmp_fh, $tmp_fname) = tempfile();
        print $tmp_fh $body;
        close $tmp_fh;
        system ( "mutt -e \"set pgp_autosign=yes;set pgp_autoencrypt=yes\" -i \"$tmp_fname\" -s \"OpenPGP UID verification\" -- \"$uid\"" );
        print "$challenge: $uid ($keyID)\n";
    }
}