#!/usr/bin/perl

sub prnotice {
	print <<EOS;
BEGIN NOTICE
@(#) nospam.pl 1.19 97/09/16 04:52:53 @(#)
This is nospam, a Perl script that may help complain about spam.
This program is Copyright (c) 1997 MIDS, mids\@mids.org, http://www.mids.org.
It was written by John S. Quarterman.
A current copy is available through http://www.mids.org/nospam/.

Anyone may copy this program or use it provided they include
this notice of copyright and lack of warranty.
Anyone may also modify their copy of this script as they see fit;
just put your name on your modifications, and don't claim I wrote them.

This program is supplied on an as-is basis.
THIS PROGRAM COMES WITH NO WARRANTY EXPRESS OR IMPLIED
AS TO ITS SUITABILITY FOR ANY PURPOSE WHATEVER.
Feel free to send bug reports to support\@mids.org,
but we never claimed this program actually does anything useful,
so don't bother trying to sue us if it doesn't do what you want it to.

END NOTICE
EOS
	exit(0);
}

$sendmail = "/usr/lib/sendmail -t";
$right = "abuse.net";
$defuser = "postmaster";
$deflocaluser = "abuse";
$defsubject = "spam";
$defeditor = "/bin/vi";

@spamcomplaint = ("The appended spam was unsolicited and is unwanted.\n",
"See http://www.mids.org/nospam/.\n");

sub usage {
	local($mess) = @_;
	local($progname);
	($progname = $0) =~ s%.*/%%;
	print STDERR "$progname: $mess\n\n" if $mess;
	print STDERR <<EOS;
Usage: $progname [ -d dir ] [ -c ] [ file ]

This program takes a spam message and uses domains from its From:
and Received: lines and composes a complaint about it.
Then it offers the use a chance to edit it using an editor,
and then mail it.

The editor to use is taken from the environment variable VISUAL,
or EDITOR, or $defeditor by default.

The $progname script does not actually reply to the address in the
From:, Reply-To:, or Sender:  line, since that only tends to increase
the spam received by verifying your address is valid.  Instead, it
complains to postmaster or other address at each related domain.
It does this by sending a copy of the complaint to domain\@abuse.net,
which is a service that keeps track of appropriate spam complaint addresses;
see http://spam.abuse.net/.

	-h	Help (this message).
	-c	Input from current MH message.
	-v	Verbose output.
	-D	Debugging output.
	-p	Print copyright and disclaimer notice.
	file	A mail message for input; defaults to STDIN.

EOS
	exit 1;
}

while ($arg = shift) {
	unshift(@ARGV, $arg), last unless $arg =~ /^-/;
	&usage(""), next if $arg =~ /^-h/;
	$mhcur++, next if $arg =~ /^-c/;
	$verbose++, next if $arg =~ /^-v/;
	$debflag++, next if $arg =~ /^-D/;
	&prnotice(), next if $arg =~ /^-p/;
	&usage("No such option: $arg");
}

unshift(@ARGV, `cur`) if $mhcur;

while (<>) {
	push(@inmess, $_);
	last if /^$/;
	chop;
	if (/^\s/) {
		($val = $_) =~ s/^\s*//;
		if ($lasttag eq "received") {
			$lastval = pop(@rec);
			$lastval .= " " . $val;
			push(@rec, $lastval);
			next;
		}
		$tag2val{$lasttag} .= " " . $val;
		next;
	}
	if (!/^([^:]+):\s*(.*)\s*$/) { warn("?$_\n"); next; }
	$tag = lc $1; $val = $2;
	$lasttag = $tag;
	if ($tag eq "received") {
		push(@rec, $val);
		next;
	}
	if ($tag2val{$tag}) {
		$tag2val{$tag} .= ' ' . $val;
		next;
	}
	$tag2val{$tag} .= $val;
}

push(@inmess, <>);

$[ = 1;
foreach $rec (@rec) {
	$rec = lc $rec;
	@words = split(/\s+/, $rec);
	$dom = $words[2];
	$dom =~ s/^\(//;
	$dom =~ s/\)$//;
	$dom =~ s/.*@//;
	$dom =~ s/;$//;
	$dom = "" if $dom eq "localhost";
	$dom = "" if $dom =~ /^localhost/;
	$dom = "" if $dom eq "by";
	push(@recfrom, $dom) if $dom;
	$by = "";
	while ($word = shift(@words)) {
		next unless $word eq "by";
		$by = shift(@words);
		last;
	}
	$by =~ s/.*@//;
	$by =~ s/;$//;
	push(@recby, $by);
#	$by2from{$by} = $from;
#	$from2by{$from} = $by;
}

&dotag("from");
&dotag("reply-to");
&dotag("sender");
&printrec if $debflag;

foreach $tag (@tag2dom) {
	$val = $tag2dom{$tag};
	&doprint($val);
}

for ($i = @rec; $i >= 1; $i--) {
	&doprint ("$recfrom[$i]");
	&doprint ("$recby[$i]");
}

&doit;

exit(0);

sub printheaders {
	while (($tag, $val) = each(%tag2val)) {
		print "$tag: $val\n";
	}
	print "\n";
}

sub printrec {
	return unless $debflag;
	foreach $rec (@rec) {
		print STDERR "Received: $rec\n";
	}
	print STDERR "\n";
}

sub printfromby {
	for ($i = 1; $i <= @rec; $i++) {
		print "from $recfrom[$i] by $recby[$i]\n";
	}
}

sub dotag {
	local($tag) = @_;
	local($val, $local, $dom);
	($local, $dom) = &gettag($tag);
	return unless $dom;
	$tag2dom{$tag} = $dom;
	$tag2addr{$tag} = "$local\@$dom" if $local;
	push(@tag2dom, $tag);
	print STDERR "$tag: $dom\n" if $debflag;
}

sub gettag {
	local($tag) = @_;
	local($val, @words, $word, $local, $dom);
	$val = $tag2val{$tag};
	return("", "") unless $val;
	$val =~ s/\([^\)]*\)//g;
	@words = split(/\s/, $val);
	foreach $word (@words) {
		next unless $word =~ /^<.*>$/;
		$word =~ s/^<//;
		$word =~ s/>$//;
		($local, $dom) = split(/@/, $word);
		return($local, $dom);
	}
	foreach $word (@words) {
		next unless $word =~ /@/;
		($local, $dom) = split(/@/, $word);
		return($local, $dom);
	}
	return("", "");
}

sub doprint {
	local($toprint) = @_;
	return unless $toprint;
	return if $lastprint eq $toprint;
	&setlocal;
	$lastprint = $toprint;
	$toprint = lc $toprint;
	push(@allprint, $toprint);
	print $toprint, "\n" if $verbose;
	local($dlen, $llen);
	$llen = length($localdom);
	$dlen = length($toprint);
#	$nonlocal++ if substr($toprint, $dlen - $llen, $dlen) ne $localdom;
}

sub setlocal {
	return if $alreadysetlocal;
	$alreadysetlocal++;
	chop($hostname = `hostname`);
	$hostname = lc $hostname;
	$localdom = $hostname;
print STDERR "localdom $localdom" if $debug;
	$localdom = &maindom($localdom);
print STDERR " -> $localdom\n" if $debug;
}

sub doit {
#	return unless $nonlocal;
	local($to, $ourfrom, $maindom, $dom, $local, $subject);
	&initabuse;
	$to = $tag2addr{"sender"} if !$to;
	$to = $tag2addr{"from"} if !$to;
	$to = $tag2addr{"reply-to"} if !$to;
	foreach $dom (@allprint) {
		next if $dom !~ /\./;
		next if $dom eq $localdom;
		next if $dom eq $hostname;
		next if $seen{$dom};
		$seen{$dom}++;
		if (($local = $abuseuser{$dom})) {
			&newcc("$local\@$dom");
			next;
		}
		$maindom = &maindom($dom);
		if (($local = $abuseuser{$maindom})) {
			&newcc("$local\@$maindom");
			next;
		}
		$local = $defuser;
#		&newcc("$local\@$dom");
		&newcc("$dom\@$right");
		next unless $maindom ne $dom;
#		&newcc("$local\@$maindom");
		&newcc("$maindom\@$right");
	}
	&newcc("$deflocaluser\@$localdom");
	$ourfrom = "$deflocaluser\@$localdom";
	push(@outmess, "From: $ourfrom\n");
	$to = shift(@ccaddr);
	push(@outmess, "To: $to\n") if $to;
	foreach $cc (@ccaddr) {
		push(@outmess, "Cc: $cc\n");
	}
	$subject = $tag2val{"subject"};
	$subject = $defsubject if !$subject;
	push(@outmess, "Subject: Re: $subject\n");
	push(@outmess, "--------\n");
	push(@outmess, "\n");
	push(@outmess, @spamcomplaint);
	push(@outmess, "\n");
	&editit;
}

sub newcc {
	local($addr) = @_;
	return if $seen{$addr};
	$seen{$addr}++;
	push(@ccaddr, $addr);
}

sub editit {
	local($tmp, $l, $editor);
#	print @outmess, @inmess;
	$tmp = "/tmp/nospam.$$";
	open(T, ">$tmp") || die "Can't open >$tmp";
	print T @outmess;
	foreach $l (@inmess) {
		print T "> " . $l;
	}
	close(T);
	$editor = $ENV{'VISUAL'};
	$editor = $ENV{'EDITOR'} if !$editor;
	$editor = $defeditor if !$editor;
	for(;;) {
		system("$editor $tmp");
		last if !&reask;
	}
	exit(0);
}

sub reask {
	for(;;) {
$yes = &doask("edit, send, post in background, or quit [espq]? ");
		return(0) if $yes =~ /^q/i;
		return(1) if $yes =~ /^e/i;
		&sendit($tmp, 0), return(0) if $yes =~ /^s/i;
		&sendit($tmp, 1), return(0) if $yes =~ /^p/i;
	}
}

sub sendit {
	local($tmp, $flag) = @_;
	local($sendcom);
	$sendcom = "$sendmail <$tmp && rm $tmp";
	$sendcom .= " &" if $flag;
	print $sendcom, "\n" if $verbose;
#	exit(0);
	system($sendcom); # || die "Can't $sendcom";
	exit(0);
}

sub doask {
	local($mess) = @_;
	local($yes, $ttyfile);
	if (!$havetty) {
		$ttyfile = "/dev/tty";
		open(TTY, $ttyfile) || die "Can't open $ttyfile";
		$havetty++;
	}
	printf ("%s", $mess);
	$yes = <TTY>;
	return($yes);
}

sub initabuse {
%abuseuser = (
	 "anon.penet.fi"    => "abuse",
	 "aol.com"          => "abuse",
	 "att.net"    	=> "abuse",
	 "concentric.net"   => "abuse",
	 "earthlink.net"    => "spam",
	 "hotmail.com"      => "abuse",
	 "interramp.com"    => "abuse",
	 "mci.net"          => "abuse",
	 "msn.com"          => "abuse",
	 "netcom.com"       => "abuse",
	 "pipeline.com"     => "abuse",
	 "prodigy.com"      => "abuse",
	 "psi.com"          => "abuse",
	 "worldnet.att.com" => "abuse",
	 ); 
	%abuseuser = ();
}
#	 "att.net"          => "abuse",

sub initsecdom {
	return if $initsecdom;
	local($sec, $cc);
	@issec = ("co", "ac", "ad", "go", "com", "edu");
	@hassec = ("us", "ca");
	foreach $sec (@issec) { $issec{$sec}++; }
	foreach $cc (@hassec) { $hassec{$cc}++; }
	$initsecdom++;
}

sub maindom {
	local($dom) = @_;
	local(@h, @m, $top, $sec, $t, $maindom);
	&initsecdom if !$initsecdom;
	$dom =~ s/.*\]\.*//;
	$dom =~ s/.*\>\.*//;
	@h = split(/\./, $dom);
	$top = pop(@h);
	if ($top =~ /\d$/) { return(join(".", @h)); }
	unshift(@m, $top);
	$sec = pop(@h);
	unshift(@m, $sec) if $sec;
	if ($sec && length($top) == 2) {
		$t = pop(@h);
		if ($t && ($issec{$sec} || $hassec{$top})) {
			unshift(@m, $t);
		}
	}
	$maindom = join(".", @m);
	return($maindom);
}
