PERL   15

checkdbl

Guest on 22nd September 2022 12:19:55 AM

  1. #!/usr/bin/perl
  2. Net::DNS;
  3. use strict;
  4. use warnings;
  5.  
  6. #
  7. # Define the headers and DBL zones we care about.
  8. #
  9. our @headers = qw(from message-id reply-to);
  10. our @zones   = qw(dbl.spamhaus.org multi.surbl.org black.uribl.com);
  11.  
  12. #
  13. # Create our resolver object.
  14. #
  15. our $dns = Net::DNS::Resolver->new(
  16.         udp_timeout  => 2,
  17.         retry        => 2,
  18. );
  19.  
  20. #
  21. # Extract what appears to the right of '@', and verify that
  22. # it is not an IP address; then, query DBLs and return as  
  23. # soon as we get a hit. Do not check additional DBLs once
  24. # a query succeeds.
  25. #
  26. sub querybl {
  27.         return unless /\@([\w.-]+\.[[:alpha:]]+)/;
  28.         my $domain = $1;
  29.         foreach my $zone (@zones) {
  30.                 my $query = $dns->query($domain . "." . ${zone}, "A");
  31.                 if ($query) {
  32.                         foreach my $rr ($query->answer) {
  33.                                 if ($rr->address=~/^127/) {
  34.                                         return ($domain, $zone);
  35.                                 }
  36.                         }
  37.                 }
  38.         }
  39.         return;
  40. }
  41.  
  42. #
  43. # Autoflush standard output.
  44. #
  45. select STDOUT; $|++;
  46.  
  47. #
  48. # Process the headers as Postfix passes them our way,
  49. # one line at a time. For now, also process domain
  50. # names found in Resent-X headers, when X is defined
  51. # in @headers.
  52. #
  53. while (<>) {
  54.         chomp;
  55.         if (/^get\s+(?:resent-)?([\w-]+)\s*:\s*(.+)$/i) {
  56.                 my ($hdr, $data) = ($1, $2);
  57.                 unless(grep(/^$hdr/i, @headers)) {
  58.                         print "200 DUNNO\n";
  59.                         next;
  60.                 }
  61.                 my @res = querybl($data);
  62.                 if (@res) {
  63.                         print "200 REJECT $res[0], which appears in the '$hdr' header, is listed on $res[1]\n";
  64.                         next;
  65.                 }
  66.         }
  67.         print "200 DUNNO\n";
  68. }

Raw Paste


Login or Register to edit or fork this paste. It's free.