#!/usr/bin/env perl

=head1 NAME

parp - Perl Anti-spam Replacement for Procmail

=head1 SYNOPSIS

For information on usage from the command-line, type:

  parp -h

=cut

# $Id: parp,v 1.140 2002/04/29 15:16:50 adams Exp $

use strict;
use warnings;

require 5.6.0;
our $VERSION = '0.62';

use Fcntl qw(:flock);
use Mail::Internet;
# use MIME::Tools;
# MIME::Tools->debugging(1);
use Proc::Daemon;

use Parp::Config  qw(config);
use Parp::Filter  qw(filter);
use Parp::IdCache;
use Parp::Friends;
use Parp::Options qw(opt usage);
use Parp::Mail;
use Parp::Utils   qw(init_logfile vprint diagnose log_rule log_mode
                     error fatal);

$SIG{__DIE__} = \&die_handler;

# Process options
Parp::Options::process();

# Prepare for output
$| = 1;
init_logfile() unless opt('test_run');

kill_daemon_and_quit() if opt('kill_daemon');

SWITCH: {
  if (opt('filter_files')) { filter_argv();    last SWITCH; }
  if (opt('daemon'))       { do_daemon_mode(); last SWITCH; }
  do_filter_mode();
}

exit 0;

sub do_daemon_mode {
  usage() if @ARGV;

  Proc::Daemon::Init();

  # Proc::Daemon closes all open handles, so they need reopening.  We
  # also need to set up error handling as soon as we have somewhere to
  # log.
  init_logfile(); 
  $SIG{TERM} = $SIG{INT} = $SIG{QUIT} = \&quit_handler;
  $SIG{__WARN__} = \&warn_handler;

  # There could be a rogue shutdown file lying around
  # if parp -k was run when no daemon was running.
  my $shutdown_file = config->shutdown_file;
  unlink $shutdown_file;

  my $spool_dir = opt('daemon');
  opendir(SPOOL, $spool_dir)
    or fatal(7, "Couldn't open $spool_dir: $!");
  
  my $now = localtime();
  log_mode "parp $VERSION started in daemon mode (pid $$) at ",
           scalar(localtime());

  while (1) {
    my @mails = grep /^\d{9,}\.\d{1,}/, readdir(SPOOL);
    filter_incoming(@mails);
    rewinddir(SPOOL);
    check_shutdown();
    sleep(config->daemon_poll_interval);
  }
}

sub kill_daemon_and_quit {
  my $shutdown = config->shutdown_file;
  open(SHUTDOWN, ">$shutdown")
    or fatal(8, "Couldn't open $shutdown: $!");
  close(SHUTDOWN);
  exit 0;
}

sub filter_incoming {
  start_batch();
  foreach my $file (@_) {
    my $full = opt('daemon') . "/$file";
    open(MAIL, $full) or error("Couldn't open $full: $!");
    flock(MAIL, LOCK_EX | LOCK_NB) or next;
    my $mail = new Mail::Internet( [<MAIL>] );
    filter->process_mail($mail);
    close(MAIL);
    unlink $full;
  }
  end_batch();
}

sub do_filter_mode {
  # Behave like a filter; take one e-mail from STDIN

  usage() if @ARGV;

  my $mail = new Mail::Internet( [<STDIN>] );
  start_batch();
  filter->process_mail($mail);
  end_batch();
}

sub filter_argv {
  # Filter all folders given in @ARGV

  usage() unless @ARGV;

  log_mode "pid $$ started run on folders in ARGV at ", scalar(localtime());

  start_batch();

  my %counts = (
    parsed  => 0,
    total   => 0,
    main    => 0,
    aux     => 0,
    spam    => 0,
    dups    => 0,
    special => 0,
  );
  my %inodes_seen = ();

  foreach my $file (@ARGV) {
    unless (-f $file) {
      # TODO: allow symlinks
      vprint "Skipping non-file $file.\n";
      next;
    }

    my ($inode, $size) = (stat $file)[1, 7];

    if ($size == 0) {
      vprint "Skipping empty file $file.\n";
      next;
    }

    if ($inodes_seen{$inode}) {
      vprint "Skipping $file\n" .
             "  (already seen file $inodes_seen{$inode} with inode $inode\n";
      next;
    }
    $inodes_seen{$inode} = $file;

    filter_folder($file, \%counts);
  }

  end_batch();

  # FIXME
#   diagnose <<EOF;
# Parsed $counts{parsed} of $counts{total} messages:
#   delivered $counts{main} to $CONFIG{main_folder}
#   delivered $counts{aux} to auxiliary folders
#   tagged $counts{spam} as spam
#   discarded $counts{dups} as duplicate
#   tagged $counts{special} as special
# EOF
  diagnose "pid $$ ended run at ", scalar(localtime), "\n";
  log_rule('=');
}

