#!/usr/bin/perl
use strict;
use Mail::Box;
use Mail::Box::Manager;
use File::Temp qw(tempdir :POSIX);
use Env qw(GNUPGHOME);
use IO::File;
use File::Copy qw(cp);
use constant MAILBOX => 'Maildir';
use constant VERSION => '2018.07.21 (v1.0)';
use constant DEBCONF => '18';
use feature 'say';
$| = 1;
my ($mgr, $folder, $workdir, $log, $num, %addrs);
$mgr = Mail::Box::Manager->new;
$folder = $mgr->open(folder => MAILBOX);
$workdir = tempdir('gnupg_XXXXXXX', TMPDIR => 1, CLEANUP => undef);
$GNUPGHOME = "$workdir/gnupg";
mkdir($GNUPGHOME, 0700);
$log = "$workdir/log";
$num=0;
foreach my $msg ($folder->messages) {
my ($body, $from, $email, $mylog, $logfh, $fh, $tmpname, $tmplog, $verif);
$num += 1;
$body = $msg->body;
$from = get_sender($msg);
$email = $1 if $from =~ /([^\s<]+\@[^\s>]+)/;
$addrs{$email} ||= {valid => [], err => [], keyid => undef};
$mylog = "${log}_${num}";
$logfh = IO::File->new($mylog, 'w');
$logfh->say("=== Processing key in mail #$num ($from)\n\n");
$logfh->say('* Performing some sanity checks...');
sanity_check($body, $logfh);
$logfh->say('* Begin the fun part of extracting information!');
$logfh->say('→ First, try to extract the key from the signed message...');
$tmpname = tmpnam();
$tmplog = tmpnam();
$fh = IO::File->new("| gpg -v --output $tmpname - 2>>$tmplog");
$fh->say($body);
$fh->close;
merge_tmplog($tmplog, $logfh);
if (-e $tmpname) {
$logfh->say('→ Import the key into a clean keyring');
$logfh->say(`gpg --import $tmpname 2>&1`);
$logfh->say('→ Get the keyid from the created file');
($addrs{$email}{keyid}, $addrs{$email}{uid}) = fetch_keydata($tmpname);
$logfh->say('→ Verify the message bears the right signature');
$verif = verify_msg($body, $mylog, $logfh, $addrs{$email}{keyid});
} else {
$logfh->say('Cannot even begin to process your message ☹');
}
printf '%3d %30s... ', $num, $email;
if ($verif) {
say 'OK';
# Ugly overloading, yes: Given that $verif is used for boolean
# purposes, we also use it to communicate the full fingerprint
$addrs{$email}{fpr} = $verif;
push @{$addrs{$email}{valid}}, $num;
} else {
say 'Error!';
push @{$addrs{$email}{err}}, $num;
}
unlink($tmpname);
unlink($tmplog);
}
gen_summaries();
say "* Temporal working directory ⇒ $workdir";
exit 0;
sub gen_summaries {
my ($txtpath, $htmlpath, $txtfh, $htmlfh, $valid);
$valid=0;
$txtpath = sprintf('%s/ksp-dc%s.txt', $workdir, DEBCONF);
$htmlpath = sprintf('%s/names.html', $workdir);
$txtfh = IO::File->new($txtpath, 'w');
$htmlfh = IO::File->new($htmlpath, 'w');
write_txt_header($txtfh);
write_html_header($htmlfh);
for my $addr (sort {lc($addrs{$a}{uid}) cmp
lc($addrs{$b}{uid})} keys %addrs) {
if (scalar(@{ $addrs{$addr}{valid} } != 0) ) {
$valid++;
write_fpr_for($addr, $valid, $txtfh, $htmlfh);
} else {
use YAML;
report_errors_on($addr);
}
}
write_html_footer($htmlfh);
cp('style.css', "$workdir/style.css");
}
sub merge_tmplog {
my ($tmplog, $logfh, $fh);
$tmplog=shift;
$logfh=shift;
$fh = IO::File->new($tmplog, 'r');
$logfh->say($fh->getlines);
close($fh);
$logfh->flush;
unlink($tmplog);
}
sub report_errors_on {
my $addr = shift;
for my $id (@{$addrs{$addr}{err}}) {
my ($fh, $fh2);
$fh = IO::File->new(sprintf('%s/error_%s', $workdir, $id), '>');
$fh2 = IO::File->new(sprintf('%s/log_%s', $workdir, $id), '<');
$fh->say(qq(To: $addr
Subject: DebConf18 KSP: Problems with your submitted key
Hi!
I'm just a poor, dumb script, and I need your help.
My Master asked me to process all of the keys sent for the DC18 KSP, but
I stumbled across some problems processing yours.
The full extents of my knowledge are saved in the following log:
/------------------------------------------------------------));
$fh->say(map {"| $_"} $fh2->getlines);
$fh2->close;
if (scalar( @{ $addrs{$addr}{valid} } ) > 0) {
$fh->say(qq(\\------------------------------------------------------------
Not all hope is lost. Master says you might like to know I *do* have some
valid mails from you, for the following fingerprints:
));
for my $other_id (@{$addrs{$addr}{valid}}) {
$fh2 = IO::File->new(sprintf('%s/log_%s', $workdir, $other_id), '<');
for my $lin ($fh2->getlines) {
next unless $lin =~ /^Primary key fingerprint/;
$fh->say($lin);
}
}
$fh->say(qq(
If the above fingerprints include all of the keys you want to sign, don't
worry, you are all set. Otherwise, please review the instructions at:
));
} else {
$fh->say(qq(
I don't have any other information indicating you could have sent your key
again. My Master is ashamed of the lateness of this request — But please,
do not delay acting on this!
));
}
$fh->say('https://people.debian.org/~gwolf/ksp-dc18/ksp-dc18.html');
$fh->say();
$fh->say(' - Just a poor, dumb script.');
}
}
sub write_fpr_for {
my ($addr, $num, $txtfh, $htmlfh, $mailfh, $keyid, $fpr, $fprfh);
$addr = shift;
$num = shift;
$txtfh = shift;
$htmlfh = shift;
$mailfh = IO::File->new(sprintf('%s/ok_%s', $workdir, $num), '>');
$keyid = $addrs{$addr}->{keyid};
$fprfh = IO::File->new("gpg --fingerprint $keyid |");
$fprfh->read($fpr, 4096);
$fprfh->close;
$mailfh->say("To: $addr
Subject: DebConf18 KSP: Almost there! (and you are all set)
Hi!
You might have interacted with me in the past — I'm just a poor, dumb
script that tries to parse mails for the KSP.
It seems we got it right! I can confirm I know the following details
about your key:
$fpr
We are still ironing out some bits, so the following files are NOT YET
FINAL (that is, don't print them until you get our notice). But do
keep them at hand:
- The document to be used for the keysigning:
https://people.debian.org/~gwolf/ksp-dc18/ksp-dc18.txt
- A nice HTML view (that we will attempt to update with some more
information):
https://people.debian.org/~gwolf/ksp-dc18/names.html
- Instructions and general information on the keysigning process
(which you already followed successfully, at least once):
https://people.debian.org/~gwolf/ksp-dc18/ksp-dc18.html
Sorry for the delays and lack of updates, we have been working hard to
get this going. See you soon in Hsinchu!
");
$txtfh->say("#$num $addrs{$addr}{uid}");
$txtfh->say();
$txtfh->say(' [ ] Fingerprint(s) OK [ ] ID OK');
$txtfh->say();
$txtfh->say($fpr);
$htmlfh->say(sprintf('
',
($num%2 ? 'odd' : 'even'), $num, $addrs{$addr}{uid},
$addrs{$addr}{fpr}, $keyid));
}
sub get_sender {
my ($msg, @addrs);
$msg = shift;
foreach my $addr ($msg->from) {
push @addrs, $addr->format;
}
return join(', ', @addrs);
}
sub fetch_keydata {
my ($filename, $keyid, $uid, $fh);
$filename = shift;
$fh = IO::File->new("gpg --list-packets $filename |");
while (my $lin = $fh->getline) {
last if defined $keyid && defined $uid;
if (!(defined $keyid) &&
$lin =~ /^\s*keyid: ([\dABCDEF]{16})$/) {
$keyid = $1;
}
if (!(defined $uid) &&
$lin =~ /^:user ID packet: "(.+) \say('• Total message length: ', length($body), ' bytes');
$fh->say('• First lines of your message:');
$fh->say(map {" > $_\n"} @lines[0..5]);
$fh->say('• Clear-signed message?');
$fh->say(ordered_strings_within($body,
'BEGIN PGP SIGNED MESSAGE',
'BEGIN PGP SIGNATURE',
'END PGP SIGNATURE') ?
' Yes!' :
' * MISSING');
$fh->say('• Contains a key block?');
$fh->say(ordered_strings_within($body,
'BEGIN PGP PUBLIC KEY BLOCK',
'END PGP PUBLIC KEY BLOCK') ?
' Yes!' :
' * MISSING');
$fh->say('• Is the key block clear-signed?');
$fh->say(ordered_strings_within($body,
'-----BEGIN PGP SIGNED MESSAGE',
'Hash: SHA',
'- -----BEGIN PGP PUBLIC KEY BLOCK',
'- -----END PGP PUBLIC KEY BLOCK',
'-----BEGIN PGP SIGNATURE',
'-----END PGP SIGNATURE') ?
' Yes!' :
' * MISSING');
}
sub ordered_strings_within {
my ($str, @strings, $this, $pos);
$str = shift;
@strings = @_;
# We work recursively. Pick only the first string for now...
# If there's nothing left to search, we succeed!
return 1 if scalar(@strings) == 0;
$this = shift @strings;
$pos = index($str, $this);
return 0 if ($pos < 0); # Not found ☹
# Reduce the string to its reminder
$str = substr($str, $pos + length($this), length($str));
# Recurse
return ordered_strings_within($str, @strings);
}
sub verify_msg {
my ($msg, $logfile, $logfh, $keyid, $tmplog, $verified, $fh, $gpg_res);
$msg = shift;
$logfile = shift;
$logfh = shift;
$keyid = shift;
# First, verify again the message (we didn't have the key in the first call)
#
# We just redirect $verified to a file we get the name here for
# the special-casing described below :-P
$tmplog = tmpnam();
$verified = tmpnam();
$fh = IO::File->new("| gpg -v - >$verified 2>>$tmplog");
$fh->say($msg);
$gpg_res = $fh->close;
if (! $gpg_res) {
$logfh->say("Message for $keyid does not verify (GPG)");
unlink($tmplog);
unlink($verified);
return 0;
}
merge_tmplog($tmplog, $logfh);
unlink($tmplog);
# Check the key was signed by the same key. This is not foolproof,
# but enough for the time being.
$fh = IO::File->new($logfile, 'r');
while (my $lin = $fh->getline) {
my ($fpr, $fpr_ver);
next unless $lin =~ /^Primary key fingerprint: (.*)/;
$fpr = $1;
$fpr =~ s/\s//g;
if (substr($fpr, -16, 16) eq $keyid) {
# The fingerprint is guaranteed to be a true value. And,
# we can store + use it later! ☺
return $fpr;
} elsif (substr($fpr, -16, 16) eq '673A03E4C1DB921F') {
# Special-casing for my own (Gunnar Wolf's) key: I have
# signed some requests for which the script failed to
# parse. Of course, this means the _real_ key fingerprint
# must be obtained from the key material, not from the
# signature!
$fpr_ver = fpr_from_packets($verified);
unlink($verified);
return $fpr_ver;
}
}
return 0;
}
sub fpr_from_packets {
my ($file, $fh);
$file = shift;
$fh = IO::File->new("gpg --list-packets $file |");
for my $lin ($fh->getlines) {
next unless $lin =~ /hashed subpkt 33 len 21 \(issuer fpr v4 ([\dABCDEF]{40})\)/;
return $1;
}
return undef;
}
sub write_txt_header {
my $fh;
$fh = shift;
$fh->say(center('D E B C O N F ' . DEBCONF . ' K E Y S I G N I N G'));
$fh->say();
$fh->say(center('Prepared by Gunnar Wolf '));
$fh->say();
$fh->say(center('List of participants'));
$fh->say();
$fh->say(center('Document version ' . VERSION));
$fh->say(q(
Here's what you have to do with this file:
1. Print this file to paper.
2. Compute this file's SHA256 checksum: sha256sum ksp-dc18.txt
3. fill in the hash values on the printout.
4. Bring the printout, a pen, and proof of identity to the keysigning.
For each participant:
1. Compare the hash you computed with the other participant.
2. Ask if the other participant's gpg fingerprint on the hardcopy is correct.
3. Verify each other's identity by checking preferably a passport.
4. If you are satisfied with the identification, mark on your hardcopy that
the other participant's gpg fingerprint is correct and has been identified.
SHA256 Checksum: _________________________________________________________ [ ]
));
}
sub write_html_header {
my ($fh, $dc);
$fh = shift;
$dc = DEBCONF;
print $fh <<"EOF"
DebConf$dc Keysigning Party Names
DebConf$dc Keysigning Party
DebConf$dc Keysigning Party Names
#
Name
Key IDs
EOF
}
sub write_html_footer {
my ($fh, $date);
$fh = shift;
$date = `date -u`;
print $fh <<"EOF"
EOF
}
sub center {
my ($str);
$str = shift;
return ' ' x ( (80 - length($str))/2 ) . $str;
}
