#!/usr/bin/perl -w
#
# report-spam
# John Simpson <jms1@jms1.net> 2003-07-30
#
# meant for a .qmail file corresponding to a honeypot address
# gathers up an incoming email message and sends it as an attachment to
# one or more spam reporting addresses.
#
# 2007-11-11 jms1 - cleaning up the code, changing GPLv2 to GPLv2/3
#
# 2007-11-14 jms1 - adjusting the exit value based on "-h" option
#
###############################################################################
#
# Copyright (C) 2003,2004,2005,2006,2007 John Simpson.
#
# 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 or version 3 of the
# license, at your option.
#
# 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, see <http://www.gnu.org/licenses/>.
#
###############################################################################

require 5.003 ;
use strict ;

use Carp ;
use DBI ;
use Getopt::Std ;
use POSIX ;
use Sys::Syslog ;

###############################################################################
#
# configuration

# when you sign up for a spamcop reporting account, you will be given an
# address like "submit.abc123def456ghi789@spam.spamcop.not" to which you
# should forward your spam. sending a message to this address will start
# the reporting process, where you will receive a notification and have
# to visit the web page in order to finish the report.
#
# if you change "submit." to "quick.", the report will be finished
# automatically, and you will not have to visit the web site in order to
# finish the report.
#
# you can enter either version of your reporting address here. the value
# should be the full email address.
#
# if you don't have a spamcop account, visit http://www.spamcop.net/ to
# sign up for one. if you don't want one, leave this blank.
my $spamcop	= "" ;

# location of your /var/qmail directory
my $var_qmail	= "/var/qmail" ;

# where you want to keep a repository of received spam messages
# set this blank (i.e. "" ) if you don't want to keep the messages
my $repo_dir	= "/var/spam" ;

# if you want to keep a copy of each spam in a maildir,
# set this variable to the maildir itself (i.e. whatever directory
# you put here should exist, and have a "new" directory underneath it.)
my $maildir	= "" ;

# sender of emails to spamcop
# this must be a valid email address, in case spamcop bounces for some reason
my $email	= "Postmaster <postmaster\@domain.xyz>" ;

# sender and recipient of admin emails
# set this blank (i.e. "" ) if you don't want the notifications
my $admin	= "" ;

# named pipe to write into, in order to trigger a rebuild of an RBL.
# set this blank (i.e. "" ) if you don't need this.
my $named_pipe	= "/tmp/update-rbl" ;

# SQL server credentials
my $sql_server = "dbi:Pg(PrintError=>0):dbname=rbl" ;
my $sql_userid = "" ;
my $sql_passwd = "" ;

###############################################################################
#
# global variables

my $now_t = time() ;
my @now_d = localtime $now_t ;
my $now_h = POSIX::strftime ( "%d %b %Y %T %z" , @now_d ) ;

my ( $comment , $honeypot , $whoami , $me , %opt , $exitval ) ;

###############################################################################
#
# logging function

sub logit($$$$)
{
	my $disp	= shift ;
	my $ip		= shift ;
	my $recip	= shift ;
	my $fname	= shift ;

	my $msg = sprintf ( "%s %s %s %s" , $disp , $ip , $recip , $fname ) ;
	$msg =~ s|\s+|| ;

	Sys::Syslog::setlogsock ( "unix" ) ;
	openlog ( "report-spam" , "pid" , "local1" ) ;
	syslog ( "info" , "%s" , $msg ) ;
	closelog() ;
}

###############################################################################
#
# is this message a bounce?

sub is_legitimate($)
{
	my $msg = shift ;

	# RFC 1891 delivery status
	if (    ( $msg =~ /^content\-type\:.*multipart\/report/im )
	     && ( $msg =~ /report\-type\s*\=\s*delivery\-status/im  ) )
	{
		return 1 ;
	}

	# RFC 3834, section 3.1.5
	if ( $msg =~ /^subject\:\s+auto\: /im )
	{
		return 1 ;
	}

	# RFC 3834, section 3.1.7 or section 5
	if ( $msg =~ /^auto\-submitted\:\s+auto\-/im )
	{
		return 1 ;
	}

	# other patterns which mark a message as somehow "legitimate"
	if (    ( $msg =~ /^(from|reply\-to|sender)\:.*da?emon/im )
	     || ( $msg =~ /^(from|reply\-to|sender)\:.*(([ph]ost|web)master|bounce)/im )
	     || ( $msg =~ /^content\-type\:.*message\/delivery\-status/im )
	     || ( $msg =~ /^content\-type\:.*message\/rfc\-?822/im )
	     || ( $msg =~ /^precedence\:.*(bulk|junk|list|auto[\-_]?reply)/im )
	     || ( $msg =~ /^From\:.*spam/im )
	     || ( $msg =~ /^From\:.*Symantec/im )
	     || ( $msg =~ /^From\:.*\(via the vacation program\)/im )
	     || ( $msg =~ /^Subject\:.*auto(mat(ed|ic))?[\- ]?re(pl|sp)/im )
	     || ( $msg =~ /^Subject\:.*(junk|bulk|spam|reject|block|fail)/im )
	     || ( $msg =~ /^Subject\:.*(deliver|confirm|qurb)/im )
	     || ( $msg =~ /^Subject\:.*(not|ver)if[iy]/im )
	     || ( $msg =~ /^Subject\:.*out\s*of\s*(the)?\s*office/im )
	     || ( $msg =~ /^Subject\:.*Abwesenheitsnotiz/im )
	     || ( $msg =~ /^Subject\:.*Majordomo results/im )
	     || ( $msg =~ /^Subject\:.*ezmlm response/im )
	     || ( $msg =~ /^(X\-)?Auto/im )
	     || ( $msg =~ /^X\-MailScanner\: generated/im )
	     || ( $msg =~ /^X\-Mailer\:.*knowspam\.net/im )
	     || ( $msg =~ /^X\-MB\-Message\-Source\:/im )
	     || ( $msg =~ /^InterScan_NT_MIME_Boundary/im )
	     || ( $msg =~ /^User\-Agent\:.*vacation\.sourceforge\.net/im )
	     || ( ( $ENV{"SENDER"} || "" ) =~ /\-owner\@/im )
	   )
	{
		return 1 ;
	}

	return 0 ;
}

