#!/usr/bin/perl
#***********************************************************************
#
# mdf-report
#
# mimedefang-filter quarantine tool
#
# $Id: mdf-qtools.cgi,v 1.12 2009/01/15 00:31:20 jonas Exp $
#
# This program may be distributed under the terms of the GNU General
# Public License, Version 2, or (at your option) any later version.
#
#***********************************************************************
use strict;
use CGI::Safe;
use CGI::Carp qw(fatalsToBrowser);
use Sys::Hostname;
use HTML::Entities;
use Mail::SpamAssassin;
use Mail::SpamAssassin::Client;
use Email::MessageID;
use MIME::Parser;
use MIME::Words;
use MIME::Entity;
use Date::Format;
use HTML::Sanitizer;
use HTML::Clean;
use Encode;
my $cgi = new CGI;
$cgi->param('parse',1) unless (defined($cgi->param('parse')));
#***********************************************************************
# Config.
#***********************************************************************
my $FilterRevision = '$Revision: 1.12 $';
my %config = (
postconf => '',
spamd => '',
spamreport => '',
);
my %Features;
$Features{'Path:QUARANTINEDIR'} = '/var/spool/MD-Quarantine';
$Features{'Path:CONFDIR'} = '/usr/local/etc/mimedefang';
foreach my $d (('','/filter')) {
next unless (open(CF,'<',sprintf('%s%s/%s',$Features{'Path:CONFDIR'},$d,'qtools.conf')));
while (my $l = <CF>) {
next if ($l =~ /^\s*[#;]/);
next unless ($l =~ /^\s*(\S+)[\s:=]+\s*(.*?)[\s\r\n]*$/);
my $cn = lc($1);
my $cv = $2;
$cn =~ s/[^a-z0-9]//g;
$config{$cn} = $cv;
}
close(CF);
}
#***********************************************************************
# Code.
#***********************************************************************
my @debugs = ();
sub finish_page {
if (@debugs) {
my @xl = ();
foreach my $dbg (@debugs) {
push @xl, $cgi->TR({class=>$#xl%2?'odd':'even'},$cgi->td({class=>'debug'},$dbg));
}
print $cgi->h2('Debug'),$cgi->table(@xl);
}
print $cgi->end_html;
}
sub dbgp {
push @debugs, $cgi->span(join($cgi->br,@_)) if (@_);
}
sub read_file {
my ($qdir,$file,$inch,$mlc) = @_;
$qdir =~ s/^\/+//;
$qdir =~ s/\/+$//;
$mlc = -1 unless (defined($mlc));
return () unless (open(F,'<',sprintf('%s/%s/%s',$Features{'Path:QUARANTINEDIR'},$qdir,$file)));
my @cnt = ();
my $ih = 1;
while (my $l = <F>) {
last unless ($mlc);
$l =~ s/[\r\n]+//gs;
$ih = 0 if ($l eq '');
$l =~ s/[\x00-\x08\x0A-\x19]+//gs if ($ih);
push @cnt, $inch ? "$l\n" : $l;
$mlc --;
}
close(F);
return @cnt;
}
sub read_line {
my ($qdir,$file,$inch) = @_;
my @cnt = read_file($qdir,$file,$inch,1);
return @cnt ? $cnt[0] : '';
}
sub read_values {
my ($qdir,$file,$value,$inch) = @_;
my @cnt = read_file($qdir,$file,$inch);
return () unless (@cnt);
my @val = ();
my $tv = 0;
foreach my $l (@cnt) {
last if ($l =~ /^[\r\n]*$/);
if ($l =~ /^(?:$value:\s*)(.*)$/si) {
$tv = 1;
push @val, $inch ? $l : $1;
} elsif ($tv) {
$tv = 0 unless ($l =~ /^\s/);
push @val, $l if ($tv);
}
}
return @val;
}
sub read_message {
my ($qdir,$intr) = @_;
my @eml = read_file($qdir,'ENTIRE_MESSAGE',1);
@eml = read_file($qdir,'INPUTMSG',1) unless (@eml);
return () unless (@eml);
my @xl;
unless ($intr) {
@xl = read_file($qdir,'RECIPIENTS');
unshift @eml, sprintf("Apparently-To: %s\n",join(", ",@xl)) if (@xl);
}
unshift @eml, read_values($qdir,'RELAY','Received',1);
unless ($intr) {
@xl = read_line($qdir,'SENDER');
unshift @eml, sprintf("Return-Path: %s\n",$xl[0]) if (@xl);
}
return @eml;
}
sub read_info_order {
my $qdir = shift;
my $files = shift;
my %info = ();
my %order = ();
my $cl = 0;
foreach my $file (split(/\+/,$files)) {
my @cnt = read_file($qdir,$file,@_);
my $h = '';
foreach my $l (@cnt) {
last if ($l =~ /^[\r\n]*$/);
$cl ++;
if ($l =~ /^(\S.*?):\s*(.*)$/) {
$h = $1;
$l = $2;
} elsif ($l =~ /^(\S+)\s+(.*)$/) {
$h = $1;
$l = $2;
} elsif ($h ne '' && $l =~ /^\s+(.*)$/) {
$l = $2;
} else {
next;
}
if ($l ne '') {
$order{$h} = $cl unless ($order{$h});
$info{$h} = [] unless ($info{$h});
push @{$info{$h}}, $l if ($l ne '');
}
}
}
return (\%info,\%order);
}
sub read_info {
my ($info,$order) = read_info_order(@_);
return %{$info};
}
sub read_notes {
my $qdir = shift;
my @notes = ();
if (opendir(D,sprintf('%s/%s',$Features{'Path:QUARANTINEDIR'},$qdir))) {
my @msgs = ();
while (my $f = readdir(D)) {
next unless ($f =~ /^MSG\.(\d+)$/);
push @msgs, $1;
}
closedir(D);
foreach my $msg (sort { $a <=> $b } @msgs) {
my @nl = read_file($qdir,"MSG.$msg",@_);
push @notes, \@nl if (@nl);
}
}
return @notes;
}
sub send_mail_message {
my $qdir = shift;
my $sndr = shift;
$sndr = '<>' unless ($sndr);
return 0 unless (@_);
my @eml = read_message($qdir,1);
return 0 unless (@eml);
my $cmd = '|/usr/sbin/sendmail -odd ';
$cmd .= "-f '$sndr' " if ($sndr);
$cmd .= "'".join("' '",@_)."'";
return 0 unless (open(F,$cmd));
print F @eml;
close(F);
return 1;
}
sub send_mail_message_attached {
my $qdir = shift;
my $sndr = shift;
$sndr = '<>' unless ($sndr);
return 0 unless (@_);
my @eml = read_message($qdir,1);
return 0 unless (@eml);
my $from = getpwuid($>);
$from = getpwuid($<) unless ($from);
$from = 'nobody' unless ($from);
$from .= '@'.hostname();
my $msg = MIME::Entity->build(
To => join(',',@_),
From => $from,
Type => 'multipart/mixed',
Date => time2str('%a, %d %b %Y %T %z',time()),
Subject => 'message attached',
Message_ID => Email::MessageID->new->format,
Description => 'spam report',
);
$msg->attach(
Type => 'text/plain',
Disposition => 'inline',
Description => 'notice',
Data => 'Spam message is attached to this message.',
);
$msg->attach(
Type => 'message/rfc822',
Disposition => 'attachment',
Description => 'spam message',
Data => \@eml,
);
my $cmd = '|/usr/sbin/sendmail -odd ';
$cmd .= "-f '$sndr' " if ($sndr);
$cmd .= "'".join("' '",@_)."'";
return 0 unless (open(F,$cmd));
print F $msg->as_string;
close(F);
return 1;
}
sub qdirdisp {
my ($qdir) = @_;
$qdir =~ s/^qdir-//i;
$qdir =~ s/^(\d+-\d+-\d+)-/$1 /;
$qdir =~ s/(\d+)\./$1:/g;
$qdir =~ s/-(\d{3,10})$/sprintf(' %u',$1)/e;
return $qdir;
}
sub decode_header {
my $r = join('',@_);
if ($r =~ /=\?(\S+)\?[QBqb]\?.*\?=/) {
my $x = $r; $r = '';
while ($x =~ /^(.*?)(=\?[^\?]*\?[QqBb]\?)(.*?)(\?=)(.*)$/) {
$r .= "$1$2";
my $d = $3; my $e = $4;
$x = $5;
$d =~ s/\?/=3F/gs;
$r .= "$d$e";
}
$r .= $x;
my @vl = MIME::Words::decode_mimewords($r);
if (@vl) {
$r = '';
foreach my $v (@vl) {
if ($v->[1]) {
$v->[1] =~ s/^unicode-\d-\d-(utf-\d)$/$1/;
my $dd;
eval { $dd = decode($v->[1],$v->[0]); };
unless (defined($dd)) {
eval { $dd = decode('iso-8859-1',$v->[0]); };
unless (defined($dd)) {
$dd = $v->[0];
$dd =~ s/=\?\S+\?[QBqb]\?//gs;
$dd =~ s/\?=//gs;
$dd =~ s/=[A-Fa-f0-9][A-Fa-f0-9]/?/gs;
}
}
$r .= $dd;
} else {
$r .= $v->[0];
}
}
}
}
$r =~ s/[\s\r\n\t]+/ /gs;
$r =~ s/^\s+//;
$r =~ s/\s+$//;
return $r;
}
sub get_msg_body {
my ($msg,$ndc) = @_;
my $cs;
unless ($ndc) {
$cs = $msg->head->mime_attr('content-type.charset') if ($msg->head);
$cs = 'ISO-8859-1' unless ($cs);
}
my $io = $msg->open('r');
return undef unless ($io);
my @txt = ();
while (my $l = $io->getline) {
$l =~ s/[\r\n]+//s;
$l = decode($cs,$l) if ($cs);
push @txt, "$l\n";
}
$io->close;
return join('',@txt);
}
sub entitize {
return encode_entities(join('',@_),'^\r\n\t\x20\x21\x23-\x3B\x3D\x3F-\x7E');
}
sub dentitize {
my $txts = join('',@_);
my $ents = '';
while ($txts =~ /^(.*?)(\&[a-zA-Z0-9]+;)(.*)$/s) {
$ents .= entitize($1).$2;
$txts = $3;
}
$ents .= entitize($txts);
return $ents;
}
sub entitize_html {
my $cs = shift;
my $page = join("\n",@_);
my $ents = '';
while ($page =~ /^([^<]*)(<[^>]*>)(.*)$/s) {
$ents .= dentitize($1);
$ents .= $2;
$page = $3;
}
$ents .= dentitize($page);
$ents =~ s/\&\#x([A-Fa-f0-9]*);/entitize(decode($cs,chr(hex($1))))/gse;
$ents =~ s/\&\#(\d*);/entitize(decode($cs,chr($1)))/gse;
return $ents;
}
sub raise_tag {
my ($t,$n,$a) = @_;
$n += $a;
return "<$t$n>";
}
sub close_tags {
my $code = $_[0];
for (my $p=1; $p<@_; $p++) {
my $tag = $_[$p];
$code .= "</$tag>" if ($code =~ /<$tag(\s+[^>]*)?>.*(<\/$tag>){0}/i);
}
return $code;
}
sub clean_html {
my $sanitize = new HTML::Sanitizer (
em => 1,
strong => 1,
div => 1,
u => 1,
b => 1,
i => 1,
p => 1,
br => 1,
ol => 1,
ul => 1,
dl => 1,
li => 1,
tt => 1,
a => 1,
table => 1,
tr => 1,
td => 1,
th => 1,
h1 => 1,
h2 => 1,
h3 => 1,
h4 => 1,
h5 => 1,
h6 => 1,
h7 => 1,
h8 => 1,
h9 => 1,
blockquote => { cite => 1 },
_ => {
href => qr/^(?:http|ftp|mailto|sip):/i,
title => 1,
alt => 1,
align => 1,
valign => 1,
border => 1,
'*' => 0,
},
img => {
alt => 1,
src => sub {$_='/removed_image.png';},
'*' => 0,
},
'*' => 0, # everything else is 'ignored'
script => undef, # except these, which are stripped along with children
style => undef,
head => undef,
);
my $html = $sanitize->filter_html_fragment(join("\n",@_));
$html =~ s/&([a-z]+|#\d+|#x[a-fA-F0-9]+);/&$1;/ig;
$html =~ s/<(\/?h)([0-7])>/raise_tag($1,$2,2)/ges;
my $cleaner = new HTML::Clean(\$html,9);
return $html unless ($cleaner);
$cleaner->strip({
whitespace => 1,
shortertags => 1,
blink => 1,
contenttype => 1,
comments => 1,
entities => 0,
dequote => 1,
defcolor => 1,
htmldefaults => 1,
lowercasetags => 1,
emptytags => 'a b u i em table li ol ul dl strong tt blockquote cite div p',
});
if (my $ref=$cleaner->data()) {
$html = $$ref;
}
$html = close_tags($html,'em','strong','u','b','i','p','ol','div','ul','dl','tt','a','table','tr','td','blockquote');
return $html;
}
sub get_msg_text {
my ($msg,$indent,$depth) = @_;
$depth = 0 unless ($depth);
my $et = lc($msg->effective_type);
my @txt;
unless ($msg->is_multipart) {
my $txt;
if ($et eq 'text/html') {
$txt = clean_html(get_msg_body($msg));
} elsif ($et =~ /^text\/(?:plain|flowed)$/) {
$txt = encode_entities(get_msg_body($msg));
my $ctf;
$txt =~ s/ \n/ /gs if ($et =~ /flowed/ || ($msg->head && ($ctf = $msg->head->mime_attr('content-type.format')) && $ctf =~ /format/i));
$txt =~ s/\n/$cgi->br/gse;
} elsif ($et =~ /^text\//) {
$txt = $cgi->pre(encode_entities(get_msg_body($msg)));
}
push @txt, $cgi->p({style=>'font-family:serif;font-size:150%;font-weight:bold;'},$et);
push @txt, $cgi->div($txt) if (defined($txt));
return $cgi->div({class=>($depth+1)%2?'odd':'even',style=>'margin-left:1em'},@txt);
}
push @txt, $cgi->p({style=>'font-family:serif;font-size:150%;font-weight:bold;'},$et);
foreach my $prt ($msg->parts) {
push @txt, get_msg_text($prt,1,$depth+1);
}
return $cgi->div({class=>($depth+1)%2?'odd':'even',style=>$indent?'margin-left:1em;':''},@txt);
}
#***********************************************************************
# Actions.
#***********************************************************************
sub list_quarantine {
my @dirs = ();
if (opendir(D,$Features{'Path:QUARANTINEDIR'})) {
while (my $f = readdir(D)) {
next unless ($f =~ /^qdir-/);
push @dirs, $cgi->a({href=>sprintf('%s/%s',$cgi->url,$f)},qdirdisp($f));
}
closedir(D);
}
@dirs = sort { $b cmp $a } @dirs;
for (my $i=0;$i<@dirs;$i++) { $dirs[$i] = $cgi->li({class=>($i+1)%2?'odd':'even'},$dirs[$i]); }
print $cgi->header,
$cgi->start_html(-title=>'Quarantine',-style=>{src=>'/default.css',code=>'body{font-family:sans-serif;margin-left:0.5em;}'}),
$cgi->h1('Quarantine'),
$cgi->ul(@dirs);
finish_page();
}
sub show_quarantined {
my $qdir = $cgi->path_info;
$qdir =~ s/^\///;
my (@xl,$xh,$xo);
push @xl, $cgi->td(
$cgi->start_form(-method=>'post',-action=>sprintf('%s/%s',$cgi->url,$qdir)),
$cgi->submit('View',$cgi->param('parse')?'Raw':'Parsed'),
$cgi->hidden(-name=>'act',-default=>'',-override=>1),
$cgi->hidden(-name=>'parse',-default=>$cgi->param('parse')?0:1,-override=>1),
$cgi->end_form,
);
push @xl, $cgi->td(
$cgi->start_form(-method=>'post',-action=>sprintf('%s/%s',$cgi->url,$qdir)),
$cgi->submit('Report','Report Spam'),
$cgi->hidden(-name=>'act',-default=>'report',-override=>1),
$cgi->hidden(-name=>'parse',-default=>$cgi->param('parse')?1:0,-override=>1),
$cgi->end_form,
) if ($config{spamreport});
push @xl, $cgi->td(
$cgi->start_form(-method=>'post',-action=>sprintf('%s/%s',$cgi->url,$qdir)),
$cgi->submit('Ham','Learn as Ham'),
$cgi->hidden(-name=>'act',-default=>'ham',-override=>1),
$cgi->hidden(-name=>'parse',-default=>$cgi->param('parse')?1:0,-override=>1),
$cgi->end_form,
);
push @xl, $cgi->td(
$cgi->start_form(-method=>'post',-action=>sprintf('%s/%s',$cgi->url,$qdir)),
$cgi->submit('Resend','Resend'),
$cgi->hidden(-name=>'act',-default=>'resend',-override=>1),
$cgi->hidden(-name=>'parse',-default=>$cgi->param('parse')?1:0,-override=>1),
$cgi->end_form,
);
push @xl, $cgi->td(
$cgi->start_form(-method=>'post',-action=>sprintf('%s/%s',$cgi->url,$qdir)),
$cgi->submit('SendTo','Send to:'),
$cgi->hidden(-name=>'act',-default=>'input',-override=>1),
$cgi->hidden(-name=>'parse',-default=>$cgi->param('parse')?1:0,-override=>1),
$cgi->textfield('Recipient','',30,127),
$cgi->end_form,
);
print $cgi->header,
$cgi->start_html(-title=>qdirdisp($qdir),-style=>{src=>'/default.css',code=>'body{font-family:sans-serif;margin-left:0.5em;}'}),
$cgi->h1(qdirdisp($qdir)),@_,
$cgi->table($cgi->TR(@xl));
@xl = read_notes($qdir);
if (@xl) {
print $cgi->h2('Notes');
for (my $i=0;$i<@xl;$i++) {
print $cgi->p({class=>($i+1)%2?'odd':'even'},join($cgi->br,map { encode_entities($_) } @{$xl[$i]}));
}
}
@xl = ();
foreach my $f ('Sender','Recipients','Sendmail-QID') {
my @vl = read_file($qdir,uc($f));
next unless (@vl);
push @xl, $cgi->TR({class=>$#xl%2?'odd':'even'},$cgi->td({nowrap=>1},"$f:"),$cgi->td(join($cgi->br,map { encode_entities($_) } @vl)));
}
($xh,$xo) = read_info_order($qdir,'RELAY');
foreach my $k (sort { $xo->{$a} <=> $xo->{$b} } keys %{$xh}) {
push @xl, $cgi->TR({class=>$#xl%2?'odd':'even'},$cgi->td({nowrap=>1},"Relay $k:"),$cgi->td(join($cgi->br,map { encode_entities($_) } @{$xh->{$k}}))) unless ($k eq 'Received');
}
if (@xl) {
print $cgi->h2('Info'),
$cgi->table(@xl);
}
@xl = ();
($xh,$xo) = read_info_order($qdir,'SPAM_REPORT');
foreach my $k (sort { $xo->{$a} <=> $xo->{$b} } keys %{$xh}) {
push @xl, $cgi->TR({class=>$#xl%2?'odd':'even'},$cgi->td({nowrap=>1},"$k:"),$cgi->td(join($cgi->br,map { encode_entities($_) } @{$xh->{$k}})));
}
if (@xl) {
print $cgi->h2('Spam Report'),
$cgi->table(@xl);
}
for (my $fn=0;1;$fn++) {
my $rp = join("\n",read_file($qdir,"HTML_CLEANING_REPORT.$fn"));
last unless ($rp);
my %rpl = ();
while ($rp =~ /^(.*)==========================\n([A-Z][a-z]+)\n--------------------------\n(.*)$/s) {
$rpl{lc($2)} = $3;
$rp = $1;
}
next unless (%rpl);
next unless ($rpl{diff});
print $cgi->h2("HTML Cleaning Diff Report ($fn)"),
$cgi->pre(encode_entities($rpl{diff}));
}
@xl = read_message($qdir);
#dbgp('<pre>'.encode_entities(join('',@xl)).'</pre>');
if (@xl) {
print $cgi->h2('Message');
if ($cgi->param('parse')) {
my $parser = new MIME::Parser;
$parser->extract_nested_messages(0);
$parser->extract_uuencode(1);
$parser->filer->ignore_filename(1);
$parser->filer->output_dir('/tmp');
$parser->filer->output_prefix($qdir);
my $msg = $parser->parse_data(\@xl);
if ($msg) {
if (my $hdr = $msg->head) {
$hdr->cleanup;
my @trl = ();
my $hdrl = $hdr->header;
for (my $i=0;$i<@{$hdrl};$i++) {
my $l = $hdrl->[$i];
$l =~ s/[\r\n]+//gs;
if ($l =~ /^(\S+[:\s])\s*(.*)$/) {
my $hn = encode_entities($1);
my $hv = encode_entities(decode_header($2));
push @trl, $cgi->TR({class=>($i+1)%2?'odd':'even'},$cgi->td({nowrap=>1},$hn),$cgi->td($hv));
} else {
push @trl, $cgi->TR({class=>($i+1)%2?'odd':'even'},$cgi->td({colspan=>2},encode_entities($l)));
}
}
print $cgi->table(@trl);
}
print get_msg_text($msg);
}
$parser->filer->purge;
} else {
print $cgi->pre(encode_entities(join('',@xl)));
}
}
for (my $fn=0;1;$fn++) {
my $rp = join("\n",read_file($qdir,"HTML_CLEANING_REPORT.$fn"));
last unless ($rp);
my %rpl = ();
while ($rp =~ /^(.*)==========================\n([A-Z][a-z]+)\n--------------------------\n(.*)$/s) {
$rpl{lc($2)} = $3;
$rp = $1;
}
next unless (%rpl);
#next if ($rpl{diff});
print $cgi->h2("HTML Cleaning Report ($fn)");
foreach $rp (keys %rpl) {
next if ($rp eq 'diff');
print $cgi->h3(ucfirst($rp)),
$cgi->pre(encode_entities($rpl{$rp}));
}
}
finish_page();
}
sub send_quarantined_to {
my $qdir = $cgi->path_info;
my @rcpts = ();
foreach my $r (@_) {
$r =~ s/^\s+//;
$r =~ s/\s+$//;
push @rcpts, $r if ($r ne '');
}
if (!@rcpts) {
show_quarantined($cgi->p($cgi->i($cgi->b('Error: '),'No recipients')));
} elsif (!send_mail_message($qdir,'',@rcpts)) {
show_quarantined($cgi->p($cgi->i($cgi->b('Error: '),'Mail not sent!')));
} else {
show_quarantined($cgi->p(join($cgi->br,$cgi->i('Mail sent to:'),map { $cgi->b(encode_entities($_)) } @rcpts)));
}
}
sub send_quarantined {
my $rcpt = $cgi->param('Recipient');
$rcpt = '' unless (defined($rcpt));
send_quarantined_to(split(/[,;]/,$rcpt));
}
sub resend_quarantined {
my $qdir = $cgi->path_info;
send_quarantined_to(read_file($qdir,'RECIPIENTS'));
}
sub report_quarantined {
my $qdir = $cgi->path_info;
if (!$config{spamreport}) {
show_quarantined($cgi->p($cgi->i($cgi->b('Error: '),'No report recipient!')));
} elsif (!send_mail_message_attached($qdir,'',$config{spamreport})) {
show_quarantined($cgi->p($cgi->i($cgi->b('Error: '),'Mail not sent!')));
} else {
show_quarantined($cgi->p($cgi->i('Mail reported.')));
}
}
sub learn_quarantined_as {
my ($spam) = @_;
my $qdir = $cgi->path_info;
$qdir =~ s/^\///;
my @msg = read_message($qdir);
return 0 unless (@msg);
my $sa;
if ($config{spamd}) {
my %sap = (username=>'mdf');
unless ($config{spamd} == -1) {
my ($sdh,$sdp,$sdu) = split(/:/,$config{spamd},3);
$sap{socketpath} = $sdh if ($sdh && $sdh =~ /\//);
$sap{host} = $sdh if ($sdh && $sdh !~ /\//);
$sap{port} = $sdp if ($sdp);
$sap{username} = $sdu if ($sdu);
}
$sa = new Mail::SpamAssassin::Client(\%sap);
return 0 unless ($sa && $sa->ping && defined($sa->learn(join('',@msg),$spam?0:1)));
return 1;
}
if ($config{postconf}) {
$sa = Mail::SpamAssassin->new({dont_copy_prefs=>1,post_config_text=>$config{postconf}});
} else {
my $cfg = '/usr/local/etc/mimedefang/spamassassin.cf';
foreach my $cfn (('/usr/local/etc/mimedefang/sa-mimedefang.cf','/usr/local/etc/mimedefang/spamassassin/sa-mimedefang.cf','/usr/local/etc/mimedefang/spamassassin/local.cf')) {
if (-r $cfn) {
$cfg = $cfn;
last;
}
}
$sa = Mail::SpamAssassin->new({dont_copy_prefs=>1,userprefs_filename=>$cfg});
}
$sa->init_learner({caller_will_untie=>1,learn_to_journal=>1});
return 0 unless (defined($sa));
my $msg = $sa->parse(join('',@msg));
return 0 unless ($msg);
my $ok = 0;
my $st = $sa->learn($msg,undef,$spam,0);
if ($st) {
$ok = 1;
$st->finish();
}
$msg->finish();
return $ok;
}
sub learn_quarantined {
my ($spam) = @_;
if (learn_quarantined_as($spam)) {
show_quarantined($cgi->p($cgi->i('Learned:'),$spam?'Spam':'Ham'));
} else {
show_quarantined($cgi->p($cgi->i($cgi->b('Error: '),'Mail not learned!')));
}
}
sub learn_quarantined_ham {
learn_quarantined(0);
}
#***********************************************************************
# Main.
#***********************************************************************
$cgi->path_info(shift @ARGV) if (@ARGV);
if ($cgi->path_info =~ /^\/?$/) {
list_quarantine();
} elsif ($cgi->path_info =~ /^\/?qdir-[-_.a-zA-Z0-9]+$/ && (-d sprintf('%s/%s',$Features{'Path:QUARANTINEDIR'},$cgi->path_info))) {
if (!$cgi->param('act')) {
show_quarantined();
} elsif ($cgi->param('act') eq 'ham') {
learn_quarantined_ham()
} elsif ($cgi->param('act') eq 'resend') {
resend_quarantined()
} elsif ($cgi->param('act') eq 'input') {
send_quarantined()
} elsif ($cgi->param('act') eq 'report') {
report_quarantined()
} else {
show_quarantined();
}
} else {
print $cgi->header('text/html','404 Not found'),
$cgi->start_html(-title=>'404 Not found',-style=>{src=>'/default.css',code=>'body{font-family:sans-serif;margin-left:0.5em;}'}),
$cgi->h1('404 Not found'),$cgi->p(encode_entities($cgi->path_info));
finish_page();
}
(2009-01-28)