#!@perl5@ -s

######################################################################
# to setup, set the folllowing directory and filename, and then edit
# eternity.conf

my $eternity_dir = "@dir@";
my $config_file = "eternity.conf";

# note: whatever user the web server runs cgi-bins as, that user's
# going to need write permission to eternity_dir and contents

######################################################################
# eternity-0.07
# 
# simple type I eternity service boot-strapped off USENET news.
# 
# This version can be run without ability to leave processes running.
#
# requirements:
#   perl5                        (http://www.perl.com/)
#   pgp                          (ftp://ftp.pgp.net/pub/pgp/)
#   sha1                         (C files included to compile your own)
#   www page & cgi-bin capability
#   read access to an NNTP news server or local news spool
#
# use as cgi-bin, or with -u as cron job, set "cgi_update = off" in 
# eternity.conf if you're using cron
#
# See:  http://www.dcs.ex.ac.uk/~aba/eternity/
#       Adam Back <aba@dcs.ex.ac.uk>
# PGP key: adam-key.asc

require 5.001;
use FileHandle;
use Socket;
# use strict;			# debugging aid

chdir $eternity_dir;

# list of vars which can be set in config file
my %config_var = 
    ( "eternity_dir", 1, "eternity_url", 1, "eternity_cgi", 1,
     "perl5_exe", 1, "pgp_exe", 1, "sha1_exe", 1, "echo_exe", 1, 
     "admin_name", 1, "admin_email", 1, 
     "nntp_server", 1, "news_spool", 1, 
     "altavista_sever", 1, "dejanews_server", 1,
     "cache", 1, 
     "cache_size", 1, "cache_dir", 1, 
     "directory_service", 1,
     "newsgroups_file", 1, "lock_dir", 1, "log_file", 1, 
     "cgi_update", 1, "cgi_update_interval", 1 );

# list of eternity flags which can be set
my %flags_var = ( "directory", 1, "exdirectory", 1 );

######################################################################
# defaults

$news_spool = "news";	# test spool
$nntp_server;
$altavista_server;
$dejanews_server;
$cache = 1;		# encrypted
$cache_dir = "cache";
$cache_size = 2048;		# in 2Mb (in Kb)
$directory_service = 1;
$sha1_exe = "/usr/local/bin/sha1";
$pgp_exe = "/usr/local/bin/pgp";
$echo_exe = "echo";
$default_passphrase = "eternity";
$newsgroups_file = "newsgroups";
$article_file = "article";
%article_db;
$lock_dir = "locks";
$admin_name = "Nobody";
$admin_email = 'nobody@dev.null';
$cgi_update = 0;
$cgi_update_interval = 600;		# 10 mins
$log_file = "log";

######################################################################
# logging / debugging options

my $err = 1;			# failures
my $dbg = 2;			# debugging (general)
my $net = 4;			# debug network errors
my $nn = 8;			# debug news sessions
my $adb = 16;			# debug article database
my $pgp = 32;			# debug PGP calls
my $fmt = 64;			# debug eternity document formatting
my $lck = 128;			# debug file locking
my $try = 256;			# temporary
my $fil = 512;			# debug file usage
my %log_name = ( $err, "ERROR", $dbg, "DEBUG", $net, "NETWORK", $nn, "NEWS",
	     $adb, "ARTICLE", $pgp, "PGP", $fmt, "FORMAT", $lck, "LOCK",
	     $try, "TRY", $fil, "FILE" );
my $all = $err + $dbg + $net + $nn + $adb + $pgp + $fmt + $lck + $try + $fil;

# turn on logging here, here's a useful example:
# my $logging = $err + $net + $pgp + $try + $fmt + $nn;

# turn it all on (nearly)
# my $logging = $all - $fil - $log;

# distribution, logging set to errors only
my $logging = $err;

######################################################################
# internal constants, don't alter unless you know whats going on

my $eternity_regexp = '\s+([a-fA-F0-9]{40})\s*$';
my $pgp_flags = "+batchmode +force 2>&1";
my $keys_dir = "keys";
my $pgp_dir = "pgp";
$ENV{"PGPPATH"} = "$eternity_dir/$pgp_dir";	# want a separate PGP environment
my $directory = "directory.html";
my $mime_types_file = "mime.types";
my $copy_exe = "/bin/cp 2> /dev/null";
my $ls_exe = "/bin/ls 2> /dev/null";
my $max_key_len = 5120;		# > 5 Kb public key is big, for a nym
my $max_desc = 64;		# max length of URL description for directory
my $ntmp = 0;			# tmpnam count
my $nntp_connected = 0;		# state of NNTP connection
my $tmp_dir = "/tmp";
my $tmp_file = "et";
my $config_cache = "conf.cache";
my %LOCKS;
my %LCK;
my $LCK_FH_name = "FH";
my $nntp_port;
my $nntp_ipaddr;
my $nntp_addr;
my $nntp_proto;
my $do_directory;;
umask( 0022 );

######################################################################
# config file overrides defaults

if ( -e $config_file )
{
    if ( mod_time( $config_cache ) < mod_time( $config_file ) )
    {
	parse_conf_file( $config_file, $config_cache );
    }
    do $config_cache;
}

if ( $r )			# reset: nuke all cache, databases
{
    print STDERR "removing article database...\n";
    wipe( $article_file, "${article_file}.db" );
    print STDERR "removing $config_cache...\n";
    wipe( $config_cache );
    print STDERR "removing log file...\n";
    wipe( $log_file );
    print STDERR "removing lock files...\n";
    unlink( $log_file );	# no point wiping they're 0 size files
    print STDERR "emptying cache...\n";
    wipe( `$ls_exe $cache_dir/*` );
    print STDERR "emptying keys directory...\n";
    wipe( `$ls_exe $keys_dir/*` );
    exit( 0 );
}

######################################################################
# turn on logging

if ( $logging )
{
    if ( !defined( open( LOG, ">>$log_file" ) ) )
    {
	html_error( "cgi config error: can not open log file: $log_file $!" );
    }
    LOG->autoflush( 1 );
}

if ( $altavista_server ne "" )
{
    LOG( $err, "news protocol altavista not implemented yet" );
    html_error( "config error: news protocol altavista not implemented yet" );
}

