#!/usr/ug/bin/perl5
#			vim:fo=croql:cin:com=\:#
#
# killfiling gsubrc, mark II
# jtr@ugcs.caltech.edu

use strict;
use POSIX qw(strftime setpgid);

# is this really something I want to do?
print "cannot become process group leader\n"
	if (!defined(setpgid(0,0)));

# if this ain't a sign of good programming, then shit...

# gale info
use vars qw($CONTENT $PING $TO $FROM $ENC $CAT $SIGN $FTIME $TIME
			@MESSAGE $AGENT);

# directories
use vars qw($GALE $HOME $GALESTUN $GALELAST);

# formatting
use vars qw($BON $BOFF $CEOL $STOMP $BEEP $COLUMNS);

# killinfo
use vars qw(%score @nukes %gvars);

if (-t 1) {
	$STOMP= "\r";
	$BEEP= "\a";
	$BON=`tput bold`;
	$BOFF=`tput sgr0`;       
	$CEOL= `tput el`;
	$STOMP .= $CEOL;
}



$FROM= &envSet('GALE_TEXT_MESSAGE_SENDER', '*anonymous*');
$TO= &envSet('GALE_TEXT_MESSAGE_RECIPIENT', '*everyone*');
$TIME= &envSet('GALE_TIME_ID_TIME', 'never, never, no place, no time');
$FTIME= substr($TIME, 5);
$FTIME= $TIME if (!defined($ENV{'GALE_TIME_ID_TIME'}));
$AGENT= $ENV{'HEADER_AGENT'};
$PING= $ENV{'HEADER_RECEIPT_TO'};
$CAT= $ENV{'GALE_CATEGORY'};
$CAT =~ s-zephyr/message-zephyr/MESSAGE-gi;
$ENC= $ENV{'GALE_ENCRYPTED'};
$SIGN= $ENV{'GALE_SIGNED'};
$CONTENT= $ENV{'HEADER_CONTENT_TYPE'};
$HOME= $ENV{'HOME'};
$GALE= $HOME . "/.gale/";
$GALESTUN= $HOME . "/.gale/stun";
$GALELAST= "$GALE/glast";
$COLUMNS= 80;
$COLUMNS= $ENV{'COLUMNS'} if defined($ENV{'COLUMNS'});

# you did not see this.
exit 0 if crypt("$ENC", "CL") eq "CLlLLBYXYwT/Y" && ($ENC ne $SIGN);

@MESSAGE= <>;

sub envSet {
	my($evar, $dflt)= @_;
	return $ENV{$evar} if defined($ENV{$evar});
	return $dflt;
}

#
# main handler
#


&logit;


if ($CAT =~ m-^notice/-)		{ &printNotice(@MESSAGE); }
elsif ($CAT =~ m-receipt$-)	{ &printReceipt(@MESSAGE); }
else {
	&mkKillfile;
	my $res= &chkKill;
	if (!defined($ENC) && defined($gvars{'shutup'})) {
		exit 0;
	}
	if (defined($ENC) && defined($SIGN)) {
		&acquire("$GALE/lock-glast");
		if (open(G, ">$GALELAST")) {
			print G $SIGN;
		}
		&release("$GALE/lock-glast");
	}
	if ($res >= 0) {
		&printMessage(@MESSAGE);
	}
	else {
		&printKilledHeader($res);
		$gvars{'numkilled'}++;
	}
	&sweepKillfiles;
}





# 
# log information about recent messages
#

sub logit {
}


#
# formatting
#

sub center {
	my($str, $bold)= @_;

	print "${STOMP}", ' ' x (40 - length($str) / 2);
	print $BON if ($bold);
	print $str;
	print $BOFF if ($bold);
	print "$CEOL\n";
}


sub printKilledHeader {
	my($res)= @_;
	if ($gvars{'showkillshit'}) {
		my $name= $FROM;
		$name =~ s/ <.*>//;
		print "${STOMP}$res KILLED: [$BON$CAT$BOFF] from $BON$name$BOFF$CEOL\n";
		print "${STOMP}\tencrypted: $BON$ENC$BOFF$CEOL\n" if defined($ENC);
		print "${STOMP}";
	}
}


sub printNotice {
	print "${STOMP}$BON";
	print "* $SIGN " if defined($SIGN);
	my $C= $CAT;
	$C =~ s-notice/[^/]*/[^/]*/([^/]*)-$1-;
	print "$C: ";
	print "$AGENT on ";
	print "$TIME$BOFF$CEOL\n${STOMP}";
}

sub printReceipt {
	print "${STOMP}$BON";
	print "* " if defined($SIGN);
	print "receipt: ";
	print "$AGENT at ";
	print "$TIME$BOFF$CEOL\n${STOMP}";
}



