Pastebin launched a little side project called VERYVIRAL.com, check it out ;-) Want more features on Pastebin? Sign Up, it's FREE!
Guest

BlockCountries V1.4

By: a guest on Nov 8th, 2010  |  syntax: None  |  size: 34.47 KB  |  views: 826  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. #!/usr/bin/perl
  2. #
  3. # BlockCountries     Block IP traffic from specified countries
  4. #
  5. # chkconfig: 2345 10 92
  6. # description:  Blocks IP traffic from IP addresses assigned to specific countries
  7. #
  8.  
  9. use strict;
  10. use warnings;
  11.  
  12. # Version 1.4
  13. #
  14. # Copyright (c) 2010 Timothe Litt, litt__at__acm_dot_org
  15. #  All rights reserved.
  16. #
  17. # This software is licensed under the terms of the Perl
  18. # Artistic License (see http://dev.perl.org/licenses/artistic.html).
  19. #
  20. # This is free software - it works for me, and it may (or may not)
  21. # work for you.  No warranty or support is provided.
  22. #
  23. # Consider carefully whether you want to use this software
  24. # and the full consequences to your site and/or business.
  25. #
  26. # This is written as a technical means to assist in implementing
  27. # your policy.  The author expressly disclaims any responsibility
  28. # for the consequences of using this software.
  29.  
  30. ### Block all traffic from specified countries. ###
  31. #
  32. # See Usage() for documentation
  33. #
  34.  
  35. # List of country codes - specify yours in the config file
  36.  
  37. my @DEFAULT_ISO = qw /cn kr kp kz ru/;
  38.  
  39. # Local configuration
  40.  
  41. my $IPT = '/sbin/iptables';
  42. my $IPTR = '/sbin/iptables-restore';
  43. my $GREP = '/bin/grep';
  44.  
  45. my $CFGFILE = '/etc/sysconfig/BlockCountries';
  46.  
  47. my $ZONEDIR = '/root/blockips';
  48. my $ZONETBL = "$ZONEDIR/tables.ipt";
  49. my $BLOCKURL = 'http://www.ipdeny.com/ipblocks/data/countries';
  50.  
  51. my $LOGPFX = '[Blocked CC]: ';
  52. my $LOG = '/var/log/messages*';  # Note: This is a wildcard to handle log rotation.  .gz files will decompressed on the fly and processed.
  53. my $LOGPGM = 'kernel';
  54. my $IHOOK = 'INPUT-HOOK';       # Note: if this table is not found, INPUT will be used
  55. my $OHOOK = 'OUTPUT-HOOK';      # Note: if this table is not found, OUTPUT will be used
  56. my $FHOOK = 'FORWARD-HOOK';     # Note: if this table is not found, FORWARD will be used
  57. # ### End of configuration
  58.  
  59. # The following are either part of base perl, or available on CPAN
  60.  
  61. use File::Basename;
  62. use File::Path;
  63. use IO::Uncompress::Gunzip;
  64. use Locale::Country;
  65. use LWP::Simple;
  66. use NetAddr::IP;
  67. use Net::Domain;
  68. use Parse::Syslog;
  69. use POSIX;
  70. use Text::ParseWords;
  71.  
  72. # Changelog (Also update revision above!)
  73. # 1.0       Initial development
  74. # 1.1       Add support for hook tables
  75. # 1.2       By unpopular demand, add -permitonly
  76. #           Add logging rate limit
  77. #           Add -dip (deny IP)
  78. # 1.3       Add output filtering (-blockout)
  79. # 1.4       Output filters need to match on destination port.
  80. #           Separate output port overrides as trojans like to ride on well-known ports
  81.  
  82. umask 0137;
  83.  
  84. my $prog = basename $0;
  85.  
  86. # new, old
  87. my @IPCHAINS = ( 'BLOCKCC0', 'BLOCKCC1' );
  88.  
  89. @IPCHAINS = reverse( @IPCHAINS ) if( system( "$IPT -n -L $IPCHAINS[0]-I >/dev/null 2>&1" ) == 0 );
  90. my $IPNEWCHAIN = $IPCHAINS[0];
  91. my $IPOLDCHAIN = $IPCHAINS[1];
  92.  
  93. $IHOOK = 'INPUT' unless( system( "$IPT -n -L $IHOOK >/dev/null 2>&1" ) == 0 );
  94. $OHOOK = 'OUTPUT' unless( system( "$IPT -n -L $OHOOK >/dev/null 2>&1" ) == 0 );
  95. $FHOOK = 'FORWARD' unless( system( "$IPT -n -L $FHOOK >/dev/null 2>&1" ) == 0 );
  96.  
  97. if( -e $CFGFILE ) {
  98.     open( my $fh, '<', $CFGFILE ) or die( "Can't open $CFGFILE:$!" );
  99.     while( <$fh> ) {
  100.         s/\s*#.*$//;
  101.         s/^\s+//;
  102.         s/\s+$//;
  103.         next unless length;
  104.         push @ARGV, parse_line( '\s+', 0, $_ );
  105.     }
  106.     close $fh;
  107. }
  108.  
  109. my $cmd = shift;
  110.  
  111. # Collect all arguments here, even though they are mostly for start
  112. # This allows detailed status
  113.  
  114. my( $debug, $verbose, @iso, %iso, $update, $log, $days, $host, $permitonly, $outrules, @loglimits, @atports, @auports, @atportso, @auportso, @aips, @dips );
  115. @loglimits = ( '1/minute', 10 );
  116.  
  117. while( (my $arg = shift) ) {
  118.     if( $arg =~ /^-/ ) {
  119.         if( $arg eq '-update' ) {
  120.             $update = 1;
  121.             next;
  122.         }
  123.         if( $arg eq '-log' ) {
  124.             $log = 1;
  125.             next;
  126.         }
  127.         if( $arg eq '-limit' && $ARGV[0] ) {
  128.             unless( $ARGV[0] =~ m#(\d+/(?:second|minute|hour|day))(?::(\d+))?# ) {
  129.                 print "Syntax error in -limit\n";
  130.                 exit 1;
  131.             }
  132.             shift;
  133.             $loglimits[0] = $1;
  134.             $loglimits[1] = $2 if( defined $2 );
  135.             next;
  136.         }
  137.         if( $arg eq '-nolimit' ) {
  138.             @loglimits = ();
  139.             next;
  140.         }
  141.         if( $arg eq '-nolog' ) {
  142.             $log = 0;
  143.             next;
  144.         }
  145.         if( $arg eq '-permitonly' ) {
  146.             $permitonly = 1;
  147.             next;
  148.         }
  149.         if( $arg eq '-d' ) {
  150.             $debug = 1;
  151.             next;
  152.         }
  153.         if( $arg eq '-blockout' ) {
  154.             $outrules = 1;
  155.             next;
  156.         }
  157.         if( $arg eq '-v' ) {
  158.             $verbose = 1;
  159.             next;
  160.         }
  161.         if( $arg eq '-days' && $ARGV[0] && $ARGV[0] =~ /^\d+$/ ){
  162.             $days = shift;
  163.             next;
  164.         }
  165.         if( $arg eq '-host' && $ARGV[0] ){
  166.             $host = shift;
  167.             next;
  168.         }
  169.         if( $arg eq '-atport' && $ARGV[0] ){
  170.             $arg = shift;
  171.             if( $arg =~  /^(?:\d+)$/ ) {
  172.                 push @atports, $arg;
  173.                 next;
  174.             }
  175.             my $val = getservbyname( $arg, 'tcp' );
  176.             if( defined $val ) {
  177.                 push @atports, $val;
  178.                 next;
  179.             }
  180.             print "Invalid port $arg\n";
  181.             exit 1;
  182.         }
  183.         if( $arg eq '-auport' && $ARGV[0] ){
  184.             $arg = shift;
  185.             if( $arg =~  /^(?:\d+)$/ ) {
  186.                 push @auports, $arg;
  187.                 next;
  188.             }
  189.             my $val = getservbyname( $arg, 'udp' );
  190.             if( defined $val ) {
  191.                 push @auports, $val;
  192.                 next;
  193.             }
  194.             print "Invalid port $arg\n";
  195.             exit 1;
  196.         }
  197.         if( $arg eq '-atporto' && $ARGV[0] ){
  198.             $arg = shift;
  199.             if( $arg =~  /^(?:\d+)$/ ) {
  200.                 push @atportso, $arg;
  201.                 next;
  202.             }
  203.             my $val = getservbyname( $arg, 'tcp' );
  204.             if( defined $val ) {
  205.                 push @atportso, $val;
  206.                 next;
  207.             }
  208.             print "Invalid port $arg\n";
  209.             exit 1;
  210.         }
  211.         if( $arg eq '-auporto' && $ARGV[0] ){
  212.             $arg = shift;
  213.             if( $arg =~  /^(?:\d+)$/ ) {
  214.                 push @auportso, $arg;
  215.                 next;
  216.             }
  217.             my $val = getservbyname( $arg, 'udp' );
  218.             if( defined $val ) {
  219.                 push @auportso, $val;
  220.                 next;
  221.             }
  222.             print "Invalid port $arg\n";
  223.             exit 1;
  224.         }
  225.         if( $arg eq '-aip' && $ARGV[0] ) {
  226.             if( $ARGV[0] =~ /^\d{1,3}(?:\.\d{1,3}){0,3}(?:\/(?:\d+|(?:\d{1,3}(?:\.\d{1,3}){3})))?$/ ){
  227.                 push @aips, NetAddr::IP->new( shift );
  228.                 next;
  229.             }
  230.             my @h = gethostbyname( $ARGV[0] );
  231.             unless( @h) {
  232.                 print "Unknown host $ARGV[0]\n";
  233.                 exit 1;
  234.             }
  235.             unless( $h[3] == 4 && $#h >= 4 ) {
  236.                 print "$ARGV[0] : not an IPV4 address\n";
  237.                 exit 1;
  238.             }
  239.             for my $a (@h[4..$#h]) {
  240.                 push @aips, NetAddr::IP->new( sprintf( "%vd", $a ) );
  241.             }
  242.             shift;
  243.             next;
  244.         }
  245.         if( $arg eq '-dip' && $ARGV[0] ) {
  246.             if( $ARGV[0] =~ /^\d{1,3}(?:\.\d{1,3}){0,3}(?:\/(?:\d+|(?:\d{1,3}(?:\.\d{1,3}){3})))?$/ ){
  247.                 push @dips, NetAddr::IP->new( shift );
  248.                 next;
  249.             }
  250.             my @h = gethostbyname( $ARGV[0] );
  251.             unless( @h) {
  252.                 print "Unknown host $ARGV[0]\n";
  253.                 exit 1;
  254.             }
  255.             unless( $h[3] == 4 && $#h >= 4 ) {
  256.                 print "$ARGV[0] : not an IPV4 address\n";
  257.                 exit 1;
  258.             }
  259.             for my $a (@h[4..$#h]) {
  260.                 push @dips, NetAddr::IP->new( sprintf( "%vd", $a ) );
  261.             }
  262.             shift;
  263.             next;
  264.         }
  265.         if( $arg eq '-h' || $arg eq '--help' ) {
  266.             Usage();
  267.             exit 0;
  268.         }
  269.         print "Unknown switch $arg";
  270.         print ' ', $ARGV[0] if( defined $ARGV[0] );
  271.         print "\n";
  272.         exit 1;
  273.     }
  274.     if( defined code2country( $arg ) ) {
  275.         $iso{lc $arg} = 1;
  276.     } else {
  277.         my $cc = country2code( $arg );
  278.         if( defined $cc ) {
  279.             $iso{lc $cc} = 1;
  280.         } else {
  281.             print "Unrecognized country/country code: $arg\n";
  282.             exit 1;
  283.         }
  284.     }
  285. }
  286.  
  287. @iso = sort keys %iso;
  288. @iso = @DEFAULT_ISO unless( @iso );
  289.  
  290. my @genlist = $outrules? qw/I O/ : 'I';
  291.  
  292. sub Usage {
  293.     print << "HELP";
  294. IP filter manager for country filters
  295.  
  296. Usage: $prog command args
  297.   status [-v]        Display filter status
  298.                      -v provides configuration from config file
  299.                      and command file - NOT iptables.
  300.   list               List available country names/codes
  301.                        Contacts server for list.
  302.   intercepts [-host name] [-days n]
  303.                      List today\'s intercepts by host (from $LOG)
  304.                      Requires -log
  305.   stop               Stop filtering
  306.   restart  args      Synonym for start (reloads with no open window)
  307.   condrestart args   Restarts only if already running
  308.   start args         Starts filter
  309.  
  310. Start uses tables of IP blocks assigned to country codes that are
  311. stored in $ZONEDIR, which will be created if necessary.  The data
  312. is obtained from $BLOCKURL when needed,
  313. or when start -update is specified.
  314.  
  315. iptables filters are generated and installed by start.  The filters are
  316. optimized and generally will not look identical to the input data.  However
  317. they will match the same address (no more and no fewer.)
  318.  
  319. Arguments for start-class commands are:
  320.  -update            Get latest data for active country codes.
  321.                     Otherwise, only gets data if no local file exists for a CC.
  322.  -log               Install a logging rule to log rejected packets.
  323.  -nolog             Don\'t install a logging rule (default)
  324.  -nolimit           Do not limit logging (can generate huge log files if under attack; not advised)
  325.  -limit spec        Limit logging, default = $loglimits[0]:$loglimits[1] (see man iptables "limit")
  326.  -atport n          Allow connections to TCP port n even FROM banned addresses.
  327.                     May specify any number of times.  May use a service name.
  328.  -auport n          Allow connections to UDP port n even FROM banned addresses.
  329.                     May specify any number of times.  May use a service name.
  330.  -atporto n         Same as -atport, but for connections TO banned addresses.
  331.  -auporto n         Same as -auport, but for connections TO banned addresses.
  332.  -aip ip(\/mask)    Allow connection from an otherwise banned IP address.
  333.                     For a block, specify a netlength or mask. A hostname may
  334.                     also be specified.
  335.  -dip ip(\/mask)     Deny connections from an otherwise allowed IP address.
  336.                     Same syntax as -aip
  337.  -permitonly        Listed countries will be permited, all others denied
  338.  -blockout          Also generate rules to block output & forwarded-output
  339.                     This is probably not required for most applications, and
  340.                     will roughly double the memory requirements.
  341.                     Caution: If you use -blockout for start, you must also use it for stop.
  342.                     This will not be a problem if it\'s in the config file.
  343.  -d                 Output random debugging messages
  344.  -v                 Output extended status/statistics
  345.   CC                ISO Country code or name to ban (as many as you like)
  346.                     Default list:
  347. HELP
  348.     for my $cc (sort @DEFAULT_ISO ) {
  349.         print "                      $cc - ", code2country($cc), "\n";
  350.     }
  351.     print << "HELP";
  352.  
  353. Arguments may also be obtained from $CFGFILE.
  354. Anything (except comments) contained in it is appended to every command line.
  355. Use single or double-quoted strings for country names including spaces.
  356.  
  357. This script is designed to run as a service; chkconfig will link it into
  358. /etc/rcn.d/.
  359.  
  360. This script should also be run with start -update from a cron job - weekly
  361. is suggested - to obtain the latest IP address databases.  If the CRONJOB
  362. environment variable is set, only errors and zone updates will be reported.
  363. This minimizes e-mail from cron.
  364.  
  365. To prevent communications from banned IP addresses during updates,
  366. start will install new rules before removing active rules.  For
  367. this to be effective, you should not stop the service.
  368.  
  369. The status -v command will report the current configuration, although the
  370. actual implementation in iptables will be different due to optimizations.
  371.  
  372. start -v will provide some statistics for the optimizations and generated rules.
  373.  
  374. The intercepts command will parse $LOG and summarize intercepts by IP address.
  375. It will break down the dropped packets by protocol(s) and port(s).  Of course,
  376. logging must be on for this to work.  -days specifys how many days back
  377. (from the current time) to read.  -host specifies the hostname to match.
  378. Default -days is 1, hostname is current host.
  379.  
  380. Credits:
  381.  Some ideas came from http://www.cyberciti.biz/faq/block-entier-country-using-iptables/.
  382.  
  383.  This version of the script merges all the IP address blocks; this saves over 1,000
  384.  rules for the default banned address list.  It\'s also somewhat faster than a shell
  385.  script, and contains a more complete and polished user and system interface.
  386.  
  387. Issues:
  388.  Consider carefully whether you want to use this software and the full consequences
  389.  to your site and\/or business.  By necessity, it will block potential customers and
  390.  'good' connections along with villains.  You must consider the costs and benefits
  391.  to your operation - the author does not endorse any specific policy.  In particular,
  392.  the defaults should be viewed as examples, not value judgements.
  393.  
  394.  If you use selinux (and you should), you may have to create a policy allowing
  395.  $IPTR to access $ZONETBL.
  396.  
  397.  Very large numbers of exception IP blocks might benefit from implementing a subchain
  398.  structure - but that would be a rather different use model.  The known use cases
  399.  would probably be penalized - so one would want to make a dynamic choice.  I\'d
  400.  want to see actual data before implementing this.
  401.  
  402.  The iptables-restore format is undocumented, though used by others.  It may be
  403.  fragile.
  404.  
  405.  This code should use IPTables::IPv4 - but it doesn\'t currently work on my x64 system.
  406.  It may be re-written to do so at some point.
  407.  
  408.  --tlhackque 1-Aug-2010
  409. HELP
  410. }
  411.  
  412. # Success and failure return true and false, and
  413. # print boot-compatible strings (color and aligned
  414. # to column 60 if on a terminal)
  415. # CHA (...G)
  416. # SGR codes used (...m)
  417. # 0 = default; 1 = bold; 31 = green, 32 = red; 1 = bold; 39 = "default" (boot requires)
  418.  
  419. sub success {
  420.     return 1 if( $ENV{CRONJOB} );
  421.  
  422.     if( -t STDOUT ) {
  423.         print "\033[60G[\033[1;32m OK \033[0;39m]\n";
  424.     } else {
  425.         print " [ OK ]\n";
  426.     }
  427.     return 1;
  428. }
  429.  
  430. sub failure {
  431.     return 0 if( $ENV{CRONJOB} );
  432.  
  433.     if( -t STDOUT ) {
  434.         print "\033[60G[\033[1;31m FAILED \033[0;39m]\n";
  435.     } else {
  436.         print " [ FAILED ]\n";
  437.     }
  438.     return 0;
  439. }
  440.  
  441. sub running {
  442.     return system( "$IPT -n -L $IHOOK | $GREP -q -P '^$IPOLDCHAIN-\[IO\]\\s+'" ) == 0;
  443. }
  444.  
  445. sub pport {
  446.     my $p = shift;
  447.     my @p = @_;
  448.  
  449.     printf "  %5u", $p;
  450.     if( @p ) {
  451.         print " $p[0]";
  452.         if( length $p[1] ) {
  453.             print " (", join( '/', split( ' ', $p[1] ) ), ")";
  454.         }
  455.     }
  456.     print "\n";
  457. }
  458.  
  459. sub status {
  460.     if( running ) {
  461.         print "Blocked countries IP filter is running";
  462.         if( $verbose ) {
  463.             printf " and configured to %s:\n", ($permitonly? 'permit only' : 'block');
  464.             for my $cc (sort @iso ) {
  465.                 print " $cc - ", code2country($cc), "\n";
  466.             }
  467.             if( (my $n = @atports + @auports + @atportso + @auportso + @aips + @dips) ) {
  468.                 printf "However, the following exception%s exist:\n", ($n == 1)? ' is' : 's are';
  469.                 if( @atports ) {
  470.                     printf " TCP port%s permitted (input):\n", ((@atports == 1)? '' : 's');
  471.                     for my $p (@atports) {
  472.                         pport( $p,  getservbyport($p, 'tcp') );
  473.                     }
  474.                 }
  475.                 if( @atportso ) {
  476.                     printf " TCP port%s permitted (output):\n", ((@atportso == 1)? '' : 's');
  477.                     for my $p (@atportso) {
  478.                         pport( $p,  getservbyport($p, 'tcp') );
  479.                     }
  480.                 }
  481.                 if( @auports ) {
  482.                     printf " UDP port%s permitted (input):\n", ((@auports == 1)? '' : 's');
  483.                     for my $p (@auports) {
  484.                         pport( $p, getservbyport($p, 'udp') );
  485.                     }
  486.                 }
  487.                 if( @auportso ) {
  488.                     printf " UDP port%s permitted (output):\n", ((@auportso == 1)? '' : 's');
  489.                     for my $p (@auportso) {
  490.                         pport( $p, getservbyport($p, 'udp') );
  491.                     }
  492.                 }
  493.                 if( @aips ) {
  494.                     printf " IP %s permitted:\n", ((@aips == 1)? 'address/network' : 'addresses/networks');
  495.                     for my $ip (@aips) {
  496.                         printf "    $ip\n";
  497.                     }
  498.                 }
  499.                 if( @dips ) {
  500.                     printf " IP %s blocked:\n", ((@dips == 1)? 'address/network' : 'addresses/networks');
  501.                     for my $ip (@dips) {
  502.                         printf "    $ip\n";
  503.                     }
  504.                 }
  505.             }
  506.         } else {
  507.             print "\n";
  508.         }
  509.         return 1;
  510.     }
  511.     print "Blocked countries IP filter is stopped\n";
  512.     return 0;
  513. }
  514.  
  515. sub list {
  516.     my $list = get( $BLOCKURL );
  517.     unless( defined $list ) {
  518.         print "Unable to contact $BLOCKURL for listing\n";
  519.         return 0;
  520.     }
  521.  
  522.     print "Recognized country codes:\n";
  523.     my @ccs = $list =~ /href=['"](..)\.zone["']/gm;
  524.  
  525.     for my $cc (sort @ccs) {
  526.         my $cn = code2country($cc);
  527.         next unless( defined $cn ); # There seem to be some undocumented zones
  528.         printf " $cc - %s\n", $cn
  529.     }
  530.     return 1;
  531. }
  532.  
  533. sub delsubchains {
  534.     my $chain = shift;
  535.  
  536.     # List sub-chains of the form NAME-[IO]-nnn
  537.  
  538.  
  539.     my @schains = map { (m/^($chain-\d+)\s/ ? ( $1, ) : ()) } split( /\n/, `$IPT -n -L $chain 2>/dev/null`);
  540.  
  541.     # Delete each one
  542.     #  First, delete the rule in the main chain that reads '-s 1st octet, goto subchain'
  543.     #  Then empty and delete the subchain
  544.  
  545.     for my $schain (@schains) {
  546.         $schain =~ m/-([IO])-(\d+)$/;
  547.         system( "$IPT -D $chain -" . ($1 eq 'I'? 's' : 'd' ) . " $2.0.0.0/8 -g $schain" );
  548.         system( "$IPT -F $schain" );
  549.         system( "$IPT -X $schain" );
  550.     }
  551. }
  552.  
  553. sub delchainref {
  554.     my $main = shift;  # e.g. INPUT
  555.     my $chain = shift; # e.g. BLOCKchain
  556.     my @crefs = map { (m/^$chain\s/ ? ( $chain, ) : ()) } split( /\n/, `$IPT -n -L $main 2>/dev/null`);
  557.  
  558.     for my $cref (@crefs) { # should be only one
  559.         system( "$IPT -D $main -j $cref" );
  560.     }
  561. }
  562.  
  563. # Sort function for IP addresses for installation into filter chains
  564. # The whole chain must be processed if we miss, so there's nothing we can do.
  565. # But on a hit, we can improve the expected time somewhat by checking the
  566. # largest blocks first.  This corresponds to the smallest mask length.
  567. # It is possible to do better if the traffic pattern is known, but there
  568. # isn't a good way (short of active feedback) to determine it.
  569. # In any case, we reduce the search length by hashing on the first
  570. # octet of the address, so this is a secondary effect.
  571.  
  572. sub ipcmp {
  573.     my $x = $a->masklen <=> $b->masklen;
  574.     return $x if( $x );
  575.     return $a <=> $b;
  576. }
  577.  
  578. sub start {
  579.     print "Starting blocked countries IP filter: " unless( $ENV{CRONJOB} );
  580.  
  581.     File::Path::make_path( $ZONEDIR, { mode => 0771 } ) unless( -d $ZONEDIR );
  582.  
  583.     # Delete any lingering references / parts of new chain
  584.  
  585.     delchainref( $IHOOK, "$IPNEWCHAIN-I" );
  586.  
  587.     delchainref( $OHOOK, "$IPNEWCHAIN-O" );
  588.     delchainref( $FHOOK, "$IPNEWCHAIN-O" );
  589.  
  590.     delsubchains( "$IPNEWCHAIN-I" );
  591.     delsubchains( "$IPNEWCHAIN-O" );
  592.     foreach my $pchain ( @genlist ) {
  593.         system( "$IPT -F $IPNEWCHAIN-$pchain >/dev/null 2>&1" );
  594.         system( "$IPT -X $IPNEWCHAIN-$pchain >/dev/null 2>&1" );
  595.     }
  596.  
  597.     # (Log & ) drop chain
  598.  
  599.     system( "$IPT -F $IPNEWCHAIN-DLOG >/dev/null 2>&1" );
  600.     system( "$IPT -X $IPNEWCHAIN-DLOG >/dev/null 2>&1" );
  601.     return failure unless( system( "$IPT -N $IPNEWCHAIN-DLOG" ) == 0 );
  602.     if( $log ) {
  603.         # Note that we can not provide a per-country log prefix due to compaction.
  604.         # However, the intercepts report will map IPs back to their (alleged) country of origin
  605.         # To determine what countries are causing intercepts, the logs must be post-processed to
  606.         # lookup each IP.
  607.         my $limits = "";
  608.         $limits = "-m limit --limit $loglimits[0] --limit-burst $loglimits[1] " if( @loglimits );
  609.         return failure unless( system( "$IPT -A $IPNEWCHAIN-DLOG $limits-j LOG --log-prefix \"$LOGPFX\"" ) == 0 );
  610.     }
  611.     return failure unless( system( "$IPT -A $IPNEWCHAIN-DLOG -j DROP" ) == 0 );
  612.  
  613.     # Local subnets - external firewalls prevent them from showing up here, but
  614.     # a bogus zone file could do damage.
  615.     unshift @aips, NetAddr::IP->new( '192.168.0.0/16' ), NetAddr::IP->new( '172.16.0.0/12' ), NetAddr::IP->new( '10.0.0.0/8' );
  616.  
  617.     # Optimize  IP lists
  618.     @aips = sort ipcmp NetAddr::IP::Compact( @aips );
  619.     @dips = sort ipcmp NetAddr::IP::Compact( @dips );
  620.  
  621.     # Make sure we have a zone file for each country code
  622.     # Fetch a new one if -update or we don't have one
  623.     # If we fetch, only transfer the file if it's different from (usu. newer than) our copy.
  624.  
  625.     my @files;
  626.     for my $c (@iso) {
  627.         my $db = "$ZONEDIR/$c.zone";
  628.         my $cn = code2country( $c );
  629.         $cn = " ($cn)" if( defined $cn );
  630.  
  631.         # Fetch if updating or have no data
  632.  
  633.         if( $update || ! -f $db || -z $db ) {
  634.             my $rc = mirror( "$BLOCKURL/$c.zone", $db );
  635.             if( is_success( $rc ) ) {
  636.  
  637.                 print "\nUpdated IP zone data for $c$cn", if( $debug || $update || $ENV{CRONJOB} );
  638.                 # Shouldn't ever get an empty file, but may as well check
  639.                 unless( -f $db && -s $db ) {
  640.                     print "\nUpdated zone data for $c$cn is empty!";
  641.                     unlink $db;
  642.                     return failure;
  643.                 }
  644.             } else {
  645.                 if( $rc == RC_NOT_MODIFIED ) { # Can only happen if file exists
  646.                     print "\nNo new IP data available for $c$cn " if( $debug || ($update && !$ENV{CRONJOB}) );
  647.                 } else {
  648.                     print "\nUnable to fetch IP zone data for $c$cn: $rc - ", status_message($rc), " ";
  649.                 }
  650.                 unless( -f $db && -s $db ) {
  651.                     # No data - don't replace current filter
  652.                     print "\nNo IP zone data available for $c$cn ";
  653.                     if( $debug ) {
  654.                         next;
  655.                     }
  656.                     return failure;
  657.                 }
  658.                 # Failed, but have old file, continue since other zones may be updated
  659.             }
  660.         }
  661.         push @files, $db;
  662.     }
  663.  
  664.     return failure unless( @files );
  665.  
  666.  
  667.     # Parse the zone files and create a list of IP blocks
  668.  
  669.     my @addresses = ();
  670.     for my $if (@files) {
  671.         open( my $ifh, '<', $if ) or die( "Can't open $if: $!" );
  672.         while( <$ifh> ) {
  673.             s/\s*#.*$//;
  674.             next unless( length );
  675.             push @addresses, NetAddr::IP->new( $_ );
  676.         }
  677.         close $ifh;
  678.     }
  679.     return failure unless( @addresses );
  680.  
  681.     # Compact the blocks into the minimal covering set
  682.     my $inaddrs = @addresses;
  683.  
  684.     @addresses = sort ipcmp NetAddr::IP::Compact(@addresses);
  685.  
  686.     open( my $fh, '>', $ZONETBL ) or die( "Can't open $ZONETBL: $!" );
  687.     print $fh "# Generated by $prog on ", (scalar localtime), "\n",
  688.               "*filter\n";           # table
  689.  
  690.     my( $exceptions, $xrules ) = (0,0);
  691.     foreach my $pchain ( @genlist ) {
  692.         return failure unless( system( "$IPT -N $IPNEWCHAIN-$pchain" ) == 0 );
  693.         return failure unless( system( "$IPT -A $IPNEWCHAIN-$pchain -m state --state RELATED,ESTABLISHED -j RETURN" ) == 0 );
  694.  
  695.         # List any allowed ports - first since they have a netmask of 0
  696.  
  697.         # Allowed TCP ports - no more than 15 per rule (limit of multiport)
  698.  
  699.         $exceptions += @aips + @dips;
  700.  
  701.         my @ports = ($pchain eq 'I')? @atports : @atportso;
  702.         $exceptions += @ports;
  703.         while( @ports ) {
  704.             my $n = @ports;
  705.             $n = 15 if( $n > 15 );
  706.             return failure unless( system( "$IPT -A $IPNEWCHAIN-$pchain -p tcp -m multiport --dports " . join( ',', @ports[0..$n-1] ) . ' -j RETURN' ) == 0 );
  707.             splice( @ports, 0, $n );
  708.             $xrules++;
  709.         }
  710.  
  711.         # Allowed UDP ports
  712.  
  713.         @ports = ($pchain eq 'I')? @auports : @auportso;
  714.         $exceptions += @ports;
  715.  
  716.         while( @ports ) {
  717.             my $n = @ports;
  718.             $n = 15 if( $n > 15 );
  719.             return failure unless( system( "$IPT -A $IPNEWCHAIN-$pchain -p udp -m multiport --dports " . join( ',', @ports[0..$n-1] ) . ' -j RETURN' ) == 0 );
  720.             splice( @ports, 0, $n );
  721.             $xrules++;
  722.         }
  723.  
  724.         # Allowed IPs (with optional masklen/netmask); largest size first
  725.         #
  726.  
  727.         $xrules += @aips;
  728.         my $match = ($pchain eq 'I' ? 's' : 'd');
  729.         my @ips = @aips;
  730.         while( @ips ) {
  731.             return failure unless( system( "$IPT -A $IPNEWCHAIN-$pchain -$match " . shift( @ips ) . ' -j RETURN' ) == 0 );
  732.         }
  733.  
  734.         # Explicitly blocked IPs
  735.  
  736.         $xrules += @dips;
  737.         @ips = @dips;
  738.         while( @ips ) {
  739.             return failure unless( system( "$IPT -A $IPNEWCHAIN-$pchain -$match " . shift( @ips ) . " -j $IPNEWCHAIN-DLOG" ) == 0 );
  740.         }
  741.  
  742.  
  743.         # Generate iptables-restore data
  744.  
  745.         my %subchains;
  746.  
  747.         # Note: Do not include input hook table declaration as this will clear it
  748.         # It is guaranteed to exist because we checked earlier
  749.  
  750.         if( $pchain eq 'I' ) {
  751.             if( $IHOOK eq 'INPUT' ) {
  752.                 print $fh ":INPUT ACCEPT [0:0]\n"; # built-in chain, policy, counters
  753.             }
  754.         } elsif( $pchain eq 'O' ) {
  755.             if( $OHOOK eq 'OUTPUT' ) {
  756.                 print $fh ":OUTPUT ACCEPT [0:0]\n"; # built-in chain, policy, counters
  757.             }
  758.             if( $FHOOK eq 'FORWARD' ) {
  759.                 print $fh ":FORWARD ACCEPT [0:0]\n"; # built-in chain, policy, counters
  760.             }
  761.         }
  762.  
  763.         foreach my $ipblock (@addresses) {
  764.             $ipblock =~ /^(\d+)\./;
  765.             unless( $subchains{$1} ) {
  766.                 print $fh ":$IPNEWCHAIN-$pchain-$1 - [0:0]\n",    # subchain, no policy, zero counters
  767.                           "-A $IPNEWCHAIN-$pchain -$match $1.0.0.0/8 -g $IPNEWCHAIN-$pchain-$1\n";  # Chain - branch on 1st octet to subchain
  768.             }
  769.             $subchains{$1}++;
  770.             if( $permitonly ) {
  771.                 print $fh "-A $IPNEWCHAIN-$pchain-$1 -$match $ipblock -j RETURN\n"; # Subchain, accept
  772.             } else {
  773.                 print $fh "-A $IPNEWCHAIN-$pchain-$1 -$match $ipblock -j $IPNEWCHAIN-DLOG\n"; # Subchain, branch on match to log & drop
  774.             }
  775.         }
  776.         if( $permitonly ) {
  777.             foreach my $subchain (keys %subchains) {
  778.                 print $fh "-A $IPNEWCHAIN-$pchain-$subchain -j $IPNEWCHAIN-DLOG\n";
  779.             }
  780.         }
  781.  
  782.         if( $verbose && $pchain eq 'I' ) {
  783.             # Statistics are identical for each chain
  784.             my( $minlen, $maxlen );
  785.             $minlen = $maxlen = $subchains{(keys %subchains)[0]};
  786.             for my $s (values %subchains) {
  787.                 $minlen = $s if( $s < $minlen );
  788.                 $maxlen = $s if( $s > $maxlen );
  789.             }
  790.             print( "\n",
  791.                    $inaddrs . ($permitonly? ' permitted' : ' blocked') . " address ranges generated ",
  792.                    (scalar @addresses), " rules, using ",
  793.                    (scalar keys %subchains), " sub-chains.  Savings: ",
  794.                    ($inaddrs - scalar @addresses), " rules (",
  795.                    sprintf( "%.2f", 100*(1- ((scalar @addresses))/$inaddrs)), "%).  Minimum chain length: $minlen",
  796.                    ", Maximum: $maxlen\n" );
  797.         }
  798.     }
  799.  
  800.     print $fh "COMMIT\n",
  801.               "# Completed on ", (scalar localtime), "\n";
  802.     close $fh or die "Close failed for $ZONETBL: $!\n";
  803.  
  804.     if( $verbose ) {
  805.         # Provide some statistics, mostly for debugging.
  806.  
  807.         # Exception statistics
  808.         print( "\n",
  809.                "$exceptions exceptions generated $xrules rules." );
  810.     }
  811.  
  812.     # Install new ruleset
  813.  
  814.     # -- Mass-install new Chain, subchains & rules
  815.     return failure unless( system( "$IPTR -n $ZONETBL" ) == 0 );
  816.  
  817.     # -- Link INPUT to the new chain
  818.     return failure unless( system( "$IPT -I $IHOOK -j $IPNEWCHAIN-I" ) == 0 );
  819.  
  820.     # -- Link OUTPUT and FORWARD to the new chains if we generated them.
  821.  
  822.     if( $outrules ) {
  823.         return failure unless( system( "$IPT -I $OHOOK -j $IPNEWCHAIN-O" ) == 0 );
  824.         return failure unless( system( "$IPT -I $FHOOK -j $IPNEWCHAIN-O" ) == 0 );
  825.     }
  826.  
  827.     # Remove old rules
  828.     delchainref( $IHOOK, "$IPOLDCHAIN-I" );
  829.     delchainref( $OHOOK, "$IPOLDCHAIN-O" );
  830.     delchainref( $FHOOK, "$IPOLDCHAIN-O" );
  831.  
  832.     delsubchains( "$IPOLDCHAIN-I" );
  833.     delsubchains( "$IPOLDCHAIN-O" );
  834.  
  835.     foreach my $pchain ( @genlist ) {
  836.         system( "$IPT -F $IPOLDCHAIN-$pchain >/dev/null 2>&1" );
  837.         system( "$IPT -X $IPOLDCHAIN-$pchain >/dev/null 2>&1" );
  838.     }
  839.  
  840.     system( "$IPT -F $IPOLDCHAIN-DLOG >/dev/null 2>&1" );
  841.     system( "$IPT -X $IPOLDCHAIN-DLOG >/dev/null 2>&1" );
  842.  
  843.     $IPOLDCHAIN = $IPNEWCHAIN;
  844.  
  845.     return success if( running );
  846.  
  847.     return failure;
  848. }
  849.  
  850. sub stop {
  851.     return 1 if( !running );
  852.  
  853.     print "Removing blocked countries IP filter";
  854.  
  855.     delchainref( $IHOOK, "$IPOLDCHAIN-I" );
  856.     delchainref( $OHOOK, "$IPOLDCHAIN-O" );
  857.     delchainref( $FHOOK, "$IPOLDCHAIN-O" );
  858.  
  859.     delsubchains( "$IPOLDCHAIN-I" );
  860.     delsubchains( "$IPOLDCHAIN-O" );
  861.  
  862.     foreach my $pchain ( @genlist ) {
  863.         system( "$IPT -F $IPOLDCHAIN-$pchain" );
  864.         system( "$IPT -X $IPOLDCHAIN-$pchain" );
  865.     }
  866.  
  867.     system( "$IPT -F $IPOLDCHAIN-DLOG" );
  868.     system( "$IPT -X $IPOLDCHAIN-DLOG" );
  869.     if( !running ) {
  870.         success;
  871.         return 1;
  872.     }
  873.     failure;
  874.     return 0;
  875. }
  876.  
  877. sub restart {
  878.     # Don't stop since start will keep the current table alive until
  879.     # the new one is active.
  880.     return start();
  881. }
  882.  
  883. # List intercepted IPs for today
  884. # This can be run in a cron job just before midnight to get a list of
  885. # IPs to report.  Or, you can use -days n to get the last n days worth
  886. # of intercepts
  887. # Only works if logging is on
  888.  
  889. sub intercepts {
  890.     my( $fh, %ips );
  891.  
  892.  
  893.     $days ||= 1;
  894.  
  895.     my $start = time() - ( $days * 24*60*60 );
  896.     $host ||= Net::Domain::hostname();
  897.  
  898.     foreach my $logfile (glob $LOG) {
  899.         my $lh = IO::Uncompress::Gunzip->new( $logfile, MultiStream => 1, Transparent => 1 );
  900.         unless( $lh ) {
  901.             print "Skipping system log file: $IO::Uncompress::Gunzip::GunzipError\n";
  902.             next;
  903.         }
  904.         my $sl = Parse::Syslog->new( $lh, arrayref => 1 );
  905.  
  906.         # Record # intercepts for each ip => protocol => port
  907.  
  908.         while( my $l = $sl->next ) {
  909.             next if( $l->[0] < $start );
  910.             next unless $l->[2] eq $LOGPGM && $l->[1] =~ /$host/i;
  911.             if( $l->[4] =~ /^\Q$LOGPFX\E.*?\bSRC=([0-9.]+).*?\bPROTO=(ICMP)\b.*?\bTYPE=(\d+)/ ) {
  912.                 $ips{$1}{lc $2}{$3}++;
  913.             } elsif( $l->[4] =~ /^\Q$LOGPFX\E.*?\bSRC=([0-9.]+).*?\bPROTO=(\w+).*?\bDPT=(\d+)/ ) {
  914.                 $ips{$1}{lc $2}{$3}++;
  915.             }
  916.         }
  917.  
  918.         close $lh;
  919.     }
  920.  
  921.     return 0 unless %ips;
  922.  
  923.     # List each intercepted IP, its country, the protocols, ports and number of packets for each
  924.  
  925.     print "Intercepts by host IP:\n";
  926.  
  927.     my( %ccip, %ccn );
  928.     foreach (glob "$ZONEDIR/*.zone") {
  929.         /$ZONEDIR\/(.*).zone/;
  930.         my $cc = $1;
  931.         next unless( defined code2country( $cc ) ); # Skip undocumented zone files
  932.         open( my $ifh, '<', $_ ) or next;
  933.         while( <$ifh> ) {
  934.             s/\s*#.*$//;
  935.             next unless( length );
  936.             push @{$ccip{$cc}}, NetAddr::IP->new( $_ );
  937.         }
  938.         close $ifh;
  939.     }
  940.  
  941.     for my $ip (sort map {NetAddr::IP->new($_)} keys %ips) {
  942.         my $ccn;
  943.       CCSEARCH:
  944.         foreach my $cc (keys %ccip) {
  945.             foreach my $cip (@{$ccip{$cc}}) {
  946.                 if( $cip->contains($ip) ) {
  947.                     print "$cc: ";
  948.                     $ccn = $cc;
  949.                     last CCSEARCH;
  950.                 }
  951.             }
  952.         }
  953.         unless( $ccn ) {  # Possible if we've stopped blocking a country but have old log entries
  954.             $ccn = '??';
  955.             print '??: ';
  956.         }
  957.         print $ip->addr;
  958.         my @plist = sort keys %{$ips{$ip->addr}}; # Protocol
  959.         for my $p (@plist) {
  960.             my @rlist = sort keys %{$ips{$ip->addr}{$p}}; # Ports
  961.             print ' ', join( ' ', map { my $n = $ips{$ip->addr}{$p}{$_}; $ccn{$ccn} += $n; "$p-$_($n)" } @rlist );
  962.         }
  963.         print "\n";
  964.     }
  965.  
  966.     print "Intercepts by country:\n";
  967.     for my $cc (sort {$ccn{$b} <=> $ccn{$a} } keys %ccn) {
  968.         my $cn = code2country($cc);
  969.         if( defined $cn ) {
  970.             $cn = "$cc ($cn)";
  971.         } else {
  972.             $cn = $cc;
  973.         }
  974.         printf "%10u %s\n", $ccn{$cc}, $cn;
  975.     }
  976.     return 1;
  977. }
  978.  
  979. if( $cmd eq 'start' ) {
  980.     exit !start();
  981. }
  982. if( $cmd eq 'stop' ) {
  983.     exit !stop();
  984. }
  985. if( $cmd eq 'restart' ) {
  986.     exit !restart();
  987. }
  988. if( $cmd eq 'condrestart' ) {
  989.     exit !(running && restart());
  990. }
  991. if( $cmd eq 'status' ) {
  992.     exit !status();
  993. }
  994. if( $cmd eq 'list' ) {
  995.     exit !list();
  996. }
  997. if( $cmd eq 'intercepts' ) {
  998.     exit !intercepts();
  999. }
  1000. if( $cmd eq 'help' ) {
  1001.     Usage();
  1002.     exit;
  1003. }
  1004. print "Usage: $prog (start|stop|restart|condrestart|status|list|intercepts|help)\n";
  1005. exit 1;