if ( $dejanews_server ne "" )
{
    LOG( $err, "news protocol dejanews not implemented yet" );
    html_error( "config error: news protocol dejanews not implemented yet" );
}

if ( $nntp_server ne "" && $news_spool ne "" )
{
    $news_spool = "";		# nntp overrides news spool
}

if ( $nntp_server eq "" && $news_spool eq "" )
{
    LOG( $err, "no news protocol selected" );
    html_error( "config error: no news protocol selected" );
}

$nntp = $nntp_server ne "";

######################################################################
# socket setup

if ( $nntp )
{
    $nntp_port = getservbyname( "nntp", "tcp" );
    $nntp_ipaddr = inet_aton( $nntp_server );
    $nntp_addr = sockaddr_in( $nntp_port, $nntp_ipaddr );
    $nntp_proto = getprotobyname( "tcp" );
}

if ( ! -e $article_file && ! -e "${article_file}.db" )
{
    article_db_create();
}

if ( ! -e "$pgp_dir/secring.pgp" )
{
    touch( "$pgp_dir/secring.pgp" );
}

######################################################################
# read newsgroups file

if ( !open( GROUPS, $newsgroups_file ) )
{
    LOG( $err, "can not open $newsgroups_file" );
    html_error( "cgi config error: can not open newsgroups file: $newsgroups_file" );
}
my @newsgroups;
chop( @newsgroups = <GROUPS> );
close( GROUPS );

######################################################################
# if we're doing eternity -u from a cron job, we always do the update

if ( $u )			# if cron job
{
    update_article_db();
    et_exit( 0 );
}

LOG( $dbg, `printenv` );

######################################################################
# but if this is from cgi-bin invocation, only do if update = on,  
# and more than update_interval has elapsed since last update

my $now;
my $last_update;

if ( $cgi_update )
{
    ( $last_update ) = article_lookup( "time" );
    $now = time;
	    LOG( $dbg, "checking interval < $cgi_update_interval",
			" time now = $now, last checked = $last_update" );
    if ( $last_update + $cgi_update_interval > $now )
    {
	LOG( $dbg, "not updating, interval < $cgi_update_interval", 
	    " time now = $now, last checked = $last_update" );
    }
    else
    {
	update_article_db();
    }
}

######################################################################
# parse URL

my %FORM = cgi_parse();

my $url = $FORM{"url"};
$url =~ s/^\s+//;		# strip leading space
$url =~ s/\s+$//;		# strip trailing space

######################################################################
# try to parse url

# match   http://eternity/string

my( $protocol, $location, $path );
($protocol, $location, $path) = ($url =~ m|^([^:]+)://([^/]+)/(.*)$|);

my $mimetype;

if ( $path ne "" ) 
{ 

# match .mimetype in path

    ($mimetype) = ($path =~ m|\.(\w+)$|);
}

######################################################################
# do wildcard directory searches

if ( $url =~ m/\*/ ) # directory service
{
    if ( ! $directory_service )
    {

	html_error( 
"This server does not keep directories.  You can still access eterntity
documents if you know the URL." );
    }
    serve( $url, "html", 1 );
}

######################################################################
# default mimetype = html

if ($mimetype eq "") { $mimetype = "html"; }

######################################################################
# check URL syntax

if ( $protocol !~ /^https?$/ || ! ($location =~ /eternity$/) )
{
    html_error( "URL \"$url\" is not an eternity url" );
}

######################################################################
# calculate hash of URL

my $url_sha1 = sha1( $url );
my $url_password = sha1( "1$url" );
LOG( $dbg, "SHA1( $url ) = $url_sha1" );

######################################################################
# do directory service

my $doc = fetch_document( $url_sha1, $url_password );
if ( $doc eq "" )
{
    html_error( "Document not found: $url" );
}

######################################################################
# try decrypting with form passphrase if there was one

if ( $FORM{"passphrase"} ne "" )
{
    $doc = maybe_decrypt( $doc, $FORM{"passphrase"} );
}

serve( $doc, $mimetype );

######################################################################
# do the mime content encoding stuff

sub serve
{
    my( $file, $mimetype, $do_directory ) = @_;
    my( $found, $cap, $ext, $url_base, $url_site );
    my( $redir_abs, $redir_site, $redir_rel, $dir_file, $key, $match );

    if ( $do_directory )
    {
	$dir_file = tmpnam();
	if ( !open( DOC, ">$dir_file" ) ) 
	{
	    LOG( $err, "can not open directory file: $dir_file" );
	    html_error( "can not open directory file: $dir_file" );
	}
	$mimetype = "html";
	print "Content-type: text/html\n\n";
	open( DIRECT, $directory );
        while ( <DIRECT> )
        {
            print $_;
        }
        close( DIRECT );
	print "<H2>Listing: $file</H2>\n";

	read_lock( $article_file );
	article_db_open();

        $match = $file;
        $match =~ s/\./\\\./g;

# foreach * (ie repeat as many times as there are *s)

	foreach ( $file =~ m/\*/g )
	{
	    $match =~ s|(//[^/\*]*)\*([^/]*/)|$1\[\^\0\]"$2|g;
	    LOG( $dbg, "match = {$match}" );
        }

	LOG( $dbg, "match1 = {$match}" );
        $match =~ s/\*/.*/g;
	LOG( $dbg, "match2 = {$match}" );
	$match =~ s|\0|/|g;
	LOG( $dbg, "match3 = {$match}" );
	$match =~ s|"|*|g;
	LOG( $dbg, "match4 = {$match}" );

        foreach $key ( keys %article_db )
        {
            if ( $key =~ m/^https?/ && $key =~ m/^$match$/ )
            {
                print DOC "<A HREF=\"$key\">$key</A> $article_db{$key}<BR>\n";
            }
        }
	dbmclose( %article_db );
	unlock( $article_file );
	close( DOC );
	open( DOC, $dir_file );
    }
    else
    {
	if ( !open( MIME, $mime_types_file ) )
	{
	    html_error( "config error: can not open mime.types file" );
	}
	$found = 0;
mimeloop:
	while ( <MIME> )
	{
	    chomp;
	    ($cap, @ext) = split( /\s+/, $_ );
	    foreach $ext ( @ext )
	    {
		if ( $ext eq $mimetype )
	        {
		    $found = 1;
		    last mimeloop;
		}
	    }
	}
	close( MIME );
	if ( !$found ) { $cap = "text/html"; }
	print "Content-type: $cap\n\n";

	if ( !open( DOC, $file ) )
	{
	    LOG( $err, "can not open file: $file" );
	    html_error( "can not open file: $file" );
	}
    }
    if ( $mimetype eq "html" )
    {
	$url_base = $url;
	$url_base =~ s|/[^/]*$|/|;
	$url =~ m|http://[^/]+|;
	$url_site = $&;
	$redir_abs = "$ENV{'SCRIPT_NAME'}?url=";
	$redir_site = "$ENV{'SCRIPT_NAME'}?url=$url_site";
	$redir_rel = "$ENV{'SCRIPT_NAME'}?url=$url_base";
	@doct = <DOC>;
	$_ = join( '', @doct );

# absolute urls
	s|<(A\s+HREF\s*=\s*")\s*(https?://[^/]*eternity/[^"]*)|\0$1$redir_abs$2|gis;
	s|<([^>]+SRC\s*=\s*")\s*(https?://[^/]*eternity/[^"]*)|\0$1$redir_abs$2|gis;
	s|<(BODY\s+BACKGROUND\s*=\s*")\s*(http://[^/]*eternity/[^"]*)|\0$1$redir_abs$2|gis;

# site (http://*.eternity/) relative urls
        s|<(A\s+HREF\s*=\s*")\s*(/[^"]*)|\0$1$redir_site$2|gis;
	s|<([^>]+SRC\s*=\s*")\s*(/[^"]*)|\0$1$redir_site$2|gis;
	s|<(BODY\s+BACKGROUND\s*=\s*")\s*(/[^"]*)|\0$1$redir_abs$2|gis;

