[36] | 1 | #!/usr/bin/perl |
---|
| 2 | # |
---|
[44] | 3 | # Copyright 2007 Simon Ward <simon@bleah.co.uk> |
---|
[36] | 4 | # Copyright 2002-2006 Ingo Kloecker <mail@ingo-kloecker.de> |
---|
| 5 | # |
---|
| 6 | # This program is free software; you can redistribute it and/or modify |
---|
[44] | 7 | # it under the terms of version 2 of the GNU General Public License as |
---|
| 8 | # published by the Free Software Foundation. |
---|
| 9 | # |
---|
| 10 | # is free software; you can redistribute it and/or modify |
---|
[36] | 11 | # it under the terms of the GNU General Public License as published by |
---|
| 12 | # the Free Software Foundation; either version 2 of the License, or |
---|
| 13 | # (at your option) any later version. |
---|
| 14 | # |
---|
| 15 | # This program is distributed in the hope that it will be useful, |
---|
| 16 | # but WITHOUT ANY WARRANTY; without even the implied warranty of |
---|
| 17 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
---|
| 18 | # GNU General Public License for more details. |
---|
| 19 | # |
---|
| 20 | # You should have received a copy of the GNU General Public License |
---|
| 21 | # along with this program; if not, write to the Free Software |
---|
| 22 | # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA |
---|
| 23 | # |
---|
| 24 | |
---|
| 25 | use strict; |
---|
[40] | 26 | use File::Temp qw(tempfile); |
---|
[36] | 27 | |
---|
| 28 | my $myKeyID="0123456789ABCDEF"; |
---|
| 29 | my $myEmailAddress="Full Name <name\@example.com>"; |
---|
[41] | 30 | my $myName="Full Name"; |
---|
[40] | 31 | my $policyURL="http://www.example.com/gpg/policy"; |
---|
[36] | 32 | my $occasion="something"; |
---|
| 33 | |
---|
[43] | 34 | sub get_uids ($) |
---|
| 35 | { |
---|
| 36 | my $keyID = shift; |
---|
[36] | 37 | |
---|
| 38 | my (%uids); |
---|
| 39 | |
---|
| 40 | open( GPG, "gpg --with-colon --list-sigs --fixed-list-mode $keyID 2>/dev/null|" ) |
---|
[38] | 41 | || die "Cannot run gpg\n"; |
---|
[36] | 42 | |
---|
| 43 | my $uid = ""; |
---|
| 44 | |
---|
| 45 | while ( <GPG> ) { |
---|
| 46 | if ( /^uid/ ) { |
---|
| 47 | if ( defined( $uid ) && $uid ne "" ) { |
---|
| 48 | $uids{$uid} = $uid; |
---|
| 49 | } |
---|
| 50 | my @fields = split /:/; |
---|
| 51 | if ( ( $fields[1] ne "r" ) && ( $fields[1] ne "e" ) ) { |
---|
| 52 | # user ID wasn't revoked and hasn't expired |
---|
| 53 | $uid = $fields[9]; |
---|
| 54 | # convert some UTF-8 to latin1 |
---|
| 55 | $uid =~ s/Ã\\x9f/ß/g; |
---|
| 56 | $uid =~ s/Ã\\x89/É/g; |
---|
| 57 | $uid =~ s/ä/ä/g; |
---|
| 58 | $uid =~ s/á/á/g; |
---|
| 59 | $uid =~ s/é/é/g; |
---|
| 60 | $uid =~ s/è/è/g; |
---|
| 61 | $uid =~ s/ø/ø/g; |
---|
| 62 | $uid =~ s/ö/ö/g; |
---|
| 63 | $uid =~ s/ü/ü/g; |
---|
| 64 | $uid =~ s/Ä\\x8c/C/g; |
---|
| 65 | $uid =~ s/Å\\x99/r/g; |
---|
| 66 | $uid =~ s/\\x3a/:/g; |
---|
[39] | 67 | printf STDERR "Found valid user id $uid.\n" |
---|
[36] | 68 | } |
---|
| 69 | } |
---|
| 70 | elsif ( /^sig.*:$myKeyID:.*x:$/ ) { |
---|
| 71 | $uid = ""; |
---|
[39] | 72 | printf STDERR "This user id was already signed by me.\n" |
---|
[36] | 73 | } |
---|
| 74 | } |
---|
| 75 | close GPG; |
---|
| 76 | |
---|
| 77 | if ( defined( $uid ) && $uid ne "" ) { |
---|
| 78 | $uids{$uid} = $uid; |
---|
| 79 | } |
---|
| 80 | |
---|
[43] | 81 | return %uids; |
---|
| 82 | } |
---|
| 83 | |
---|
[45] | 84 | open( CHALLENGE, ">>gpg.challenges" ) |
---|
| 85 | || die "Cannot append to gpg.challenges file\n"; |
---|
| 86 | |
---|
[43] | 87 | foreach my $keyID (@ARGV) { |
---|
| 88 | if ( $keyID !~ /[A-F0-9]{8}/i ) |
---|
[36] | 89 | { |
---|
[43] | 90 | die "\"$keyID\" doesn't look like a valid Key-ID!\n"; |
---|
| 91 | } |
---|
| 92 | |
---|
| 93 | printf STDERR "Key ID: $keyID\n"; |
---|
| 94 | my (%uids) = get_uids($keyID); |
---|
| 95 | |
---|
| 96 | foreach my $uid ( keys %uids ) |
---|
| 97 | { |
---|
[38] | 98 | # Get a random string: |
---|
| 99 | my $challenge; |
---|
[42] | 100 | open ( RANDOM, "dd if=/dev/random count=64 bs=1 | mimencode|" ) |
---|
[38] | 101 | || die "Cannot get random string\n"; |
---|
| 102 | while ( <RANDOM> ) |
---|
[36] | 103 | { |
---|
[38] | 104 | $challenge .= $_; |
---|
[36] | 105 | } |
---|
[38] | 106 | chomp $challenge; |
---|
| 107 | close RANDOM; |
---|
[36] | 108 | |
---|
| 109 | # Create the encrypted part of the body of the message: |
---|
[38] | 110 | my $body = << "EOF"; |
---|
[40] | 111 | Hi, |
---|
[36] | 112 | |
---|
[40] | 113 | You are receiving this email because you gave me your OpenPGP key |
---|
| 114 | details for key-signing at $occasion. |
---|
[36] | 115 | |
---|
[40] | 116 | This message is a challenge to help verify that you can read email sent |
---|
| 117 | to $uid and encrypted to the key with ID $keyID. |
---|
[36] | 118 | |
---|
[40] | 119 | You should have received an email for each UID, each containing a random |
---|
| 120 | string of data. Please reply from each of the UIDs a message was sent |
---|
| 121 | to, including the random string, making sure you sign the message. (You |
---|
| 122 | may encrypt your reply, but this is not necessary.) |
---|
[36] | 123 | |
---|
[40] | 124 | After receiving your reply and checking that the challenge string |
---|
| 125 | matches the original, I will upload your key to a key server unless you |
---|
| 126 | specify otherwise. |
---|
[36] | 127 | |
---|
[40] | 128 | My key-signing policy can be found at: |
---|
[36] | 129 | |
---|
[40] | 130 | $policyURL |
---|
[36] | 131 | |
---|
[40] | 132 | BEGIN CHALLENGE |
---|
| 133 | $challenge |
---|
| 134 | END CHALLENGE |
---|
[36] | 135 | |
---|
[40] | 136 | Regards, |
---|
[41] | 137 | $myName |
---|
[36] | 138 | EOF |
---|
| 139 | |
---|
[40] | 140 | my ($tmp_fh, $tmp_fname) = tempfile(); |
---|
| 141 | print $tmp_fh $body; |
---|
| 142 | close $tmp_fh; |
---|
| 143 | system ( "mutt -e \"set pgp_autosign=yes;set pgp_autoencrypt=yes\" -i \"$tmp_fname\" -s \"OpenPGP UID verification\" -- \"$uid\"" ); |
---|
[45] | 144 | print CHALLENGE "$challenge: $uid ($keyID)\n"; |
---|
[36] | 145 | } |
---|
| 146 | } |
---|
[45] | 147 | |
---|
| 148 | close CHALLENGE; |
---|