separate out SMTP testing into its own module
This commit is contained in:
Graham Knop
parent
8c2c2f0a8d
commit
bc5df47fed
4 changed files with 242 additions and 290 deletions
237
t/Mail/Send.t
237
t/Mail/Send.t
|
|
@ -17,17 +17,15 @@ use lib "$FindBin::Bin/../lib";
|
|||
use JSON qw( from_json to_json );
|
||||
use Test::More;
|
||||
use Test::Deep;
|
||||
use Data::Dumper;
|
||||
use MIME::Parser;
|
||||
use Encode qw/decode encode/;
|
||||
use Try::Tiny;
|
||||
|
||||
use WebGUI::Test;
|
||||
use WebGUI::Paths;
|
||||
|
||||
use WebGUI::Mail::Send;
|
||||
|
||||
$| = 1;
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
# Init
|
||||
my $session = WebGUI::Test->session;
|
||||
|
|
@ -35,11 +33,6 @@ my $session = WebGUI::Test->session;
|
|||
my $mail; # The WebGUI::Mail::Send object
|
||||
my $mime; # for getMimeEntity
|
||||
|
||||
# See if we have an SMTP server to use
|
||||
my $hasServer = 0;
|
||||
eval { WebGUI::Test->prepareMailServer; $hasServer = 1 };
|
||||
if ( $@ ) { diag( "Can't prepare mail server: $@" ) }
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
# Tests
|
||||
|
||||
|
|
@ -127,139 +120,119 @@ my $dbMail = WebGUI::Mail::Send->retrieve($session, $messageId);
|
|||
is($dbMail->getMimeEntity->head->get('List-ID'), "=?UTF-8?Q?H=C3=84ufige=20Fragen?=\n", 'addHeaderField: handles utf-8 correctly');
|
||||
|
||||
# TODO: Test that addHtml creates a body with the right content type
|
||||
my $smtpServerOk = 0;
|
||||
|
||||
my $smtpServerOk;
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
# Test emailOverride
|
||||
SKIP: {
|
||||
my $numtests = 2; # Number of tests in this block
|
||||
|
||||
# Must be able to write the config, or we'll die
|
||||
if ( !-w File::Spec->catfile( WebGUI::Paths->configBase, WebGUI::Test->file ) ) {
|
||||
skip "Cannot test emailOverride: Can't write new configuration value", $numtests;
|
||||
try {
|
||||
require WebGUI::Test::MailServer;
|
||||
$smtpServerOk = 1;
|
||||
}
|
||||
catch {
|
||||
skip "Cannot run live SMTP tests: $_", 6;
|
||||
};
|
||||
|
||||
# Must have an SMTP server, or it's pointless
|
||||
if ( !$hasServer ) {
|
||||
skip "Cannot test emailOverride: Module Net::SMTP::Server not loaded!", $numtests;
|
||||
}
|
||||
WebGUI::Test::MailServer::test_smtp($session, sub {
|
||||
my $cb = shift;
|
||||
|
||||
sleep 1;
|
||||
$smtpServerOk = 1;
|
||||
# Override the emailOverride
|
||||
$session->config->set( 'emailOverride', 'dufresne@localhost' );
|
||||
|
||||
# Override the emailOverride
|
||||
my $oldEmailOverride = $session->config->get('emailOverride');
|
||||
$session->config->set( 'emailOverride', 'dufresne@localhost' );
|
||||
# Send the mail
|
||||
my $mail
|
||||
= WebGUI::Mail::Send->create( $session, {
|
||||
to => 'norton@localhost',
|
||||
} );
|
||||
$mail->addText( 'His judgement cometh and that right soon.' );
|
||||
|
||||
# Send the mail
|
||||
my $mail
|
||||
= WebGUI::Mail::Send->create( $session, {
|
||||
to => 'norton@localhost',
|
||||
} );
|
||||
$mail->addText( 'His judgement cometh and that right soon.' );
|
||||
$mail->send;
|
||||
my $received = $cb->();
|
||||
|
||||
$mail->send;
|
||||
my $received = WebGUI::Test->getMail;
|
||||
# Test the mail
|
||||
like( $received->{to}->[0], qr/dufresne\@localhost/,
|
||||
"Email TO: address is overridden",
|
||||
);
|
||||
|
||||
if (!$received) {
|
||||
skip "Cannot test emailOverride: No response received from smtpd", $numtests;
|
||||
}
|
||||
my $parser = MIME::Parser->new();
|
||||
$parser->output_to_core(1);
|
||||
my $parsed_message = $parser->parse_data($received->{contents});
|
||||
my $head = $parsed_message->head;
|
||||
my $messageId = decode('MIME-Header', $head->get('Message-Id'));
|
||||
like ($messageId, qr/^<WebGUI-([a-zA-Z0-9\-_]){22}@\w+\.\w{2,4}>$/, 'Message-Id is valid');
|
||||
|
||||
# Test the mail
|
||||
like( $received->{to}->[0], qr/dufresne\@localhost/,
|
||||
"Email TO: address is overridden",
|
||||
);
|
||||
$session->config->delete( 'emailOverride' );
|
||||
|
||||
my $parser = MIME::Parser->new();
|
||||
$parser->output_to_core(1);
|
||||
my $parsed_message = $parser->parse_data($received->{contents});
|
||||
my $head = $parsed_message->head;
|
||||
my $messageId = decode('MIME-Header', $head->get('Message-Id'));
|
||||
like ($messageId, qr/^<WebGUI-([a-zA-Z0-9\-_]){22}@\w+\.\w{2,4}>$/, 'Message-Id is valid');
|
||||
# Send the mail
|
||||
$mail
|
||||
= WebGUI::Mail::Send->create( $session, {
|
||||
to => 'norton@localhost',
|
||||
} );
|
||||
$mail->addText( "I understand you're a man who knows how to get things." );
|
||||
|
||||
# Restore the emailOverride
|
||||
$session->config->set( 'emailOverride', $oldEmailOverride );
|
||||
}
|
||||
$mail->send;
|
||||
$received = $cb->();
|
||||
|
||||
SKIP: {
|
||||
my $numtests = 4; # Number of tests in this block
|
||||
# Test the mail
|
||||
my $parsed_message = $received->{parsed};
|
||||
my $head = $parsed_message->head;
|
||||
my $messageId = decode('MIME-Header', $head->get('Message-Id'));
|
||||
chomp $messageId;
|
||||
like ($messageId, qr/^<WebGUI-([a-zA-Z0-9\-_]){22}@\w+\.\w{2,4}>$/, 'generated Message-Id is valid');
|
||||
|
||||
skip "Cannot test message ids", $numtests unless $smtpServerOk;
|
||||
# Send the mail
|
||||
$mail
|
||||
= WebGUI::Mail::Send->create( $session, {
|
||||
to => 'norton@localhost',
|
||||
messageId => '<leadingAngleOnly@localhost.localdomain',
|
||||
} );
|
||||
$mail->addText( "What say you there, fuzzy-britches? Feel like talking?" );
|
||||
|
||||
# Send the mail
|
||||
my $mail
|
||||
= WebGUI::Mail::Send->create( $session, {
|
||||
to => 'norton@localhost',
|
||||
} );
|
||||
$mail->addText( "I understand you're a man who knows how to get things." );
|
||||
$mail->send;
|
||||
$received = $cb->();
|
||||
|
||||
$mail->send;
|
||||
my $received = WebGUI::Test->getMail;
|
||||
$parsed_message = $received->{parsed};
|
||||
$head = $parsed_message->head;
|
||||
$messageId = decode('MIME-Header', $head->get('Message-Id'));
|
||||
chomp $messageId;
|
||||
is($messageId, '<leadingAngleOnly@localhost.localdomain>', 'bad messageId corrected (added ending angle)');
|
||||
|
||||
if (!$received) {
|
||||
skip "Cannot test messageIds: No response received from smtpd", $numtests;
|
||||
}
|
||||
# Send the mail
|
||||
$mail
|
||||
= WebGUI::Mail::Send->create( $session, {
|
||||
to => 'norton@localhost',
|
||||
messageId => 'endingAngleOnly@localhost.localdomain>',
|
||||
} );
|
||||
$mail->addText( "Dear Warden, You were right. Salvation lies within." );
|
||||
|
||||
# Test the mail
|
||||
my $parser = MIME::Parser->new();
|
||||
$parser->output_to_core(1);
|
||||
my $parsed_message = $parser->parse_data($received->{contents});
|
||||
my $head = $parsed_message->head;
|
||||
my $messageId = decode('MIME-Header', $head->get('Message-Id'));
|
||||
chomp $messageId;
|
||||
like ($messageId, qr/^<WebGUI-([a-zA-Z0-9\-_]){22}@\w+\.\w{2,4}>$/, 'generated Message-Id is valid');
|
||||
$mail->send;
|
||||
$received = $cb->();
|
||||
|
||||
# Send the mail
|
||||
$mail
|
||||
= WebGUI::Mail::Send->create( $session, {
|
||||
to => 'norton@localhost',
|
||||
messageId => '<leadingAngleOnly@localhost.localdomain',
|
||||
} );
|
||||
$mail->addText( "What say you there, fuzzy-britches? Feel like talking?" );
|
||||
$parsed_message = $received->{parsed};
|
||||
$parsed_message = $parser->parse_data($received->{contents});
|
||||
$head = $parsed_message->head;
|
||||
$messageId = decode('MIME-Header', $head->get('Message-Id'));
|
||||
chomp $messageId;
|
||||
is($messageId, '<endingAngleOnly@localhost.localdomain>', 'bad messageId corrected (added starting angle)');
|
||||
|
||||
$mail->send;
|
||||
$received = WebGUI::Test->getMail;
|
||||
# Send the mail
|
||||
$mail
|
||||
= WebGUI::Mail::Send->create( $session, {
|
||||
to => 'red@localhost',
|
||||
messageId => 'noAngles@localhost.localdomain',
|
||||
} );
|
||||
$mail->addText( "Neither are they. You have to be human first. They don't qualify." );
|
||||
|
||||
$parsed_message = $parser->parse_data($received->{contents});
|
||||
$head = $parsed_message->head;
|
||||
$messageId = decode('MIME-Header', $head->get('Message-Id'));
|
||||
chomp $messageId;
|
||||
is($messageId, '<leadingAngleOnly@localhost.localdomain>', 'bad messageId corrected (added ending angle)');
|
||||
|
||||
# Send the mail
|
||||
$mail
|
||||
= WebGUI::Mail::Send->create( $session, {
|
||||
to => 'norton@localhost',
|
||||
messageId => 'endingAngleOnly@localhost.localdomain>',
|
||||
} );
|
||||
$mail->addText( "Dear Warden, You were right. Salvation lies within." );
|
||||
|
||||
$mail->send;
|
||||
$received = WebGUI::Test->getMail;
|
||||
|
||||
$parsed_message = $parser->parse_data($received->{contents});
|
||||
$head = $parsed_message->head;
|
||||
$messageId = decode('MIME-Header', $head->get('Message-Id'));
|
||||
chomp $messageId;
|
||||
is($messageId, '<endingAngleOnly@localhost.localdomain>', 'bad messageId corrected (added starting angle)');
|
||||
|
||||
# Send the mail
|
||||
$mail
|
||||
= WebGUI::Mail::Send->create( $session, {
|
||||
to => 'red@localhost',
|
||||
messageId => 'noAngles@localhost.localdomain',
|
||||
} );
|
||||
$mail->addText( "Neither are they. You have to be human first. They don't qualify." );
|
||||
|
||||
$mail->send;
|
||||
$received = WebGUI::Test->getMail;
|
||||
|
||||
$parsed_message = $parser->parse_data($received->{contents});
|
||||
$head = $parsed_message->head;
|
||||
$messageId = decode('MIME-Header', $head->get('Message-Id'));
|
||||
chomp $messageId;
|
||||
is($messageId, '<noAngles@localhost.localdomain>', 'bad messageId corrected (added both angles)');
|
||||
$mail->send;
|
||||
$received = $cb->();
|
||||
|
||||
$parsed_message = $received->{parsed};
|
||||
$head = $parsed_message->head;
|
||||
$messageId = decode('MIME-Header', $head->get('Message-Id'));
|
||||
chomp $messageId;
|
||||
is($messageId, '<noAngles@localhost.localdomain>', 'bad messageId corrected (added both angles)');
|
||||
});
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
|
@ -292,24 +265,24 @@ WebGUI::Test->addToCleanup($inboxGroup);
|
|||
$inboxGroup->addUsers([$emailUser->userId, $inboxUser->userId, $lonelyUser->userId]);
|
||||
|
||||
SKIP: {
|
||||
my $numtests = 1; # Number of tests in this block
|
||||
skip "Cannot test email notifications", 1 unless $smtpServerOk;
|
||||
|
||||
# Must be able to write the config, or we'll die
|
||||
skip "Cannot test email notifications", $numtests unless $smtpServerOk;
|
||||
WebGUI::Test::MailServer::test_smtp($session, sub {
|
||||
my $cb = shift;
|
||||
# Send the mail
|
||||
$mail = WebGUI::Mail::Send->create( $session, {
|
||||
toUser => $inboxUser->userId,
|
||||
},
|
||||
'fromInbox',
|
||||
);
|
||||
$mail->addText( 'sent via email' );
|
||||
|
||||
# Send the mail
|
||||
$mail = WebGUI::Mail::Send->create( $session, {
|
||||
toUser => $inboxUser->userId,
|
||||
},
|
||||
'fromInbox',
|
||||
);
|
||||
$mail->addText( 'sent via email' );
|
||||
$mail->send;
|
||||
my $received = $cb->();
|
||||
|
||||
$mail->send;
|
||||
my $received = WebGUI::Test->getMail;
|
||||
|
||||
# Test the mail
|
||||
is($received->{to}->[0], '<ellis_boyd_redding@shawshank.gov>', 'send, toUser with email address');
|
||||
# Test the mail
|
||||
is($received->{to}->[0], '<ellis_boyd_redding@shawshank.gov>', 'send, toUser with email address');
|
||||
});
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
|
|
|||
|
|
@ -523,57 +523,6 @@ sub getSmokeLDAPProps {
|
|||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 prepareMailServer ( )
|
||||
|
||||
Prepare a Net::SMTP::Server to use for testing mail.
|
||||
|
||||
=cut
|
||||
|
||||
my $smtpdPid;
|
||||
my $smtpdStream;
|
||||
my $smtpdSelect;
|
||||
|
||||
sub prepareMailServer {
|
||||
eval {
|
||||
require Net::SMTP::Server;
|
||||
require Net::SMTP::Server::Client;
|
||||
};
|
||||
croak "Cannot load Net::SMTP::Server: $@" if $@;
|
||||
|
||||
my $SMTP_HOST = 'localhost';
|
||||
my $SMTP_PORT = '54921';
|
||||
my $smtpd = File::Spec->catfile( $CLASS->root, 't', 'smtpd.pl' );
|
||||
$smtpdPid = open $smtpdStream, '-|', $^X, $smtpd, $SMTP_HOST, $SMTP_PORT
|
||||
or die "Could not open pipe to SMTPD: $!";
|
||||
|
||||
$smtpdSelect = IO::Select->new;
|
||||
$smtpdSelect->add($smtpdStream);
|
||||
|
||||
$CLASS->session->setting->set( 'smtpServer', $SMTP_HOST . ':' . $SMTP_PORT );
|
||||
|
||||
$CLASS->originalConfig('emailToLog');
|
||||
$CLASS->session->config->set( 'emailToLog', 0 );
|
||||
|
||||
# Let it start up yo
|
||||
sleep 2;
|
||||
|
||||
$CLASS->addToCleanup(sub {
|
||||
# Close SMTPD
|
||||
if ($smtpdPid) {
|
||||
kill INT => $smtpdPid;
|
||||
}
|
||||
if ($smtpdStream) {
|
||||
# we killed it, so there will be an error. Prevent that from setting the exit value.
|
||||
local $?;
|
||||
close $smtpdStream;
|
||||
}
|
||||
});
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 originalConfig ( $param )
|
||||
|
||||
Stores the original data from the config file, to be restored
|
||||
|
|
@ -606,63 +555,6 @@ sub originalConfig {
|
|||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 getMail ( )
|
||||
|
||||
Read a sent mail from the prepared mail server (L<prepareMailServer>)
|
||||
|
||||
=cut
|
||||
|
||||
sub getMail {
|
||||
my $json;
|
||||
|
||||
if ( !$smtpdSelect ) {
|
||||
return from_json ' { "error": "mail server not prepared" }';
|
||||
}
|
||||
|
||||
if ($smtpdSelect->can_read(5)) {
|
||||
$json = <$smtpdStream>;
|
||||
}
|
||||
else {
|
||||
$json = ' { "error": "mail not sent" } ';
|
||||
}
|
||||
|
||||
if (!$json) {
|
||||
$json = ' { "error": "error in getting mail" } ';
|
||||
}
|
||||
|
||||
return from_json( $json );
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 getMailFromQueue ( )
|
||||
|
||||
Send the first mail in the queue and then retrieve it from the smtpd. Returns
|
||||
false if there is no mail in the queue.
|
||||
|
||||
Will prepare the server if necessary
|
||||
|
||||
=cut
|
||||
|
||||
sub getMailFromQueue {
|
||||
my $class = shift;
|
||||
if ( !$smtpdSelect ) {
|
||||
$class->prepareMailServer;
|
||||
}
|
||||
|
||||
my $messageId = $CLASS->session->db->quickScalar( "SELECT messageId FROM mailQueue" );
|
||||
warn $messageId;
|
||||
return unless $messageId;
|
||||
|
||||
require WebGUI::Mail::Send;
|
||||
my $mail = WebGUI::Mail::Send->retrieve( $CLASS->session, $messageId );
|
||||
$mail->send;
|
||||
|
||||
return $class->getMail;
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 cleanupGuard ( $object, $class => $ident )
|
||||
|
||||
Pass in a list of objects or pairs of classes and identifiers, and
|
||||
|
|
|
|||
137
t/lib/WebGUI/Test/MailServer.pm
Normal file
137
t/lib/WebGUI/Test/MailServer.pm
Normal file
|
|
@ -0,0 +1,137 @@
|
|||
package WebGUI::Test::MailServer;
|
||||
|
||||
=head1 LEGAL
|
||||
|
||||
-------------------------------------------------------------------
|
||||
WebGUI is Copyright 2001-2009 Plain Black Corporation.
|
||||
-------------------------------------------------------------------
|
||||
Please read the legal notices (docs/legal.txt) and the license
|
||||
(docs/license.txt) that came with this distribution before using
|
||||
this software.
|
||||
-------------------------------------------------------------------
|
||||
http://www.plainblack.com info@plainblack.com
|
||||
-------------------------------------------------------------------
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Package WebGUI::Test::MailServer
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Routines for testing mail sending in WebGUI
|
||||
|
||||
=cut
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use JSON ();
|
||||
use File::Spec::Functions qw(catdir updir);
|
||||
use File::Basename qw(dirname);
|
||||
use IO::Select;
|
||||
use Net::SMTP::Server;
|
||||
use Net::SMTP::Server::Client;
|
||||
use MIME::Parser;
|
||||
use Scope::Guard;
|
||||
use MIME::Parser;
|
||||
|
||||
my $smtpdPid;
|
||||
my $smtpdStream;
|
||||
my $smtpdSelect;
|
||||
|
||||
sub test_smtp {
|
||||
my $session = shift;
|
||||
my $testSub = shift;
|
||||
my $guard = Scope::Guard->new(sub { _shutdown_server() } );
|
||||
_setup_server($session);
|
||||
sleep 1;
|
||||
my $parser = MIME::Parser->new;
|
||||
$parser->output_to_core(1);
|
||||
my $cb = sub {
|
||||
die "mail not sent\n"
|
||||
unless $smtpdSelect->can_read(5);
|
||||
my $json = <$smtpdStream>;
|
||||
my $data = JSON->new->utf8->decode($json);
|
||||
my $parsed = $parser->parse_data($data->{contents});
|
||||
$data->{parsed} = $parsed;
|
||||
return $data;
|
||||
};
|
||||
$testSub->($cb);
|
||||
}
|
||||
|
||||
sub _setup_server {
|
||||
my $session = shift;
|
||||
return
|
||||
if $smtpdPid;
|
||||
|
||||
my $host = 'localhost';
|
||||
my $port = 54921;
|
||||
|
||||
# make sure the lib path for this file is available
|
||||
my $lib_path = catdir( dirname(__FILE__), (updir) x 2 );
|
||||
my @command_line = (
|
||||
$^X, "-I$lib_path", '-M' . __PACKAGE__,
|
||||
'-e' . __PACKAGE__ . '::run_server(@ARGV)', $host, $port,
|
||||
);
|
||||
|
||||
$smtpdPid = open $smtpdStream, '-|', @command_line
|
||||
or die "Could not open pipe to SMTPD: $!";
|
||||
die "Could not open pipe to SMTPD: $!"
|
||||
unless $smtpdStream;
|
||||
|
||||
$smtpdSelect = IO::Select->new;
|
||||
$smtpdSelect->add($smtpdStream);
|
||||
|
||||
$session->setting->set( 'smtpServer', $host . ':' . $port );
|
||||
$session->config->set( 'emailToLog', 0 );
|
||||
}
|
||||
|
||||
sub _shutdown_server {
|
||||
undef $smtpdSelect;
|
||||
|
||||
# Close SMTPD
|
||||
if ($smtpdPid) {
|
||||
kill INT => $smtpdPid;
|
||||
undef $smtpdPid;
|
||||
}
|
||||
if ($smtpdStream) {
|
||||
# we killed it, so there will be an error. Prevent that from setting the exit value.
|
||||
local $?;
|
||||
close $smtpdStream;
|
||||
undef $smtpdStream;
|
||||
}
|
||||
}
|
||||
|
||||
=head2 getMail ( )
|
||||
|
||||
Read a sent mail from the prepared mail server (L<prepareMailServer>)
|
||||
|
||||
=cut
|
||||
|
||||
sub getMail {
|
||||
my $json;
|
||||
|
||||
if ($smtpdSelect->can_read(5)) {
|
||||
$json = <$smtpdStream>;
|
||||
}
|
||||
return from_json( $json );
|
||||
}
|
||||
|
||||
sub run_server {
|
||||
my ($host, $port) = @_;
|
||||
my $server = Net::SMTP::Server->new( $host, $port );
|
||||
local $| = 1;
|
||||
CONNECTION: while ( my $conn = $server->accept ) {
|
||||
my $client = Net::SMTP::Server::Client->new( $conn );
|
||||
$client->process;
|
||||
print JSON->new->utf8->encode({
|
||||
to => $client->{TO},
|
||||
from => $client->{FROM},
|
||||
contents => $client->{MSG},
|
||||
});
|
||||
print "\n";
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
50
t/smtpd.pl
50
t/smtpd.pl
|
|
@ -1,50 +0,0 @@
|
|||
use strict;
|
||||
use warnings;
|
||||
|
||||
use JSON qw( to_json );
|
||||
use Net::SMTP::Server;
|
||||
use Net::SMTP::Server::Client;
|
||||
|
||||
my ($HOST, $PORT) = @ARGV;
|
||||
|
||||
die "HOST must be first argument"
|
||||
unless $HOST;
|
||||
die "PORT must be second argument"
|
||||
unless $PORT;
|
||||
|
||||
my $server = Net::SMTP::Server->new( $HOST, $PORT );
|
||||
|
||||
$| = 1;
|
||||
|
||||
CONNECTION: while ( my $conn = $server->accept ) {
|
||||
my $client = Net::SMTP::Server::Client->new( $conn );
|
||||
$client->process;
|
||||
print to_json({
|
||||
to => $client->{TO},
|
||||
from => $client->{FROM},
|
||||
contents => $client->{MSG},
|
||||
});
|
||||
print "\n";
|
||||
}
|
||||
|
||||
=head1 NAME
|
||||
|
||||
t/smtpd.pl - A dumb SMTP server.
|
||||
|
||||
=head1 USAGE
|
||||
|
||||
perl smtpd.pl <hostname> <port>
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This program listens on the given hostname and port, then processes the
|
||||
incoming SMTP client request.
|
||||
|
||||
Then it prints a JSON object of the data recieved and exits.
|
||||
|
||||
This program will only handle one request before exiting.
|
||||
|
||||
=head1 CAVEATS
|
||||
|
||||
You MUST C<sleep 1> after opening a pipe to this so that it can establish the
|
||||
listening on the port.
|
||||
Loading…
Add table
Add a link
Reference in a new issue