# external urls
	s|<(A\s+HREF\s*=\s*"\s*[a-zA-Z]+://[^"]+)|\0$1|gis;
	s|<(A\s+HREF\s*=\s*"\s*mailto:[^"]+)|\0$1|gis;
	s|<(A\s+HREF\s*=\s*"\s*news:[^"]+)|\0$1|gis;
	s|<([^>]+SRC\s*=\s*"\s*[a-zA-Z]+://[^"]+)|\0$1|gis;
	s|<(BODY\s+BACKGROUND\s*=\s*"\s*[a-zA-Z]+://[^"]+)|\0$1|gis;

# relative urls
        s|<(A\s+HREF\s*=\s*")\s*([^"/][^"]*)|\0$1$redir_rel$2|gis;
        s|<([^>]+SRC\s*=\s*")\s*([^"/][^"]*)|\0$1$redir_rel$2|gis;
	s|<(BODY\s+BACKGROUND\s*=\s*")\s*([^"/][^"]*)|\0$1$redir_rel$2|gis;
	s/\0/</gs;
        print $_;
    }
    else
    {
        while ( <DOC> )
	{
	    print $_;
	}
    }
    close( DOC );
    if ( $do_directory )
    {
	print "<P><IMG SRC=\"${eternity_url}rsa.gif\">";
        print "<P>Configuration problems to <EM>", htmlize( $admin_name );
        print " <A HREF=\"mailto:", htmlize( $admin_email ), "\">&LT;";
        print htmlize( $admin_email ), "&GT;</A></EM>\n"; 
        print "</BODY></HTML>\n";
    }
    et_exit( 0 );
}

######################################################################
# fetch document
# 
sub fetch_document
{
    my( $url_sha1, $url_password ) = @_;
    my( $found, $article, $group, %flags, $doc, $policy );
    my( $mid, $pk, $check );

######################################################################
# look in the document cache if we have a cache

    if ( $cache )
    {
	if ( -e "$cache_dir/$url_sha1" )
	{
	    return maybe_decrypt( "$cache_dir/$url_sha1", 
				 $url_password, $default_passphrase );
	}
    }

######################################################################
# then see what we know about this URL

    ($mid, $group, $article, $pk, $policy, %flags) 
	= article_lookup( $url_sha1 );
    
    if ( $group eq "" ) { return ""; }

######################################################################
# fetch article 
    
    LOG( $nn, "fetching article $group $article $hash\n" );
    ($doc, $mid, $check) = news_fetch( $group, $article );
    LOG( $nn, "got article $group $article as $doc, mid = $mid" );
    if ( $doc eq "" || $check ne $url_sha1 )
    {
	return "";
    }

######################################################################
# process article, updating article database

    $doc = process_article( $doc, $mid, $group, $article, $url_sha1, 
			   $url_password );
    LOG( $dbg, "processed article as $doc" );
    if ( $doc eq "" ) { return ""; }

######################################################################
# add it to the cache if policy allows

    maybe_add_to_cache( $doc, $url_sha1, $url_password );

    return $doc;
}


######################################################################
# fetch article from news server

sub news_fetch
{
    my( $group, $article, $ingroup ) = @_;
    my( $resp, $tmp, $file, $we_connected, $mid, $hash, @res, $news );
    my( $gdir );

    if ( $nntp )
    {
# connect to NNTP server

	$we_connected = 0;
	if ( !$nntp_connected )
	{
	    connect_to_nntp_server();
	    $we_connected = 1;
	}

# check that we haven't already done group

	if ( !$ingroup || $we_connected )
	{
	    LOG( $nn, "sending GROUP $group" );
	    print NNTP "GROUP $group\n";
	    $resp = <NNTP>;
	}

# send ARTICLE command to fetch article

	print NNTP "ARTICLE $article\n";
	$resp = <NNTP>;
	if ( $resp =~ /^(\d+)/ )
	{
	    LOG( "got response code $1\n" );
	}

# parse code is same, once we have setup

	$news = "NNTP";
    }
    else
    {
	$gdir = $group; $gdir =~ s|\.|/|g;	#  alt/anonymous/messages
	$file = "$news_spool/$gdir/$article";
	if ( ! -e $file ) { return (); }
	if ( !open( NEWS, $file ) ) { return (); }
	$news = "NEWS";
    }
    
    LOG( $nn, "reading article $group $article" );
    $tmp = tmpnam();
    if ( !open( COPY, ">$tmp" ) )
    {
	@res = ();
	goto CLOSE_AND_RETURN;
    }
    $mid = "";
    $hash = "";
    while ( <$news> )
    {
	if ( $nntp && $_ =~ m/^\.\s*$/ ) # "." marks end of article
        {
            last;
        }
	if ( $mid eq "" ) 
	{
	    if ( /^Message-I[dD]: (\S+)\s*$/ )
	    {
		LOG( $dbg, "found message-id $1" );
		$mid = $1;
	    }
	}
	if ( $hash eq "" )
	{
	    if ( /^Subject:$eternity_regexp/ )
	    {
		$hash = "\L$1";
	    }
	}
	print COPY $_;
	# LOG( $nn, "body: " . length( $_ ). join(",",unpack("C*",$_)) );
    }
    LOG( $nn, "read article: $article\n" );
    @res = ($tmp, $mid, $hash);
CLOSE_AND_RETURN:

######################################################################
# if we opened the connection, we close it, otherwise leave it open

    close( COPY );
    if ( $nntp )
    {
	if ( $we_connected ) { disconnect_from_nntp_server(); }
    }
    else
    {
	close( NEWS );
    }
    return @res;
}

######################################################################
# try decrypting with list of passphrases in order until one succeeds
# if none succeed return unmodified document

sub maybe_decrypt
{
    my( $doc, @phrases ) = @_;
    my( $phrase, $tmp );

    foreach $phrase ( @phrases )
    {
	if ( $phrase ne "" )
	{
	    $tmp = decrypt( $doc, $phrase );
	    if ( $tmp ne "" ) {	return $tmp; }
	}
    }				# return doc if didn't decrypt
    return $doc;		# ie don't decrypt
}

######################################################################
# add document to cache
# fetches the hash policy for this from the article.db file indexed
# by hash

sub maybe_add_to_cache
{
    my( $doc, $hash, $url_password ) = @_;
    my( $cache_choice, $policy );
    my( $m, $g, $a, $pk );

    if ( $cache == 0 ) { return; }

    ($m, $g, $a, $pk, $policy) = article_lookup( $hash );

    LOG( $dbg, "user policy = $policy" );

######################################################################
# maybe the user changed from a policy of on or encrypt to off
# if so there may be old cached files floating around, which ought
# to be nuked

    if ( $policy == 0 )
    {
	if ( -e "$cache_dir/$hash" )
	{
	    wipe( "$cache_dir/$hash" );
	}
	return;			# they said no cacheing, so return now
    }

######################################################################
# user policy is allowed to make it more secure, but not less

    $cache_choice = $policy;	# give user choice
    
    if ( $policy < $cache )	# unless it reduces security
    { 
	$cache_choice = $cache; # use encrypt
    }

######################################################################
# encrypt if policy requires

    if ( $cache_choice == 2 )		# encrypt
    {
	if ( $url_password ne "" )
	{
	    $doc = encrypt( $doc, $url_password );
	}
	else
	{
	    return;		# can't encrypt => don't cache
	}
    }

######################################################################
#
# code to keep track of how full the cache is, and deciding what to
# get rid of when it gets full goes here.

#
# cache replacement policy code goes <- HERE
# 

######################################################################
# do the deed

    `$copy_exe $doc $cache_dir/$hash`;
}

sub process_article
{
    my( $doc, $mid, $group, $article, $hash, $url_password ) = @_;
    my( $tmp, $already_key, $decrypted, $dir_url, $dir_desc );
    my( $seen_before, $already_key, %old_flags, %flags, $flags );
    my( $got_url, $got_desc, $got_key, $got_doc, $got_cache );
    my( $key_file, $policy, $m, $a, $g, $keyhash, $p,  );
    my( $status, $ok, $exit, $len, $junk, $goodsig, $res );
    my( $doc_file, $html_file );

    $decrypted = 0;
    %flags = ();
# try default passwords first

    LOG( $pgp, "decrypting $doc with passphrase $default_passphrase, $url_password" );

    $tmp = maybe_decrypt( $doc, $default_passphrase, $url_password );
    if ( $tmp eq $doc )
    {
# if we can't do anything with it now, remember we saw it
# maybe we'll be able to read it later with a url based passphrase

# TODO:
# note this isn't the right thing to do, really we should hold a list
# of new articles which we can't decrypt, and go look at them 
# when we have the passphrase (that will be when a user shows us the
# URL by trying to retrieve an article with this URL, the passphrase will
# be sha1( "1<URL>" ).  We'll know it's the right URL because it will hash
# to the correct hash

	($m, $g, $a, $keyhash, $policy, %flags) = article_lookup( $hash );
	article_update( $hash, $m, $group, $article, $keyhash, $policy, %flags );
	return "";
    }
    else
    {
	$doc = $tmp;
    }

    $already_key = 0;
    $seen_before = 0;

######################################################################
# new flags override old flags, but old flags remain as is by default

    ($m, $g, $a, $keyhash, $policy, %flags) = article_lookup( $hash );
    %old_flags = %flags;	# need to know what the previous 
				# flags are for so we know what changed
    if ( $g ne "" ) { $seen_before = 1; }
    if ( $keyhash ne "" ) { $already_key = 1; }

#
# format of decrypted message is:
#
#  [Options: flags]         optional flags: directory, exdirectory
#  [Cache: on/off/encrypt]  optional override server cacheing policy
#  [URL: url]               optional eternity url
#  [Description: blah]      optional string describing url
#  [pgp-key]                optional author's PGP document is signed with
#  ascii armored document   just pgp -sa, signed armored, not encrypted
#  
# fields can appear in any order, multiple flags lines are allowed
# only the first public key is used, remaining ones are discarded
# there must be one document, remaining documents are ignored

    if ( !open( ART, $doc ) )
    {
	LOG( $err, "could not open $doc" );
	return "";
    }

    $got_cache = 0;
    $got_key = 0;
    $got_doc = 0;
    $got_url = 0;
    $got_desc = 0;
    $dir_url = "";
    $dir_desc = "";

  MSG:
    while ( <ART> )
    {
	if ( /^\s*$/ ) { next; }	# skip blank lines
	if ( /^Options?:(.*)\s*$/i )
	{
	    LOG( $fmt, "read Eternity flags: $_" );
	    chomp( $flags = $1 );
	    %flags = parse_flags( $flags, %flags );	# accept multiple flags
	    next MSG;
	}
	if ( /^URL:\s*(\S+)\s*$/i )
	{
	    if ( $got_url ) { next MSG; }
	    $got_url = 1;
	    LOG( $fmt, "read url: [$1]" );
	    chomp( $dir_url = $1 );
	    next MSG;
	}
	if ( /^Cache:\s*(\S+)\s*$/i )
	{
	    if ( $got_cache ) { next MSG; }
	    $got_cache = 1;
	    LOG( $fmt, "read $1" );
	    chomp( $policy = $1 );
	    if ( $policy eq "off" || $policy eq "no" ) { $policy = 0; }
	    elsif ( $policy eq "on" || $policy eq "yes" ) { $policy = 1; }
	    elsif ( $policy eq "encrypt" || $policy eq "encrypted" ) { $policy = 2; }
	    else { $got_cache = 0; $policy = ""; }
	    next MSG;
	}
	if ( /^Description:\s*(.*)\s*$/i )
	{
	    LOG( $fmt, "read Description: $_" );
	    if ( $got_desc ) { next MSG; }
	    $got_desc = 1;
	    chomp( $dir_desc = $1 );
	    if ( length($dir_desc) > $max_desc )
	    {
		$dir_desc = substr( $dir_desc, 1, $max_desc );
	    }
	    $dir_desc =~ s/[<>]//g; # no html references!
	    next MSG;
	}
	if ( /^-----BEGIN PGP PUBLIC KEY BLOCK-----/ )
	{
	    if ( $got_key || $already_key )		# discard extra keys
	    { 
		LOG( $fmt, "skipping extra public key block" );
		while ( <ART> )
		{
		    if ( /^-----END PGP PUBLIC KEY BLOCK-----/ ) { next MSG; }
		}
		LOG( $fmt, "truncated PGP key" );
		html_error( "truncated PGP key" );
	    }
	    $got_key = 1;
	    LOG( $fmt, "found begin public key block" );
	    wipe( "$pgp_dir/pubring.pgp" );
	    $key_file = tmpnam();
	    if ( !open( KEY, ">$key_file" ) )
	    {
		LOG( $err, "could not create key tmp file $key_file" );
		return "";
	    }
	    print KEY $_;
	    while ( <ART> )
	    {
		print KEY $_;
		if ( /^-----END PGP PUBLIC KEY BLOCK-----/ )
		{
		    close( KEY );
		    LOG( $fmt, "found end of public key block" );
# add PGP key to empty keyring

		    LOG( $pgp, "PGPPATH = $ENV{'PGPPATH'}" );
		    LOG( $pgp, "invoking $pgp_exe $pgp_flags -f -ka < $key_file" );
		    LOG( $pgp, `$pgp_exe $pgp_flags -f -ka < $key_file` );
		    $status = $? >> 8;
		    LOG( $pgp, "adding key, result = $status" );

# PGP overrides our umask
		    chmod( 0666 & ~umask, "$pgp_dir/pubring.pgp" );
		    
		    if ( !open( KEY, "$pgp_dir/pubring.pgp" ) )
		    {
			LOG( $pgp, "could not open $pgp_dir/pubring.pgp\n" );
			return "";
		    }
# read PGP key into $key

		    $len = read( KEY, $junk, $max_key_len );
		    if ( $len == $max_key_len )
		    {
			LOG( $fmt, "oversized key > $max_key_len bytes, rejected" );
		    }
		    close( KEY );
		    next MSG;
		}
	    }
	    LOG( $fmt, "truncated PGP key" );
	    html_error( "truncated PGP key" );
	}
	if ( /^-----BEGIN PGP MESSAGE-----/ )
	{
	    if ( $got_doc )		# discard extra keys
	    {
		LOG( $fmt, "skipping extra message block" );
		while ( <ART> )
		{
		    if ( /^-----END PGP MESSAGE-----/ ) { next MSG; }
		}
	    }
	    $got_doc = 1;
	    LOG( $fmt, "found begin message block" );
	    $doc_file = tmpnam();
	    open( DOC, ">$doc_file" );
	    print DOC $_;
	    while ( <ART> )
	    {
		print DOC $_;
		if ( /^-----END PGP MESSAGE-----/ )
		{
		    LOG( $fmt, "found end message block" );
		    close( DOC );
		    next MSG;
		}
	    }
	    LOG( $fmt, "truncated document\n" );
	    html_error( "truncated document" );
	}
	# ignore anything else
    }
    close( ART );
    if ( !$got_doc ) 
    { 
	LOG( $err, "malformed content: no document, Message-ID:" .
	    "$mid, Group: $group Article: $article" ); 
    }
    if ( $already_key ) { $got_key = 1; }

    LOG( $dbg, "parsed document" );

######################################################################
# URL missing only allowed if we've seen this document before

    if ( $dir_url eq "" )
    {
	if ( !$seen_before )
	{
	    LOG( $dbg, "expected a URL in the article" );
	    return;
	}
    }
    else
    {

######################################################################
# if there is a URL, it must match the hash

        LOG( $dbg, "checking correct hash: $hash " . sha1( $dir_url ) . "[$dir_url]" );
	if ( $hash ne sha1( $dir_url) )
	{
	    return;
	}
    }

######################################################################
# if we don't have the URL password, calculate it if we can

    if ( $url_password eq "" )
    {
	if ( $dir_url ne "" )
	{
	    $url_password = ( "1$dir_url" );
	}
	else
	{
	    $url_password = "";
	}
    }

    $goodsig = 0;
    if ( $got_key )
    {

######################################################################
# if this is a new document work out keyhash, and store in key db

	if ( !$already_key )
	{
	    $keyhash = sha1_file( "$pgp_dir/pubring.pgp" );
	    LOG( $pgp, "storing key $keyhash in $keys_dir/$keyhash" );
	    rename( "$pgp_dir/pubring.pgp", "$keys_dir/$keyhash" );
	}

######################################################################
# if we've got a key (either from the article, or from the key db 
# saved from previous of this document), check the signature

	`$copy_exe $keys_dir/$keyhash $pgp_dir/pubring.pgp`;
	$html_file = tmpnam();
	LOG( $pgp, "invoking $pgp_exe $pgp_flags -f -o $html_file < $doc_file" );
	LOG( $pgp, $res = `$pgp_exe $pgp_flags -f -o $html_file < $doc_file` );
	$status = $? >> 8;
	LOG( $pgp, "PGP return code = $exit, success = $ok" );
	$goodsig = $status == 0;
	if ( $goodsig && ! -e $html_file )
	{
	    $goodsig = 0;
	}
	if ( $goodsig )
	{
	    LOG( $pgp, "good signature on $group/$article with key $keyhash" );
	}
	else
	{
	    LOG( $pgp, "bad signature with $group/$article $keyhash" );
	}
######################################################################
# if there is a key, and the sig is bad, discard the document

	if ( !$goodsig ) { return ""; }

    }
    else

    {

######################################################################
# if there is no key to check sig on document just remove ascii armor

	$html_file = tmpnam();
	LOG( $pgp, "invoking $pgp_exe $pgp_flags -f -o $html_file < $doc_file" );
	LOG( $pgp, $res = `$pgp_exe $pgp_flags -f -o $html_file < $doc_file` );
	
	$keyhash = "-";		# remember, no key 
    }

######################################################################
# update article database

    article_update( $hash, $mid, $group, $article, $keyhash, $policy, %flags );

######################################################################
# if we're cacheing, and a previous version of the document is 
# in the cache, replace it according to cache policy

    if ( $cache && -e "$cache_dir/$hash" )
    {
	maybe_add_to_cache( $html_file, $hash, $url_password );
    }

######################################################################
# if we're changing from directory to exdirectory remove directory
# entry

    if ( $directory_service && $seen_before && $flags{'exdirectory'} 
	&& $old_flags{'directory'} && $dir_url =~ m/^http/ )
    {
	article_remove( $dir_url );
	delete( $flags{'directory'} );
    }

######################################################################
# if it's not exdirectory, and the url is correct add a directory entry

    if ( $directory_service && $flags{'directory'} && !$flags{'exdirectory'} )
    {
	LOG( $dbg, "think about creating dir entry: $hash " . sha1( $dir_url ) . " $dir_url" );

	if ( $hash eq sha1( $dir_url) && $dir_url =~ m/^http/ )
	{
	    article_update( $dir_url, $dir_desc );
	}
    }
    return $html_file;
}

sub article_db_create
{
    write_lock( $article_file );
    LOG( $adb, "creating article database" );
    if ( !dbmopen( %article_db, $article_file, 0666 ) )
    {
	LOG( $err, "can not create article database file: $article_file" );
	html_error( $err, "cgi config error: can not create article database file: $article_file" );
    }
    LOG( $adb, "set last time checked NNTP server to 0" );
    $article_db{ "time" } = 0;
    LOG( $adb, "closing article database" );
    dbmclose( %article_db );
    unlock( $article_file );
}

sub article_db_open
{
    if ( !dbmopen( %article_db, $article_file, 0666 ) )
    {
	unlock( $article_file );
	LOG( $err, "could not open article database file: $article_file" );
	html_error( "could not open article database file: $article_file" );
    }
}

sub article_update
{
    my( $key, @values ) = @_;

    write_lock( $article_file );
    article_db_open();
    $article_db{$key} = join(" ", @values );
    LOG( $adb, "setting $key <- " . join(',',@values) ); 
    dbmclose( %article_db );
    unlock( $article_file );
}

sub article_remove
{
    my( $key ) = @_;

    write_lock( $article_file );
    article_db_open();
    delete( $article_db{ $key } );
    LOG( $adb, "removing $key = " . join(',',@values) );
    dbmclose( %article_db );
    unlock( $article_file );
}

sub article_lookup
{
    my( $key ) = @_;
    my( @res );

    read_lock( $article_file );
    article_db_open();
    if ( defined( $article_db{ $key } ) )
    {
	@res = split( " ", $article_db{ $key } );
    }
    LOG( $adb, "looked up $key -> ", join( " ", @res ) );
    dbmclose( %article_db );
    unlock( $article_file );
    return ( @res );
}

sub update_article_db
{
    my( @article, @list, $article, $group, $tmp, $doc, $item );
    my( $mid, $check, $resp, $resp_line, $j, $first, $last, @art_nos );
    my( $last_checked, $hash, $gdir );

# connect to NNTP server

    if ( $nntp )
    {
	connect_to_nntp_server();
    }

    foreach $group ( @newsgroups )
    {

# get article numbers

	if ( $nntp )
	{
	    LOG( $nn, "sending GROUP $group" );
	    print NNTP "GROUP $group\n";
	    $resp_line = <NNTP>;
	    ($resp, $j, $first, $last) = split( ' ', $resp_line );
	    LOG( $nn, "got response code $resp" );
	}
	else
	{
	    $gdir = $group; $gdir =~ s|\.|/|g;
	    chop( @art_nos = `$ls_exe $news_spool/$gdir` );
	    @art_nos = sort{$a <=> $b} @art_nos;
	    $first = $art_nos[ 0 ];
	    $last = pop( @art_nos );
	}
	LOG( $nn, "article numbers for group $group are $first-$last" );

	($last_checked) = article_lookup( $group );
	LOG( $adb, "looked up last read news article number for group $group = $last_checked" );
	if ( $last_checked ne "" && $last_checked >= $first ) 
	{ 
	    $first = $last_checked + 1; 
	}
	if ( $first <= $last )
	{
	    @list = find_eternity_articles( $group, $first, $last );
	}

	if ( ! @list )
	{
	    article_update( $group, $last ); 
	    next;
	}

# for each article in this group

	foreach $item ( @list )
	{
	    ($article, $hash) = split( ' ', $item );

# fetch the article

	    LOG( $nn, "fetching article $group $article $hash\n" );
            ($tmp, $mid, $check) = news_fetch( $group, $article, 1 );
	    LOG( $nn, "got article $group $article as $tmp, mid = $mid" );
	    if ( $tmp eq "" || $check ne $hash )
	    {
		next;
	    }
	    LOG( $nn, "processing article $group $article $hash" );
	    process_article( $tmp, $mid, $group, $article, $hash );

######################################################################
# if we're doing the cgi-bin kludge, better save our progress
# in case the user clicks stop in boredom, so we don't lose some
# of our progress

	    if ( !$u )
	    {
		article_update( $group, $article );
	    }

######################################################################
# get rid of all temp files at this point, otherwise lots could
# get accumulated

	    wipe_tmpfiles();
	}

	article_update( $group, $last ); # update last article in group
    }

    if( $nntp )
    {
	disconnect_from_nntp_server();
    }
    article_update( "time", time );
}

sub find_eternity_articles
{
    my( $group, $first, $last ) = @_;
    my( $i, @list, $hash, $resp, $gdir );

    if ( $first eq "" || $last eq "" )
    {
	return ();
    }

    if ( $nntp )
    {
	LOG( $nn, "sending XHDR Subject $first-$last" );
	print NNTP "XHDR Subject $first-$last\n";
	$resp = <NNTP>;
	if ( $resp =~ /^(\d+)/ )
	{
	    LOG( $nn, "got response code $1\n" );
#	    if ( $resp != valid ) { html_error( "blah" ); }
	}
	while ( <NNTP> )
	{
	    if ( /^\./ ) { last; } # "." marks end of list
	    LOG( $nn, "read header: $_" );
	    if ( /^(\d+)$eternity_regexp/ )
	    {
		LOG( $dbg, "found enternity message $1 \L$2" );
		push( @list, "$1 \L$2" );
	    }
	}
	LOG( $nn, "read all NNTP XHDR headers for group $group" );
    }
    else
    {
	LOG( $nn, "looking subjects $first-$last" );
	$gdir = $group; $gdir =~ s|\.|/|g;
	for ( $i = $first; $i <= $last; $i++ )
	{
	    $hash = extract_article_hash( "$news_spool/$gdir/$i" );
	    if ( $hash ne "" )
	    {
		push( @list, "$i \L$hash" );
	    }
	}
    }
    return @list;
}

sub extract_article_hash
{
    my( $file ) = @_;
    my( $hash );

    if (!open( EXTRACT, $file ))
    {
	next;
    }
    while ( <EXTRACT> )
    {
	if ( /^Subject:$eternity_regexp/ )
	{
	    $hash = "\L$1";
	    last;
	}
    }
    close( EXTRACT );
    return $hash;
}

sub connect_to_nntp_server
{
    my( $resp );

    if ( !socket( NNTP, PF_INET, SOCK_STREAM, $nntp_proto ) )
    {
	LOG( $net, "failed to obtain socket" );
	html_error( "network problem: failed to obtain socket" );
    }

    NNTP->autoflush( 1 );	# critical!
    
    LOG( $nn, "connecting to NNTP server: $nntp_server $nntp_port" );
    if ( !connect( NNTP, $nntp_addr ) )
    {
	LOG( $net, "failed to connect to NNTP server: $nntp_server" );
	html_error( "network problem: failed to connect to NNTP server: $nntp_server" );
    }
    
    $resp = <NNTP>;
    if ( $resp =~ /^(\d+)/ )
    {
	LOG( $nn, "got response code $1" );
#       if ( $resp != valid ) { html_error( "blah" ); }
    }
    $nntp_connected = 1;
}

sub disconnect_from_nntp_server
{
    print NNTP "quit\n";
    close( NNTP );
    $nntp_connected = 0;
}

######################################################################
# parse CGI forms output

sub cgi_parse
{
    my( $input, $val, $var, $pair, %FORM );

    if ( $ENV{'REQUEST_METHOD'} eq "GET" )
    {
	$input = $ENV{'QUERY_STRING'};
    }
    elsif ( $ENV{'REQUEST_METHOD'} eq "POST" )
    {
	read(STDIN, $input, $ENV{'CONTENT_LENGTH'});
    }
    else
    {
	html_error( "malformed cgi request, not GET or POST" );
    }

    foreach $pair ( split( /&/, $input ) )
    {
	$pair =~ tr/+/ /;
	$pair =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
	($var, $val) = split( /=/, $pair );
	if (defined($FORM{$var}))
	{
	    $FORM{$var} .= "|$val";
	}
	else
	{
	    $FORM{$var} = $val;
	}
    }
    foreach $var (keys %FORM)
    {
	LOG( $dbg, "cgi form: $var = ", $FORM{ $var }, "\n" );
    }
    return %FORM;
}

######################################################################
# crypt stuff

sub sha1
{
    my( $str ) = @_;
    my( $tmp );

    LOG( $dbg, "EVALING echo -n \"$str\" | $sha1_exe" );
    $tmp = `$echo_exe -n "$str" | $sha1_exe`;
    chop( $tmp );
    $tmp =~ s/\s+//g;
    return $tmp;
}

sub sha1_file
{
    my( $file ) = @_;
    my( $tmp );

    $tmp = `$sha1_exe < $file`;
    chop( $tmp );
    $tmp =~ s/\s+//g;
    return $tmp;
}

######################################################################
# decrypt document with passphrase, return decrypted filename, or ""

sub decrypt
{
    my( $file, $passphrase ) = @_;
    my( $status, $out );

    $out = tmpnam();
    LOG( $pgp, "invoking: $pgp_exe $pgp_flags -z\"$passphrase\" $file -o $out" );
    $status = `$pgp_exe $pgp_flags -z"$passphrase" $file -o $out`;
    LOG( $pgp, $status );
    # pgp batch mode is bugged, it uses status 1 to mean two things:
    # alt_success (no sig) or file_error !! so check if file exists
    # also
    if ( ($? >> 8) == 1 && -e $out )
    {
	return $out;
    }
    else
    {
	return "";
    }
}

######################################################################
# encrypt document with passphrase, return encrypted filename, or ""

sub encrypt
{
    my( $file, $passphrase ) = @_;
    my( $status, $out );

    $out = tmpnam();
    LOG( $pgp, "invoking: $pgp_exe $pgp_flags -ca -z\"$passphrase\" $file -o $out" );
    $status = `$pgp_exe $pgp_flags -ca -z"$passphrase" $file -o $out`;
    LOG( $pgp, $status );
    $status = ($? >> 8);
    return ($status == 0) ? $out : "";
}

######################################################################
# parse eternity document flags

sub parse_flags
{
    my( $flags, %flags ) = @_;
    my( $flag );

# all flags are boolean at the moment, if to add "val = str"
# flags options, change this

    $flags =~ s/\s//g;
    foreach $flag ( split( /,/, $flags ) )
    {
	if ( defined( $flags_var{ $flag } ) )
	{
	    $flags{ $flag } = 1;
	}
    }
    return %flags;
}

######################################################################
# parse config file

sub parse_conf_file
{
    my( $file, $out ) = @_;
    my( $var, $val );

    if ( ! open( CFG, $file ) )
    {
	print STDERR "can not read config file $file\n";
	return;
    }

    if ( ! open( CACHE, ">$out" ) )
    {
	close( CFG );
	print STDERR "can not create config cache $out\n";
	return;
    }

    print CACHE<<EOM;
# This file is automatically created by the eternity program.
# Make changes to $file
EOM

    while ( <CFG> )
    {
	next if /^\s*#/;
	chomp;
	s/\s*#.*$//;
	next if $_ eq "";
	($var,$val) = /^\s*(\w+)\s*=\s*(.+)\s*$/;
	$var = "\L$var";
	if ( defined( $config_var{ $var } ) ) # only allowed variables
	{
	    $val =~ s/^off$/0/;	    $val =~ s/^no$/0/;
	    $val =~ s/^on$/1/; 	    $val =~ s/^yes$/1/;
	    $val =~ s/^encrypt$/2/; $val =~ s/^encrypted$/2/;
	    if ( ! ( $val =~ m/^\d$/ ) )
	    {
		$val =~ s/secs$//;
		$val =~ s/mins$// && ($val *= 60);
		$val =~ s/hours$// && ($val *= 3600);
		$val =~ s/Kb$//;
		$val =~ s/kb$//;
		$val =~ s/Mb$// && ($val *= 1024);
		$val =~ s/mb$// && ($val *= 1024);
		$val =~ s/@/\\@/g;
		$val =~ s/`//g;	           # no shell escapes!
            }
	    print CACHE '$'. "$var = $val;\n";
        }
    }
    close( CACHE );
    close( CFG );
}

######################################################################
# error reporting and logging

sub html_error
{
    my( @reason ) = @_;
    my( $reason );

    if ( !$u )			# don't splurge html if we're a cron job
    {
	print "Content-type: text/html\n\n";
	print "<HTML><HEAD><TITLE>Eternity Service Error</TITLE></HEAD><BODY>\n";
	print "<H1>Eternity Service Error</H2>\n";
	$reason = join( " ", @reason );
	$reason = htmlize( $reason );
	print "$reason<P>\n";
	if ( $? ) { print "Error was: ",htmlize( $!), "<P>\n"; }
	print "If you think this is a persistant error due to misconfiguration"; 
	print " you might try contacting: <BR><EM> ", htmlize( $admin_name ),
	    " <A HREF=\"mailto:", htmlize( $admin_email ), "\">&LT;",
	    htmlize( $admin_email ), "&GT;</A></EM>\n"; 
	print "</BODY> </HTML>\n";
    }
    et_exit( 0 );
}

sub htmlize
{
    my( $text ) = @_;

    $text =~ s/&/&AMP;/g;
    $text =~ s/</&LT;/g;
    $text =~ s/>/&GT;/g;
    $text =~ s/"/&QUOT;/g;
    return $text;
}

sub LOG
{
    my( $error_type, @msg ) = @_;
    if ( $logging & $error_type )
    {
	print LOG "$log_name{ $error_type }: @msg\n";
    }
}

######################################################################
# file locking stuff

my $LOCK_SH = 1;
my $LOCK_EX = 2;
my $LOCK_UN = 8;

# create empty file, or update files timestamp
sub touch
{
    my( $file ) = @_;
    my( $now );

    if ( ! -e $file )
    {
	open( TOUCH, ">$file" );
	close( TOUCH );
    }
    $now = time;
    utime( $now, $now, $file );
}

sub lock
{
    my( $file, $type ) = @_;
    my( $lock_file );

    $lock_file = "$lock_dir/${file}.lock";
    if ( ! -e $lock_file )
    {
	touch( $lock_file );
    }
    LOG( $lck, "trying to lock for ", ($type == $LOCK_SH)?"write":"read", 
	" $file" );
    $LCK{$file} = "$LCK_FH_name$file";
    open( $LCK{$file}, ">$lock_file" );
    flock( $LCK{$file}, $type );
    $LOCKS{$file} = 1;
    LOG( $lck, "obtained lock on $file" );
}

sub read_lock
{
    my( $file ) = @_;

    lock( $file, $LOCK_SH );
}

sub write_lock
{
    my( $file ) = @_;

    lock( $file, $LOCK_EX );
}

sub unlock
{
    my( $file ) = @_;
    my( $lock_file );

    $lock_file = "$lock_dir/${file}.lock";
    LOG( $lck, "unlocking $file" );
    if ( $LOCKS{$file} && -e $lock_file )
    {
	flock( $LCK{$file}, $LOCK_UN );	
	close( $LCK{$file} );
	delete $LOCKS{$file};
    }
}

sub unlock_all
{
    my( $lock );

    LOG( $lck, "unlocking all" );
    foreach $lock ( keys %LOCKS )
    {
	unlock( $lock );
    }
}

sub wipe
{
    my( @files ) = @_;
    my( $file, $res );

    foreach $file ( @files )
    {
	$res = `$pgp_exe $pgp_flags -w $file`;
	unlink( $file );		# just in case!
    }
}

sub et_exit
{
    my( $code ) = @_;
    my( $tmpnam );

    wipe_tmpfiles();		# burn and delete all temp files
    unlock_all();		# unlock which is still locked
    if ( $logging )
    {
	close( LOG );
    }
    exit( $code );
}

sub tmpnam
{
    my( $tmpnam );

    $ntmp++;
    $tmpnam = "$tmp_dir/${tmp_file}$ntmp.$$";
    LOG( $fil, "creating temporary $tmpnam" );
    return $tmpnam;
}

sub wipe_tmpfiles
{
    my( $i, $tmpnam );

    for ( $i = 1; $i <= $ntmp; $i++ )
    {
	$tmpnam = "$tmp_dir/${tmp_file}$i.$$";
	LOG( $fil, "wiping temporary $tmpnam" );
	wipe( $tmpnam );
    }
}

sub mod_time
{
# modify time is # 9
    return (stat($_[0]))[9];
}
