head	2.30;
access;
symbols;
locks; strict;
comment	@# @;


2.30
date	2014.01.29.11.31.35;	author az;	state Exp;
branches;
next	2.29;

2.29
date	2013.11.25.11.50.08;	author az;	state Exp;
branches;
next	2.28;

2.28
date	2013.11.25.11.48.37;	author az;	state Exp;
branches;
next	2.27;

2.27
date	2012.09.04.10.27.32;	author az;	state Exp;
branches;
next	2.26;

2.26
date	2012.02.21.02.19.28;	author az;	state Exp;
branches;
next	2.25;

2.25
date	2010.09.16.05.17.22;	author az;	state Exp;
branches;
next	2.24;

2.24
date	2009.10.20.06.43.04;	author az;	state Exp;
branches;
next	2.23;

2.23
date	2008.08.31.06.39.26;	author az;	state Exp;
branches;
next	2.22;

2.22
date	2008.06.29.12.31.01;	author az;	state Exp;
branches;
next	2.21;

2.21
date	2008.06.29.11.57.31;	author az;	state Exp;
branches;
next	2.20;

2.20
date	2008.06.29.11.39.34;	author az;	state Exp;
branches;
next	2.19;

2.19
date	2008.06.29.11.01.55;	author az;	state Exp;
branches;
next	2.18;

2.18
date	2008.06.29.10.26.41;	author az;	state Exp;
branches;
next	2.17;

2.17
date	2008.06.29.07.24.53;	author az;	state Exp;
branches;
next	2.16;

2.16
date	2007.06.23.02.37.57;	author az;	state Exp;
branches;
next	2.15;

2.15
date	2005.11.04.06.21.20;	author az;	state Exp;
branches;
next	2.14;

2.14
date	2005.02.25.22.09.21;	author az;	state Exp;
branches;
next	2.13;

2.13
date	2003.08.03.02.06.53;	author az;	state Exp;
branches;
next	2.12;

2.12
date	2003.08.03.01.45.37;	author az;	state Exp;
branches;
next	2.11;

2.11
date	2003.04.25.07.52.15;	author az;	state Exp;
branches;
next	2.10;

2.10
date	2003.02.22.04.57.58;	author az;	state Exp;
branches;
next	2.9;

2.9
date	2003.02.21.11.41.06;	author az;	state Exp;
branches;
next	2.8;

2.8
date	2003.02.16.13.42.10;	author az;	state Exp;
branches;
next	2.7;

2.7
date	2003.02.08.13.09.39;	author az;	state Exp;
branches;
next	2.6;

2.6
date	2003.02.08.13.08.06;	author az;	state Exp;
branches;
next	2.5;

2.5
date	2003.02.05.22.45.39;	author az;	state Exp;
branches;
next	2.4;

2.4
date	2003.01.21.12.27.01;	author az;	state Exp;
branches;
next	2.3;

2.3
date	2003.01.15.22.57.54;	author az;	state Exp;
branches;
next	2.2;

2.2
date	2003.01.15.15.03.03;	author az;	state Exp;
branches;
next	2.1;

2.1
date	2003.01.12.15.21.03;	author az;	state Exp;
branches;
next	2.0;

2.0
date	2003.01.12.14.05.48;	author az;	state Exp;
branches;
next	1.27;

1.27
date	2002.10.27.13.45.50;	author az;	state Exp;
branches;
next	1.26;

1.26
date	2002.09.25.12.12.32;	author az;	state Exp;
branches;
next	1.25;

1.25
date	2002.09.19.16.43.25;	author az;	state Exp;
branches;
next	1.24;

1.24
date	2002.09.19.16.25.46;	author az;	state Exp;
branches;
next	1.23;

1.23
date	2002.09.19.14.58.21;	author az;	state Exp;
branches;
next	1.22;

1.22
date	2002.09.19.09.51.25;	author az;	state Exp;
branches;
next	1.21;

1.21
date	2002.09.19.09.13.13;	author az;	state Exp;
branches;
next	1.20;

1.20
date	2002.04.27.15.49.50;	author az;	state Exp;
branches;
next	1.19;

1.19
date	2002.04.26.02.11.33;	author az;	state Exp;
branches;
next	1.18;

1.18
date	2002.04.25.14.31.58;	author az;	state Exp;
branches;
next	1.17;

1.17
date	2002.03.05.13.18.49;	author az;	state Exp;
branches;
next	1.16;

1.16
date	2002.03.05.13.02.53;	author az;	state Exp;
branches;
next	1.15;

1.15
date	2002.02.16.12.02.54;	author az;	state Exp;
branches;
next	1.14;

1.14
date	2002.02.05.23.44.47;	author az;	state Exp;
branches;
next	1.13;

1.13
date	2002.01.30.14.23.21;	author az;	state Exp;
branches;
next	1.12;

1.12
date	2002.01.30.13.36.38;	author az;	state Exp;
branches;
next	1.11;

1.11
date	2002.01.27.12.32.31;	author az;	state Exp;
branches;
next	1.10;

1.10
date	2002.01.02.06.59.22;	author az;	state Exp;
branches;
next	1.9;

1.9
date	2002.01.02.06.42.48;	author az;	state Exp;
branches;
next	1.8;

1.8
date	2002.01.02.06.39.34;	author az;	state Exp;
branches;
next	1.7;

1.7
date	2001.12.12.13.31.02;	author az;	state Exp;
branches;
next	1.6;

1.6
date	2001.11.25.11.39.53;	author az;	state Exp;
branches;
next	1.5;

1.5
date	2001.11.11.11.41.05;	author az;	state Exp;
branches;
next	1.4;

1.4
date	2001.11.11.10.28.53;	author az;	state Exp;
branches;
next	1.3;

1.3
date	2001.11.10.04.55.38;	author az;	state Exp;
branches;
next	1.2;

1.2
date	2001.11.06.13.00.27;	author az;	state Exp;
branches;
next	1.1;

1.1
date	2001.11.06.12.53.15;	author az;	state Exp;
branches;
next	;


desc
@@


2.30
log
@fixed logfile handling, perl 5.18 is unhappy with close(...expr that is undef...)
@
text
@#!/usr/bin/perl
#
# this file is part of kuvert, a mailer wrapper that
# does gpg signing/signing+encrypting transparently, based
# on the content of your public keyring(s) and your preferences.
#
# copyright (c) 1999-2013 Alexander Zangerl <az@@snafu.priv.at>
#
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License version 2
#   as published by the Free Software Foundation.
#
#   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 this program; if not, write to the Free Software
#   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
#   $Id: kuvert,v 2.29 2013/11/25 11:50:08 az Exp az $
#--

use strict;
use Sys::Syslog qw(setlogsock openlog syslog closelog);
use Fcntl qw(:flock);
use Getopt::Std;
use MIME::Parser;		# for parsing the mime-stream
use Mail::Address;		# for parsing to and cc-headers
use Net::SMTPS;			# for sending via smtp, which ssl
use Sys::Hostname;		# ditto
use Net::Server::Mail::ESMTP;	# for receiving via smtp
use IO::Socket::INET;		# ditto
use FileHandle;
use File::Slurp;
use File::Temp qw(:mktemp);
use Fcntl qw(:flock);
use Time::HiRes;

# some global stuff
# the version number is inserted by make install
my $version="INSERT_VERSION";
my $progname="kuvert";
$0=$progname;
my $listenername="$progname-smtp";

# who are we gonna pretend to be today?
my($username,$home)=(getpwuid($<))[0,7];

# where is the configuration file
my $rcfile="$home/.kuvert";

my $timeout=600;		# seconds to wait for gpg

# configuration directives
my (%config,$debug,%email2key);

my %options;
if (!getopts("dork",\%options) || @@ARGV)
{
    die "usage: $progname [-d] [-o] [-r|-k]
-k: kill running $progname daemon
-d: debug mode
-r: reload keyrings and configfile
-o: one-shot mode, run queue once and exit
This is: $progname $version.\n";
}
$debug=$options{"d"};

# now handle the kill/reload stuff
my $piddir=($ENV{'TMPDIR'}?$ENV{'TMPDIR'}:"/tmp");
my $pidname="$progname.$<";

# kill a already running process
# TERM for kill or HUP for rereading
my $pidf="$piddir/$pidname.pid";
if ($options{"k"} || $options{"r"})
{
    my $sig=($options{"r"}?'USR1':'TERM');
    my $ssig='TERM';		# the smtp listener must die
    my $pidf="$piddir/$pidname.pid";

    die("no pid file found, can't signal any $progname\n")
	if (!-r $pidf);
    my @@pids=read_file($pidf);
    for my $p (@@pids)
    {
	chomp $p;
	$p=~s/[^0-9]//g;	# only numbers
	# fixme: this is linux-centric, should be replaced 
	# with proc::processtable
	my $fn="/proc/$p/cmdline";
	if (-r $fn && (my $n=read_file($fn))=~/^$progname/)
	{
	    my $s=($n=~/^$listenername/?$ssig:$sig);
	    dlogit("sending sig $s to $p");
	    logit("can't send signal to process $p: $!\n")
		if (!kill($s,$p));
	}
    }
    unlink($pidf) if ($options{k}); # remove the pidfile on kills
    exit 0;
}
chdir("/");

# now do the pidfile checking dance
if (-f "$pidf")                     
{
    open(PIDF,"+<$pidf") || &die("can't rw-open $pidf: $!\n");
}
else
{
    open(PIDF,">$pidf") || &die("can't w-open $pidf: $!\n");
}
die("can't lock $pidf: $!\n") if (!flock(PIDF,LOCK_NB|LOCK_EX));
my @@others=<PIDF>;
my @@badones;
for my $p (@@others)
{
    chomp $p;
    $p=~s/[^0-9]//g;	# only numbers
    # fixme: this is linux-centric, should be replaced 
    # with proc::processtable
    if (-r "/proc/$p/cmdline" 
	&& (my $n=read_file("/proc/$p/cmdline"))=~/^$progname/)
    {
	push @@badones,$p;
    }
}
die("other instance(s) with pids ".join(", ",@@badones)." are running\n")
    if (@@badones);
# rewind to ready it for writing
seek(PIDF,0,'SEEK_SET');

die("no configuration file exists. See $progname(1) for details.\n")
    if (!-e $rcfile);

dlogit("reading config file");
# read in the config, setup dirs, logging, defaultkey etc.
%config=&read_config;
# log startup after config is read and logging prefs are known
logit("$progname version $version starting");

# fire up smtp server, iff not oneshot
if (!$options{o} && 
    $config{"ma-user"} && $config{"ma-pass"} && $config{"maport"})
{
    # fork off the smtp-to-queue daemon
    my $pid=&start_mailserver;
    # we, parent, update the pidfile with mailserver pid
    print PIDF "$pid\n";
}

# install the handlers for conf reread
$SIG{'USR1'}=\&handle_reload;
# and the termination-handler
map { $SIG{$_}=\&handle_term; } qw(HUP INT QUIT TERM);

if (!$options{o} && $config{"can-detach"})
{
    my $pid=fork;
    if (!defined $pid)
    {
	&bailout("fork failed: $!");
    }
    elsif ($pid)
    {
	exit 0;			# parent is done
    }
}
print PIDF "$$\n";
close PIDF;			# clears the lock

# make things clean and ready. we're in sole command now.
cleanup($config{tempdir},0);
%email2key=&read_keyring;

# let's use one parser object only;
my $parser = MIME::Parser->new() 
    || bailout("can't create mime parser object: $!");

# dump mime object to tempdir
$parser->output_dir($config{tempdir});
# retain rfc1522-encoded headers, please
$parser->decode_headers(0);
# make the parser ignore all filename info and just invent filenames.
$parser->filer->ignore_filename(1);

