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


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.16
log
@signatures are now tagged more extensively (as per hint
by Andreas Labres/Andreas Kreuzinger)
@
text
@#!/usr/bin/perl
#
# this file is part of kuvert, a wrapper around sendmail that
# does pgp/gpg signing/signing+encrypting transparently, based
# on the content of your public keyring(s) and your preferences.
#
# copyright (c) 1999-2005 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 as published by
#   the Free Software Foundation; either version 2 of the License, or
#   any later version.
#
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software
#   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
#   $Id: kuvert,v 2.15 2005/11/04 06:21:20 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 FileHandle;
use Term::ReadKey;
use Proc::PID::File;

# some global stuff
# the version number is inserted by make install
my $version="INSERT_VERSION";
my $progname="kuvert";
# who are we gonna pretend to be today?
my($username,$home)=(getpwuid($<))[0,7];
# where is the configuration file
my $rcfile="$home/.kuvert";
# 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=();

my $piddir=($ENV{'TMPDIR'}?$ENV{'TMPDIR'}:"/tmp");
my $pidname="$progname.$<";

sub main
{
    my %options;

    if (!getopts("dkrnvb",\%options) || @@ARGV)
    {
	die "usage: $progname [-n] [-d] [-v] [-b]| [-k] | [-r] 
-k: kill running $progname
-d: debug mode
-r: reload keyrings and configfile
-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"});

    # 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');

	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;
    }

    if (! -e $rcfile)
    {
	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"
    }

    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})
    {
	# 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});
    }

    if (!$debug && !$options{"n"})
    {
	my $res=fork;

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

    # 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)
    {
	&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});
    }
}

# processes a file in the queue, does not remove stuff from the tempdir or the queue
# exception on errors
sub process_file
{
    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)))
    {
	# 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.

	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/)
	{
	    # 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}->{$_}],$_);
	    }
	    next;
	}
	
	if ($action=~/sign/)
	{
	    logit("sending mail (sign,$type) to ".join(",",@@recips));
	    &sign_send($in_ent,$input,$type,$orig_header,@@recips);
	    next;
	}
	else
	{
	    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);
	}
    }
}

# sign an entity and send the resulting email to the listed recipients
# args: entity, location of dump of entity, type, outermost headers, recipients
# exception on errors
sub sign_send
{
    my ($ent,$dumpfile,$type,$header,@@recips)=@@_;
    my $output="$config{tempdir}/.signout";

    # 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" => ($type eq "ng"?"pgp-sha1":"pgp-md5"));

    $newent->preamble(["This is a multi-part message in MIME format.\n",
		       "It has been signed conforming to RFC3156.\n",
		       "You need GPG or PGP to check the signature.\n"]);

    # add the passed entity as part
    $newent->add_part($ent);

    # generate the signature, repeat until proper passphrase given
    while (&sign_encrypt(0,$type,$dumpfile,$output,undef))
    {
	# 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
	{
	    # bad passphrase but we're on our own -> cant recover
	    bailout("bad passphrase, but no passphrase store to query!");
	}
    }
    # 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
    &send_entity($newent,@@recips);
}

# encrypt and sign an entity, send the resulting email to the listed recipients
# args: entity, location of dump of entity, type, outermost headers, recipient keys, recipient addresses
sub crypt_send
{
    my ($ent,$dumpfile,$type,$header,$rec_keys,@@recips)=@@_;
    my $output="$config{tempdir}/.encout";

    # 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 the new preamble
    $newent->preamble(["This is a multi-part message in MIME format.\n",
		       "It has been encrypted conforming to RFC3156.\n",
		       "You need PGP or 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
    while (&sign_encrypt(1,$type,$dumpfile,$output,@@{$rec_keys}))
    {
	# 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
	{
	    # bad passphrase but we're on our own -> cant recover
	    bailout("bad passphrase, but no passphrase store to query!");
	}
    }
    
    # attach the encrypted data
    $newent->attach(Type => "application/octet-stream",
		    Path => "$output",
		    Filename => undef,
		    Disposition => "inline",
		    Encoding=>"7bit");

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


# 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
{
    my ($ent,@@args)=@@_;

    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]: $!");
    }
}

# 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 0;
}

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

    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);
	}
    }
    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
{
    logit("rereading config file");
    &read_config;
    &read_keyrings;
}