sub filter_folder {
  my ($file, $counts) = @_;

  vprint "Reading $file ... ";
  require Mail::Box::Manager;
  my $mgr = Mail::Box::Manager->new;
  my $folder = $mgr->open(folder => $file,
                          lazy_extract => 'NEVER'
                         );
  vprint "done.\n";

  my ($file_total, $friends) = (0, 0);

  foreach my $mail ($folder->allMessages) {
    $counts->{total}++;

    $mail->{parp_foldername} = $file;
    if (! $mail) {
      error(ref($folder) . '::allMessages() failed',
            "\$mail:\n", Dumper $mail);
      next;
    }

    my $rv = filter->process_mail($mail);
    $counts->{parsed}++  if $rv;
    $counts->{dups}++    if $rv =~ /IS_DUPLICATE/;
    $counts->{spam}++    if $rv =~ /IS_SPAM/;
    $counts->{main}++    if $rv =~ /TO_MAIN/;
    $counts->{aux}++     if $rv =~ /TO_AUX/;
    $counts->{special}++ if $rv =~ /IS_SPECIAL/;
    $counts->{friends}++ if $rv eq 'EXTRACTED_FRIEND';
    $counts->{file_total}++;

    last if opt('sample') && $counts->{total} >= opt('sample');
  }

  $mgr->close($folder);
}

sub start_batch {
  Parp::Friends::attach();
  Parp::IdCache::attach();
}

sub end_batch {
  Parp::Friends::release();
  Parp::IdCache::release();
}

sub quit_handler {
  my ($sig) = @_;
  my $shutdown = config->shutdown_file;
  if (! open(SHUTDOWN, ">$shutdown")) {
    log_mode "pid $$ caught a SIG$sig at ", scalar(localtime),
             "\nbut failed to open $shutdown: $!; shutting down immediately";
  }
  print SHUTDOWN $sig;
  close(SHUTDOWN);
}

sub warn_handler {
  (my $warning = shift) =~ s/^/!!! /gm;
  $warning =~ s/\n*$/\n/;
  diagnose($warning);
}

sub check_shutdown {
  my $shutdown = config->shutdown_file;
  return unless open(SHUTDOWN, $shutdown);
  my $sig = <SHUTDOWN> || '';
  chomp $sig;
  close(SHUTDOWN);
  unlink $shutdown;
  log_mode "pid $$ ",
           $sig ? "caught a SIG$sig" : "received shutdown via -k",
           " --\nshutting down gracefully at ", scalar(localtime);
  exit 0;
}

sub die_handler {
  my ($error) = @_;
  error($error, "Called via DIE handler\n");
  exit 255;
}

=head1 DESCRIPTION

parp is a powerful, extensible, hackerware e-mail filter with
sophisticated anti-spam capabilities.

FIXME: Include an overview of all the modules here.
For now, see <http://adamspiers.org/computing/parp/>.

=head1 SEE ALSO

L<Parp::Blacklist>,
L<Parp::Config>,
L<Parp::Filter>,
L<Parp::Folders>,
L<Parp::Friends>,
L<Parp::IdCache>,
L<Parp::Locking>,
L<Parp::Mail>,
L<Parp::Mail::Deliverable>,
L<Parp::Mail::Friends>,
L<Parp::Mail::Tests::Body>,
L<Parp::Mail::Tests::Header>,
L<Parp::Options>,
L<Parp::Utils>

=head1 LICENSE

Copyright (c) 1999 Adam Spiers <adam@spiers.net>.  All rights
reserved.  This program is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.

=cut