# the main loop, left only via signal handler handle_term
while (1)
{
    &bailout("cant open $config{queuedir}: $!")
	if (!opendir(D,"$config{queuedir}"));
	
    my $file;
    foreach $file (sort grep(/^\d+$/,readdir(D)))
    {
	if (!open(FH,"$config{queuedir}/$file"))
	{
	    logit("huh? $file suddenly disappeared? $!");
	    next;
	}
	# lock it if possible
	if (!flock(FH,LOCK_NB|LOCK_EX))
	{
	    close(FH);
	    logit("$file is locked, skipping.");
	    next;
	}

	#ok, open & locked, let's proceed
	logit("processing $file for $username");

	my @@res=process_file(*FH,"$config{queuedir}/$file");
	if (@@res)
	{
	    rename("$config{queuedir}/$file","$config{queuedir}/.$file")
		|| &bailout("cant rename $config{queuedir}/$file: $!");
	    alert("Problem with $config{queuedir}/$file",
"Your mail \"$config{queuedir}/$file\" could not be processed and 
$progname has given up on it.
Please review the following error details to determine what went wrong:\n\n",
@@res,
"\n$progname has renamed the problematic mail to \"$config{queuedir}/.$file\";
if you want $progname to retry, rename it to an all-numeric filename. Otherwise you should delete the file.\n
Please note that processing may have worked for SOME recipients already!\n");
	}
	else
	{
	    logit("done handling file $file");
	    unlink("$config{queuedir}/$file")
		|| &bailout("cant unlink $config{queuedir}/$file: $!");
	}
	# and clean up the cruft left behind, please!
	cleanup("$config{tempdir}",0);

	# unlock the file
	bailout("problem closing $config{queuedir}/$file: $!")
	    if (!close(FH));
    }
    closedir(D);
    &handle_term("oneshot mode") if ($options{o});
    sleep($config{interval});
}


# sign an entity and send the resulting email to the listed recipients
# args: entity, location of dump of entity, outermost headers, envelope from,
# signkey and recipients
# returns nothing if fine, @@error msgs otherwise
sub sign_send
{
    my ($ent,$dumpfile,$header,$from,$signkey,@@recips)=@@_;
    my $output=mktemp($config{tempdir}."/cryptoout.XXXX");

    # generate a new top-entity to be mailed
    my $newent=new MIME::Entity;
    # make a private copy of the main header and set this one
    $newent->head($header->dup);
    # make it a multipart/signed
    # and set the needed content-type-fields on this top entity
    $newent->head->mime_attr("MIME-Version"=>"1.0");
    $newent->head->mime_attr("Content-Type"=>"multipart/signed");
    $newent->head->mime_attr("Content-Type.Boundary"=>
			     &MIME::Entity::make_boundary);
    $newent->head->mime_attr("Content-Type.Protocol"=>
			     "application/pgp-signature");
    $newent->head->mime_attr("content-Type.Micalg"=>"pgp-sha1");

    # set/suppress the preamble
    $newent->preamble($config{"preamble"}?
		      ["This is a multi-part message in MIME format.\n",
		       "It has been signed conforming to RFC3156.\n",
		       "You need GPG to check the signature.\n"]:[]);
	
    # add the passed entity as part
    $newent->add_part($ent);

    # generate the signature, repeat until proper passphrase given
    # or until gpg gives up with a different error indication
    my @@res;
    while (1)
    {
	@@res=&sign_encrypt($signkey,$dumpfile,$output,());
	last if (!@@res || $res[0]!=1);	#  no error or fatal error
	dlogit("gpg reported bad passphrase, retrying.");
	if (!$config{"use-agent"} && $config{"flush-secret"} && $signkey)
	{
	    dlogit("invalidating passphrase for $signkey");
	    my $cmd=sprintf($config{"flush-secret"},$signkey);
	    system($cmd);	# ignore the flushing result; best effort only
	}
    }
    return @@res[1..$#res] if (@@res || $res[0]); # fatal error: give up

    # attach the signature
    $newent->attach(Type => "application/pgp-signature",
		    Path => $output,
		    Filename => "signature.asc",
		    Disposition => "inline",
		    Description=> "Digital Signature",
		    Encoding => "7bit");
    # and send the resulting thing, not cleaning up
    return &send_entity($newent,$from,@@recips);
}

# encrypt and sign an entity, send the resulting email to the listed recipients
# args: entity, location of dump of entity, outermost headers, 
# envelope from address, recipient keys arrayref, recipient addresses
# returns nothing if fine, @@error msgs otherwise
sub crypt_send
{
    my ($ent,$dumpfile,$header,$from,$signkey,$rec_keys,@@recips)=@@_;
    my $output=mktemp($config{tempdir}."/cryptoout.XXXX");

    # generate a new top-entity to be mailed
    my $newent=new MIME::Entity;
    # make a private copy of the main header and set this one
    $newent->head($header->dup);
    # make it a multipart/encrypted
    # and set the needed content-type-fields on this top entity
    $newent->head->mime_attr("MIME-Version"=>"1.0");
    $newent->head->mime_attr("Content-Type"=>"multipart/encrypted");
    $newent->head->mime_attr("Content-Type.Boundary"=>
			     &MIME::Entity::make_boundary);
    $newent->head->mime_attr("Content-Type.Protocol"=>
			     "application/pgp-encrypted");
    # set/suppress the new preamble
    $newent->preamble($config{"preamble"}?
		      ["This is a multi-part message in MIME format.\n",
		       "It has been encrypted conforming to RFC3156.\n",
		       "You need GPG to view the content.\n"]:[]);
    
    # attach the needed dummy-part
    $newent->attach(Type=>"application/pgp-encrypted",
		    Data=>"Version: 1\n",
		    Encoding=>"7bit");

    # generate the encrypted data, repeat until proper passphrase given
    my @@res;
    while (1)
    {
	@@res=&sign_encrypt($signkey,$dumpfile,$output,@@{$rec_keys});
	last if (!@@res || $res[0]!=1);	#  no error or fatal error
	dlogit("gpg reported bad passphrase, retrying.");
	if (!$config{"use-agent"} && $config{"flush-secret"} && $signkey)
	{
	    dlogit("invalidating passphrase for $signkey");
	    my $cmd=sprintf($config{"flush-secret"},$signkey);
	    system($cmd);	# ignore the flushing result; best effort only
	}
    }
    return @@res[1..$#res] if (@@res || $res[0]); # fatal error: give up
    
    # attach the encrypted data
    $newent->attach(Type => "application/octet-stream",
		    Path => $output,
		    Filename => undef,
		    Disposition => "inline",
		    Encoding=>"7bit");

    # and send the resulting thing
    return &send_entity($newent,$from,@@recips);
}

# processes a file in the queue, 
# leaves the file in the queue
# returns nothing if ok or @@error msgs
sub process_file
{
    my ($fh,$file)=@@_;

    my $in_ent;
    eval { $in_ent=$parser->parse(\$fh); };
    return ("parsing $file failed","parser errors: $@@",$parser->last_error)
	if ($@@);

    # extract and clean envelope x-kuvert-from and -to
    my @@erecips=extract_addresses($in_ent->head->get("x-kuvert-to"));
    my @@efrom=extract_addresses($in_ent->head->get("x-kuvert-from"));
    $in_ent->head->delete("x-kuvert-to");
    $in_ent->head->delete("x-kuvert-from");
    
    # extract the from
    my @@froms=extract_addresses($in_ent->head->get("from"));
    return "could not parse From: header!" if (!@@froms);

    # envelope from is: x-kuvert-from if present or from
    my $fromaddr=@@efrom?$efrom[0]->[0]:$froms[0]->[3]; 
   
    my $signkey=$config{defaultkey};
    # do we have a key override
    if ($froms[0]->[4]=~/key=([0-9a-fA-FxX]+)/)
    {
	$signkey=$1;
	dlogit("local signkey override: $signkey");
	$in_ent->head->replace("from",$froms[0]->[3]);
    }

    # add version header
    $in_ent->head->add('X-Mailer',"$progname $version")
	if ($config{identify});

    # extract and delete blanket instruction header
    my $override;
    if (lc($in_ent->head->get("x-kuvert"))=~
	/^\s*(none|fallback|fallback-all|signonly)\s*$/)
    {
	$override=$1;
    }
    $in_ent->head->delete("x-kuvert");

    # resend-request-header present and no more specific recipients given? 
    # then send this as-it-is
    if (!@@erecips && (my $rsto=$in_ent->head->get("resent-to")))
    {
	logit("resending requested, doing so.");
	my @@prstos=Mail::Address->parse($rsto);
	return "could not parse Resent-To: header!"
	    if (!@@prstos);
	my @@rstos=map { $_->address } (@@prstos);

	return send_entity($in_ent,$fromaddr,@@rstos);
    }

    # extract and analyze normal and bcc recipients
    my @@tos=extract_addresses($in_ent->head->get("to"));
    my @@ccs=extract_addresses($in_ent->head->get("cc"));
    my @@recips=(@@tos,@@ccs);

    my @@recip_bcc=extract_addresses($in_ent->head->get("bcc"));
    # and don't leak Bcc...
    $in_ent->head->delete("bcc");
    
    # replace to and cc with cleaned headers: we don't want to
    # leak directives
    my $newto=join(", ",map { $_->[3] } (@@tos));
    my $newcc=join(", ",map { $_->[3] } (@@ccs));
    $in_ent->head->replace("to",$newto);
    $in_ent->head->replace("cc",$newcc) if ($newcc);

    # cry out loud if there is a problem with the submitted mail 
    # and no recipients were distinguishable...
    # happens sometimes, with mbox-style 'From bla' lines in the headers...
    return("No recipients found!","The mail headers seem to be garbled.")
	if (!@@erecips && !@@recips && !@@recip_bcc);

    # remember the addresses' nature
    my (%is_bcc);
    map { $is_bcc{$_->[0]}=1; } (@@recip_bcc);
    
    # now deal with envelope-vs-mailheader recipients:
    # whatever the envelope says, wins.
    if (@@erecips)
    {
	# no need to distinguish these otherwise
	my (%is_normal,%is_envelope);
	map { $is_normal{$_->[0]}=1; } (@@recips);
	map { $is_envelope{$_->[0]}=1; } (@@erecips);

	for my $e (@@erecips)
	{
	    # in the envelope but not the headers -> fake bcc
	    if (!$is_normal{$e->[0]} && !$is_bcc{$e->[0]})
	    {
		push @@recip_bcc,$e;
		$is_bcc{$e->[0]}=1;
	    }
	}
	# in the headers but not the envelope -> ignore it
	my @@reallyr;
	for my $n (@@recips)
	{
	    push @@reallyr,$n if ($is_envelope{$n->[0]});
	}
	@@recips=@@reallyr;
    }

    # figure out what to do for specific recipients
    my %actions=findaction($override,\@@recips,\@@recip_bcc);

    # send out unsigned mails first
    my @@rawrecips=grep($actions{$_} eq "none",keys %actions);
    if (@@rawrecips)
    {
	logit("sending mail (unchanged) to ".join(", ",@@rawrecips));
	my @@res=send_entity($in_ent,$fromaddr,@@rawrecips);
	return @@res if (@@res);
    }
    
    my ($orig_header,$cryptoin);
    # prepare various stuff we need only when encrypting or signing
    if(grep($_ ne "none",values(%actions)))
    {
	# copy (mail)header, split header info
	# in mime-related (remains with the entity) and non-mime
	# (is saved in the new, outermost header-object)
	$orig_header=$in_ent->head->dup;

	# content-* stays with the entity and the rest moves to orig_header
	foreach my $headername ($in_ent->head->tags)
	{
	    if ($headername !~ /^content-/i)
	    {
		# remove the stuff from the entity
		$in_ent->head->delete($headername);
	    }
	    else
	    {
		# remove this stuff from the orig_header
		$orig_header->delete($headername);
	    }
	}

	# any text/plain parts of the entity have to be fixed with the
	# correct content-transfer-encoding (qp), since any transfer 8->7bit
	# on the way otherwise will break the signature.
	# this is not necessary if encrypting, but done anyways since
	# it doesnt hurt and we want to be on the safe side.
	my $res=qp_fix_parts($in_ent);
	return $res if ($res);

	# now we've got a in entity which is ready to be encrypted/signed
	# and the mail-headers are saved in $orig_header
	# next we dump this entity into a file for crypto ops
	my $fh;
	($fh,$cryptoin)=mkstemp($config{tempdir}."/cryptoin.XXXX");
	return("can't create file $cryptoin: $!")
	    if (!$fh);
	$in_ent->print($fh);
 	close($fh);
    } 
    
    # send the mail signed to the appropriate recips
    my @@signto=grep($actions{$_} eq "signonly",keys %actions);
    if (@@signto)
    {
	logit("sending mail (signed with $signkey) to ".join(", ",@@signto));
	my @@res=&sign_send($in_ent,$cryptoin,$orig_header,$fromaddr,$signkey,
			   @@signto);
	return @@res if (@@res);
    }

    # send mail encrypted+signed to appropriate recips.
    # note: bcc's must be handled separately!
    my @@encto=grep($actions{$_}!~/^(none|signonly)$/ && !$is_bcc{$_}, keys %actions);
    if (@@encto)
    {
	logit("sending mail (encrypted+signed with $signkey) to "
	      .join(", ",@@encto));
	my @@enckeys = map { $actions{$_} } (@@encto);
	my @@res=&crypt_send($in_ent,$cryptoin,$orig_header,$fromaddr,$signkey,
			    \@@enckeys,@@encto);
	return @@res if (@@res);
    }
    for my $bcc (grep($actions{$_}!~/^(none|signonly)$/ && $is_bcc{$_}, 
		      keys %actions))
    {
	logit("sending mail (bcc,encrypted+signed with $signkey) to $bcc");
	my @@res=&crypt_send($in_ent,$cryptoin,$orig_header,$fromaddr,$signkey,
			    [$actions{$bcc}],$bcc);
	return @@res if (@@res);
    }
    return;
}


# find the correct action for the given email addresses
# input: override header, normal and bcc-addresses
# returns hash with address as key, value is "none", "signonly" or key id
sub findaction    
{
    my ($override,$normalref,$bccref)=@@_;
    my(%actions,%specialkeys,$groupfallback);

    # address lookup in configured overrides
    foreach my $a (@@{$normalref},@@{$bccref})
    {
	my $addr=$a->[0];
	foreach (@@{$config{overrides}})
	{
	    if ($addr =~ $_->{re})
	    {
		$actions{$addr}=$_->{action};
		# remember config-file key overrides
		$specialkeys{$addr}=$_->{key}
		if ($_->{key});
		last;
	    }
	}
	# nothing configured? then default action
	$actions{$addr}||=($config{defaultaction}||"none");
	dlogit("action $actions{$addr} for $addr");

	# blanket override? then override the config but not where
	# "none" is specified
	if ($override && $actions{$addr} ne "none")
	{
	    dlogit("override header: $override for $addr");
	    $actions{$addr}=$override;
	}

	# next: check individual action=x directives
	if ($a->[4] =~/action=(none|fallback-all|fallback|signonly)/)
	{
	    my $thisaction=$1;
	    $actions{$addr}=$thisaction;
	    dlogit("local override: action $thisaction for $addr");
	}

	if ($a->[4] =~/key=([0-9a-fA-FxX]+)/)
	{
	    $specialkeys{$addr}=$1;
	    dlogit("local key override: $specialkeys{$addr} for $addr");
	}

	# now test for key existence and downgrade action to signonly
	# where necessary. 
	if ($actions{$addr}=~/^fallback/)
	{
	    # group fallback is relevant for normal recipients only
	    $groupfallback||=($actions{$addr} eq "fallback-all")
		if (!grep($_->[0] eq $addr,@@{$bccref}));
	    $actions{$addr}=$specialkeys{$addr}||$email2key{$addr}||"signonly";
	}
    }
    
    # were there any fallback-all? if so and also none or signonly present,
    # then all recips are downgraded.
    my @@allactions=values %actions;
    if ($groupfallback && grep(/^(none|signonly)$/,@@allactions))
    {
	# time to downgrade everybody to signing...
	for my $a (@@{$normalref})
	{
	    my $addr=$a->[0];
	    if ($actions{$addr} ne "none")
	    {
		$actions{$addr}="signonly";
		dlogit("downgrading to signonly for $addr");
	    }
	}
    }
    return %actions;
}

# parses an address-line, extracts all addresses from it
# and splits them into address, phrase, comment, full and directive
# returns array of arrays
sub extract_addresses
{
    my (@@lines)=@@_;
    my @@details;

    for my $a (Mail::Address->parse(@@lines))
    {
	my ($addr,$comment,$phrase)=(lc($a->address),$a->comment,$a->phrase);
	# some name "directive,directive..." <an@@addre.ss> 
	if ($phrase=~s/\s*\"([^\"]+)\"\s*//)
	{
	    my $directive=$1;
	    # clean the phrase up
	    my $newa=Mail::Address->new($phrase,$addr,$comment);
	    push @@details,[$addr,$phrase,$comment,$newa->format,$directive];
	}
	else
	{
	    push @@details,[$addr,$phrase,$comment,$a->format,undef];
	}
    }
    return @@details;
}

# traverses a mime entity and changes all parts with
# type == text/plain, charset != us-ascii, transfer-encoding 8bit
# to transfer-encoding qp.
# input: entity, retval: undef if ok, error message otherwise
sub qp_fix_parts
{
    my ($entity)=@@_;
    if ($entity->is_multipart)
    {
	foreach ($entity->parts)
	{
	    my $res=&qp_fix_parts($_);
	    return $res if ($res);
	}
    }
    else
    {
	if ($entity->head->mime_type eq "text/plain"
	    && $entity->head->mime_encoding eq "8bit"
	    && lc($entity->head->mime_attr("content-type.charset"))
	    ne "us-ascii")
	{
	    return("changing Content-Transfer-Encoding failed")
		if ($entity->head->mime_attr("content-transfer-encoding"
					     => "quoted-printable")
		    !="quoted-printable");
	}
    }
    return;
}


# log termination, cleanup, exit
sub handle_term
{
    my ($sig)=@@_;

    $sig="SIG$sig" if (!$options{o}); 
    logit("Termination requested ($sig), cleaning up");
    &cleanup($config{tempdir},1);
    close $config{logfh} if ($config{logfh});
    exit 0;
}

# reread configuration file and keyrings
# no args or return value; intended as a sighandler.
sub handle_reload
{
    my ($sig)=@@_;
    logit("received SIG$sig, reloading");
    %config=&read_config;
    %email2key=&read_keyring;
    # restart mailserver if required
    # also update pidfile
    if ($config{"ma-user"} && $config{"ma-pass"} && $config{"maport"})
    {
	# fork off the smtp-to-queue daemon
	my $pid=&start_mailserver;
	open(PIDF,">$pidf") || &bailout("can't w-open $pidf: $!\n");
	print PIDF "$$\n$pid\n";
	close(PIDF);
    }
}

# remove temporary stuff left behind in directory $what
# remove_what set: remove the dir, too.
# exception on error, no retval
sub cleanup
{
    my ($what,$remove_what)=@@_;
    my ($name,$res);

    opendir(F,$what) || bailout("cant opendir $what: $!");
    foreach $name (readdir(F))
    {
	next if ($name =~ /^\.{1,2}$/o); 
	(-d "$what/$name")?&cleanup("$what/$name",1):
	    (unlink("$what/$name") || bailout("cant unlink $what/$name: $!"));
    }
    closedir(F);
    $remove_what && (rmdir("$what") || bailout("cant rmdir $what: $!"));
    return;
}


# (re)reads the configuration file
# calls bailout on problems
# needs user-specific vars to be setup
# returns %options on success, bailout on error
sub read_config
{
    my %options=
	(
	 defaultkey=>undef,
	 identify=>undef,
	 defaultaction=>"none",
	 msserver=>undef,
	 msuser=>undef,
	 mspass=>undef,
	 ssl=>undef,
	 "ssl-cert"=>undef,
	 "ssl-key"=>undef,
	 "ssl-ca"=>undef,
	 'mspass-from-query-secret'=>undef,
	 msport=>587,
	 msp=>"/usr/sbin/sendmail -om -oi -oem",
	 "use-agent"=>undef,
	 syslog=>undef,
	 logfile=>undef,
	 queuedir=>"$home/.kuvert_queue",
	 tempdir=>($ENV{'TMPDIR'}?$ENV{'TMPDIR'}:"/tmp")."/kuvert.$username.$$",
	 alwaystrust=>undef,
	 interval=>60,
	 "query-secret"=>"/bin/sh -c 'stty -echo; read -p \"Passphrase %s: \" X; stty echo; echo \$X'",
	 "flush-secret"=>undef,
	 "mail-on-error"=>undef,
	 "can-detach"=>0,
	 maport=>2587,
	 "ma-user"=>undef,
	 "ma-pass"=>undef,
	 preamble=>1,
	 );
    my @@over;

    &bailout("cant open $rcfile: $!")
	if (!open (F,$rcfile));
    logit("reading config file");
    my @@stuff=<F>;
    close F;
    for (@@stuff)
    {
	chomp;
	next if (/^\s*\#/ || /^\s*$/); # strip comments and empty lines

	# trigger on old config-file style
	if (/^([[:upper:]]+)\s+(\S.*)\s*$/)
	{
	    my $nf=rewrite_conf(@@stuff);
	    die("Can't work with old config, terminating!
$progname has found an old config file and attempted a ROUGH auto-conversion.

The result has been left in $nf and likely needs to be adjusted 
for ${progname}'s new features. Please do so and restart $progname 
with the new config file in place.\n");
	}

	if (/^\s+(\S+)\s+(fallback(-all)?(,(0x)?[a-fA-F0-9]+)?|signonly|none)\s*(\#.*)?$/)
	{
	    my ($who,$action)=($1,$2);
	    my $key;
	    if ($action=~s/^(fallback(-all)?),((0x)?[a-fA-F0-9]+)/$1/)
	    {
		$key=$3;
	    }
	    push @@over,{"who"=>$who,
			"re"=>qr/$who/,
			"action"=>$action,
			"key"=>$key};
	    dlogit("got override $action "
		   .($key?"key $key ":"")."for $who");
	    next;
	}

	if (/^\S/)
	{
	    my ($key,$value)=split(/\s+/,$_,2);
	    $key=lc($key);
	    $value=~s/^(\"|\')(.*)\1$/$2/;

	    bailout("unknown config key \"$key\"")
		if (!exists $options{$key});

	    # booleans
	    if ($key =~ /^(identify|use-agent|alwaystrust|can-detach|mspass-from-query-secret|preamble)$/)
	    {
		bailout("bad value \"$value\" for key \"$key\"")
		    if ($value !~ /^(0|1|t|f|on|off)$/i);
		$options{$key}=($value=~/^(1|on|t)$/);
	    }
	    # numbers
	    elsif ($key =~ /^(msport|interval|maport)$/)
	    {
		bailout("bad value \"$value\" for key \"$key\"")
		      if ($value!~/^\d+$/);
		$options{$key}=$value;
	    }
	    # nothing or string
	    elsif ($key =~ /^(ma-pass|ma-user|mail-on-error|msserver|ssl(-cert|-key|-ca)?|msuser|mspass)$/)
	    {
		$options{$key}=$value;
	    }
	    # nothing or program and args
	    elsif ($key eq "msp")
	    {
		bailout("bad value \"$value\" for key \"$key\"")
		     if ($value && !-x (split(/\s+/,$value))[0]);
		$options{$key}=$value;
	    }
	    # program with %s escape
	    elsif ($key =~ /^(query-secret|flush-secret)$/)
	    {
		my ($cmd,$args)=split(/\s+/,$value,2);
		bailout("bad value \"$value\" for key \"$key\"")
		     if (!-x $cmd || $args!~/%s/);
		$options{$key}=$value;
	    }
	    # dirs to create
	    elsif ($key=~/^(queuedir|tempdir)$/)
	    {
		$options{$key}=$value;
	    }
	    # the rest are special cases
	    elsif ($key eq "defaultkey")
	    {
		bailout("bad value \"$value\" for key \"$key\"")
		    if ($value !~ /^(0x)?[a-f0-9]+$/i);
		$options{$key}=$value;

	    }
	    elsif ($key eq "defaultaction")
	    {
		bailout("bad value \"$value\" for key \"$key\"")
		    if ($value!~/^(fallback|fallback-all|signonly|none)$/);
		$options{$key}=$value;
	    }
	    elsif ($key eq "syslog")
	    {
		# syslog: nothing or a facility
		bailout("bad value \"$value\" for key \"$key\"")
		    if ($value && 
			$value!~/^(authpriv|cron|daemon|ftp|kern|local[0-7]|lpr|mail|news|syslog|user|uucp)$/);
		$options{$key}=$value;
	    }
	    elsif ($key eq "logfile")
	    {
		bailout("bad value \"$value\" for key \"$key\"")
		    if (-e $value && !-w $value);
		if ($config{$key} ne $value) # deal with changing logfiles
		{
		    close($config{logfh}) if (defined $config{logfh});
		    delete $config{logfh};
		}
		$options{$key}=$value;
	    }
	    dlogit("got config $key=$value");
	}
    }
    close F;

    # post-config-reading sanity checking
    if ($options{msserver} && $options{msuser})
    {
	bailout("smtp auth requires mspass or mspass-from-query-secret options")
	    if (!$options{mspass} && !$options{"mspass-from-query-secret"});
    }	

    # post-config-reading directory fixes
    for my $v ($options{queuedir},$options{tempdir})
    {
	if (!-d $v)
	{
	    mkdir($v,0700) or bailout("cannot create directory $v: $!\n");
	}
	my @@stat=stat($v);
	if ($stat[4] != $< or ($stat[2]&0777) != 0700)
	{
	    bailout("directory $v does not belong to you or has bad mode.");
	}
    }

    $options{overrides}=\@@over;
    return %options;
}

sub rewrite_conf
{
    my @@old=@@_;
    
    my ($fh,$fn)=mkstemp(($ENV{'TMPDIR'}?$ENV{'TMPDIR'}:"/tmp")."/config.XXXX");
    my %xlat=qw(NGKEY defaultkey 
		GETSECRET query-secret
		DELSECRET flush-secret
		MTA msp
		ALWAYSTRUST alwaystrust
		INTERVAL interval
		TEMPDIR tempdir
		QUEUEDIR queuedir
		LOGFILE logfile
		IDENTIFY identify);
	      
    for (@@old)
    {
	chomp;
	next if (/^\#/ || /^\s*$/); # strip comments and empty lines
	
	if (/^(\S+)\s+((none|std(sign)?|ng(sign)?|fallback)(-force)?)\s*$/)
	{
	    my ($k,$v)=($1,$2);
	    $v=~s/(std|ng)sign/signonly/;
	    $v=~s/(std|ng)/fallback/;
	    $v=~s/fallback-force/fallback-all/;
	    
	    print $fh ($k eq "DEFAULT"?"defaultaction":" $k")." $v\n\n";
	}
	elsif (/^([[:upper:]]+)\s+(\S.*)\s*$/)
	{
	    my ($k,$v)=($1,$2);
	    if ($xlat{$k})
	    {
		$k=$xlat{$k};
		print $fh "$k $v\n\n";
	    }
	}
    }
    close $fh;
    return $fn;
}

# read keyring 
# needs global %config,$debug
# returns id-to-key hash, bailout on error
sub read_keyring
{
    my %badcauses=('i'=>'invalid, no selfsig','d'=>'disabled',
		   'r'=>'revoked','e'=>'expired');
    my %id2key;

    logit("reading keyring...");
    my $tf="$config{tempdir}/subproc";
    
    my @@tmp=`gpg -q --batch --list-keys --with-colons --no-expensive-trust-checks 2>$tf`;
    bailout("keyring reading failed: $?",(-r $tf && readfile($tf))) 
	if ($?);
    logit("finished reading keyring");
    
    my ($lastkey,$lasttype);
    foreach (@@tmp)
    {
	my @@info=split(/:/);
	# only public keys and uids are of interest
	next if ($info[0] ne "pub" && $info[0] ne "uid");
	$info[4] =~ s/^.{8}//;	# truncate key-id
	    
	$info[9] =~ s/\\x3a/:/g; # re-insert colons, please
	    
	# remember the email address
	# if no address given: remember this key 
	# but go on to the uid's to get an email address to
	# work with
	my $name;
	if ($info[9] =~ /(\s|<)([^\s<]+\@@[^\s>]+)>?/)
	{
	    $name=lc($2);
	}
	# check the key: public part or uid?
	if ($info[0] eq "pub")
	{
	    # lets associate this key with the current email address
	    # if an address is known
	    $lastkey=$info[4];
		
	    if ($name)
	    {
		# ignore expired, revoked and other bad keys
		if (defined $badcauses{$info[1]})
		{
		    &logit("ignoring key 0x$info[4], reason: "
			   .$badcauses{$info[1]});
		    next;
		}
		
		$id2key{$name}="0x$lastkey";
		dlogit("got key 0x$lastkey type $info[3] for $name");
	    }
	    else
	    {
		dlogit("saved key 0x$lastkey, no address known yet");
	    }
	    next;
	}
	else
	{
	    # uid: associate the current address with the key 
	    # given in the most recent public key line
	    if ($name)
	    {
		# ignore expired, revoked and other bad keys
		if (defined $badcauses{$info[1]})
		{
		    &logit("ignoring uid $name for 0x$lastkey, "
			   ."reason: ".$badcauses{$info[1]});
		    next;
		}
		
		$id2key{$name}="0x$lastkey";
		dlogit("got key (uid) 0x$lastkey for $name");
	    }
	    else
	    {
		dlogit("ignoring uid without valid address");
	    }
	}
    }
    return %id2key;
}

# send this mime entity out 
# if msserver+port known: use smtp, envelope from is $from
# otherwise use local msp program with @@recips
# uses global %config
# returns nothing if ok, @@error messages otherwise
sub send_entity
{
    my ($ent,$from,@@recips,)=@@_;

    if ($config{msserver} && $config{msport})
    {
	my $dom=hostname;

	my $s=Net::SMTPS->new( $config{msserver}, Port => $config{msport},
			       Hello => $dom,
			       doSSL => $config{ssl},
			       SSL_key_file => $config{"ssl-key"},
			       SSL_cert_file => $config{"ssl-cert"},
			       SSL_ca_file => $config{"ssl-ca"} );
	return("cannot connect to mail server ".$config{msserver}.": $!")
	    if (!$s);

	# do smtp auth if asked to
	if ($config{msuser})
	{
	    my $authed;
	    while (!$authed)
	    {
		if (!$config{mspass} && $config{"mspass-from-query-secret"})
		{
		    my $cmd=sprintf($config{"query-secret"},"smtp-password");
		    $config{mspass}=`$cmd`;

		    return("couldn't get smtp password via query-secret: $!") 
			if (!$config{mspass});
		    chomp($config{mspass});
		}

		$authed=$s->auth($config{msuser},$config{mspass});
		
		# bailout if we can't requery
		if (!$authed)
		{
		    # get rid of the apparently dud password and try again
		    delete $config{mspass};
		    if ($config{"mspass-from-query-secret"})
		    {
			my $cmd=sprintf($config{"flush-secret"},"smtp-password");
			system($cmd);	# ignore the flushing result; best effort only
		    }
		    else
		    {
			return("smtp auth failed: ".$s->code." ".$s->message);
		    }
		}
	    }
	}

	$s->mail($from) 
	    or return("mailserver rejected our from address \"$from\": ".$s->code." ".$s->message);
	my @@okrecips=$s->to(@@recips, { SkipBad => 1 });
	if (@@okrecips != @@recips)
	{
	    my %seen;
	    map { $seen{$_}=1; } (@@recips);
	    map { ++$seen{$_}; } (@@okrecips);
	    my @@missed=grep $seen{$_}==1, keys %seen;
	    
	    return ("mailserver rejected some recipients!",
		    "rejected: ".join(", ",@@missed),
		    "info: ".$s->code." ".$s->message);
	}
	$s->data($ent->as_string) or return("mailserver rejected our data: ".$s->code." ".$s->message);
	$s->quit;
    }
    else
    {
	# pipeline to msp, but we do it ourselves: safe cmd handling
	my $pid=open(TOMTA,"|-");
	return("cant open pipe to msp: $!") if (!defined $pid);
	if ($pid)
	{
	    $ent->print(\*TOMTA);
	    close(TOMTA) || return("error talking to msp: $?");
	}
	else
	{
	    my @@cmd=split(/\s+/,$config{msp});
	    push @@cmd,'-f',$from;
	    push @@cmd,@@recips;
	    exec(@@cmd) || return("error executing msp: $!");
	}
    }
    return;
}

# sign/encrypt a file
# input: sign key, infile and outfile path, recipient keys 
# if encryption wanted.
# input must be existing filename, outfile must not exist.
# signkey overrides config-defaultkey, and is optional.
# uses global %config
# returns: undef if ok, 1 if bad passphrase, (2,errorinfo) otherwise
sub sign_encrypt
{
    my ($signkey,$infile,$outfile,@@recips)=@@_;
    my @@cmd=qw(gpg -q -t -a --batch --status-fd 2);
    my ($precmd,$pid);

    push @@cmd,"--always-trust" if ($config{alwaystrust});

    $signkey=$config{defaultkey} if ($config{defaultkey} && !$signkey);
    push @@cmd,"--default-key",$signkey if ($signkey);

    # should we leave the passphrase handling to gpg/gpg-agent?
    # otherwise, we run a query program in a pipeline
    # after determining what passphrase gpg is looking for
    if ($config{"use-agent"})
    {
	push @@cmd,"--use-agent";
    } 
    
    if (@@recips)
    {
	push @@cmd, qw(--encrypt --sign), map { ("-r",$_) } (@@recips);
    }
    else
    {
	push @@cmd,"--detach-sign";
    }

    if (!$config{"use-agent"})
    {
	# now determine which passphrase to query for:
	# run gpg once without data, and analyze the status text
	$pid=open(F,"-|");
	if (!defined $pid)
	{
	    return (2,"Error: could not run gpg: $!");
	}
	elsif (!$pid)
	{
	    # child: dup stderr to stdout and exec gpg
	    open STDERR, ">&",\*STDOUT 
		or bailout("can't dup2 stderr onto stdout: $!\n");
	    exec(@@cmd);
	    bailout("exec gpg failed: $!\n");
	}
	# read the status stuff in and determine the passphrase required
	for my $l (<F>)
	{
	    if ($l=~/^\[GNUPG:\] NEED_PASSPHRASE ([a-fA-F0-9]+) ([a-fA-F0-9]+) \d+ \d+$/)   
	    {
		$precmd=sprintf($config{"query-secret"},"0x".substr($2,8));
		push @@cmd,"--passphrase-fd",0;
		last;
	    }
	}
	close(F);
    }
    push @@cmd,"-o",$outfile,$infile;

    # now run gpg, read back stdout/stderr
    $pid=open(F,"-|");
    if (!defined $pid)
    {
	return (2, "Error: could not run gpg: $!");
    }
    elsif (!$pid)
    {
	# with agent: simply run gpg
	if ($config{"use-agent"})
	{
	    # collapse stderr and stdout
	    open STDERR, ">&",\*STDOUT 
		or bailout("can't dup2 stderr onto stdout: $!\n");
	    exec(@@cmd);
	    bailout("exec gpg failed: $!\n");
	}
	else
	{
	    # without agent: run the query program 
	    # in yet another pipeline to gpg

	    # read from child: query prog in child
	    # whereas we run gpg
	    my $pidc=open(G,"-|"); 
	    if (!defined($pidc))
	    {
		bailout("Error: couldn't fork: $!\n");
	    }
	    elsif (!$pidc)
	    {
		# child: run query prog with stderr separated
		exec($precmd);
		die("exec $precmd failed: $!\n");
	    }
	    # parent: we run gpg
	    # dup stderr to stdout and exec gpg
	    open STDERR, ">&",\*STDOUT 
		or bailout("can't dup2 stderr onto stdout: $!\n");
	    open STDIN, ">&", \*G 
		or bailout("can't dup stdin onto child-pipe: $!\n");
	    exec(@@cmd);
	    bailout("exec gpg failed: $!\n");
	}
    }
    # outermost parent: read gpg status info
    my @@output;
    eval { 
	local $SIG{ALRM}=sub { die "alarm\n"; };
	alarm $timeout;
	@@output=<F>;
	alarm 0;
        close(F);
    };
    if ($@@)
    {
	logit("gpg timeout!");
	kill("TERM",$pid);
	return 1;
    }
    elsif ($?)
    {
	#  no complaints if gpg just dislikes the passphrase
	return 1
	    if (grep(/(MISSING|BAD)_PASSPHRASE/,@@output));
	return (2,"Error: gpg terminated with $?",
	      "Detailed error messages:",@@output);
    }
    return;
}

# logs the argument strings to syslog and/or the logfile
# uses global %config
# returns nothing
sub logit
{
    my (@@msgs)=@@_;

    if ($config{logfile}) 	# our own logfile?
    {
	if (!$config{logfh})	# not open yet?
	{
	    $config{logfh}=FileHandle->new(">>$config{logfile}");
	    die "can't open logfile $config{logfile}: $!\n" 
		if (!$config{logfh});
	    $config{logfh}->autoflush(1);
	}

	print { $config{logfh} } scalar(localtime)." ".join("\n\t",@@msgs)."\n";
    }

    if ($config{syslog})
    {
	setlogsock('unix');
	openlog($progname,"pid,cons",$config{syslog});
	syslog("notice",join("\n",@@msgs));
	closelog;
    }
}

# debug log to stderr
sub dlogit
{
    print STDERR join("\n",@@_)."\n" if ($debug);
}


# alerts the user of some problem
# this is done via the normal logging channels,
# plus: stderr if can-detach is not set
# plus: email if mail-on-error is set to some email addy
# for email the program name plus first message line are used as subject
# sender and recipient are set to mail-on-error config entry
sub alert
{
    my (@@msgs)=@@_;
    
    logit(@@msgs);
    if (!$config{"can-detach"})
    {
	print STDERR join("\n\t",@@msgs)."\n";
    }
    if ($config{"mail-on-error"})
    {
	my $heading=shift @@msgs;
	my $out=join("\n",@@msgs);
	my $ent=MIME::Entity->build(From=>$config{"mail-on-error"},
				  To=>$config{"mail-on-error"},
				  Subject=>($progname.": $heading"),
				  Data=>\$out);
	send_entity($ent,$config{"mail-on-error"},$config{"mail-on-error"});
    }
}

# alert of a problem and die
sub bailout
{
    my (@@msgs)=@@_;
    $msgs[0]="Fatal: ".$msgs[0];
    alert(@@msgs);
    
    # don't bother writing to stderr if alert already took care of that
    exit(1)
	if (!$config{"can-detach"});	
    die(scalar(localtime).join("\n\t",@@msgs)."\n");
}

# returns pid of new mailserver process
# dies if unsuccessful
sub start_mailserver
{
    # fork off the smtp-to-queue daemon
    my $pid=fork;
    if (!defined($pid))
    {
	bailout("cannot fork: $!\n");
    }
    elsif (!$pid)
    {	
	# run mailserver, which does never reload the config
	$0=$listenername;
	close STDIN;
	close PIDF;		# clears the inherited lock
	map { $SIG{$_}='DEFAULT'; } qw(USR1 HUP INT QUIT TERM);
	&accept_mail;
    }
    # parent
    return $pid;
}

# run a receive-only mailserver on localhost and spool to queue
# does not terminate except signalled
sub accept_mail
{
    my $server = IO::Socket::INET->new(Listen=>1,
				       ReuseAddr=>1,
				       LocalAddr=>"127.0.0.1",
				       LocalPort=>$config{"maport"},);
    bailout("setting up listening port failed: $!") if (!$server);
    
    while(my $conn = $server->accept)
    {
	my $esmtp = Net::Server::Mail::ESMTP->new(socket=>$conn);
	$esmtp->register('Net::Server::Mail::ESMTP::plainAUTH');

	$esmtp->set_callback(MAIL=>\&req_auth);
	$esmtp->set_callback(RCPT=>\&req_auth);
	$esmtp->set_callback(AUTH=>\&check_auth);
	$esmtp->set_callback("DATA-INIT"=>\&start_mail);
	$esmtp->set_callback("DATA-PART"=>\&cont_mail);
	$esmtp->set_callback(DATA => \&finish_mail);
	$esmtp->process();
	$conn->close();
    }
}

sub check_auth
{
    my ($session,$user,$pwd)=@@_;
    return ($user eq $config{'ma-user'} and $pwd eq $config{'ma-pass'});
}

sub req_auth
{
    my ($session,$input)=@@_;
    if (!$session->{AUTH}->{completed})
    {
	return(0,530,"5.7.0 Authentication Required");
    }
    return(0,550,"Invalid Address.")
	if (!extract_addresses($input));
    return 1;
}

sub start_mail
{
    my($session,$data) = @@_;

    my @@recipients = $session->get_recipients();   
    my $sender = $session->get_sender();
    return(0,554,'No recipients given.') if (!@@recipients);
    return(0,554,'No sender given.') if (!$sender);

    my $qid=join("",Time::HiRes::gettimeofday);
    my $fn=$config{queuedir}."/".$qid;
    if (!open(F,">$fn"))
    {
	alert("can't open new queuefile $fn: $!");
	return(0,450,"can't create queuefile. please try again later.");
    }
    if (!flock(F,LOCK_NB|LOCK_EX))
    {
	alert("can't lock queuefile $qid: $!");
	return(0,450,"can't lock queuefile. please try again later.");
    }
    print F "X-Kuvert-From: $sender\nX-Kuvert-To: "
	.join(", ",@@recipients)."\n";
    logit("queueing email from $sender to ".join(", ",@@recipients));
    
    $session->{DATA}->{qfh}=\*F;
    $session->{DATA}->{qid}=$qid;
    return 1;
}

sub cont_mail
{
    my ($session,$dr)=@@_;
    print {$session->{DATA}->{qfh}} $$dr;
    undef $$dr;
    return 1;
}

sub finish_mail
{
    my ($session,$dr)=@@_;
    print {$session->{DATA}->{qfh}} $$dr;
    undef $$dr;

    my $qid=$session->{DATA}->{qid};
    if (!close($session->{DATA}->{qfh}))
    {
	alert("could not close queuefile $qid: $!");
	return(0,450,"could not close queuefile");
    }
    logit("finished enqueueing mail $qid");
    return(1,250,"Mail enqueued as $qid");
}



__END__
    
=pod

=head1 NAME

kuvert - Automatically sign and/or encrypt emails based on the recipients

=head1 SYNOPSIS 

kuvert [-d] [-o] [-r|-k]

=head1 DESCRIPTION

Kuvert is a tool to protect the integrity and secrecy of your outgoing email
independent of your mail client and with minimal user interaction.

It reads mails from its queue (or accepts SMTP submissions), 
analyzes the recipients and decides to whom it should encrypt and/or 
sign the mail. The resulting mail is coerced into the PGP-MIME framework 
defined in RFC3156 and finally sent to your outbound mail server. 
Kuvert uses GnuPG for all cryptographic tasks and is designed to interface
cleanly with external secret caching tools.

=head1 OPTIONS

After startup kuvert periodically scans its queue directory and processes
mails from there; depending on your GnuPG passphrase setup kuvert 
may daemonize itself. In either case, kuvert runs forever until 
actively terminated.

Kuvert's behaviour is configured primarily using a configuration file, 
with exception of the following commandline options:

=over

=item -d

Enables debugging mode: extra debugging information is written to STDERR.
(This is independent of normal logging.)

=item -o 

Enables one-shot mode: kuvert does not loop forever but processes
only the current queue contents and then exits. Kuvert does also not
start an SMTP listener in this mode.

=item -r

Tells a running kuvert daemon to reload the configuration file
and the gpg keyring. This is equivalent to sending a SIGUSR1 to the
respective process.

=item -k

Tells a running kuvert daemon to terminate cleanly. This is equivalent
to sending a SIGTERM to the respective process.

=back

=head1 OPERATION

At startup kuvert reads its configuration file and your gnugp keyring and 
remembers the association of email addresses to keys. 

Kuvert then works as a wrapper around your mail transfer agent (MTA): 
you author your emails like always but instead of sending them out 
directly you submit them to kuvert.

Periodically kuvert scans its queue and processes any email therein.
If your keyring contains a key for a recipient, kuvert will
encrypt and sign the email to that recipient. If no key is available, kuvert
will only (clear/detached-)sign the email. Subsequently, the email 
is sent onwards using your MTA program or SMTP. 

Emails to be processed can 
have any valid MIME structure; kuvert unpacks the 
MIME structure losslessly and repacks the (encrypted/signed) mail 
into a PGP/MIME object as described in RFC3156. The mail's structure is 
preserved. Signature and encryption cover all of the mail content with 
the exception of the top-level headers: for example the "Subject" header 
will be passed in clear, whereas any body or attached MIME object will be 
signed/encrypted.

The encrypt-or-sign decision can be overridden on a per-address basis 
using the configuration file or, even more fine-grainedly, by using directives 
in the actual email. Kuvert can also be told not to modify an email 
at all.

=head2 Submitting Emails to Kuvert

Kuvert primarily relies on mails being dumped into its queue directory.
Kuvert operates on files with numeric file names only. Anything that you
store in its queue directory with such a filename will be treated as containing
a single RFC2822-formatted email.

However, no mainstream MUA supports such a drop-your-files-somewhere scheme, 
and therefore kuvert comes with a helper program
called kuvert_submit (see L<kuvert_submit(1)>)  which mimics 
sendmail's mail submission 
behaviour but feeds to the kuvert queue. If your MUA can be instructed 
to run a program for mail submission, kuvert_submit can be used.

Alternatively, you can send your email to kuvert via SMTP. Kuvert comes with
a built-in receive-only mail server, which feeds to the queue directory.
As allowing others to submit emails for your signature would be 
silly and dangerous, kuvert's mail server only listens on the localhost IP 
address and requires that your MUA uses SMTP Authentication to ensure
that only your submissions are accepted. If your MUA supports SMTP AUTH 
PLAIN or LOGIN and can be told to use localhost and a specific port 
for outbound email, then you can use this mechanism.

=head2 Transporting Emails Onwards

Kuvert can send outbound emails either by running a local MTA program 
or by speaking SMTP to some (fixed) outbound mail server of your choice.

=head2 Recipients, Identities and the SMTP Envelope

In general kuvert identifies recipients using the To, Cc, Bcc and 
Resent-To headers of the queued email. If the mechanism you used
to submit the mail to kuvert did explicitely set recipients, then 
these B<override> the headers within the email. 

This is the case if kuvert_submit is called with a list of recipients
and no -t option and for SMTP submission.

If kuvert enqueues email via inbound SMTP, the SMTP envelope 
B<overrides> the email headers: recipients that are present in the 
envelope but not the headers are treated as Bcc'd, and recipients listed
in the headers but not the envelope are B<ignored>. Any Resent-To header
is ignored for SMTP-submitted email.

Only if no overriding recipients are given, kuvert checks the mail
for a Resent-To header. If present, the email is sent out immediately
to the Resent-To addresses I<without further processing>. (This is the 
standard "bounce" behaviour for MUAs that don't pass 
recipients on to an MSP/MTA directly.)

When sending outbound email, kuvert usually uses the From header from
the queued email as identity. If the email was queued via SMTP, 
the envelope again B<overrides> the mail headers. 

Note that kuvert sets the envelope sender using "-f" if sending email 
via a local MTA program; if you are not sufficiently trusted by your MTA
to do such, your mail may get an X-Authentication-Warning header tacked on
that indicates your username and the fact that the envelope was 
set explicitely.

=head2 Passphrase Handling

Kuvert does not handle your precious keys' passphrases. You can either 
elect to use gpg-agent as an (on-demand or caching) passphrase store, or
you can tell kuvert what program it should run to query for a passphrase
when required. Such a query program will be run in a pipeline to GnuPG, and 
kuvert will not access, store or cache the passphrases themselves: 
there are better programs available for secret caching, eg. quintuple-agent 
or the Linux in-kernel keystorage (L<keyctl(1)>). Kuvert interfaces 
cleanly with these.

=head2 How Kuvert Decides What (Not) To Do

For each recipient, kuvert can be told to apply one of 
four different actions:

=over

=item none

The email is sent as-is (except for configuration directive removal).

=item signonly

The email is (clear/detached-) signed.

=item fallback

The email is encrypted and signed if there is a key available for this
recipient or only signed. 

=item fallback-all

The email is encrypted and signed if keys are available for B<all> 
recipients, or only signed otherwise. Recipients whose action is 
set to "none" and Bcc'd recipients are not affected by this action.

The fallback-all action is an "all-or-nothing" action as far as encryption
is concerned and ensures that no mix of encrypted or unencrypted versions 
of this email are sent out: if we can we use encryption for everybody, or 
otherwise everybody gets it signed (or even unsigned). 
(Bcc'd recipients are the exception.)

=back 

=head2 Specifying Actions

Kuvert uses four sources for action specifications:
directives in the individual email addresses,
action directives in the configuration file, an X-Kuvert header in your email,
and finally the default action given in the configuration file.

=over 

=item 1.

First kuvert looks for action directives in your configuration file. 
Such directives are given as action plus regular expression
to be matched against an address, and the first matching directive is used.

=item 2.

If no matching directive is found, the default action given in
the configuration file is applied.

=item 3.

Kuvert now checks for the presence of an X-Kuvert header: its content
must be an action keyword, which is applied to all recipients of this email
except the ones whose action at this stage is "none".
(In other words: if you specify "no encryption/signing" for 
some addresses, then this cannot be overridden in a blanket fashion.)

=item 4.

Kuvert then analyzes each recipient email address. If an address 
has the format 
 Some Text "action=someaction" <user@@some.host>",
kuvert strips the quoted part and overrides the addressee's
action with someaction.

=item 5.

Finally kuvert checks if any recipient has action "fallback-all". If so,
kuvert 

=over 

=item a)

checks if any recipients (except Bcc'd) have action "signonly" or 
"none". If this is the case, all "fallback" and "fallback-all" actions are downgraded to 
"signonly".

=item b)

checks if keys for all recipients (except Bcc'd) are available. If not,
all "fallback" and "fallback-all" actions are downgraded to "signonly".

=back

=item 6.

Recipients which are given in a Bcc: header are always treated independently 
and separately from all others: 
any "fallback-all" action is downgraded to "fallback" for Bcc'd addresses,
and if encryption is used, the email is encrypted separately so that no record
of the Bcc'd recipient is visible in the email as sent out to the "normal" 
recipients. Also, any Bcc: header is removed before sending an email onwards.

=back 

=head2 Key Selection

Kuvert depends on the order of keys in your keyring to determine which
key (of potentially many) with a given address should be used for encryption.
By default kuvert uses the B<last> key that it encounters for a given address.
For people who have multiple keys for a single address this can cause 
problems, and therefore kuvert has override mechanisms for encryption 
key selection: You can specify a key to encrypt to for an address 
in the configuration file (see below), or you can override the key selection
for and within a single mail:

If the recipient address is given in the format

 Some Name "key=keyid" <user@@some.host>

Kuvert will strip the double-quoted part and use this particular
key for this recipient and for this single email. The keyid must be given as 
the hex key identifier. This mechanism overrides
whatever associations your keyring contains and should be used with caution.
Note that both key and action overrides can be given concurrently as a single 
comma-separated entry like this: 

 Some Name "action=fallback,key=0x12345" <user@@some.host>

The signing key can be overridden in a similar fashion: if the From
address contains a "key=B<keyid>" stanza, kuvert will use this key for
signing this single email.

=head1 CONFIGURATION

The kuvert configuration file is plain text,
blank lines and lines that start with "#" are ignored.

The configuration has of two categories: options and address/action 
specifications. 

=head2 Address and Action

Address+action specifications are given one per line. 
Such lines must start with some whitespace, followed
by an address regexp, followed by some whitespace and the action keyword. 
For actions "fallback" and "fallback-all" kuvert also allows 
you to specify a single key identifier like this: "fallback,0x42BD645D".
The remainder of the line is ignored.

The address regexp is a full Perl regular expression and will be  
applied to the raw SMTP address (i.e. not to the comment or name 
in the email address), case-insensitively. The regular expression 
may need to be anchored with ^ and $; kuvert does not do that for you.
You must give just the core of the regexp (no m// or //), like in this 
example:

 # don't confuse mailing list robots
 ^.*-request@@.*$	none

The action keyword must be one of "none", "signonly", "fallback"
or "fallback-all"; see section L</"How Kuvert Decides What (Not) To Do"> 
for semantics. Order of action specifications
in the config file is significant: the search terminates on first match.

=head2 Options 

Options are given one per line, and option lines must start with 
the option name followed by some whitespace. All options are case-sensitive.
Depending on the option content, some or all of the remainder of 
the option line will be assigned as option value. Inline comments are 
not supported.

In the following list of options angle brackets denote required 
arguments like this: 

 defaultkey <hexkeyid>

Options that have boolean arguments recognize "1", "on" and "t" as true
and "0", "off", "f" as false (plus their upper-case versions). 
Other options have more restricted argument types; kuvert generally
sanity-checks options at startup.

=head2 Known Options

=over

=item syslog <syslog facility or blank>

Whether kuvert should use syslog for logging, and if so, what facility to
use. Default: nothing. This is independent of the logfile option below.

=item logfile <path or blank>

Whether kuvert should write log messages to a file, appending to it.
Default: not set. This is independent of the syslog option above.

=item mail-on-error <email address or blank>

If kuvert encounters serious or fatal errors, an email is sent back
to this address if set. Default: undef. This email is sent in addition to the 
normal logging via syslog or logfile.

=item queuedir <path>

Where kuvert and its helper programs store mails to be processed.
Default: ~/.kuvert_queue. The directory is created if necessary. The directory
must be owned by the user running kuvert and have mode 0700.

=item tempdir <path>

Where kuvert stores temporary files. Default: a directory called 
kuvert.<username>.<pid> in $TMPDIR or /tmp. The directory is created if 
necessary, and must be owned by the user running kuvert and have mode 0700.
This directory is completely emptied after processing an email.

=item identify <boolean>

Whether kuvert should add an X-Mailer header to outbound emails. 
Default: false. The X-Mailer header consists of the program name and version.

=item preamble <boolean>

Whether kuvert should include an explanatory preamble in the generated
MIME mail. Default: true

=item interval <number>

This sets the queue checking interval in seconds. Default: 60 seconds.

=item msserver <hostname-or-address>

Mail Submission Server for outbound email. Default: unset.
If this is set, kuvert will use SMTP to send outbound emails.
If not set, kuvert uses the mail submission program on the local machine.
See msp below.

=item msport <portnumber>

The TCP port on which the Mail Submission Server listens. Default: 587.
Ignored if msserver is not set.

=item ssl <string>

Whether SSL or STARTTLS are to be used for outbound SMTP submission.
The value must be either "starttls" to use STARTTLS or "ssl" for raw SSL.
SSL encryption is not used if this option is unset.

=item ssl-cert <client cert path.pem>

=item ssl-key <client key path.pem>

=item ssl-ca <ca cert path.pem>

If an SSL client certificate is to be presented to the SMTP server, set
both ssl-cert and ssl-key. If your system-wide CA certificate setup doesn't
include the certificate your SMTP server uses, set ssl-ca to point to a
PEM file containing all the relevant CA certificates. All these are ignored
if the ssl option isn't set.

=item msuser <username>

The username to use for SMTP authentication at the Mail Submission Server.
SMTP Auth is not attempted if msuser isn't set. Ignored if msserver is not
set.

=item mspass <password>

The password for SMTP authentication. Ignored if msserver or msuser are not set.

=item mspass-from-query-secret <boolean>

Whether the mspass should be retrieved using the query-secret program
instead of giving the mspass in the config file. Ignored if msserver or 
msuser are not set. If this option is set, the query-secret program will be used to ask for 
the "smtp-password" when the first mail is processed. The password will be
cached if authentication succeeds or you will be asked again, until 
authentication succeeds.

=item msp <program-path and args>

Defines the program kuvert should use to deliver email. 
Default: "/usr/sbin/sendmail -om -oi -oem".
This is ignored if msserver is set. The argument must include the 
full path to the program, and the program must accept the common mail transfer
agent arguments as defined in the Linux Standards Base 
(see L<http://refspecs.linux-foundation.org/LSB_2.0.0/LSB-Core/LSB-Core.html#BASELIB-SENDMAIL-1>).

=item can-detach <boolean>

Indicates to kuvert that it can background itself on startup, detaching
from the terminal. Default: false. This is possible only if you either
delegate passphrase handling to gpg-agent, or if your secret-query program
does not require interaction via the original terminal (e.g. if it is an
X11 program with its own window).

=item maport <portnumber>

Kuvert can accept email for processing via SMTP. This option sets
the TCP port kuvert listens on (localhost only). Default: 2587.
Ignored if ma-user and ma-pass are not both set. If you want to use this 
mechanism, tell your mail program to use localhost or 127.0.0.1 as outgoing
mail server and enable SMTP Authentication (see below).

=item ma-user <username>

This option sets the required SMTP authentication username for accepting 
mails via SMTP. Default: undef.
Kuvert does not listen for SMTP submissions unless both ma-user 
and ma-pass are set.
Kuvert does not accept emails for processing via SMTP unless you prove your
identity with SMTP Authentication (or anybody on your local machine could
use kuvert to send emails signed by you!). Kuvert currently supports only
AUTH PLAIN and LOGIN (which is not a major problem as we listen on the loopback
interface only). This option sets the username kuvert recognizes as yours.
This can be anything and doesn't have to be a real account name.

=item ma-pass <password>

This option sets the password your mail user agent must use for 
SMTP Authentication if submitting mails via SMTP. Default: unset.
Kuvert does not listen for SMTP submissions unless both ma-user 
and ma-pass are set. This password does not have to be (actually shouldn't be)
your real account's password. Note that using SMTP submission
requires that you protect your kuvert configuration file with strict 
permissions (0600 is suggested).

=item defaultkey <hexkeyid>

Specifies a default key to use as signing key. Default: unset, 
which means GnuPG gets to choose (usually the first available secret key).
Can be overridden in the From: address, see section L</"Key Selection">.

=item defaultaction <action>

Which action is to be taken if no overrides are found for a recipient.
Default: none. See section L</"How Kuvert Decides What (Not) To Do"> for recognized actions.

=item alwaystrust <boolean>

Whether gpg should be told to trust all keys for encryption or not.
Default: false.

=item use-agent <boolean>

Whether kuvert should delegate all passphrase handling to the gpg-agent
and call gpg with appropriate options. Default: false.
If not set, kuvert will ask the user (or some nominated passphrase store) 
for passphrases on demand.

=item query-secret <program-path and args with %s>

Tells kuvert which program to use for passphrase retrieval. 
Default: "/bin/sh -c 'stty -echo; read -p \"Passphrase %s: \" X; \
stty echo; echo $X'"
Ignored if use-agent is set. Kuvert does not store passphrases internally 
but rather runs the indicated program in a pipeline with gpg when signing.
If you use a passphrase store (like the Linux-kernel keyutils or secret-agent
or the like), enter your retrieval program here.
The program is run with kuvert's environment, the first %s in the argument
spec is replaced with the hex keyid and the passphrase is expected on stdout.
The exit code is ignored. If can-detach is not set, the program
has access to kuvert's terminal.
Note that the default query program prohibits kuvert from backgrounding itself.

=item flush-secret <program-path and args with %s>

This program is called to invalidate an external passphrase cache if 
kuvert is notified by gpg of the passphrase being invalid. Default: undef.
Ignored if use-agent is set. The program is run with kuvert's environment
and with the first %s of its argument spec being replaced by the hex keyid
in question. Its exit code is ignored. If can-detach is not set, the program
has access to kuvert's terminal. 

=back

=head1 DIAGNOSTICS

Kuvert usually logs informational messages to syslog and/or its own logfile,
both of which can be disabled and adjusted.

If kuvert detects a fault that makes successful processing of 
a particular email impossible, kuvert will report that on STDERR (if not 
detached) and also email an error report if the option mail-on-error 
is enabled. Such partially or completely unprocessed mails are left 
in the queue but are renamed (the name is prefixed with "failed."); 
it is up to you to either remove such leftovers or rename them to something 
all-numeric once the problem has been resolved.

The behaviour is similar if fatal problems are encountered; after
alerting kuvert will terminate with exit code 1.

=head1 ENVIRONMENT AND SIGNALS

Kuvert itself uses only on environment variable: $TMPDIR provides
the fallback location for kuvert's temporary directory.

Kuvert passes its complete environment to child processes, namely
gpg and any passphrase-query programs.

On reception of SIGUSR1, kuvert reloads its configuration file and keyring.
Any one of SIGHUP, SIGINT, SIGQUIT and SIGTERM causes kuvert to terminate
cleanly, invalidating the passphrases if a query program is used.
All other signals are ignored.

=head1 FILES

=over

=item ~/.kuvert 

The configuration file read by kuvert and kuvert_submit.

=item ~/.kuvert_queue

The default queue directory.

=item /tmp/kuvert.pid.E<lt>uidE<gt>

holds the pid of a running kuvert daemon.

=back

=head1 SEE ALSO

L<gpg(1)>, L<kuvert_submit(1)>, RFC3156, RFC2440, RFC2015

=head1 AUTHOR

Alexander Zangerl <az@@snafu.priv.at>

=head1 COPYRIGHT AND LICENCE

copyright 1999-2008 Alexander Zangerl <az@@snafu.priv.at>

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License version 2
as published by the Free Software Foundation.

=cut

@


2.29
log
@updated copyright timestamp
@
text
@d22 1
a22 1
#   $Id: kuvert,v 2.28 2013/11/25 11:48:37 az Exp az $
d914 1
a914 1
		    close($config{logfh}); 
d1326 2
@


2.28
log
@added support for starttls
@
text
@d7 1
a7 1
# copyright (c) 1999-2008 Alexander Zangerl <az@@snafu.priv.at>
d22 1
a22 1
#   $Id: kuvert,v 2.27 2012/09/04 10:27:32 az Exp az $
@


2.27
log
@added 600s timeout for gpg invocations
@
text
@d22 1
a22 1
#   $Id: kuvert,v 2.26 2012/02/21 02:19:28 az Exp az $
d31 1
a31 1
use Net::SMTP;			# for sending via smtp
d774 4
d862 1
a862 1
	    elsif ($key =~ /^(ma-pass|ma-user|mail-on-error|msserver|msuser|mspass)$/)
d1094 6
a1099 2
	my $s=Net::SMTP->new($config{msserver},Port=>$config{msport},
			     Hello=>$dom);
d1908 18
@


2.26
log
@added option to set or suppress the mime preamble
@
text
@d22 1
a22 1
#   $Id: kuvert,v 2.25 2010/09/16 05:17:22 az Exp az $
d54 2
d1280 16
a1295 4
    # outermost parent: read gpg status info 
    my @@output=<F>;
    close(F);
    if ($?)
@


2.25
log
@added support for optional outbound smtp authentication
@
text
@d22 1
a22 1
#   $Id: kuvert,v 2.24 2009/10/20 06:43:04 az Exp az $
d269 3
a271 1
    $newent->preamble(["This is a multi-part message in MIME format.\n",
d273 2
a274 2
		       "You need GPG to check the signature.\n"]);

d327 3
a329 2
    # set the new preamble
    $newent->preamble(["This is a multi-part message in MIME format.\n",
d331 2
a332 2
		       "You need GPG to view the content.\n"]);

d789 1
d842 1
a842 1
	    if ($key =~ /^(identify|use-agent|alwaystrust|can-detach|mspass-from-query-secret)$/)
d1865 5
@


2.24
log
@fixed stupid case-sensitivity bug: keys are downcased but addresses were not...
@
text
@d22 1
a22 1
#   $Id: kuvert,v 2.23 2008/08/31 06:39:26 az Exp az $
d767 3
d838 1
a838 1
	    if ($key =~ /^(identify|use-agent|alwaystrust|can-detach)$/)
d852 1
a852 1
	    elsif ($key =~ /^(ma-pass|ma-user|mail-on-error)$/)
a889 7
	    elsif ($key eq "msserver")
	    {
		# crude check for ip or host name
		bailout("bad value \"$value\" for key \"$key\"")
		     if ($value!~/^([0-9:.]+|[a-z0-9.]+)$/);
		$options{$key}=$value;
	    }
d914 7
d1088 37
d1126 1
a1126 1
	    or return("mailserver rejected our from address \"$from\"");
d1136 2
a1137 1
		    "rejected: ".join(", ",@@missed));
d1139 1
a1139 1
	$s->data($ent->as_string) or return("mailserver rejected our data");
d1878 19
d1900 2
a1901 2
Default: "/usr/sbin/sendmail -om -oi -oem"
Ths is ignored if msserver is set. The argument must include the 
@


2.23
log
@fixed queuedir-creation
@
text
@d22 1
a22 1
#   $Id: kuvert,v 2.22 2008/06/29 12:31:01 az Exp az $
d653 1
a653 1
	my ($addr,$comment,$phrase)=($a->address,$a->comment,$a->phrase);
@


2.22
log
@fixed silly manpage typo
@
text
@d22 1
a22 1
#   $Id: kuvert,v 2.21 2008/06/29 11:57:31 az Exp az $
a870 10
		if (!-d $value)
		{
		    mkdir($value,0700) or bailout("cannot create $key $value: $!\n");
		}
		my @@stat=stat($value);
		if ($stat[4] != $< or ($stat[2]&0777) != 0700)
		{
		    bailout("$key $value does not belong to you or has bad mode.");
		}
		    
d917 15
@


2.21
log
@syslog is now off by default
@
text
@d22 1
a22 1
#   $Id: kuvert,v 2.20 2008/06/29 11:39:34 az Exp az $
d1725 1
a1725 1
address contains a ((key=B<keyid>)) stanza, kuvert will use this key for
@


2.20
log
@added logging for end of keyring read
@
text
@d22 1
a22 1
#   $Id: kuvert,v 2.19 2008/06/29 11:01:55 az Exp az $
d770 1
a770 1
	 syslog=>"mail",
d1785 1
a1785 1
use. Default: mail. This is independent of the logfile option below.
@


2.19
log
@added auto-conversion
@
text
@d22 1
a22 1
#   $Id: kuvert,v 2.18 2008/06/29 10:26:41 az Exp az $
d990 1
@


2.18
log
@kuvert v2 looks ready :-)
@
text
@d22 1
a22 1
#   $Id: kuvert,v 2.17 2008/06/29 07:24:53 az Exp az $
a168 2
    print PIDF "$$\n";
    close PIDF;			# clears the lock
d170 2
d789 3
a791 1
    while (<F>)
d796 12
d931 44
d1762 1
a1762 1
the option name followed by some whitespace.
@


2.17
log
@semi-tested (missing: test of smtp server, some options)
on the way to kuvert v2.
@
text
@d22 1
a22 1
#   $Id: kuvert,v 2.16 2007/06/23 02:37:57 az Exp az $
a74 1
# fixme: pidstuff for the smtp daemon
d94 4
a97 2
	    die "can't send signal to process $p: $!\n"
		if (!kill(($n=~/^$listenername/?$ssig:$sig),$p));
d103 1
a135 1
$config{syslog}="mail";
d137 1
d140 1
a142 9

# install the handler for conf reread
$SIG{'USR1'}=\&handle_reload;
# and the termination-handler
$SIG{'HUP'}=\&handle_term;
$SIG{'INT'}=\&handle_term;
$SIG{'QUIT'}=\&handle_term;
$SIG{'TERM'}=\&handle_term;

a143 1
# fixme: pidfile stuff!
d148 3
a150 19
    my $pid=fork;
    if (!defined($pid))
    {
	die "cannot fork: $!\n";
    }
    elsif (!$pid)
    {	
	# run mailserver, which does never reload the config
	$0=$listenername;
	close STDIN;
	close PIDF;		# clears the inherited lock
	$SIG{'USR1'}=\&handle_term;
	&accept_mail;
    }
    else
    {
	# parent updates pidfile with mailserver pid
	print PIDF "$pid\n";
    }
d153 5
d219 1
a219 1
"Your mail \"$config{queuedir}/$file\" could not be processed successfully,
d224 2
a225 1
if you wish to retry rename it to an all-numeric filename. Otherwise you should delete the file.\n");
d283 1
a283 1
	$debug && logit("gpg reported bad passphrase, retrying.");
d286 1
a286 1
	    $debug && logit("invalidating passphrase for $signkey");
d341 1
a341 1
	$debug && logit("gpg reported bad passphrase, retrying.");
d344 1
a344 1
	    $debug && logit("invalidating passphrase for $signkey");
d392 1
a392 1
	$debug && logit("local signkey override: $signkey");
d436 1
a436 1
    $in_ent->head->replace("cc",$newcc);
d556 1
a556 1
	my @@res=&crypt_send($in_ent,$cryptoin,$orig_header,$signkey,
d589 1
a589 1
	$debug && logit("action $actions{$addr} for $addr");
d595 1
a595 1
	    $debug && logit("override header: $override for $addr");
d604 1
a604 2
	    $debug && 
		logit("local override: action $thisaction for $addr");
d610 1
a610 2
	    $debug && 
		logit("local key override: $specialkeys{$addr} for $addr");
d636 1
a636 1
		$debug && logit("downgrading to signonly for $addr");
d708 1
a708 1
    logit("$sig triggered termination, cleaning up");
d718 2
a719 1
    logit("rereading configuration");
a720 1
    logit("rereading keyring");
d722 10
d806 2
a807 2
	    $debug && logit("got override $action "
			    .($key?"key $key ":"")."for $who");
d815 1
a901 1
		$value=undef if (!$value || $value=~/^(\'|\"){2}$/); 
d909 1
a909 1
	    $debug && logit("got config $key=$value");
d970 1
a970 2
		&logit("got key 0x$lastkey type $info[3] for $name")
		    if ($debug);
d974 1
a974 2
		&logit("saved key 0x$lastkey, no address known yet")
		    if ($debug);
d993 1
a993 2
		&logit("got key (uid) 0x$lastkey for $name")
		    if ($debug);
d997 1
a997 2
		&logit("ignoring uid without valid address")
		    if ($debug);
d1106 1
a1106 1
		or die "can't dup2 stderr onto stdout: $!\n";
d1108 1
a1108 1
	    die "exec gpg failed: $!\n";
d1115 1
a1115 1
		$precmd=sprintf($config{"query-secret"},substr($2,8));
d1137 1
a1137 1
		or die "can't dup2 stderr onto stdout: $!\n";
d1139 1
a1139 1
	    die "exec gpg failed: $!\n";
d1151 1
a1151 1
		die "Error: couldn't fork: $!\n";
d1162 1
a1162 1
		or die "can't dup2 stderr onto stdout: $!\n";
d1164 1
a1164 1
		or die "can't dup stdin onto child-pipe: $!\n";
d1166 1
a1166 1
	    die "exec gpg failed: $!\n";
d1178 1
a1178 1
	      "Detailed error message:",join("\n",@@output));
d1198 1
a1198 1
	print { $config{logfh} } scalar(localtime).join("\n\t",@@msgs)."\n";
d1210 5
d1234 1
a1235 2

	my $subject=$progname.": ".shift @@msgs;
d1238 1
a1238 1
				  Subject=>$subject,
d1257 23
d1286 1
d1293 1
a1293 1
	$esmtp->register('Net::Server::Mail::ESMTP::Extension::plainAUTH');
d1309 1
a1309 1
    return ($user eq $config{'ma-user'} && $pwd eq $config{'ma-pass'});
d1333 1
a1333 1
    my $qid=(Time::HiRes::gettimeofday)[1];
d1369 1
a1369 1
    if (!close {$session->{DATA}->{qfh}})
d1418 2
a1419 2
Enables debugging mode: extra information is written to kuvert's logfile
and/or syslog.
d1424 2
a1425 1
only the current queue contents and then exits.
@


2.16
log
@signatures are now tagged more extensively (as per hint
by Andreas Labres/Andreas Kreuzinger)
@
text
@d3 2
a4 2
# this file is part of kuvert, a wrapper around sendmail that
# does pgp/gpg signing/signing+encrypting transparently, based
d7 1
a7 1
# copyright (c) 1999-2005 Alexander Zangerl <az@@snafu.priv.at>
d10 2
a11 3
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; either version 2 of the License, or
#   any later version.
d22 1
a22 1
#   $Id: kuvert,v 2.15 2005/11/04 06:21:20 az Exp az $
d31 4
d36 4
a39 2
use Term::ReadKey;
use Proc::PID::File;
d45 3
d50 1
a52 6
# configuration directives, keyring
my (%config,@@overrides,%keys);
# the passphrases are stored here if passphrase store is not a/v
my %secrets=();
my ($debug,$barfmail);
my @@detailederror=();
d54 2
a55 2
my $piddir=($ENV{'TMPDIR'}?$ENV{'TMPDIR'}:"/tmp");
my $pidname="$progname.$<";
d57 2
a58 1
sub main
d60 2
a61 6
    my %options;

    if (!getopts("dkrnvb",\%options) || @@ARGV)
    {
	die "usage: $progname [-n] [-d] [-v] [-b]| [-k] | [-r] 
-k: kill running $progname
d64 4
a67 13
-n don't fork
-v: output version and exit
-b: complain via mail when dying\n";
    }
    
    if ($options{'v'})
    {
	print STDERR "$progname $version\n";
	exit 0;
    }
    
    $debug=1 if ($options{"d"});
    $barfmail=1 if ($options{"b"});
d69 3
a71 6
    # kill a already running process
    # TERM for kill or HUP for rereading
    if ($options{"k"} || $options{"r"})
    {
	my $pid;
	my $sig=($options{"r"}?'USR1':'TERM');
d73 25
a97 10
	open(PIDF,"$piddir/$pidname.pid") || &bailout("cant open pidfile: $! -- exiting");
	$pid=<PIDF>;
	close(PIDF);
	chomp $pid;

	&bailout("no valid pid found, cant kill any process -- exiting")
	    if (!$pid);
	&bailout("cant kill -$sig $pid: $! -- exiting")
	    if (!kill $sig, $pid);
	exit 0;
d99 3
d103 20
a122 1
    if (! -e $rcfile)
d124 44
a167 7
	open(F,">$rcfile") || &bailout("can't create $rcfile: $! -- exiting");
	print F "# configuration file for kuvert\n"
	    ."# see kuvert(1) for details\n";
	close(F);
	1==chmod(0600,$rcfile) || 
	    &bailout("can't chmod $rcfile: $! -- exiting");
	print STDERR "created blank configuration file $rcfile\n"
d169 1
a169 9

    logit("$progname version $version starting");

    # read the config, setup dirs, logging, defaultkeys etc.
    &read_config;

    # get the passphrase(s) if no external passphrase store is used
    # this has to be done before a fork...
    if (!$config{secretondemand})
d171 2
a172 4
	# get the passphrases and verify them
	# if we do ng or std, ie. keyid!=0
	get_secret("std") if ($config{stdkey});
	get_secret("ng") if ($config{ngkey});
d174 1
d176 4
a179 1
    if (!$debug && !$options{"n"})
d181 1
a181 5
	my $res=fork;

	&bailout("fork failed: $! -- exiting")
	    if ($res == -1);
	exit 0 if ($res);
d183 1
a183 20

    # check that we're the only instance running
    bailout("$progname: some other instance is running!")
	if (Proc::PID::File->running(dir=>$piddir,
				     name=>$pidname));

    # make things clean and ready. we're in sole command now.
    cleanup($config{tempdir},0);
    &read_keyrings;

    # install the handler for conf reread
    $SIG{'USR1'}=\&handle_reload;
    # and the termination-handler
    $SIG{'HUP'}=\&handle_term;
    $SIG{'INT'}=\&handle_term;
    $SIG{'QUIT'}=\&handle_term;
    $SIG{'TERM'}=\&handle_term;

    # the main loop, left only via signal handler handle_term
    while (1)
d185 1
a185 50
	&bailout("cant open $config{queuedir}: $! -- exiting")
	    if (!opendir(D,"$config{queuedir}"));
	
	my $file;
	foreach $file (grep(!/^\./,readdir(D)))
	{
	    if (!open(FH,"$config{queuedir}/$file"))
	    {
		logit("huh? $file just disappeared? $!");
		next;
	    }
	    # lock it if possible
	    if (!flock(FH,LOCK_NB|LOCK_EX))
	    {
		close(FH);
		logit("$file is locked, skipping.");
		next;
	    }

	    #ok, open & locked, let's proceed
	    logit("processing $file for $username");
	    $barfmail=0; # avoid duplicate mails, we're eval()ing!
	    eval { process_file(*FH,"$config{queuedir}/$file"); };
	    $barfmail=1 if ($options{"b"});
	    if ($@@)
	    {
		chomp(my $error=$@@);
		
		rename("$config{queuedir}/$file","$config{queuedir}/.$file")
		    || &bailout("cant rename $config{queuedir}/$file: $! -- exiting");
		logit("failed to process $file, left as \".$file\".\n");
		send_bounce($error,$file);
	    }
	    else
	    {
		logit("done with file $file");
		unlink("$config{queuedir}/$file")
		    || &bailout("cant unlink $config{queuedir}/$file: $! -- exiting");
	    }
	    # and clean up the cruft left behind, please!
	    cleanup("$config{tempdir}",0);

	    # unlock the file
	    bailout("problem unlocking $config{queuedir}/$file: $! -- exiting")
		if (!flock(FH,LOCK_UN));
	    close(FH);
	}
	closedir(D);
	&handle_term("debug mode") if ($debug);
	sleep($config{interval});
d187 2
d191 17
a207 3
# processes a file in the queue, does not remove stuff from the tempdir or the queue
# exception on errors
sub process_file
d209 5
a213 78
    my ($fh,$file)=@@_;

    my $parser = new MIME::Parser;

    # dump mime object to tempdir
    $parser->output_dir($config{tempdir});
    # retain rfc1522-encoded headers, please
    $parser->decode_headers(0);
    # make the parser ignore all filename info and just invent filenames.
    $parser->filer->ignore_filename(1);

    my $in_ent;

    eval { $in_ent=$parser->read(\$fh); };
    bailout("could not parse MIME stream, last header was ".$parser->last_head)
	if ($@@);

    # add version header
    $in_ent->head->add('X-Mailer',"$progname $version")
	if ($config{identify});

    # extract and delete instruction header
    my $custom_conf=lc($in_ent->head->get("x-kuvert"));
    $in_ent->head->delete("x-kuvert");

    # strip trailing and leading whitespace from the custom header
    $custom_conf =~ s/^\s*(\S*)\s*$/$1/;
    
    # check the custom header for validity
    undef $custom_conf 	
	unless ($custom_conf=~/^(none|std(sign)?|ng(sign)?|fallback)(-force)?$/);

    # extract a possible resend-request-header, if set call mta immediately
    if ($custom_conf eq "none" || $in_ent->head->get("resent-to"))
    {
	logit(($custom_conf eq "none"?"resending ":"")
	       ."sign/encrypt disabled, calling $config{mta} -t");
	# we do not send the original file here because this file possibly
	# holds the instruction header...
	&send_entity($in_ent,"-t");
	$in_ent->purge;
	return;
    }

    my (@@recip_all,@@recip_bcc);

    # get the recipients
    map { push @@recip_all, lc($_->address); } 
    Mail::Address->parse($in_ent->head->get("To"),
			 $in_ent->head->get("Cc"));
    
    map { push @@recip_bcc, lc($_->address); } 
    Mail::Address->parse($in_ent->head->get("Bcc"));
    # but don't leak Bcc...
    $in_ent->head->delete("Bcc");

    # cry out loud if there is a problem with the submitted mail 
    # and no recipients were distinguishable...
    # happens sometimes, with mbox-style 'From bla' lines in the headers...
    bailout("no recipients found! the mail headers seem to be garbled.")
	if (!@@recip_all && !@@recip_bcc);

    # figure out what to do for specific recipients
    my %actions=findaction($custom_conf,\@@recip_all,\@@recip_bcc);

    my $orig_header;
    my $input="$config{tempdir}/.input";

    # take care of raw mails, before mangling the headers
    my @@recips=grep($actions{$_} eq "none",keys %actions);
    if (@@recips)
    {
	logit("sending mail (raw) to ".join(",",@@recips));
	&send_entity($in_ent,@@recips);
    }
    
    # prepare various stuff we need only when encrypting or signing
    if(grep(/(ng|std)/,values(%actions)))
d215 1
a215 7
	# copy (mail)header, split header info
	# in mime-related (remains with the entity) and non-mime
	# (is saved in the new, outermost header-object)
	$orig_header=$in_ent->head->dup;

	# content-* stays with the entity and the rest moves to orig_header
	foreach my $headername ($in_ent->head->tags)
d217 2
a218 10
	    if ($headername !~ /^content-/i)
	    {
		# remove the stuff from the entity
		$in_ent->head->delete($headername);
	    }
	    else
	    {
		# remove this stuff from the orig_header
		$orig_header->delete($headername);
	    }
d220 2
a221 31

	# any text/plain parts of the entity have to be fixed with the
	# correct content-transfer-encoding (qp), since any transfer 8->7bit
	# on the way otherwise will break the signature.
	# this is not necessary if encrypting, but done anyways since
	# it doesnt hurt and we want to be on the safe side.

	qp_fix_parts($in_ent);

	# now we've got a $in_entity which is ready to be encrypted/signed
	# and the mail-headers are saved in $orig_header

	# since old pgp has problems with stuff signed/encrypted
	# by newer software that uses partial-length headers when fed
	# data via pipe, we write out our $in_entity to a tempfile 
	# which is then used in the relevant signing/encryption operations.

	bailout("cant open >$input: $!")
	    if (!open(F,">$input"));
	$in_ent->print(\*F);
	close(F);
    }

    foreach my $action qw(ng ngsign std stdsign bcc-ng bcc-std)
    {
	my @@recips=grep($actions{$_} eq $action,keys %actions);
	next if (!@@recips);

	my $type=($action=~/ng/?"ng":"std");

	if ($action=~/bcc/)
d223 2
a224 8
	    # send stuff single file, one completely separate mail per bcc recipient...ugly and slow
	    # but the Right Thing, otherwise we leak encryption key information
	    # (only necessary for encryption)
	    foreach (@@recips)
	    {
		logit("sending mail (bcc,crypt,$type) to $_");
		&crypt_send($in_ent,$input,$type,$orig_header,[$keys{$type}->{$_}],$_);
	    }
d227 6
a232 2
	
	if ($action=~/sign/)
d234 9
a242 3
	    logit("sending mail (sign,$type) to ".join(",",@@recips));
	    &sign_send($in_ent,$input,$type,$orig_header,@@recips);
	    next;
d246 14
a259 6
	    my @@recipkeys;
	    map { push @@recipkeys,$keys{$type}->{$_}; } @@recips;
	    logit("sending mail (crypt,$type) to ".join(",",@@recips));
	    &crypt_send($in_ent,$input,$type,$orig_header,\@@recipkeys,@@recips);
	}
    }
d262 1
d264 3
a266 2
# args: entity, location of dump of entity, type, outermost headers, recipients
# exception on errors
d269 2
a270 2
    my ($ent,$dumpfile,$type,$header,@@recips)=@@_;
    my $output="$config{tempdir}/.signout";
d284 1
a284 1
    $newent->head->mime_attr("content-Type.Micalg" => ($type eq "ng"?"pgp-sha1":"pgp-md5"));
d288 1
a288 1
		       "You need GPG or PGP to check the signature.\n"]);
d294 3
a296 1
    while (&sign_encrypt(0,$type,$dumpfile,$output,undef))
d298 4
a301 11
	# get rid of broken passphrase and lets try again
	if ($config{secretondemand})
	{
	    $debug && logit("bad passphrase, retry");
	    my $cmd=sprintf($config{delsecret},$config{$type."key"});
	    my $res=0xffff & system("$cmd >$config{tempdir}/subproc 2>&1");
	    bailout("error deleting broken passphrase from store: $res",
		    "$config{tempdir}/subproc")
		if ($res);		
	}
	else
d303 3
a305 2
	    # bad passphrase but we're on our own -> cant recover
	    bailout("bad passphrase, but no passphrase store to query!");
d308 2
d312 1
a312 1
		    Path => "$output",
d318 1
a318 1
    &send_entity($newent,@@recips);
d322 3
a324 1
# args: entity, location of dump of entity, type, outermost headers, recipient keys, recipient addresses
d327 2
a328 2
    my ($ent,$dumpfile,$type,$header,$rec_keys,@@recips)=@@_;
    my $output="$config{tempdir}/.encout";
d345 1
a345 1
		       "You need PGP or GPG to view the content.\n"]);
d353 2
a354 1
    while (&sign_encrypt(1,$type,$dumpfile,$output,@@{$rec_keys}))
d356 4
a359 11
	# get rid of broken passphrase and lets try again
	if ($config{secretondemand})
	{
	    $debug && logit("bad passphrase, retry");
	    my $cmd=sprintf($config{delsecret},$config{$type."key"});
	    my $res=0xffff & system("$cmd >$config{tempdir}/subproc 2>&1");
	    bailout("error deleting broken passphrase from store: $res",
		    "$config{tempdir}/subproc")
		if ($res);		
	}
	else
d361 3
a363 2
	    # bad passphrase but we're on our own -> cant recover
	    bailout("bad passphrase, but no passphrase store to query!");
d366 1
d370 1
a370 1
		    Path => "$output",
d376 1
a376 1
    &send_entity($newent,@@recips);
d379 4
a382 5

# send entity to $mta, passing $args to $mta
# ent is a MIME::Entity and args is either "-t" or a list of recipients
# exception on errors
sub send_entity
d384 1
a384 1
    my ($ent,@@args)=@@_;
d386 4
a389 13
    my $pid=open(TOMTA,"|-");
    bailout("cant open pipe to $config{mta}: $!") if (!defined $pid);
    if ($pid)
    {
	$ent->print(\*TOMTA);
	close(TOMTA) || bailout("error talking to child $config{mta}: $?");
    }
    else
    {
	my @@cmd=split(/\s+/,$config{mta});
	exec(@@cmd,@@args) || bailout("error execing $cmd[0]: $!");
    }
}
d391 9
a399 7
# remove temporary stuff left behind in directory $what
# remove_what set: remove the dir, too.
# exception on error, no retval
sub cleanup
{
    my ($what,$remove_what)=@@_;
    my ($name,$res);
d401 10
a410 6
    opendir(F,$what) || bailout("cant opendir $what: $!");
    foreach $name (readdir(F))
    {
	next if ($name =~ /^\.{1,2}$/o); 
	(-d "$what/$name")?&cleanup("$what/$name",1):
	    (unlink("$what/$name") || bailout("cant unlink $what/$name: $!"));
a411 4
    closedir(F);
    $remove_what && (rmdir("$what") || bailout("cant rmdir $what: $!"));
    return 0;
}
d413 3
a415 4
# log termination, cleanup, exit
sub handle_term
{
    my ($sig)=@@_;
d417 6
a422 16
    logit("got termination signal SIG$sig, cleaning up");
    my $res=&cleanup($config{tempdir},1);
    logit("problem cleaning up $config{tempdir}: $res")
	if ($res);

    # wipe keys
    if ($config{secretondemand})
    {
	foreach ($config{ngkey},$config{stdkey})
	{
	    next if (!$_);
	    my $cmd=sprintf($config{delsecret},$_);
	    my $res=0xffff & system $cmd;
	    &logit("problem deleting secret for $_: $res")
		if ($res);
	}
d424 1
a424 3
    close $config{logfh} if ($config{logfh});
    exit 0;
}
d426 28
a453 8
# reread configuration file and keyrings
# no args or return value; intended as a sighandler.
sub handle_reload
{
    logit("rereading config file");
    &read_config;
    &read_keyrings;
}
d455 5
a459 9
# read keyrings into global hashes
# note: this must happen after the config is read, so that
# the right tools are used (gpg vs. pgp)
sub read_keyrings
{
    my ($lastkey,$lasttype,@@tmp,$name,$now,@@info);
    my %badcauses=('i'=>'invalid, no selfsig','d'=>'disabled',
		   'r'=>'revoked','e'=>'expired');
    %{$keys{std}}=();
d461 7
a467 1
    if ($config{usepgp})
d469 6
a474 1
	if (!$config{stdkey})
d476 6
a481 1
	    logit("ignoring std keyring, no key a/v.");
d483 3
a485 1
	else
d487 1
a487 45
	    logit("reading std keyring.");
	    $now=time;
	    
	    #get the keys and dump the trailer and header lines
	    # this does not care if pgp is not existent...but then, we're not
	    # needing the pgp keyring
	    @@tmp=`$config{pgppath} -kv 2>$config{tempdir}/subproc`;
	    bailout("failure reading keyring with $config{pgppath}: $?",
		    "$config{tempdir}/subproc") if ($?);
	    foreach (@@tmp)
	    {
		if (/^pub\s+\d+\/(\S+)\s+(.+)$/)
		{
		    my ($key,$userspec)=($1,$2);
		    
		    if ($userspec =~ /(\s|<)([^\s<]+\@@[^\s>]+)>?/)
		    {
			$name=lc($2);
		    }
		    else
		    {
			undef $name;
		    }
		    
		    if ($name)
		    {
			$keys{std}->{$name}="0x$key";
			$lastkey=$key;
			&logit("got stdkey 0x$key for $name") if ($debug);
		    }
		    else
		    {
			$lastkey=$key;
			&logit("saved stdkey 0x$key, no address known yet")
			    if ($debug);
		    }
		    next;
		}
		if (/^\s+.*(\s|<)([^\s<]+\@@[^\s>]+)>?\s*$/)
		{
		    my $name=lc($2);
		    $keys{std}->{$name}="0x$lastkey";
		    &logit("got stdkey (uid) 0x$lastkey for $name") if ($debug);
		}
	    }
d489 1
d492 2
a493 1
    %{$keys{ng}}=();
d495 12
a506 1
    if ($config{ngkey} || !$config{usepgp} && $config{stdkey})
d508 4
a511 1
	logit("reading ".(!$config{usepgp} && $config{stdkey}?"combined":"ng")." keyring.");
d513 4
a516 35
	# this does not care if gpg is not existent...but then, we're not
	# needing the gpg keyring
	@@tmp=`$config{gpgpath} -q --batch --list-keys --with-colons --no-expensive-trust-checks 2>$config{tempdir}/subproc`;
	bailout("failure reading keyring with $config{gpgpath}: $?",
		"$config{tempdir}/subproc") if ($?);
	foreach (@@tmp)
	{
	    @@info=split(/:/);
	    # only public keys and uids are of interest
	    next if ($info[0] ne "pub" && $info[0] ne "uid");
	    
	    $info[4] =~ s/^.{8}//;	# truncate key-id
	    
	    # rsa-keys only if !$usepgp
	    # and be sure to skip these uid's, too
	    if ($config{usepgp} && $info[3] eq "1")
	    {
		&logit("ignoring stdkey 0x$info[4]") if ($debug && $info[4]);
		undef $lastkey;
		next;
	    }
	    elsif (!$config{ngkey} && $info[3] ne "1")
	    {
		&logit("ignoring ngkey 0x$info[4]") if ($debug && $info[4]);
		undef $lastkey;
		next;
	    }
	    
	    $info[9] =~ s/\\x3a/:/g; # re-insert colons, please
	    
	    # remember the email address
	    # if no address given: remember this key 
	    # but go on to the uid's to get an email address to
	    # work with
	    if ($info[9] =~ /(\s|<)([^\s<]+\@@[^\s>]+)>?/)
d518 2
a519 1
		$name=lc($2);
d523 2
a524 69
		undef $name;
	    }
	    
	    # check the key: public part or uid?
	    if ($info[0] eq "pub")
	    {
		# lets associate this key with the current email address
		# if an address is known
		$lastkey=$info[4];
		$lasttype=$info[3]==1?"std":"ng";
		
		if ($name)
		{
		    # ignore expired, revoked and other bad keys
		    if (defined $badcauses{$info[1]})
		    {
			&logit("ignoring ".($info[3]==1?"std":"ng")
			       ." key 0x$info[4], reason: "
			       .$badcauses{$info[1]});
			next;
		    }
		    
		    $keys{$lasttype}->{$name}="0x$lastkey";
		    
		    &logit("got $lasttype key 0x$lastkey for $name")
			if ($debug);
		}
		else
		{
		    &logit("saved $lasttype key 0x$lastkey, no address known yet")
			if ($debug);
		}
		next;
	    }
	    else
	    {
		# uid: associate the current address with the key 
		# given in the most recent public key line
		# if no such key saved: the pub key was an rsa key &
		# we're set to ignore those
		if (!$lastkey)
		{
		    $name="<no valid address>" if (!$name);
		    &logit("ignoring uid $name, belongs to std key?")
			if ($debug);
		}
		else
		{
		    if ($name)
		    {
			# ignore expired, revoked and other bad keys
			if (defined $badcauses{$info[1]})
			{
			    &logit("ignoring ".($info[3]==1?"std":"ng")
				   ." uid $name for 0x$lastkey, "
				   ."reason: ".$badcauses{$info[1]});
			    next;
			}
			
			$keys{$lasttype}->{$name}="0x$lastkey";
			&logit("got $lasttype key (uid) 0x$lastkey for $name")
			    if ($debug);
		    }
		    else
		    {
			&logit("ignoring uid without valid address")
			    if ($debug);
		    }
		}
a526 6
    }
    else
    {
	logit("ignoring ng keyring, no key a/v.");
    }
}
d528 57
a584 4
# reads the configuration file, sets config variables
# exception on major problems
# no retval. changes %config and @@overrides on success.
sub read_config
d586 2
a587 1
    my @@over;
d589 2
a590 23
    # default settings
    my $defaction="none";
    my %newconf=(ngkey=>undef,
		 stdkey=>undef,
		 pgppath=>"/usr/bin/pgp",
		 gpgpath=>"/usr/bin/gpg",
		 usepgp=>0,
		 getsecret=>undef,
		 delsecret=>undef,
		 mta=>"/usr/lib/sendmail -om -oi -oem",
		 secretondemand=>0,
		 alwaystrust=>0,
		 interval=>60,
		 tempdir=>($ENV{'TMPDIR'}?$ENV{'TMPDIR'}:"/tmp")."/kuvert.$username.$$",
		 queuedir=>"$home/.kuvert_queue",
		 logfile=>undef,
		 logfh=>undef,
		 identify=>0);
    
    &bailout("cant open $rcfile: $! -- exiting")
	if (!open (F,$rcfile));
    logit("reading config file");
    while (<F>)
d592 2
a593 4
	chomp;
	next if (/^\#/ || /^\s*$/); # strip comments and empty lines

	if (/^(\S+)\s+((none|std(sign)?|ng(sign)?|fallback)(-force)?)\s*$/)
d595 1
a595 2
	    my ($key,$action)=(lc($1),lc($2));
	    if ($key eq "default")
d597 5
a601 9
		$defaction=$action;
		$debug && logit("changing default action to $action");
	    }
	    else
	    {
		push @@over,{"key"=>$key,
			    "re"=>qr/$key/,
			    "action"=>$action};
		$debug && logit("got conf $action for $key");
d604 7
a610 1
	elsif (/^([[:upper:]]+)\s+(\S.*)\s*$/)
d612 3
a614 1
	    my ($key,$value)=(lc($1),$2);
d616 7
a622 9
	    if (grep($_ eq $key, keys %newconf))
	    {
		$newconf{$key}=$value;
		$debug && logit("set config $key to $value");
	    }
	    else
	    {
		&bailout("bad config entry \"$_\" -- exiting");
	    }
d624 2
a625 1
	else
d627 3
a629 1
	    &bailout("bad config entry \"$_\" -- exiting");
a630 7
    }
    close F;

    # last per-address override is the catch-all default
    push @@over,{"key"=>"default",
		"re"=>qr/.*/,
		"action"=>"$defaction"};
d632 3
a634 22
    # generate queuedir if not existing
    if (!-d $newconf{queuedir})
    {
	unlink "$newconf{queuedir}";
	&bailout("cant mkdir $newconf{queuedir}: $! -- exiting")
	    if (!mkdir($newconf{queuedir},0700));
    }
    # check queuedir owner & perm
    elsif ((stat($newconf{queuedir}))[4] != $<)
    {
	&bailout("$newconf{queuedir} is not owned by you  -- exiting");
    }
    elsif ((stat($newconf{queuedir}))[2] & 0777 != 0700)
    {
	&bailout("$newconf{queuedir} does not have mode 0700 -- exiting");
    }
    
    # make tempdir
    if (!-d $newconf{tempdir})
    {
	unlink "$newconf{tempdir}";
	if (!mkdir($newconf{tempdir},0700))
d636 4
a639 1
	    &bailout("cant mkdir $newconf{tempdir}: $! -- exiting");
a641 12
    elsif ((stat($newconf{tempdir}))[4] != $<)
    {
	&bailout("$newconf{tempdir} is not owned by you -- exiting");
    }
    elsif ((stat($newconf{tempdir}))[2]&0777 != 0700)
    {
	&bailout("$newconf{tempdir} does not have mode 0700 -- exiting");
    }

    # close old logfile if there is one
    close($config{logfile})
	if ($config{logfile} && $config{logfile} ne $newconf{logfile});
d643 4
a646 1
    if ($newconf{logfile})
d648 2
a649 37
	&bailout("cant open logfile $newconf{logfile}: $! -- exiting")
	    if (!open($newconf{logfh},">>$newconf{logfile}"));
	$newconf{logfh}->autoflush(1);
    }

    # secret on demand is only possible with both a get and a del command
    $newconf{secretondemand}=0 
	if (!$newconf{getsecret} || !$newconf{delsecret});

    # sanity checks: external executables
    &bailout("bad executable '$newconf{mta}' -- exiting")
	if ($newconf{mta}=~/^(\S+)/ && ! -x $1);
    if ($newconf{secretondemand})
    {
	&bailout("bad executable '$newconf{getsecret}' -- exiting")
	    if ($newconf{getsecret} 
		&& $newconf{getsecret}=~/^(\S+)/ && ! -x $1);
	&bailout("bad executable '$newconf{delsecret}' -- exiting")
	    if ($newconf{delsecret} 
		&& $newconf{delsecret}=~/^(\S+)/ && ! -x $1);
    }
    &bailout("bad executable '$newconf{pgppath}' -- exiting")
	if ($newconf{usepgp} && $newconf{stdkey} ne "0" 
	    && (!$newconf{pgppath} || $newconf{pgppath}=~/^(\S+)/ && ! -x $1));
    &bailout("bad executable '$newconf{gpgpath}' -- exiting")
	if ($newconf{ngkey} ne "0" 
	    && ( !$newconf{gpgpath} || $newconf{gpgpath}=~/^(\S+)/ && ! -x $1));
    # figure out the default keys if none were supplied, check them
    if ($newconf{ngkey})
    {
	my $res=0xffff & system("$newconf{gpgpath} -q --batch --list-secret-keys --with-colons $newconf{ngkey} >$newconf{tempdir}/subproc 2>&1");
	bailout("bad ngkey spec '$newconf{ngkey}' -- exiting","$newconf{tempdir}/subproc") if ($res);
    }
    elsif (!defined $newconf{ngkey})
    {
	open(F,"$newconf{gpgpath} -q --batch --list-secret-keys --with-colons 2>$newconf{tempdir}/subproc |") || bailout("cant fork $newconf{gpgpath} to list sec keys: $! -- exiting");
	while (<F>)
d651 6
a656 6
	    my @@list=split(/:/);
	    next if ($list[0] ne "sec" || $list[3] ne "17");
	    $list[4] =~ s/^.{8}//;	# truncate key-id
	    $newconf{ngkey}="0x$list[4]";
	    $debug && logit("set ngkey to $newconf{ngkey}");
	    last;
a657 3
	close F;
	bailout("error running $newconf{gpgpath}: $? -- exiting","$newconf{tempdir}/subproc") if ($?);
	bailout("could not find ngkey -- exiting") if (!$newconf{ngkey});
d659 10
d670 1
a670 1
    if ($newconf{stdkey})
d672 8
a679 4
	if ($newconf{usepgp})
	{
	    my $res=0xffff & system("$newconf{pgppath} -kv $newconf{stdkey} $home/.pgp/secring.pgp >$newconf{tempdir}/subproc 2>&1");
	bailout("bad stdkey spec \"$newconf{stdkey}\" -- exiting","$newconf{tempdir}/subproc") if ($res);
d683 1
a683 3
	    my $res=0xffff & system("$newconf{gpgpath} -q --batch --list-secret-keys --with-colons $newconf{stdkey} >$newconf{tempdir}/subproc 2>&1");
	    bailout("bad stdkey spec \"$newconf{stdkey}\" -- exiting","$newconf{tempdir}/subproc")
		if ($res);
d686 1
a686 52
    elsif (!defined $newconf{stdkey})
    {
	if ($newconf{usepgp})
	{
	    open(F,"$newconf{pgppath} -kv $home/.pgp/secring.pgp 2>$newconf{tempdir}/subproc |") 
		|| bailout("cant fork $newconf{pgppath} to list sec keys: $! -- exiting");
	    while (<F>)
	    {
		if (/^sec\s+\d+\/(\S+)\s+/)
		{
		    $newconf{stdkey}="0x$1";
		    $debug && logit("set stdkey to $newconf{stdkey}");
		    last;
		}
	    }
	    close F;
	    bailout("error running $newconf{pgppath}: $? -- exiting","$newconf{tempdir}/subproc")
		if ($?);
	}
	else
	{
	    open(F,"$newconf{gpgpath} -q --batch --list-secret-keys --with-colons 2>$newconf{tempdir}/subproc|")
		|| bailout("cant run $newconf{gpgpath} to list sec keys: $! -- exiting","$newconf{tempdir}/subproc");
	    while (<F>)
	    {
		my @@list=split(/:/);
		next if ($list[0] ne "sec" || $list[3] ne "1");
		$list[4] =~ s/^.{8}//;	# truncate key-id
		$newconf{stdkey}="0x$list[4]";
		$debug && logit("set stdkey to $newconf{stdkey}");
		last;
	    }
	    close F;
	    bailout("error running $newconf{gpgpath}: $? -- exiting","$newconf{tempdir}/subproc")
		if ($?);
	}
	bailout("could not find stdkey -- exiting") if (!$newconf{stdkey});
    } 

    # finally make sure that no action conflicts with the keys we may lack
    bailout("no keys whatsoever a/v! -- exiting") if (!$newconf{stdkey} && !$newconf{ngkey});

    bailout("config specifies ng but no ng key a/v -- exiting")
	if (!$newconf{ngkey} && grep($_->{action} =~ /^ng/, @@over));
    bailout("config specifies std but no std key a/v -- exiting")
	if (!$newconf{stdkey} && grep($_->{action} =~ /^std/, @@over));

	
    # everything seems ok, overwrite global vars config and override 
    %config=%newconf;
    @@overrides=@@over;
    return;
d689 1
a689 1
# traverses the entity and sets all parts with
d692 1
a692 1
# input: entity, retval: none
a695 1

d700 2
a701 1
	    &qp_fix_parts($_);
d711 1
a711 1
	    bailout("changing Content-Transfer-Encoding failed")
d713 2
a714 1
					     => "quoted-printable")!="quoted-printable");
d717 14
d733 8
a740 21
# notifies the sender of a problem, via email
# retrieves the detailed error message from @@detailederror
# no return value, exception on problems
sub send_bounce
{
    my ($res,$file)=@@_;

    open(F,"|$config{mta} $username") || 
	bailout("cant fork $config{mta}: $! -- exiting");
    print F "From: $username\nTo: $username\nSubject: $progname Mail Sending Failure\n\n"
	."Your mail $config{queuedir}/$file could not be sent to some or all recipients.\n\n"
	."The error message was:\n\n$res\n\n\n";
    print F "Detailed error message:\n\n"
	.join("",@@detailederror)."\n\n\n" if (@@detailederror);
    print F "$progname has no reliable way of figuring out whether this failure did affect\n"
	."all recipients of your mail, so please look into the log for further error indications.\n\n"
	."$progname has backed the failed mail up as $config{queuedir}/.$file;\n"
	."If you wish to retry again for all original recipients, just rename the file back to\n"
	."$config{queuedir}/$file or otherwise remove the backup file.\n";
    close F;
    bailout("error running $config{mta}: $? -- exiting") if ($?);
d743 4
a746 37
 
# get, verify and store a secret
# input: what kind of secret
# retval: none, changes %secrets, exception on major errors 
# note: only used when secretondemand is unset.
sub get_secret
{
    my ($type)=@@_;
    my $id=$config{($type eq "std"?"stdkey":"ngkey")};
    my $res;
   
    do 
    {
	# do-it-yourself
	
	# the previous attempt failed...
	print "wrong passphrase, try again.\n"
	    if ($res);
	
	print "enter secret for key $id:\n";
	ReadMode("noecho");
	chomp (my $phrase=<STDIN>);
	ReadMode("restore");
	bailout("error reading $type passphrase: $!")
	    if (!defined($phrase));
	print "\n";
	$secrets{$id}=$phrase;
	$phrase="x" x 64; 
	$res=sign_encrypt(0,$type,undef,undef);
    }
    while ($res);
}

# sign/encrypt a file, or test the passphrase if infile and outfile are undef.
# input: encrypt, type std/ng, infile and outfile path, recipient keys if encrypt.
# returns: 0 if ok, 1 if bad passphrase,  exception on other errors
sub sign_encrypt
d748 5
a752 5
    my ($enc,$type,$infile,$outfile,@@recips)=@@_;
    my ($passphrase,$passphrase_cmd,$cmd);
        
    # passphrase issues
    if ($config{secretondemand})
d754 3
a756 2
	$cmd="|".sprintf($config{getsecret},
			 ($type eq "std"?$config{stdkey}:$config{ngkey}));
d758 41
a798 1
    else
d800 2
a801 2
	$passphrase=$secrets{$config{($type eq "std"?"stdkey":"ngkey")}};
    }
d803 1
a803 4
    # how to arrange the command
    if (!$enc)
    {
	if ($type eq "std" && $config{usepgp})
d805 13
a817 1
	    $cmd.="|PGPPASSFD=0 $config{pgppath} +batchmode -u $config{stdkey} -sbat";
d819 2
a820 1
	else
d822 34
a855 2
	    $cmd.="|$config{gpgpath} -q -t --batch --armor --detach-sign --passphrase-fd 0 --status-fd 1 --default-key";
	    if ($type eq "std")
d857 4
a860 1
		$cmd.=" $config{stdkey} --rfc1991 --cipher-algo idea --digest-algo md5 --compress-algo 1";
d862 55
a916 3
	    else
	    { 
		$cmd.=" $config{ngkey}";
d918 1
a918 10
	}
	
	# only check the passphrase: pgp needs -f(ilter) flag then
	if (!$infile && !$outfile)
	{
	    $cmd.=" -f" if ($type eq "std" && $config{usepgp});
	}
	else
	{
	    $cmd.=" -o $outfile $infile";
d921 23
a943 1
    else			# encrypt and sign
d945 43
a987 5
	if ($type eq "std" && $config{usepgp})
	{
	    $cmd.="|PGPPASSFD=0 $config{pgppath} +batchmode "
		."-u $config{stdkey} -seat -o $outfile $infile "
		.join(" ",@@recips);
d991 3
a993 2
	    # gpg: normal mode...
	    if ($type ne "std")
d995 11
a1005 5
		$cmd.="|$config{gpgpath} -q -t --batch --armor --passphrase-fd 0 "
		    ."--status-fd 1 --default-key $config{ngkey} -r "
		    .join(" -r ",@@recips)
		    .($config{alwaystrust}?" --always-trust":"")
		    ." --encrypt --sign -o $outfile $infile";
d1009 2
a1010 11
		# or compatibility-mode, bah
		
		# very elaborate but working procedure, found by
		# Gero Treuner <gero@@faveve.uni-stuttgart.de>
		# http://muppet.faveve.uni-stuttgart.de/~gero/gpg-2comp

		# first, generate the signature and store it
		$cmd.="|$config{gpgpath} --batch -q --detach-sign "
		    ."--default-key $config{stdkey} "
		    ."--passphrase-fd 0 --status-fd 1 -o $outfile $infile";
		# the rest is done later on
d1014 2
d1017 8
a1024 1
    $cmd.=" >$config{tempdir}/subproc 2>&1";
d1026 3
a1028 1
    unlink($outfile) if (-e $outfile);
d1030 21
a1050 10
    open(F,$cmd) || bailout("cannot open pipe $cmd: $!");
    print F "$passphrase\n" if ($passphrase);
    $passphrase="x" x 64;
    close F;

    # compatibility mode? there's more to do, unfortunately
    return 0
	if (!$? && !($enc && $type eq "std" && !$config{usepgp})) ;
    
    if ($?)
d1052 9
a1060 9
	# hmm, things went wrong: try to figure out what happened.
	# if it's just the passphrase, return 1.
	# if it's something else, bailout...won't get better with retries.
	
	# pgp's way of saying "bad passphrase".
	return 1 if ($type eq "std" && $config{usepgp} && ($?>>8) eq 20);
	
	# with gpg we'll have to look at the output
	if ($type eq "ng" || !$config{usepgp})
d1062 4
a1065 5
	    open F,"$config{tempdir}/subproc";
	    my @@result=<F>;
	    close F;
	
	    return 1 if (grep(/^\[GNUPG:\] BAD_PASSPHRASE/,@@result));
a1066 4
    
	bailout("error running sign prog: $?","$config{tempdir}/subproc") if ($? == 0xff00);
	bailout("sign prog died from signal " . ($? & 0x7f),"$config{tempdir}/subproc") if ($? <= 0x80);
	bailout(("sign prog returned error ".($?>>8)),"$config{tempdir}/subproc") if ($?>>8);
d1068 15
d1084 12
a1095 1
    # ok, must be in compat mode...let's complete the nasty construction
d1097 8
a1104 46
    # next, convert the cleartext to the internal literal structure
    unlink("$outfile.inter1") if (-e "$outfile.inter1");
    my $res=0xffff
	    & system("$config{gpgpath} --batch -q --store --batch -z 0 -o $outfile.inter1 "
		     ."$infile >$config{tempdir}/subproc 2>&1");
    bailout("error running gpg","$config{tempdir}/subproc") if ($res);
    
    # now compress signature and literal in the required order
    open(F,"$outfile") || bailout("cant open $outfile: $!");
    open(G,"$outfile.inter1") || bailout("cant open $outfile.inter1: $!");
    
    unlink("$outfile.inter2") if (-e "$outfile.inter2");;
    open(H,"|$config{gpgpath} --no-literal --store --batch  --compress-algo 1 "
	 ."-o $outfile.inter2 >$config{tempdir}/subproc 2>&1")
	|| bailout("cant open pipe to $config{gpgpath}: $!");
    print H <F>;
    print H <G>;
    close F;
    close G;
    close H;
    bailout("error running $config{gpgpath}: $?","$config{tempdir}/subproc") if ($?);
	    
    # and finally encrypt all this for the wanted recipients.
    unlink($outfile);
    $cmd="$config{gpgpath} --no-literal --batch --encrypt --rfc1991 --cipher-algo idea "
	.($config{alwaystrust}?"--always-trust ":"")
	."--armor -o $outfile -r "
	.join(" -r ",@@recips)
	." $outfile.inter2 >$config{tempdir}/subproc 2>&1";

    $res=0xffff & system($cmd);
    bailout("error running $config{gpgpath}: $res","$config{tempdir}/subproc") if ($res);
    return 0;
}

# find the correct action for a given email address
# input: addresses and custom-header, bcc-addresses
# result: hash with address as key and action as value
# the fallback and -force options are expanded into atoms, ie.
# resulting actions are: ng, ngsign, std, stdsign, none,
# or bcc-{ng,std}.
# note: ng and std means encryption here, no check for keys necessary anymore
sub findaction    
{
    my ($custom,$allref,$bccref)=@@_;
    my(@@affected,%actions,$addr);
d1106 1
a1106 2
    # lookup addresses in configured overrides
    foreach $addr (@@{$allref},@@{$bccref})
d1108 8
a1115 1
	foreach (@@overrides)
d1117 10
a1126 1
	    if ($addr =~ $_->{re})
d1128 2
a1129 2
		$actions{$addr}=$_->{action};
		$debug && logit("found directive: $addr -> $actions{$addr}");
d1133 1
a1133 8
	# custom set? then override the config except where action=none
	if ($custom && $actions{$addr} ne "none")
	{
	    $debug && logit("custom conf header: overrides $addr -> $custom");
	    $actions{$addr}=$custom;
	    next;
	}
	&bailout("internal error, no action found for $addr") if (!exists $actions{$addr});
d1135 1
d1137 3
a1139 2
    # no -force options for bcc
    foreach $addr (@@{$bccref})
d1141 1
a1141 1
	$actions{$addr}=~s/^(\S+)-force$/$1/;
d1143 1
a1143 4

    # check the found actions: anyone with -force options?
    # note: normal addresses only, bcc don't count here
    foreach $addr (@@{$allref})
d1145 2
a1146 12
	next if ($actions{$addr} !~ /^(\S+)-force$/);
	my $force=$1;
	$debug && logit("found force directive: $addr -> $actions{$addr}");

	# yuck, must find affected addresses: those with action=none
	# have to be disregarded and unchanged.
	
	@@affected = grep($actions{$_} ne "none",@@{$allref});

	# (almost) unconditionally apply the simple force options:
	# none,ngsign,stdsign; others need more logic
	if ($force eq "std")
d1148 5
a1152 2
	    # downgrade to sign if not all keys a/v
	    $force="stdsign" if (grep(!exists $keys{std}->{$_}, @@affected));
d1154 1
a1154 5
	elsif ($force eq "ng")
	{
	    $force="ngsign" if (grep(!exists $keys{ng}->{$_}, @@affected));
	}
	elsif ($force eq "fallback")
d1156 2
a1157 6
	    # fallback-logic: ng-crypt or std-crypt, otherwise ngsign or stdsign
	    # -force: ng- or std-crypt for all, otherwise ngsign or stdsign
	    $force="ngsign" 	
		if (grep(!exists $keys{ng}->{$_} 
			 && !exists $keys{std}->{$_}, @@affected));
	}
d1159 33
a1191 5
	# apply forced action to the affected addresses
	map { $actions{$_}=$force; } (@@affected);	 
	$debug && logit("final force directive: $force");
	# the first force-option wins, naturally.
	last;
d1193 9
d1203 1
a1203 3
    # check the actions for fallback, ng or std and expand that
    # also bail out if no suitable keys available!
    foreach $addr (@@{$allref},@@{$bccref})
d1205 1
a1205 1
	if ($actions{$addr} eq "fallback")
d1207 2
a1208 5
	    ($config{ngkey} && $keys{ng}->{$addr} && ($actions{$addr}="ng")) 
		|| ($config{stdkey} && $keys{std}->{$addr} && ($actions{$addr}="std"))
		|| ($config{ngkey} && ($actions{$addr}="ngsign"))
		|| ($config{stdkey} && ($actions{$addr}="stdsign"))
		|| &bailout("oooops. no keys available for fallback action for $addr");
a1209 11
	elsif ($actions{$addr} =~ /^ng(sign)?$/)
	{
	    bailout("no ng key available but ng action required for $addr") 
		if (!$config{ngkey});
	    $actions{$addr}="ngsign" if ($actions{$addr} eq "ng" && !$keys{ng}->{$addr});
	} 
	elsif ($actions{$addr} =~ /^std(sign)?$/)
	{
	    bailout("no std key available but std action required for $addr") 
		if (!$config{stdkey});
	    $actions{$addr}="stdsign" if ($actions{$addr} eq "std" && !$keys{std}->{$addr});
d1211 1
a1211 2
	} 
	$debug && logit("final action: $addr -> $actions{$addr}");
d1214 1
a1214 3
    # tag ng and std actions for bcc recipients:
    # those must be handled separately (separate encryption step...)
    foreach $addr (@@{$bccref})
d1216 4
a1219 1
	$actions{$addr}=~s/^(ng|std)$/bcc-$1/;
a1220 1
    return %actions;
d1223 9
a1231 6
# logging and dying with a message
# does not return
# if barfmail is set, then a mail with the log information is sent (message and detailfn-content)
# args: the message to spit out, path to a file with details.
# the details from the file are logged only, not printed in the die-message
sub bailout
d1233 4
a1236 3
    my ($msg,$detailfn)=@@_;

    if ($detailfn && open(DF,$detailfn))
d1238 1
a1238 2
	push @@detailederror,<DF>;
	close DF;
d1240 3
d1244 6
a1249 16
    if ($barfmail)
    {
	# i'd like to call bailout without looping.
	my $oldbarfmail=$barfmail;
	$barfmail=0;	
	my $mta=$config{mta}||"/usr/lib/sendmail"; # this could run before the config is read
	open (F,"|$mta $username") || 
	    bailout("cant fork $mta: $!");
	print F "From: $username\nTo: $username\nSubject: $progname General Failure\n\n"
	    ."$progname has encountered a serious/fatal failure.\n\n"
	    ."The error message was:\n\n$msg\n\n\n";
	print F "Detailed error message:\n\n"
	    .join("",@@detailederror)."\n\n\n" if (@@detailederror);
	close F;
	bailout("error running $mta: $?") if ($?);
	$barfmail=$oldbarfmail;
d1251 8
d1260 4
a1263 2
    logit($msg,$detailfn);
    die($msg."\n");
d1266 24
d1291 1
a1291 5
# log the msg(s) to syslog or the logfile
# the detailed info is put into @@detailederror
# args: message, path to file with details
# no retval.
sub logit
d1293 3
a1295 1
    my ($msg,$detailfn)=@@_;
d1297 4
a1300 1
    if ($detailfn)
d1302 1
a1302 6
	@@detailederror=();
	if (open(DF,$detailfn))
	{
	    push @@detailederror,<DF>;
	    close DF;
	}
d1304 13
d1318 3
a1320 1
    if ($config{logfh})
d1322 2
a1323 4
	# logfile is opened with autoflush set to 1, 
	# so no extra flushing needed
	# we're more or less emulating the syslog format here...
	print { $config{logfh} } scalar(localtime)." $progname\[$$\] $msg\n";
d1325 30
a1354 1
    else
d1356 2
a1357 4
	setlogsock('unix');
	openlog($progname,"pid,cons","mail");
	syslog("notice",$msg);
	closelog;
d1359 2
d1363 3
d1367 552
a1918 1
&main;
@


2.15
log
@no more use_agent, client_path config
added getsecret and delsecret config options
@
text
@d23 1
a23 1
#   $Id: kuvert,v 2.14 2005/02/25 22:09:21 az Exp az $
d417 1
a417 1
		    Filename => undef,
d419 1
@


2.14
log
@fixed calling setup of mta: no more shell intervention
@
text
@d7 1
a7 1
# copyright (c) 1999-2003 Alexander Zangerl <az@@snafu.priv.at>
d23 1
a23 1
#   $Id: kuvert,v 2.13 2003/08/03 02:06:53 az Exp az $
d34 1
d46 1
a46 1
# the passphrases are stored here if agent is not a/v
d51 3
a56 1
    my $pidf=($ENV{'TMPDIR'}?$ENV{'TMPDIR'}:"/tmp")."/kuvert.pid.$<";
d85 1
a85 1
	open(PIDF,"$pidf") || &bailout("cant open $pidf: $! -- exiting");
a93 1
	unlink $pidf if ($options{"k"});
a107 16
    # retain content of pidf, in case we cant lock it 
    if (-f "$pidf")			
    {
	open(PIDF,"+<$pidf") || &bailout("cant open <+$pidf: $! -- exiting");
    }
    else
    {
	open(PIDF,">$pidf") || &bailout("cant open >$pidf: $! -- exiting");
    }
    my $other=<PIDF>;
    chomp $other;
    logit("there seems to be another instance with PID $other") if ($other);
    &bailout("cant lock $pidf ($!) -- exiting.")
	if (!flock(PIDF,LOCK_NB|LOCK_EX));
    seek(PIDF,0,'SEEK_SET');

a111 2
    # make things clean and ready
    cleanup($config{tempdir},0);
d113 2
a114 40
    # get the passphrase(s) and setup secret-agent if wanted
    # this has to be done before any fork, because the environment
    # vars for secret-agent must be retained

    # if use_agent is set, check if the agent is running and start one
    # if needed.
    if ($config{use_agent})
    {
	# not running? start a personal instance
	# and remember its pid
	if (!$ENV{"AGENT_SOCKET"})
	{
	    # start your own agent process
	    # and remember its pid
	    $config{private_agent}=open(SOCKETNAME,"-|");
	    bailout("cant fork agent: $! -- exiting") 
		if (!defined $config{private_agent});
	    if ($config{private_agent})	# original process
	    {
		# get the socketname
		my $res=<SOCKETNAME>;
		# and set the correct env variable for client
		$res=~/^AGENT_SOCKET=\'(.+)\';/;
		$ENV{"AGENT_SOCKET"}=$1;
		# do not close the pipe, because then the
		# parent process tries to wait() on the child,
		# which wont work here
		$debug 
		    && &logit("forked secret-agent pid $config{private_agent},"
			      ."socket is $1");
	    }
	    else
	    {
		# the child that should exec the quintuple-agent
		exec "$config{agentpath}"
		    || &bailout("cant exec $config{agentpath}: $! -- exiting");
	    }
	}
    }
    
a122 1

d132 7
a138 5
    # the lockfile is ours, lets write the current pid
    print PIDF "$$\n";
    PIDF->flush;
    truncate PIDF,tell(PIDF);	# and make sure there's nothing else in there...
    # now read the keyrings
d399 1
a399 1
	if ($config{use_agent})
d402 3
a404 3
	    my $res=0xffff & system("$config{clientpath} delete "
				    .$config{$type."key"}." >$config{tempdir}/subproc 2>&1");
	    bailout("error deleting broken passphrase from agent: $res",
d411 1
a411 1
	    bailout("bad passphrase, but no passphrase agent to query!");
d457 1
a457 1
	if ($config{use_agent})
d460 3
a462 3
	    my $res=0xffff & system("$config{clientpath} delete "
				    .$config{$type."key"}." >$config{tempdir}/subproc 2>&1");
	    bailout("error deleting broken passphrasee from agent: $res",
d469 1
a469 1
	    bailout("bad passphrase, but no passphrase agent to query!");
d537 1
a537 1
    if ($config{use_agent})
d539 1
a539 1
	if ($config{private_agent})
d541 5
a545 15
	    # kill the private agent process
	    $res = kill('TERM',$config{private_agent});
	    &logit("problem killing $config{private_agent}: $!") if (!$res);
	    wait;
	}
	else
	{
	    foreach ($config{ngkey},$config{stdkey})
	    {
		next if (!$_);
		my $res=0xffff & system "$config{clientpath} delete $_";
		&logit("problem deleting secret for $_: $res")
		    if ($res);
	    }
	    
d765 2
a766 4
		 use_agent=>0,
		 private_agent=>0,
		 clientpath=>undef,
		 agentpath=>undef,
d873 3
d880 9
a888 5
    &bailout("bad agent-executable '$newconf{agentpath}' -- exiting")
 	if ($newconf{agentpath} 
 	    && $newconf{agentpath}=~/^(\S+)/ && ! -x $1);
    &bailout("bad client-executable '$newconf{clientpath}' -- exiting")
	if ($newconf{clientpath} && $newconf{clientpath}=~/^(\S+)/ && ! -x $1);
a894 5
        
    $newconf{use_agent}=$newconf{clientpath} && $newconf{agentpath};
    # secret on demand is only possible with agent *and* X11
    $newconf{secretondemand}=0 if (!$newconf{use_agent} || !$ENV{DISPLAY});

d1051 15
a1065 39
	if ($config{use_agent})
	{
	    # cleanup possible previous blunder
	    if ($res)
	    {
		$res=0xffff & system("$config{clientpath} delete $id >$config{tempdir}/subproc 2>&1");
		bailout("error deleting $id from agent: $res/$!","$config{tempdir}/subproc")
		    if ($res);
	    }

	    # if we have a display, we can use the demand-query option of
	    # client get, otherwise we use client put.
	    # the display-situation is covered by sign() itself.
	    if (!$ENV{DISPLAY})
	    {
		$res = 0xffff & system("$config{clientpath} put $id >$config{tempdir}/subproc 2>&1");
		bailout("error running client storing $type passphrase: $res/$!",
			"$config{tempdir}/subproc")
		    if ($res);
	    }
	}
	else 
	{
	    # do-it-yourself
	    
	    # the previous attempt failed...
	    print "wrong passphrase, try again.\n"
		if ($res);
	    
	    print "enter secret for key $id:\n";
	    ReadMode("noecho");
	    chomp (my $phrase=<STDIN>);
	    ReadMode("restore");
	    bailout("error reading $type passphrase: $!")
		if (!defined($phrase));
	    print "\n";
	    $secrets{$id}=$phrase;
	    $phrase="x" x 64; 
	}
d1080 1
a1080 1
    if ($config{use_agent})
d1082 2
a1083 2
	$cmd="|$config{clientpath} get ".
	    ($type eq "std"?$config{stdkey}:$config{ngkey});
@


2.13
log
@added auto-generation of blank .kuvert file
@
text
@d23 1
a23 1
#   $Id: kuvert,v 2.12 2003/08/03 01:45:37 az Exp az $
d545 12
a556 5
    open(TOMTA,("|$config{mta} ".join(" ",@@args)))
	|| bailout("cant open pipe to $config{mta}: $!");
    $ent->print(\*TOMTA);
    close(TOMTA);
    bailout("error running $config{mta}: $?") if ($?);
@


2.12
log
@fixed bad bug with mixture of raw and encrypted mails (headers were lost)
@
text
@d23 1
a23 1
#   $Id: kuvert,v 2.11 2003/04/25 07:52:15 az Exp az $
d95 10
a104 2
    &bailout("no configuration file \"$rcfile\" -- exiting")
	if (! -r $rcfile);
@


2.11
log
@fixed duplicate mail issues
@
text
@d23 1
a23 1
#   $Id: kuvert,v 2.10 2003/02/22 04:57:58 az Exp az $
d321 8
d375 1
a375 1
    foreach my $action qw(none ng ngsign std stdsign bcc-ng bcc-std)
a379 6
	if ($action eq "none")
	{
	    logit("sending mail (raw) to ".join(",",@@recips));
	    &send_entity($in_ent,@@recips);
	    next;
	}
@


2.10
log
@fixed typo
@
text
@d7 1
a7 1
# copyright (c) 1999-2001 Alexander Zangerl <az@@snafu.priv.at>
d23 1
a23 1
#   $Id: kuvert,v 2.9 2003/02/21 11:41:06 az Exp az $
d218 1
d220 1
d223 1
a223 1
		chomp $@@;
d227 2
a228 3
		logit("problem \"$@@\" while processing $file,"
		      ." left as \".$file\".\n");
		send_bounce($@@,$file);
d1071 6
a1076 6
	."Your mail $config{queuedir}/$file could not be sent to some or all recipients.\n"
	."The error message was:\n-----\n$res\n-----\n\n";
    print F "Detailed error message:\n-----\n"
	.join("",@@detailederror)."\n-----\n\n" if (@@detailederror);
    print F "$progname has no reliable way of figuring out whether this failure was partial\n"
	."or total, so please look into the log for further error indications.\n\n"
d1426 6
a1436 7
	my @@detailederror=();
	if (open(DF,$detailfn))
	{
	    push @@detailederror,<DF>;
	    close DF;
	}
	
d1442 3
a1444 3
	    ."The error message was:\n-----\n$msg\n-----\n\n";
	print F "Detailed error message:\n-----\n"
	    .join("",@@detailederror)."\n-----\n\n" if (@@detailederror);
@


2.9
log
@added x-mailer option
@
text
@d23 1
a23 1
#   $Id: kuvert,v 2.8 2003/02/16 13:42:10 az Exp az $
d271 1
a271 1
    $in_ent->head->add('X-mailer',"$progname $version")
d822 1
a822 1
		 identify=0);
@


2.8
log
@added -b option
@
text
@d23 1
a23 1
#   $Id: kuvert,v 2.7 2003/02/08 13:09:39 az Exp az $
d270 4
d821 2
a822 1
		 logfh=>undef);
@


2.7
log
@more pidfile fixing
@
text
@d23 1
a23 1
#   $Id: kuvert,v 2.6 2003/02/08 13:08:06 az Exp az $
d47 1
a47 1
my $debug=0;
d55 1
a55 1
    if (!getopts("dkrnv",\%options) || @@ARGV)
d57 1
a57 1
	print "usage: $progname [-n] [-d] [-v] | [-k] | [-r] 
d62 2
a63 2
-v: output version and exit";
	exit 1;
d73 1
d82 1
a82 1
	open(PIDF,"$pidf") || &bailout("cant open $pidf: $!");
d87 1
a87 1
	&bailout("no valid pid found, cant kill any process.")
d89 1
a89 1
	&bailout("cant kill -$sig $pid: $!")
d95 1
a95 1
    &bailout("no configuration file \"$rcfile\", can't start!")
d101 1
a101 1
	open(PIDF,"+<$pidf") || &bailout("cant open <+$pidf: $!");
d105 1
a105 1
	open(PIDF,">$pidf") || &bailout("cant open >$pidf: $!");
a108 1
    seek(PIDF,0,'SEEK_SET');
d110 1
a110 1
    &bailout("cant lock $pidf ($!), exiting.")
d112 1
d136 1
a136 1
	    bailout("cant fork agent: $!") 
d156 1
a156 1
		    || &bailout("cant exec $config{agentpath}: $!");
d174 1
a174 1
	&bailout("fork failed: $!")
d197 1
a197 1
	&bailout("cant open $config{queuedir}: $!")
d224 1
a224 1
		    || &bailout("cant rename $config{queuedir}/$file: $!");
d233 1
a233 1
		    || &bailout("cant unlink $config{queuedir}/$file: $!");
d239 1
a239 1
	    bailout("problem unlocking $config{queuedir}/$file: $!")
d802 16
a817 16
	      stdkey=>undef,
	      pgppath=>"/usr/bin/pgp",
	      gpgpath=>"/usr/bin/gpg",
	      usepgp=>0,
	      use_agent=>0,
	      private_agent=>0,
	      clientpath=>undef,
	      agentpath=>undef,
	      mta=>"/usr/lib/sendmail -om -oi -oem",
	      secretondemand=>0,
	      alwaystrust=>0,
	      interval=>60,
	      tempdir=>($ENV{'TMPDIR'}?$ENV{'TMPDIR'}:"/tmp")."/kuvert.$username.$$",
	      queuedir=>"$home/.kuvert_queue",
	      logfile=>undef,
	      logfh=>undef);
d819 1
a819 1
    &bailout("cant open $rcfile: $!")
d854 1
a854 1
		&bailout("bad config entry \"$_\"");
d859 1
a859 1
	    &bailout("bad config entry \"$_\"");
d873 1
a873 1
	&bailout("cant mkdir $newconf{queuedir}: $!")
d879 1
a879 1
	&bailout("$newconf{queuedir} is not owned by you - refusing to run");
d883 1
a883 1
	&bailout("$newconf{queuedir} does not have mode 0700 - refusing to run");
d892 1
a892 1
	    &bailout("cant mkdir $newconf{tempdir}: $!");
d897 1
a897 1
	&bailout("$newconf{tempdir} is not owned by you - refusing to run");
d901 1
a901 1
	&bailout("$newconf{tempdir} does not have mode 0700 - refusing to run");
d910 1
a910 1
	&bailout("cant open logfile $newconf{logfile}: $!")
d939 1
a939 1
	bailout("bad ngkey spec '$newconf{ngkey}'","$newconf{tempdir}/subproc") if ($res);
d943 1
a943 1
	open(F,"$newconf{gpgpath} -q --batch --list-secret-keys --with-colons 2>$newconf{tempdir}/subproc |") || bailout("cant fork $newconf{gpgpath} to list sec keys: $!");
d954 2
a955 2
	bailout("error running $newconf{gpgpath}: $?","$newconf{tempdir}/subproc") if ($?);
	bailout("could not find ngkey") if (!$newconf{ngkey});
d963 1
a963 1
	bailout("bad stdkey spec \"$newconf{stdkey}\"","$newconf{tempdir}/subproc") if ($res);
d968 1
a968 1
	    bailout("bad stdkey spec \"$newconf{stdkey}\"","$newconf{tempdir}/subproc")
d977 1
a977 1
		|| bailout("cant fork $newconf{pgppath} to list sec keys: $!");
d988 1
a988 1
	    bailout("error running $newconf{pgppath}: $?","$newconf{tempdir}/subproc")
d994 1
a994 1
		|| bailout("cant run $newconf{gpgpath} to list sec keys: $!\n","$newconf{tempdir}/subproc");
d1005 1
a1005 1
	    bailout("error running $newconf{gpgpath}: $?","$newconf{tempdir}/subproc")
d1008 1
a1008 1
	bailout("could not find stdkey") if (!$newconf{stdkey});
d1012 1
a1012 1
    bailout("no keys whatsoever a/v!") if (!$newconf{stdkey} && !$newconf{ngkey});
d1014 1
a1014 1
    bailout("config specifies ng but no ng key a/v")
d1016 1
a1016 1
    bailout("config specifies std but no std key a/v")
d1063 1
a1063 1
	bailout("cant fork $config{mta}: $!");
d1075 1
a1075 1
    bailout("error running $config{mta}: $?") if ($?);
d1413 1
d1420 25
d1448 1
@


2.6
log
@pidfile in $TMPDIR if available
@
text
@d23 1
a23 1
#   $Id: kuvert,v 2.5 2003/02/05 22:45:39 az Exp az $
d107 1
@


2.5
log
@fixed duplicate entries in pidfile
@
text
@d23 1
a23 1
#   $Id: kuvert,v 2.4 2003/01/21 12:27:01 az Exp az $
d53 1
a53 1
    my $pidf="/tmp/kuvert.pid.$<";
@


2.4
log
@testing done. some minor fixes were necessary, but things got more reliable as
well. more side-effect testing was done.
@
text
@d23 1
a23 1
#   $Id: kuvert,v 2.3 2003/01/15 22:57:54 az Exp az $
d107 1
@


2.3
log
@fixed signing hoppala
@
text
@d23 1
a23 1
#   $Id: kuvert,v 2.2 2003/01/15 15:03:03 az Exp az $
d48 1
d218 2
d222 1
a222 1
		logit("problem \"$@@\" processing $file,"
d380 1
a380 1
		&crypt_send($in_ent,$input,$type,$orig_header,$keys{$type}->{$_},$_);
d439 1
a439 1
	    bailout("error deleting broken passphrasee from agent: $res",
d688 7
a694 1
		&logit("ignoring stdkey 0x$info[4]") if ($debug);
d1053 1
d1063 4
a1066 2
	."The error message was:\n\n$res\n\n"
	."$progname has no reliable way of figuring out whether this failure was partial\n"
d1122 1
a1122 1
		if (eof(STDIN));
d1148 1
a1148 1
	$passphrase=$secrets{($type eq "std"?"stdkey":"ngkey")};
d1251 1
a1251 1
	bailout("sign prog returned error ".$?>>8,"$config{tempdir}/subproc") if ($?>>8);
d1357 2
a1358 2
	    # fallback-logic: ng-crypt or std-crypt, otherwise ngsign
	    # -force: ng- or std-crypt for all, otherwise ngsign
d1372 1
d1377 11
a1387 7
	    ($keys{ng}->{$addr} && ($actions{$addr}="ng")) 
		|| ($keys{std}->{$addr} && ($actions{$addr}="std"))
		|| ($actions{$addr}="ngsign");
	}
	elsif ($actions{$addr} eq "ng")
	{
	    $actions{$addr}="ngsign" if (!$keys{ng}->{$addr});
d1389 1
a1389 1
	elsif ($actions{$addr} eq "std")
d1391 4
a1394 1
	    $actions{$addr}="stdsign" if (!$keys{std}->{$addr});
d1421 1
a1426 1
    my @@lotsaoutput=($msg);
d1430 1
a1430 1
	push @@lotsaoutput,"Details:";
d1433 1
a1433 1
	    push @@lotsaoutput,<DF>;
d1443 1
a1443 4
	foreach (@@lotsaoutput)
	{
	    print { $config{logfh} } scalar(localtime)." $progname\[$$\] $_\n";
	}
d1449 1
a1449 4
	foreach (@@lotsaoutput)
	{
	    syslog("notice",$_);
	}
@


2.2
log
@lotsa small and medium bugs removed
pgp/gpg interaction tested, works everywhere. agent-related passphrase handling works perfectly

todo: test findaction, test signonly, !secretondemand, !agent
check errormsg in send bounce (incomplete)
@
text
@d23 1
a23 1
#   $Id: kuvert,v 2.1 2003/01/12 15:21:03 az Exp az $
d448 1
a448 1
		    Path => "output",
d1148 1
a1148 1
	    $cmd.="|$config{gpgpath} -q -t --batch --armor --passphrase-fd 0 --status-fd 1 --default-key";
d1423 4
a1426 1
	map { print $config{logfh} (scalar(localtime)." $progname\[$$\] $_\n"); } (@@lotsaoutput);
d1432 4
a1435 1
	map { syslog("notice",$_); } (@@lotsaoutput);
@


2.1
log
@fixed bugs in config and keyring reading
@
text
@d23 1
a23 1
#   $Id: kuvert,v 2.0 2003/01/12 14:05:48 az Exp az $
d218 1
a218 1
		    && &bailout("cant rename $config{queuedir}/$file: $!");
d227 1
a227 1
		    && &bailout("cant unlink $config{queuedir}/$file: $!");
d359 1
d430 15
a444 2
	# unless we can't query for the passphrase...
	bailout("bad passphrase, but no passphrase agent to query!") if (!$config{secretondemand});
d488 15
a502 2
	# unless we can't query for the passphrase...
	bailout("bad passphrase, but no passphrase agent to query!") if (!$config{secretondemand});
d601 1
a601 1
    my ($lastkey,@@tmp,$name,$now,@@info);
d606 1
a606 1
    if ($config{use_pgp})
d608 5
a612 10
	logit("reading std keyring.");
	$now=time;

	#get the keys and dump the trailer and header lines
	# this does not care if pgp is not existent...but then, we're not
	# needing the pgp keyring
	@@tmp=`$config{pgppath} -kv 2>$config{tempdir}/subproc`;
	bailout("failure reading keyring with $config{pgppath}: $?",
		"$config{tempdir}/subproc") if ($?);
	foreach (@@tmp)
d614 10
a623 1
	    if (/^pub\s+\d+\/(\S+)\s+(.+)$/)
d625 1
a625 3
		my ($key,$userspec)=($1,$2);
		
		if ($userspec =~ /<?([^\s<]+\@@[^\s>]+)>?/)
d627 24
a650 12
		    $name=lc($1);
		}
		else
		{
		    undef $name;
		}
		
		if ($name)
		{
		    $keys{std}->{$name}="0x$key";
		    $lastkey=$key;
		    &logit("got stdkey 0x$key for $name") if ($debug);
d652 1
a652 1
		else
d654 3
a656 3
		    $lastkey=$key;
		    &logit("saved stdkey 0x$key, no address known yet")
			if ($debug);
a657 7
		next;
	    }
	    if (/^\s+.*<?([^\s<]+\@@[^\s>]+)>?\s*$/)
	    {
		my $name=lc($1);
		$keys{std}->{$name}="0x$lastkey";
		&logit("got stdkey (uid) 0x$lastkey for $name") if ($debug);
a659 1
	logit("reading ng keyring.");
a660 1
    logit("reading combined keyring.") if (!$config{use_pgp});
a662 24
    
    # this does not care if gpg is not existent...but then, we're not
    # needing the gpg keyring
    @@tmp=`$config{gpgpath} -q --batch --list-keys --with-colons --no-expensive-trust-checks 2>$config{tempdir}/subproc`;
    bailout("failure reading keyring with $config{gpgpath}: $?",
	    "$config{tempdir}/subproc") if ($?);
    foreach (@@tmp)
    {
	@@info=split(/:/);
	# only public keys and uids are of interest
	next if ($info[0] ne "pub" && $info[0] ne "uid");

	$info[4] =~ s/^.{8}//;	# truncate key-id

	# rsa-keys only if !$use_pgp
	# and be sure to skip these uid's, too
	if ($config{use_pgp} && $info[3] eq "1")
	{
	    &logit("ignoring stdkey 0x$info[4]") if ($debug);
	    undef $lastkey;
	    next;
	}
	
	$info[9] =~ s/\\x3a/:/g; # re-insert colons, please
d664 10
a673 5
	# remember the email address
	# if no address given: remember this key 
	# but go on to the uid's to get an email address to
	# work with
	if ($info[9] =~ /<?([^\s<]+\@@[^\s>]+)>?/)
d675 22
a696 15
	    $name=lc($1);
	}
	else
	{
	    undef $name;
	}
	
	# check the key: public part or uid?
	if ($info[0] eq "pub")
	{
	    # lets associate this key with the current email address
	    # if an address is known
	    $lastkey=$info[4];

	    if ($name)
d698 1
a698 14
		# ignore expired, revoked and other bad keys
		if (defined $badcauses{$info[1]})
		{
		    &logit("ignoring ".($info[3]==1?"std":"ng")
			   ." key 0x$info[4], reason: "
			   .$badcauses{$info[1]});
		    next;
		}

		$keys{ng}->{$name}="0x$lastkey";
		
		&logit("got ".($info[3]==1?"std":"ng")
		       ." key 0x$lastkey for $name")
		    if ($debug);
d702 1
a702 3
		&logit("saved ".($info[3]==1?"std":"ng")
		       ." key 0x$lastkey, no address known yet")
		    if ($debug);
d704 3
a706 15
	    next;
	}
	else
	{
	    # uid: associate the current address with the key 
	    # given in the most recent public key line
	    # if no such key saved: the pub key was an rsa key &
	    # we're set to ignore those
	    if (!$lastkey)
	    {
		$name="<no valid address>" if (!$name);
		&logit("ignoring uid $name, belongs to std key?")
		    if ($debug);
	    }
	    else
d708 5
d719 2
a720 2
			       ." uid $name for 0x$lastkey, "
			       ."reason: ".$badcauses{$info[1]});
d723 4
a726 4

		    $keys{ng}->{$name}="0x$lastkey";
		    &logit("got ".($info[3]==1?"std":"ng")
			   ." key (uid) 0x$lastkey for $name")
d731 15
a745 1
		    &logit("ignoring uid without valid address")
d748 23
d774 4
d842 1
a842 1
		logit("ignoring unknown config entry \"$_\"");
d845 4
d907 5
a911 5
    (logit("bad agent-executable '$newconf{agent}', disabling agent support"),
     $newconf{agentpath}=0) if ($newconf{agentpath} 
				&& $newconf{agentpath}=~/^(\S+)/ && ! -x $1);
    (logit("bad client-executable '$newconf{clientpath}', disabling agent support"),
     $newconf{clientpath}=0) if ($newconf{clientpath} && $newconf{clientpath}=~/^(\S+)/ && ! -x $1);
d931 1
a931 1
	open(F,"$newconf{gpgpath} -q --batch --list-secret-keys --with-colons 2>$newconf{tempdir}/subproc |") || bailout("cant run $newconf{gpgpath} to list sec keys: $!","$newconf{tempdir}/subproc");
d935 2
a936 1
	    next if ($list[0] ne "sec" || $list[3] ne "1");
d942 1
d950 1
a950 1
	    my $res=0xffff & system("$newconf{pgppath} -kv $newconf{stdkey} $home/.pgp/secring.pgp 2>$newconf{tempdir}/subproc");
a955 1
	    # fixme: output gpg result
d965 1
a965 1
		|| bailout("cant run $newconf{pgppath} to list sec keys: $!","$newconf{tempdir}/subproc");
d976 2
d986 2
a987 1
		next if ($list[0] ne "sec" || $list[3] ne "17");
d993 2
d1000 2
d1006 1
d1060 1
d1081 1
a1081 1
		$res=0xfff & system("$config{clientpath} delete $id >$config{tempdir}/subproc 2>&1");
a1126 11

    if ($enc)
    {
	# some sanity checking
	bailout("empty recipient list passed") if (!@@recips);
	foreach (@@recips)
	{
	    bailout("oops. unknown encryption key $_")
		if (!$keys{$type}->{$_});
	}
    }
d1174 1
a1174 1
		."-u $config{stdkey} -seat -o $outfile $infile"
d1207 1
a1207 1
    unlink($outfile) if ($outfile);
d1233 2
a1234 3
	    
	    return 1 
		if (grep(/^\[GNUPG:\] BAD_PASSPHRASE/,@@result));
d1245 1
a1245 1
    unlink("$outfile.inter1");
d1247 1
a1247 1
	    & system("$config{gpgpath} --batch -q --store -z 0 -o $outfile.inter1 "
d1255 2
a1256 2
    unlink("$outfile.inter2");
    open(H,"|$config{gpgpath} --no-literal --store --compress-algo 1 "
d1264 1
a1264 1
    bailout("error $? running gpg","$config{tempdir}/subproc") if ($?);
d1267 2
a1268 1
    $cmd="$config{gpgpath} --no-literal --encrypt --rfc1991 --cipher-algo idea "
d1275 1
a1275 1
    bailout("error $res running gpg","$config{tempdir}/subproc") if ($res);
d1310 1
a1310 2
	# apply default if necessary
	$actions{$addr}=$config{"default"} if (! exists $actions{$addr});
d1413 3
a1415 6
	   foreach (<DF>) 
	   {
	       push @@lotsaoutput,$_;
	   }
	   close DF;
       }
@


2.0
log
@first non-syntax errored version of kuvert 1.1.0
no testing done yet, though
@
text
@d23 1
a23 1
#   $Id: kuvert,v 1.27 2002/10/27 13:45:50 az Exp az $
d151 2
a152 2
		exec "$config{agent}"
		    || &bailout("cant exec $config{agent}: $!");
d230 1
a230 3
	    eval {cleanup("$config{tempdir}",0);};
	    bailout("problem cleaning $config{tempdir}: $@@")
		if ($@@);
d244 1
a244 1
# dies on errors
d399 1
a399 1
# dies on errors
d492 1
a492 1
# dies on errors
d506 1
a506 1
# dies on error, no retval
d512 1
a512 1
    opendir(F,$what) || die "cant opendir $what: $!\n";
d516 2
a517 2
	(-d "$what/$name")?cleanup("$what/$name",1):
	    (unlink("$what/$name") || die "cant unlink $what/$name: $!\n");
d520 1
a520 1
    $remove_what && (rmdir("$what") || die "cant rmdir $what: $!\n");
d549 1
a549 1
		my $res=0xffff & system "$config{client} delete $_";
d587 3
a589 1
	@@tmp=`$config{pgp} -kv 2>$config{tempdir}/subproc`;
d596 1
a596 1
		if ($userspec =~ /<(.+)>/)
d619 1
a619 1
	    if (/^\s+.*<(\S+)>\s*$/)
d634 3
a636 1
    @@tmp=`$config{gpg} -q --batch --list-keys --with-colons --no-expensive-trust-checks 2>$config{tempdir}/subproc`;
d660 1
a660 1
	if ($info[9] =~ /<(.+)>/)
d742 1
a742 1
# dies on major problems
d752 2
a753 2
	      pgp=>"/usr/bin/pgp",
	      gpg=>"/usr/bin/gpg",
d757 2
a758 2
	      client=>undef,
	      agent=>undef,
d865 5
a869 4
     $newconf{agent}=0) if ($newconf{agent} && $newconf{agent}=~/^(\S+)/ && ! -x $1);
    (logit("bad client-executable '$newconf{client}', disabling agent support"),
     $newconf{client}=0) if ($newconf{client} && $newconf{client}=~/^(\S+)/ && ! -x $1);
    &bailout("bad executable '$newconf{pgp}' -- exiting")
d871 2
a872 2
	    && (!$newconf{pgp} || $newconf{pgp}=~/^(\S+)/ && ! -x $1));
    &bailout("bad executable '$newconf{gpg}' -- exiting")
d874 1
a874 1
	    && ( !$newconf{gpg} || $newconf{gpg}=~/^(\S+)/ && ! -x $1));
d876 1
a876 1
    $newconf{use_agent}=$newconf{client} && $newconf{agent};
d883 1
a883 1
	my $res=0xffff & system("$newconf{gpg} -q --batch --list-secret-keys --with-colons $newconf{ngkey} >$newconf{tempdir}/subproc 2>&1");
d888 1
a888 1
	open(F,"$newconf{gpg} -q --batch --list-secret-keys --with-colons 2>$newconf{tempdir}/subproc |") || bailout("cant run $newconf{gpg} to list sec keys: $!","$newconf{tempdir}/subproc");
d905 1
a905 1
	    my $res=0xffff & system("$newconf{pgp} -kv $newconf{stdkey} $home/.pgp/secring.pgp 2>$newconf{tempdir}/subproc");
d910 1
a910 1
	    my $res=0xffff & system("$newconf{gpg} -q --batch --list-secret-keys --with-colons $newconf{stdkey} >$newconf{tempdir}/subproc 2>&1");
d920 2
a921 2
	    open(F,"$newconf{pgp} -kv $home/.pgp/secring.pgp 2>$newconf{tempdir}/subproc |") 
		|| bailout("cant run $newconf{pgp} to list sec keys: $!","$newconf{tempdir}/subproc");
d935 2
a936 2
	    open(F,"$newconf{gpg} -q --batch --list-secret-keys --with-colons 2>$newconf{tempdir}/subproc|")
		|| bailout("cant run $newconf{gpg} to list sec keys: $!\n","$newconf{tempdir}/subproc");
d992 1
a992 1
# no return value, dies on problems
d1013 1
a1013 1
# retval: none, changes %secrets, dies on major errors 
d1028 1
a1028 1
		$res=0xfff & system("$config{client} delete $id >$config{tempdir}/subproc 2>&1");
d1038 1
a1038 1
		$res = 0xffff & system("$config{client} put $id >$config{tempdir}/subproc 2>&1");
d1069 1
a1069 1
# returns: 0 if ok, 1 if bad passphrase,  dies on other errors
d1089 1
a1089 1
	$cmd="|$config{client} get ".
d1102 1
a1102 1
	    $cmd.="|PGPPASSFD=0 $config{pgp} +batchmode -u $config{stdkey} -sbat";
d1106 1
a1106 1
	    $cmd.="|$config{gpg} -q -t --batch --armor --passphrase-fd 0 --status-fd 1 --default-key";
d1131 1
a1131 1
	    $cmd.="|PGPPASSFD=0 $config{pgp} +batchmode "
d1140 1
a1140 1
		$cmd.="|$config{gpg} -q -t --batch --armor --passphrase-fd 0 "
d1155 1
a1155 1
		$cmd.="|$config{gpg} --batch -q --detach-sign "
d1206 1
a1206 1
	    & system("$config{gpg} --batch -q --store -z 0 -o $outfile.inter1 "
d1215 1
a1215 1
    open(H,"|$config{gpg} --no-literal --store --compress-algo 1 "
d1217 1
a1217 1
	|| bailout("cant open pipe to $config{gpg}: $!");
d1226 1
a1226 1
    $cmd="$config{gpg} --no-literal --encrypt --rfc1991 --cipher-algo idea "
d1356 1
a1356 1
    die($msg.'\n');
@


1.27
log
@unified keyring handling
@
text
@d23 1
a23 1
#   $Id: kuvert,v 1.26 2002/09/25 12:12:32 az Exp az $
a29 1

a31 1

d33 1
d35 1
a35 8
my %options;
if (!getopts("dkrnv",\%options) || @@ARGV)
{
    print "usage: $0 [-n] [-d] [-v] | [-k] | [-r] \n-k: kill running $0\n"
	."-d: debug mode\n-r: reload keyrings and configfile\n-n don't fork\n-v: output version and exit\n";
    exit 1;
}

d38 1
a38 7

if ($options{'v'})
{
    print STDERR "kuvert $version\n";
    exit 0;
}

d40 1
a40 17
my($name,$home)=(getpwuid($<))[0,7];

# where is our in-queue
my $queuedir="$home/.kuvert_queue";

# which mta to use
my $mta="/usr/lib/sendmail -om -oi -oem";

# where to put temp files for parsing mime
my $tempdir=($ENV{'TMPDIR'}?$ENV{'TMPDIR'}:"/tmp")."/kuvert.$<.$$";
# where to put pgp/gpg in- and output
my $tempfile_in="input.tmp";
my $tempfile_out="output.tmp";

# interval to check the queue
my $interval=60;		# seconds

d42 4
a45 35
my $config="$home/.kuvert";

# list of addresses and -regexps to be handles specially
my %config=();
my @@configkeys=();

# adresses and keyids
my (%ngkeys,%stdkeys);

# the name of program for logging
my $progname="kuvert";

# where to put the pid of the running process
my $pidf="/tmp/kuvert.pid.$<";

# header to check for bounce request
# bounces are not signed or encrypted but simply passed to $mta
my $resend_indicator="resent-to";

# with this header one can override the configuration options wrt.
# signing for all recipients of the current mail
my $conf_header="x-kuvert";

# pgp path
my $PGP='/usr/bin/pgp';
# gpg path
my $GPG='/usr/bin/gpg';
# cat, needed if !use_pgp
my $CAT="/bin/cat";
# quintuple-client path
my $client;
# quintuple-agent path and args
my $agent;

# the passphrases are stored here if agent support is switched off
d47 1
d49 4
a52 20
# 0 if gpg should try to mimickry as pgp2
# 0 means, that both keys are assumed to reside in one keyring
my $use_pgp=0;

# set this to 1 if this module should store the secrets with
# secret-agent rather than storing them itself.
my $use_agent=0;
# whether we need a separate agent-process
my $private_agent=0;

# if use_agent:
# set this to 0 if the secret should be loaded on demand by
# client if possible: this demand asking works only if
# $DISPLAY is set, so this option is ignored if no $DISPLAY is a/v
# if not set, the secret is asked & stored when kuvert starts.
my $secret_on_demand=0;

# add --always-trust to the gpg-parameters: this makes gpg
# encrypt to non fully trusted keys, too.
my $alwaystrust=0;
d54 18
a71 2
# set this to 1 for more verbose debugging output to syslog
my $debug=0;
d73 6
a78 18
# default keyid(s) for std and ng
# not really needed if you run separate keyrings, but if you
# want to run only gpg (in normal and "compat" mode),
# you've got to specify your default key because you've got more than
# one secret key in your secret keyring...
my ($ng_defkey,$std_defkey);

# usually this program logs to syslog, but it can log to a file as well
my ($lf,$logfile);

$debug=1 if ($options{"d"});

# kill a already running process
# TERM for kill or HUP for rereading
if ($options{"k"} || $options{"r"})
{
    my $pid;
    my $sig=($options{"r"}?'USR1':'TERM');
d80 4
a83 4
    open(PIDF,"$pidf") || &bailout("cant open $pidf: $!");
    $pid=<PIDF>;
    close(PIDF);
    chomp $pid;
d85 1
a85 1
    &bailout("no valid pid found, cant kill any process.")
d87 5
a91 5
    &bailout("cant kill -$sig $pid: $!")
	if (!kill $sig, $pid);
    unlink $pidf if ($options{"k"});
    exit 0;
}
d93 2
a94 2
&bailout("no configuration file, can't start!")
    if (! -r $config);
d96 13
a108 1
logit("version $version starting");
d110 1
a110 9
# and now for some real work...
if (-f "$pidf")			# retain content of pidf, in case we cant lock it
{
    open(PIDF,"+<$pidf") || &bailout("cant open <+$pidf: $!");
}
else
{
    open(PIDF,">$pidf") || &bailout("cant open >$pidf: $!");
}
d112 4
a115 2
&bailout("cant lock $pidf ($!), another process running?, exiting")
    if (!flock(PIDF,LOCK_NB|LOCK_EX));
d117 3
a119 2
# read the config, setup the queuedir and tempdir
&read_config;
d121 43
a163 10
# cleanup tempdir
my $res;
&bailout("cant clean $tempdir: $res")
    if ($res=cleanup($tempdir,0));

# get the passphrase(s) and setup secret-agent if wanted
# this has to be done before any fork, because the environment
# vars for secret-agent must be retained
$res=&get_verify_secrets;
&bailout("secrets could not be initialized properly: $res") if ($res);
a164 3
if (!$options{"d"} && !$options{"n"})
{
    my $res=fork;
d166 8
a173 5
    &bailout("fork failed: $!")
	if ($res == -1);
    exit 0
	if ($res);
}
d175 6
a180 14
# the lockfile is ours, lets write the current pid
print PIDF "$$\n";
PIDF->flush;
truncate PIDF,tell(PIDF);	# and make sure there's nothing else in there...
# now read the keyrings
&read_keyrings;

# install the handler for conf reread
$SIG{'USR1'}=\&handle_reload;
# and the termination-handler
$SIG{'HUP'}=\&handle_term;
$SIG{'INT'}=\&handle_term;
$SIG{'QUIT'}=\&handle_term;
$SIG{'TERM'}=\&handle_term;
d182 7
a188 5
# the main loop, left only via signal handler handle_term
while (1)
{
    &bailout("cant open $queuedir: $!")
	if (!opendir(D,"$queuedir"));
d190 2
a191 2
    my $file;
    foreach $file (readdir(D))
d193 18
a210 1
	my $res;
d212 25
a236 7
	# dont try to handle any files starting with "."
	next if ($file =~ /^\./);
	# open the file
	next if (!open(FH,"$queuedir/$file"));
	# lock it if possible
	if (!flock(FH,LOCK_NB|LOCK_EX))
	{
a237 2
	    logit("$file is locked, skipping.");
	    next;
d239 4
a242 32

	#ok, open & locked, let's proceed
	logit("processing $file for $name");
	$res=process_file(*FH,"$queuedir/$file");
	if ($res)
	{
	    send_bounce($res,$file);
	    logit("problem \"$res\" processing $file,"
		  ." leaving as \".$file\".\n");
	    $res=rename("$queuedir/$file","$queuedir/.$file");
	}
	else
	{
	    logit("done with file $file");
	    $res=unlink("$queuedir/$file");
	    logit("problem removing $queuedir/$file: $!")
		if (!$res);
	}

	# and clean up the cruft left behind, please!
	$res=&cleanup("$tempdir",0);
	logit("problem cleaning $tempdir: $res")
	    if ($res);

	# unlock the file
	logit("problem unlocking $queuedir/$file: $!")
	    if (!flock(FH,LOCK_UN));
	close(FH);
    }
    closedir(D);
    &handle_term("debug mode") if ($options{"d"});
    sleep($interval);
d245 2
a246 2
# returns 0 if ok
# stuff in the temp directory is removed by the main loop
a249 3
    my ($res);

    my @@sent;
d253 2
a254 4
    # set output to tempdir
    $parser->output_dir($tempdir);
    # everything less than 100k goes to core mem
    $parser->output_to_core(100000);
d257 2
d260 1
a260 1
    my $in_ent = $parser->read(\$fh);
d262 3
a264 7
    if (!$in_ent)
    {
	logit("could not parse MIME stream, last header was "
	      .$parser->last_head);
	return ("mail was not sent anywhere: could not parse MIME stream, "
		."last header was ".$parser->last_head);
    }
d267 2
a268 2
    my $custom_conf=lc($in_ent->head->get($conf_header));
    $in_ent->head->delete($conf_header);
a275 2
    # extract a possible resend-request-header
    # if a/v, call $mta immediately
d277 2
a278 1
    if ($custom_conf eq "none" || $in_ent->head->get($resend_indicator))
d280 2
a281 8
	if ($custom_conf eq "none" )
	{
	    logit("all sign/encrypt disabled for this mail, calling $mta -t");
	}
	else
	{
	    logit("resending mail, sign/encrypt disabled, calling $mta -t");
	}
d284 1
a284 1
	$res=&send_entity($in_ent,"-t");
d286 1
a286 8
	if ($res)
	{
	    return "mail was not sent to anybody: $res";
	}
	else
	{
	    return 0;
	}
d289 2
a290 2
    my (@@recip_none,@@recip_sign_std,@@recip_sign_ng,
	@@recip_crypt_std,@@recip_crypt_ng,@@recip_all);
d292 8
a299 3
    # note: bcc handling is not implemented.
    map { push @@recip_all, lc($_->address); } Mail::Address->parse($in_ent->head->get("To"),
								    $in_ent->head->get("Cc"));
d304 2
a305 4
    if (!@@recip_all)
    {
	return "no recipients found! the mail headers seem to be garbled.";
    }
d308 1
a308 1
    my %actions=findaction($custom_conf,@@recip_all);
d310 2
a311 6
    # translate that into arrays
    @@recip_none=grep($actions{$_} eq "none",keys %actions);
    @@recip_sign_std=grep($actions{$_} eq "stdsign",keys %actions);
    @@recip_sign_ng=grep($actions{$_} eq "ngsign",keys %actions);
    @@recip_crypt_std=grep($actions{$_} eq "std",keys %actions);
    @@recip_crypt_ng=grep($actions{$_} eq "ng",keys %actions);
d313 7
d321 2
a322 7
    # if there are recipients in recip_none, send the message to them
    # without any further action
    if (@@recip_none)
    {
	logit("sending mail (raw) to ".join(",",@@recip_none));
	$res=&send_entity($in_ent,join(" ",@@recip_none));
	if ($res)
d324 10
a333 2
	    $in_ent->purge;	# only if the sending went wrong
	    return ("mail was not sent to anybody: $res");
d335 21
a355 1
	push @@sent,@@recip_none;
d358 3
a360 5
    # shortcut if just recipients without crypt/sign
    # and no other recipients are given
    return 0
	if (!@@recip_sign_std && !@@recip_sign_ng
	    && !@@recip_crypt_std && !@@recip_crypt_ng);
d362 7
a368 5
    # copy (mail)header, split header info
    # in mime-related (remains with the entity) and non-mime
    # (is saved in the new header-object)
    my $orig_header=$in_ent->head->dup;
    my $headername;
d370 14
a383 4
    # content-* stays with the entity and the rest moves to orig_header
    foreach $headername ($in_ent->head->tags)
    {
	if ($headername !~ /^content-/i)
d385 3
a387 2
	    # remove the stuff from the entity
	    $in_ent->head->delete($headername);
d391 4
a394 2
	    # remove this stuff from the orig_header
	    $orig_header->delete($headername);
a396 103

    # any text/plain parts of the entity have to be fixed with the
    # correct content-transfer-encoding (qp), since any transfer 8->7bit
    # on the way otherwise will break the signature.
    # this is not necessary if encrypting, but done anyways since
    # it doesnt hurt and we want to be on the safe side.

    qp_fix_parts($in_ent);

    # now we've got a $in_entity which is ready to be encrypted/signed
    # and the mail-headers are saved in $orig_header

    # since the old pgp has problems with stuff signed/encrypted
    # by newer software that uses partial-length headers when fed
    # data via pipe, we write out our $in_entity to $tempfile_in
    # which is then fed through the relevant signing/encryption and sent on.

    if (!open(F,">$tempdir/$tempfile_in"))
    {
	logit("cant open >$tempdir/$tempfile_in: $!");
	return ("mail was sent to ".
		(@@sent?join(",",@@sent):"nobody")
		.",\nnot to anybody else: ".
		"cant open >$tempdir/$tempfile_in: $!");
    }
    $in_ent->print(\*F);
    close(F);

    if (@@recip_sign_std)
    {
	return ("no std key known, can't sign! mail was sent to ".
		(@@sent?join(",",@@sent):"nobody")
		.",\nnot to anybody else")
	    if (!$std_defkey);
	logit("sending mail (sign,std) to ".join(",",@@recip_sign_std));
	$res=sign_send($in_ent,"$tempdir/$tempfile_in",\@@recip_sign_std,
		       \&std_sign,
		       "md5",$orig_header,"std");
	return ("mail was sent to ".
		(@@sent?join(",",@@sent):"nobody")
		.",\nnot to ".join(",",@@recip_sign_std).": $res")
	    if ($res);
	push @@sent,@@recip_sign_std;
    }

    if (@@recip_sign_ng)
    {
	return ("no ng key known, can't sign! mail was sent to ".
		(@@sent?join(",",@@sent):"nobody")
		.",\nnot to anybody else")
	    if (!$ng_defkey);
	logit("sending mail (sign,ng) to ".join(",",@@recip_sign_ng));
	$res=sign_send($in_ent,"$tempdir/$tempfile_in",\@@recip_sign_ng,
		       \&ng_sign,
		       "sha1",$orig_header,"ng");
	return ("mail was sent to ".
		(@@sent?join(",",@@sent):"nobody")
		.",\nnot to ".join(",",@@recip_sign_ng).": $res")
	    if ($res);
	push @@sent,@@recip_sign_ng;
    }

    if (@@recip_crypt_std)
    {
	my @@keys;

	return ("no std key known, can't encrypt! mail was sent to ".
		(@@sent?join(",",@@sent):"nobody")
		.",\nnot to anybody else")
	    if (!$std_defkey);
	logit("sending mail (crypt,std) to ".join(",",@@recip_crypt_std));
	map { push @@keys,$stdkeys{$_}; } @@recip_crypt_std;
	$res=crypt_send($in_ent,"$tempdir/$tempfile_in",\@@recip_crypt_std,
			\@@keys,\&std_crypt,
			$orig_header);
	return ("mail was sent to ".
		(@@sent?join(",",@@sent):"nobody")
		.",\nnot to ".join(",",@@recip_crypt_std).": $res")
	    if ($res);
	push @@sent,@@recip_crypt_std;
    }

    if (@@recip_crypt_ng)
    {
	my @@keys;

	return ("no ng key known, can't encrypt! mail was sent to ".
		(@@sent?join(",",@@sent):"nobody")
		.",\nnot to anybody else")
	    if (!$ng_defkey);
	logit("sending mail (crypt,ng) to ".join(",",@@recip_crypt_ng));
	map { push @@keys,$ngkeys{$_}; } @@recip_crypt_ng;
	$res=crypt_send($in_ent,"$tempdir/$tempfile_in",\@@recip_crypt_ng,
			\@@keys,\&ng_crypt,$orig_header);
	return ("mail was sent to ".
		(@@sent?join(",",@@sent):"nobody")
		.",\nnot to ".join(",",@@recip_crypt_ng).": $res")
	    if ($res);
	push @@sent,@@recip_crypt_ng;
    }

    # done, return
    return 0;
d399 3
a401 1
# return 0 if ok, errortext otherwise
d404 2
a405 2
    my ($ent,$ent_file,$rec,$cmd,$micalg,$header,$type)=@@_;
    my $res;
d409 1
a409 1
    # make a private copy of the passed header and set this one
d419 1
a419 1
    $newent->head->mime_attr("content-Type.Micalg" => "pgp-$micalg");
d423 1
a423 1
		       "You'll need GPG or PGP to check the signature.\n"]);
d428 6
a433 7
    # make sure outfile is not existing
    unlink("$tempdir/$tempfile_out");

    # generate the signature
    $res=&$cmd($ent_file,"$tempdir/$tempfile_out");
    return $res if ($res);

d436 2
a437 2
		    Path => "$tempdir/$tempfile_out",
		    Filename => "signature.$type",
a439 1

d441 1
a441 1
    return &send_entity($newent,@@{$rec});
d444 2
a445 1
# return 0 if ok, errortext otherwise
d448 2
a449 2
    my ($ent,$ent_file,$rec,$rec_keys,$cmd,$header)=@@_;
    my $res;
d453 1
a453 1
    # make a private copy of the passed header and set this one
d465 2
a466 2
		       "It has been encrypted conforming to RFC2015.\n",
		       "You'll need PGP or GPG to view the content.\n"]);
d473 7
a479 7
    # make sure tempfile is not existing
    unlink("$tempdir/$tempfile_out");

    # generate the encrypted data
    $res=&$cmd($ent_file,"$tempdir/$tempfile_out",@@{$rec_keys});
    return $res if ($res);

d482 1
a482 1
		    Path => "$tempdir/$tempfile_out",
d488 1
a488 1
    return &send_entity($newent,@@{$rec});
a490 20
# log the msg(s) to syslog or the logfile
sub logit
{
    my $msg = shift(@@_);

    if ($lf)
    {
	# logfile is opened with autoflush set to 1, 
	# so no extra flushing needed
	# we're more or less emulating the syslog format here...
	print $lf scalar(localtime)." $0\[$$\] $msg\n";
    }
    else
    {
	setlogsock('unix');
	openlog($progname,"pid,cons","mail");
	syslog("notice","$msg");
	closelog;
    }
}
d494 1
a494 1
# returns 0 if ok or an errortext
d499 2
a500 2
    open(TOMTA,("|$mta ".join(" ",@@args)))
	|| return "cant open pipe to $mta: $!";
d503 1
a503 3
    return "error when calling $mta: $!"
	if ($?);
    return "";
d508 1
a508 1
# returns: "" or errormsg
d514 1
a514 1
    opendir(F,$what) || return "cant opendir $what: $!";
d517 3
a519 11
	next if ($name =~ /^\.{1,2}$/); # dont touch the dir-entries...
	if (-d "$what/$name")
	{
	    $res=&cleanup("$what/$name");
	    return $res if ($res);
	    rmdir ("$what/$name") || return "cant rmdir $what/$name: $!";
	}
	else
	{
	    unlink("$what/$name") || return "cant unlink $what/$name: $!";
	}
d522 1
a522 4
    if ($remove_what)
    {
	rmdir("$what") || return "cant rmdir $what: $!";
    }
a529 1
    my $res;
d532 2
a533 2
    $res=&cleanup($tempdir,1);
    logit("problem cleaning up $tempdir: $res")
d535 24
a558 4
    $res=&wipe_keys;
    logit("problem doing the module cleanup routine: $res")
	if ($res);
    close $lf if ($lf);
d579 1
a579 1
    %stdkeys=();
d581 1
a581 1
    if ($use_pgp)
d589 1
a589 1
	@@tmp=`$PGP -kv 2>$tempdir/subprocess`;
d607 1
a607 1
		    $stdkeys{$name}="0x$key";
d622 1
a622 1
		$stdkeys{$name}="0x$lastkey";
d628 1
a628 1
    logit("reading combined keyring.") if (!$use_pgp);
d630 1
a630 1
    %ngkeys=();
d634 1
a634 1
    @@tmp=`$GPG -q --batch --list-keys --with-colons --no-expensive-trust-checks 2>$tempdir/subprocess`;
d645 1
a645 1
	if ($use_pgp && $info[3] eq "1")
a651 1
	# fixme lowprio: more general unquote
d685 1
a685 1
		$ngkeys{$name}="0x$lastkey";
d724 1
a724 1
		    $ngkeys{$name}="0x$lastkey";
d739 3
d744 1
a744 1
    my (@@tmp,$lastkey,$mtaopt);
d746 19
a764 3
    # get the list of special adresses and adress-regexps
    &bailout("cant open $config: $!\n")
	if (!open (F,$config));
d766 2
a768 4
    %config=();
    $config{default}='none';

    @@configkeys=();
a772 76
	# if the keyid given is 0, don't do ng pgp at all
	if (/^NGKEY\s+(\S.*)$/)
	{
	    $ng_defkey=$1;
	    logit("set default ng key ng to $1") if ($options{"d"});
	    next;
	}
	# if the keyid given is 0, don't do std pgp at all
	if (/^STDKEY\s+(\S.*)$/)
	{
	    $std_defkey=$1;
	    logit("set default std key to $1") if ($options{"d"});
	    next;
	}
	if (/^PGPPATH\s+(\S.+)\s*$/)
	{
	    $PGP=$1;
	    logit("set pgppath to $1") if ($options{"d"});
	    next;
	}
	if (/^GPGPATH\s+(\S.+)\s*$/)
	{
	    $GPG=$1;
	    logit("set gpgpath to $1") if ($options{"d"});
	    next;
	}
	if (/^USEPGP\s+(\d)/)
	{
	    $use_pgp=$1;
	    logit("set use_pgp to $1") if ($options{"d"});
	    next;
	}
	if (/^AGENTPATH\s+(\S.+)\s*$/) # 
	{
	    $agent=$1;
	    logit("set agent to $1") if ($options{"d"});
	    next;
	}
	if (/^CLIENTPATH\s+(\S.+)\s*$/)
	{
	    $client=$1;
	    logit("set client to $1") if ($options{"d"});
	    next;
	}
	if (/^MTA\s+(\S.+)\s*$/)
	{
	    $mtaopt=$1;
	    logit("set mta to $1") if ($options{"d"});
	    next;
	}
	if (/^SECRETONDEMAND\s+(\d)/)
	{
	    $secret_on_demand=$1;
	    logit("set secret_on_demand to $1") if ($options{"d"});
	    next;
	}
	if (/^ALWAYSTRUST\s+(\d)/)
	{
	    $alwaystrust=$1;
	    logit("set alwaystrust to $1") if ($options{"d"});
	    next;
	}
	
	if (/^QUEUEDIR\s+(\S+)\s*$/)
	{
	    logit("set queuedir to $1") if ($options{"d"});
	    $queuedir=$1;
	    next;
	}
	
	if (/^INTERVAL\s+(\d+)\s*$/)
	{
	    logit("set interval to $1") if ($options{"d"});
	    $interval=$1;
	    next;
	}
d774 1
a774 2

	if (/^TEMPDIR\s+(\S+)\s*$/)
d776 13
a788 3
	    logit("set tempdir to $1") if ($options{"d"});
	    $tempdir=$1;
	    next;
d790 1
a790 2

	if (/^LOGFILE\s+(\S+)\s*$/)
d792 1
a792 11
	    # close old logfile if there is one
	    close $lf
		if ($logfile && $logfile ne $1);
	    $logfile=$1;		
	    # we append to the logfile
	    &bailout("cant open logfile $logfile: $!")
		if (!open($lf,">>$logfile"));
	    $lf->autoflush(1);
	    logit("set logfile to $1") if ($options{"d"});
	    next;
	}
d794 1
a794 4
	if (/^(\S+)\s+(\S+)\s*$/)
	{
	    my ($key,$action)=(lc($1),lc($2));
	    if ($action=~/^(none|std(sign)?|ng(sign)?|fallback)(-force)?$/)
d796 2
a797 3
		$config{$key}=$action;
		push @@configkeys, $key;
		logit("got conf $action for $key") if ($options{"d"});
d801 1
a801 1
		logit("ignoring bad action \"$action\" for $key");
a804 1
	
d807 5
d813 1
a813 1
    if (!-d $queuedir)
d815 3
a817 3
	unlink "$queuedir";
	&bailout("cant mkdir $queuedir: $!")
	    if (!mkdir($queuedir,0700));
d820 1
a820 1
    elsif ((stat($queuedir))[4] != $<)
d822 1
a822 1
	&bailout("$queuedir is not owned by you - refusing to run");
d824 1
a824 1
    elsif ((stat($queuedir))[2]&0777 != 0700)
d826 1
a826 1
	&bailout("$queuedir does not have mode 0700 - refusing to run");
d829 2
a830 2
    # gen tempdir for storing mime-stuff
    if (!-d $tempdir)
d832 2
a833 2
	unlink "$tempdir";
	if (!mkdir($tempdir,0700))
d835 1
a835 1
	    &bailout("cant mkdir $tempdir: $!");
d838 1
a838 1
    elsif ((stat($tempdir))[4] != $<)
d840 1
a840 1
	&bailout("$tempdir is not owned by you - refusing to run");
d842 1
a842 1
    elsif ((stat($tempdir))[2]&0777 != 0700)
d844 1
a844 1
	&bailout("$tempdir does not have mode 0700 - refusing to run");
d846 4
d851 45
a895 16
    # consistency checks
    $use_agent=$client && $agent;
    $secret_on_demand=0 if (!$use_agent);
    
    # sanity checks
    &bailout("bad ng executable '$GPG' -- exiting")
	if (! -x $GPG);

    &bailout("bad std executable '$PGP' -- exiting")
	if ($use_pgp && ! -x $PGP);

    if ($mtaopt && $mtaopt =~ /^(\S+)/)
    {
	&bailout("bad MTA '$mtaopt' -- exiting")
	    if (! -x $1);
	$mta=$mtaopt;
d897 2
a898 2
    
    if ($use_agent)		
d900 6
a905 1
	foreach my $x ($client,$agent)
d907 4
a910 2
	    &bailout("bad agent executable '$x' -- exiting")
		if (! -x $x);
d913 44
d962 1
d981 3
a983 2
	    $entity->head->mime_attr("content-transfer-encoding"
				     => "quoted-printable");
d988 2
a989 2

# notify the sender of the problem
d994 10
a1003 7
    open(F,"|$mta -t") || return;
    print F "From: $name\nTo: $name\nSubject: $progname Mail Send Failure\n\n";
    print F "your mail $queuedir/$file could not be sent to some or all"
	." recipients.\nthe detailed error message was:\n\n";
    print F "$res\n";
    print F "please remove the backup file $queuedir/.$file\n"
	."or rename it back to $queuedir/$file if you want me to try again for all recipients.\n";
d1007 6
a1012 3
# sign a infile and write it to outfile
# args: infile,outfile
sub std_sign
d1014 5
a1018 60
    if ($use_pgp)
    {
	return &pgp_sign(@@_,"");
    }
    else
    {
	return &gpg_sign(@@_,$std_defkey,
			 "--rfc1991 --cipher-algo idea --digest-algo md5"
			 ." --compress-algo 1");
    }
}
sub ng_sign { return &gpg_sign(@@_,$ng_defkey,undef); }

# crypt+sign a infile with keys, write it to outfile
# args: infile,outfile,recipients
sub std_crypt
{
    if ($use_pgp)
    {
	return &pgp_crypt("",@@_);
    }
    else
    {
	return &gpg_crypt($std_defkey,@@_);
    }
}
sub ng_crypt  { return &gpg_crypt($ng_defkey,@@_); }


# generate detached signature
# input: filename_in,filename_out,extra_args
# output: errormsg or ""
sub pgp_sign
{
    my ($infile,$outfile,$extra_args)=@@_;
    my ($passphrase,$passphrase_cmd);
    if ($use_agent)
    {
	$passphrase_cmd="|$client get $std_defkey";
	$passphrase="";

	# check the passphrase for correctness
	# only if actual work is requested
	&verify_passphrase($std_defkey) if ($infile || $outfile);
    }
    else
    {
	$passphrase_cmd="";
	$passphrase=$secrets{$std_defkey};
	return "no passphrase known for key $std_defkey"
	    if (!$passphrase);
    }

    if (!$infile && !$outfile)	# only check the passphrase
    {
	open(F,"$passphrase_cmd|PGPPASSFD=0 $PGP +batchmode "
	     ."$extra_args -u $std_defkey -sbatf >$tempdir/subprocess 2>&1")
	    || return "cant open |pgp: $!";
    }
    else
d1020 1
a1020 157
	open(F,"$passphrase_cmd|PGPPASSFD=0 $PGP +batchmode $extra_args "
	     ."-u $std_defkey -sbat $infile -o $outfile >$tempdir/subprocess 2>&1")
	    || return "cant open |pgp: $!";
    }
    print F "$passphrase\n"
	if ($passphrase);
    close(F);
    $passphrase="xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"; # does this overwrite?
    return "" if (!$?);
    open F,"$tempdir/subprocess";
    my @@result=<F>;
    close F;
    return "error running pgp: $!\n".join("\n",@@result) if ($? == 0xff00);
    return "pgp died from signal" . ($? & 0x7f)."\n".join("\n",@@result) if ($? <= 0x80);
    $? >>= 8;
    return "bad passphrase\n".join("\n",@@result) if ($? == 20);
    return "pgp returned $?\n".join("\n",@@result);
}

# sign and encrypt
# input: extra_args,filename_in,filename_out,recipients
# output: errormsg or ""
sub pgp_crypt
{
    my ($extra_args,$infile,$outfile,@@recipients)=@@_;
    my ($passphrase,$cmd);

    if ($use_agent)
    {
	$passphrase="";
	$cmd="$client get $std_defkey|";

	&verify_passphrase($std_defkey);
    }
    else
    {
	$passphrase=$secrets{$std_defkey};
	return "no passphrase known for key $std_defkey"
	    if (!$passphrase);
    }

    $cmd.="PGPPASSFD=0 $PGP +batchmode $extra_args -u $std_defkey -esat "
	."$infile -o $outfile " . join(" ",@@recipients) ." >$tempdir/subprocess 2>&1";

    open(F,"|$cmd") || return "cant open |pgp: $!";
    print F "$passphrase\n"
	if ($passphrase);
    close(F);
    $passphrase="xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"; # does this overwrite?
    return "" if (!$?);
    open F,"$tempdir/subprocess";
    my @@result=<F>;
    close F;
    return "error running pgp: $!\n".join("\n",@@result) if ($? == 0xff00);
    return "pgp died from signal" . ($? & 0x7f)
	."\n".join("\n",@@result) if ($? <= 0x80);
    $? >>= 8;
    return "bad passphrase\n".join("\n",@@result) if ($? == 20);
    return "pgp returned $?\n".join("\n",@@result);
}

# generate detached signature
# input: filename_in,filename_out,key,extra_args
# key is the key that's used for signing & secret retrieval
# output: errormsg or ""
sub gpg_sign
{
    my ($infile,$outfile,$key,$extra_args)=@@_;
    my ($passphrase_cmd,$passphrase);

    if ($use_agent)
    {
	$passphrase_cmd="|$client get $key";
	$passphrase="";

	&verify_passphrase($key) if ($infile || $outfile);
    }
    else
    {
	$passphrase_cmd="";
	$passphrase=$secrets{$key};
	return "no passphrase known for key $key"
	    if (!$passphrase);
    }

    if (!$infile && !$outfile)	# only check passphrase
    {
	open(F,"$passphrase_cmd|$GPG -q -t --batch --armor "
	     ."--passphrase-fd 0 --default-key $key $extra_args --detach-sign "
	     .">$tempdir/subprocess 2>&1") || return "cant open |gpg: $!";
    }
    else
    {
	open(F,"$passphrase_cmd|$GPG -q -t --batch --armor --passphrase-fd 0 "
	     ."--default-key $key $extra_args --detach-sign -o $outfile $infile "
	     .">$tempdir/subprocess 2>&1")
	    || return "cant open |gpg: $!";
    }
    print F "$passphrase\n"
	if ($passphrase);
    close(F);
    $passphrase="xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"; # does this overwrite?
    return "" if (!$?);
    open F,"$tempdir/subprocess";
    my @@result=<F>;
    close F;
    return "error running gpg: $!\n".join("\n",@@result) if ($? == 0xff00);
    return "gpg died from signal" . ($? & 0x7f)
	."\n".join("\n",@@result) if ($? <= 0x80);
    $? >>= 8;
    return "gpg returned $?\n".join("\n",@@result);
}

# sign and encrypt
# input: key,filename_in,filename_out,recipients
# key is used for signing & secret retrieval
# if key is an rsa-key, do all the
# stuff thats needed to generate rsa-stuff that pgp2 can successfully
# decrypt (this means to care for some bugs in pgp2 and emulate
# its behaviour...
# output: errormsg or ""
sub gpg_crypt
{
    my ($key,$infile,$outfile,@@recipients)=@@_;
    my ($cmd,$passphrase);

    if ($use_agent)
    {
	$passphrase="";
	$cmd="$client get $key|";

	&verify_passphrase($key);
    }
    else
    {
	$passphrase=$secrets{$key};
	return "no passphrase known for key $key"
	    if (!$passphrase);
    }

    if ($key eq $std_defkey) # means: compat mode!
    {
	my $res;

	# very elaborate but working procedure, found by
	# Gero Treuner <gero@@faveve.uni-stuttgart.de>
	# http://muppet.faveve.uni-stuttgart.de/~gero/gpg-2comp

	# first, generate the signature and store it
	$cmd.="$GPG --batch -q --detach-sign --default-key $key "
	    ."--passphrase-fd 0 -o $outfile.inter1 $infile >$tempdir/subprocess 2>&1";
	open(F,"|$cmd") || return "cant open |gpg: $!";
	print F "$passphrase\n"
	    if ($passphrase);
	close(F);
	$passphrase="xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx";
	if ($?)
d1022 7
a1028 10
	    open F,"$tempdir/subprocess";
	    my @@result=<F>;
	    close F;
	    return "error running gpg: $!\n"
		.join("\n",@@result) if ($? == 0xff00);
	    return "gpg died from signal" . ($? & 0x7f)
		."\n".join("\n",@@result)if ($? <= 0x80);
	    $? >>= 8;
	    return "gpg returned $?\n".join("\n",@@result);
	}
d1030 10
a1039 11
	# then, convert the cleartext to the internal literal structure
	$res=0xffff
	    & system("$GPG --batch -q --store -z 0 -o $outfile.inter2 "
		     ."$infile >$tempdir/subprocess 2>&1");
	if ($res)
	{
	    open F,"$tempdir/subprocess";
	    my @@result=<F>;
	    close F;
	    return "error running gpg literal conversion: $res\n"
		.join("\n",@@result);
d1041 1
a1041 6

	# compress signature and literal in the required order
	$res=0xffff & system("$CAT $outfile.inter1 $outfile.inter2"
			     ."|$GPG --no-literal --store --compress-algo 1 "
			     ."-o $outfile.inter3 >$tempdir/subprocess 2>&1");
	if ($res)
d1043 15
a1057 21
	    open F,"$tempdir/subprocess";
	    my @@result=<F>;
	    close F;
	    return "error running gpg sig+data compression: $res\n"
		.join("\n",@@result);
	}

	# and finally encrypt all this for the wanted recipients.
	$cmd="$GPG --no-literal --encrypt --rfc1991 --cipher-algo idea "
		.($alwaystrust?"--always-trust ":"")
		."--armor -o $outfile -r "
		    .join(" -r ",@@recipients)
		    ." $outfile.inter3 >$tempdir/subprocess 2>&1";
	$res= 0xffff & system($cmd);
	if ($res)
	{
	    open F,"$tempdir/subprocess";
	    my @@result=<F>;
	    close F;
	    return "error running gpg encryption: $res\n"
		.join("\n",@@result);
d1059 1
a1059 26
	return "";
    }
    else
	# the usual variant: ng-keys only, no backwards compatibility for
	# pgp2
    {
	$cmd.="$GPG --batch -q -t --armor --passphrase-fd 0 "
	    .($alwaystrust?"--always-trust ":"")
		."-o $outfile --default-key $key -r "
		    . join(" -r ",@@recipients)
			." --encrypt --sign $infile >$tempdir/subprocess 2>&1";
	
	open(F,"|$cmd") || return "cant open |gpg: $!";
	print F "$passphrase\n"
	    if ($passphrase);
	close(F);
	$passphrase="xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx";
	return "" if (!$?);
	open F,"$tempdir/subprocess";
	my @@result=<F>;
	close F;
	return "error running gpg: $!\n".join("\n",@@result) if ($? == 0xff00);
	return "gpg died from signal" . ($? & 0x7f).
	    "\n".join("\n",@@result)if ($? <= 0x80);
	$? >>= 8;
	return "gpg returned $?\n".join("\n",@@result);
d1061 1
d1064 4
a1067 6
# get and store a secret
# if agent support activated: check if agent running
# and let client ask for the secret and store it
# otherwise, ask and store the secret yourself
# returns error text or ""
sub askput_secret
d1069 2
a1070 3
    my ($id)=@@_;
    my ($res,$phrase);
    
d1072 1
a1072 1
    if ($use_agent)
d1074 3
a1076 9
	# if x11 is running and get is used, then the agent will
	# run a graphical query program. otherwise things use the command line
	my $cmd="$client put $id 2>$tempdir/subprocess";
	$cmd="$client get $id >$tempdir/subprocess 2>&1" if ($ENV{DISPLAY});

	# now let the secret client handle the situation:
	# it asks for the secret and stores it
	$res = 0xffff & system "$cmd";
	if ($res)
d1078 2
a1079 5
	    open F,"$tempdir/subprocess";
	    my @@result=<F>;
	    close F;
	    return "$client returned error code $res\n"
		.join("\n",@@result);
a1080 1
	return 0;
d1082 3
a1084 29
    else
    {
	print "enter secret for key $id:\n";
	system "stty -echo";
	chomp ($phrase=<>);
	system "stty echo";
	print "\n";
	$secrets{$id}=$phrase;
	$phrase="xxxxxxxxxxxxxxxxxxxxxxxxxxx"; # does this overwrite
				# the previous content? lets hope so...
	return 0;
    }
}

# lookup the usual default key, if none is given
# pgp: use the first key in the secret keyring
# gpg/norsa: use the first dsa-key in the secret keyring
# gpg/rsa: similar, the first rsa-key is used
# returns keyid (std,ng)
sub lookup_defkeys
{
    my (@@list,@@tmp,$stdkey,$ngkey);

    # first, get the std key as this is more work
    $stdkey="";

    # if we use pgp, ask pgp to show the contents of the secret keyring
    # (ugly)
    if ($use_pgp)
d1086 2
a1087 11
	# fixme lowprio: is there a neater way to do this?
	@@list=`$PGP -kv $ENV{HOME}/.pgp/secring.pgp 2>$tempdir/subprocess`;
	foreach (@@list)
	{
	    if (/^sec\s+\d+\/(\S+)\s+/)
	    {
		$stdkey="0x$1";
		&logit("defaultkey for std is $stdkey") if ($debug);
		last;
	    }
	}
a1088 1
    # else we ask gpg to show the secring and use the first rsa key
d1091 1
a1091 14
	@@tmp=`$GPG -q --batch --list-secret-keys --with-colons 2>$tempdir/subprocess`;
	foreach (@@tmp)
	{
	    @@list=split(/:/);
	    next if ($list[0] ne "sec"); # only check secret keys
	    $list[4] =~ s/^.{8}//;	# truncate key-id

	    if ($list[3] eq "1") # this is a rsa key
	    {
		$stdkey="0x$list[4]";
		&logit("defaultkey for std is $stdkey") if ($debug);
		last;
	    }
	}
d1094 2
a1095 3
    # now, get the ng key
    @@tmp=`$GPG -q --batch --list-secret-keys --with-colons 2>$tempdir/subprocess`;
    foreach (@@tmp)
d1097 1
a1097 5
	@@list=split(/:/);
	next if ($list[0] ne "sec"); # only check secret keys
	$list[4] =~ s/^.{8}//;	# truncate key-id

	if ($list[3] ne "1") # this is not a rsa key, therefore dsa/elg
d1099 1
a1099 3
	    $ngkey="0x$list[4]";
	    &logit("defaultkey for ng is $ngkey") if ($debug);
	    last;
d1101 1
a1101 30
    }
    return ($stdkey,$ngkey);
}

# sets the default default keys if none specified yet
# does the setup for the agent-process if needed
# asks, verifies and stores the secrets if secret_on_demand is not set
# returns "" or error
sub get_verify_secrets
{
    my ($stdkey,$ngkey)=&lookup_defkeys;
    my $res;

    # set the std keys if no overrides given and keys were found
    $std_defkey=$stdkey if (!defined($std_defkey) && $stdkey);
    $ng_defkey=$ngkey if (!defined($ng_defkey) && $ngkey);

    return "no default key for std known"
	if (!defined $std_defkey);
    return "no default key for ng known"
	if (!defined $ng_defkey);

    # if use_agent is set, check if the agent is running and start one
    # if needed.
    if ($use_agent)
    {
	# check if agent properly active
	# not running? start a personal instance
	# and remember its pid
	if (!$ENV{"AGENT_SOCKET"})
d1103 2
a1104 5
	    # start your own agent process
	    # and remember its pid
	    $private_agent=open(SOCKETNAME,"-|");
	    return "cant fork: $!" if (!defined($private_agent));
	    if ($private_agent)	# original process
d1106 1
a1106 11
		# get the socketname
		$res=<SOCKETNAME>;
		# and set the correct env variable for client
		$res=~/^AGENT_SOCKET=\'(.+)\';/;
		$ENV{"AGENT_SOCKET"}=$1;
		# do not close the pipe, because then the
		# parent process tries to wait() on the child,
		# which wont work here
		&logit("forked secret-agent pid $private_agent,"
		       ."socket is $1")
		    if ($options{"d"});
d1109 2
a1110 4
		# the child that should exec the quintuple-agent
	    {
		exec "$agent"
		    || &bailout("cant exec $agent: $!");
d1113 3
a1115 8
    }
    
    if (!$secret_on_demand)
    {
	# get the std passphrase and verify it,
	# but only if we're doing std pgp at all
	# i.e. keyid!=0
	if ($std_defkey)
d1117 1
a1117 10
	    do
	    {
		$res=&askput_secret($std_defkey);
		bailout("could not read passphrase for $std_defkey: $res") 
		    if ($res);
		$res=std_sign(undef,undef);
		print "wrong passphrase, try again.\n"
		    if ($res);
	    }
	    while ($res);
d1119 1
a1119 4

	# get the ng passphrase and verify it
	# again, only if ng pgp/gpg requested/possible
	if ($ng_defkey)
d1121 1
a1121 10
	    do
	    {
		$res=&askput_secret($ng_defkey);
		bailout("could not read passphrase for $ng_defkey: $res") 
		    if ($res);
		$res=ng_sign(undef,undef);
		print "wrong passphrase, try again.\n"
		    if ($res);
	    }
	    while ($res);
d1124 1
a1124 11
    return "";
}

# if secret-agent support is active:
# removes the keys from the secret agent's store and
# terminates the agent if wanted
sub wipe_keys
{
    my $res;

    if ($use_agent)
d1126 1
a1126 1
	if ($private_agent)
d1128 3
a1130 4
	    # kill the private agent process
	    $res = kill('TERM',$private_agent);
	    &logit("problem killing $private_agent: $!") if (!$res);
	    wait;
d1134 2
a1135 1
	    if ($std_defkey)
d1137 5
a1141 3
		$res = 0xffff & system "$client delete $std_defkey";
		&logit("problem deleting secret for $std_defkey: $res")
		    if ($res);
d1143 1
a1143 1
	    if ($ng_defkey)
d1145 11
a1155 3
		$res = 0xffff & system "$client delete $ng_defkey";
		&logit("problem deleting secret for $ng_defkey: $res")
		    if ($res);
a1158 2
    return "";
}
d1160 3
d1164 4
a1167 9
# requests the passphrase from the agent and runs it 
# through the usual verification process.
# does not stop until the passphrase passes the test.
# does assume that secret agent is running (will not be called
# otherwise...)
sub verify_passphrase
{
    my ($key)=@@_;
    my $res;
d1169 5
a1173 1
    while (1)
d1175 9
a1183 2
	# let the sign subroutine check for validity
	if ($key eq $std_defkey)
d1185 6
a1190 1
	    $res=std_sign(undef,undef);
d1192 4
a1195 9
	else
	{
	    $res=ng_sign(undef,undef);
	}
	
	# ok? then exit
	return 0 if (!$res);
	# otherwise nuke the key and redo this
	system("$client delete $key");
d1197 35
a1231 1
    exit 1;			# must not reach here
a1233 1

d1235 1
a1235 1
# input: addresses and custom-header
d1238 2
a1239 1
# resulting actions are: ng, ngsign, std, stdsign, none.
a1240 1
# fixme: uses globals stdkeys, ngkeys, options
d1243 2
a1244 2
    my ($custom,@@addrs,@@affected)=@@_;
    my (%actions,$addr);
d1246 2
a1247 2
    # lookup addresses in config
    foreach $addr (@@addrs)
d1249 1
a1249 2
	# go through the configkeys
	foreach (@@configkeys)
d1251 1
a1251 1
	    if ($addr =~ /$_/i)
d1253 2
a1254 3
		$actions{$addr}=$config{$_};
		logit("found directive: $addr -> $actions{$addr}")
		    if ($options{"d"});
d1261 1
a1261 2
	    logit("custom conf header: overrides $addr -> $custom")
		if ($options{"d"});
d1269 9
a1277 2
    # now check the found actions: anyone with -force options?
    foreach $addr (@@addrs)
d1281 1
a1281 2
	logit("found force directive: $addr -> $actions{$addr}")
	    if ($options{"d"});
d1286 1
a1286 1
	@@affected = grep($actions{$_} ne "none",@@addrs);
d1293 1
a1293 1
	    $force="stdsign" if (grep(!exists $stdkeys{$_}, @@affected));
d1297 1
a1297 1
	    $force="ngsign" if (grep(!exists $ngkeys{$_}, @@affected));
d1304 2
a1305 2
		if (grep(!exists $ngkeys{$_} 
			 && !exists $stdkeys{$_}, @@affected));
d1310 1
a1310 2
	logit("final force directive: $force")
	    if ($options{"d"});
d1315 2
a1316 2
    # finally check the actions for fallback, ng or std and expand that
    foreach $addr (@@addrs)
d1320 2
a1321 2
	    ($ngkeys{$addr} && ($actions{$addr}="ng")) 
		|| ($stdkeys{$addr} && ($actions{$addr}="std"))
d1326 1
a1326 1
	    $actions{$addr}="ngsign" if (!$ngkeys{$addr});
d1330 1
a1330 1
	    $actions{$addr}="stdsign" if (!$stdkeys{$addr});
d1332 8
a1339 1
	logit("final action: $addr -> $actions{$addr}") if ($options{"d"});
d1345 3
a1347 1
# does not return. one arg: the message to spit out
d1350 1
a1350 1
    my ($msg)=@@_;
d1352 1
a1352 1
    logit($msg);
d1355 38
d1394 1
@


1.26
log
@fixed idea-problem
@
text
@d23 1
a23 1
#   $Id: kuvert,v 1.25 2002/09/19 16:43:25 az Exp az $
d700 2
d704 162
a865 4
    logit("reading std keyring.");
    %stdkeys=&std_listkeys;
    logit("reading ng keyring.");
    %ngkeys=&ng_listkeys;
a1107 6
# list the public keys in the usual keyrings
# returns: hash of (address,keyid)
sub std_listkeys { if ($use_pgp) { return &pgp_listkeys; }
		   else { return &gpg_listkeys_rsa; } }
sub ng_listkeys { return &gpg_listkeys_norsa; }

a1140 53
# setup for std pgp  (rsa/idea, 2.6.*)
# returns: hash of address,key
sub pgp_listkeys
{
    my (%stdkeys,$lastkey,@@tmp);

    #get the keys and dump the trailer and header lines
    %stdkeys=();
    # this does not care if pgp is not existent...but then, we're not
    # needing the pgp keyring
    @@tmp=`$PGP -kv 2>$tempdir/subprocess`;
    foreach (@@tmp)
    {
	my $name;
	
	if (/^pub\s+\d+\/(\S+)\s+(.+)$/)
	{
	    my $userspec=$2;
	    my $key=$1;
	    
	    if ($userspec =~ /<(.+)>/)
	    {
		$name=lc($1);
	    }
	    else
	    {
		undef $name;
	    }

	    if ($name)
	    {
		$stdkeys{$name}="0x$key";
		$lastkey=$key;
		&logit("got stdkey 0x$key for $name") if ($debug);
	    }
	    else
	    {
		$lastkey=$key;
		&logit("saved stdkey 0x$key, no address known yet")
		    if ($debug);
	    }
	    next;
	}
	if (/^\s+.*<(\S+)>\s*$/)
	{
	    my $name=lc($1);
	    $stdkeys{$name}="0x$lastkey";
	    &logit("got stdkey (uid) 0x$lastkey for $name") if ($debug);
	}
    }
    return %stdkeys;
}

a1409 231
}

# list keys
# returns: hash of address,key
sub gpg_listkeys_norsa
{
    my (%ngkeys,$lastkey,@@tmp,@@info,$now);
    my %badcauses=('i'=>'invalid, no selfsig','d'=>'disabled',
		   'r'=>'revoked','e'=>'expired');

    $now=time;

    # this does not care if gpg is not existent...but then, we're not
    # needing the gpg keyring
    @@tmp=`$GPG -q --batch --list-keys --with-colons --no-expensive-trust-checks 2>$tempdir/subprocess`;
    foreach (@@tmp)
    {
	my $name;

	@@info=split(/:/);
	# only public keys and uids are of interest
	next if ($info[0] ne "pub" && $info[0] ne "uid");

	$info[4] =~ s/^.{8}//;	# truncate key-id

	# no rsa-keys, please
	# and be sure to skip these uid's, too
	if ($info[3] eq "1")
	{
	    &logit("ignoring rsa key 0x$info[4]") if ($debug);
	    undef $lastkey;
	    next;
	}
	
	# fixme lowprio: more general unquote
	$info[9] =~ s/\\x3a/:/g; # re-insert colons, please

	# remember the email address
	# if no address given: remember this key 
	# but go on to the uid's to get an email address to
	# work with
	if ($info[9] =~ /<(.+)>/)
	{
	    $name=lc($1);
	}
	else
	{
	    undef $name;
	}
	
	# check the key: public part or uid?
	if ($info[0] eq "pub")
	{
	    # lets associate this key with the current email address
	    # if an address is known
	    $lastkey=$info[4];

	    if ($name)
	    {
		# ignore expired, revoked and other bad keys
		if (defined $badcauses{$info[1]})
		{
		    &logit("ignoring DSA key 0x$info[4], reason: "
			   .$badcauses{$info[1]});
		    next;
		}

		$ngkeys{$name}="0x$lastkey";
		
		&logit("got ngkey 0x$lastkey for $name")
		    if ($debug);
	    }
	    else
	    {
		&logit("saved ngkey 0x$lastkey, no address known yet")
		    if ($debug);
	    }
	    next;
	}
	else
	{
	    # uid: associate the current address with the key 
	    # given in the most recent public key line
	    # if no such key saved: the pub key was an rsa key &
	    # we're set to ignore those
	    if (!$lastkey)
	    {
		$name="<no valid address>" if (!$name);
		&logit("ignoring uid $name, belongs to rsa key")
		    if ($debug);
	    }
	    else
	    {
		if ($name)
		{
		    # ignore expired, revoked and other bad keys
		    if (defined $badcauses{$info[1]})
		    {
			&logit("ignoring DSA uid $name for 0x$lastkey, "
			       ."reason: ".$badcauses{$info[1]});
			next;
		    }

		    $ngkeys{$name}="0x$lastkey";
		    &logit("got ngkey (uid) 0x$lastkey for $name")
			if ($debug);
		}
		else
		{
		    &logit("ignoring uid without valid address")
			if ($debug);

		}
	    }
	}
    }
    return %ngkeys;
}

# list keys
# returns: hash of address,key
sub gpg_listkeys_rsa
{
    my (%stdkeys,$lastkey,@@tmp,@@info,$now);
    my %badcauses=('i'=>'invalid, no selfsig','d'=>'disabled',
		   'r'=>'revoked','e'=>'expired');

    $now=time;

    # this does not care if gpg is not existent...but then, we're not
    # needing the gpg keyring
    @@tmp=`$GPG -q --batch --list-keys --with-colons --no-expensive-trust-checks 2>$tempdir/subprocess`;
    foreach (@@tmp)
    {
	my $name;

	@@info=split(/:/);
	# only public keys and uids are of interest
	next if ($info[0] ne "pub" && $info[0] ne "uid");

	$info[4] =~ s/^.{8}//;	# truncate key-id

	# no dsa/elg-keys, please
	# and be sure to skip these uid's, too
	if ($info[3] > 1)
	{
	    &logit("ignoring dsa/elg key 0x$info[4]") if ($debug);
	    undef $lastkey;
	    next;
	}

	# fixme lowprio: general unquote
	$info[9] =~ s/\\x3a/:/g; # re-insert colons, please

	# remember the email address
	# if no address given: remember this key 
	# but go on to the uid's to get an email address to
	# work with
	if ($info[9] =~ /<(.+)>/)
	{
	    $name=lc($1);
	}
	else
	{
	    undef $name;
	}

	if ($info[0] eq "pub")
	{
	    $lastkey=$info[4];

	    # ignore expired, revoked and other bad keys
	    if (defined $badcauses{$info[1]})
	    {
		&logit("ignoring RSA key 0x$info[4], reason: "
		       .$badcauses{$info[1]});
		next;
	    }
	    
	    if ($name)
	    {
		$stdkeys{$name}="0x$lastkey";
		
		&logit("got stdkey 0x$lastkey for $name")
		    if ($debug);
	    }
	    else
	    {
		&logit("saved stdkey 0x$lastkey, no address known yet")
		    if ($debug);
	    }
	    next;
	}
	else
	{
	    # uid: associate the current address with the key 
	    # given in the most recent public key line
	    # if no such key saved: the pub key was an dsa key &
	    # we're set to ignore those
	    if (!$lastkey)
	    {
		$name="<no valid address>" if (!$name);
		&logit("ignoring uid $name, belongs to dsa/elg key")
		    if ($debug);
	    }
	    else
	    {
		if ($name)
		{

		    # ignore expired, revoked and other bad keys
		    if (defined $badcauses{$info[1]})
		    {
			&logit("ignoring RSA uid $name for 0x$lastkey, "
			       ."reason: ".$badcauses{$info[1]});
			next;
		    }

		    $stdkeys{$name}="0x$lastkey";
		    &logit("got stdkey (uid) 0x$lastkey for $name")
			if ($debug);
		}
		else
		{
		    &logit("ignoring uid without valid address")
			if ($debug);
		}
	    }
	}
    }
    return %stdkeys;
@


1.25
log
@fixed loop bug, added proper default action
@
text
@d23 1
a23 1
#   $Id: kuvert,v 1.24 2002/09/19 16:25:46 az Exp az $
d1268 1
a1268 2
	$cmd="$GPG --no-options --load-extension idea "
	    ."--no-literal --encrypt --rfc1991 --cipher-algo idea "
@


1.24
log
@added better secretondemand handling
@
text
@d23 1
a23 1
#   $Id: kuvert,v 1.23 2002/09/19 14:58:21 az Exp az $
d718 2
d838 1
d840 1
a840 1
	close F;
d842 22
a863 2
	# generate queuedir if not existing
	if (!-d $queuedir)
d865 1
a865 30
	    unlink "$queuedir";
	    &bailout("cant mkdir $queuedir: $!")
		if (!mkdir($queuedir,0700));
	}
	# check queuedir owner & perm
	elsif ((stat($queuedir))[4] != $<)
	{
	    &bailout("$queuedir is not owned by you - refusing to run");
	}
	elsif ((stat($queuedir))[2]&0777 != 0700)
	{
	    &bailout("$queuedir does not have mode 0700 - refusing to run");
	}

	# gen tempdir for storing mime-stuff
	if (!-d $tempdir)
	{
	    unlink "$tempdir";
	    if (!mkdir($tempdir,0700))
	    {
		&bailout("cant mkdir $tempdir: $!");
	    }
	}
	elsif ((stat($tempdir))[4] != $<)
	{
	    &bailout("$tempdir is not owned by you - refusing to run");
	}
	elsif ((stat($tempdir))[2]&0777 != 0700)
	{
	    &bailout("$tempdir does not have mode 0700 - refusing to run");
d868 9
a876 1

d880 1
a880 1

@


1.23
log
@added MTA option
@
text
@d23 1
a23 1
#   $Id: kuvert,v 1.22 2002/09/19 09:51:25 az Exp az $
d152 1
a152 1
    open(PIDF,"$pidf") || die "cant open $pidf: $!\n";
d157 1
a157 1
    die "no valid pid found, cant kill any process.\n"
d159 2
a160 4
    if (!kill $sig, $pid)
    {
	die "cant kill -$sig $pid: $!\n";
    }
d165 2
a166 6
if (! -r $config)
{
    logit("no configuration file, can't start!");
    die("no configuration file, can't start!\n");
    exit 1;
}
d173 1
a173 1
    open(PIDF,"+<$pidf") || die "cant open <+$pidf: $!\n";
d177 1
a177 6
    open(PIDF,">$pidf") || die "cant open >$pidf: $!\n";
}
if (!flock(PIDF,LOCK_NB|LOCK_EX))
{
    logit("cant lock $pidf ($!), another process running?, exiting");
    die "cant lock $pidf ($!), another process running?, exiting\n";
d180 5
a184 4
# get the list of known keys and the configuration-stuff,
# setup the queuedir and tempdir
# the hup-handler does this
handle_reload();
d188 2
a189 5
if ($res=cleanup($tempdir,0))
{
    logit("cant clean $tempdir: $res");
    die "cant clean $tempdir: $res\n";
}
d195 1
a195 1
die "secrets could not be initialized properly: $res\n" if ($res);
d201 1
a201 1
    die "fork failed: $!\n"
d211 2
d225 2
a226 5
    if (!opendir(D,"$queuedir"))
    {
	logit("cant open $queuedir: $!");
	die "cant open $queuedir: $!";
    }
d691 1
d694 16
d713 86
a798 76
    if (!open (F,$config))
    {
	logit("cant open $config: $!\n");
	die "can't open $config: $!\n";
    }
    else
    {
	logit("reading config file");
	%config=();
	@@configkeys=();
	while (<F>)
	{
	    chomp;
	    next if (/^\#/ || /^\s*$/); # strip comments and empty lines
	    # if the keyid given is 0, don't do ng pgp at all
	    if (/^NGKEY\s+(\S.*)$/)
	    {
		$ng_defkey=$1;
		logit("set default ng key ng to $1") if ($options{"d"});
		next;
	    }
	    # if the keyid given is 0, don't do std pgp at all
	    if (/^STDKEY\s+(\S.*)$/)
	    {
		$std_defkey=$1;
		logit("set default std key to $1") if ($options{"d"});
		next;
	    }
	    if (/^PGPPATH\s+(\S.+)\s*$/)
	    {
		$PGP=$1;
		logit("set pgppath to $1") if ($options{"d"});
		next;
	    }
	    if (/^GPGPATH\s+(\S.+)\s*$/)
	    {
		$GPG=$1;
		logit("set gpgpath to $1") if ($options{"d"});
		next;
	    }
	    if (/^USEPGP\s+(\d)/)
	    {
		$use_pgp=$1;
		logit("set use_pgp to $1") if ($options{"d"});
		next;
	    }
	    if (/^AGENTPATH\s+(\S.+)\s*$/) # 
	    {
		$agent=$1;
		logit("set agent to $1") if ($options{"d"});
		next;
	    }
	    if (/^CLIENTPATH\s+(\S.+)\s*$/)
	    {
		$client=$1;
		logit("set client to $1") if ($options{"d"});
		next;
	    }
	    if (/^MTA\s+(\S.+)\s*$/)
	    {
		$mtaopt=$1;
		logit("set mta to $1") if ($options{"d"});
		next;
	    }
	    if (/^SECRETONDEMAND\s+(\d)/)
	    {
		$secret_on_demand=$1;
		logit("set secret_on_demand to $1") if ($options{"d"});
		next;
	    }
	    if (/^ALWAYSTRUST\s+(\d)/)
	    {
		$alwaystrust=$1;
		logit("set alwaystrust to $1") if ($options{"d"});
		next;
	    }
a799 6
	    if (/^QUEUEDIR\s+(\S+)\s*$/)
	    {
		logit("set queuedir to $1") if ($options{"d"});
		$queuedir=$1;
		next;
	    }
d801 6
a806 6
	    if (/^INTERVAL\s+(\d+)\s*$/)
	    {
		logit("set interval to $1") if ($options{"d"});
		$interval=$1;
		next;
	    }
d808 13
d822 4
a825 1
	    if (/^TEMPDIR\s+(\S+)\s*$/)
d827 3
a829 3
		logit("set tempdir to $1") if ($options{"d"});
		$tempdir=$1;
		next;
d831 1
a831 2

	    if (/^LOGFILE\s+(\S+)\s*$/)
d833 1
a833 28
		# close old logfile if there is one
		close $lf
		    if ($logfile && $logfile ne $1);
		$logfile=$1;		
		# we append to the logfile
		if (!open($lf,">>$logfile"))
		{
		    logit("cant open logfile $logfile: $!");
		    die("cant open logfile $logfile: $!\n");
		}
		$lf->autoflush(1);
		logit("set logfile to $1") if ($options{"d"});
		next;
	    }

	    if (/^(\S+)\s+(\S+)\s*$/)
	    {
		my ($key,$action)=(lc($1),lc($2));
		if ($action=~/^(none|std(sign)?|ng(sign)?|fallback)(-force)?$/)
		{
		    $config{$key}=$action;
		    push @@configkeys, $key;
		    logit("got conf $action for $key") if ($options{"d"});
		}
		else
		{
		    logit("ignoring bad action \"$action\" for $key");
		}
d836 1
d843 2
a844 5
	    if (!mkdir($queuedir,0700))
	    {
		logit("cant mkdir $queuedir: $!");
		die "cant mkdir $queuedir: $!\n";
	    }
d849 1
a849 2
	    logit("$queuedir is not owned by you - refusing to run");
	    die "$queuedir is not owned by you - refusing to run";
d853 1
a853 2
	    logit("$queuedir does not have mode 0700 - refusing to run");
	    die "$queuedir does not have mode 0700 - refusing to run";
d862 1
a862 2
		logit("cant mkdir $tempdir: $!");
		die "cant mkdir $tempdir: $!\n";
d867 1
a867 2
	    logit("$tempdir is not owned by you - refusing to run");
	    die "$tempdir is not owned by you - refusing to run";
d871 1
a871 2
	    logit("$tempdir does not have mode 0700 - refusing to run");
	    die "$tempdir does not have mode 0700 - refusing to run";
d880 2
a881 5
    if (! -x $GPG)
    {
	logit("bad ng executable '$GPG' -- exiting");
	die "bad ng executable '$GPG' -- exiting\n";
    }
d883 2
a884 5
    if ($use_pgp && ! -x $PGP)
    {
	logit("bad std executable '$PGP' -- exiting");
	die "bad std executable '$PGP' -- exiting\n";
    }
d888 3
a890 9
	if (! -x $1)
	{
	    logit("bad MTA '$mtaopt' -- exiting");
	    die "bad MTA '$mtaopt' -- exiting\n";
	}
	else
	{
	    $mta=$mtaopt;
	}
d897 2
a898 5
	    if (! -x $x)
	    {
		logit("bad agent executable '$x' -- exiting");
		die "bad agent executable '$x' -- exiting\n";
	    }
a900 6

    logit("reading std keyring.");
    %stdkeys=&std_listkeys;
    logit("reading ng keyring.");
    %ngkeys=&ng_listkeys;
    return;
d1550 1
d1554 5
d1561 1
a1561 1
	$res = 0xffff & system "$client put $id 2>$tempdir/subprocess";
d1567 1
a1567 1
	    return "secret-client returned error code $res\n"
d1660 1
a1660 2
    # set the std std keys if no overrides given and keys were returned
    # by the lookup
a1668 1

d1700 1
a1700 1
		    || die "cant exec $agent: $!\n";
d1704 2
a1705 5
    elsif ($secret_on_demand)
    {
	return "secret_on_demand without agent-support is not possible.";
    }
    if (!$secret_on_demand || !$ENV{"DISPLAY"})
d1715 2
a1716 1
		return $res if ($res);
d1731 2
a1732 1
		return $res if ($res);
a1751 13
	if ($std_defkey)
	{
	    $res = 0xffff & system "$client delete $std_defkey";
	    &logit("problem deleting secret for $std_defkey: $res")
		if ($res);
	}
	if ($ng_defkey)
	{
	    $res = 0xffff & system "$client delete $ng_defkey";
	    &logit("problem deleting secret for $ng_defkey: $res")
		if ($res);
	}

d1759 15
d1779 1
a1779 1
# requests the passphrase from secret agent and runs it 
d1803 1
a1803 1
	# otherwise nuke the key in order to make 
d1911 5
a1915 1
    
d1917 3
@


1.22
log
@some more sanity checks
@
text
@d23 1
a23 1
#   $Id: kuvert,v 1.21 2002/09/19 09:13:13 az Exp az $
d549 2
a550 2
		       "It has been signed conforming to RFC2015.\n",
		       "You'll need PGP or GPG to check the signature.\n"]);
d707 1
a707 1
    my (@@tmp,$lastkey);
d768 6
d897 1
d903 13
d917 1
a917 1
    if ($use_agent)
@


1.21
log
@fixed missing config startup,
fixed $TMPDIR handling
@
text
@d23 1
a23 1
#   $Id: kuvert,v 1.20 2002/04/27 15:49:50 az Exp az $
d99 1
a99 1
# cat
d169 2
a170 2
    logit("no configuration file, can't start");
    die("no configuration file, can't start");
d884 24
@


1.20
log
@fixed stupid typo
@
text
@d23 1
a23 1
#   $Id: kuvert,v 1.19 2002/04/26 02:11:33 az Exp az $
d63 1
a63 1
my $tempdir="/tmp/kuvert.$<.$$";
d167 7
d713 1
@


1.19
log
@fixed ng-sign typo
@
text
@d23 1
a23 1
#   $Id: kuvert,v 1.18 2002/04/25 14:31:58 az Exp az $
d1871 1
a1871 1
		|| ($ngkeys{$addr} && ($actions{$addr}="std"))
@


1.18
log
@fixed -force handling
added immutability of none
better logging in debug mode
@
text
@d23 1
a23 1
#   $Id: kuvert,v 1.17 2002/03/05 13:18:49 az Exp az $
d1842 1
a1842 1
	    $force="std-sign" if (grep(!exists $stdkeys{$_}, @@affected));
d1846 1
a1846 1
	    $force="ng-sign" if (grep(!exists $ngkeys{$_}, @@affected));
d1850 2
a1851 2
	    # fallback-logic: ng-crypt or std-crypt, otherwise ng-sign
	    # -force: ng- or std-crypt for all, otherwise ng-sign
@


1.17
log
@fixed send_bounce finally
@
text
@d23 1
a23 1
#   $Id: kuvert,v 1.16 2002/03/05 13:02:53 az Exp az $
d314 1
a314 1
    my $custom_conf=$in_ent->head->get($conf_header);
d319 4
a322 1

d352 3
a354 2
    # save all recipients, necessary for override-handling
    map { push @@recip_all, lc($_->address); }  Mail::Address->parse($in_ent->head->get("To"),
a356 128
    # check if there is one with an override in there
    # but only if there's no custom header already
    if (!$custom_conf)
    {
	foreach (@@recip_all)
	{
	    if (grep($_,@@configkeys))
	    {
		if ($config{$_} =~ 
		    /^((std|ng)(sign)?|none|fallback)-force$/)
		{
		    $custom_conf=$config{$_};
		    logit("found override $custom_conf for $_");
		    last;		# more than one override -> undefined...
		}
	    }
	}
    }
    # handle -force options:
    $custom_conf =~ s/^(none|stdsign|ngsign)-force$/$1/;

    # fallback to signing if not all recipients have keys of any kind
    if ($custom_conf eq "fallback-force")
    {	
	$custom_conf="fallback";
	$custom_conf="ngsign" 	
	    if (grep(!exists $ngkeys{$_} && !exists $stdkeys{$_}, @@recip_all));
    }
    elsif ($custom_conf eq "ng-force")
    {
	$custom_conf="ng";
	$custom_conf="ngsign"
	    if (grep(!exists $ngkeys{$_}, @@recip_all));
    }
    elsif ($custom_conf eq "std-force")
    {
	$custom_conf="std";
	$custom_conf="stdsign"
	    if (grep(!exists $stdkeys{$_}, @@recip_all));
    }

    foreach my $tmp (@@recip_all)
    {
	my $key="";
	my $value="";

	# if there is a custom configuration header,
	# set its content for all the recipients
	if ($custom_conf)
	{
	    $value=lc($custom_conf);
	    logit("found custom conf header, set $tmp -> $value")
		if ($options{"d"});
	}
	else
	{
	    # traverse the config an find first match
	    foreach (@@configkeys)
	    {
		if ($tmp =~ /$_/i)
		{
		    $key=$_;
		    logit("addr $tmp matches special case $_ -> $config{$key}")
			if ($options{"d"});
		    last;
		}
	    }
	}

	# if we've got no config for this address,
	# we use the default configuration, if a/v
	# if there is no default config, we do not sign/crypt at all.
	# if value is set, dont set the key!!
	$key="default"
	    if (!$key && !$value);

	# try ng enc, then std enc, else ng sign
	if (lc($config{$key}) eq "fallback"
	    || ( $custom_conf && $value eq "fallback" ))
	{
	    if ($ngkeys{$tmp})
	    {
		push @@recip_crypt_ng,$tmp;
	    }
	    elsif ($stdkeys{$tmp})
	    {
		push @@recip_crypt_std,$tmp;
	    }
	    else
	    {
		push @@recip_sign_ng,$tmp;
	    }
	}
	elsif (lc($config{$key}) eq "ngsign"
	       || ( $custom_conf && $value eq "ngsign" )) # ng, but signonly
	{
	    push @@recip_sign_ng,$tmp;
	}
	elsif (lc($config{$key}) eq "ng"
	       || ( $custom_conf && $value eq "ng" )) # ng-keys, but encr if possible
	{
	    my $ref=\@@recip_sign_ng;

	    $ref=\@@recip_crypt_ng
		if ($ngkeys{$tmp});

	    push @@$ref,$tmp;
	}
	elsif (lc($config{$key}) eq "stdsign"
	       || ( $custom_conf && $value eq "stdsign" )) # std, but signonly
	{
	    push @@recip_sign_std,$tmp;
	}
	elsif (lc($config{$key}) eq "std"
	       || ( $custom_conf && $value eq "std")) # consider only std-keys
	{
	    my $ref=\@@recip_sign_std;

	    $ref=\@@recip_crypt_std
		if ($stdkeys{$tmp});
	    push @@$ref,$tmp;
	}
	else			# everything else means no sign/crypt at all
	{
	    push @@recip_none,$tmp;
	}
    }

d360 1
a360 2
    if (!@@recip_crypt_ng && !@@recip_crypt_std && !@@recip_sign_ng
	&& !@@recip_sign_std && !@@recip_none)
d365 10
d814 11
a824 3
		$config{lc($1)}=$2;
		push @@configkeys, lc($1);
		logit("got conf $2 for $1") if ($options{"d"});
d1785 102
a1886 1
    
@


1.16
log
@changed address format for bounce
@
text
@d23 1
a23 1
#   $Id: kuvert,v 1.15 2002/02/16 12:02:54 az Exp az $
d1025 1
a1025 1
    print F "From: $name ($progname)\nTo: $name\nSubject: Mail Send Failure\n\n";
@


1.15
log
@fixed version generation
@
text
@d23 1
a23 1
#   $Id: kuvert,v 1.14 2002/02/05 23:44:47 az Exp az $
d1025 1
a1025 1
    print F "From: $progname <$name>\nTo: <$name>\nSubject: Mail Send Failure\n\n";
@


1.14
log
@fixed version
@
text
@d23 1
a23 1
#   $Id: kuvert,v 1.13 2002/01/30 14:23:21 az Exp az $
d44 2
a45 2
# manually updated...not perfect
my $version="1.0.7";
@


1.13
log
@added version and version output at start
@
text
@d23 1
a23 1
#   $Id: kuvert,v 1.12 2002/01/30 13:36:38 az Exp az $
d45 1
a45 1
my $version="1.0.5";
@


1.12
log
@added interval option
@
text
@d23 1
a23 1
#   $Id: kuvert,v 1.11 2002/01/27 12:32:31 az Exp az $
d37 1
a37 1
if (!getopts("dkrn",\%options) || @@ARGV)
d39 2
a40 2
    print "usage: $0 [-n] [-d] | [-k] | [-r] \n-k: kill running $0\n"
	."-d: debug mode\n-r: reload keyrings and configfile\n-n don't fork\n";
d44 9
d166 2
@


1.11
log
@fixed subtle bug with handling of disabled std pgp
@
text
@d23 1
a23 1
#   $Id: kuvert,v 1.10 2002/01/02 06:59:22 az Exp az $
d883 8
@


1.10
log
@fixed output format for revoked or invalid stuff
@
text
@d23 1
a23 1
#   $Id: kuvert,v 1.9 2002/01/02 06:42:48 az Exp az $
d821 1
a821 1
	    if (/^NGKEY\s+(\S.+)$/)
d828 1
a828 1
	    if (/^STDKEY\s+(\S.+)$/)
@


1.9
log
@fixed usage message
@
text
@d23 1
a23 1
#   $Id: kuvert,v 1.8 2002/01/02 06:39:34 az Exp az $
a1410 9
	# ignore expired, revoked and other bad keys
	if (defined $badcauses{$info[1]})
	{
	    &logit("ignoring DSA ".
		   ($info[0] eq "pub"? "key 0x$info[4]":"uid 0x$lastkey")." reason: "
		   .$badcauses{$info[1]});
	    next;
	}

d1436 8
d1472 8
a1527 8
	# ignore expired, revoked and other bad keys
	if (defined $badcauses{$info[1]})
	{
	    &logit("ignoring RSA key 0x$info[4], reason: "
		   .$badcauses{$info[1]});
	    next;
	}

d1547 8
d1586 9
@


1.8
log
@fixed handling of revoked keys
added -force actions
@
text
@d23 1
a23 1
#   $Id: kuvert,v 1.7 2001/12/12 13:31:02 az Exp az $
d40 1
a40 1
	."-d: debug mode\n-r: reload keyrings and configfile\n-n don't fork";
@


1.7
log
@fixed handling revoked/disabled keys
@
text
@d23 1
a23 1
#   $Id: kuvert,v 1.6 2001/11/25 11:39:53 az Exp az $
d337 4
a340 1
	@@recip_crypt_std,@@recip_crypt_ng);
d342 42
a383 2
    foreach (Mail::Address->parse($in_ent->head->get("To"),
				       $in_ent->head->get("Cc")))
a384 1
	my $tmp=lc($_->address);
d476 1
a476 1
	return "no recipients found! the mail header seems to be garbled.";
d1414 2
a1415 1
	    &logit("ignoring DSA key 0x$info[4], reason: "
a1416 1
	    undef $lastkey;	# uids have no expiry, still BSTS...
a1525 1
	    undef $lastkey;	# uids have no expiry, still BSTS...
@


1.6
log
@added option -n
fixed debug mode
@
text
@d23 1
a23 1
#   $Id: kuvert,v 1.5 2001/11/11 11:41:05 az Exp az $
a33 1
use Time::Local;
d176 1
a176 1
handle_hup();
d1342 2
d1369 2
a1370 2
	# ignore expired keys
	if ($info[6] && $info[6]=~/^(\d+)-(\d+)-(\d+)$/)
d1372 4
a1375 7
	    # yyyy-mm-dd
	    if (timegm(0,0,0,$3,$2-1,$1-1900)<$now)
	    {
		&logit("ignoring expired DSA key 0x$info[4]");
		undef $lastkey;	# uids have no expiry, still BSTS...
		next;
	    }
d1452 2
d1479 2
a1480 2
	# ignore expired keys
	if ($info[6] && $info[6]=~/^(\d+)-(\d+)-(\d+)$/)
d1482 4
a1485 7
	    # yyyy-mm-dd
	    if (timegm(0,0,0,$3,$2-1,$1-1900)<$now)
	    {
		&logit("ignoring expired RSA key 0x$info[4]");
		undef $lastkey;	# uids have no expiry, still BSTS...
		next;
	    }
@


1.5
log
@added logging to file
@
text
@d23 1
a23 1
#   $Id: kuvert,v 1.4 2001/11/11 10:28:53 az Exp az $
d38 1
a38 1
if (!getopts("dkr",\%options) || @@ARGV)
d40 2
a41 2
    print "usage: $0 [-d] | [-k] | [-r] \n-k: kill running $0\n"
	."-d: debug mode\n-r: reload keyrings and configfile\n";
d142 1
a142 1
    my $sig=($options{"r"}?'HUP':'TERM');
d193 1
a193 1
if (!$options{"d"})
d208 2
a209 2
# install the hup-handler
$SIG{'HUP'}=\&handle_hup;
d211 1
d271 1
d761 1
a761 1
sub handle_hup
@


1.4
log
@fixed tempdir, queuedir generation
sendmail errormode changed to -oem
fixed handling for no gpg or no pgp
@
text
@d23 1
a23 1
#   $Id: kuvert,v 1.3 2001/11/10 04:55:38 az Exp az $
d35 1
d132 3
d673 1
a673 1
# log the msg(s) to syslog
d678 14
a691 4
    setlogsock('unix');
    openlog($progname,"pid,cons","mail");
    syslog("notice","$msg");
    closelog;
d754 1
d845 17
@


1.3
log
@generate an error message if there is no recipient to be found
@
text
@d23 1
a23 1
#   $Id: kuvert,v 1.2 2001/11/06 13:00:27 az Exp az $
d51 1
a51 1
my $mta="/usr/lib/sendmail -om -oi -oee";
d73 1
a73 1
my $progname="kuvert V1.0.0";
d429 1
a429 1
	return "no recipients found! header seems to be garbled.";
d503 4
d520 4
d539 4
d559 4
d762 1
d769 1
a822 22

		# generate queuedir if not existing
		if (!-d $queuedir)
		{
		    unlink "$queuedir";
		    if (!mkdir($queuedir,0700))
		    {
			logit("cant mkdir $queuedir: $!");
			die "cant mkdir $queuedir: $!\n";
		    }
		}
		# check queuedir owner & perm
		elsif ((stat($queuedir))[4] != $<)
		{
		    logit("$queuedir is not owned by you - refusing to run");
		    die "$queuedir is not owned by you - refusing to run";
		}
		elsif ((stat($queuedir))[2]&0777 != 0700)
		{
		    logit("$queuedir does not have mode 0700 - refusing to run");
		    die "$queuedir does not have mode 0700 - refusing to run";
		}
a829 21

		# gen tempdir for storing mime-stuff
		if (!-d $tempdir)
		{
		    unlink "$tempdir";
		    if (!mkdir($tempdir,0700))
		    {
			logit("cant mkdir $tempdir: $!");
			die "cant mkdir $tempdir: $!\n";
		    }
		}
		elsif ((stat($tempdir))[4] != $<)
		{
		    logit("$tempdir is not owned by you - refusing to run");
		    die "$tempdir is not owned by you - refusing to run";
		}
		elsif ((stat($tempdir))[2]&0777 != 0700)
		{
		    logit("$tempdir does not have mode 0700 - refusing to run");
		    die "$tempdir does not have mode 0700 - refusing to run";
		}
d841 43
d987 2
d1312 3
a1314 1
    @@tmp=`$GPG -q --batch --list-keys --with-colons --no-expensive-trust-checks`;
d1423 3
a1425 1
    @@tmp=`$GPG -q --batch --list-keys --with-colons --no-expensive-trust-checks`;
d1592 1
a1592 1
	@@tmp=`$GPG -q --batch --list-secret-keys --with-colons`;
d1609 1
a1609 1
    @@tmp=`$GPG -q --batch --list-secret-keys --with-colons`;
d1637 2
a1638 2
    $std_defkey=$stdkey if (!$std_defkey && $stdkey);
    $ng_defkey=$ngkey if (!$ng_defkey && $ngkey);
d1641 1
a1641 1
	if (!$std_defkey);
d1643 1
a1643 1
	if (!$ng_defkey);
a1674 1
		# but must not let quintuple-agent fork...
d1676 1
a1676 1
		exec "$agent","--nofork"
d1687 14
a1700 8
	# get the std passphrase and verify it
	do
	{
	    $res=&askput_secret($std_defkey);
	    return $res if ($res);
	    $res=std_sign(undef,undef);
	    print "wrong passphrase, try again.\n"
		if ($res);
a1701 1
	while ($res);
d1704 2
a1705 1
	do
d1707 9
a1715 5
	    $res=&askput_secret($ng_defkey);
	    return $res if ($res);
	    $res=ng_sign(undef,undef);
	    print "wrong passphrase, try again.\n"
		if ($res);
a1716 1
	while ($res);
d1730 12
a1741 6
	$res = 0xffff & system "$client delete $std_defkey";
	&logit("problem deleting secret for $std_defkey: $res")
	    if ($res);
	$res = 0xffff & system "$client delete $ng_defkey";
	&logit("problem deleting secret for $ng_defkey: $res")
	    if ($res);
@


1.2
log
@added --no-expensive-trust-checks for speeding up the keyring checks
@
text
@d23 1
a23 1
#   $Id: kuvert,v 1.1 2001/11/06 12:53:15 az Exp az $
d422 11
d447 2
a448 1
    # shortcut if no other recipients are given
@


1.1
log
@Initial revision
@
text
@d23 1
a23 1
#   $Id: guard,v 2.10 2001/09/21 00:01:16 az Exp $
d1280 1
a1280 1
    @@tmp=`$GPG -q --batch --list-keys --with-colons`;
d1389 1
a1389 1
    @@tmp=`$GPG -q --batch --list-keys --with-colons`;
@
