path: root/masterkey.pl

#!/usr/bin/perl
use strictures;
use v5.10;

use Data::Dumper;
use Email::Date;
use Email::MessageID;
use Function::Parameters;
use Getopt::Long;
use GnuPG::Interface;
use JSON;
use List::Util qw(first);
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
   --from-address <email> Email of GPG ID to use
   --tokenfile <file>     Record tokens in this file
   --debug                Output debugging information

=cut

sub main {
	my $recipient_address_regex = qr/\@archlinux\.org/;
	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.

A copy of your signed key is attached to this message.

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", "from-address=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: --from-address option is required but not set\n" if not $opts{'from-address'};
	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);

			if ($command eq 'verification') {
				validate_key_parameters($id);
			}

			my $msg = build_email($command, $opts{from}, quotemeta($opts{'from-address'}), $id, $recipient_address_regex, $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";
		}
	}
}

fun save_token($id, $token, $file) {
	open my $fh,  '>>', $file or die "Failed to open '$file': $!";
	say $fh "$id $token";
	close $fh;
}

fun fill_template($template, $values) {
	my $result = Text::Template::fill_in_string($template, HASH => $values)
		or die "Failed to fill in template: $Text::Template::ERROR";

	return $result;
}

fun gpg_get_users($key) {
	my $gpg = GnuPG::Interface->new();
	my @keys = $gpg->get_public_keys_with_sigs($key);

	die "No key found" if 0+@keys == 0;

	my @users;

	for my $uid ($keys[0]->user_ids->@*) {
		next if $uid->revocations->@* > 0;

		my $user = Encode::decode('utf8', $uid->as_string);
		unless ($user =~ m/^(?<name>.*?) (?:\((?<comment>.*?)\) )?\<(?<email>.*?@.*?)\>$/) {
			die "Failed to parse GPG user information for key $key; got $user";
		}

		push @users, {%+};
	}

	return \@users;
}

fun gpg_get_user($key, $email_regex) {
	my $users = gpg_get_users($key);

	return $users->[0] if $users->@* == 1;

	my $user = first {$_->{email} =~ m/$email_regex/} $users->@*;

	while (not defined $user) {
		for my $item ($users->@*) {
			printf "%s - %s\n", $item->@{qw(name email)};
		}

		print "Enter email address to use: ";
		my $email = <STDIN>;
		chomp($email);
		$user = first {$_->{email} eq $email} $users->@*;
	}

	return $user;
}

fun validate_key_parameters($key) {
	system("sq-keyring-linter <(gpg --export '$key')");
	system("gpg --export '$key' | hokey lint");

	print "Are there validation errors in the output above or is anything else wrong with the key? (Y/n) ";
	my $answer = <STDIN>;
	chomp($answer);

	die "Key has validation errors" unless $answer eq 'n' or $answer eq 'N';
}

fun build_email($command, $sender_key, $sender_address_regex, $recipient_key, $recipient_address_regex, $subject, $body, $token) {
	# get from gpg keys
	my ($sender_name, $sender_addr) = gpg_get_user($sender_key, $sender_address_regex)->@{qw(name email)};
	my ($recipient_name, $recipient_addr) = gpg_get_user($recipient_key, $recipient_address_regex)->@{qw(name email)};

	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('MIME-Header', $sender_name). " <$sender_addr>",
		To   => $recipient_addr,
		BCC   => $sender_addr,
		Subject => Encode::encode('MIME-Header', $subject),
		# TODO: necessary?
		#TimeZone => 'Europe/Vienna',
		Encoding => 'quoted-printable',
		Charset => 'utf8',
		Date => Email::Date::format_date(),
		Data => [$body],
	);

	if ($command eq 'confirmation') {
		my $recipient_key_data = `gpg --armor --export $recipient_key`;
		$msg->attach(
			Data => $recipient_key_data,
			Filename => "$recipient_key-signed.asc",
			Encoding => 'quoted-printable',
		);
	}


	$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],
	);
}

fun send_email($msg) {
	open my $mail, "|msmtp -t";
	print $mail $msg->as_string;
	close $mail;
}

main();