#!/usr/bin/perl -w
#####################################################################
# Copyright (C) 2004 Alexander Kuehn <alexander.kuehn@nagilum.net>
#  http://www.nagilum.net/unix/dspam.toggle. All rights reserved.
#####################################################################
# License:  BSD
#  Redistribution and use in source and binary forms, with or without
#  modification, are permitted provided that the following conditions
#  are met:
#
# * Redistributions of source code must retain the above copyright 
#   notice, this list of conditions and the following disclaimer.
# * Redistributions in binary form must reproduce the above copyright
#   notice, this list of conditions and the following disclaimer in 
#   the documentation and/or other materials provided with the 
#   distribution.
# * Neither the name of Alexander Kuehn nor the names of its 
#   contributors may be used to endorse or promote products derived 
#   from this software without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 
# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 
# FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 
# COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 
# (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 
#  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
# STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
# OF THE POSSIBILITY OF SUCH DAMAGE.
#####################################################################
# Purpose:
#  This is a small helper application for integrating dspam
#  or possibly other spamfilters into horde/imp. 
#  Given a mail as input (stdin) it searches for a given X header
#  and depending on the result of a second RE matched 
#  against that line it feeds the mail into another program
#  (the spamfilter) with different arguments.
#  To integrate this into horde change the $conf['spam']['program'] 
#  line in horde/imp/config/conf.php to something similar to this:
#  if (@is_callable(array(Auth, getAuth))) {
#	$conf['spam']['program'] = '/usr/local/bin/dspam.toggle '
#					. Auth::getAuth();
#  }
#  Make sure the path is correct and the file is executeable (+x).
#####################################################################
# Version history:
#	1.0 initial release
#	1.1 It seems dspam 3.1+ does no longer chop off a trailing
#	    \r after the signature, this causes it to not find the
#           signature sought after and produces this error message:
#    "process_message returned error -5. delivering message."
#	    To combat that this program now chops off all \r's
#	    at all line-ends of the mail. This should not cause
#	    any problems since dspam only needs the signature
#	    not the whole mail and the rest of the output is
#	    more or less disregarded.
#	1.2 Apparently I was a bit overzealous by adding that
#	    "s/\r$//;", it seems dspam has this feature already.
#	    It can be turned on again by adding/uncommenting
#	    "Broken lineStripping" in dspam.conf (dspam 3.2+).
#	    So if you're getting error -5 again, try enabling
#	    that option.
#	    Added "@" for the is_callable function to omit
#	    useless warnings about auth not beeing defined (imp).
#####################################################################
# dspam.toggle
#  This can be used to toggle the spam status of mails.
# Usage:
#  dspam.toggle [opts] < mail
#

package main;
use strict;

my $version="$0 1.2";

# the command line will be "$dspam $commonopt [$erropts] $(no)spamopts $opts"
local %::config = (	
	dspam		=>	"/usr/local/bin/dspam",
				# which header to search for?
	xheader		=>	"X-DSPAM-Result",
				# options
	commonopt	=>	"--feature=chained,noise,whitelist",
	spamopts	=>	"--mode=teft --class=spam --user",
	nospamopts	=>	"--mode=tum --class=innocent --user",
	erropts		=>	"--source=error",
	unknownopts	=>	"--mode=tum -d",
				# whats the trigger word?
	spamre		=>	"Spam"
				# if the xhdr could not be found
				# where to pipe to?
	);

my $opts=join(" ", @ARGV);
my $got_header=0;
my $headerbuffer;

# read stdin until we find the header we're looking for
# or a single line
while (<STDIN>) {
	if ($got_header) {
		print;
	} else {
		$headerbuffer.=$_;
		if (/^$::config{xheader}: /) {
			if ( /$::config{spamre}/ ) {
				# this mail has been flagged as spam but isn't
				open (PIPE, "|$::config{dspam} $::config{commonopt} $::config{erropts} "
					  . "$::config{nospamopts} $opts") || print STDERR ("$version:could not"
					. " open dspam pipe ($::config{dspam} $::config{commonopt} "
					. "$::config{erropts} $::config{nospamopts} $opts:$?)!\n");
			} else {
                # this mail hasn't been flagged as spam but is
				open (PIPE, "|$::config{dspam} $::config{commonopt} $::config{erropts} "
					  . "$::config{spamopts} $opts") || print STDERR ("$version:could not"
					. " open dspam pipe ($::config{dspam} $::config{commonopt} "
					. "$::config{erropts} $::config{spamopts} $opts:$?)!\n");
			}
			*STDOUT=*PIPE;		# set stdout to pipe
			print $headerbuffer;
			$got_header=1;
		} elsif (/^$/) {
			print STDERR ("Could not open find header $::config{xheader}!\n");
			open (PIPE, "|$::config{dspam} $::config{commonopt} $::config{unknownopts} $opts") 
				|| print STDERR ("$version:could not open error output pipe ($::config{dspam} "
								 . "$::config{commonopt} $::config{unknownopts} $opts:$?)!\n");
			*STDOUT=*PIPE;		# set stdout to pipe
			print $headerbuffer;
			$got_header=1;
		}
	}
}

close STDOUT;