diff --git a/plugins/dnsbl b/plugins/dnsbl index 977424f..b417bd4 100644 --- a/plugins/dnsbl +++ b/plugins/dnsbl @@ -176,44 +176,61 @@ sub hook_connect { my $remote_ip = $self->qp->connection->remote_ip; my $reversed_ip = join('.', reverse(split(/\./, $remote_ip))); - $self->initiate_lookups( \%dnsbl_zones, $reversed_ip ); - - my $message = $self->process_sockets or do { - $self->log(LOGINFO, 'pass'); - return DECLINED; - }; - - return $self->get_reject( $message ); -}; - -sub initiate_lookups { - my ($self, $zones, $reversed_ip) = @_; - -# we queue these lookups in the background and fetch the -# results in the first rcpt handler - my $res = new Net::DNS::Resolver; $res->tcp_timeout(30); $res->udp_timeout(30); - my $sel = IO::Select->new(); - - my $dom; - for my $dnsbl (keys %$zones) { + for my $dnsbl (keys %dnsbl_zones) { # fix to find A records, if the dnsbl_zones line has a second field 20/1/04 ++msp - $dom->{"$reversed_ip.$dnsbl"} = 1; - if (defined($zones->{$dnsbl})) { - $self->log(LOGDEBUG, "Checking $reversed_ip.$dnsbl for A record in the background"); - $sel->add($res->bgsend("$reversed_ip.$dnsbl")); + my $query; + if ( defined $dnsbl_zones{$dnsbl} ) { + $self->log(LOGDEBUG, "Checking $reversed_ip.$dnsbl for A record"); + $query = $res->query("$reversed_ip.$dnsbl"); } else { - $self->log(LOGDEBUG, "Checking $reversed_ip.$dnsbl for TXT record in the background"); - $sel->add($res->bgsend("$reversed_ip.$dnsbl", "TXT")); + $self->log(LOGDEBUG, "Checking $reversed_ip.$dnsbl for TXT record"); + $query = $res->query("$reversed_ip.$dnsbl", "TXT"); + } + + if ( ! $query) { + if ( $res->errorstring ne "NXDOMAIN" ) { + $self->log(LOGERROR, "$dnsbl query failed: ", $res->errorstring); + }; + next; + }; + + my $a_record = 0; + my $result; + foreach my $rr ($query->answer) { + if ( $rr->type eq 'A' ) { + $result = $rr->name; + $self->log(LOGDEBUG, "found A for $result with IP " . $rr->address); + } + elsif ($rr->type eq 'TXT') { + $self->log(LOGDEBUG, "found TXT, " . $rr->txtdata); + $result = $rr->txtdata; + }; + + next if ! $result; + + if ( ! $dnsbl ) { ($dnsbl) = ($result =~ m/(?:\d+\.){4}(.*)/); }; + if ( ! $dnsbl ) { $dnsbl = $result; }; + + if ($a_record) { + if (defined $dnsbl_zones{$dnsbl}) { + my $smtp_msg = $dnsbl_zones{$dnsbl}; + $smtp_msg =~ s/%IP%/$remote_ip/g; + return $self->get_reject( $smtp_msg, $dnsbl ); + } + return $self->get_reject( "Blocked by $dnsbl" ); + } + + return $self->get_reject( $result, $dnsbl ); } } - $self->connection->notes('dnsbl_sockets', $sel); - $self->connection->notes('dnsbl_domains', $dom); + $self->log(LOGINFO, 'pass'); + return DECLINED; }; sub is_set_rblsmtpd { @@ -236,7 +253,7 @@ sub is_set_rblsmtpd { }; sub ip_whitelisted { - my $self = shift; + my ($self) = @_; my $remote_ip = $self->qp->connection->remote_ip; @@ -256,93 +273,6 @@ sub return_env_message { return ( $self->get_reject_type(), join(' ', $msg, $result)); } -sub process_sockets { - my ($self) = @_; - - my $conn = $self->qp->connection; - - return $conn->notes('dnsbl') if $conn->notes('dnsbl'); - - my $sel = $conn->notes('dnsbl_sockets') or return ''; - my $dom = $conn->notes('dnsbl_domains'); - my $remote_ip = $self->qp->connection->remote_ip; - - my %dnsbl_zones = map { (split /:/, $_, 2)[0,1] } $self->qp->config('dnsbl_zones'); - - my $result; - my $res = new Net::DNS::Resolver; - $res->tcp_timeout(30); - $res->udp_timeout(30); - - $self->log(LOGDEBUG, "waiting for dnsbl dns"); - - # don't wait more than 8 seconds here - my @ready = $sel->can_read(8); - - $self->log(LOGDEBUG, "done waiting for dnsbl dns, got ", scalar @ready, " answers ..."); - return '' unless @ready; - - for my $socket (@ready) { - my $query = $res->bgread($socket); - $sel->remove($socket); - undef $socket; - - my $dnsbl; - - if ($query) { - my $a_record = 0; - foreach my $rr ($query->answer) { - my $name = $rr->name; - $self->log(LOGDEBUG, "name $name"); - next unless $dom->{$name}; - $self->log(LOGDEBUG, "name $name was queried"); - $a_record = 1 if $rr->type eq "A"; - ($dnsbl) = ($name =~ m/(?:\d+\.){4}(.*)/) unless $dnsbl; - $dnsbl = $name unless $dnsbl; - next unless $rr->type eq "TXT"; - $self->log(LOGDEBUG, "got txt record"); - $result = $rr->txtdata and last; - } - #$a_record and $result = "Blocked by $dnsbl"; - - if ($a_record) { - if (defined $dnsbl_zones{$dnsbl}) { - $result = $dnsbl_zones{$dnsbl}; - #$result =~ s/%IP%/$ENV{'TCPREMOTEIP'}/g; - $result =~ s/%IP%/$remote_ip/g; - } - else { - # shouldn't get here? - $result = "Blocked by $dnsbl"; - } - } - } - else { - $self->log(LOGERROR, "$dnsbl query failed: ", $res->errorstring) - unless $res->errorstring eq "NXDOMAIN"; - } - - if ($result) { - #kill any other pending I/O - $conn->notes('dnsbl_sockets', undef); - $result = join("\n", $self->qp->config('dnsbl_rejectmsg'), $result); - return $conn->notes('dnsbl', $result); - } - } - - if ($sel->count) { - # loop around if we have dns blacklists left to see results from - return $self->process_sockets(); - } - - # er, the following code doesn't make much sense anymore... - - # if there was more to read; then forget it - $conn->notes('dnsbl_sockets', undef); - - return $conn->notes('dnsbl', $result); -} - sub hook_rcpt { my ($self, $transaction, $rcpt, %param) = @_; @@ -356,11 +286,3 @@ sub hook_rcpt { return DECLINED; } -sub hook_disconnect { - my ($self, $transaction) = @_; - - $self->connection->notes('dnsbl_sockets', undef); - - return DECLINED; -} - diff --git a/plugins/rhsbl b/plugins/rhsbl index 5706f0c..3f08aac 100644 --- a/plugins/rhsbl +++ b/plugins/rhsbl @@ -31,146 +31,111 @@ use warnings; use Qpsmtpd::Constants; sub register { - my ($self, $qp, $denial ) = @_; - if ( defined $denial and $denial =~ /^disconnect$/i ) { - $self->{_rhsbl}->{DENY} = DENY_DISCONNECT; - } - else { - $self->{_rhsbl}->{DENY} = DENY; - } + my ($self, $qp ) = (shift, shift); + + my $denial; + if ( @_ == 1 ) { + $denial = shift; + if ( defined $denial && $denial =~ /^disconnect$/i ) { + $self->{_args}{reject_type} = 'disconnect'; + } + else { + $self->{_args}{reject_type} = 'perm'; + } + } + else { + $self->{_args} = { @_ }; + }; } sub hook_mail { - my ($self, $transaction, $sender, %param) = @_; + my ($self, $transaction, $sender, %param) = @_; return DECLINED if $self->is_immune(); if ($sender->format eq '<>') { - $self->log(LOGINFO, 'skip, null sender'); + $self->log(LOGINFO, 'pass, null sender'); return DECLINED; }; - my %rhsbl_zones = map { (split /\s+/, $_, 2)[0,1] } $self->qp->config('rhsbl_zones'); + my %rhsbl_zones = $self->populate_zones() or return DECLINED; - if ( ! %rhsbl_zones ) { - $self->log(LOGINFO, 'skip, no zones'); - return DECLINED; - }; + my $res = $self->init_resolver(); - my $res = new Net::DNS::Resolver; - my $sel = IO::Select->new(); - my %rhsbl_zones_map = (); - - # Perform any RHS lookups in the background. We just send the query packets - # here and pick up any results in the RCPT handler. - # MTAs gets confused when you reject mail during MAIL FROM: - - push(my @hosts, $sender->host); - #my $helo = $self->qp->connection->hello_host; - #push(@hosts, $helo) if $helo && $helo ne $sender->host; + my @hosts = $sender->host; for my $host (@hosts) { - for my $rhsbl (keys %rhsbl_zones) { - # fix to find TXT records, if the rhsbl_zones line doesn't have second field - if (defined($rhsbl_zones{$rhsbl})) { - $self->log(LOGDEBUG, "Checking $host.$rhsbl for A record in the background"); - $sel->add($res->bgsend("$host.$rhsbl")); - } else { - $self->log(LOGDEBUG, "Checking $host.$rhsbl for TXT record in the background"); - $sel->add($res->bgsend("$host.$rhsbl", "TXT")); - } - $rhsbl_zones_map{"$host.$rhsbl"} = $rhsbl_zones{$rhsbl}; + for my $rhsbl (keys %rhsbl_zones) { + my $query; +# fix to find TXT records, if the rhsbl_zones line doesn't have second field + if (defined($rhsbl_zones{$rhsbl})) { + $self->log(LOGDEBUG, "Checking $host.$rhsbl for A record"); + $query = $res->query("$host.$rhsbl"); + } else { + $self->log(LOGDEBUG, "Checking $host.$rhsbl for TXT record"); + $query = $res->query("$host.$rhsbl", 'TXT'); + } + + if ( ! $query) { + if ( $res->errorstring ne 'NXDOMAIN' ) { + $self->log(LOGCRIT, "query failed: ", $res->errorstring); + }; + next; + }; + + my $result; + foreach my $rr ($query->answer) { + $self->log(LOGDEBUG, 'got an ' . $rr->type . ' record ' . $rr->name); + if ($rr->type eq 'A') { + $self->log(LOGDEBUG, "A record found for $result with IP " . $rr->address); + $result = $rr->name; + } + elsif ($rr->type eq 'TXT') { + $result = $rr->txtdata; + $self->log(LOGDEBUG, "TXT record found: " . $rr->txtdata); + }; + + if ( $result ) { + $self->log(LOGINFO, "fail, $result"); + + my $host = $transaction->sender->host; + if ($result =~ /^$host\./ ) { + return $self->get_reject( "Mail from $host rejected because it $result" ); + }; + + my $hello = $self->qp->connection->hello_host; + return $self->get_reject( "Mail from HELO $hello rejected because it $result" ); + }; + } + } } - } - %{$self->{_rhsbl_zones_map}} = %rhsbl_zones_map; - $transaction->notes('rhsbl_sockets', $sel); - - return DECLINED; -} - -sub hook_rcpt { - my ($self, $transaction, $rcpt) = @_; - - my $result = $self->process_sockets or do { $self->log(LOGINFO, "pass"); return DECLINED; - }; - - - if ( defined($self->{_rhsbl_zones_map}{$result}) ) { - my $host = $transaction->sender->host; - if ($result =~ /^$host\./ ) { - return ($self->{_rhsbl}->{DENY}, "Mail from $host rejected because it " . $self->{_rhsbl_zones_map}{$result}); - } else { - my $hello = $self->qp->connection->hello_host; - return ($self->{_rhsbl}->{DENY}, "Mail from HELO $hello rejected because it " . $self->{_rhsbl_zones_map}{$result}); - } - } - return ($self->{_rhsbl}->{DENY}, $result); } -sub process_sockets { - my ($self) = @_; - my $trans = $self->transaction; - my $result = ''; +sub populate_zones { + my $self = shift; - return $trans->notes('rhsbl') if $trans->notes('rhsbl'); + my %rhsbl_zones + = map { (split /\s+/, $_, 2)[0,1] } + $self->qp->config('rhsbl_zones'); - my $res = new Net::DNS::Resolver; - my $sel = $trans->notes('rhsbl_sockets') or return ''; + if ( ! keys %rhsbl_zones ) { + $self->log(LOGINFO, 'pass, no zones'); + return; + }; - $self->log(LOGDEBUG, 'waiting for rhsbl dns'); + return %rhsbl_zones; +}; - # don't wait more than 8 seconds here - my @ready = $sel->can_read(8); - - $self->log(LOGDEBUG, 'DONE waiting for rhsbl dns, got ' , scalar @ready, ' answers ...') ; - return '' unless @ready; - - for my $socket (@ready) { - my $query = $res->bgread($socket); - $sel->remove($socket); - undef $socket; - - if ($query) { - foreach my $rr ($query->answer) { - $self->log(LOGDEBUG, 'got an ' . $rr->type . ' record ' . $rr->name); - if ($rr->type eq 'A') { - $result = $rr->name; - $self->log(LOGDEBUG, "A record found for $result with IP " . $rr->address); - last; - } elsif ($rr->type eq 'TXT') { - $result = $rr->txtdata; - $self->log(LOGDEBUG, "TXT record found: " . $rr->txtdata); - last; - } - } - } else { - $self->log(LOGCRIT, "query failed: ", $res->errorstring) unless $res->errorstring eq 'NXDOMAIN'; - } - - if ($result) { - #kill any other pending I/O - $trans->notes('rhsbl_sockets', undef); - return $trans->notes('rhsbl', $result); - } - } - - if ($sel->count) { - # loop around if we have dns results left - return $self->process_sockets(); - } - - # if there was more to read; then forget it - $trans->notes('rhsbl_sockets', undef); - - return $trans->notes('rhsbl', $result); -} - -sub hook_disconnect { - my ($self, $transaction) = @_; - - $transaction->notes('rhsbl_sockets', undef); - return DECLINED; -} +sub init_resolver { + my $self = shift; + return $self->{_resolver} if $self->{_resolver}; + $self->log( LOGDEBUG, "initializing Net::DNS::Resolver"); + $self->{_resolver} = Net::DNS::Resolver->new(dnsrch => 0); + my $timeout = $self->{_args}{timeout} || 8; + $self->{_resolver}->tcp_timeout($timeout); + $self->{_resolver}->udp_timeout($timeout); + return $self->{_resolver}; +};