#!/usr/bin/perl -w
############################################################
# The code in this file is copyright 2001 by Craig Hughes  #
# It is licensed for use with the SpamAssassin distribution#
# under the terms of the Perl Artistic License, the text of#
# which is included as the file named "License"            #
############################################################

use lib '../lib';	# added by jm for use inside the distro
use strict;
use Socket;
use Carp;
use Mail::Audit;
use Mail::SpamAssassin;
use Sys::Syslog qw(:DEFAULT setlogsock);
use POSIX qw(setsid);
use Getopt::Std;

my %resphash = (
    EX_OK => 0,
    EX_USAGE => 64, # command line usage error
    EX_DATAERR => 65, # data format error
    EX_NOINPUT => 66, # cannot open input
    EX_NOUSER => 67, # addressee unknown
    EX_NOHOST => 68, # host name unknown
    EX_UNAVAILABLE => 69, # service unavailable
    EX_SOFTWARE => 70, # internal software error
    EX_OSERR => 71, # system error (e.g., can't fork)
    EX_OSFILE => 72, # critical OS file missing
    EX_CANTCREAT => 73, # can't create (user) output file
    EX_IOERR => 74, # input/output error
    EX_TEMPFAIL => 75, # temp failure; user is invited to retry
    EX_PROTOCOL => 76, # remote error in protocol
    EX_NOPERM => 77, # permission denied
    EX_CONFIG => 78, # configuration error
);

sub usage
{
    warn <<EOUSAGE;

Usage: spamd [options]

Options:

    -h            Print this usage message and exit
    -L            Use local tests only (no DNS or other network lookups)
    -A host,...   Set list of authorized ip addresses which can connect to this server
                    (defaults to 127.0.0.1 only)
    -p port       Listen on the specific port (otherwise default is port 22874)
    -u username   Run as named user, instead of running setuid to spamc user
    -d		  Daemonize, detach from parent process
    -x            Disable user config files
    -P            Die upon user errors (does not exist or user = root) instead of
                  running as 'nobody' with defaults.
    -s            Specify the syslog facility (default: mail)
    -D            Print debugging messages
    -c            Create user preferences files if they do not already exist

EOUSAGE
    exit $resphash{EX_USAGE};
}

use POSIX 'setsid';
sub daemonize
{
	chdir '/' or die "Can't chdir to '/': $!";
	open STDIN,'/dev/null' or die "Can't read '/dev/null': $!";
	open STDOUT,'>/dev/null' or die "Can't write '/dev/null': $!";
   defined(my $pid=fork) or die "Can't fork: $!";
   exit if $pid;
   setsid or die "Can't start new session: $!";
   open STDERR,'>&STDOUT' or die "Can't duplicate stdout: $!";
}

use vars qw{
  	$opt_d $opt_h $opt_L $opt_p $opt_A $opt_x $opt_s $opt_D $opt_u
	$opt_P $opt_c
};

getopts('hdLxp:A:s:Du:Pc') or usage();

$opt_h and usage();

# These can be changed on command line with -A flag
my @allowed_clients;
if($opt_A)
{
    @allowed_clients = split /,/,$opt_A;
}
else
{
    @allowed_clients = qw (127.0.0.1);
}

# This can be changed on the command line with the -s flag
my $log_facility;
if($opt_s)
{
    $log_facility = $opt_s;
}
else
{
    $log_facility = 'mail';
}

my $dontcopy = 1;
if ($opt_c) { $dontcopy = 0; }

my $spamtest = Mail::SpamAssassin->new({
  dont_copy_prefs => $dontcopy,
  local_tests_only => $opt_L,
  debug => $opt_D,
  paranoid => ($opt_P || 0),
});

$spamtest->compile_now();	# ensure all modules etc. are loaded
$/ = "\n";			# argh, Razor resets this!  Bad Razor!

sub spawn;  # forward declaration
setlogsock('unix');

# jm: NOTE: this should probably just openlog() once, in parent pid, for
# efficiency (TODO)
sub logmsg {
  openlog('spamd','cons,pid',$log_facility); syslog('info',"@_"); closelog();
}

my $port = $opt_p || 22874;
my $proto = getprotobyname('tcp');

