#!/usr/bin/perl -T use warnings; use strict; use CGI::Fast; use HTTP::Date; use DBI; use POSIX qw(strftime); use Encode qw(encode); while(my $q = CGI::Fast->new()) { if ($q->param('fn')) { my $filename = $q->param('fn'); print STDERR "filename=$filename\n"; if ($filename =~ m{^\d{4}/\d\d/\d\d/[0-9a-f]{40}$}) { if (open(my $fh, '<', "/var/lib/mail-archive/$filename")) { print "Content-Type: message/rfc-822\r\n"; print "Content-Disposition: attachment; filename=$filename.eml\r\n"; print "\r\n"; while (<$fh>) { chomp; print "$_\r\n"; } } else { print "Status: 404\n"; print "Content-Type: text/html\n"; print "\n"; print "This message doesn't exist.\n"; } } else { print "Status: 404\n"; print "Content-Type: text/html\n"; print "\n"; print "This message cannot exist.\n"; } } else { print "Content-Type: text/html; charset=utf-8\n"; print "\n"; # process arguments my $start; if ($q->param('start')) { $start = str2time($q->param('start')); } else { $start = time - 86400; $q->param('start', strftime("%Y-%m-%d %H:%M:%S", localtime($start))); } my $end; if ($q->param('end')) { $end = str2time($q->param('end')); } else { $end = time - 0; $q->param('end', strftime("%Y-%m-%d %H:%M:%S", localtime($end))); } my $mailfrom = $q->param('sender') || '%'; my $subject = $q->param('subject') || '%'; # output print_header(); print_form($q); my $dbh = DBI->connect("dbi:SQLite:dbname=/var/lib/mail-archive/index", '', ''); $dbh->{unicode} = 1; my $result; if ($q->param('recipient')) { $result = $dbh->selectall_arrayref( "select distinct id, date, mailfrom, subject, message_id, filename from messages, recipients where messages.id = recipients.message and date >= ? and date <= ? and mailfrom like ? and subject like ? and rcptto like ? order by id ", { Slice => {} }, $start, $end, $mailfrom, $subject, $q->param('recipient') ); } else { $result = $dbh->selectall_arrayref( "select id, date, mailfrom, subject, message_id, filename from messages where date >= ? and date <= ? and mailfrom like ? and subject like ? order by id ", { Slice => {} }, $start, $end, $mailfrom, $subject, ); } if ($q->param('size')) { my $size = $q->param('size'); if ($q->param('size_op') eq '>') { $result = [ grep { -s $_->{filename} > $size } @$result ]; } else { $result = [ grep { -s $_->{filename} < $size } @$result ]; } print_result($q, $dbh, $result); print_footer(); } } sub print_header { print < Mail Archive

Mail Archive

EOT } sub print_form { my ($q) = @_; print " " x 2, "

\n"; print " " x 3, "\n"; print " " x 4, "\n"; print " " x 5, "\n"; print " " x 5, "\n"; print " " x 5, "\n"; print " " x 5, "\n"; print " " x 4, "\n"; print " " x 4, "\n"; print " " x 5, "\n"; print " " x 5, "\n"; print " " x 5, "\n"; print " " x 5, "\n"; print " " x 4, "\n"; print " " x 4, "\n"; print " " x 5, "\n"; print " " x 5, "\n"; print " " x 5, "\n"; print " " x 5, "\n"; print " " x 5, "\n"; print " " x 4, "\n"; print " " x 3, "

Start:	\n"; print " " x 6, "\n"; print " " x 5, "	End:	\n"; print " " x 6, "\n"; print " " x 5, "
Sender:	\n"; print " " x 6, "\n"; print " " x 5, "	Recipient:	\n"; print " " x 6, "\n"; print " " x 5, "
Subject:	\n"; print " " x 6, "\n"; print " " x 5, "	Size:	\n"; print " " x 6, "\n"; print " " x 6, "\n"; print " " x 5, "	\n"; print " " x 6, "\n"; print " " x 5, "

\n"; print " " x 2, "

\n"; } sub print_result { my ($q, $dbh, $result) = @_; print " " x 2, "\n"; my $row = 0; for my $r (@$result) { my $evenodd = ++$row % 2 ? "odd" : "even"; print " " x 3, "\n"; print " " x 4, "\n"; print " " x 4, "\n"; print " " x 4, "\n"; print " " x 4, "\n"; print " " x 4, "\n"; #print STDERR join(",", map sprintf("%x", ord($_)), split(//, $r->{subject})), "\n"; print " " x 4, "\n"; print " " x 4, "\n"; print " " x 4, "\n"; print " " x 3, "\n"; } print " " x 2, "

", $q->escapeHTML($row), "

", $q->escapeHTML($r->{id}), "

", $q->escapeHTML(strftime("%Y-%m-%d %H:%M:%S%z", localtime($r->{date}))), "

", format_address($q, $r->{mailfrom}), "

\n"; my $rcpts = $dbh->selectcol_arrayref("select rcptto from recipients where message=?", {}, $r->{id} ); print $q->escapeHTML(join ", ", @$rcpts); print " " x 4, "

", encode('UTF-8', $q->escapeHTML($r->{subject})), "

", format_filename($q, $r->{filename}), "

", format_number($q, -s $r->{filename}), "

\n"; } sub print_footer { print < EOT } sub format_address { my ($q, $addr) = @_; my $tooltip; if (length($addr) > 32) { $tooltip = $addr; my ($local, $domain) = $addr =~ /(.*)@(.*)/; for ($local, $domain) { if (length($_) > 16) { $_ = substr($_, 0, 16) . "\x{2026}"; } } $addr = "$local\@$domain"; } if ($tooltip) { return "" . $q->escapeHTML($addr) . ""; } else { return $q->escapeHTML($addr); } } sub format_filename { my ($q, $filename) = @_; $filename =~ s{/var/lib/mail-archive/}{}; (my $basename = $filename) =~ s{.*/}{}; return "" . $q->escapeHTML($basename) . ""; } sub format_number { my ($q, $number) = @_; 1 while ($number =~ s/(\d+)(\d{3})/$1\x{A0}$2/); return encode('UTF-8', $number); } # vim: tw=0