enable taint checking

git-svn-id: https://svn.perl.org/qpsmtpd/trunk@9 958fd67b-6ff1-0310-b445-bb7760255be9
This commit is contained in:
Ask Bjørn Hansen 2002-01-21 14:24:32 +00:00
parent 9155e06d22
commit 97a9e4d205
2 changed files with 19 additions and 11 deletions

View File

@ -1,8 +1,11 @@
2002/01/21 ask 2002/01/21
assorted fixes; getting dnsbl's to actually work assorted fixes; getting dnsbl's to actually work
fixing the maximum message size (databytes) stuff (thanks for the fixing the maximum message size (databytes) stuff (thanks for the
spot to Andrew Pam <xanni@glasswings.com.au>) spot to Andrew Pam <xanni@glasswings.com.au>)
support and enable taint checking (thanks to Devin Carraway
<qpsmtpd@devin.com>)

25
qpsmtpd
View File

@ -1,4 +1,4 @@
#!/home/perl/bin/perl -w #!/home/perl/bin/perl -Tw
# Copyright (c) 2001 Ask Bjoern Hansen. See the LICENSE file for details. # Copyright (c) 2001 Ask Bjoern Hansen. See the LICENSE file for details.
# The "command dispatch" system is taken from colobus - http://trainedmonkey.com/colobus/ # The "command dispatch" system is taken from colobus - http://trainedmonkey.com/colobus/
# #
@ -23,6 +23,9 @@ BEGIN{$^W=0;}
use Net::DNS; use Net::DNS;
BEGIN{$^W=1;} BEGIN{$^W=1;}
delete $ENV{ENV};
$ENV{PATH} = '/var/qmail/bin';
use vars qw($TRACE); use vars qw($TRACE);
$TRACE = 0; $TRACE = 0;
@ -63,6 +66,11 @@ sub dispatch {
respond(553, $state{dnsbl_blocked}), return 1 respond(553, $state{dnsbl_blocked}), return 1
if $state{dnsbl_blocked} and ($cmd eq "rcpt"); 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}) { if (exists $commands{$cmd}) {
my ($result) = eval "&$cmd"; my ($result) = eval "&$cmd";
warn "$$ $@" if $@; warn "$$ $@" if $@;
@ -85,7 +93,8 @@ sub respond {
sub fault { sub fault {
my ($msg) = shift || "program fault - command not performed"; my ($msg) = shift || "program fault - command not performed";
return respond(451, "Fatal error - " . $msg); print STDERR "$0[$$]: $msg ($!)\n";
return respond(451, "Internal error - try again later - " . $msg);
} }
sub helo { sub helo {
@ -130,11 +139,9 @@ sub mail {
} }
return respond(501, "could not parse your mail from command") unless $from; return respond(501, "could not parse your mail from command") unless $from;
if ($from->format ne "<>") { $from->format ne "<>"
return respond(450, "Could not resolve ". $from->host) unless check_dns($from->host); and !check_dns($from->host)
return respond(450, "Don't like your spam; please go away now.") if $from->host eq "6x6.net"; and return respond(450, "Could not resolve ". $from->host);
}
#warn "$$ getting mail from ",$from->format,"\n" if $TRACE; #warn "$$ getting mail from ",$from->format,"\n" if $TRACE;
respond(250, $from->format . ", sender OK - I always like getting mail from you!"); respond(250, $from->format . ", sender OK - I always like getting mail from you!");
@ -163,8 +170,6 @@ sub rcpt {
$rcpt = (Mail::Address->parse($rcpt))[0]; $rcpt = (Mail::Address->parse($rcpt))[0];
return respond(501, "could not parse recipient") unless $rcpt; return respond(501, "could not parse recipient") unless $rcpt;
return respond(550, "will not relay for ". $rcpt->host) unless check_relay($rcpt->host); return respond(550, "will not relay for ". $rcpt->host) unless check_relay($rcpt->host);
return respond(550, "no such mailbox") if lc $rcpt->address eq 'unicode@perl.org';
return respond(550, "no such mailbox") if lc $rcpt->address eq 'porters@perl.org';
push @{$state{transaction}->{rcpt}}, $rcpt; push @{$state{transaction}->{rcpt}}, $rcpt;
respond(250, $rcpt->format . ", recipient OK"); respond(250, $rcpt->format . ", recipient OK");
} }
@ -319,7 +324,7 @@ sub check_dnsbl {
foreach my $rr ($query->answer) { foreach my $rr ($query->answer) {
$a_record = 1 if $rr->type eq "A"; $a_record = 1 if $rr->type eq "A";
next unless $rr->type eq "TXT"; next unless $rr->type eq "TXT";
warn "got txt record" if $TRACE > 9 warn "got txt record" if $TRACE > 9;
return $rr->txtdata; return $rr->txtdata;
} }
return "Blocked by $dnsbl" if $a_record; return "Blocked by $dnsbl" if $a_record;