#!/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/&amp;([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();
}