###############################################################################
#
# forward the message as an attachment

my $msg_honeypot = <<EOF ;
The attached message was sent to an email address which is a honeypot.
EOF

my $msg_reported = <<EOF ;
The attached message was reported by a user as spam.
EOF

sub forward_attach($$)
{
	my $recip = shift ;
	my $text  = shift ;

	my $sep = sprintf ( "mime.%08X.%04X.separator" , $now_t , $$ ) ;
	$comment = $honeypot ? $msg_honeypot : $msg_reported ;

	open ( O , "| $var_qmail/bin/qmail-inject" )
		or die "Can\'t run $var_qmail/bin/qmail-inject: $!\n" ;

	print O <<EOF ;
Date: $now_h
From: $email
To: $recip
Subject: SPAM report
MIME-Version: 1.0
Content-Type: Multipart/Mixed;
  boundary="$sep"


--$sep
Content-Type: text/plain
Content-Transfer-Encoding: 7bit
Content-Disposition: inline

$comment

--$sep
Content-Type: message/rfc822;
  name="forwarded message"
Content-Transfer-Encoding: 8bit
Content-Description: SPAM

$text
--$sep--
EOF

	close O ;
}

###############################################################################
#
# keep a local copy of a message in a repository
# returns the filename, which will look like:
#   $repo_dir/YYYY/MM/DD/YYYY-MM-DD.hhmmss.PPPP.A.B.C.D
#     YYYY, MM, DD, hh, mm, ss = date and time
#     PPPP = this script's PID, in hex (prevents duplicate filenames)
#     A.B.C.D = sender's IP

sub keep_message($$)
{
	my $ip = shift ;
	my $msg = shift ;

	my $filename = "" ;

	my $zf = sprintf ( "%04d-%02d-%02d.%02d%02d%02d.%04X.%s" ,
		$now_d[5]+1900 , $now_d[4]+1 , $now_d[3] ,
		$now_d[2] , $now_d[1] , $now_d[0] , $$ , $ip ) ;

	if ( $repo_dir )
	{
		my $ou = umask() ;
		umask ( 022 ) ;

		my $z1 = sprintf ( "%s/%04d" , $repo_dir , $now_d[5]+1900 ) ;
		mkdir ( $z1 , 0755 ) ;

		my $z2 = sprintf ( "%s/%02d" , $z1 , $now_d[4]+1 ) ;
		mkdir ( $z2 , 0755 ) ;

		my $z3 = sprintf ( "%s/%02d" , $z2 , $now_d[3] ) ;
		mkdir ( $z3 , 0755 ) ;

		$filename = "$z3/$zf" ;

		open ( O , ">$filename" ) or die "Can\'t create $filename: $!\n" ;
		print O "SENDER IP: $ip\n-----\n" ;
		map { printf O "%s=%s\n" , $_ , $ENV{$_} } sort keys %ENV ;
		print O "----------\n" ;
		print O $msg ;
		close O ;
		chmod ( 0644 , $filename ) ;

		umask ( $ou ) ;
	}

	########################################
	# store a copy of the raw message in a real maildir somewhere

	if ( $maildir )
	{
		my @zs = stat ( $maildir )
			or die "Can\'t stat $maildir: $!\n" ;

		my $ztmp = "$maildir/tmp/$zf" ;
		my $znew = "$maildir/new/$zf" ;

		open ( O , ">$ztmp" )
			or die "Can\'t create $ztmp: $!\n" ;
		print O $msg ;
		close O ;
		chown ( $zs[4] , $zs[5] , $ztmp ) ;
		chmod ( 0600 , $ztmp ) ;

		rename ( $ztmp , $znew ) ;
	}

	return $filename ;
}

###############################################################################
###############################################################################
#
# database code

my $dbh ;

sub SQL_connect()
{
	$dbh && return ;
	$dbh = DBI->connect ( $sql_server , $sql_userid , $sql_passwd ) ;
	die ( "Can\'t connect to SQL server: " . $DBI::errstr . "\n" )
		unless $dbh ;
}

