1 (* Copyright 2006 pango *)
3 This file is part of mldonkey.
5 mldonkey is free software; you can redistribute it and/or modify
6 it under the terms of the GNU General Public License as published by
7 the Free Software Foundation; either version 2 of the License, or
8 (at your option) any later version.
10 mldonkey is distributed in the hope that it will be useful,
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 GNU General Public License for more details.
15 You should have received a copy of the GNU General Public License
16 along with mldonkey; if not, write to the Free Software
17 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
22 (* list of functions to call when banning changes *)
23 let update_hooks = ref []
25 let add_update_hook f
=
26 update_hooks := f
:: !update_hooks
28 let ip_blocking_list = ref Ip_set.bl_empty
29 let web_ip_blocking_list = ref Ip_set.bl_empty
30 let country_blocking_block = ref false
31 let country_blocking_list =
32 Array.make
(Array.length
Geoip.country_code_array
) false
34 (* Keep a copy of valid values from !!ip_blocking_countries to
35 check if geoip_hit needs really to compute the country code.
36 If this list is empty, do not call GeoIP *)
37 let country_blocking_string_list_copy = ref []
39 let ip_set_hit bl ip
=
40 match Ip_set.match_blocking_range bl ip
with
42 | Some br
-> Some br
.Ip_set.blocking_description
44 let geoip_hit cbl ip cc
=
47 | None
-> Geoip.get_country_code ip
48 | Some cc
-> if cc
= 0 then Geoip.get_country_code ip
else cc
50 if not
(Geoip.active
()) || !country_blocking_string_list_copy = [] then None
51 else if cbl
.(index) then
52 Some
(Printf.sprintf
"IPs from country %s are currently blocked"
53 Geoip.country_name_array
.(index))
59 if Ip.local_ip ip
then None
else
60 let block = ip_set_hit !web_ip_blocking_list ip
in
61 if block <> None
then block else
62 let block = ip_set_hit !ip_blocking_list ip
in
63 if block <> None
then block else
64 let block = geoip_hit country_blocking_list ip cc
in
65 if block <> None
then block else
68 List.iter
(fun f
-> f
()) !update_hooks
70 let set_ip_blocking_list filename
=
78 let set_geoip_dat filename
=
79 if filename
<> "" then Geoip.init
(Geoip.unpack filename
)
83 let set_ip_blocking_countries cl
=
84 let temp_list = ref [] in
85 let cl = List.map
String.uppercase
cl in
86 Array.fill
country_blocking_list 0
87 (Array.length
country_blocking_list) !country_blocking_block;
89 if cc
= "UNKNOWN" then
91 temp_list := cc
:: !temp_list;
92 country_blocking_list.(0) <- (not
!country_blocking_block)
96 let index = Hashtbl.find
Geoip.country_index cc
in
97 temp_list := cc
:: !temp_list;
98 country_blocking_list.(index) <- (not
!country_blocking_block)
100 lprintf_nl
"Country code %s not found" cc
102 country_blocking_string_list_copy := !temp_list;
105 let set_ip_blocking_countries_block v
=
106 country_blocking_block := v
;
110 CommonWeb.add_web_kind
"guarding.p2p"
111 "IP blocking lists (ipfilter and guardian v2 formats)"
113 web_ip_blocking_list :=
114 if filename
= "" then
117 Ip_set.load filename
;
120 CommonWeb.add_web_kind
"geoip.dat" "IP to country mapping database"
122 Geoip.init
(Geoip.unpack filename
);
126 Heap.add_memstat
"CommonBlocking" (fun level buf
->
127 Printf.bprintf buf
" local ranges: %d\n"
128 (Ip_set.bl_length
!ip_blocking_list);
129 Printf.bprintf buf
" web ranges: %d\n"
130 (Ip_set.bl_length
!web_ip_blocking_list)