sub printMessageFought {
	my($logf, @MESSAGE)= @_;
	print $logf $STOMP, "-" x ($COLUMNS-1), "\n";
	&printHeaderFought($logf);

	&wrapBody($logf, @MESSAGE);

	&printFooterFought($logf);
}

sub wrapBody {
	my($logf, @MESSAGE)= @_;

	my $line;
	foreach $line (@MESSAGE) {
		if (length($line) > ($COLUMNS-1)) {
			my($word, $l)= ('', '');
			($l,$line)= ($line =~ /^(\s*)(.*)$/);
			foreach $word (split(/\s/, $line)) {
				if (length($word . ' ' . $l) > ($COLUMNS-1) ||
					(length($word) > ($COLUMNS-1) && length($l) > 0)) {
				  print $logf "$STOMP$l", "\n";
				  $l= $word;
				}
				else {
					$l .= ' ' if ($l !~ /^\s*$/);
					$l .= $word;
				}
			}
			print($logf "$STOMP$l\n") if length($l) > 0;
		}
		else {
			print $logf $STOMP, $line;
		}
	}
}


sub printMessage {
	my @MESSAGE= @_;
	if (defined($gvars{'foughtdisplay'})) {
		&printMessageFought(*STDOUT, @MESSAGE);
	} else {
		&printMessageMe(@MESSAGE);
	}
}

sub printMessageMe {
	my @MESSAGE= @_;
	&printHeaderMarkII(*STDOUT);

	&wrapBody(*STDOUT, @MESSAGE);

	if (defined($SIGN) || defined($ENC)) {
		my $enc= '-- ';
		$enc .= "signed: $SIGN" if defined($SIGN);
		$enc .= " / " if (defined($SIGN) && defined($ENC));
		$enc .= "encrypted: $ENC" if defined($ENC);
		$enc .= ' --';

		&center($enc, 1);
	}

	print "${BEEP}" if defined($ENC);
	print "${STOMP}$CEOL\n$CEOL${STOMP}";
}


sub printHeader {
	my $name= $FROM;
	$name =~ s/ <.*>//;
	print "${STOMP}";
	print "+" if defined($PING);
	print "[$BON$CAT$BOFF] from $BON$name$BOFF";
	print "$TIME$CEOL\n";
}



sub printHeaderFought {
	my($logf)= @_;
	my $name= $FROM;
	print $STOMP;
	print $logf "+" if defined($ENV{'HEADER_RECEIPT_TO'});
	print $logf "[$BON$CAT$BOFF] from $BON$name$BOFF to $BON$TO$BOFF\n";
}

sub printHeaderMarkII {
	my($logf)= @_;
	my $name= $FROM;
	$name =~ s/ <.*>//;
	print "${STOMP}";
	print $logf "+" if defined($ENV{'HEADER_RECEIPT_TO'});
	print $logf "[$BON$CAT$BOFF] from $BON$name$BOFF";
	print $logf (" $FTIME$CEOL\n");
}

sub printFooterFought {
	my ($logf)= @_;
	my $foot= "-- ";
	if (defined($SIGN)) {
		$foot .= "<$BON$SIGN$BOFF>";
	}
	else {
		$foot .= "$BON*anonymous*$BOFF";
	}
	$foot .= " for ";
	if (defined($ENC)) {
		$foot .= "<$BON$ENC$BOFF>";
	}
	else {
		$foot .= "$BON*everyone*$BOFF";
	}
	$foot .= " at $FTIME --\n";
	print $logf ($STOMP . (" " x ($COLUMNS + length(($BON.$BOFF) x 2) -
								  length($foot)))
				 . $foot);
}


sub printFooterMarkII {
	my ($logf)= @_;
	if (defined($SIGN) || defined($ENC)) {
		my $enc= '-- ';
		$enc .= "signed: $SIGN" if defined($SIGN);
		$enc .= " / " if (defined($SIGN) && defined($ENC));
		$enc .= "encrypted: $ENC" if defined($ENC);
		$enc .= ' --';

		&center($logf, $enc);
	}
}
# Mark II killfile

sub chkKill {
	my @catscore= ();
	my($f, $cat, $score);
	foreach $cat (split(/:/, $CAT)) {
		$gvars{'category'}= $cat;
		$score= 0;
		foreach $f (keys %score) {
			print "${STOMP}<<$f>>\n" if $gvars{'expandverbose'};
			if (eval $f) {
				print "${STOMP}$f: " . $score{$f} . "\n${STOMP}"
					if $gvars{'scoreverbose'};
				$score += $score{$f};
			}
		}
		push @catscore, $score;
	}
	$score= &pickScore(@catscore);
	&nuke($score);
	return $score;
}


