From 6df92cd56e32549d7fc4dc905e005124ffa7f704 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ask=20Bj=C3=B8rn=20Hansen?= Date: Wed, 3 Jul 2002 13:10:44 +0000 Subject: [PATCH] half baked version of the new object mail engine (note the branch, v010) git-svn-id: https://svn.perl.org/qpsmtpd/branches/v010@23 958fd67b-6ff1-0310-b445-bb7760255be9 --- lib/Qpsmtpd.pm | 250 +++++++++++++++++++++++++++++++++++++ lib/Qpsmtpd/Connection.pm | 55 ++++++++ lib/Qpsmtpd/Constants.pm | 6 + lib/Qpsmtpd/TcpServer.pm | 52 ++++++++ lib/Qpsmtpd/Transaction.pm | 30 +++++ qpsmtpd | 235 ++-------------------------------- run | 2 +- 7 files changed, 407 insertions(+), 223 deletions(-) create mode 100644 lib/Qpsmtpd.pm create mode 100644 lib/Qpsmtpd/Connection.pm create mode 100644 lib/Qpsmtpd/Constants.pm create mode 100644 lib/Qpsmtpd/TcpServer.pm create mode 100644 lib/Qpsmtpd/Transaction.pm diff --git a/lib/Qpsmtpd.pm b/lib/Qpsmtpd.pm new file mode 100644 index 0000000..3370e4b --- /dev/null +++ b/lib/Qpsmtpd.pm @@ -0,0 +1,250 @@ +package Qpsmtpd; +use strict; +use Carp; + +use Qpsmtpd::Connection; +use Qpsmtpd::Transaction; +use Qpsmtpd::Constants; + +use Mail::Address (); +use Sys::Hostname; +use IPC::Open2; +use Data::Dumper; +BEGIN{$^W=0;} +use Net::DNS; +BEGIN{$^W=1;} + +$Qpsmtpd::VERSION = "0.10-dev"; + +# $SIG{ALRM} = sub { respond(421, "Game over pal, game over. You got a timeout; I just can't wait that long..."); exit }; + + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + + my %args = @_; + + my $self = bless ({ args => \%args }, $class); + + my (@commands) = qw(ehlo helo rset mail rcpt data help vrfy noop quit); + my (%commands); @commands{@commands} = ('') x @commands; + # this list of valid commands should probably be a method or a set of methods + $self->{_commands} = \%commands; + + $self; +} + + +# +# method to get the configuration. It just calls get_qmail_config by +# default, but it could be overwritten to look configuration up in a +# database or whatever. +# +sub config { + my ($self, $c) = @_; + + my %defaults = ( + me => hostname, + timeout => 1200, + ); + + return ($self->get_qmail_config($c) || $defaults{$c} || undef); + +}; + +sub log { + my ($self, $trace, @log) = @_; + warn join(" ", $$, @log), "\n" + if $trace <= 10; +} + +sub dispatch { + my $self = shift; + my ($cmd) = lc shift; + + warn "command: $cmd"; + + #$self->respond(553, $state{dnsbl_blocked}), return 1 + # if $state{dnsbl_blocked} and ($cmd eq "rcpt"); + + $self->respond(500, "Unrecognized command"), return 1 + if ($cmd !~ /^(\w{1,12})$/ or !exists $self->{_commands}->{$1}); + $cmd = $1; + + if (1 or $self->{_commands}->{$cmd} and $self->can($cmd)) { + my ($result) = eval { $self->$cmd(@_) }; + $self->log(0, "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"; + return $self->respond(451, "Internal error - try again later - " . $msg); +} + + +sub start_conversation { + my $self = shift; + $self->respond(220, $self->config('me') ." qpsmtpd ". $self->version ." Service ready, send me all your stuff!"); +} + +sub transaction { + my $self = shift; + use Data::Dumper; + warn Data::Dumper->Dump([\$self], [qw(self)]); + return $self->{_transaction} || ($self->{_transaction} = Qpsmtpd::Transaction->new()); +} + +sub connection { + my $self = shift; + return $self->{_connection} || ($self->{_connection} = Qpsmtpd::Connection->new()); +} + + +sub helo { + my ($self, $hello_host, @stuff) = @_; + my $conn = $self->connection; + return $self->respond (503, "but you already said HELO ...") if $conn->hello; + + $conn->hello("helo"); + $conn->hello_host($hello_host); + $self->transaction; + $self->respond(250, $self->config('me') ." Hi " . $conn->remote_info . " [" . $conn->remote_ip ."]; I am so happy to meet you."); +} + +sub ehlo { + my ($self, $hello_host, @stuff) = @_; + my $conn = $self->connection; + return $self->respond (503, "but you already said HELO ...") if $conn->hello; + + $conn->hello("ehlo"); + $conn->hello_host($hello_host); + $self->transaction; + + $self->respond(250, + $self->config("me") . " Hi " . $conn->remote_info . " [" . $conn->remote_ip ."]", + "PIPELINING", + "8BITMIME", + ($self->config('databytes') ? "SIZE ". ($self->config('databytes'))[0] : ()), + ); +} + +sub mail { + my $self = shift; + return $self->respond(501, "syntax error in parameters") if $_[0] !~ m/^from:/i; + unless ($self->connection->hello) { + return $self->respond(503, "please say hello first ..."); + } + else { + my $from_parameter = join " ", @_; + $self->log(2, "full from_parameter: $from_parameter"); + my ($from) = ($from_parameter =~ m/^from:\s*(\S+)/i)[0]; + #warn "$$ from email address : $from\n" if $TRACE; + if ($from eq "<>" or $from =~ m/\[undefined\]/) { + $from = Mail::Address->new("<>"); + } + else { + $from = (Mail::Address->parse($from))[0]; + } + return $self->respond(501, "could not parse your mail from command") unless $from; + + # this needs to be moved to a plugin --- FIXME + 0 and $from->format ne "<>" + and $self->config("require_resolvable_fromhost") + and !check_dns($from->host) + and return $self->respond(450, $from->host ? "Could not resolve ". $from->host : "FQDN required in the envelope sender"); + + $self->log(2, "getting mail from ".$from->format); + $self->respond(250, $from->format . ", sender OK - I always like getting mail from you!"); + + $self->transaction->sender($from); + } +} + +sub rcpt { + my $self = shift; + return $self->respond(501, "syntax error in parameters") unless $_[0] =~ m/^to:/i; + return(503, "Use MAIL before RCPT") unless $self->transaction->sender; + + my $from = $self->transaction->sender; + + # Move to a plugin -- FIXME + if (0 and $from->format ne "<>" and $self->config('rhsbl_zones')) { + my %rhsbl_zones = map { (split /\s+/, $_, 2)[0,1] } $self->config('rhsbl_zones'); + my $host = $from->host; + for my $rhsbl (keys %rhsbl_zones) { + $self->respond("550", "Mail from $host rejected because it $rhsbl_zones{$rhsbl}"), return 1 + if check_rhsbl($rhsbl, $host); + } + } + + my ($rcpt) = ($_[0] =~ m/to:(.*)/i)[0]; + $rcpt = $_[1] unless $rcpt; + $rcpt = (Mail::Address->parse($rcpt))[0]; + return $self->respond(501, "could not parse recipient") unless $rcpt; + return $self->respond(550, "will not relay for ". $rcpt->host) unless $self->check_relay($rcpt->host); + $self->transaction->add_recipient($rcpt); + $self->respond(250, $rcpt->format . ", recipient OK"); +} + + +sub check_relay { + my $self = shift; + my $host = lc shift; + my @rcpt_hosts = $self->config("rcpthosts"); + return 1 if exists $ENV{RELAYCLIENT}; + for my $allowed (@rcpt_hosts) { + $allowed =~ s/^\s*(\S+)/$1/; + return 1 if $host eq lc $allowed; + return 1 if substr($allowed,0,1) eq "." and $host =~ m/\Q$allowed\E$/i; + } + return 0; +} + +sub get_qmail_config { + my ($self, $config) = (shift, shift); + $self->log(5, "trying to get config for $config"); + if ($self->{_config_cache}->{$config}) { + return wantarray ? @{$self->{_config_cache}->{$config}} : $self->{_config_cache}->{$config}->[0]; + } + my $configdir = '/var/qmail/control'; + my ($name) = ($0 =~ m!(.*?)/([^/]+)$!); + $configdir = "$name/config" if (-e "$name/config/$config"); + open CF, "<$configdir/$config" or warn "$$ could not open configfile $config: $!", return; + my @config = ; + chomp @config; + @config = grep { $_ and $_ !~ m/^\s*#/ and $_ =~ m/\S/} @config; + close CF; + $self->log(5, "returning get_config for $config ",Data::Dumper->Dump([\@config], [qw(config)])); + $self->{_config_cache}->{$config} = \@config; + return wantarray ? @config : $config[0]; +} + + +sub help { + my $self = shift; + $self->respond(214, + "This is qpsmtpd " . $self->version, + "See http://develooper.com/code/qpsmtpd/", + 'To report bugs or send comments, mail to .'); +} + +sub version { + $Qpsmtpd::VERSION; +} + +sub quit { + my $self = shift; + $self->respond(221, $self->config('me') . " closing connection. Have a wonderful day"); + exit; +} + + +1; diff --git a/lib/Qpsmtpd/Connection.pm b/lib/Qpsmtpd/Connection.pm new file mode 100644 index 0000000..18ecd7e --- /dev/null +++ b/lib/Qpsmtpd/Connection.pm @@ -0,0 +1,55 @@ +package Qpsmtpd::Connection; +use strict; + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = {}; + bless ($self, $class); +} + +sub start { + my $self = shift; + $self = $self->new(@_) unless ref $self; + + my %args = @_; + + for my $f (qw(remote_host remote_ip remote_info)) { + $self->$f($args{$f}) if $args{$f}; + } + + return $self; +} + +sub remote_host { + my $self = shift; + @_ and $self->{_remote_host} = shift; + $self->{_remote_host}; +} + +sub remote_ip { + my $self = shift; + @_ and $self->{_remote_ip} = shift; + $self->{_remote_ip}; +} + +sub remote_info { + my $self = shift; + @_ and $self->{_remote_info} = shift; + $self->{_remote_info}; +} + +sub hello { + my $self = shift; + @_ and $self->{_hello} = shift; + $self->{_hello}; +} + +sub hello_host { + my $self = shift; + @_ and $self->{_hello_host} = shift; + $self->{_hello_host}; +} + + +1; diff --git a/lib/Qpsmtpd/Constants.pm b/lib/Qpsmtpd/Constants.pm new file mode 100644 index 0000000..8e616fa --- /dev/null +++ b/lib/Qpsmtpd/Constants.pm @@ -0,0 +1,6 @@ +package Qpsmtpd::Constants; +use strict; +use constant TRACE => 10; + + +1; diff --git a/lib/Qpsmtpd/TcpServer.pm b/lib/Qpsmtpd/TcpServer.pm new file mode 100644 index 0000000..f875f63 --- /dev/null +++ b/lib/Qpsmtpd/TcpServer.pm @@ -0,0 +1,52 @@ +package Qpsmtpd::TcpServer; +use strict; +use base qw(Qpsmtpd); + +sub start_connection { + my $self = shift; + + my $remote_host = $ENV{TCPREMOTEHOST} || "[$ENV{TCPREMOTEIP}]"; + my $remote_info = $ENV{TCPREMOTEINFO} ? "$ENV{TCPREMOTEINFO}\@$remote_host" : $remote_host; + my $remote_ip = $ENV{TCPREMOTEIP}; + + $self->SUPER::connection->start(remote_info => $remote_info, + remote_ip => $remote_ip, + remote_host => $remote_host, + @_); +} + +sub run { + my $self = shift; + + $self->start_conversation; + + # this should really be the loop and read_input should just get one line; I think + + $self->read_input; +} + +sub read_input { + my $self = shift; + alarm $self->config('timeout'); + while () { + alarm 0; + $_ =~ s/\r?\n$//s; # advanced chomp + $self->log(1, "dispatching $_"); + defined $self->dispatch(split / +/, $_) + or $self->respond(502, "command unrecognized: '$_'"); + alarm $self->config('timeout'); + } +} + +sub respond { + my ($self, $code, @messages) = @_; + while (my $msg = shift @messages) { + my $line = $code . (@messages?"-":" ").$msg; + $self->log(1, "$line"); + print "$line\r\n" or ($self->log("Could not print [$line]: $!"), return 0); + } + return 1; +} + + +1; diff --git a/lib/Qpsmtpd/Transaction.pm b/lib/Qpsmtpd/Transaction.pm new file mode 100644 index 0000000..ec16b37 --- /dev/null +++ b/lib/Qpsmtpd/Transaction.pm @@ -0,0 +1,30 @@ +package Qpsmtpd::Transaction; +use strict; + +sub new { start(@_) } + +sub start { + my $proto = shift; + my $class = ref($proto) || $proto; + my %args = @_; + my $self = { _rcpt => [] }; + bless ($self, $class); +} + +sub add_header { + my $self = shift; +} + +sub add_recipient { + my $self = shift; + +} + +sub sender { + my $self = shift; + @_ and $self->{_sender} = shift; + $self->{_sender}; + +} + +1; diff --git a/qpsmtpd b/qpsmtpd index ce23ce9..5499b82 100755 --- a/qpsmtpd +++ b/qpsmtpd @@ -10,169 +10,23 @@ # # -package QPsmtpd; -$QPsmtpd::VERSION = "0.07b"; +use lib 'lib'; +use Qpsmtpd::TcpServer; use strict; $| = 1; -use Mail::Address (); -use Sys::Hostname; -use IPC::Open2; -use Data::Dumper; -BEGIN{$^W=0;} -use Net::DNS; -BEGIN{$^W=1;} delete $ENV{ENV}; $ENV{PATH} = '/var/qmail/bin'; use vars qw($TRACE); +$TRACE = 5; -$TRACE = 0; +# should this be ->new ? +my $qpsmtpd = Qpsmtpd::TcpServer->new(); +$qpsmtpd->start_connection(); +$qpsmtpd->run(); -my %config; -$config{me} = get_config('me') || hostname; -$config{timeout} = get_config('timeoutsmtpd') || 1200; - -my (@commands) = qw(ehlo helo rset mail rcpt data help vrfy noop quit); -my (%commands); @commands{@commands} = ('') x @commands; - -my %state; - -respond(220, "$config{me} qpsmtpd $QPsmtpd::VERSION Service ready, send me all your stuff!"); - -my $remote_host = $ENV{TCPREMOTEHOST} || "[$ENV{TCPREMOTEIP}]"; -$state{remote_info} = $ENV{TCPREMOTEINFO} ? "$ENV{TCPREMOTEINFO}\@$remote_host" : $remote_host; -$state{remote_ip} = $ENV{TCPREMOTEIP}; - -$SIG{ALRM} = sub { respond(421, "Game over pal, game over. You got a timeout; I just can't wait that long..."); exit }; - -$state{dnsbl_blocked} = check_dnsbl($state{remote_ip}); - -my ($commands) = ''; -alarm $config{timeout}; -while () { - alarm 0; - $_ =~ s/\r?\n$//s; # advanced chomp - warn "$$ dispatching $_\n" if $TRACE; - defined dispatch(split / +/, $_) - or respond(502, "command unrecognized: '$_'"); - alarm $config{timeout}; -} - -sub dispatch { - my ($cmd) = lc shift; - - respond(553, $state{dnsbl_blocked}), return 1 - if $state{dnsbl_blocked} and ($cmd eq "rcpt"); - - respond(500, "Unrecognized command"), return 1 - if ($cmd !~ /^(\w{1,12})$/ or !exists $commands{$1}); - $cmd = $1; - - - if (exists $commands{$cmd}) { - my ($result) = eval "&$cmd"; - warn "$$ $@" if $@; - return $result if defined $result; - return fault("command '$cmd' failed unexpectedly"); - } - - return; -} - -sub respond { - my ($code, @messages) = @_; - while (my $msg = shift @messages) { - my $line = $code . (@messages?"-":" ").$msg; - print "$line\r\n"; - warn "$$ $line\n" if $TRACE; - } - return 1; -} - -sub fault { - my ($msg) = shift || "program fault - command not performed"; - print STDERR "$0[$$]: $msg ($!)\n"; - return respond(451, "Internal error - try again later - " . $msg); -} - -sub helo { - my ($hello_host, @stuff) = @_; - return respond (503, "but you already said HELO ...") if $state{hello}; - $state{hello} = "helo"; - $state{hello_host} = $hello_host; - $state{transaction} = {}; - respond(250, "$config{me} Hi $state{remote_info} [$state{remote_ip}]; I am so happy to meet you."); -} - -sub ehlo { - my ($hello_host, @stuff) = @_; - return respond (503, "but you already said HELO ...") if $state{hello}; - $state{hello} = "ehlo"; - $state{hello_host} = $hello_host; - $state{transaction} = {}; - respond(250, - "$config{me} Hi $state{remote_info} [$state{remote_ip}].", - "PIPELINING", - "8BITMIME", - (get_config('databytes') ? "SIZE ". (get_config('databytes'))[0] : ()), - ); -} - - -sub mail { - return respond(501, "syntax error in parameters") if $_[0] !~ m/^from:/i; - unless ($state{hello}) { - return respond(503, "please say hello first ..."); - } - else { - my $from_parameter = join " ", @_; - warn "$$ full from_parameter: $from_parameter\n" if $TRACE; - my ($from) = ($from_parameter =~ m/^from:\s*(\S+)/i)[0]; - #warn "$$ from email address : $from\n" if $TRACE; - if ($from eq "<>" or $from =~ m/\[undefined\]/) { - $from = Mail::Address->new("<>"); - } - else { - $from = (Mail::Address->parse($from))[0]; - } - return respond(501, "could not parse your mail from command") unless $from; - - $from->format ne "<>" - and get_config("require_resolvable_fromhost") - and !check_dns($from->host) - and return respond(450, $from->host ? "Could not resolve ". $from->host : "FQDN required in the envelope sender"); - - warn "$$ getting mail from ",$from->format,"\n" if $TRACE; - respond(250, $from->format . ", sender OK - I always like getting mail from you!"); - - $state{transaction} = { from => $from }; - } -} - -sub rcpt { - return respond(501, "syntax error in parameters") unless $_[0] =~ m/^to:/i; - return(503, "Use MAIL before RCPT") unless $state{transaction}->{from}; - - my $from = $state{transaction}->{from}; - if ($from->format ne "<>" and get_config('rhsbl_zones')) { - my %rhsbl_zones = map { (split /\s+/, $_, 2)[0,1] } get_config('rhsbl_zones'); - my $host = $from->host; - for my $rhsbl (keys %rhsbl_zones) { - respond("550", "Mail from $host rejected because it $rhsbl_zones{$rhsbl}"), return 1 - if check_rhsbl($rhsbl, $host); - } - } - - - my ($rcpt) = ($_[0] =~ m/to:(.*)/i)[0]; - $rcpt = $_[1] unless $rcpt; - $rcpt = (Mail::Address->parse($rcpt))[0]; - return respond(501, "could not parse recipient") unless $rcpt; - return respond(550, "will not relay for ". $rcpt->host) unless check_relay($rcpt->host); - push @{$state{transaction}->{rcpt}}, $rcpt; - respond(250, $rcpt->format . ", recipient OK"); -} +__END__ sub data { respond(503, "MAIL first"), return 1 unless $state{transaction}->{from}; @@ -300,17 +154,6 @@ sub vrfy { respond(252, "Just try sending a mail and we'll see how it turns out ..."); } -sub help { - respond(214, - "This is qpsmtpd $QPsmtpd::VERSION", - "See http://develooper.com/code/qpsmtpd/", - "To report bugs or whatnot, send mail to ."); -} - -sub quit { - respond(221, "$config{me} closing connection. Have a wonderful day"); - exit; -} sub check_rhsbl { my ($rhsbl, $host) = @_; @@ -320,36 +163,6 @@ sub check_rhsbl { return 0; } -sub check_dnsbl { - my ($ip, $debug) = @_; - local $TRACE = 5 if $debug; - my %dnsbl_zones = map { (split /\s+/, $_, 2)[0,1] } get_config('dnsbl_zones'); - return unless %dnsbl_zones; - - my $reversed_ip = join(".", reverse(split(/\./, $ip))); - - my $res = new Net::DNS::Resolver; - for my $dnsbl (keys %dnsbl_zones) { - warn "$$ Checking $reversed_ip.$dnsbl ..." if $TRACE > 2; - my $query = $res->query("$reversed_ip.$dnsbl", "TXT"); - if ($query) { - my $a_record = 0; - foreach my $rr ($query->answer) { - $a_record = 1 if $rr->type eq "A"; - next unless $rr->type eq "TXT"; - warn "got txt record" if $TRACE > 9; - return $rr->txtdata; - } - return "Blocked by $dnsbl" if $a_record; - } - else { - warn "$$ query for $reversed_ip.$dnsbl failed: ", $res->errorstring, "\n" - unless $res->errorstring eq "NXDOMAIN"; - } - } - return ""; -} - sub check_dns { my $host = shift; @@ -373,35 +186,13 @@ sub check_dns { return 0; } - -sub check_relay { - my $host = lc shift; - my @rcpt_hosts = get_config("rcpthosts"); - return 1 if exists $ENV{RELAYCLIENT}; - for my $allowed (@rcpt_hosts) { - $allowed =~ s/^\s*(\S+)/$1/; - return 1 if $host eq lc $allowed; - return 1 if substr($allowed,0,1) eq "." and $host =~ m/\Q$allowed\E$/i; - } - return 0; -} -my %config_cache; -sub get_config { - my $config = shift; - warn "$$ trying to get config for $config" if $TRACE > 4; - return @{$config_cache{$config}} if $config_cache{$config}; - my $configdir = '/var/qmail/control'; +sub load_plugins { + my @plugins = get_config('plugins'); + my ($name) = ($0 =~ m!(.*?)/([^/]+)$!); - $configdir = "$name/config" if (-e "$name/config/$config"); - open CF, "<$configdir/$config" or warn "$$ could not open configfile $config: $!", return; - my @config = ; - chomp @config; - @config = grep { $_ and $_ !~ m/\s*#/ } @config; - close CF; - warn "$$ returning get_config for $config ",Data::Dumper->Dump([\@config], [qw(config)]) if $TRACE > 4; - $config_cache{$config} = \@config; - return wantarray ? @config : $config[0]; + my $dir = "$name/plugins"; + warn "$$ loading plugins from $dir" if $TRACE; } 1; diff --git a/run b/run index 3e2ff6b..6356496 100755 --- a/run +++ b/run @@ -3,6 +3,6 @@ QMAILDUID=`id -u smtpd` NOFILESGID=`id -g smtpd` exec /usr/local/bin/softlimit -m 10000000 \ /usr/local/bin/tcpserver -c 10 -v -p \ - -u $QMAILDUID -g $NOFILESGID 0 smtp \ + -u $QMAILDUID -g $NOFILESGID 64.81.84.165 smtp \ ./qpsmtpd 2>&1