diff --git a/Changes b/Changes index f979637..a38d7eb 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,8 @@ + +2002/07/03 + First (non functional) version of the new object oriented mail engine. + + 2002/05/09 Klez filter (thanks to Robert Spier) diff --git a/lib/Qpsmtpd.pm b/lib/Qpsmtpd.pm index 6144152..8be008b 100644 --- a/lib/Qpsmtpd.pm +++ b/lib/Qpsmtpd.pm @@ -264,5 +264,121 @@ sub quit { exit; } +sub data { + my $self = shift; + $self->respond(503, "MAIL first"), return 1 unless $self->transaction->sender; + $self->respond(503, "RCPT first"), return 1 unless $self->transaction->recipients; + $self->respond(354, "go ahead"); + my $buffer = ''; + my $size = 0; + my $i = 0; + my $max_size = ($self->config('databytes'))[0] || 0; # this should work in scalar context + my $blocked = ""; + my %matches; + my $header = 1; + my $complete = 0; + + $self->log(6, "max_size: $max_size / size: $size"); + + while () { + $complete++, last if $_ eq ".\r\n"; + $i++; + $self->respond(451, "See http://develooper.com/code/qpsmtpd/barelf.html"), exit + if $_ eq ".\n"; + unless ($max_size and $size > $max_size) { + s/\r\n$/\n/; + $header = 0 if $header and m/^\s*$/; + + if ($header) { + + $matches{"aol.com"} = 1 if m/aol\.com/; + + $blocked = "Your mail looks too much like that SirCam nonsense, please go away" + if $self->transaction->sender->format eq "<>" + and $_ eq "Content-Disposition: Multipart message\n"; + + $blocked = "No List Builder spam for us, thank you." + if m/^From: List Builder /; + + $blocked = q[Don't send W32.Badtrans.B@mm virus to us, please] + if $matches{"aol.com"} and m/^From: .* <_/; + } + + + # Might be klez + m/^Content-type:.*(?:audio|application)/i + and $matches{"klez"}=1; + + # we've seen the Klez signature, we're probably infected + $blocked = q[Take your Klez virus and stuff it! HAND.] + if $matches{"klez"} and m!^TVqQAAMAAAAEAAAA//8AALgAAAAAAAAAQA!; + + $buffer .= $_; + $size += length $_; + } + warn "$$ size is at $size\n" unless ($i % 300); + + alarm $self->config('timeout'); + } + + $self->log(6, "max_size: $max_size / size: $size"); + + # if we get here without seeing a terminator, the connection is + # probably dead. + $self->respond(451, "Incomplete DATA"), return 1 unless $complete; + + $self->respond(550, $blocked),return 1 if $blocked; + $self->respond(552, "Message too big!"),return 1 if $max_size and $size > $max_size; + + + + # these bits inspired by Peter Samuels "qmail-queue wrapper" + pipe(MESSAGE_READER, MESSAGE_WRITER) or fault("Could not create message pipe"), exit; + pipe(ENVELOPE_READER, ENVELOPE_WRITER) or fault("Could not create envelope pipe"), exit; + + my $child = fork(); + + not defined $child and fault(451, "Could not fork"), exit; + + if ($child) { + # Parent + my $oldfh = select(MESSAGE_WRITER); $| = 1; + select(ENVELOPE_WRITER); $| = 1; + select($oldfh); + + close MESSAGE_READER or fault("close msg reader fault"),exit; + close ENVELOPE_READER or fault("close envelope reader fault"), exit; + print MESSAGE_WRITER "Received: from ".$self->connection->remote_info." (HELO ".$self->connection->hello_host . ") [".$self->connection->remote_ip . "]\n"; + print MESSAGE_WRITER " by ".$self->config('me')." (qpsmtpd/".$self->version.") with SMTP; ", scalar gmtime, "Z\n"; + print MESSAGE_WRITER $buffer; + close MESSAGE_WRITER; + + my @rcpt = map { "T" . $_->address } $self->transaction->recipients; + my $from = "F".($self->transaction->sender->address|| "" ); + print ENVELOPE_WRITER "$from\0", join("\0",@rcpt), "\0\0" + or respond(451,"Could not print addresses to queue"),exit; + + close ENVELOPE_WRITER; + waitpid($child, 0); + my $exit_code = $? >> 8; + $exit_code and respond(451, "Unable to queue message ($exit_code)"), exit; + $self->respond(250, "Message queued; it better be worth it."); + } + elsif (defined $child) { + # Child + close MESSAGE_WRITER or die "could not close message writer in parent"; + close ENVELOPE_WRITER or die "could not close envelope writer in parent"; + + open(STDIN, "<&MESSAGE_READER") or die "b1"; + open(STDOUT, "<&ENVELOPE_READER") or die "b2"; + + unless (exec '/var/qmail/bin/qmail-queue') { + die "should never be here!"; + } + } + + return 1; +} + 1; diff --git a/lib/Qpsmtpd/Constants.pm b/lib/Qpsmtpd/Constants.pm index 8e616fa..8deb382 100644 --- a/lib/Qpsmtpd/Constants.pm +++ b/lib/Qpsmtpd/Constants.pm @@ -4,3 +4,13 @@ use constant TRACE => 10; 1; + + +=head1 NAME + +Qpsmtpd::Constants - Constants should be defined here + +=head1 SYNOPSIS + +Not sure if we are going to use this... + diff --git a/lib/Qpsmtpd/TcpServer.pm b/lib/Qpsmtpd/TcpServer.pm index f875f63..0a599c3 100644 --- a/lib/Qpsmtpd/TcpServer.pm +++ b/lib/Qpsmtpd/TcpServer.pm @@ -5,7 +5,7 @@ use base qw(Qpsmtpd); sub start_connection { my $self = shift; - my $remote_host = $ENV{TCPREMOTEHOST} || "[$ENV{TCPREMOTEIP}]"; + my $remote_host = $ENV{TCPREMOTEHOST} || ( $ENV{TCPREMOTEIP} ? "[$ENV{TCPREMOTEIP}]" : "[noip!]"); my $remote_info = $ENV{TCPREMOTEINFO} ? "$ENV{TCPREMOTEINFO}\@$remote_host" : $remote_host; my $remote_ip = $ENV{TCPREMOTEIP}; diff --git a/lib/Qpsmtpd/Transaction.pm b/lib/Qpsmtpd/Transaction.pm index ec16b37..52f5c88 100644 --- a/lib/Qpsmtpd/Transaction.pm +++ b/lib/Qpsmtpd/Transaction.pm @@ -7,7 +7,7 @@ sub start { my $proto = shift; my $class = ref($proto) || $proto; my %args = @_; - my $self = { _rcpt => [] }; + my $self = { _rcpt => [], started => time }; bless ($self, $class); } @@ -17,7 +17,12 @@ sub add_header { sub add_recipient { my $self = shift; + @_ and push @{$self->{_recipients}}, shift; +} +sub recipients { + my $self = shift; + ($self->{_recipients} ? @{$self->{_recipients}} : ()); } sub sender { @@ -27,4 +32,12 @@ sub sender { } +sub add_header_line { + +} + +sub add_body_line { + +} + 1; diff --git a/log/run b/log/run index 80e38d2..06555e6 100755 --- a/log/run +++ b/log/run @@ -1,2 +1,5 @@ #! /bin/sh -exec multilog t s1000000 n20 /var/log/qmail/qpsmtpd +export LOGDIR=./main +mkdir $LOGDIR +exec multilog t s1000000 n20 $LOGDIR + diff --git a/qpsmtpd b/qpsmtpd index ffb4cee..1204755 100755 --- a/qpsmtpd +++ b/qpsmtpd @@ -25,118 +25,6 @@ $qpsmtpd->run(); __END__ -sub data { - respond(503, "MAIL first"), return 1 unless $state{transaction}->{from}; - respond(503, "RCPT first"), return 1 unless $state{transaction}->{rcpt}; - respond(354, "go ahead"); - my $buffer = ''; - my $size = 0; - my $i = 0; - my $max_size = (get_config('databytes'))[0] || 0; - my $blocked = ""; - my %matches; - my $header = 1; - my $complete = 0; - - warn "$$ max_size: $max_size / size: $size" if $TRACE > 5; - - while () { - $complete++, last if $_ eq ".\r\n"; - $i++; - respond(451, "See http://develooper.com/code/qpsmtpd/barelf.html"), exit - if $_ eq ".\n"; - unless ($max_size and $size > $max_size) { - s/\r\n$/\n/; - $header = 0 if $header and m/^\s*$/; - - if ($header) { - - $matches{"aol.com"} = 1 if m/aol\.com/; - - $blocked = "Your mail looks too much like that SirCam nonsense, please go away" - if $state{transaction}->{from}->format eq "<>" - and $_ eq "Content-Disposition: Multipart message\n"; - - $blocked = "No List Builder spam for us, thank you." - if m/^From: List Builder /; - - $blocked = q[Don't send W32.Badtrans.B@mm virus to us, please] - if $matches{"aol.com"} and m/^From: .* <_/; - } - - - # Might be klez - m/^Content-type:.*(?:audio|application)/i - and $matches{"klez"}=1; - - # we've seen the Klez signature, we're probably infected - $blocked = q[Take your Klez virus and stuff it! HAND.] - if $matches{"klez"} and m!^TVqQAAMAAAAEAAAA//8AALgAAAAAAAAAQA!; - - $buffer .= $_; - $size += length $_; - } - warn "$$ size is at $size\n" unless ($i % 300); - - alarm $config{timeout}; - } - - warn "$$ max_size: $max_size / size: $size" if $TRACE > 5; - - # if we get here without seeing a terminator, the connection is - # probably dead. - respond(451, "Incomplete DATA"), return 1 unless $complete; - - respond(550, $blocked),return 1 if $blocked; - respond(552, "Message too big!"),return 1 if $max_size and $size > $max_size; - - # these bits inspired by Peter Samuels "qmail-queue wrapper" - pipe(MESSAGE_READER, MESSAGE_WRITER) or fault("Could not create message pipe"), exit; - pipe(ENVELOPE_READER, ENVELOPE_WRITER) or fault("Could not create envelope pipe"), exit; - - my $child = fork(); - - not defined $child and fault(451, "Could not fork"), exit; - - if ($child) { - # Parent - my $oldfh = select(MESSAGE_WRITER); $| = 1; - select(ENVELOPE_WRITER); $| = 1; - select($oldfh); - - close MESSAGE_READER or fault("close msg reader fault"),exit; - close ENVELOPE_READER or fault("close envelope reader fault"), exit; - print MESSAGE_WRITER "Received: from $state{remote_info} (HELO $state{hello_host}) ($state{remote_ip})\n"; - print MESSAGE_WRITER " by $config{me} (qpsmtpd/$QPsmtpd::VERSION) with SMTP; ", scalar gmtime, " -0000\n"; - print MESSAGE_WRITER $buffer; - close MESSAGE_WRITER; - - my @rcpt = map { "T" . $_->address } @{$state{transaction}->{rcpt}}; - my $from = "F".($state{transaction}->{from}->address|| "" ); - print ENVELOPE_WRITER "$from\0", join("\0",@rcpt), "\0\0" - or respond(451,"Could not print addresses to queue"),exit; - - close ENVELOPE_WRITER; - waitpid($child, 0); - my $exit_code = $? >> 8; - $exit_code and respond(451, "Unable to queue message ($exit_code)"), exit; - respond(250, "Message queued; it better be worth it."); - } - elsif (defined $child) { - # Child - close MESSAGE_WRITER or die "could not close message writer in parent"; - close ENVELOPE_WRITER or die "could not close envelope writer in parent"; - - open(STDIN, "<&MESSAGE_READER") or die "b1"; - open(STDOUT, "<&ENVELOPE_READER") or die "b2"; - - unless (exec '/var/qmail/bin/qmail-queue') { - die "should never be here!"; - } - } - - return 1; -} sub check_rhsbl { my ($rhsbl, $host) = @_;