($port) = $port =~ /^(\d+)$/ or die "invalid port";

# Be a well-behaved daemon
chdir '/'               or die "Can't chdir to /: $!";
open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
open STDOUT, '>/dev/null' or die "Can't write to /dev/null: $!";
# open STDERR, '>/dev/null' or die "Can't write to /dev/null: $!";

socket(Server, PF_INET, SOCK_STREAM, $proto)        || die "socket: $!";
setsockopt(Server,SOL_SOCKET,SO_REUSEADDR,pack("l", 1)) || die "setsockopt: $!";
bind(Server, sockaddr_in($port, INADDR_ANY))        || die "bind: $!";
listen(Server,SOMAXCONN)                            || die "listen: $!";

$opt_d and daemonize();

# support non-root use (after we bind to the port)
my $setuid_to_user = 0;
if ($opt_u) {
    my $uuid = getpwnam($opt_u);
    if (!defined $uuid || $uuid == 0) {
	die "fatal: cannot run as nonexistent user or root with -u option\n";
    }
    $> = $uuid;		# effective uid
    $< = $uuid;		# real uid. we now cannot setuid anymore
    if ($> != $uuid) {
	die "fatal: setuid to uid $uuid failed\n";
    }

} elsif ($> == 0) {
    $setuid_to_user = 1;
}

logmsg "server started on port $port";
if ($opt_D) {
    warn "server started on port $port\n";
    warn "server pid: $$\n";
}

my $waitedpid = 0;
my $current_user;
my $paddr;

$SIG{CHLD} = 'IGNORE';		# important: avoids perl sighandling bug on BSD

for ( $waitedpid = 0;
      ($paddr = accept(Client,Server)) || $waitedpid;
      $waitedpid = 0, close Client)
{
    next if $waitedpid and not $paddr;

    my $start = time;

    my($port,$iaddr) = sockaddr_in($paddr);
    my $name = gethostbyaddr($iaddr,AF_INET);

    if ( allowed($iaddr) ) {
       logmsg "connection from $name [",
       				inet_ntoa($iaddr),"] at port $port";
    } else {
       logmsg "unauthorized connection from $name [",
       				inet_ntoa($iaddr),"] at port $port";
       next;
    } 

    spawn sub {
	$|=1; # always immediately flush output
	# First request line off stream
        local $_ = <STDIN>;
	chomp;
        if(/PROCESS SPAMC\/(.*)/)
	{
	    my $version = $1;
	    if($version > 1.0)
	    {
		while(1)
                {
                    $_ = <STDIN>;
                    if(!defined $_) {
                        protocol_error ("(EOF during headers)");
                        return 1;
                    }
                    if (/^\r\n/s) { last; }
                    if((/^User: (.*)\r\n/) && (! $opt_x)) {
		        handle_user ($1);
                    }
                }	
	    }

            if ($spamtest->{paranoid} && $setuid_to_user && $> == 0)
            {
                logmsg "PARANOID: Still running as root, closing connection.";
	    }
            elsif ( $setuid_to_user && $> == 0 )
            {
                logmsg "Still running as root: user not specified, not found, or set to root.  Fall back to nobody.";
		my $uid = getpwnam('nobody');
		if (!defined $uid) { die "no UID for nobody"; }
                $> = $uid;
            }

	    my $resp = "EX_OK";
	    # Now read in message
	    my $mail = Mail::SpamAssassin::MyMailAudit->new();

	    # Now use copy-on-writed (hopefully) SA object
	    my $status = $spamtest->check($mail);
	    $status->rewrite_mail; #if $status->is_spam;

	    print "SPAMD/1.0 $resphash{$resp} $resp\r\n",
	    		$mail->header, "\n",
			(join '',@{$mail->body});

	    logmsg "processed successfully for $current_user:$> in ".
			 sprintf("%3d", time - $start) ." seconds.\n";

	    $status->finish();	# added by jm to allow GC'ing
	}
	else
	{
	    protocol_error ($_);
	}
    };
}

sub protocol_error {
  local $_ = shift;

  my $resp = "EX_PROTOCOL";
  print "SPAMD/1.0 $resphash{$resp} Bad header line: $_\r\n";
  logmsg "bad protocol: header error: $_";
}

