perl/DXCIDR.pm

   1 #
   2 # IP Address block list / checker
   3 #
   4 # This is a DXSpider compatible, optional skin over Net::CIDR::Lite
   5 # If Net::CIDR::Lite is not present, then a find will always returns 0
   6 #
   7
   8 package DXCIDR;
   9
  10 use strict;
  11 use warnings;
  12 use 5.16.1;
  13 use DXVars;
  14 use DXDebug;
  15 use DXUtil;
  16 use DXLog;
  17 use IO::File;
  18 use File::Copy;
  19
  20 use Socket qw(AF_INET AF_INET6 inet_pton inet_ntop);
  21
  22 our $active = 0;
  23 our $badipfn = "badip";
  24 my $ipv4;
  25 my $ipv6;
  26 my $count4 = 0;
  27 my $count6 = 0;
  28
  29 sub _fn
  30 {
  31         return localdata($badipfn);
  32 }
  33
  34 sub _read
  35 {
  36         my $suffix = shift;
  37         my $fn = _fn();
  38         $fn .= ".$suffix" if $suffix;
  39         my $fh = IO::File->new($fn);
  40         my @out;
  41         my $ecount;
  42         my $line;
  43
  44
  45         if ($fh) {
  46                 while (<$fh>) {
  47                         chomp;
  48                         ++$line;
  49                         next if /^\s*\#/;
  50                         next unless /[\.:]/;
  51                         next unless $_;
  52                         unless (is_ipaddr($_)) {
  53                                 ++$ecount;
  54                                 LogDbg('err', qq(DXCIDR: $fn line $line: '$_' not an ip address));
  55                                 if ($ecount > 10) {
  56                                         LogDbg('err', qq(DXCIDR: More than 10 errors in $fn at/after line $line: '$_' - INVALID INPUT FILE));
  57                                         return ();
  58                                 }
  59                         }
  60                         push @out, $_;
  61                 }
  62                 $fh->close;
  63         } else {
  64                 LogDbg('err', "DXCIDR: $fn read error ($!)");
  65         }
  66         return @out;
  67 }
  68
  69 sub _load
  70 {
  71         return unless $active;
  72         my $suffix = shift;
  73         my @in = _read($suffix);
  74         return 0 unless @in;
  75         return scalar add(@in);
  76 }
  77
  78 sub _put
  79 {
  80         my $suffix = shift;
  81         my $fn = _fn() . ".$suffix";
  82         my $r = rand;
  83         my $fh = IO::File->new (">$fn.$r");
  84         my $count = 0;
  85         if ($fh) {
  86                 for ($ipv4->list, $ipv6->list) {
  87                         $fh->print("$_\n");
  88                         ++$count;
  89                 }
  90                 move "$fn.$r", $fn;
  91                 LogDbg('cmd', "DXCIDR: put (re-)written $fn");
  92         } else {
  93                 LogDbg('err', "DXCIDR: cannot write $fn.$r $!");
  94         }
  95         return $count;
  96 }
  97
  98 sub append
  99 {
 100         return 0 unless $active;
 101
 102         my $suffix = shift;
 103         my @in = @_;
 104         my @out;
 105
 106         if ($suffix) {
 107                 my $fn = _fn() . ".$suffix";
 108                 my $fh = IO::File->new;
 109                 if ($fh->open("$fn", "a+")) {
 110                         $fh->seek(0, 2);        # belt and braces !!
 111                         print $fh "$_\n" for @in;
 112                         $fh->close;
 113                 } else {
 114                         LogDbg('err', "DXCIDR::append error appending to $fn $!");
 115                 }
 116         } else {
 117                 LogDbg('err', "DXCIDR::append require badip suffix");
 118         }
 119         return scalar @in;
 120 }
 121
 122 sub add
 123 {
 124         return 0 unless $active;
 125         my $count = 0;
 126         my @out;
 127
 128         for my $ip (@_) {
 129                 # protect against stupid or malicious
 130                 next unless is_ipaddr($ip);
 131                 next if $ip =~ /^127\./;
 132                 next if $ip =~ /^::1$/;
 133 #               next if find($ip);
 134                 if ($ip =~ /\./) {
 135                         eval {$ipv4->add_any($ip)};
 136                         if ($@) {
 137                                 push @out, $@;
 138                         } else {
 139                                 ++$count;
 140                                 ++$count4;
 141                         }
 142                 } elsif ($ip =~ /:/) {
 143                         eval {$ipv6->add_any($ip)};
 144                         if ($@) {
 145                                 push @out, $@;
 146                         } else {
 147                                 ++$count;
 148                                 ++$count6;
 149                         }
 150                 } else {
 151                         LogDbg('err', "DXCIDR::add non-ip address '$ip' read");
 152                 }
 153         }
 154         return $count;
 155 }
 156
 157 sub clean_prep
 158 {
 159         return unless $active;
 160
 161         if ($ipv4 && $count4) {
 162                 $ipv4->clean;
 163                 $ipv4->prep_find;
 164         }
 165         if ($ipv6 && $count6) {
 166                 $ipv6->clean;
 167                 $ipv6->prep_find;
 168         }
 169 }
 170
 171 sub _sort
 172 {
 173         my @in;
 174         my @out;
 175         my $c;
 176         for my $i (@_) {
 177                 my @s;
 178
 179                 my @ip = split m|/|, $i;
 180                 if ($ip[0] =~ /:/) {
 181                         @s = map{$_ ? hex($_) : 0} split /:/, $ip[0];
 182                 } else {
 183                         @s = map{$_ ? $_+0 : 0} split /\./, $ip[0];
 184                 }
 185                 while (@s < 8) {
 186                         push @s, 0;
 187                 }
 188 #               my $s = pack "S*", reverse @s;
 189                 my $s = pack "n*", @s;
 190 #               my $s = join ':', map {sprintf "%04d:", $_} @s;
 191 #               push @in, [inet_pton(m|:|?AF_INET6:AF_INET, $ip[0]), @ip];
 192                 push @in, [$s, @ip];
 193         }
 194         @out = sort {$a->[0] cmp $b->[0]} @in;
 195 #       @out = sort {$a->[0] <=> $b->[0]} @in;
 196         return map { "$_->[1]/$_->[2]"} @out;
 197 }
 198
 199 sub list
 200 {
 201         return () unless $active;
 202         my @out;
 203         push @out, $ipv4->list if $count4;
 204         push @out, $ipv6->list if $count6;
 205         return _sort(@out);
 206 }
 207
 208 sub find
 209 {
 210         return 0 unless $active;
 211         return 0 unless $_[0];
 212
 213         if ($_[0] =~ /\./) {
 214                 return $ipv4->find($_[0]) if $count4;
 215         }
 216         return $ipv6->find($_[0]) if $count6;
 217 }
 218
 219 sub init
 220 {
 221         eval { require Net::CIDR::Lite };
 222         if ($@) {
 223                 LogDbg('DXProt', "DXCIDR: load (cpanm) the perl module Net::CIDR::Lite to check for bad IP addresses (or CIDR ranges)");
 224                 return;
 225         }
 226
 227         eval {import Net::CIDR::Lite };
 228         if ($@) {
 229                 LogDbg('DXProt', "DXCIDR: import Net::CIDR::Lite error $@");
 230                 return;
 231         }
 232
 233         $active = 1;
 234
 235         my $fn = _fn();
 236         if (-e $fn) {
 237                 move $fn, "$fn.base";
 238         }
 239
 240         _touch("$fn.local");
 241
 242         reload();
 243
 244 }
 245
 246 sub _touch
 247 {
 248         my $fn = shift;
 249         my $now = time;
 250         local (*TMP);
 251         utime ($now, $now, $fn) || open (TMP, ">>$fn") || LogDbg('err', "DXCIDR::touch: Couldn't touch $fn: $!");
 252 }
 253
 254 sub reload
 255 {
 256         return 0 unless $active;
 257
 258         new();
 259
 260         my $count = 0;
 261         my $files = 0;
 262
 263         LogDbg('DXProt', "DXCIDR::reload reload database" );
 264
 265         my $dir;
 266         opendir($dir, $main::local_data);
 267         while (my $fn = readdir $dir) {
 268                 next unless my ($suffix) = $fn =~ /^badip\.(\w+)$/;
 269                 my $c = _load($suffix);
 270                 LogDbg('DXProt', "DXCIDR::reload: $fn read containing $c ip addresses" );
 271                 $count += $c;
 272                 $files++;
 273         }
 274         closedir $dir;
 275
 276         LogDbg('DXProt', "DXCIDR::reload $count ip addresses found (IPV4: $count4 IPV6: $count6) in $files badip files" );
 277
 278         return $count;
 279 }
 280
 281 sub new
 282 {
 283         return 0 unless $active;
 284
 285         $ipv4 = Net::CIDR::Lite->new;
 286         $ipv6 = Net::CIDR::Lite->new;
 287         $count4 = $count6 = 0;
 288 }
 289
 290 1;