#!/usr/bin/perl -w

# Copyright (C) 2005 Daniel O'Connor <doconnor@gsoft.com.au>. 
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. 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.
#
# THIS SOFTWARE IS PROVIDED BY AUTHOR 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 AUTHOR 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.

use strict;
use FileHandle;
use Mail::IMAPClient;
use File::Temp qw/ tempfile tempdir /;
use File::Path;
use POSIX;
use English;
use Fcntl;

$ENV{"PATH"} = "/bin:/sbin:/usr/bin:/usr/sbin:/usr/local/bin:/usr/local/sbin:/usr/X11R6/bin";

my ($name, $server, $user, $authuser, $pwdfile, $hamfoldersuffix, $spamfoldersuffix, $password, $imap, $xxx, @folders, $f, $uid, $gid, $homedir, @userlist);

my $debug = 0;

# Turn auto-flush on so print statements get written out even if they
# don't have newlines at the end.
$| = 1;

# Configuration information
$server = "mail.example.com";
$authuser = "imapadmin";
$pwdfile = "/usr/local/Genesis/imap/config/impadadminpwd";
$hamfoldersuffix = "Spam.Ham";
$spamfoldersuffix = "Spam.Spam";

if ($> != 0) {
  die "You need to be root";
}

open PWD, "$pwdfile" or die "Unable to open password file $pwdfile: $!";
chomp($password = <PWD>);
close PWD;

print "Connecting to server..." if $debug;
$imap = Mail::IMAPClient->new(Server => $server,
			      User => $authuser,
			      Password => $password,
			      Uid => 1,
			     );

die "Failed to connect to $server as $authuser - $@" unless defined($imap);
print " done!\n" if $debug;

# Searching for users is slow since we have to parse the entire folder
# list. Would be faster to go through passwd and check for matching
# folders.
if (0) {
  print "Looking for users... " if $debug;
  @folders = $imap->folders;

  for $f (@folders) {
    if ($f =~ /user\.(.*)\.Spam.Spam/) {
      push (@userlist, $1);
      print "$1 ";
    }
  }
  print "done!\n" if $debug;
}

while ($name = getpwent()) {
    push @userlist, $name;
}

BADUSER: for $user (@userlist) {
  ($xxx, $xxx, $uid, $gid, $xxx, $xxx, $xxx, $homedir, $xxx, $xxx) = getpwnam($user);
  if (!defined($homedir)) {
    print "No home directory found for $user\n" if $debug;
    next BADUSER;
  }
  print "Home dir is $homedir\n" if $debug;

  print "Checking HAM messages for $user\n" if $debug;
  process_mails($imap, $authuser, $user, $homedir, $uid, $gid, "ham");
  print "Checking SPAM messages for $user\n" if $debug;
  process_mails($imap, $authuser, $user, $homedir, $uid, $gid, "spam");
}

$imap->close();
print "\n" if $debug;

exit 0;

#
# Main function that actually does the work
#
sub process_mails {
  my($imap, $authuser, $user, $homedir, $uid, $gid, $type, @chownlist, $pid, $chldstat, $output);
  ($imap, $authuser, $user, $homedir, $uid, $gid, $type) = @_;

  my($foldername, $fh, $tmpdir, @msgs, $m, $bogoswitch, $canselect, $cansetacl);

  if ($type eq "ham") {
    $foldername = "user.$user.$hamfoldersuffix";
    $bogoswitch = "-n";
  } elsif ($type eq "spam") {
    $foldername = "user.$user.$spamfoldersuffix";
    $bogoswitch = "-s";
  } else {
    die "Unknown type $type";
  }

  # By default admin users have no access to user folders, so set it here
  $cansetacl = $imap->setacl($foldername, $authuser, "lrswipd");
  # Try and select the folder
  if ($cansetacl) {
    $canselect = defined($imap->select($foldername));
  }
  # If either fail we can't continue
  if ($cansetacl && $canselect) {
    @msgs = $imap->search("ALL");
    if (@msgs != 0) {
      print "Processing..." if $debug;
      # Create a temp directory to store messages Ideally we would
      # like to use message_to_file to pass multiple messages to
      # sa-learn without the need for temporary storage, but
      # message_to_file doesn't write out the mails in a way sa-learn
      # can understand them.
      $tmpdir = tempdir("/tmp/process-spam.XXXXXXXX", CLEANUP => 0 );
      die "unable to create temporary directory" if !defined($tmpdir);

      # The end user has to own it so sa-learn can read it
      @chownlist = $tmpdir;

      # Copy each email into the temporary folder
      for $m (@msgs) {
	$fh = new FileHandle;
	$fh->open ("|tr -d 
 >$tmpdir/$m");
	$imap->message_to_file($fh, $m) or die "Couldn't fetch message - $imap->{LastError}";
	$fh->close;
	push @chownlist, "$tmpdir/$m";
      }
      chown $uid, $gid, @chownlist or die "Unable to chown messages - $!";

      # Fork and lower our privs to run sa-learn and bogofilter
      die "Can't fork: $!" unless defined($pid = open(KID, "-|"));

      if ($pid) {
	# Parent

	while (<KID>) {
	  # Gather up the output in case the child fails so we can log it
	  $output .= $_;
	}

	# Check if the child succeeded
	if (!close(KID)) {
	  $chldstat = WEXITSTATUS($?);
	  if ($chldstat != 0) {
	    print "Child returned " . $chldstat . " output follows\n";
	    print $output . "\n";
	  } else {
	    print "Child returned 0, but close failed\n";
	    print $output . "\n";
	  }
	} else {
	  print "Close succeeded\n" if $debug;
	  print $output . "\n" if $debug;
	}
      } else {
	# Child

	# Dup stdout to stderr
	open(STDERR, ">&STDOUT") || die "Can't dup stdout";
	print "Switching to $uid:$gid, home $homedir\n";

	# Drop privs
	$UID = $uid;
	$GID = $gid;
	$EUID = $uid;
	$EGID = $gid;
	$UID = $uid;
	$GID = $gid;

	# Tell sa-learn/bogofilter where to write stuff
	$ENV{"HOME"} = $homedir;

	# Do the actual work
	system("sa-learn", "-u", "$user", "--$type", "$tmpdir/") == 0 or die "Unable to run sa-learn - $!, $?";
	system("bogofilter", "$bogoswitch", "-v", "-B", "$tmpdir/") == 0 or die "Unable to run bogofilter - $!, $?";
	exit;
      }
      # Tidy up the emails
      rmtree($tmpdir, 0, 0);

      # Remove the email from the server
      $imap->select($foldername) or die "Couldn't re-select $foldername - $imap->{LastError}";
      $imap->delete_message(@msgs) or die "Couldn't delete messages after learning - $imap->{LastError}";
      $imap->expunge() or warn "Couldn't expunge messages - $imap->{LastError}";
      print "done!\n" if $debug;
    } else {
      print "Empty folder\n" if $debug;
    }
  } else {
    print "Couldn't set ACLs folder, probably doesn't exist\n" if (!$cansetacl && $debug);
    print "Can't select $type folder $foldername - $imap->{LastError}\n" if ($canselect && $debug);
  }
}