data method; we can now receive mails with this...
git-svn-id: https://svn.perl.org/qpsmtpd/branches/v010@28 958fd67b-6ff1-0310-b445-bb7760255be9
This commit is contained in:
Ask Bjørn Hansen
parent
a7b1d2ade9
commit
bcd0d6d534
5
Changes
5
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)
|
||||
|
||||
|
||||
116
lib/Qpsmtpd.pm
116
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 (<STDIN>) {
|
||||
$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 <notifications\@bcentral.com>/;
|
||||
|
||||
$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;
|
||||
|
||||
@ -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...
|
||||
|
||||
|
||||
@ -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};
|
||||
|
||||
|
||||
@ -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;
|
||||
|
||||
5
log/run
5
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
|
||||
|
||||
|
||||
112
qpsmtpd
112
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 (<STDIN>) {
|
||||
$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 <notifications\@bcentral.com>/;
|
||||
|
||||
$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) = @_;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user