# 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}}=();

    if ($config{usepgp})
    {
	if (!$config{stdkey})
	{
	    logit("ignoring std keyring, no key a/v.");
	}
	else
	{
	    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);
		}
	    }
	}
    }

    %{$keys{ng}}=();

    if ($config{ngkey} || !$config{usepgp} && $config{stdkey})
    {
	logit("reading ".(!$config{usepgp} && $config{stdkey}?"combined":"ng")." keyring.");

	# 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>]+)>?/)
	    {
		$name=lc($2);
	    }
	    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];
		$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);
		    }
		}
	    }
	}
    }
    else
    {
	logit("ignoring ng keyring, no key a/v.");
    }
}

# reads the configuration file, sets config variables
# exception on major problems
# no retval. changes %config and @@overrides on success.
sub read_config
{
    my @@over;

    # 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>)
    {
	chomp;
	next if (/^\#/ || /^\s*$/); # strip comments and empty lines

	if (/^(\S+)\s+((none|std(sign)?|ng(sign)?|fallback)(-force)?)\s*$/)
	{
	    my ($key,$action)=(lc($1),lc($2));
	    if ($key eq "default")
	    {
		$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");
	    }
	}
	elsif (/^([[:upper:]]+)\s+(\S.*)\s*$/)
	{
	    my ($key,$value)=(lc($1),$2);

	    if (grep($_ eq $key, keys %newconf))
	    {
		$newconf{$key}=$value;
		$debug && logit("set config $key to $value");
	    }
	    else
	    {
		&bailout("bad config entry \"$_\" -- exiting");
	    }
	}
	else
	{
	    &bailout("bad config entry \"$_\" -- exiting");
	}
    }
    close F;

    # last per-address override is the catch-all default
    push @@over,{"key"=>"default",
		"re"=>qr/.*/,
		"action"=>"$defaction"};

    # 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))
	{
	    &bailout("cant mkdir $newconf{tempdir}: $! -- exiting");
	}
    }
    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});
    
    if ($newconf{logfile})
    {
	&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>)
	{
	    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;
	}
	close F;
	bailout("error running $newconf{gpgpath}: $? -- exiting","$newconf{tempdir}/subproc") if ($?);
	bailout("could not find ngkey -- exiting") if (!$newconf{ngkey});
    }

    if ($newconf{stdkey})
    {
	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);
	}
	else
	{
	    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);
	}
    }
    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;
}

# traverses the entity and sets all parts with
# type == text/plain, charset != us-ascii, transfer-encoding 8bit
# to transfer-encoding qp.
# input: entity, retval: none
sub qp_fix_parts
{
    my ($entity)=@@_;

    if ($entity->is_multipart)
    {
	foreach ($entity->parts)
	{
	    &qp_fix_parts($_);
	}
    }
    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")
	{
	    bailout("changing Content-Transfer-Encoding failed")
		if ($entity->head->mime_attr("content-transfer-encoding"
					     => "quoted-printable")!="quoted-printable");
	}
    }
}

