#!/usr/bin/perl
use strict;
use warnings;
BEGIN {
    use File::Basename;
    my $dir = dirname($0) .'/../lib';
    unshift(@INC, $dir) if(-d $dir);
}
use Encode qw(decode);
use Getopt::Std;
use LockFile::Simple;
use POSIX qw(strftime);
use MySpam;
use MySpam::Email;

binmode(STDOUT, ':utf8');


my %opts;
getopt('c', \%opts);


sub usage {
    my $me = basename($0);
    die
"usage: $me [-c <config>] <command> [args]

where <command> [args] is one of:
    install       [--db]
    quarantine    <file>|<directory> [--rm]
    expire
    list          <recipient>
    release       <recipient> <id>
    delete        <recipient> <id>
    print         <recipient> <id>
    whitelist     <recipient> <sender>
    unwhitelist   <recipient> <sender>
    listwhitelist <recipient>
    genwhitelist
    subscribe     <recipient> <days>
    unsubscribe   <recipient>
    newsletter    <days> [--send]
";
}


my $m;
sub cm { # Connect to MySpam
    $m = MySpam->new($opts{c}) unless($m);
}


sub install {
    my $real = shift;
    cm();

    if (!$real) {
        print "No --db option - printing schema only:\n\n";
        print join(";\n", map {$_->sql_create} $m->db->tables)
                . ";\n";
        return;
    }
    
    if ($real ne '--db') {
        usage;
    }

    if ($m->deploy) {
        print "Database installed\n";
        return;
    }
    else {
        die "Database NOT installed";
    }
}


# Internal method - not documented.
sub quarantine_file {
    my $file = shift || die 'takes a file, dummy!';
    my $rm   = shift || '';

    cm();

    if ($m->quarantine_file($file)) {
        print "$file: Quarantined $rm\n";
        $rm && unlink($file);
    }
    else {
        die "$file: could NOT be quarantined";
    }
}


sub quarantine {
    my $obj = shift || usage;
    my $rm  = shift;

    if ($rm and $rm ne '--rm') {
        usage;
    }

    my @files;

    if (-f $obj) {
        push(@files, $obj);
    }
    elsif (-d $obj) {
        opendir(DIR, $obj) || die "opendir($obj): $!";
        @files = map {$obj .'/'. $_} readdir(DIR);
    }
    else {
        die "$obj not a file or a directory";
    }


    my $lockmgr = LockFile::Simple->make(
        -autoclean => 1,
        -format    => '%f.lck',
        -hold      => 10000000,
        -stale     => 1,
        -delay     => 2,
        -max       => 5,
        -nfs       => 0,
        -warn      => 0,
    );

    my $me = basename($0);
    if (!$lockmgr->lock("/var/lock/$me")) {
        die "Could not lock /var/lock/$me: $!";
    }

    foreach my $file (@files) {
        if (-f $file) {
            quarantine_file($file, $rm);
        }
    }

    $lockmgr->unlock("/var/lock/$me");
}


sub expire {
    cm();
    $m->expire;
}


sub list {
    my $recipient = shift || usage;
    cm();
    my @results = $m->get_quarantined_mails($recipient);

    print "Quarantined mails for $recipient:\n";
    print "------------------------------------------------------------\n";
    foreach my $r (@results) {
        my $h_from = eval { decode('MIME-Header',$r->h_from) } || 'Unknown';
        my $h_subj = eval { decode('MIME-Header',$r->h_subject) } || 'Unknown';

        print
            ' Quarantined: '. gmtime($r->epoch) ." UTC\n".
            ' From: '. $h_from ."\n".
            ' Subject: '. $h_subj ."\n".
            ' Score: '. $r->sa_score ."\n".
            ' ID: '.$r->id.' (last released: '. 
               ($r->released ? gmtime($r->released).' UTC' :'Never'). ")\n\n"
            ;
    }
    if (!@results) {
        print " None\n\n";
    }

    listwhitelist($recipient);

    print "Subscription Status for $recipient:\n";
    print "------------------------------------------------------------\n";
    if (my $s = $m->get_subscriber($recipient)) {
        print " Newsletter every "
            .  ($s->period == 1 ? 'day.' : $s->period .' days.')
            ."\n\n";
    }
    else {
        print " Not subscribed\n\n";
    }
}