END
{
	$dbh || return ;
	$dbh->disconnect() ;
	$dbh = undef ;
}

sub SQL_quote($)
{
	SQL_connect() ;
	return $dbh->quote ( $_[0] ) ;
}

sub SQL_do($)
{
	SQL_connect() ;
	return $dbh->do ( $_[0] ) ;
}

sub SQL_select($)
{
	my @rv = () ;

	SQL_connect() ;
	my $sth = $dbh->prepare ( $_[0] )
		or die ( "prepare($_[0]): " . $DBI::errstr . "\n" ) ;
	$sth->execute()
		or die ( "execute($_[0]): " . $DBI::errstr . "\n" ) ;
	while ( my @z = $sth->fetchrow_array() )
	{
		push ( @rv , @z ) ;
	}
	$sth->finish() ;
	return ( wantarray ? @rv : $rv[0] ) ;
}

###############################################################################
###############################################################################
###############################################################################
#
# MAIN PROGRAM STARTS HERE

getopts ( "h" , \%opt ) ;
$honeypot = $opt{"h"} ? 1 : 0 ;
$exitval = $opt{"h"} ? 99 : 0 ;

#$whoami = getpwuid ( $< ) ;
$whoami = "auto" ;

########################################
# read /var/qmail/control/me

open ( ME , "<$var_qmail/control/me" )
	or die "Can't read $var_qmail/control/me: $!\n" ;
chomp ( $me = <ME> ) ;
close ME ;

###############################################################################
#
# gather the spam message into memory. watch for "Received:" headers, pull the
# IP from the first one which shows being received by ourselves.

my $recipient = ( $ENV{"RECIPIENT"} || "(null)" ) ;
$recipient =~ s/^.*?\-(.*?\@)/$1/ ;

my $spam  = "" ;
my $ip    = "" ;
my $hdone = 0 ;

while ( my $line = <> )
{
	$spam .= $line ;

	if ( $line =~ m|^[\r\n]+$| )
	{
		$hdone = 1 ;
	}

	unless ( $hdone || $ip )
	{
		if ( $line =~ m|^Received: from.*\(([\d\.]+?)\)\s*$| )
		{
			my $zip = $1 ;

			$line = <> ;
			$spam .= $line ;

			if ( $line =~ /by $me/ )
			{
				$ip = $zip ;
			}
		}
	}
}

########################################
# don't do anything if it was a legitimate message

if ( is_legitimate ( $spam ) )
{
	logit ( "legit" , $ip , $recipient , "" ) ;
	exit $exitval ;
}

########################################
# not legitimate - is it whitelisted?

if ( $ip )
{
	my $qip = SQL_quote ( $ip ) ;
	my $c = SQL_select ( "SELECT COUNT(*) FROM whitelist"
		. " WHERE block >>= $qip" ) ;
	if ( $c )
	{
		logit ( "white" , $ip , $recipient , "" ) ;
		exit $exitval ;
	}
}

###############################################################################
#
# we know it needs to be reported...
#
# report it to spamcop

if ( $spamcop )
{
	forward_attach ( $spamcop , $spam ) ;
}

###############################################################################
#
# if we found an IP earlier (i.e. if the message was sent to ourselves) then
# we can do some more stuff, like...

if ( $ip )
{

	########################################
	# save a copy to the repository

	my $filename = keep_message ( $ip , $spam ) ;
	logit ( "report" , $ip , $recipient , $filename ) ;

	########################################
	# add the sender's IP to our blacklist

	my $qip = SQL_quote ( $ip ) ;
	my $qfn = SQL_quote ( $filename ) ;
	my $qco = SQL_quote ( $honeypot
			? "Sent mail to honeypot $recipient"
			: "Sent mail which was reported as spam" ) ;

	SQL_do ( "INSERT INTO rbl ( block , filename , comments )"
		. " VALUES ( $qip , $qfn , $qco )" ) ;

	########################################
	# update the "last updated" timer

	SQL_do ( "UPDATE control SET val_d = CURRENT_TIMESTAMP"
		. " WHERE key = 'last updated'" ) ;

	########################################
	# kick the service which rebuilds the RBL files

	if ( $named_pipe )
	{
		open ( P , ">$named_pipe" )
			or die "Can\'t write to $named_pipe: $!\n" ;
		print P "$ip\n" ;
		close P ;
	}

	########################################
	# send an email to tell the admin what's going on

	if ( $admin )
	{
		my $subject = ( $honeypot
			? "blacklisted $ip sent mail to honeypot $recipient"
			: "blacklisted $ip sent reported spam to $recipient" ) ;

		open ( QI , "| $var_qmail/bin/qmail-inject" )
			or die "Can\'t run $var_qmail/bin/qmail-inject: $!\n" ;
		print QI <<EOF ;
Date: $now_h
From: $admin
To: $admin
Subject: $subject

Added entry to rbl database
      IP: $ip
 Comment: $comment
Filename: $filename

fnord
EOF
		close QI ;
	}
}

###############################################################################
#
# outta here

exit $exitval ;