sub allowed {
    my $iaaddr = shift;

    #I'm sure this could be improved, but hey, it works.
    foreach (@allowed_clients) {
        if (inet_ntoa($iaaddr) eq $_) {
	   return(1);
	}
    }
    
    return(0);
}

sub spawn {
    my $coderef = shift;

    unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
	confess "usage: spawn CODEREF";
    }

    my $pid;
    if (!defined($pid = fork)) {
	logmsg "cannot fork: $!";
	return;
    } elsif ($pid) {
	return; # I'm the parent
    }
    # else I'm the child -- go spawn

    open(STDIN,  "<&Client")   || die "can't dup client to stdin";
    open(STDOUT, ">&Client")   || die "can't dup client to stdout";
    exit &$coderef();
}

sub handle_user {
    my $username = shift;

    $current_user = $username;
    my ($name,$pwd,$uid,$gid,$quota,$comment,$gcos,$dir,$etc) =
    				getpwnam($username);

    if ( !$spamtest->{paranoid} && !defined($uid) ) {
       #if we are given a username, but can't look it up,
       #Maybe NIS is down? lets break out here to allow
       #them to get 'defaults' when we are not running paranoid.
       logmsg "handle_user() -> unable to find user [$username]!\n";
       return 0;
    }

    if ($setuid_to_user) {
      $> = $uid;
      if ($> != $uid) {
	logmsg "setuid to $uid failed";
	die;		# make it fatal to avoid security breaches
      }
    }

    my $cf_file = $dir."/.spamassassin.cf";

    create_default_cf_if_needed ($cf_file, $username);
    $spamtest->read_scoreonly_config ($cf_file);
    $spamtest->load_scoreonly_sql ($username);
    return 1;
}

sub create_default_cf_if_needed {
    my ($cf_file, $username) = @_;

    # Parse user scores, creating default .cf if needed:
    if( ! -r $cf_file && ! $spamtest->{dont_copy_prefs})
    {
	logmsg "Creating default_prefs [$cf_file]";

	$spamtest->create_default_prefs ($cf_file,$username);

	if ( ! -r $cf_file )
	{
	    logmsg "Couldn't create readable default_prefs for [$cf_file]";
	}
    }
}

=head1 NAME

spamd - daemonized version of spamassassin

=head1 SYNOPSIS

spamd [options]

=head1 OPTIONS

=over

=item B<-c>

Create user preferences files if they don't exist (default: don't)

=item B<-d>

Detach from starting process and run in background (daemonize)

=item B<-D>

Print debugging messages

=item B<-h>

Print a brief help message, then exit without further action

=item B<-L>

Perform only local tests on all mail.  In other words, skip DNS and other
network tests.  Works the same as the C<-L> flag to C<spamassassin(1)>

=item B<-A> I<host,...>

Specify a list of authorized hosts which can connect to this spamd instance.
The list is one of valid IP addresses, separated by commas.  By default, connections are only accepted from localhost

=item B<-p> I<port>

Optionally specifies the port number for the server to listen on.

=item B<-P>

Die on user errors (for the user passed from spamc) instead of falling back to user I<nobody> and using the default configuration

=item B<-s> I<facility>

Specify the syslog facility to use (default: mail)

=item B<-u> I<username>

Run as the named user.  The alternative, default behaviour is to setuid() to
the user running C<spamc>, if C<spamd> is running as root

=item B<-x>

Turn off per-user config files.  All users will just get the default configuration

=back

=head1 DESCRIPTION

The purpose of this program is to provide a daemonized version of the
spamassassin executable.  The goal is improving throughput performance for
automated mail checking.

This is intended to be used alongside C<spamc>, a fast, low-overhead C client
program.

See the README file in the C<spamd> directory of the SpamAssassin distribution
for more details.

=head1 SEE ALSO

spamc(1)
spamassassin(1)
Mail::SpamAssassin(3)

=head1 AUTHOR

Craig R Hughes E<lt>craig@hughes-family.orgE<gt>

=head1 PREREQUISITES

C<Mail::SpamAssassin>

=cut