#!/usr/bin/perl
# server:.spamdealer/reporter -- make a RFC 2046 spam multipart/digest
# of spam headers sorted by score. Bodies are left on the server.
# Copyright       : http://www.fsf.org/copyleft/gpl.html
# By: Dan Jacobson  http://jidanni.org/comp/spam/spamdealer.html
# Last Modified On: Mon Mar 10 00:01:56 2008
# Update Count    : 635
# Spam strategy for low bandwidth users. We don't have to ask root to
# install anything. This file is triggered by a special message
# (that is caught by procmail) that one sends when one wants a report.
# courier-imap users see
# http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=464016
use strict;
use warnings FATAL => 'all';
use File::Find;
use MIME::Entity;
use MIME::Head;
use constant S     => "spamdealer";
use constant TS    => "." . S . "/time";
use constant JTIME => time - 100;          #avoid race conditions perhaps
umask 077;
die "Usage: $0 spam_days backup_days" unless $#ARGV == 1;
chdir or die;

if ( !-f TS ) {
    for ( JTIME - 10 * 365 * 24 * 60 * 60 ) {
        open( FILE, ">>" . TS ) or die $!;
        close FILE or die $!;
        utime $_, $_, TS or die $!;
    }
}
use vars qw/*name/;
*name = *File::Find::name;
my $AGE_OF_ts = -M TS;
File::Find::find( { wanted => \&wanted }, glob "Mail/*spam" );
my ( %headers, %score );

sub wanted {
    my $size = (lstat)[7];
    -f _ or return;
    if ( -M _ < $AGE_OF_ts ) {
        my $bighead = MIME::Head->from_file($_);
        for (qw/Date From Subject X-Spam-Status X-Spam-Languages/) {
            if ( $bighead->count($_) and my $h = $bighead->get($_) ) {
                $headers{$name} .= "$_: " . $h;
            }
        }
        $headers{$name} .= "X-Size: $size\nX-File: $name\n\n";    #\n\n:gnus
        my $t = $bighead->get("X-Spam-Status");
        $score{$name} = $t && $t =~ /score=([-0-9.]+)/ ? $1 : 0;
    }
    elsif ( -M _ > $ARGV[0] ) { unlink or die $! }
}
my $top = MIME::Entity->build( Type => "multipart/digest", );
$top->preamble(
    [ "This ", S, " report should have ", scalar keys %score, " parts.\n" ] );
for ( sort { $score{$a} <=> $score{$b} } keys %score ) {
    my $part = MIME::Entity->build(
        Type                        => 'message/rfc822',          #be stingy:
        'Content-Type'              => undef,
        'Content-Disposition'       => undef,
        'Content-Transfer-Encoding' => undef,
        Top                         => 0,
        Data                        => $headers{$_}
    );
    $top->add_part($part);
}

File::Find::find( { wanted => \&wanted2 }, 'Mail/backup' );

sub wanted2 {
    lstat;
    -f _ or return;
    if ( -M _ > $ARGV[1] ) { unlink or die $! }
}
$top->print(\*STDOUT);
rename TS, TS . ".old" or die $!;
for (TS) {
    open( FILE, ">>" . $_ ) or die $!;
    close FILE or die $!;
    utime JTIME, JTIME, $_ or die $!;
}