1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
|
#!/usr/bin/perl
use warnings;
use strict;
use v5.10;
use Data::Dumper;
use Email::Date;
use Email::MessageID;
use Getopt::Long;
use GnuPG::Interface;
use JSON;
use List::MoreUtils;
use Mail::GPG;
use MIME::Entity;
use Pod::Usage;
use String::Random qw(random_string);
use Text::Template;
use Try::Tiny;
=head1 NAME
masterkey.pl
=head1 SYNOPSIS
masterkey.pl [options] <keyid ...>
Send verification mails to the owners of the listed GPG keys.
Options:
--help, -h short help message
--dry-run, -n do not perform any permanent actions
--from, -f <gpg id> GPG ID used to send the email
--tokenfile <file> Record tokens in this file
--debug Output debugging information
=cut
sub main {
my %templates = (
'verification' => {
'subject' => 'Master Key Verification for {$recipient_name} ({$recipient_key})',
'body' => 'Hi,
This mail is about having your GPG key signed by an Arch Linux master key.
Please reply with an email that is signed with your key ({$recipient_key})
and contains the token listed below. It is not necessary to encrypt the mail,
however, signing the mail with your key is required.
If you do not have GPG configured in your mail client, it is sufficient to
send the signed token as an attachment.
Your token: {$token}
Best Regards,
SAMKIVS (Simple Automated Master Key Identity Verification System)
on behalf of {$sender_name} ({$sender_key})
',
},
'confirmation' => {
'subject' => 'Master Key Signature Confirmation for {$recipient_name} ({$recipient_key})',
'body' => 'Hi,
Your GPG key ({$recipient_key})
has been successfully signed by an Arch Linux master key.
Best Regards,
SAMKIVS (Simple Automated Master Key Identity Verification System)
on behalf of {$sender_name} ({$sender_key})
',
},
);
my %opts = ();
Getopt::Long::Configure ("bundling");
GetOptions(\%opts, "help|h", "dry-run|n", "from|f=s", "tokenfile=s", "debug") or pod2usage(2);
pod2usage(0) if $opts{help};
pod2usage(-verbose => 0) if (@ARGV== 0);
my $command = shift @ARGV;
# TODO: print all errors at once
die "Error: --from option is required but not set\n" if not $opts{from};
die "Error: --tokenfile option is required but not set\n" if not $opts{tokenfile};
die "Error: no or invalid command\n" unless $templates{$command};
for my $id (@ARGV) {
say STDERR "Processing $id";
try {
die "key ID has length != 40\n" unless length($id) == 40;
my $mail_subject = $templates{$command}{'subject'};
my $mail_body = $templates{$command}{'body'};
my $token = random_string('.' x 25);
my $msg = build_email($command, $opts{from}, $id, $mail_subject, $mail_body, $token);
if ($command eq 'verification') {
save_token($id, $token, $opts{tokenfile}) unless $opts{'dry-run'};
}
send_email($msg) unless $opts{'dry-run'};
say $msg->as_string if $opts{debug};
} catch {
warn "$_\nSkipping $id due to uncaught error\n";
}
}
}
sub save_token {
my $id = shift;
my $token = shift;
my $file = shift;
open my $fh, '>>', $file or die "Failed to open '$file': $!";
say $fh "$id $token";
close $fh;
}
sub fill_template {
my $template = shift;
my $values = shift;
my $result = Text::Template::fill_in_string($template, HASH => $values)
or die "Failed to fill in template: $Text::Template::ERROR";
return $result;
}
sub gpg_get_user {
my $key = shift;
my $gpg = GnuPG::Interface->new();
my @keys = $gpg->get_public_keys($key);
die "No key found" if 0+@keys == 0;
my $user = $keys[0]->user_ids_ref->[0]->as_string;
unless ($user =~ m/^(?<name>.*?) (?:\((?<comment>.*?)\) )?\<(?<email>.*?@.*?)\>$/) {
die "Failed to parse GPG user information for key $key; got $user";
}
my $name = $+{name};
my $email = $+{email};
return ($name, $email);
}
sub build_email {
my $command = shift;
my $sender_key = shift;
my $recipient_key = shift;
my $subject = shift;
my $body = shift;
my $token = shift;
# get from gpg keys
my ($sender_name, $sender_addr) = gpg_get_user($sender_key);
my ($recipient_name, $recipient_addr) = gpg_get_user($recipient_key);
my %values;
$values{token} = $token;
$values{sender_key} = $sender_key;
$values{sender_name} = $sender_name;
$values{sender_addr} = $sender_addr;
$values{recipient_key} = $recipient_key;
$values{recipient_name} = $recipient_name;
$values{recipient_addr} = $recipient_addr;
$subject = fill_template($subject, \%values);
$body = fill_template($body, \%values);
my $mgpg = Mail::GPG->new(
default_key_id => $sender_key,
default_passphrase => '',
);
my $msg = MIME::Entity->build(
From => Encode::encode('iso-8859-1', $sender_name). " <$sender_addr>",
To => $recipient_addr,
BCC => $sender_addr,
Subject => Encode::encode('iso-8859-1', $subject),
# TODO: necessary?
#TimeZone => 'Europe/Vienna',
Encoding => 'quoted-printable',
Charset => 'utf8',
Date => Email::Date::format_date(),
Data => [$body],
);
$msg->add("Message-ID", Email::MessageID->new->in_brackets);
$msg->replace("Return-Path", "<$sender_addr>");
if ($command eq 'verification') {
return $mgpg->mime_sign_encrypt(
entity => $msg,
recipients => [$sender_key, $recipient_key],
);
}
return $mgpg->mime_sign(
entity => $msg,
recipients => [$sender_key, $recipient_key],
);
}
sub send_email {
my $msg = shift;
open my $mail, "|msmtp -t";
print $mail $msg->as_string;
close $mail;
}
main();
|
