Support comments in configuration files (prefix the line with #)

Support RELAYCLIENT like qmail-smtpd (thanks to Marius Kjeldahl
  <marius@kjeldahl.net>) )


git-svn-id: https://svn.perl.org/qpsmtpd/trunk@15 958fd67b-6ff1-0310-b445-bb7760255be9
This commit is contained in:
Ask Bjørn Hansen 2002-04-21 03:21:23 +00:00
parent 3774269de8
commit f4f1427fb9
2 changed files with 17 additions and 6 deletions

View File

@ -1,3 +1,10 @@
2002/04/20
Support comments in configuration files (prefix the line with #)
Support RELAYCLIENT like qmail-smtpd (thanks to Marius Kjeldahl
<marius@kjeldahl.net>) )
2002/01/26 2002/01/26
Allow [1.2.3.4] for the hostname when checking if the dns resolves Allow [1.2.3.4] for the hostname when checking if the dns resolves

16
qpsmtpd
View File

@ -44,7 +44,7 @@ my $remote_host = $ENV{TCPREMOTEHOST} || "[$ENV{TCPREMOTEIP}]";
$state{remote_info} = $ENV{TCPREMOTEINFO} ? "$ENV{TCPREMOTEINFO}\@$remote_host" : $remote_host; $state{remote_info} = $ENV{TCPREMOTEINFO} ? "$ENV{TCPREMOTEINFO}\@$remote_host" : $remote_host;
$state{remote_ip} = $ENV{TCPREMOTEIP}; $state{remote_ip} = $ENV{TCPREMOTEIP};
$SIG{ALRM} = sub { respond(421, "timeout pal, don't be so slow"); exit }; $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}); $state{dnsbl_blocked} = check_dnsbl($state{remote_ip});
@ -127,7 +127,7 @@ sub mail {
} }
else { else {
my $from_parameter = join " ", @_; my $from_parameter = join " ", @_;
#warn "$$ full from_parameter: $from_parameter\n" if $TRACE; warn "$$ full from_parameter: $from_parameter\n" if $TRACE;
my ($from) = ($from_parameter =~ m/^from:\s*(\S+)/i)[0]; my ($from) = ($from_parameter =~ m/^from:\s*(\S+)/i)[0];
#warn "$$ from email address : $from\n" if $TRACE; #warn "$$ from email address : $from\n" if $TRACE;
if ($from eq "<>") { if ($from eq "<>") {
@ -141,9 +141,9 @@ sub mail {
$from->format ne "<>" $from->format ne "<>"
and get_config("require_resolvable_fromhost") and get_config("require_resolvable_fromhost")
and !check_dns($from->host) and !check_dns($from->host)
and return respond(450, "Could not resolve ". $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; 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!");
$state{transaction} = { from => $from }; $state{transaction} = { from => $from };
@ -340,6 +340,9 @@ sub check_dnsbl {
sub check_dns { sub check_dns {
my $host = shift; my $host = shift;
# for stuff where we can't even parse a hostname out of the address
return 0 unless $host;
return 1 if $host =~ m/^\[(\d{1,3}\.){3}\d{1,3}\]$/; return 1 if $host =~ m/^\[(\d{1,3}\.){3}\d{1,3}\]$/;
my $res = new Net::DNS::Resolver; my $res = new Net::DNS::Resolver;
@ -361,6 +364,7 @@ sub check_dns {
sub check_relay { sub check_relay {
my $host = lc shift; my $host = lc shift;
my @rcpt_hosts = get_config("rcpthosts"); my @rcpt_hosts = get_config("rcpthosts");
return 1 if exists $ENV{RELAYCLIENT};
for my $allowed (@rcpt_hosts) { for my $allowed (@rcpt_hosts) {
$allowed =~ s/^\s*(\S+)/$1/; $allowed =~ s/^\s*(\S+)/$1/;
return 1 if $host eq lc $allowed; return 1 if $host eq lc $allowed;
@ -372,7 +376,7 @@ sub check_relay {
my %config_cache; my %config_cache;
sub get_config { sub get_config {
my $config = shift; my $config = shift;
warn "$$ trying to get config for $config" if $TRACE; warn "$$ trying to get config for $config" if $TRACE > 4;
return @{$config_cache{$config}} if $config_cache{$config}; return @{$config_cache{$config}} if $config_cache{$config};
my $configdir = '/var/qmail/control'; my $configdir = '/var/qmail/control';
my ($name) = ($0 =~ m!(.*?)/([^/]+)$!); my ($name) = ($0 =~ m!(.*?)/([^/]+)$!);
@ -380,7 +384,7 @@ sub get_config {
open CF, "<$configdir/$config" or warn "$$ could not open configfile $config: $!", return; open CF, "<$configdir/$config" or warn "$$ could not open configfile $config: $!", return;
my @config = <CF>; my @config = <CF>;
chomp @config; chomp @config;
@config = grep { $_ } @config; @config = grep { $_ and $_ !~ m/\s*#/ } @config;
close CF; close CF;
warn "$$ returning get_config for $config ",Data::Dumper->Dump([\@config], [qw(config)]) if $TRACE > 4; warn "$$ returning get_config for $config ",Data::Dumper->Dump([\@config], [qw(config)]) if $TRACE > 4;
$config_cache{$config} = \@config; $config_cache{$config} = \@config;