Ported to async

git-svn-id: https://svn.perl.org/qpsmtpd/trunk@732 958fd67b-6ff1-0310-b445-bb7760255be9
2007-04-09 22:19:40 +00:00 · 2007-04-09 22:19:40 +00:00 · a87b5b07cc
commit a87b5b07cc
parent 062e73b7bf
1 changed files with 135 additions and 0 deletions
--- a/plugins/async/require_resolvable_fromhost
+++ b/plugins/async/require_resolvable_fromhost
@ -0,0 +1,135 @@
+#!/usr/bin/perl -w
+
+use Qpsmtpd::DSN;
+use ParaDNS;
+use Socket;
+
+my %invalid  = ();
+my $has_ipv6 = Qpsmtpd::Constants::has_ipv6;
+
+sub register {
+    my ( $self, $qp ) = @_;
+    
+    foreach my $i ( $self->qp->config("invalid_resolvable_fromhost") ) {
+        $i =~ s/^\s*//;
+        $i =~ s/\s*$//;
+        if ( $i =~ m#^((\d{1,3}\.){3}\d{1,3})/(\d\d?)# ) {
+            $invalid{$1} = $3;
+        }
+    }
+
+    $self->register_hook( mail => 'hook_mail_start' );
+    $self->register_hook( mail => 'hook_mail_done' );
+}
+
+sub hook_mail_start {
+    my ( $self, $transaction, $sender ) = @_;
+    
+    return DECLINED
+      if ( $self->qp->connection->notes('whitelistclient') );
+
+    if ( $sender ne "<>" ) {
+        
+        unless ( $sender->host ) {
+            # default of addr_bad_from_system is DENY, we use DENYSOFT here to
+            # get the same behaviour as without Qpsmtpd::DSN...
+            return Qpsmtpd::DSN->addr_bad_from_system( DENYSOFT,
+                "FQDN required in the envelope sender" );
+        }
+        
+        $self->check_dns( $sender->host );
+        return YIELD;
+    }
+    
+    return DECLINED;
+}
+
+sub hook_mail_done {
+    my ( $self, $transaction, $sender ) = @_;
+    
+    return DECLINED
+      if ( $self->qp->connection->notes('whitelistclient') );
+
+    if (!$transaction->notes('resolvable_fromhost')) {
+        # default of temp_resolver_failed is DENYSOFT
+        return Qpsmtpd::DSN->temp_resolver_failed(
+            "Could not resolve " . $sender->host );
+    }
+    return DECLINED;
+}
+
+sub check_dns {
+    my ( $self, $host ) = @_;
+    my @host_answers;
+
+    return if $host =~ m/^\[(\d{1,3}\.){3}\d{1,3}\]$/;
+
+    my $qp = $self->qp;
+    
+    my $a_records = [];
+    my $num_queries = $has_ipv6 ? 2 : 1;
+    ParaDNS->new(
+        callback  => sub {
+            my $mx = shift;
+            return if $mx =~ /^[A-Z]+$/; # error
+            my $addr = $mx->[0];
+            $num_queries++;
+            ParaDNS->new(
+                callback => sub { push @$a_records, $_[0] if $_[0] !~ /^[A-Z]+$/; },
+                finished => sub { $num_queries--; $self->finish_up($qp, $a_records) unless $num_queries; },
+                host     => $addr,
+                type     => 'A',
+            );
+            if ($has_ipv6) {
+                $num_queries++;
+                ParaDNS->new(
+                    callback => sub { push @$a_records, $_[0] if $_[0] !~ /^[A-Z]+$/; },
+                    finished => sub { $num_queries--; $self->finish_up($qp, $a_records) unless $num_queries; },
+                    host     => $addr,
+                    type     => 'AAAA',
+                );
+            }
+        },
+        host      => $host,
+        type      => 'MX',
+    );
+    ParaDNS->new(
+        callback  => sub { push @$a_records, $_[0] if $_[0] !~ /^[A-Z]+$/; },
+        finished  => sub { $num_queries--; $self->finish_up($qp, $a_records) unless $num_queries },
+        host      => $host,
+        type      => 'A',
+    );
+    ParaDNS->new(
+        callback  => sub { push @$a_records, $_[0] if $_[0] !~ /^[A-Z]+$/; },
+        finished  => sub { $num_queries--; $self->finish_up($qp, $a_records) unless $num_queries },
+        host      => $host,
+        type      => 'AAAA',
+    ) if $has_ipv6;
+}
+
+sub finish_up {
+    my ($self, $qp, $a_records) = @_;
+    
+    foreach my $addr (@$a_records) {
+        if (is_valid($addr)) {
+            $qp->transaction->notes('resolvable_fromhost', 1);
+            last;
+        }
+    }
+    
+    $qp->run_continuation;
+}
+
+sub is_valid {
+    my $ip = shift;
+    my ( $net, $mask );
+    foreach $net ( keys %invalid ) {
+        $mask = $invalid{$net};
+        $mask = pack "B32", "1" x ($mask) . "0" x ( 32 - $mask );
+        return 0
+          if join( ".", unpack( "C4", inet_aton($ip) & $mask ) ) eq $net;
+    }
+    return 1;
+}
+
+# vim: ts=4 sw=4 expandtab syn=perl