fix set/badip so that it appends to the existing file
[spider.git] / 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
42         if ($fh) {
43                 while (<$fh>) {
44                         chomp;
45                         next if /^\s*\#/;
46                         next unless /[\.:]/;
47                         push @out, $_;
48                 }
49                 $fh->close;
50         } else {
51                 LogDbg('err', "DXCIDR: $fn read error ($!)");
52         }
53         return @out;
54 }
55
56 sub _load
57 {
58         my $suffix = shift;
59         my @in = _read($suffix);
60         return scalar add(@in);
61 }
62
63 sub _put
64 {
65         my $suffix = shift;
66         my $fn = _fn() . ".$suffix";
67         my $r = rand;
68         my $fh = IO::File->new (">$fn.$r");
69         my $count = 0;
70         if ($fh) {
71                 for ($ipv4->list, $ipv6->list) {
72                         $fh->print("$_\n");
73                         ++$count;
74                 }
75                 move "$fn.$r", $fn;
76                 LogDbg('cmd', "DXCIDR: put (re-)written $fn");
77         } else {
78                 LogDbg('err', "DXCIDR: cannot write $fn.$r $!");
79         }
80         return $count;
81 }
82
83 sub append
84 {
85         my $suffix = shift;
86         my @in = @_;
87         my @out;
88         
89         if ($suffix) {
90                 my $fn = _fn() . ".$suffix";
91                 my $fh = IO::File->new;
92                 if ($fh->open("$fn", "a+")) {
93                         $fh->seek(0, 2);        # belt and braces !!
94                         print $fh "$_\n" for @in;
95                         $fh->close;
96                 } else {
97                         LogDbg('err', "DXCIDR::append error appending to $fn $!");
98                 }
99         } else {
100                 LogDbg('err', "DXCIDR::append require badip suffix");
101         }
102         return scalar @in;
103 }
104
105 sub add
106 {
107         my $count = 0;
108         
109         for my $ip (@_) {
110                 # protect against stupid or malicious
111                 next if $ip =~ /^127\./;
112                 next if $ip =~ /^::1$/;
113                 if ($ip =~ /\./) {
114                         $ipv4->add_any($ip);
115                         ++$count;
116                         ++$count4;
117                 } elsif ($ip =~ /:/) {
118                         $ipv6->add_any($ip);
119                         ++$count;
120                         ++$count6;
121                 } else {
122                         LogDbg('err', "DXCIDR::add non-ip address '$ip' read");
123                 }
124         }
125         return $count;
126 }
127
128 sub clean_prep
129 {
130         if ($ipv4 && $count4) {
131                 $ipv4->clean;
132                 $ipv4->prep_find;
133         }
134         if ($ipv6 && $count6) {
135                 $ipv6->clean;
136                 $ipv6->prep_find;
137         }
138 }
139
140 sub _sort
141 {
142         my @in;
143         my @out;
144         for (@_) {
145                 push @in, [inet_pton(m|:|?AF_INET6:AF_INET, $_), split m|/|];
146         }
147         @out = sort {$a->[0] <=> $b->[0]} @in;
148         return map { "$_->[1]/$_->[2]"} @out;
149 }
150
151 sub list
152 {
153         my @out;
154         push @out, $ipv4->list if $count4;
155         push @out, $ipv6->list if $count6;
156         return _sort(@out);
157 }
158
159 sub find
160 {
161         return 0 unless $active;
162         return 0 unless $_[0];
163
164         if ($_[0] =~ /\./) {
165                 return $ipv4->find($_[0]) if $count4;
166         }
167         return $ipv6->find($_[0]) if $count6;
168 }
169
170 sub init
171 {
172         eval { require Net::CIDR::Lite };
173         if ($@) {
174                 LogDbg('DXProt', "DXCIDR: load (cpanm) the perl module Net::CIDR::Lite to check for bad IP addresses (or CIDR ranges)");
175                 return;
176         }
177
178         import Net::CIDR::Lite;
179         $active = 1;
180
181         my $fn = _fn();
182         if (-e $fn) {
183                 move $fn, "$fn.base";
184         }
185
186         _touch("$fn.local");
187         
188         reload();
189
190 }
191
192 sub _touch
193 {
194         my $fn = shift;
195         my $now = time;
196         local (*TMP);
197         utime ($now, $now, $fn) || open (TMP, ">>$fn") || LogDbg('err', "DXCIDR::touch: Couldn't touch $fn: $!");
198 }
199
200 sub reload
201 {
202         new();
203
204         my $count = 0;
205         my $files = 0;
206
207         LogDbg('DXProt', "DXCIDR::reload reload database" );
208
209         my $dir;
210         opendir($dir, $main::local_data);
211         while (my $fn = readdir $dir) {
212                 next unless my ($suffix) = $fn =~ /^badip\.(\w+)$/;
213                 my $c = _load($suffix);
214                 LogDbg('DXProt', "DXCIDR::reload: $fn read containing $c ip addresses" );
215                 $count += $c;
216                 $files++;
217         }
218         closedir $dir;
219         
220         LogDbg('DXProt', "DXCIDR::reload $count ip addresses found (IPV4: $count4 IPV6: $count6) in $files badip files" );
221
222         return $count;
223 }
224
225 sub new
226 {
227         $ipv4 = Net::CIDR::Lite->new;
228         $ipv6 = Net::CIDR::Lite->new;
229         $count4 = $count6 = 0; 
230 }
231
232 1;