enable taint checking
git-svn-id: https://svn.perl.org/qpsmtpd/trunk@9 958fd67b-6ff1-0310-b445-bb7760255be9
This commit is contained in:
parent
9155e06d22
commit
97a9e4d205
5
Changes
5
Changes
@ -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
25
qpsmtpd
@ -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;
|
||||||
|
Loading…
Reference in New Issue
Block a user