sub pickScore {
	my @catscore= @_;
	my($score, $f);

	if ($gvars{'xpost'} =~ /sum|avg/) {
		$score= 0;
		foreach $f (@catscore) { $score += $f; }
		$score /= ($#catscore + 1) if $gvars{'xpost'} =~ /avg/;
	} elsif ($gvars{'xpost'} =~ /max/) {
		$score= $catscore[0];
		foreach $f (@catscore) { $score= $f if $f > $score; }
	} else {
		# minimum
		$score= $catscore[0];
		foreach $f (@catscore) { $score= $f if $f < $score; }
	}

	return $score;
}



sub nuke {
	my($score)= @_;
	my($nk);
	foreach $nk (@nukes) {
		my($s, $e)= split(/\.\./, $nk->[0]);
		if ($s eq '' || $score >= $s) {
			if ($e eq '' || $score < $e) {
				my $newrule= $nk->[2];
				$newrule =~ s:\^([a-z]+):$gvars{$1}:g;
				$newrule =~ s:\^([A-Z]+):$ENV{$1}:g;
				open(TF, ">$GALESTUN/" . time . "-$$:" .
					 $nk->[1]) || die "can't plonk";
				print TF $newrule, "\n";
				close(TF);
			}
		}
	}
}


sub mkKillfile {
	&readKillfile("$GALE/gkill");
	if (-d "$GALESTUN") {
		&acquire("$GALE/lock-stundir");
		my $f; foreach $f (<$GALESTUN/*>) { # */ grr
			&readKillfile($f);
		}
		&release("$GALE/lock-stundir");
	} else {
		mkdir($GALESTUN, 0755);
	}
}

sub sweepKillfiles {
	&acquire("$GALE/lock-stundir");
	my $f; foreach $f (<$GALESTUN/*>) { # */ stooopid editor
		my $mtime= (stat($f))[9];
		my $len= (split(/:/, $f))[1];
		unlink($f) if (time > $mtime + $len);
	}
	&release("$GALE/lock-stundir");
}


sub readKillfile {
	my($f)= @_;
	open(GKILL, $f) || return;

	while (<GKILL>) {
		s/#.*$//;
		if (/^[+-]/) {
			&readScore($_);
		} elsif (/^\d*\.\.d*/) {
			&readNuke($_);
		} elsif (/^(\w*)\s*=\s*(.*)$/) {
			$gvars{$1}= $2;
		} else {
		# compatibility with Mk I killfile
	  	if (/^dipshit\s*([^\s]*)\s*([^\s]*)/) {
			my $target= $1;
			if ($2 =~ /kill/) {
				$score{" \$ENV{'GALE_SIGNED'} =~ /$target/"}= -50;
			} else {
				$score{" \$ENV{'GALE_SIGNED'} =~ /$target/"}= -100;
				push @nukes, ['..-99', 3600, '-50:category(^category)'];
		  }
	  } elsif (/^category\s*(.*)$/) {
		  $score{" \$ENV{'GALE_CATEGORY'} =~ /$1/"}= -50;
	  } elsif (/^polluted\s*([^\s*])/) {
		  $score{" \$ENV{'GALE_CATEGORY'} =~ /$1/"}= -50;
	  } else {
		  my @a= split(/\s*/);
		  $gvars{$a[0]}= $a[1];
			}
		}
	}
}

sub readScore {
	my($cmdl)= @_;
	/^(.*):(.*)$/;
	my($score, $condition)= ($1, $2);
	$condition =~ s/\@/\\\@/g;
	$condition =~ s:([A-Z_]+)\(\):defined (\$ENV{'$1'}):g;
	$condition =~ s:([a-z_]+)\(\):defined (\$gvars{'$1'}):g;
	$condition =~ s:([A-Z_]+)\(([^)]+)\):(\$ENV{'$1'} =~ m!$2!):g;
	$condition =~ s:([a-z_]+)\(([^)]+)\):(\$gvars{'$1'} =~ m!$2!):g;
	$score{$condition}= $score;
}

sub readNuke {
	my($cmdl)= @_;
	/^([^:]*):([^:]*):(.*)$/;
	my($l, @a)= ($3, $1, $2);
	$l =~ s:\$([A-Z_]+):^$1:g;
	$l =~ s:\$([a-z_]+):^$1:g;
	push @a, $l;

	push @nukes, \@a;
}



#
# mutexery
#

sub acquire {
	my($lockf)= @_;
	my $retries= 0;
	while (!mkdir($lockf, 0)) {
		die "error acquiring lock on $lockf: $!" if ($! ne "File exists");
		$retries++;
		print("${STOMP}sleeping on lock $lockf: $!\n")
			if ($gvars{'lockverbose'} == 1 ||
				$retries % 20 == 0);
		sleep(4);
	}
}

sub release {
	my($lockf)= @_;
	rmdir($lockf);
}