#!/usr/bin/perl
use warnings;
use strict;
use POE;
use POE::Component::Server::TCP;
use POE::Component::Server::HTTP;
use HTML::Template;
use MIME::Base64 qw< decode_base64 >;
use Getopt::Long;
my $sport = 25;
my $hport = 8000;
my $banner = "SMTP Server";
my $magic = "test:test";
my $verbose = 0;
my %msgs;
GetOptions(
"smtpport=i" => \$sport,
"httpport=i" => \$hport,
"magic=s" => \$magic,
"banner=s" => \$banner,
"verbose!" => \$verbose,
"help" => \&usage,
) or usage();
POE::Component::Server::TCP->new(
Port => $sport,
ClientConnected => \&c_connected,
ClientInput => \&c_input,
);
POE::Component::Server::HTTP->new(
Port => $hport,
ContentHandler => { "/" => \&h_handler },
);
my %tmpl; my $ptr;
while(local $_ = <DATA>) {
if(/^__(\w+)__$/) {
$ptr = \$tmpl{$1};
} else {
$$ptr .= $_;
}
}
POE::Kernel->run;
exit;
sub usage { print STDERR <<USAGE; exit }
Usage: $0 [options]
Available options are:
--smtpport=25 Sets the SMTP port to listen on.
--httpport=8000 Sets the HTTP port to listen on.
--banner="SMTP Server"
Sets the banner to display upon connection.
--verbose Sets verbosity.
--help Displays this help.
Options may be abbreviated to uniqueness.
USAGE
sub debug($) {
return unless $verbose;
print STDERR shift, "\n";
}
sub c_connected { $_[HEAP]->{client}->put("220 " . $banner) }
sub c_input {
my ($heap, $line) = @_[HEAP, ARG0];
my $client = $heap->{client};
my $in_data = \$heap->{in_data};
my $data = \$heap->{data};
if($$in_data and $line ne ".") {
$line =~ s/^\.//;
$$data .= $line . "\n";
} elsif($$in_data and $line eq ".") {
$client->put("250 Ok.");
debug sprintf "Received new mail from client %s:%d, length %d bytes.",
$_[HEAP]->{remote_ip}, $_[HEAP]->{remote_port},
length $$data;
my $id = time * 100;
$id++ while $msgs{$id};
$msgs{$id} = Email::Simple::SofortMail->new($$data);
$msgs{$id}->setdate_rcvd(time);
$$data = undef; $$in_data = 0;
} else {
my ($cmd) = split /\s/, $line;
my %dispatch = (
HELO => sub { "250 Ok." },
EHLO => sub { "250 Ok." },
MAIL => sub { "250 Ok." },
RCPT => sub { "250 Ok." },
DATA => sub {
$$in_data++;
"354 Enter message, ending with \".\" on a line by itself.";
},
QUIT => sub {
POE::Kernel->yield("shutdown");
"221 Bye.";
},
EROR => sub { "500 Unrecognized command." },
);
my $sub = $dispatch{uc $cmd} || $dispatch{EROR};
$client->put($sub->());
}
}
sub h_handler {
my ($req, $rep) = @_;
if(
$req->header("Authorization") and
decode_base64(($req->header("Authorization") =~ /^Basic (.+)$/i)[0]) eq $magic
) {
if($req->uri->path eq "/") {
return h_list($req, $rep);
} elsif($req->uri->path =~ /^\/(\d+)\/html$/) {
return h_msg_html($req, $rep, $1);
} elsif($req->uri->path =~ /^\/(\d+)\/source$/) {
return h_msg_src($req, $rep, $1);
} elsif($req->uri->path =~ /^\/(\d+)\/delete$/) {
return h_msg_del($req, $rep, $1);
} elsif($req->uri->path eq "/style.css") {
return h_style($req, $rep);
} else {
return h_error($req, $rep);
}
} else {
return h_unauth($req, $rep);
}
}
sub h_list {
my ($req, $rep) = @_;
local $_;
my $tmpl = HTML::Template->new(
scalarref => \$tmpl{LIST},
die_on_bad_params => 0,
);
$tmpl->param(messages => [ map {{
%{ $msgs{$_}->as_tmpl },
mid => $_
}} sort { $b <=> $a } keys %msgs ]);
$rep->code(200);
$rep->content($tmpl->output);
}
sub h_msg_html {
my ($req, $rep, $mid) = @_;
return h_error($req, $rep) unless $mid >= 0 and $msgs{$mid};
my $tmpl = HTML::Template->new(
scalarref => \$tmpl{MESSAGE},
die_on_bad_params => 0,
);
$tmpl->param(%{ $msgs{$mid}->as_tmpl }, mid => $mid);
$rep->code(200);
$rep->content($tmpl->output);
}
sub h_msg_src {
my ($req, $rep, $mid) = @_;
return h_error($req, $rep) unless $mid >= 0 and $msgs{$mid};
$rep->code(200);
$rep->header("Content-Type" => "message/rfc822");
my $str = $msgs{$mid}->as_string;
$str =~ s/\012/\015\012/g;
$rep->content($str);
}
sub h_msg_del {
my ($req, $rep, $mid) = @_;
return h_error($req, $rep) unless $mid >= 0 and $msgs{$mid};
delete $msgs{$mid};
$rep->code(200);
$rep->content($tmpl{DELETED});
}
sub h_style {
my ($req, $rep) = @_;
$rep->code(200);
$rep->header("Content-Type" => "text/css");
$rep->content($tmpl{STYLE});
}
sub h_error {
my ($req, $rep) = @_;
$rep->code(500);
$rep->content($tmpl{ERROR});
}
sub h_unauth {
my ($req, $rep) = @_;
$rep->code(401);
$rep->header("WWW-Authenticate" => 'Basic realm="sofortmaild"');
$rep->content($tmpl{UNAUTH});
}
{
package Email::Simple::SofortMail;
use POSIX "strftime";
use base "Email::Simple";
sub setdate_rcvd { $_[0]->{date_rcvd} = $_[1] }
sub date_rcvd { $_[0]->{date_rcvd} }
sub as_tmpl {{
from => $_[0]->header("From"),
to => $_[0]->header("To"),
subject => $_[0]->header("Subject"),
date => $_[0]->header("Date"),
date_rcvd => strftime("%c", localtime $_[0]->date_rcvd),
source => $_[0]->as_string,
}}
}
__DATA__
__ERROR__
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
<head>
<title>Error</title>
<link rel="stylesheet" href="/style.css">
</head>
<body>
<h1>Error</h1>
<div class="content">
An error occured. <a href="/">Go back to the message overview.</a>
</div>
<div class="footer">Perl-powered sofort-maild</div>
</body>
</html>
__UNAUTH__
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
<head>
<title>401 Unauthorized</title>
<link rel="stylesheet" href="/style.css">
</head>
<body>
<h1>401 Unauthorized</h1>
<div class="content">
You have to authorize to use this service.
</div>
<div class="footer">Perl-powered sofort-maild</div>
</body>
</html>
__LIST__
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
<html>
<head>
<title>Message overview</title>
<link rel="stylesheet" href="/style.css">
</head>
<body>
<h1>Message overview</h1>
<div class="content">
<table>
<tr>
<th>From</th>
<th>To</th>
<th>Subject</th>
<th>Date</th>
<th>Link</th>
</tr>
<TMPL_LOOP name=messages>
<tr>
<td><TMPL_VAR NAME="from" ESCAPE="HTML"></td>
<td><TMPL_VAR NAME="to" ESCAPE="HTML"></td>
<td><TMPL_VAR NAME="subject" ESCAPE="HTML"></td>
<td><TMPL_VAR NAME="date" ESCAPE="HTML"></td>
<td>
<a href="/<TMPL_VAR NAME="mid">/html">.html</a>
<a href="/<TMPL_VAR NAME="mid">/source">.src</a>
<a href="/<TMPL_VAR NAME="mid">/delete">.del</a>
</td>
</tr>
</TMPL_LOOP>
</table>
</div>
<div class="footer">Perl-powered sofort-maild</div>
</body>
</html>
__MESSAGE__
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
<html>
<head>
<title>Message "<TMPL_VAR NAME="subject" ESCAPE="HTML">"</title>
<link rel="stylesheet" href="/style.css">
</head>
<body>
<h1>
Message display
<a href="/<TMPL_VAR NAME="mid" ESCAPE="HTML">/source">.src</a>
<a href="/<TMPL_VAR NAME="mid" ESCAPE="HTML">/delete">.del</a>
<a href="/">.back</a>
</h1>
<div class="content">
<table>
<tr>
<th>From</th>
<td><TMPL_VAR NAME="from" ESCAPE="HTML"></td>
</tr>
<tr>
<th>To</th>
<td><TMPL_VAR NAME="to" ESCAPE="HTML"></td>
</tr>
<tr>
<th>Subject</th>
<td><TMPL_VAR NAME="subject" ESCAPE="HTML"></td>
</tr>
<tr>
<th>Date</th>
<td><TMPL_VAR NAME="date" ESCAPE="HTML"></td>
</tr>
<tr>
<th>Date of reception</th>
<td><TMPL_VAR NAME="date_rcvd" ESCAPE="HTML"></td>
</tr>
</table>
<pre><TMPL_VAR NAME="source" ESCAPE="HTML"></pre>
</div>
<div class="footer">Perl-powered sofort-maild</div>
</body>
</html>
__DELETED__
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
<head>
<title>Message deleted</title>
<link rel="stylesheet" href="/style.css">
</head>
<body>
<h1>Message deleted</h1>
<div class="content">
The message was deleted. <a href="/">Go back to the message overview.</a>
</div>
<div class="footer">Perl-powered sofort-maild</div>
</body>
</html>
__STYLE__
body { font-family: sans-serif; margin: 0; }
h1, .content, .footer { padding: 5px; }
h1 {
margin: 0;
margin-bottom: 5px;
border-bottom: 1px solid black;
text-align: left;
color: white;
background-color: #aaa;
}
div.footer {
margin: 0;
margin-top: 5px;
border-top: 1px solid black;
text-align: left;
color: white;
background-color: #aaa;
}
table { width: 100%; }
th { text-align: left; background-color: #eee; }
a { text-decoration: none; }
a:hover { text-decoration: underline; }
Download