diff -a -x CVS -x Root -x Repository -x Tag -x Entries -x Entries.Log -x .svn -x '*.rej' -x '*.orig' -x .cvsignore -N -r -u ./src/daemon/common/commonBlocking.ml ./src/daemon/common/commonBlocking.ml
--- ./src/daemon/common/commonBlocking.ml 2006-04-03 22:35:05.000000000 +0200
+++ ./src/daemon/common/commonBlocking.ml 2006-05-23 20:29:20.000000000 +0200
@@ -19,14 +19,36 @@
open Printf2
+let log_prefix = "[cB]"
+
+let lprintf_nl fmt =
+ lprintf_nl2 log_prefix fmt
+
+let lprintf_n fmt =
+ lprintf2 log_prefix fmt
+
(* list of functions to call when banning changes *)
let update_hooks = ref []
let add_update_hook f =
update_hooks := f :: !update_hooks
-let ip_blocking_list = ref Ip_set.bl_empty
-let web_ip_blocking_list = ref Ip_set.bl_empty
+(* ranges come and go, keep hits separate from ranges *)
+type hit = {
+ mutable hit_reason : string;
+ mutable hit_count : int;
+}
+
+let hits : (Ip.t, hit) Hashtbl.t = Hashtbl.create 13
+
+let hits_reset () = Hashtbl.clear hits
+
+(* list of filenames *)
+let ip_blocking_list : string list ref = ref []
+(* list of url -> filenames associations *)
+let web_ip_blocking_list : (string * string) list ref = ref []
+let merged_ip_blocking_list = ref Ip_set.bl_empty
+
let country_blocking_block = ref false
let country_blocking_list =
Array.create (Array.length Geoip.country_code_array) false
@@ -44,26 +66,58 @@
Geoip.country_name_array.(index))
else None
+let check_ip ip =
+ if Ip.local_ip ip then None else
+ let block = ip_set_hit !merged_ip_blocking_list ip in
+ if block <> None then block else
+ let block = geoip_hit country_blocking_list ip in
+ if block <> None then block else
+ None
+
let update_bans () =
+ merged_ip_blocking_list :=
+ Ip_set.bl_optimize (
+ List.fold_left
+ (fun bl (url, fn) ->
+ try
+ Ip_set.bl_merge bl (Ip_set.load fn)
+ with e ->
+ lprintf_nl "Exception %s while loading web list %s"
+ (Printexc2.to_string e) fn;
+ bl)
+ (List.fold_left
+ (fun bl fn ->
+ try
+ Ip_set.bl_merge bl (Ip_set.load fn)
+ with e ->
+ lprintf_nl "Exception %s while loading local list %s"
+ (Printexc2.to_string e) fn;
+ bl)
+ Ip_set.bl_empty !ip_blocking_list)
+ !web_ip_blocking_list);
Ip.banned :=
(fun ip ->
- if Ip.local_ip ip then None else
- let block = ip_set_hit !web_ip_blocking_list ip in
- if block <> None then block else
- let block = ip_set_hit !ip_blocking_list ip in
- if block <> None then block else
- let block = geoip_hit country_blocking_list ip in
- if block <> None then block else
- None
+ let reason = check_ip ip in
+ (match reason with
+ | None -> ()
+ | Some reason ->
+ (* maybe that could be made optional, if someone minds
+ memory more than block_list output ? *)
+ let entry =
+ try
+ Hashtbl.find hits ip
+ with Not_found ->
+ let entry = { hit_reason = reason; hit_count = 0 } in
+ Hashtbl.add hits ip entry;
+ entry in
+ entry.hit_reason <- reason;
+ entry.hit_count <- entry.hit_count + 1);
+ reason
);
List.iter (fun f -> f ()) !update_hooks
let set_ip_blocking_list filename =
- ip_blocking_list :=
- if filename = "" then
- Ip_set.bl_empty
- else
- Ip_set.load filename;
+ ip_blocking_list := if filename = "" then [] else [filename];
update_bans ()
let set_geoip_dat filename =
@@ -91,25 +145,39 @@
update_bans ()
let _ =
+ let need_updating = ref false in
+ CommonWeb.add_web_before_hook (fun web_infos ->
+ need_updating := false;
+ let new_web_list =
+ List.fold_left (fun l (kind, _, url) ->
+ if kind = "guarding.p2p" then
+ (url,
+ try
+ List.assoc url !web_ip_blocking_list
+ with Not_found -> "") :: l
+ else l) [] web_infos in
+ (* comparing lists that way is probably sufficient but not
+ necessary *)
+ if !web_ip_blocking_list <> new_web_list then begin
+ web_ip_blocking_list := new_web_list;
+ need_updating := true
+ end);
CommonWeb.add_web_kind "guarding.p2p"
"IP blocking lists (ipfilter and guardian v2 formats)"
- (fun _ filename ->
- try
- web_ip_blocking_list :=
- if filename = "" then
- Ip_set.bl_empty
- else
- Ip_set.load filename;
- update_bans ()
- with _ -> ());
+ (fun url filename ->
+ web_ip_blocking_list := List.remove_assoc url !web_ip_blocking_list;
+ if filename <> "" then
+ web_ip_blocking_list := (url, filename) :: !web_ip_blocking_list;
+ need_updating := true);
+ CommonWeb.add_web_after_hook (fun _ ->
+ if !need_updating then update_bans ()
+ );
CommonWeb.add_web_kind "geoip.dat" "IP to country mapping database"
(fun _ filename ->
Geoip.init (Geoip.unpack filename);
update_bans ());
Heap.add_memstat "CommonBlocking" (fun level buf ->
- Printf.bprintf buf " local ranges: %d\n"
- (Ip_set.bl_length !ip_blocking_list);
- Printf.bprintf buf " web ranges: %d\n"
- (Ip_set.bl_length !web_ip_blocking_list)
+ Printf.bprintf buf " ranges: %d\n"
+ (Ip_set.bl_length !merged_ip_blocking_list)
)
diff -a -x CVS -x Root -x Repository -x Tag -x Entries -x Entries.Log -x .svn -x '*.rej' -x '*.orig' -x .cvsignore -N -r -u ./src/daemon/common/commonWeb.ml ./src/daemon/common/commonWeb.ml
--- ./src/daemon/common/commonWeb.ml 2006-05-14 21:09:21.000000000 +0200
+++ ./src/daemon/common/commonWeb.ml 2006-05-23 19:43:14.000000000 +0200
@@ -40,11 +40,19 @@
(*************************************************************************)
let file_kinds = ref []
+let before_hooks = ref []
+let after_hooks = ref []
let add_web_kind kind descr f =
let kind_record = { f = f; description = descr } in
file_kinds := (kind, kind_record) :: !file_kinds
+let add_web_before_hook f =
+ before_hooks := f :: !before_hooks
+
+let add_web_after_hook f =
+ after_hooks := f :: !after_hooks
+
let mldonkey_wget url f =
let module H = Http_client in
let r = {
@@ -154,6 +162,11 @@
(*************************************************************************)
let load_web_infos core_start =
+ List.iter (fun f ->
+ try f !!CommonOptions.web_infos with e ->
+ lprintf_nl "[cWeb] %s before loading web resources"
+ (Printexc2.to_string e)
+ ) !before_hooks;
List.iter (fun (kind, period, url) ->
if (core_start && period = 0) || (period <> 0 && !hours mod period = 0) then
begin
@@ -163,7 +176,12 @@
lprintf_nl "[cWeb] %s while loading %s"
(Printexc2.to_string e) url
end
- ) !!CommonOptions.web_infos
+ ) !!CommonOptions.web_infos;
+ List.iter (fun f ->
+ try f !!CommonOptions.web_infos with e ->
+ lprintf_nl "[cWeb] %s after loading web resources"
+ (Printexc2.to_string e)
+ ) !after_hooks
type rss_feed = {
mutable rss_date : int;
diff -a -x CVS -x Root -x Repository -x Tag -x Entries -x Entries.Log -x .svn -x '*.rej' -x '*.orig' -x .cvsignore -N -r -u ./src/daemon/driver/driverCommands.ml ./src/daemon/driver/driverCommands.ml
--- ./src/daemon/driver/driverCommands.ml 2006-05-23 19:38:26.000000000 +0200
+++ ./src/daemon/driver/driverCommands.ml 2006-05-23 19:46:57.000000000 +0200
@@ -381,7 +381,7 @@
onClick=\\\"parent.fstatus.location.href='submit?q=friend_add+%d'\\\"
onMouseOver=\\\"mOvr(this);\\\"
onMouseOut=\\\"mOut(this);\\\"\\>"
- (if (!counter mod 2 == 0) then "dl-1" else "dl-2") num;
+ (if (!counter mod 2 = 0) then "dl-1" else "dl-2") num;
client_print c o;
if use_html_mods o then
html_mods_td buf ([
@@ -3130,53 +3130,35 @@
"block_list", Arg_none (fun o ->
let buf = o.conn_buf in
+ let counter = ref 0 in
if o.conn_output = HTML then
- List.iter (fun (tablename, l) ->
- html_mods_cntr_init ();
- html_mods_table_header buf tablename "servers" [
- ( "0", "srh br", "Description (" ^ tablename ^ ")", "Description (" ^ tablename ^ ")") ;
- ( "0", "srh", "Hits", "Hits") ;
- ( "0", "srh", "Range", "Range")];
- let nhits, nranges =
- Ip_set.bl_fold_left (fun br (nhits, nranges) ->
- if br.Ip_set.blocking_hits > 0 then begin
- Printf.bprintf buf "\\
"
- (html_mods_cntr ());
- html_mods_td buf [
- ("Description", "sr br", br.Ip_set.blocking_description);
- ("Hits", "sr br", string_of_int br.Ip_set.blocking_hits);
- ("Range", "sr br", Printf.sprintf "%s - %s"
- (Ip.to_string br.Ip_set.blocking_begin)
- (Ip.to_string br.Ip_set.blocking_end))];
- Printf.bprintf buf "\\
";
- end;
- (nhits + br.Ip_set.blocking_hits, nranges + 1)
- ) (0, 0) l in
- Printf.bprintf buf "\\"
- (html_mods_cntr ());
- if nranges > 0 then
- html_mods_td buf [
- ("Total ranges", "sr br", ("Total " ^ string_of_int nranges));
- ("Hits", "sr br", ("Total " ^ string_of_int nhits));
- ("", "sr br", "")]
- else begin
- html_mods_td buf [
- ("no " ^ tablename ^ " loaded", "sr br", "no " ^ tablename ^ " loaded");
- ("", "sr br", "");
- ("", "sr br", "")];
- end;
- Printf.bprintf buf "\\
\\\\";
- ) [
- ("Web blocking list", !CommonBlocking.web_ip_blocking_list);
- ("Local blocking list", !CommonBlocking.ip_blocking_list)]
- else begin
- Printf.bprintf buf "Web blocking list\n";
- Ip_set.print_list buf !CommonBlocking.web_ip_blocking_list;
- Printf.bprintf buf "Local blocking list\n";
- Ip_set.print_list buf !CommonBlocking.ip_blocking_list;
- end;
+ html_mods_table_header buf "block_listTable" "results" [
+ ( "0", "srh", "Name", "IP" ) ;
+ ( "0", "srh", "Name", "Reason" ) ;
+ ( "0", "srh", "Hits", "Number of hits" ) ];
+ let print_hit n ip =
+ let hit = Hashtbl.find CommonBlocking.hits ip in
+ if o.conn_output = HTML then begin
+ Printf.bprintf buf "\\
"
+ (if !counter mod 2 = 0 then "dl-1" else "dl-2");
+ html_mods_td buf [
+ ("", "sr", Ip.to_string ip);
+ ("", "sr", hit.CommonBlocking.hit_reason);
+ ("", "sr", string_of_int hit.CommonBlocking.hit_count) ];
+ Printf.bprintf buf "\\
";
+ incr counter
+ end else
+ Printf.bprintf buf "%s (%d hits): %s\n" (Ip.to_string ip)
+ hit.CommonBlocking.hit_count hit.CommonBlocking.hit_reason;
+ n + hit.CommonBlocking.hit_count in
+ let ips = Hashtbl.fold (fun ip hits acc -> ip :: acc)
+ CommonBlocking.hits [] in
+ (* could sort with something else, like number of hits ? *)
+ let sorted_ips = List.sort Ip.compare ips in
+ let nhits = List.fold_left print_hit 0 sorted_ips in
+ Printf.bprintf buf "%d ranges, %d hits\n" (Ip_set.bl_length !CommonBlocking.merged_ip_blocking_list) nhits;
_s ""
- ), ":\t\t\t\tdisplay the list of blocked IP ranges that were hit";
+ ), ":\t\t\t\tdisplay the list of blocked IPs";
"block_test", Arg_one (fun arg o ->
let ip = Ip.of_string arg in
@@ -3185,4 +3167,9 @@
| Some reason ->
Printf.sprintf "Blocked, %s\n" reason)
), " :\t\t\tcheck whether an IP is blocked";
+
+ "block_reset", Arg_none (fun o ->
+ CommonBlocking.hits_reset ();
+ _s "done"
+ ), ":\t\t\t\tClear blocked IPs list";
]
diff -a -x CVS -x Root -x Repository -x Tag -x Entries -x Entries.Log -x .svn -x '*.rej' -x '*.orig' -x .cvsignore -N -r -u ./src/daemon/driver/driverInteractive.ml ./src/daemon/driver/driverInteractive.ml
--- ./src/daemon/driver/driverInteractive.ml 2006-05-23 19:38:26.000000000 +0200
+++ ./src/daemon/driver/driverInteractive.ml 2006-05-23 19:45:27.000000000 +0200
@@ -1822,8 +1822,6 @@
let runinfo html buf o =
let dis_mess = "disabled, to enable adjust web_infos in downloads.ini for automatic download" in
let ui_user = o.conn_user.ui_user_name in
- let bl_loc = (Ip_set.bl_length !CommonBlocking.ip_blocking_list) in
- let bl_web = (Ip_set.bl_length !CommonBlocking.web_ip_blocking_list) in
let s =
(
"User:\t\t " ^ ui_user
@@ -1842,8 +1840,8 @@
^ "\nServer usage:\t " ^ (if !!enable_servers then "enabled" else "disabled (you are not able to connect to ED2K Servers)")
^ "\nGeoip:\t\t " ^ (if !Geoip.active then "enabled, GeoLite data created by MaxMind, available from http://maxmind.com/"
else dis_mess)
- ^ "\nIP blocking:\t " ^ (if bl_loc = 0 && bl_web = 0 then "no blocking list loaded"
- else Printf.sprintf "local: %d ranges - web: %d ranges" bl_loc bl_web)
+ ^ (Printf.sprintf "\nIP blocking: %d ranges"
+ (Ip_set.bl_length !CommonBlocking.merged_ip_blocking_list))
^ (if Autoconf.magic then
if !Autoconf.magic_works then
Printf.sprintf "\nLibmagic:\t file-type recognition database present"
diff -a -x CVS -x Root -x Repository -x Tag -x Entries -x Entries.Log -x .svn -x '*.rej' -x '*.orig' -x .cvsignore -N -r -u ./src/utils/net/ip_set.ml ./src/utils/net/ip_set.ml
--- ./src/utils/net/ip_set.ml 2006-05-20 01:43:55.000000000 +0200
+++ ./src/utils/net/ip_set.ml 2006-05-23 19:43:14.000000000 +0200
@@ -43,7 +43,6 @@
blocking_description: string;
blocking_begin: Ip.t;
blocking_end: Ip.t;
- mutable blocking_hits: int
}
let store_blocking_descriptions = ref true
@@ -77,12 +76,6 @@
else
(* Be lazy. The optimizer will deal with it. *)
fixup (BL_Range (red, left, br2, (ins right br)))
-(* let newr = {
- blocking_description = br.blocking_description;
- blocking_begin = ip_mini br.blocking_begin br2.blocking_begin;
- blocking_end = ip_maxi br.blocking_end br2.blocking_end;
- blocking_hits = br.blocking_hits + br2.blocking_hits } in
- BL_Range (red, left, newr, right) *)
and fixup bl =
match bl with
@@ -98,25 +91,17 @@
BL_Empty -> BL_Empty
| BL_Range(_, left, v, right) -> BL_Range(false, left, v, right)
-let rec match_ip_aux bl ip =
+let rec match_ip bl ip =
match bl with
BL_Empty -> None
| BL_Range (red, left, br, right) ->
if Ip.compare ip br.blocking_begin < 0 then
- match_ip_aux left ip
+ match_ip left ip
else if Ip.compare ip br.blocking_end > 0 then
- match_ip_aux right ip
+ match_ip right ip
else
Some br
-let match_ip bl ip =
- let m = match_ip_aux bl ip in
- (match m with
- Some br ->
- br.blocking_hits <- br.blocking_hits + 1
- | None -> ());
- m
-
let rec bl_fold_left f acc bl =
match bl with
BL_Empty -> acc
@@ -134,14 +119,12 @@
if Ip.compare br.blocking_begin (Ip.succ pbr.blocking_end) > 0 then
(add_range new_bl pbr, Some br)
else
- let hits_sum = br.blocking_hits + pbr.blocking_hits in
(* next range merge with pending one, does it extend it ? *)
if Ip.compare br.blocking_end pbr.blocking_end > 0 then
- (new_bl, Some { pbr with blocking_end = br.blocking_end;
- blocking_hits = hits_sum })
+ (new_bl, Some { pbr with blocking_end = br.blocking_end })
else
(* no, it doesn't *)
- (new_bl, Some { pbr with blocking_hits = hits_sum })
+ (new_bl, Some pbr)
in
(* start with no current range *)
@@ -151,6 +134,9 @@
None -> new_bl
| Some pbr -> add_range new_bl pbr
+let bl_merge bl1 bl2 =
+ bl_fold_left (fun br acc -> add_range acc br) bl1 bl2
+
let bl_length bl =
bl_fold_left (fun br acc -> acc+1) 0 bl
@@ -164,11 +150,11 @@
last_ip := Some (Ip.succ br.blocking_end)
in bl_fold_left check () bl
-let load_merge bl filename remove =
+let bl_load filename =
let guardian_regexp = Str.regexp "^\\(.*\\): *\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)-\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" in
let ipfilter_regexp = Str.regexp "^\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\) *- *\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\) *, *[0-9]+ *, *\\(.*\\)$" in
- let bl = ref bl in
+ let bl = ref bl_empty in
let nranges = ref 0 in
let error = ref false in
Unix2.tryopen_read filename (fun cin ->
@@ -185,8 +171,7 @@
else
unknown_description;
blocking_begin = Ip.of_string (Str.matched_group 1 line);
- blocking_end = Ip.of_string (Str.matched_group 2 line);
- blocking_hits = 0 } in
+ blocking_end = Ip.of_string (Str.matched_group 2 line) } in
bl := add_range !bl br;
incr nranges
end else
@@ -197,8 +182,7 @@
else
unknown_description;
blocking_begin = Ip.of_string (Str.matched_group 2 line);
- blocking_end = Ip.of_string (Str.matched_group 3 line);
- blocking_hits = 0 } in
+ blocking_end = Ip.of_string (Str.matched_group 3 line) } in
bl := add_range !bl br;
incr nranges
end else
@@ -213,9 +197,9 @@
done
with End_of_file -> ());
if !error then lprint_newline ();
- if remove then (try Sys.remove filename with _ -> ());
let optimized_bl = bl_optimize !bl in
- lprintf_nl "%d ranges loaded - optimized to %d" !nranges (bl_length optimized_bl);
+ lprintf_nl "%d ranges loaded - optimized to %d" !nranges
+ (bl_length optimized_bl);
(* bl_optimizedp optimized_bl;
for i=0 to 999999 do
let random_ip = Ip.of_ints (Random.int 256, Random.int 256, Random.int 256, Random.int 256) in
@@ -226,6 +210,11 @@
done; *)
optimized_bl
+let bl_load_and_remove filename =
+ let bl = bl_load filename in
+ (try Sys.remove filename with _ -> ());
+ bl
+
let load filename =
lprintf_nl "loading %s" filename;
if Sys.file_exists filename then
@@ -244,7 +233,7 @@
let file = Zip.find_entry ic h in
lprintf_nl "%s found in zip file" h;
ignore(Misc.archive_extract filename "zip");
- load_merge bl_empty file.Zip.filename true
+ bl_load_and_remove file.Zip.filename
with Not_found ->
find_in_zip q in
find_in_zip filenames_list
@@ -269,7 +258,7 @@
if String2.check_suffix ext ".bz2" then "bz2" else "gz" in
(try
let s = Misc.archive_extract filename filetype in
- load_merge bl_empty s true
+ bl_load_and_remove s
with e ->
lprintf_nl "Exception %s while extracting from %s"
(Printexc2.to_string e) filename;
@@ -278,7 +267,7 @@
| ".tar.gz" | ".p2p.tar.gz" | ".dat.tar.gz" ->
lprintf_nl "tar files are not (yet) supported, please untar %s" filename;
bl_empty
- | _ -> load_merge bl_empty filename false
+ | _ -> bl_load filename
else
begin
lprintf_nl "file %s not found" filename;
@@ -295,47 +284,34 @@
255, 255, 255, 255 ->
{ blocking_description = unknown_description;
blocking_begin = Ip.of_ints (0, 0, 0, 0);
- blocking_end = Ip.of_ints (255, 255, 255, 255);
- blocking_hits = 0 }
+ blocking_end = Ip.of_ints (255, 255, 255, 255) }
| a, 255, 255, 255 ->
{ blocking_description = unknown_description;
blocking_begin = Ip.of_ints (a, 0, 0, 0);
- blocking_end = Ip.of_ints (a, 255, 255, 255);
- blocking_hits = 0 }
+ blocking_end = Ip.of_ints (a, 255, 255, 255) }
| a, b, 255, 255 ->
{ blocking_description = unknown_description;
blocking_begin = Ip.of_ints (a, b, 0, 0);
- blocking_end = Ip.of_ints (a, b, 255,255);
- blocking_hits = 0 }
+ blocking_end = Ip.of_ints (a, b, 255,255) }
| a, b, c, 255 ->
{ blocking_description = unknown_description;
blocking_begin = Ip.of_ints (a, b, c, 0);
- blocking_end = Ip.of_ints (a, b, c, 255);
- blocking_hits = 0 }
+ blocking_end = Ip.of_ints (a, b, c, 255) }
| _ ->
{ blocking_description = unknown_description;
blocking_begin = h;
- blocking_end = h;
- blocking_hits = 0 } in
+ blocking_end = h } in
of_list_aux q (add_range bl range) in
of_list_aux l BL_Empty
let print_list buf bl =
- let rec print_list_aux bl =
- match bl with
- BL_Empty -> 0
- | BL_Range (red, left, br, right) ->
- let nleft = print_list_aux left in
- if br.blocking_hits > 0 then
- Printf.bprintf buf "%s (%d hits): %s - %s\n"
- br.blocking_description
- br.blocking_hits
- (Ip.to_string br.blocking_begin)
- (Ip.to_string br.blocking_end);
- let nright = print_list_aux right in
- nleft + 1 + nright in
-
- let nranges = print_list_aux bl in
+ let print_range br acc =
+ Printf.bprintf buf "%s: %s - %s\n"
+ br.blocking_description
+ (Ip.to_string br.blocking_begin)
+ (Ip.to_string br.blocking_end);
+ acc+1 in
+ let nranges = bl_fold_left print_range 0 bl in
Printf.bprintf buf "%d ranges\n" nranges
(*