I recently transitioned mail.netisland.net from 0.28-tcpserver to
0.32-forkserver, and in doing so ended up making a number of small
changes. The attached diff does the following:
o lib/Qpsmtpd/SMTP.pm
- The code in fault() which displays error messages looks like
it wanted to prefix the message with the name of the process
and its PID, however the "$0[$$]" expression was being
parsed as an array lookup on @0. I also modified the
expression to only display the first word of $0, as in many
cases $0 has been modified to include information
identifying the current SMTP conversation.
- Treat DENY_DISCONNECT from connect hooks the same as DENY.
Previously, a return code of DENY_DISCONNECT was being
ignored, resulting in the default DECLINED action being
taken.
- Rather than always blindly appending " ESMTP" to the
smtpgreeting, only append when the smtpgreeting does not
already contain the word ESMTP.
- Make the space after "mail from:" once again be optional,
initialize $from_parameter to "" in order to avoid "Use of
uninitialized value" warnings.
- In RCPT TO, perform more careful error checking on the
object returned by Qpsmtpd::Address->parse. Previously,
"RCPT TO:<mct>" resulted in SMTP.pm not realizing that the
address was not properly parsed, and passing the plugins a
Qpsmtpd::Address object where both the user and host were
undef.
- The HELP command previously never returning a response
to the client due to missing parenthesis in the ternary
operation used to construct the response string.
o qpsmtpd-forkserver
- Add a new command line option, "-H" (same as tcpserver),
to avoid reverse DNS lookups on the client's IP address.
- If not running with "-H", modify $0 to display the name of
the IP address currently being examined, and restore the
original value when completed.
- Rather than having $USER default to "smtpd", have it instead
default to the name of the user who invoked it, and falling
back to "smtpd" only when that user was root. Previously,
if I wanted to run qpsmtpd-forkserver as myself on port
2525, I had to run "./qpsmtpd-forkserver -u mct" to avoid
permission denied errors.
- Add a call to endgrent() once we're done with getgrent()
to close the open file descriptor reading from /etc/group,
which otherwise would then be inherited by every child.
o STATUS
- Remove the wishlist item for supporting config/smtpgreeting;
the feature has been implemented.
Matt pointed out to me in the #qpsmtpd IRC channel that this is a
patch against the 0.32 distribution rather than the 0.3x SVN branch,
but as all of these changes are about three lines or less, hopefully
they won't present much of a problem when applying. If that turns out
not to be true, please let me know, and I'll be happy to put in the
grunt work to produce another diff.
Thanks,
-mct
diff -br -U20 qpsmtpd-0.32.old/lib/Qpsmtpd/SMTP.pm
qpsmtpd-0.32/lib/Qpsmtpd/SMTP.pm
--- qpsmtpd-0.32.old/lib/Qpsmtpd/SMTP.pm 2006-02-26 07:22:16.000000000
-0500
+++ qpsmtpd-0.32/lib/Qpsmtpd/SMTP.pm 2006-12-23 23:52:27.000000000 -0500
@@ -65,65 +65,68 @@
else {
$self->respond(500, "Unrecognized command");
}
return 1
}
$cmd = $1;
if (1 or $self->{_commands}->{$cmd} and $self->can($cmd)) {
my ($result) = eval { $self->$cmd(@_) };
$self->log(LOGERROR, "XX: $@") if $@;
return $result if defined $result;
return $self->fault("command '$cmd' failed unexpectedly");
}
return;
}
sub fault {
my $self = shift;
my ($msg) = shift || "program fault - command not performed";
- print STDERR "$0[$$]: $msg ($!)\n";
+ my ($name) = split /\s+/, $0, 2;
+
+ print STDERR "${name}[$$]: $msg ($!)\n";
return $self->respond(451, "Internal error - try again later - " . $msg);
}
sub start_conversation {
my $self = shift;
# this should maybe be called something else than "connect", see
# lib/Qpsmtpd/TcpServer.pm for more confusion.
my ($rc, $msg) = $self->run_hooks("connect");
- if ($rc == DENY) {
+ if ($rc == DENY || $rc == DENY_DISCONNECT) {
$self->respond(550, ($msg || 'Connection from you denied, bye bye.'));
return $rc;
}
elsif ($rc == DENYSOFT) {
$self->respond(450, ($msg || 'Connection from you temporarily denied,
bye bye.'));
return $rc;
}
elsif ($rc == DONE) {
return $rc;
}
elsif ($rc != DONE) {
my $greets = $self->config('smtpgreeting');
if ( $greets ) {
- $greets .= " ESMTP";
+ $greets .= " ESMTP"
+ unless $greets =~ /(^|\W)ESMTP(\W|$)/;
}
else {
$greets = $self->config('me')
. " ESMTP qpsmtpd "
. $self->version
. " ready; send us your mail, but not your spam.";
}
$self->respond(220, $greets);
return DONE;
}
}
sub transaction {
my $self = shift;
return $self->{_transaction} || $self->reset_transaction();
}
sub reset_transaction {
my $self = shift;
@@ -250,46 +253,47 @@
# may be aborted by the RSET (or a new EHLO) command. There may be
# zero or more transactions in a session. MAIL (or SEND, SOML, or
# SAML) MUST NOT be sent if a mail transaction is already open,
# i.e., it should be sent only if no mail transaction had been
# started in the session, or it the previous one successfully
# concluded with a successful DATA command, or if the previous one
# was aborted with a RSET.
# sendmail (8.11) rejects a second MAIL command.
# qmail-smtpd (1.03) accepts it and just starts a new transaction.
# Since we are a qmail-smtpd thing we will do the same.
$self->reset_transaction;
unless ($self->connection->hello) {
return $self->respond(503, "please say hello first ...");
}
else {
my $from_parameter = join " ", @_;
+ $from_parameter ||= "";
$self->log(LOGINFO, "full from_parameter: $from_parameter");
my ($from) = ($from_parameter =~ m/^from:\s*(<[^>]*>)/i)[0];
# support addresses without <> ... maybe we shouldn't?
- ($from) = "<" . ($from_parameter =~ m/^from:\s*(\S+)/i)[0] . ">"
+ ($from) = "<" . ($from_parameter =~ m/^from:\s*(\S*)/i)[0] . ">"
unless $from;
$self->log(LOGALERT, "from email address : [$from]");
if ($from eq "<>" or $from =~ m/\[undefined\]/ or $from eq "<[EMAIL
PROTECTED]>") {
$from = Qpsmtpd::Address->new("<>");
}
else {
$from = (Qpsmtpd::Address->parse($from))[0];
}
return $self->respond(501, "could not parse your mail from command")
unless $from;
my ($rc, $msg) = $self->run_hooks("mail", $from);
if ($rc == DONE) {
return 1;
}
elsif ($rc == DENY) {
$msg ||= $from->format . ', denied';
$self->log(LOGINFO, "deny mail from " . $from->format . " ($msg)");
$self->respond(550, $msg);
@@ -312,41 +316,42 @@
$self->disconnect;
}
else { # includes OK
$self->log(LOGINFO, "getting mail from ".$from->format);
$self->respond(250, $from->format . ", sender OK - how exciting to get
mail from you!");
$self->transaction->sender($from);
}
}
}
sub rcpt {
my $self = shift;
return $self->respond(501, "syntax error in parameters") unless $_[0] and
$_[0] =~ m/^to:/i;
return $self->respond(503, "Use MAIL before RCPT") unless
$self->transaction->sender;
my ($rcpt) = ($_[0] =~ m/to:(.*)/i)[0];
$rcpt = $_[1] unless $rcpt;
$self->log(LOGALERT, "to email address : [$rcpt]");
$rcpt = (Qpsmtpd::Address->parse($rcpt))[0];
- return $self->respond(501, "could not parse recipient") unless $rcpt;
+ return $self->respond(501, "could not parse recipient")
+ unless $rcpt && (defined($rcpt->user) || defined($rcpt->host));
my ($rc, $msg) = $self->run_hooks("rcpt", $rcpt);
if ($rc == DONE) {
return 1;
}
elsif ($rc == DENY) {
$msg ||= 'relaying denied';
$self->respond(550, $msg);
}
elsif ($rc == DENYSOFT) {
$msg ||= 'relaying denied';
return $self->respond(450, $msg);
}
elsif ($rc == DENY_DISCONNECT) {
$msg ||= 'delivery denied';
$self->log(LOGINFO, "delivery denied ($msg)");
$self->respond(550, $msg);
$self->disconnect;
}
elsif ($rc == DENYSOFT_DISCONNECT) {
@@ -354,41 +359,41 @@
$self->log(LOGINFO, "delivery denied ($msg)");
$self->respond(421, $msg);
$self->disconnect;
}
elsif ($rc == OK) {
$self->respond(250, $rcpt->format . ", recipient ok");
return $self->transaction->add_recipient($rcpt);
}
else {
return $self->respond(450, "No plugin decided if relaying is allowed");
}
return 0;
}
sub help {
my $self = shift;
$self->respond(214,
"This is qpsmtpd " .
- $self->config('smtpgreeting') ? '' : $self->version,
+ ($self->config('smtpgreeting') ? '' : $self->version),
"See http://smtpd.develooper.com/";,
'To report bugs or send comments, mail to <[EMAIL PROTECTED]>.');
}
sub noop {
my $self = shift;
$self->respond(250, "OK");
}
sub vrfy {
my $self = shift;
# Note, this doesn't support the multiple ambiguous results
# documented in RFC2821#3.5.1
# I also don't think it provides all the proper result codes.
my ($rc, $msg) = $self->run_hooks("vrfy");
if ($rc == DONE) {
return 1;
}
diff -br -U20 qpsmtpd-0.32.old/qpsmtpd-forkserver
qpsmtpd-0.32/qpsmtpd-forkserver
--- qpsmtpd-0.32.old/qpsmtpd-forkserver 2006-02-26 07:22:16.000000000 -0500
+++ qpsmtpd-0.32/qpsmtpd-forkserver 2006-12-24 11:24:05.000000000 -0500
@@ -1,72 +1,77 @@
#!/usr/bin/perl -Tw
# Copyright (c) 2001 Ask Bjoern Hansen. See the LICENSE file for details.
# The "command dispatch" system is taken from colobus -
http://trainedmonkey.com/colobus/
#
# For more information see http://develooper.com/code/qpsmtpd/
#
#
use lib 'lib';
use Qpsmtpd::TcpServer;
use Qpsmtpd::Constants;
use IO::Socket;
use IO::Select;
use Socket;
-use Getopt::Long;
+use Getopt::Long qw(:config no_ignore_case);
use POSIX qw(:sys_wait_h :errno_h :signal_h);
use strict;
$| = 1;
# Configuration
my $MAXCONN = 15; # max simultaneous connections
my $PORT = 2525; # port number
my @LOCALADDR; # ip address(es) to bind to
-my $USER = 'smtpd'; # user to suid to
my $MAXCONNIP = 5; # max simultaneous connections from one IP
my $PID_FILE = '';
my $DETACH; # daemonize on startup
+my $NORDNS;
+
+my $USER = (getpwuid $>)[0]; # user to suid to
+$USER = "smtpd" if $USER eq "root";
sub usage {
print <<"EOT";
usage: qpsmtpd-forkserver [ options ]
-l, --listen-address addr : listen on specific address(es); can be specified
multiple times for multiple bindings. Default is
0.0.0.0 (all interfaces).
-p, --port P : listen on a specific port; default 2525
-c, --limit-connections N : limit concurrent connections to N; default 15
-u, --user U : run as a particular user (default 'smtpd')
-m, --max-from-ip M : limit connections from a single IP; default 5
--pid-file P : print main servers PID to file P
-d, --detach : detach from controlling terminal (daemonize)
+ -H, --no-rdns : don't perform reverse DNS lookups
EOT
exit 0;
}
GetOptions('h|help' => \&usage,
'l|listen-address=s' => [EMAIL PROTECTED],
'c|limit-connections=i' => \$MAXCONN,
'm|max-from-ip=i' => \$MAXCONNIP,
'p|port=i' => \$PORT,
'u|user=s' => \$USER,
'pid-file=s' => \$PID_FILE,
'd|detach' => \$DETACH,
+ 'H|no-rdns' => \$NORDNS,
) || &usage;
# detaint the commandline
if ($PORT =~ /^(\d+)$/) { $PORT = $1 } else { &usage }
@LOCALADDR = ( '0.0.0.0' ) if [EMAIL PROTECTED];
for (0..$#LOCALADDR) {
if ($LOCALADDR[$_] =~ /^([\d\w\-.]+)$/) {
$LOCALADDR[$_] = $1;
} else {
&usage;
}
}
if ($USER =~ /^([\w\-]+)$/) { $USER = $1 } else { &usage }
if ($MAXCONN =~ /^(\d+)$/) { $MAXCONN = $1 } else { &usage }
delete $ENV{ENV};
$ENV{PATH} = '/bin:/usr/bin:/var/qmail/bin';
my %childstatus = ();
@@ -123,40 +128,41 @@
or die "Could not truncate $PID_FILE at 0: $!";
} else {
open PID, ">$PID_FILE"
or die "open pid_file: $!\n";
}
}
# Load plugins here
my $qpsmtpd = Qpsmtpd::TcpServer->new();
# Drop privileges
my (undef, undef, $quid, $qgid) = getpwnam $USER or
die "unable to determine uid/gid for $USER\n";
my $groups = "$qgid $qgid";
while (my ($name,$passwd,$gid,$members) = getgrent()) {
my @m = split(/ /, $members);
if (grep {$_ eq $USER} @m) {
$groups .= " $gid";
}
}
+endgrent;
$) = $groups;
POSIX::setgid($qgid) or
die "unable to change gid: $!\n";
POSIX::setuid($quid) or
die "unable to change uid: $!\n";
$> = $quid;
$qpsmtpd->load_plugins;
::log(LOGINFO,"Listening on port $PORT");
::log(LOGINFO, 'Running as user '.
(getpwuid($>) || $>) .
', group '.
(getgrgid($)) || $)));
if ($DETACH) {
open STDIN, '/dev/null' or die "/dev/null: $!";
open STDOUT, '>/dev/null' or die "/dev/null: $!";
open STDERR, '>&STDOUT' or die "open(stderr): $!";
defined (my $pid = fork) or die "fork: $!";
@@ -228,41 +234,49 @@
$running++;
close($client);
next;
}
# otherwise child
# all children should have different seeds, to prevent conflicts
srand( time ^ ($$ + ($$ << 15)) );
close($server);
$SIG{$_} = 'DEFAULT' for keys %SIG;
$SIG{ALRM} = sub {
print $client "421 Connection Timed Out\n";
::log(LOGINFO, "Connection Timed Out");
exit; };
$ENV{TCPLOCALIP} = inet_ntoa($laddr);
# my ($port, $iaddr) = sockaddr_in($hisaddr);
$ENV{TCPREMOTEIP} = inet_ntoa($iaddr);
+
+ if ($NORDNS) {
+ $ENV{TCPREMOTEHOST} = $ENV{TCPREMOTEIP} ? "[$ENV{TCPREMOTEIP}]" :
"[noip!]";
+ } else {
+ my $zero = $0;
+ $0 = "$zero (gethostbyname $ENV{TCPREMOTEIP})";
$ENV{TCPREMOTEHOST} = gethostbyaddr($iaddr, AF_INET) || "Unknown";
+ $0 = $zero;
+ }
# don't do this!
#$0 = "qpsmtpd-forkserver: $ENV{TCPREMOTEIP} / $ENV{TCPREMOTEHOST}";
::log(LOGINFO, "Accepted connection $running/$MAXCONN from
$ENV{TCPREMOTEIP} / $ENV{TCPREMOTEHOST}");
# dup to STDIN/STDOUT
POSIX::dup2(fileno($client), 0);
POSIX::dup2(fileno($client), 1);
$qpsmtpd->start_connection
(
local_ip => $ENV{TCPLOCALIP},
local_port => $lport,
remote_ip => $ENV{TCPREMOTEIP},
remote_port => $port,
);
$qpsmtpd->run();
$qpsmtpd->run_hooks("post-connection");
diff -br -U20 qpsmtpd-0.32.old/STATUS qpsmtpd-0.32/STATUS
--- qpsmtpd-0.32.old/STATUS 2006-02-26 07:22:16.000000000 -0500
+++ qpsmtpd-0.32/STATUS 2006-12-23 23:35:57.000000000 -0500
@@ -66,44 +66,40 @@
join them to one for SMTP?)
support plugins for the rest of the commands.
specify a priority in register_hook. ("LAST", "FIRST", "MIDDLE", or
maybe a number)
plugin access to the data line by line during the DATA phase
(instead of just after)
if qmail-queue can't be loaded we still return 250 ?!
Make a system for configuring the plugins per user/domain/...
support databytes per user / domain
plugin to reject mails from <> if it has multiple recipients.
localiphost - support [EMAIL PROTECTED] addresses
-support smtpgreeting (?)
-
-
-
TRACE in Constants.pm is not actually being used. Should it be?
Move dispatch() etc from SMTP.pm to Qpsmtpd.pm to allow other similar
protocols to use the qpsmtpd framework.
Future Ideas
============
Methods to create a bounce message easily; partly so we can accept a
mail for one user but bounce it right away for another RCPT'er.
The data_post hook should be able to put in the notes what addresses
should go through, bounce and get rejected respectively, and qpsmtpd
should just do the right thing. See also
http://nntp.perl.org/group/perl.qpsmtpd/170
David Carraway has some thoughts for "user filters"
http://nntp.perl.org/group/perl.qpsmtpd/2