# 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 ($?);
}

 
# 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
{
    my ($enc,$type,$infile,$outfile,@@recips)=@@_;
    my ($passphrase,$passphrase_cmd,$cmd);
        
    # passphrase issues
    if ($config{secretondemand})
    {
	$cmd="|".sprintf($config{getsecret},
			 ($type eq "std"?$config{stdkey}:$config{ngkey}));
    }
    else
    {
	$passphrase=$secrets{$config{($type eq "std"?"stdkey":"ngkey")}};
    }

    # how to arrange the command
    if (!$enc)
    {
	if ($type eq "std" && $config{usepgp})
	{
	    $cmd.="|PGPPASSFD=0 $config{pgppath} +batchmode -u $config{stdkey} -sbat";
	}
	else
	{
	    $cmd.="|$config{gpgpath} -q -t --batch --armor --detach-sign --passphrase-fd 0 --status-fd 1 --default-key";
	    if ($type eq "std")
	    {
		$cmd.=" $config{stdkey} --rfc1991 --cipher-algo idea --digest-algo md5 --compress-algo 1";
	    }
	    else
	    { 
		$cmd.=" $config{ngkey}";
	    }
	}
	
	# 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";
	}
    }
    else			# encrypt and sign
    {
	if ($type eq "std" && $config{usepgp})
	{
	    $cmd.="|PGPPASSFD=0 $config{pgppath} +batchmode "
		."-u $config{stdkey} -seat -o $outfile $infile "
		.join(" ",@@recips);
	}
	else
	{
	    # gpg: normal mode...
	    if ($type ne "std")
	    {
		$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";
	    }
	    else
	    {
		# 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
	    }
	}
    }

    $cmd.=" >$config{tempdir}/subproc 2>&1";

    unlink($outfile) if (-e $outfile);

    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 ($?)
    {
	# 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})
	{
	    open F,"$config{tempdir}/subproc";
	    my @@result=<F>;
	    close F;
	
	    return 1 if (grep(/^\[GNUPG:\] BAD_PASSPHRASE/,@@result));
	}
    
	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);
    }

    # ok, must be in compat mode...let's complete the nasty construction
    
    # 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);

    # lookup addresses in configured overrides
    foreach $addr (@@{$allref},@@{$bccref})
    {
	foreach (@@overrides)
	{
	    if ($addr =~ $_->{re})
	    {
		$actions{$addr}=$_->{action};
		$debug && logit("found directive: $addr -> $actions{$addr}");
		last;
	    }
	}
	# 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});
    }

    # no -force options for bcc
    foreach $addr (@@{$bccref})
    {
	$actions{$addr}=~s/^(\S+)-force$/$1/;
    }

    # check the found actions: anyone with -force options?
    # note: normal addresses only, bcc don't count here
    foreach $addr (@@{$allref})
    {
	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")
	{
	    # downgrade to sign if not all keys a/v
	    $force="stdsign" if (grep(!exists $keys{std}->{$_}, @@affected));
	}
	elsif ($force eq "ng")
	{
	    $force="ngsign" if (grep(!exists $keys{ng}->{$_}, @@affected));
	}
	elsif ($force eq "fallback")
	{
	    # 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));
	}

	# apply forced action to the affected addresses
	map { $actions{$_}=$force; } (@@affected);	 
	$debug && logit("final force directive: $force");
	# the first force-option wins, naturally.
	last;
    }

    # check the actions for fallback, ng or std and expand that
    # also bail out if no suitable keys available!
    foreach $addr (@@{$allref},@@{$bccref})
    {
	if ($actions{$addr} eq "fallback")
	{
	    ($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");
	}
	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});

	} 
	$debug && logit("final action: $addr -> $actions{$addr}");
    }

    # tag ng and std actions for bcc recipients:
    # those must be handled separately (separate encryption step...)
    foreach $addr (@@{$bccref})
    {
	$actions{$addr}=~s/^(ng|std)$/bcc-$1/;
    }
    return %actions;
}

# 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
{
    my ($msg,$detailfn)=@@_;

    if ($detailfn && open(DF,$detailfn))
    {
	push @@detailederror,<DF>;
	close DF;
    }

    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;
    }
    
    logit($msg,$detailfn);
    die($msg."\n");
}


# 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
{
    my ($msg,$detailfn)=@@_;

    if ($detailfn)
    {
	@@detailederror=();
	if (open(DF,$detailfn))
	{
	    push @@detailederror,<DF>;
	    close DF;
	}
    }

    if ($config{logfh})
    {
	# 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";
    }
    else
    {
	setlogsock('unix');
	openlog($progname,"pid,cons","mail");
	syslog("notice",$msg);
	closelog;
    }
}

    
&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`;
@
