Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
#!/usr/bin/perl # # Take a mail message on STDIN or as a file argument and parse out all # IP addresses in Received: headers. These are then looked up in the # Realtime Black Hole spam filter (or similar service) and if any are # found then the programs prints a 1 to stdout otherwise it returns a # 0 # # Use this in a procmail .procmailrc file like this to filter all # spam into a mailbox # # ISSPAM=`/path/to/rbl-test.pl` # # :0 # * ISSPAM ?? [1-9] # { # # Add a spam detected header # :0 fw # | formail -A "X-Spam: $ISSPAM" # # :0: # spambox # } # # Takes -d to print extra stuff when debugging # # by Nick Craig-Wood <ncw@axis.demon.co.uk> use strict; use Net::DNS; use Getopt::Std; $^W=1; # use this instead of -w to silence wa +rnings from Net::DNS # You can put other servers in here as desired # # The commented out ones are too vicious for my taste - experiment by # all means! my @servers = ( 'blackholes.mail-abuse.org',# reported spammers # 'dialups.mail-abuse.org', # dialup users 'relays.mail-abuse.org', # open relays # 'inputs.orbs.org', # single stage relay filtering # 'outputs.orbs.org', # immediate filtering of multihop rela +ys. # 'delayed-outputs.orbs.org', # delayed immediate filtering of multi +hop relays. ); # Ip addresses we should ignore here - the private ones my $IGNORE = qr{ ^(?: (?: 1 \. ) | (?: 10 \. ) | (?: 172 \. (?:1[6-9]|2\d|3[01]) \. ) | (?: 192 \. 168 \. ) | (?: 0 \. 0 \. 0 \. 0 $ ) | (?: 127 \. 0 \. 0 \. 1 $ ) ) }x; my $opt = {}; getopts("d", $opt); my $DEBUG = $opt->{d}; # Parse the header out of the email joining continued header lines as # necessary and stopping at the end of the header my $header = ""; while (<>) { chomp; last if $_ eq ""; # end of header $header .= "\n" unless /^\s+/; $header .= $_; } $header .= "\n"; # Parse the IP addresses out of the header my $octet = qr{(?:\d|(?:[1-9]|1\d|2[0-4])\d|25[0-5])}; my $ip_addr = qr{$octet\.$octet\.$octet\.$octet}; my %ips; while ($header =~ m/^Received:\s*(.*)$/mg) { my $received = $1; while ($received =~ /\b($ip_addr)(?=\b)/og) { my $ip = $1; if ($ip =~ /$IGNORE/) { print "Ignoring ip '$ip'\n" if $DEBUG; } else { print "Found ip: '$ip'\n" if $DEBUG; $ips{$ip}++; } } } # Now test the ip addresses my @blocked = query_ip_addresses(sort keys %ips); if (@blocked) { print "Blacklisted IP addresses found\n" if $DEBUG; print join(", ", @blocked), "\n"; } else { print "No bad IPs found - all OK\n" if $DEBUG; print "0\n"; } exit(0); ############################################################ # Query the list of IP addresses in parallel # This speeds up the checker greatly ############################################################ sub query_ip_addresses { my (@ip_addresses) = @_; my ($RETRIES) = 2; # try sending each packet this many ti +mes my ($TIMEOUT) = 5; # max time for all queries to come bac +k my ($DTIMEOUT) = 0.1; # time to poll for each query my ($retry_interval) = $TIMEOUT / $RETRIES; my ($i); my (@sock); my @blocked; # Produce a list of input names to look up my (@input) = map { my $revip = join(".", reverse split /\./, $_); map { "$revip.$_." } @servers; } @ip_addresses; my (@desc) = map { my $ip = $_; map { "$ip in $_" } @servers; } @ip_addresses; print "querying:\n", map { " $_\n" } @input if $DEBUG; my ($dns) = new Net::DNS::Resolver; $dns->recurse(1); # Do recurse $dns->dnsrch(0); # Ignore the search list $dns->defnames(0); # Don't append stuff to the end if no +trailing . #$dns->debug(1); # Create the background queries @sock = map { $dns->bgsend($_, "ANY") } @input; my ($retry_at) = $retry_interval; for (my $timeout = 0; $timeout < $TIMEOUT && scalar(grep { $_ } @so +ck); $timeout += $DTIMEOUT) { print "{TRY}\n" if $DEBUG; select(undef, undef, undef, $DTIMEOUT); # sleep for a short tim +e if ($timeout > $retry_at) { # destroy the sockets and remake them for ($i = 0; $i < @sock; $i++) { next unless $sock[$i]; $sock[$i] = undef; # destroy socket $sock[$i] = $dns->bgsend($input[$i], "ANY"); print "{RETRY $input[$i]}\n" if $DEBUG; } $retry_at += $retry_interval; # reset the retry timeer } for ($i = 0; $i < @sock; $i++) { my $sock = $sock[$i]; my $input = $input[$i]; next unless $sock && $dns->bgisready($sock); my $query = $dns->bgread($sock); $sock[$i] = undef; # destroy the socket if ($query) { print "$input[$i] answer received\n" if $DEBUG; foreach my $rr ($query->answer) { next unless $rr->type eq "A"; print "**** Blacklisted IP found $desc[$i] (", $rr- +>type, " => ", $rr->address ,")\n" if $DEBUG; push @blocked, $desc[$i]; } } else { print "query failed: ", $dns->errorstring, "\n" if $DEB +UG; } } } # destroy any unused sockets - these are timeouts for ($i = 0; $i < @sock; $i++) { next unless $sock[$i]; print "Timeout on: $input[$i]\n" if $DEBUG; $sock[$i] = undef; # destroy socket } return @blocked; }

In reply to Spam Filter by ncw

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others studying the Monastery: (18)
    As of 2014-07-22 14:17 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      My favorite superfluous repetitious redundant duplicative phrase is:









      Results (115 votes), past polls