sub release {
    my $recipient = shift || usage;
    my $id        = shift || usage;
    cm();

    if ($m->release($recipient,$id)) {
        print "Mail Released\n";
    }
    else {
        die "Mail NOT Released";
    }
}


sub remove {
    my $recipient = shift || usage;
    my $id        = shift || usage;
    cm();

    unless (my $res = $m->remove($recipient,$id)) {
        die "Mail NOT Deleted: $res";
    }
    print "Mail Deleted\n";
}


sub printraw {
    my $email = shift || usage;
    my $id    = shift || usage;
    cm();

    my ($recipient, $raw) = $m->raw($email,$id);
    if($raw) {
        print $raw;
        return;
    }
    die "Mail not found";
}


sub whitelist {
    my $recipient = shift || usage;
    my $sender    = shift || usage;
    cm();

    if ($m->add_to_whitelist($recipient,$sender)) {
        print "$sender is whitelisted\n";
    }
    else {
        die "$sender is NOT whitelisted";
    }
}


sub unwhitelist { my $recipient = shift || usage;
    my $sender    = shift || usage;
    cm();

    if ($m->remove_from_whitelist($recipient,$sender)) {
        print "$sender is not whitelisted\n";
    }
    else {
        die "$sender COULD NOT be unwhitelisted";
    }
}


sub listwhitelist {
    my $recipient = shift || usage;
    cm();

    print "Whitelist for $recipient:\n";
    print "------------------------------------------------------------\n";

    my @wl = $m->get_whitelist($recipient);
    foreach my $w (@wl) {
        printf(" %-42s %s UTC\n", $w->sender,
            strftime('%F %R', gmtime($w->epoch)) );
    }
    if (!@wl) {
        print " None\n";
    }
    print "\n";
}


sub genwhitelist {
    cm();
    my $file = shift;

    if (!$m->generate_whitelist_dbm($file)) {
        die "Whitelist generation failed";
    };
}


sub subscribe {
    my $recipient = shift || usage;
    my $period    = shift || usage;
    cm();

    if ($m->subscribe($recipient,$period)) {
        print "$recipient is subscribed($period)\n";
    }
    else {
        die "$recipient is NOT subscribed($period)";
    }
}


sub unsubscribe {
    my $recipient = shift || usage;
    cm();

    if ($m->unsubscribe($recipient)) {
        print "$recipient is unsubscribed\n";
    }
    else {
        die "$recipient is NOT unsubscribed";
    }
}


sub newsletter {
    my $send = shift || '';
    $send = $send eq '--send';

    cm();
    my @list = $m->subscriber_newsletter_list;

    if (!$send) {

        print "Subscribers due for a newsletter:\n";
        foreach my $sub (@list) {
            print '    ' . $sub->subscriber ."\n";
        }
        return;
    }

    my $e = MySpam::Email->new($opts{c});

    foreach my $sub (@list) {
        (my $domain = $sub->subscriber) =~ s/.*\@//;
        $e->reset;
        $e->to($sub->subscriber);
        $e->from('myspam@'. $domain);
        $e->subject('MySpam Newsletter');
        $e->list($sub->last_sent);
        $e->send;
        $m->subscriber_sent($sub);
    }
}


my $cmd = lc(shift @ARGV) || usage;

if ($cmd eq 'install') {
    install(@ARGV);
}
elsif ($cmd eq 'quarantine') {
    quarantine(@ARGV);
}
elsif ($cmd eq 'expire') {
    expire;
}
elsif ($cmd eq 'list') {
    list(@ARGV);
}
elsif ($cmd eq 'release') {
    release(@ARGV);
}
elsif ($cmd eq 'delete') {
    remove(@ARGV);
}
elsif ($cmd eq 'print') {
    printraw(@ARGV);
}
elsif ($cmd eq 'whitelist') {
    whitelist(@ARGV);
}
elsif ($cmd eq 'unwhitelist') {
    unwhitelist(@ARGV);
}
elsif ($cmd eq 'listwhitelist') {
    listwhitelist(@ARGV);
}
elsif ($cmd eq 'genwhitelist') {
    genwhitelist(@ARGV);
}
elsif ($cmd eq 'subscribe') {
    subscribe(@ARGV);
}
elsif ($cmd eq 'subscribe2') {
    subscribe2(@ARGV);
}
elsif ($cmd eq 'unsubscribe') {
    unsubscribe(@ARGV);
}
elsif ($cmd eq 'newsletter') {
    newsletter(@ARGV);
}
else {
    usage;
}


