#!/usr/bin/perl -w

# $Id: ca-recv 160 2005-01-05 10:16:17Z lfousse $

# Copyright (c) 1998 Ian Jackson
#           (c) 2001, 2003, 2004 Peter Palfrader
#
# 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, 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 GNU Privacy Guard; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
# 02111-1307, USA.


use strict;
use File::Path;
use Cabot qw(%CONFIG getkeydir ask);

umask(0007);

my $config = $ENV{'HOME'} . '/.cabotrc';
-f $config or die "No file $config present.  See ca-config(5).\n";
my $confblurb = '';
open CONFIG, $config;
{
    local $/;
    $confblurb = <CONFIG>;
}
close CONFIG;

unless (scalar eval $confblurb) {
        die "Couldn't parse $_: $@.\n" if $@;
};

#
# is this chdir really necesarry? if not, we can get rid of $CONFIG{'cabothome'}.
#
chdir($CONFIG{'cabothome'});

sub send_mail($$) {
	my ($subject, $body) = @_;
	
	my $msg = << "EOF";
Subject: $subject
To: $CONFIG{'name'}
Bcc: $CONFIG{'BCCmail'}
From: $CONFIG{'bot'}

$body
EOF
	open(MAIL, $CONFIG{'sendmail'}) || die ("Cannot execute sendmail: $!\n");
	print MAIL $msg;
	close(MAIL);
};


my $in;
{
	local $/=undef;
	$in = <STDIN>;
};

my ($keyid) = ($in =~ m/Key: ([0-9A-F]{8})/);
my ($magic) = ($in =~ m/Magic: ([0-9A-F]*)/);
my ($upload) = ($in =~ m/Upload to keyservers: (Yes)/);
$upload = 0 unless defined $upload;

unless ((defined $keyid) && (defined $magic)) {
	send_mail("CABOT: could not parse reply", "Could not parse this message successfully:\n\n$in\n");
	exit(0);
};

unless ( -d getkeydir('sentdir', $keyid) ) {
	send_mail("CABOT: key does not exist in sentdir", "Key $keyid does not exist in sentdir:\n\n$in\n");
	exit(0);
};

unless (opendir(DIR, getkeydir('sentdir', $keyid))) {
	send_mail("CABOT: error opening sentdir", "Error opening ".getkeydir('sentdir', $keyid).": $!\nOriginal message:\n\n$in\n");
	exit(0);
};

my @uids= grep { ! /^\./ } readdir(DIR);
close(DIR);

my $ok=0;
for my $uid (@uids) {
	unless (open(MAGIC, getkeydir('sentdir', $keyid, $uid).'/MAGIC')) {
		send_mail("CABOT: error opening MAGIC", 
		          "Error opening ".getkeydir('sentdir', $keyid, $uid)."/MAGIC: $!\nOriginal message:\n\n$in\n");
		exit(0);
	};
	my $storedmagic = <MAGIC>;
	close(MAGIC);
	if ($storedmagic eq $magic) {
		$ok = $uid;
		last;
	};
};

unless ($ok) {
	send_mail("CABOT: could not find a matching magic", "could not find a matching magic\nOriginal message:\n\n$in\n");
	exit(0);
};

my $uid = $ok;

unless ( -d getkeydir('tosign', $keyid) ) {
        unless (-d $CONFIG{'tosign'}) {
            unless (mkpath($CONFIG{'tosign'}, 0, 0711)) {
		    send_mail("CABOT: Cannot create dir",
		          "Cannot create dir ".$CONFIG{'tosign'}.": $!\nOriginal message:\n\n$in\n");
                    exit(0);
            }
        }
	unless (mkpath(getkeydir('tosign', $keyid), 0, 0771)) {
		send_mail("CABOT: Cannot create dir in tosign", 
		          "Cannot create dir ".getkeydir('tosign', $keyid).": $!\nOriginal message:\n\n$in\n");
		exit(0);
	};
};

unless (rename(getkeydir('sentdir', $keyid, $uid), getkeydir('tosign', $keyid, $uid)) ) {
	send_mail("CABOT: Cannot move to tosign", "Cannot move ".getkeydir('sentdir', $keyid, $uid)." to ".
	          getkeydir('tosign', $keyid, $uid).": $!\nOriginal message:\n\n$in\n");
	exit(0);
};

rmdir( getkeydir('sentdir', $keyid)); # may fail


unless (open(LOG, '>'. getkeydir('tosign', $keyid, $uid).'/LOG')) {
	send_mail("CABOT: Cannot create file in tosign", 
	          "Cannot write to ".getkeydir('tosign', $keyid, $uid)."/LOG $!\nOriginal message:\n\n$in\n");
	exit(0);
};
print LOG $in;
close(LOG);

if ($upload) {
	unless (open(UPLOAD, '>'. getkeydir('tosign', $keyid, $uid).'/upload')) {
		send_mail("CABOT: Cannot create file Upload", 
		          "Cannot write to ".getkeydir('tosign', $keyid, $uid)."/upload $!\nOriginal message:\n\n$in\n");
		exit(0);
	};
	close(UPLOAD);
};

send_mail("CABOT: new key in tosign", "Keyid: $keyid\nUid: $uid\n\nOriginal message:\n\n$in\n");

__END__

=pod

=head1 NAME

ca-recv - parse email message, holding a reply to a cabot GPG challenge

=head1 SYNOPSIS

B<ca-recv>

=head1 DESCRIPTION

B<ca-recv> expects an email message on stdin.  In this message, it looks
for lines containing

 Key:
 Magic:
 Upload to keyservers:

.

It verifies the Magic: against the cookie stored in sentdir/MAGIC, and exits if
this fails.

It creates tosign/LOG, and, if the mail contains a request for uploading,
tosign/upload.  It mails a report to C<name> as specified in ca-config(5).
If everything went fine, this report looks like:

 Subject: CABOT: new key in tosign
 To: John Doe <john@example.com>
 From: CA Bot running on behalf of John Doe <john-cabot@example.com>

 Keyid: ABC01234
 Uid: Foo Bar <foo@example.com>

 Original message:
 <the complete original email message>

Messages on errors, if any, are mailed to C<name> too.

B<ca-recv> is part of the ca-bot(7) process; typically, ca-dosign(1) is run
after B<ca-recv>.

=head1 SEE ALSO

ca-bot(7), ca-config(5)

=head1 VERSION

$Id: ca-recv 160 2005-01-05 10:16:17Z lfousse $

=head1 AUTHOR

Peter Palfrader, based upon work by Ian Jackson

=cut