__END__

=head1 NAME

myspam - Command-line interface to the MySpam application

=head1 SYNOPSIS

  myspam [-c <config>] <COMMAND> [args]

=head1 DESCRIPTION

MySpam is all about managing mail that has been blocked by sa-exim.
B<myspam> is the shell (administrative) interface to MySpam. Most users
would only interact with MySpam using the email interface (see
L<myspam-smtp> for details).

<COMMAND> usually results in some kind of action in the MySpam database,
or may result in emails being sent.

=head2 -c config

Specify a configuration file other than the default /etc/myspam/myspam.conf.

=head1 COMMANDS

=head2 install [--db]

Prints the CREATE statements used to build the database tables and indexes.
If the optional '--db' if given then the actions will actually be
run against in the database. You only need to run this action once against
the database. Users of the Debian package don't need to do this -
the (SQLite) database is created automatically at installation time.

=head2 quarantine <file>|<directory> [--rm]

Imports into the database <file> or the files in <directory>. If '--rm'
is specified then the file(s) will be removed after successfully being
inserted.

The files to be imported must be in standard mbox format and must have
a X-SA-Exim-Rcpt-To: header. NOTE: This header is only added by sa-exim if
SAmaxrcptlistlength in /etc/exim4/sa-exim.conf is set to a positive value.

=head2 expire

Delete old mails from the database. The maximum age of a mail is determined
by the 'expire' item in /etc/myspam/myspam.conf. This command would
not normally be run by hand but would be called from a cron(8) job.

=head2 list <recipient>

List the mails which are in the database for <recipient>

=head2 release <recipient> <id>

Release the mail with matching <recipient> and <id>.

=head2 delete <recipient> <id>

Delete the mail with matching <recipient> and <id>.

=head2 whitelist <recipient> <sender>

Add address <sender> to the whitelist for <recipient>. The whitelist
functionality only works if the appropriate plugin for SpamAssassin
has been installed and configured.

=head2 unwhitelist <recipient> <sender>

Remove address <sender> from the whitelist for <recipient>. The whitelist
functionality only works if the appropriate plugin for SpamAssassin
has been installed and configured.

=head2 listwhitelist <recipient>

Print the whitelist for <recipient>. Output includes the date each
whitelist entry was created.

=head2 genwhitelist

Generates a Berkeley DBM file containing sender/recipient pairs in the
whitelist. This DBM file can be used by the MySpam/Whitelist plugin
for SpamAssassin to decrease the score for matching pairs. This command
is not normally run by hand but would be called by a cron(8) job.

=head2 subscribe <recipient> <days>

Add the address <recipient> to the subscription list sent every <days>
days.

=head2 unsubscribe <recipient>

Remove the address <recipient> from all subscription lists.

=head2 newsletter [--send]

Send out the newsletter to addresses whose subscription is due today.

If --send is not given then this command merely prints the addresses that
would receive a newsletter.

This command would not normally be run by hand but called from a
cron(8) job.

=head1 CONFIGURATION FILE

/etc/myspam/myspam.conf is the default configuration file. It should
define the following keys, separated from the values by '='.

=head2 dbi

A standard L<DBI> database connection string such as
dbi:SQLite:/var/lib/myspam/myspam.db.

=head2 user

Database user name.

=head2 pass

Database user password.

=head2 admin

The contact address for users with problems. Also gets Cc'd in the event
of an error.

=head2 expire

The number of seconds which messages in the database can age before they
are removed.

=head2 whitelist

The location of the DBM file for the SpamAssassin WhitelistDBM plugin.
This must match with the /etc/spamassassin/whitelistdbm.cf config file.

=head1 FILES

/etc/myspam/myspam.conf - database connection information

/etc/myspam/myspam.css - style definition for HTML email

/etc/spamassassin/whitelistdbm.cf

/var/log/mail.* - syslog(8) reporting of success or failure

=head1 SEE ALSO

L<MySpam>, L<myspam-smtp>

=head1 AUTHOR

Mark Lawrence E<lt>nomad@null.netE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2007-2009 Mark Lawrence <nomad@null.net>

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

=cut

# vim: set tabstop=4 expandtab:
