33 |
open CommonNetwork |
open CommonNetwork |
34 |
open CommonOptions |
open CommonOptions |
35 |
open CommonSources |
open CommonSources |
36 |
|
|
37 |
open DonkeyTypes |
open DonkeyTypes |
38 |
open DonkeyGlobals |
open DonkeyGlobals |
39 |
open DonkeyOptions |
open DonkeyOptions |
40 |
open DonkeyMftp |
open DonkeyMftp |
41 |
|
|
42 |
(* |
(* |
43 |
* Store published files. |
* Store published files. |
44 |
*) |
*) |
45 |
|
|
46 |
type peer = |
type peer = |
47 |
{ |
{ |
48 |
peer_md4 : Md4.t; |
peer_md4 : Md4.t; |
49 |
mutable peer_ip : Ip.t; |
mutable peer_ip : Ip.t; |
50 |
mutable peer_port : int; |
mutable peer_port : int; |
54 |
mutable peer_last_send : int; |
mutable peer_last_send : int; |
55 |
} |
} |
56 |
|
|
57 |
type search_kind = |
type search_kind = |
58 |
Search_for_keyword of unit option |
Search_for_keyword of unit option |
59 |
| Search_for_file |
| Search_for_file |
60 |
| Search_for_kind of int |
| Search_for_kind of int |
61 |
|
|
62 |
type t = |
type t = |
63 |
(* KADEMLIA_BOOTSTRAP_REQ *) |
(* KADEMLIA_BOOTSTRAP_REQ *) |
64 |
| OvernetConnect of peer |
| OvernetConnect of peer |
65 |
|
|
66 |
(* KADEMLIA_BOOTSTRAP_RES *) |
(* KADEMLIA_BOOTSTRAP_RES *) |
67 |
| OvernetConnectReply of peer list |
| OvernetConnectReply of peer list |
68 |
|
|
71 |
|
|
72 |
(* KADEMLIA_HELLO_RES *) |
(* KADEMLIA_HELLO_RES *) |
73 |
| OvernetPublicized of peer option |
| OvernetPublicized of peer option |
74 |
|
|
75 |
(* KADEMLIA_REQ *) |
(* KADEMLIA_REQ *) |
76 |
| OvernetSearch of |
| OvernetSearch of |
77 |
(* 2 is OK for most searches, number of replies? *) int * |
(* 2 is OK for most searches, number of replies? *) int * |
78 |
(* searched file or keyword *) Md4.t * |
(* searched file or keyword *) Md4.t * |
79 |
Md4.t option (* Our UID *) |
Md4.t option (* Our UID *) |
80 |
|
|
81 |
(* KADEMLIA_RES *) |
(* KADEMLIA_RES *) |
82 |
| OvernetSearchReply of |
| OvernetSearchReply of |
83 |
Md4.t * |
Md4.t * |
84 |
peer list (* the two closest peers in the binary tree of md4s *) |
peer list (* the two closest peers in the binary tree of md4s *) |
85 |
|
|
86 |
(* KADEMLIA_SEARCH_REQ *) |
(* KADEMLIA_SEARCH_REQ *) |
87 |
| OvernetGetSearchResults of |
| OvernetGetSearchResults of |
88 |
Md4.t * (* target *) |
Md4.t * (* target *) |
89 |
search_kind * (* type *) |
search_kind * (* type *) |
90 |
int * (* min *) |
int * (* min *) |
91 |
int (* max *) |
int (* max *) |
92 |
|
|
93 |
(* The following two messages are encoded in Overnet and Kademlia in the same |
(* The following two messages are encoded in Overnet and Kademlia in the same |
94 |
message, but we prefer to have two different messages at this level, for |
message, but we prefer to have two different messages at this level, for |
95 |
search for files and search for sources. *) |
search for files and search for sources. *) |
96 |
|
|
97 |
(* KADEMLIA_SEARCH_RES *) |
(* KADEMLIA_SEARCH_RES *) |
98 |
| OvernetSearchFilesResults of |
| OvernetSearchFilesResults of |
99 |
(* query *) Md4.t * |
(* query *) Md4.t * |
100 |
(Md4.t * tag list) list (* results *) |
(Md4.t * tag list) list (* results *) |
101 |
|
|
102 |
(* KADEMLIA_SEARCH_RES *) |
(* KADEMLIA_SEARCH_RES *) |
103 |
| OvernetSearchSourcesResults of Md4.t * peer list |
| OvernetSearchSourcesResults of Md4.t * peer list |
104 |
|
|
105 |
(* KADEMLIA_PUBLISH_REQ *) |
(* KADEMLIA_PUBLISH_REQ *) |
106 |
| OvernetPublishFiles of |
| OvernetPublishFiles of |
107 |
(* keyword or file md4 *) Md4.t * |
(* keyword or file md4 *) Md4.t * |
108 |
(* md4 of file or client md4 *) (Md4.t * tag list) list |
(* md4 of file or client md4 *) (Md4.t * tag list) list |
109 |
|
|
110 |
| OvernetPublishSources of |
| OvernetPublishSources of |
111 |
(* keyword or file md4 *) Md4.t * peer list |
(* keyword or file md4 *) Md4.t * peer list |
112 |
|
|
113 |
(* KADEMLIA_PUBLISH_RES *) |
(* KADEMLIA_PUBLISH_RES *) |
140 |
(Md4.to_string p.peer_md4) (Ip.to_string p.peer_ip) p.peer_port |
(Md4.to_string p.peer_md4) (Ip.to_string p.peer_ip) p.peer_port |
141 |
(if p.peer_tcpport <> 0 then Printf.sprintf "tcp = %d" p.peer_tcpport |
(if p.peer_tcpport <> 0 then Printf.sprintf "tcp = %d" p.peer_tcpport |
142 |
else "") p.peer_kind |
else "") p.peer_kind |
143 |
|
|
144 |
let message_to_string t = |
let message_to_string t = |
145 |
let buf = Buffer.create 100 in |
let buf = Buffer.create 100 in |
146 |
begin |
begin |
147 |
match t with |
match t with |
148 |
OvernetConnect p -> |
OvernetConnect p -> |
149 |
Buffer.add_string buf "OvernetConnect\n"; |
Buffer.add_string buf "OvernetConnect\n"; |
150 |
print_peer buf p |
print_peer buf p |
151 |
| OvernetConnectReply peers -> |
| OvernetConnectReply peers -> |
152 |
Buffer.add_string buf "OvernetConnectReply\n"; |
Buffer.add_string buf "OvernetConnectReply\n"; |
153 |
List.iter (print_peer buf) peers |
List.iter (print_peer buf) peers |
154 |
| OvernetPublicize p -> |
| OvernetPublicize p -> |
155 |
Buffer.add_string buf "OvernetPublicize\n"; |
Buffer.add_string buf "OvernetPublicize\n"; |
156 |
print_peer buf p |
print_peer buf p |
157 |
| OvernetPublicized p -> |
| OvernetPublicized p -> |
158 |
Buffer.add_string buf "OvernetPublicized\n"; |
Buffer.add_string buf "OvernetPublicized\n"; |
159 |
(match p with |
(match p with |
160 |
Some p -> print_peer buf p |
Some p -> print_peer buf p |
161 |
| None -> ()) |
| None -> ()) |
162 |
| OvernetSearch (nresults, md4, _) -> |
| OvernetSearch (nresults, md4, _) -> |
163 |
Buffer.add_string buf "OvernetSearch\n"; |
Buffer.add_string buf "OvernetSearch\n"; |
164 |
Printf.bprintf buf " target = %s nresults = %d\n" |
Printf.bprintf buf " target = %s nresults = %d\n" |
165 |
(Md4.to_string md4) nresults |
(Md4.to_string md4) nresults |
166 |
| OvernetSearchReply (target, peers) -> |
| OvernetSearchReply (target, peers) -> |
167 |
Buffer.add_string buf "OvernetSearchReply\n"; |
Buffer.add_string buf "OvernetSearchReply\n"; |
168 |
Printf.bprintf buf " target = %s npeers = %d\n" |
Printf.bprintf buf " target = %s npeers = %d\n" |
169 |
(Md4.to_string target) (List.length peers); |
(Md4.to_string target) (List.length peers); |
170 |
List.iter (print_peer buf) peers |
List.iter (print_peer buf) peers |
171 |
| OvernetGetSearchResults (target, _, _, _) -> |
| OvernetGetSearchResults (target, _, _, _) -> |
172 |
Printf.bprintf buf "OvernetGetSearchResults %s\n" (Md4.to_string target) |
Printf.bprintf buf "OvernetGetSearchResults %s\n" (Md4.to_string target) |
173 |
| OvernetSearchFilesResults (target, results) -> |
| OvernetSearchFilesResults (target, results) -> |
174 |
Printf.bprintf buf "OvernetSearchFilesResults %s\n" |
Printf.bprintf buf "OvernetSearchFilesResults %s\n" |
175 |
(Md4.to_string target); |
(Md4.to_string target); |
176 |
List.iter (fun (r_md4, r_tags) -> |
List.iter (fun (r_md4, r_tags) -> |
177 |
Printf.bprintf buf " %s\n " (Md4.to_string r_md4); |
Printf.bprintf buf " %s\n " (Md4.to_string r_md4); |
178 |
bprint_tags buf r_tags ; |
bprint_tags buf r_tags ; |
179 |
Printf.bprintf buf "\n"; |
Printf.bprintf buf "\n"; |
180 |
) results |
) results |
181 |
| OvernetSearchSourcesResults (target, peers) -> |
| OvernetSearchSourcesResults (target, peers) -> |
182 |
Printf.bprintf buf "OvernetSearchSourcesResults %s\n" |
Printf.bprintf buf "OvernetSearchSourcesResults %s\n" |
183 |
(Md4.to_string target); |
(Md4.to_string target); |
184 |
List.iter (print_peer buf) peers |
List.iter (print_peer buf) peers |
185 |
| OvernetPublishFiles (target, results) -> |
| OvernetPublishFiles (target, results) -> |
186 |
Printf.bprintf buf "OvernetPublish %s\n" |
Printf.bprintf buf "OvernetPublish %s\n" |
187 |
(Md4.to_string target); |
(Md4.to_string target); |
188 |
List.iter (fun (r_md4, r_tags) -> |
List.iter (fun (r_md4, r_tags) -> |
189 |
Printf.bprintf buf " %s\n " (Md4.to_string r_md4); |
Printf.bprintf buf " %s\n " (Md4.to_string r_md4); |
190 |
bprint_tags buf r_tags ; |
bprint_tags buf r_tags ; |
191 |
Printf.bprintf buf "\n"; |
Printf.bprintf buf "\n"; |
192 |
) results |
) results |
193 |
| OvernetPublishSources (target, peers) -> |
| OvernetPublishSources (target, peers) -> |
194 |
Printf.bprintf buf "OvernetPublishSources %s\n" |
Printf.bprintf buf "OvernetPublishSources %s\n" |
195 |
(Md4.to_string target); |
(Md4.to_string target); |
196 |
List.iter (print_peer buf) peers |
List.iter (print_peer buf) peers |
197 |
| OvernetPublished target -> |
| OvernetPublished target -> |
198 |
Printf.bprintf buf "OvernetPublished %s\n" (Md4.to_string target) |
Printf.bprintf buf "OvernetPublished %s\n" (Md4.to_string target) |
199 |
| _ -> |
| _ -> |
200 |
Buffer.add_string buf "unknown\n" |
Buffer.add_string buf "unknown\n" |
201 |
end; |
end; |
202 |
Buffer.contents buf |
Buffer.contents buf |
203 |
|
|
204 |
(* |
(* |
205 |
TODO OVERNET |
TODO OVERNET |
206 |
---- |
---- |
234 |
S 15h (21) : md4 (my MD4) IP (my ip) port (my port UDP) |
S 15h (21) : md4 (my MD4) IP (my ip) port (my port UDP) |
235 |
R 16h (22) : port (his ??? TCP port) |
R 16h (22) : port (his ??? TCP port) |
236 |
*) |
*) |
237 |
|
|
238 |
module XorSet = Set.Make ( |
module XorSet = Set.Make ( |
239 |
struct |
struct |
240 |
type t = Md4.t * peer |
type t = Md4.t * peer |
241 |
let compare (m1,p1) (m2,p2) = |
let compare (m1,p1) (m2,p2) = |
242 |
compare (m1,p1.peer_md4, p1.peer_ip) (m2,p2.peer_md4, p2.peer_ip) |
compare (m1,p1.peer_md4, p1.peer_ip) (m2,p2.peer_md4, p2.peer_ip) |
243 |
end |
end |
244 |
) |
) |
246 |
module XorMd4Set = Set.Make ( |
module XorMd4Set = Set.Make ( |
247 |
struct |
struct |
248 |
type t = Md4.t (* distance *) * Md4.t (* md4 *) |
type t = Md4.t (* distance *) * Md4.t (* md4 *) |
249 |
let compare (m1,p1) (m2,p2) = |
let compare (m1,p1) (m2,p2) = |
250 |
let c = compare m1 m2 in |
let c = compare m1 m2 in |
251 |
if c = 0 then compare p1 p2 else c |
if c = 0 then compare p1 p2 else c |
252 |
end |
end |
258 |
let compare = compare |
let compare = compare |
259 |
end |
end |
260 |
) |
) |
261 |
|
|
262 |
type search_for = |
type search_for = |
263 |
| FileSearch of file |
| FileSearch of file |
264 |
| KeywordSearch of CommonTypes.search |
| KeywordSearch of CommonTypes.search |
265 |
| FillBuckets |
| FillBuckets |
266 |
|
|
267 |
type overnet_search = { |
type overnet_search = { |
268 |
search_md4 : Md4.t; |
search_md4 : Md4.t; |
269 |
mutable search_kind : search_for; |
mutable search_kind : search_for; |
272 |
search_waiting_peers : peer Fifo.t array; |
search_waiting_peers : peer Fifo.t array; |
273 |
search_asked_peers : peer Fifo.t array; |
search_asked_peers : peer Fifo.t array; |
274 |
search_ok_peers : peer Fifo.t array; |
search_ok_peers : peer Fifo.t array; |
275 |
|
|
276 |
mutable search_queries : int; |
mutable search_queries : int; |
277 |
mutable search_requests : int; |
mutable search_requests : int; |
278 |
mutable search_start : int; |
mutable search_start : int; |
279 |
mutable search_results : (Md4.t, tag list) Hashtbl.t; |
mutable search_results : (Md4.t, tag list) Hashtbl.t; |
280 |
mutable search_nresults : int; (* number of results messages *) |
mutable search_nresults : int; (* number of results messages *) |
282 |
} |
} |
283 |
|
|
284 |
exception MessageNotImplemented |
exception MessageNotImplemented |
285 |
|
|
286 |
module Make(Proto: sig |
module Make(Proto: sig |
287 |
|
|
288 |
val enable_overnet : bool Options.option_record |
val enable_overnet : bool Options.option_record |
289 |
val overnet_port : int Options.option_record |
val overnet_port : int Options.option_record |
290 |
val overnet_tcpport : int Options.option_record |
val overnet_tcpport : int Options.option_record |
291 |
val overnet_section : Options.options_section |
val overnet_section : Options.options_section |
292 |
|
|
293 |
val redirector_section : string |
val redirector_section : string |
294 |
val options_section_name : string |
val options_section_name : string |
295 |
val command_prefix : string |
val command_prefix : string |
296 |
val source_brand : bool |
val source_brand : bool |
297 |
|
|
298 |
val udp_send : UdpSocket.t -> Ip.t -> int -> bool -> t -> unit |
val udp_send : UdpSocket.t -> Ip.t -> int -> bool -> t -> unit |
299 |
val udp_handler : (t -> UdpSocket.udp_packet -> unit) -> |
val udp_handler : (t -> UdpSocket.udp_packet -> unit) -> |
300 |
UdpSocket.t -> UdpSocket.event -> unit |
UdpSocket.t -> UdpSocket.event -> unit |
301 |
|
|
302 |
val web_info : string |
val web_info : string |
303 |
end) = struct |
end) = struct |
304 |
|
|
324 |
let max_searches_for_publish = 5 |
let max_searches_for_publish = 5 |
325 |
let max_search_queries = 64 |
let max_search_queries = 64 |
326 |
let max_search_requests = 20 |
let max_search_requests = 20 |
327 |
|
|
328 |
let is_enabled = ref false |
let is_enabled = ref false |
329 |
|
|
330 |
|
|
334 |
|
|
335 |
*********************************************************************) |
*********************************************************************) |
336 |
|
|
337 |
let overnet_store_size = |
let overnet_store_size = |
338 |
define_option overnet_section [Proto.options_section_name; "store_size"] "Size of the filename storage used to answer queries" |
define_option overnet_section [Proto.options_section_name; "store_size"] "Size of the filename storage used to answer queries" |
339 |
int_option 2000 |
int_option 2000 |
340 |
|
|
341 |
let overnet_max_known_peers = |
let overnet_max_known_peers = |
342 |
define_option overnet_section [Proto.options_section_name; "max_known_peers"] |
define_option overnet_section [Proto.options_section_name; "max_known_peers"] |
343 |
"maximal number of peers to keep overnet connected (should be >2048)" |
"maximal number of peers to keep overnet connected (should be >2048)" |
344 |
int_option 8192 |
int_option 8192 |
345 |
|
|
346 |
let overnet_search_keyword = |
let overnet_search_keyword = |
347 |
define_option overnet_section [Proto.options_section_name; "search_keyword"] |
define_option overnet_section [Proto.options_section_name; "search_keyword"] |
348 |
"allow extended search to search on overnet" bool_option true |
"allow extended search to search on overnet" bool_option true |
349 |
|
|
350 |
let overnet_search_timeout = |
let overnet_search_timeout = |
351 |
define_option overnet_section [Proto.options_section_name; "search_timeout"] |
define_option overnet_section [Proto.options_section_name; "search_timeout"] |
352 |
"How long shoud a search on Overnet wait for the last answer before terminating" |
"How long shoud a search on Overnet wait for the last answer before terminating" |
353 |
int_option 140 |
int_option 140 |
354 |
|
|
355 |
let overnet_query_peer_period = |
let overnet_query_peer_period = |
356 |
define_option overnet_section [Proto.options_section_name; "query_peer_period"] |
define_option overnet_section [Proto.options_section_name; "query_peer_period"] |
357 |
"Period between two queries in the overnet tree (should not be set under 5)" |
"Period between two queries in the overnet tree (should not be set under 5)" |
358 |
float_option 5. |
float_option 5. |
359 |
|
|
360 |
let overnet_max_search_hits = |
let overnet_max_search_hits = |
361 |
define_option overnet_section [Proto.options_section_name; "max_search_hits"] |
define_option overnet_section [Proto.options_section_name; "max_search_hits"] |
362 |
"Max number of hits in a search on Overnet" |
"Max number of hits in a search on Overnet" |
363 |
int_option 200 |
int_option 200 |
364 |
|
|
365 |
let overnet_republish = |
let overnet_republish = |
366 |
define_option overnet_section [Proto.options_section_name; "republish"] |
define_option overnet_section [Proto.options_section_name; "republish"] |
367 |
"Interval (in seconds) before republish files" |
"Interval (in seconds) before republish files" |
368 |
float_option 10800. |
float_option 10800. |
369 |
|
|
370 |
let overnet_exclude_peers = |
let overnet_exclude_peers = |
371 |
define_option overnet_section [Proto.options_section_name; "exclude_peers"] |
define_option overnet_section [Proto.options_section_name; "exclude_peers"] |
372 |
"These IP addresses cannot be peers. Elements are separated by spaces, wildcard=255 ie: use 192.168.0.255 for 192.168.0.* " |
"These IP addresses cannot be peers. Elements are separated by spaces, wildcard=255 ie: use 192.168.0.255 for 192.168.0.* " |
373 |
ip_list_option [Ip.of_string "1.0.0.0"] |
ip_list_option [Ip.of_string "1.0.0.0"] |
374 |
|
|
375 |
let overnet_md4 = define_option overnet_section |
let overnet_md4 = define_option overnet_section |
376 |
[Proto.options_section_name; "md4"] |
[Proto.options_section_name; "md4"] |
381 |
"Set this option to false if you don't want to receive new Overnet peers" |
"Set this option to false if you don't want to receive new Overnet peers" |
382 |
bool_option true |
bool_option true |
383 |
|
|
384 |
let gui_overnet_options_panel = |
let gui_overnet_options_panel = |
385 |
(* |
(* |
386 |
define_option overnet_section ["gui_overnet_options_panel"] |
define_option overnet_section ["gui_overnet_options_panel"] |
387 |
"Which options are configurable in the GUI option panel, and in the |
"Which options are configurable in the GUI option panel, and in the |
396 |
"Search Internal Period", shortname overnet_query_peer_period, "T"; |
"Search Internal Period", shortname overnet_query_peer_period, "T"; |
397 |
"Search Max Hits", shortname overnet_max_search_hits, "T"; |
"Search Max Hits", shortname overnet_max_search_hits, "T"; |
398 |
] |
] |
399 |
|
|
400 |
let overnet_options_version = |
let overnet_options_version = |
401 |
define_option overnet_section [Proto.options_section_name; "options_version"] |
define_option overnet_section [Proto.options_section_name; "options_version"] |
402 |
"(internal)" |
"(internal)" |
403 |
int_option 0 |
int_option 0 |
404 |
|
|
407 |
|
|
408 |
|
|
409 |
MUTABLE STRUCTURES |
MUTABLE STRUCTURES |
410 |
|
|
411 |
|
|
412 |
*********************************************************************) |
*********************************************************************) |
413 |
|
|
414 |
let connected_peers = ref 0 |
let connected_peers = ref 0 |
415 |
|
|
416 |
module LimitedList = struct |
module LimitedList = struct |
417 |
|
|
418 |
type key = Ip.t * int |
type key = Ip.t * int |
419 |
|
|
420 |
type 'a t = { |
type 'a t = { |
421 |
objects_fifo : key Fifo.t; |
objects_fifo : key Fifo.t; |
422 |
mutable max_objects : int; |
mutable max_objects : int; |
423 |
objects_table : (key, key) Hashtbl.t; |
objects_table : (key, key) Hashtbl.t; |
424 |
} |
} |
425 |
|
|
426 |
let length t = Fifo.length t.objects_fifo |
let length t = Fifo.length t.objects_fifo |
427 |
|
|
428 |
let create max_objects = { |
let create max_objects = { |
429 |
objects_fifo = Fifo.create (); |
objects_fifo = Fifo.create (); |
430 |
max_objects = max_objects; |
max_objects = max_objects; |
431 |
objects_table = Hashtbl.create 127; |
objects_table = Hashtbl.create 127; |
432 |
} |
} |
433 |
|
|
434 |
let add t key = |
let add t key = |
435 |
let (ip, port) = key in |
let (ip, port) = key in |
436 |
if Ip.valid ip && ip <> Ip.localhost && Ip.reachable ip && |
if Ip.valid ip && ip <> Ip.localhost && Ip.reachable ip && |
437 |
not (Hashtbl.mem t.objects_table key) then |
not (Hashtbl.mem t.objects_table key) then |
438 |
begin |
begin |
439 |
Hashtbl.add t.objects_table key key; |
Hashtbl.add t.objects_table key key; |
440 |
Fifo.put t.objects_fifo key; |
Fifo.put t.objects_fifo key; |
441 |
if Fifo.length t.objects_fifo = t.max_objects then |
if Fifo.length t.objects_fifo = t.max_objects then |
442 |
let key = Fifo.take t.objects_fifo in |
let key = Fifo.take t.objects_fifo in |
443 |
Hashtbl.remove t.objects_table key |
Hashtbl.remove t.objects_table key |
444 |
end |
end |
445 |
|
|
446 |
let to_list t = |
let to_list t = |
447 |
Fifo.to_list t.objects_fifo |
Fifo.to_list t.objects_fifo |
448 |
|
|
449 |
let iter f t = |
let iter f t = |
450 |
Fifo.iter f t.objects_fifo |
Fifo.iter f t.objects_fifo |
451 |
|
|
452 |
let set_max_objects t max_objects = |
let set_max_objects t max_objects = |
453 |
while Fifo.length t.objects_fifo > max_objects do |
while Fifo.length t.objects_fifo > max_objects do |
454 |
let key = Fifo.take t.objects_fifo in |
let key = Fifo.take t.objects_fifo in |
455 |
Hashtbl.remove t.objects_table key |
Hashtbl.remove t.objects_table key |
456 |
done; |
done; |
457 |
t.max_objects <- max_objects |
t.max_objects <- max_objects |
458 |
|
|
459 |
|
|
460 |
let value_to_t v = |
let value_to_t v = |
461 |
let t = create 100000 in |
let t = create 100000 in |
462 |
match v with |
match v with |
464 |
List.iter (fun v -> |
List.iter (fun v -> |
465 |
match v with |
match v with |
466 |
List [ip; port] | SmallList [ip; port] -> |
List [ip; port] | SmallList [ip; port] -> |
467 |
add t (Ip.of_string (value_to_string ip), |
add t (Ip.of_string (value_to_string ip), |
468 |
value_to_int port) |
value_to_int port) |
469 |
| _ -> failwith "not a limited IP list" |
| _ -> failwith "not a limited IP list" |
470 |
) l; |
) l; |
475 |
List (List2.tail_map (fun (ip,port) -> |
List (List2.tail_map (fun (ip,port) -> |
476 |
SmallList [string_to_value (Ip.to_string ip); int_to_value port] |
SmallList [string_to_value (Ip.to_string ip); int_to_value port] |
477 |
) (to_list t)) |
) (to_list t)) |
478 |
|
|
479 |
let option = define_option_class "LimitedList" |
let option = define_option_class "LimitedList" |
480 |
value_to_t value_of_t |
value_to_t value_of_t |
481 |
|
|
482 |
end |
end |
483 |
|
|
484 |
let boot_peers = define_option servers_section |
let boot_peers = define_option servers_section |
485 |
[Proto.options_section_name; "boot_peers"] |
[Proto.options_section_name; "boot_peers"] |
486 |
"List of IP addresses to use to boot Kademlia networks" |
"List of IP addresses to use to boot Kademlia networks" |
487 |
LimitedList.option (LimitedList.create 2000) |
LimitedList.option (LimitedList.create 2000) |
488 |
|
|
489 |
let boot_peers_copy = ref [] |
let boot_peers_copy = ref [] |
490 |
|
|
491 |
(* the total number of buckets used. We must fill a bucket before using the |
(* the total number of buckets used. We must fill a bucket before using the |
492 |
next one. When a bucket is full, and we want to add a new peer, we must |
next one. When a bucket is full, and we want to add a new peer, we must |
493 |
either split the bucket, if it is the last one, or remove one peer from the |
either split the bucket, if it is the last one, or remove one peer from the |
494 |
bucket. |
bucket. |
495 |
|
|
496 |
What we want: we don't want to put too many peers in the buckets. |
What we want: we don't want to put too many peers in the buckets. |
497 |
The buckets should preferably contain peers that have already send us a |
The buckets should preferably contain peers that have already send us a |
498 |
message, because we are not sure for other peers. |
message, because we are not sure for other peers. |
499 |
*) |
*) |
500 |
|
|
501 |
let n_used_buckets = ref 0 |
let n_used_buckets = ref 0 |
502 |
|
|
503 |
(* We distinguish between buckets and prebuckets: peers in buckets are peers |
(* We distinguish between buckets and prebuckets: peers in buckets are peers |
504 |
that sent us a message in the last hour, whereas peers in the prebuckets |
that sent us a message in the last hour, whereas peers in the prebuckets |
505 |
are peers that we are not sure of. *) |
are peers that we are not sure of. *) |
506 |
let buckets = Array.init 129 (fun _ -> Fifo.create ()) |
let buckets = Array.init 129 (fun _ -> Fifo.create ()) |
507 |
let prebuckets = Array.init 129 (fun _ -> Fifo.create ()) |
let prebuckets = Array.init 129 (fun _ -> Fifo.create ()) |
508 |
|
|
509 |
let known_peers = Hashtbl.create 127 |
let known_peers = Hashtbl.create 127 |
510 |
let to_ping = ref [] |
let to_ping = ref [] |
511 |
|
|
512 |
(* |
(* |
513 |
We keep the data in buckets depending on the number of bits they have |
We keep the data in buckets depending on the number of bits they have |
514 |
in common with our identifier. When we exceed the desired storage, |
in common with our identifier. When we exceed the desired storage, |
515 |
we start removing associations from the buckets with the fewest common |
we start removing associations from the buckets with the fewest common |
517 |
than 1 hour. |
than 1 hour. |
518 |
*) |
*) |
519 |
|
|
520 |
|
|
521 |
(* Argh, we MUST verify how MD4s are compared, from left to right, or from |
(* Argh, we MUST verify how MD4s are compared, from left to right, or from |
522 |
right to left ?? *) |
right to left ?? *) |
523 |
|
|
524 |
(* common_bits: compute the number of common bits between a md4 and our |
(* common_bits: compute the number of common bits between a md4 and our |
525 |
identifier. *) |
identifier. *) |
526 |
|
|
527 |
let common_bits m1 m2 = |
let common_bits m1 m2 = |
528 |
let n = |
let n = |
529 |
let m = Md4.xor m1 m2 in |
let m = Md4.xor m1 m2 in |
530 |
(* lprintf () "XOR: %s\n" (Md4.to_bits m); *) |
(* lprintf () "XOR: %s\n" (Md4.to_bits m); *) |
531 |
let rec iter m i = |
let rec iter m i = |
532 |
(* lprintf () "iter %d\n" i; *) |
(* lprintf () "iter %d\n" i; *) |
533 |
if i = 16 then 128 else |
if i = 16 then 128 else |
534 |
let c = m.[i] in |
let c = m.[i] in |
535 |
if c = '\000' then iter m (i+1) |
if c = '\000' then iter m (i+1) |
536 |
else |
else |
537 |
iter_bit (i*8) (int_of_char c) |
iter_bit (i*8) (int_of_char c) |
538 |
|
|
539 |
and iter_bit nbits c = |
and iter_bit nbits c = |
540 |
(* lprintf () "iter_bit %d %d\n" nbits c; *) |
(* lprintf () "iter_bit %d %d\n" nbits c; *) |
541 |
if c land 0x80 <> 0 then nbits else |
if c land 0x80 <> 0 then nbits else |
546 |
(* lprintf () "Common bits: %s - %s = %d\n" |
(* lprintf () "Common bits: %s - %s = %d\n" |
547 |
(Md4.to_string m1) (Md4.to_string m2) n; *) |
(Md4.to_string m1) (Md4.to_string m2) n; *) |
548 |
n |
n |
549 |
|
|
550 |
let bucket_number md4 = |
let bucket_number md4 = |
551 |
common_bits md4 !!overnet_md4 |
common_bits md4 !!overnet_md4 |
552 |
|
|
553 |
(* |
(* |
554 |
(* TODO: this structure MUST disappear. It is not Kademlia ! *) |
(* TODO: this structure MUST disappear. It is not Kademlia ! *) |
555 |
let global_peers : (Md4.t, peer) Hashtbl.t array Options.option_record = |
let global_peers : (Md4.t, peer) Hashtbl.t array Options.option_record = |
556 |
raise Not_found |
raise Not_found |
557 |
*) |
*) |
558 |
|
|
559 |
(*let firewalled_overnet_peers = Hashtbl.create 13*) |
(*let firewalled_overnet_peers = Hashtbl.create 13*) |
560 |
|
|
561 |
let search_hits = ref 0 |
let search_hits = ref 0 |
562 |
let source_hits = ref 0 |
let source_hits = ref 0 |
563 |
|
|
564 |
|
|
565 |
let udp_sock = ref None |
let udp_sock = ref None |
566 |
|
|
567 |
let overnet_searches = ref [] |
let overnet_searches = ref [] |
568 |
|
|
569 |
(******************************************************************** |
(******************************************************************** |
570 |
|
|
571 |
|
|
572 |
FUNCTIONS |
FUNCTIONS |
573 |
|
|
574 |
|
|
575 |
*********************************************************************) |
*********************************************************************) |
576 |
|
|
577 |
module Publish (M : sig |
module Publish (M : sig |
578 |
type t |
type t |
579 |
val item_name : string |
val item_name : string |
580 |
end) = struct |
end) = struct |
581 |
|
|
582 |
type publish = { |
type publish = { |
583 |
mutable publish_last_recv : int; |
mutable publish_last_recv : int; |
584 |
publish_key : (Md4.t * Md4.t); |
publish_key : (Md4.t * Md4.t); |
585 |
publish_value : M.t; |
publish_value : M.t; |
586 |
} |
} |
587 |
|
|
588 |
let keyword_to_files_buckets = Array.init 129 (fun _ -> Fifo.create ()) |
let keyword_to_files_buckets = Array.init 129 (fun _ -> Fifo.create ()) |
589 |
|
|
590 |
let keyword_to_files_table = Hashtbl.create 127 |
let keyword_to_files_table = Hashtbl.create 127 |
591 |
|
|
592 |
let keywords_table = Hashtbl.create 127 |
let keywords_table = Hashtbl.create 127 |
593 |
|
|
594 |
let n_files_stored = ref 0 |
let n_files_stored = ref 0 |
595 |
let max_soft_stored_files = 1000 |
let max_soft_stored_files = 1000 |
596 |
let max_hard_stored_files = 2000 |
let max_hard_stored_files = 2000 |
597 |
|
|
598 |
let publish md4 r_md4 r_tags = |
let publish md4 r_md4 r_tags = |
599 |
let key = (md4, r_md4) in |
let key = (md4, r_md4) in |
600 |
try |
try |
611 |
Hashtbl.add keywords_table md4 p; |
Hashtbl.add keywords_table md4 p; |
612 |
let bucket = bucket_number md4 in |
let bucket = bucket_number md4 in |
613 |
Fifo.put keyword_to_files_buckets.(bucket) p; |
Fifo.put keyword_to_files_buckets.(bucket) p; |
614 |
incr n_files_stored; |
incr n_files_stored; |
615 |
end |
end |
616 |
|
|
617 |
let refresh () = |
let refresh () = |
618 |
Hashtbl.clear keywords_table; |
Hashtbl.clear keywords_table; |
619 |
Hashtbl.clear keyword_to_files_table; |
Hashtbl.clear keyword_to_files_table; |
620 |
n_files_stored := 0; |
n_files_stored := 0; |
621 |
|
|
622 |
let maxtime = last_time () - 3600 in |
let maxtime = last_time () - 3600 in |
623 |
try |
try |
624 |
for bucket = 128 downto 0 do |
for bucket = 128 downto 0 do |
625 |
|
|
626 |
let b = keyword_to_files_buckets.(bucket) in |
let b = keyword_to_files_buckets.(bucket) in |
627 |
let len = Fifo.length b in |
let len = Fifo.length b in |
628 |
if len > 0 then |
if len > 0 then |
630 |
keyword_to_files_buckets.(bucket) <- bb; |
keyword_to_files_buckets.(bucket) <- bb; |
631 |
for i = 1 to len do |
for i = 1 to len do |
632 |
let p = Fifo.take b in |
let p = Fifo.take b in |
633 |
if p.publish_last_recv > maxtime && |
if p.publish_last_recv > maxtime && |
634 |
!n_files_stored < max_soft_stored_files then begin |
!n_files_stored < max_soft_stored_files then begin |
635 |
Fifo.put bb p; |
Fifo.put bb p; |
636 |
Hashtbl.add keyword_to_files_table p.publish_key p; |
Hashtbl.add keyword_to_files_table p.publish_key p; |
640 |
end |
end |
641 |
done |
done |
642 |
done |
done |
643 |
with Exit -> () |
with Exit -> () |
644 |
|
|
645 |
let print buf = |
let print buf = |
646 |
Printf.bprintf buf "Store for %s\n" M.item_name; |
Printf.bprintf buf "Store for %s\n" M.item_name; |
647 |
Printf.bprintf buf " Stored items: %d (%d < %d)\n" !n_files_stored |
Printf.bprintf buf " Stored items: %d (%d < %d)\n" !n_files_stored |
652 |
Printf.bprintf buf " bucket[%d] : %d items\n" bucket len |
Printf.bprintf buf " bucket[%d] : %d items\n" bucket len |
653 |
done |
done |
654 |
|
|
655 |
let get md4 = |
let get md4 = |
656 |
List2.tail_map (fun p -> p.publish_value) |
List2.tail_map (fun p -> p.publish_value) |
657 |
(Hashtbl.find_all keywords_table md4) |
(Hashtbl.find_all keywords_table md4) |
658 |
end |
end |
659 |
|
|
661 |
type t = Md4.t * tag list |
type t = Md4.t * tag list |
662 |
let item_name = "Keywords" |
let item_name = "Keywords" |
663 |
end) |
end) |
664 |
|
|
665 |
module PublishedFiles = Publish(struct |
module PublishedFiles = Publish(struct |
666 |
type t = peer |
type t = peer |
667 |
let item_name = "Files" |
let item_name = "Files" |
668 |
end) |
end) |
669 |
|
|
670 |
let debug_client ip = false |
let debug_client ip = false |
671 |
(* Ip.matches ip !!overnet_debug_clients *) |
(* Ip.matches ip !!overnet_debug_clients *) |
672 |
|
|
691 |
LimitedList.add !!boot_peers (ip,port); |
LimitedList.add !!boot_peers (ip,port); |
692 |
boot_peers_copy := (ip,port) :: !boot_peers_copy |
boot_peers_copy := (ip,port) :: !boot_peers_copy |
693 |
end |
end |
694 |
|
|
695 |
let new_peer p = |
let new_peer p = |
696 |
let ip = p.peer_ip in |
let ip = p.peer_ip in |
697 |
if Ip.valid ip && ip <> Ip.localhost && Ip.reachable ip && |
if Ip.valid ip && ip <> Ip.localhost && Ip.reachable ip && |
698 |
p.peer_port <> 0 then |
p.peer_port <> 0 then |
712 |
(* Now, enter it in the buckets *) |
(* Now, enter it in the buckets *) |
713 |
let bucket = bucket_number p.peer_md4 in |
let bucket = bucket_number p.peer_md4 in |
714 |
if bucket < !n_used_buckets then begin |
if bucket < !n_used_buckets then begin |
715 |
|
|
716 |
if Fifo.length prebuckets.(bucket) = max_peers_per_prebucket then |
if Fifo.length prebuckets.(bucket) = max_peers_per_prebucket then |
717 |
let pp = Fifo.take prebuckets.(bucket) in |
let pp = Fifo.take prebuckets.(bucket) in |
718 |
Fifo.put prebuckets.(bucket) |
Fifo.put prebuckets.(bucket) |
719 |
(* If we heard of the head of the bucket in the last 30 minutes, we should |
(* If we heard of the head of the bucket in the last 30 minutes, we should |
720 |
keep it. *) |
keep it. *) |
721 |
(if pp.peer_last_recv > last_time () - 1800 then pp else p) |
(if pp.peer_last_recv > last_time () - 1800 then pp else p) |
724 |
end else |
end else |
725 |
if !n_used_buckets < 128 then begin |
if !n_used_buckets < 128 then begin |
726 |
Fifo.put prebuckets.(!n_used_buckets) p; |
Fifo.put prebuckets.(!n_used_buckets) p; |
727 |
|
|
728 |
while !n_used_buckets < 128 && |
while !n_used_buckets < 128 && |
729 |
Fifo.length prebuckets.(!n_used_buckets) |
Fifo.length prebuckets.(!n_used_buckets) |
730 |
= max_peers_per_bucket do |
= max_peers_per_bucket do |
731 |
let b = prebuckets.(!n_used_buckets) in |
let b = prebuckets.(!n_used_buckets) in |
732 |
incr n_used_buckets; |
incr n_used_buckets; |
741 |
p |
p |
742 |
else |
else |
743 |
p |
p |
744 |
|
|
745 |
let get_closest_peers md4 nb = |
let get_closest_peers md4 nb = |
746 |
let bucket = bucket_number md4 in |
let bucket = bucket_number md4 in |
747 |
let bucket = min !n_used_buckets bucket in |
let bucket = min !n_used_buckets bucket in |
766 |
iter (min !nb (Fifo.length fifo)) |
iter (min !nb (Fifo.length fifo)) |
767 |
in |
in |
768 |
add_list bucket; |
add_list bucket; |
769 |
|
|
770 |
if !nb > 0 then begin |
if !nb > 0 then begin |
771 |
|
|
772 |
let rec iter bucket = |
let rec iter bucket = |
773 |
if bucket <= !n_used_buckets then begin |
if bucket <= !n_used_buckets then begin |
774 |
add_list bucket; |
add_list bucket; |
776 |
end |
end |
777 |
in |
in |
778 |
iter (bucket+1); |
iter (bucket+1); |
779 |
|
|
780 |
let rec iter bucket = |
let rec iter bucket = |
781 |
if bucket >= 0 then begin |
if bucket >= 0 then begin |
782 |
add_list bucket; |
add_list bucket; |
789 |
!list |
!list |
790 |
|
|
791 |
let my_peer () = |
let my_peer () = |
792 |
{ |
{ |
793 |
peer_md4 = !!overnet_md4; |
peer_md4 = !!overnet_md4; |
794 |
peer_ip = client_ip None; |
peer_ip = client_ip None; |
795 |
peer_port = !!overnet_port; |
peer_port = !!overnet_port; |
830 |
if not (Hashtbl.mem s.search_known_peers key) then begin |
if not (Hashtbl.mem s.search_known_peers key) then begin |
831 |
Hashtbl.add s.search_known_peers key p; |
Hashtbl.add s.search_known_peers key p; |
832 |
let nbits = common_bits p.peer_md4 s.search_md4 in |
let nbits = common_bits p.peer_md4 s.search_md4 in |
833 |
Fifo.put s.search_waiting_peers.(nbits) p; |
Fifo.put s.search_waiting_peers.(nbits) p; |
834 |
end |
end |
835 |
|
|
836 |
let create_search kind md4 = |
let create_search kind md4 = |
837 |
if !verbose_overnet then lprintf_nl () "create_search"; |
if !verbose_overnet then lprintf_nl () "create_search"; |
838 |
let s = { |
let s = { |
839 |
search_md4 = md4; |
search_md4 = md4; |
854 |
overnet_searches := s :: !overnet_searches; |
overnet_searches := s :: !overnet_searches; |
855 |
s |
s |
856 |
|
|
857 |
let create_keyword_search w s = |
let create_keyword_search w s = |
858 |
let md4 = Md4.string w in |
let md4 = Md4.string w in |
859 |
let search = create_search (KeywordSearch s) md4 in |
let search = create_search (KeywordSearch s) md4 in |
860 |
search |
search |
861 |
|
|
862 |
let ip_of_udp_packet p = |
let ip_of_udp_packet p = |
863 |
match p.UdpSocket.udp_addr with |
match p.UdpSocket.udp_addr with |
864 |
Unix.ADDR_INET (inet, port) -> |
Unix.ADDR_INET (inet, port) -> |
865 |
Ip.of_inet_addr inet |
Ip.of_inet_addr inet |
866 |
| _ -> assert false |
| _ -> assert false |
867 |
|
|
868 |
let port_of_udp_packet p = |
let port_of_udp_packet p = |
869 |
match p.UdpSocket.udp_addr with |
match p.UdpSocket.udp_addr with |
870 |
Unix.ADDR_INET (inet, port) -> port |
Unix.ADDR_INET (inet, port) -> port |
871 |
| _ -> assert false |
| _ -> assert false |
872 |
|
|
873 |
|
|
874 |
let new_peer_message p = |
let new_peer_message p = |
875 |
(* lprintf () "*** Updating time for %s:%d\n" (Ip.to_string p.peer_ip) p.peer_port; *) |
(* lprintf () "*** Updating time for %s:%d\n" (Ip.to_string p.peer_ip) p.peer_port; *) |
876 |
p.peer_last_recv <- last_time () |
p.peer_last_recv <- last_time () |
877 |
|
|
878 |
let udp_client_handler t p = |
let udp_client_handler t p = |
879 |
let other_ip = ip_of_udp_packet p in |
let other_ip = ip_of_udp_packet p in |
880 |
let other_port = port_of_udp_packet p in |
let other_port = port_of_udp_packet p in |
881 |
if !verbose_overnet then |
if !verbose_overnet then |
882 |
lprintf_nl () "UDP FROM %s:%d:\n %s" |
lprintf_nl () "UDP FROM %s:%d:\n %s" |
883 |
(Ip.to_string other_ip) other_port |
(Ip.to_string other_ip) other_port |
884 |
(message_to_string t); |
(message_to_string t); |
885 |
match t with |
match t with |
886 |
|
|
887 |
| OvernetConnect p -> |
| OvernetConnect p -> |
888 |
new_peer_message p; |
new_peer_message p; |
889 |
let p = new_peer p in |
let p = new_peer p in |
890 |
udp_send p (OvernetConnectReply (get_any_peers 20)) |
udp_send p (OvernetConnectReply (get_any_peers 20)) |
891 |
|
|
892 |
| OvernetConnectReply ps -> |
| OvernetConnectReply ps -> |
893 |
UdpSocket.declare_pong other_ip; |
UdpSocket.declare_pong other_ip; |
894 |
let rec iter list = |
let rec iter list = |
906 |
iter tail |
iter tail |
907 |
in |
in |
908 |
iter ps; |
iter ps; |
909 |
|
|
910 |
| OvernetPublicize p -> |
| OvernetPublicize p -> |
911 |
new_peer_message p; |
new_peer_message p; |
912 |
let p = new_peer p in |
let p = new_peer p in |
913 |
udp_send p (OvernetPublicized (Some (my_peer ()))) |
udp_send p (OvernetPublicized (Some (my_peer ()))) |
914 |
|
|
915 |
| OvernetPublicized None -> |
| OvernetPublicized None -> |
916 |
() |
() |
917 |
|
|
918 |
| OvernetPublicized (Some p) -> |
| OvernetPublicized (Some p) -> |
919 |
new_peer_message p; |
new_peer_message p; |
920 |
let p = new_peer p in |
let p = new_peer p in |
921 |
() |
() |
922 |
|
|
923 |
| OvernetSearch (nresults, md4, from_who) -> |
| OvernetSearch (nresults, md4, from_who) -> |
924 |
|
|
925 |
let peers = get_closest_peers md4 nresults in |
let peers = get_closest_peers md4 nresults in |
926 |
udp_send_direct other_ip other_port (OvernetSearchReply (md4,peers)) |
udp_send_direct other_ip other_port (OvernetSearchReply (md4,peers)) |
927 |
|
|
928 |
| OvernetSearchReply (md4, peers) -> |
| OvernetSearchReply (md4, peers) -> |
929 |
|
|
930 |
let peers = List2.tail_map new_peer peers in |
let peers = List2.tail_map new_peer peers in |
931 |
List.iter (fun s -> |
List.iter (fun s -> |
932 |
if s.search_md4 = md4 then begin |
if s.search_md4 = md4 then begin |
935 |
let p = Hashtbl.find s.search_known_peers |
let p = Hashtbl.find s.search_known_peers |
936 |
(other_ip, other_port) in |
(other_ip, other_port) in |
937 |
new_peer_message p; |
new_peer_message p; |
938 |
let nbits = common_bits p.peer_md4 s.search_md4 in |
let nbits = common_bits p.peer_md4 s.search_md4 in |
939 |
Fifo.put s.search_ok_peers.(nbits) p; |
Fifo.put s.search_ok_peers.(nbits) p; |
940 |
with _ -> () |
with _ -> () |
941 |
end |
end |
942 |
) !overnet_searches; |
) !overnet_searches; |
943 |
|
|
944 |
| OvernetUnknown (opcode, s) -> |
| OvernetUnknown (opcode, s) -> |
945 |
if !verbose_hidden_errors then |
if !verbose_hidden_errors then |
946 |
begin |
begin |
947 |
lprintf () "Unknown message from %s:%d " (Ip.to_string other_ip) other_port; |
lprintf () "Unknown message from %s:%d " (Ip.to_string other_ip) other_port; |
948 |
lprintf_nl () "\tCode: %d" opcode; dump s; |
lprintf_nl () "\tCode: %d" opcode; dump s; |
949 |
end |
end |
950 |
|
|
951 |
| OvernetSearchFilesResults (md4, results) -> |
| OvernetSearchFilesResults (md4, results) -> |
952 |
List.iter (fun s -> |
List.iter (fun s -> |
953 |
if s.search_md4 = md4 then begin |
if s.search_md4 = md4 then begin |
954 |
s.search_nresults <- s.search_nresults + 1; |
s.search_nresults <- s.search_nresults + 1; |
955 |
|
|
956 |
begin |
begin |
957 |
try |
try |
958 |
let p = Hashtbl.find s.search_known_peers |
let p = Hashtbl.find s.search_known_peers |
960 |
new_peer_message p; |
new_peer_message p; |
961 |
with _ -> () |
with _ -> () |
962 |
end; |
end; |
963 |
|
|
964 |
match s.search_kind with |
match s.search_kind with |
965 |
FileSearch file -> () |
FileSearch file -> () |
966 |
|
|
967 |
| KeywordSearch sss -> |
| KeywordSearch sss -> |
968 |
List.iter (fun (r_md4, r_tags) -> |
List.iter (fun (r_md4, r_tags) -> |
969 |
if not (Hashtbl.mem s.search_results r_md4) then |
if not (Hashtbl.mem s.search_results r_md4) then |
970 |
begin |
begin |
971 |
incr search_hits; |
incr search_hits; |
972 |
s.search_hits <- s.search_hits + 1; |
s.search_hits <- s.search_hits + 1; |
973 |
Hashtbl.add s.search_results r_md4 r_tags; |
Hashtbl.add s.search_results r_md4 r_tags; |
974 |
if !verbose_overnet then begin |
if !verbose_overnet then begin |
975 |
lprintf_nl () "FILE FOUND, TAGS:"; |
lprintf_nl () "FILE FOUND, TAGS:"; |
976 |
print_tags r_tags; |
print_tags r_tags; |
977 |
lprintf_nl () "" |
lprintf_nl () "" |
978 |
end; |
end; |
981 |
end |
end |
982 |
) results |
) results |
983 |
| FillBuckets -> () |
| FillBuckets -> () |
984 |
|
|
985 |
end |
end |
986 |
) !overnet_searches |
) !overnet_searches |
987 |
|
|
988 |
| OvernetSearchSourcesResults (md4, peers) -> |
| OvernetSearchSourcesResults (md4, peers) -> |
989 |
List.iter (fun s -> |
List.iter (fun s -> |
990 |
if s.search_md4 = md4 then begin |
if s.search_md4 = md4 then begin |
991 |
s.search_nresults <- s.search_nresults + 1; |
s.search_nresults <- s.search_nresults + 1; |
992 |
|
|
993 |
begin |
begin |
994 |
try |
try |
995 |
let p = Hashtbl.find s.search_known_peers |
let p = Hashtbl.find s.search_known_peers |
997 |
new_peer_message p; |
new_peer_message p; |
998 |
with _ -> () |
with _ -> () |
999 |
end; |
end; |
1000 |
|
|
1001 |
match s.search_kind with |
match s.search_kind with |
1002 |
FileSearch file -> |
FileSearch file -> |
1003 |
List.iter (fun p -> |
List.iter (fun p -> |
1004 |
let ip = p.peer_ip in |
let ip = p.peer_ip in |
1005 |
let port = p.peer_tcpport in |
let port = p.peer_tcpport in |
1006 |
if Ip.valid ip && ip_reachable ip && port <> 0 then |
if Ip.valid ip && ip_reachable ip && port <> 0 then |
1007 |
let s = DonkeySources.find_source_by_uid |
let s = DonkeySources.find_source_by_uid |
1008 |
(Direct_address (ip, port)) in |
(Direct_address (ip, port)) in |
1009 |
incr source_hits; |
incr source_hits; |
1010 |
DonkeySources.set_request_result s |
DonkeySources.set_request_result s |
1011 |
file.file_sources File_new_source; |
file.file_sources File_new_source; |
1012 |
DonkeySources.set_source_brand s source_brand |
DonkeySources.set_source_brand s source_brand |
1013 |
) peers |
) peers |
1014 |
|
|
1015 |
| KeywordSearch sss -> () |
| KeywordSearch sss -> () |
1016 |
| FillBuckets -> () |
| FillBuckets -> () |
1017 |
|
|
1018 |
|
|
1019 |
end |
end |
1020 |
) !overnet_searches |
) !overnet_searches |
1021 |
|
|
1023 |
List.iter (fun (r_md4, r_tags) -> |
List.iter (fun (r_md4, r_tags) -> |
1024 |
PublishedKeywords.publish md4 r_md4 (r_md4, r_tags) |
PublishedKeywords.publish md4 r_md4 (r_md4, r_tags) |
1025 |
) files |
) files |
1026 |
|
|
1027 |
| OvernetPublishSources (md4, files) -> |
| OvernetPublishSources (md4, files) -> |
1028 |
List.iter (fun p -> |
List.iter (fun p -> |
1029 |
PublishedFiles.publish md4 p.peer_md4 p |
PublishedFiles.publish md4 p.peer_md4 p |
1057 |
FillBuckets -> 10 |
FillBuckets -> 10 |
1058 |
| _ -> 2 |
| _ -> 2 |
1059 |
in |
in |
1060 |
|
|
1061 |
let rec iter nbits todo = |
let rec iter nbits todo = |
1062 |
if nbits >= 0 then |
if nbits >= 0 then |
1063 |
let len = Fifo.length s.search_waiting_peers.(nbits) in |
let len = Fifo.length s.search_waiting_peers.(nbits) in |
1067 |
udp_send p (OvernetSearch (nresults, s.search_md4, Some p.peer_md4)); |
udp_send p (OvernetSearch (nresults, s.search_md4, Some p.peer_md4)); |
1068 |
s.search_queries <- s.search_queries + 1; |
s.search_queries <- s.search_queries + 1; |
1069 |
Fifo.put s.search_asked_peers.(nbits) p; |
Fifo.put s.search_asked_peers.(nbits) p; |
1070 |
|
|
1071 |
(if todo > 1 then iter nbits (todo - 1)) |
(if todo > 1 then iter nbits (todo - 1)) |
1072 |
else |
else |
1073 |
iter (nbits-1) todo |
iter (nbits-1) todo |
1078 |
) (get_closest_peers s.search_md4 max_search_queries) |
) (get_closest_peers s.search_md4 max_search_queries) |
1079 |
in |
in |
1080 |
iter 128 2 |
iter 128 2 |
1081 |
|
|
1082 |
) !overnet_searches |
) !overnet_searches |
1083 |
|
|
1084 |
let recover_file file = |
let recover_file file = |
1085 |
if file_state file = FileDownloading then |
if file_state file = FileDownloading then |
1086 |
let search = create_search (FileSearch file) file.file_md4 in |
let search = create_search (FileSearch file) file.file_md4 in |
1087 |
() |
() |
1088 |
|
|
1089 |
let check_current_downloads () = |
let check_current_downloads () = |
1090 |
List.iter recover_file !DonkeyGlobals.current_files |
List.iter recover_file !DonkeyGlobals.current_files |
1091 |
|
|
1092 |
let update_buckets () = |
let update_buckets () = |
1093 |
|
|
1094 |
(* 1. Clean the buckets from too old peers ( last contact > 1 hour ) *) |
(* 1. Clean the buckets from too old peers ( last contact > 1 hour ) *) |
1095 |
|
|
1096 |
let overtime = last_time () - 3600 in |
let overtime = last_time () - 3600 in |
1097 |
|
|
1098 |
for i = 0 to !n_used_buckets do |
for i = 0 to !n_used_buckets do |
1099 |
|
|
1100 |
let b = buckets.(i) in |
let b = buckets.(i) in |
1101 |
for j = 1 to Fifo.length b do |
for j = 1 to Fifo.length b do |
1102 |
let p = Fifo.take b in |
let p = Fifo.take b in |
1103 |
if p.peer_last_recv > overtime then Fifo.put b p else |
if p.peer_last_recv > overtime then Fifo.put b p else |
1104 |
decr connected_peers |
decr connected_peers |
1105 |
done |
done |
1106 |
|
|
1107 |
done; |
done; |
1108 |
|
|
1109 |
(* 2. Complete buckets with new peers from the prebuckets with |
(* 2. Complete buckets with new peers from the prebuckets with |
1110 |
( last_contact < 1 hour ) *) |
( last_contact < 1 hour ) *) |
1111 |
|
|
1112 |
for i = 0 to !n_used_buckets - 1 do |
for i = 0 to !n_used_buckets - 1 do |
1113 |
let b = buckets.(i) in |
let b = buckets.(i) in |
1114 |
if Fifo.length b < max_peers_per_bucket then begin |
if Fifo.length b < max_peers_per_bucket then begin |
1115 |
|
|
1116 |
try |
try |
1117 |
let pb = prebuckets.(i) in |
let pb = prebuckets.(i) in |
1118 |
for j = 1 to Fifo.length pb do |
for j = 1 to Fifo.length pb do |
1119 |
|
|
1120 |
let p = Fifo.take pb in |
let p = Fifo.take pb in |
1121 |
if p.peer_last_recv > overtime then begin |
if p.peer_last_recv > overtime then begin |
1122 |
Fifo.put b p; |
Fifo.put b p; |
1123 |
incr connected_peers; |
incr connected_peers; |
1124 |
if Fifo.length b = max_peers_per_bucket then raise Exit |
if Fifo.length b = max_peers_per_bucket then raise Exit |
1125 |
end else Fifo.put pb p |
end else Fifo.put pb p |
1126 |
|
|
1127 |
done |
done |
1128 |
with Exit -> () |
with Exit -> () |
1129 |
|
|
1130 |
end |
end |
1131 |
done; |
done; |
1132 |
|
|
1133 |
() |
() |
1134 |
|
|
1135 |
let enable () = |
let enable () = |
1136 |
if !!enable_overnet && not !is_enabled then begin |
if !!enable_overnet && not !is_enabled then begin |
1137 |
let enabler = is_enabled in |
let enabler = is_enabled in |
1138 |
is_enabled := true; |
is_enabled := true; |
1139 |
|
|
1140 |
let sock = (UdpSocket.create (Ip.to_inet_addr !!client_bind_addr) |
let sock = (UdpSocket.create (Ip.to_inet_addr !!client_bind_addr) |
1141 |
(!!overnet_port) (Proto.udp_handler udp_client_handler)) in |
(!!overnet_port) (Proto.udp_handler udp_client_handler)) in |
1142 |
udp_sock := Some sock; |
udp_sock := Some sock; |
1143 |
UdpSocket.set_write_controler sock udp_write_controler; |
UdpSocket.set_write_controler sock udp_write_controler; |
1144 |
|
|
1145 |
add_session_timer enabler 1. (fun _ -> |
add_session_timer enabler 1. (fun _ -> |
1146 |
if !!enable_overnet then |
if !!enable_overnet then |
1147 |
let my_peer = my_peer () in |
let my_peer = my_peer () in |
1148 |
|
|
1149 |
(* ping old peers regularly *) |
(* ping old peers regularly *) |
1159 |
(* ping unknown peers *) |
(* ping unknown peers *) |
1160 |
begin |
begin |
1161 |
match !boot_peers_copy with |
match !boot_peers_copy with |
1162 |
[] -> |
[] -> |
1163 |
boot_peers_copy := LimitedList.to_list !!boot_peers |
boot_peers_copy := LimitedList.to_list !!boot_peers |
1164 |
| _ -> |
| _ -> |
1165 |
if !connected_peers < 100 then |
if !connected_peers < 100 then |
1170 |
boot_peers_copy := tail; |
boot_peers_copy := tail; |
1171 |
udp_send_ping ip port (OvernetConnect my_peer); |
udp_send_ping ip port (OvernetConnect my_peer); |
1172 |
() |
() |
1173 |
|
|
1174 |
done |
done |
1175 |
end; |
end; |
1176 |
); |
); |
1177 |
|
|
1178 |
|
|
1179 |
LimitedList.set_max_objects !!boot_peers 2000 ; |
LimitedList.set_max_objects !!boot_peers 2000 ; |
1180 |
add_timer 60. (fun _ -> |
add_timer 60. (fun _ -> |
1181 |
LimitedList.set_max_objects !!boot_peers 2000; |
LimitedList.set_max_objects !!boot_peers 2000; |
1182 |
); |
); |
1183 |
|
|
1184 |
add_session_timer enabler 10. (fun _ -> |
add_session_timer enabler 10. (fun _ -> |
1185 |
|
|
1186 |
List.iter (fun s -> |
List.iter (fun s -> |
1187 |
|
|
1188 |
if s.search_requests < max_search_requests then begin |
if s.search_requests < max_search_requests then begin |
1189 |
let nrequests = |
let nrequests = |
1190 |
match s.search_kind with |
match s.search_kind with |
1191 |
FillBuckets -> 0 |
FillBuckets -> 0 |
1192 |
| FileSearch _ -> 1 |
| FileSearch _ -> 1 |
1212 |
with Exit -> () |
with Exit -> () |
1213 |
done |
done |
1214 |
end |
end |
1215 |
|
|
1216 |
) !overnet_searches |
) !overnet_searches |
1217 |
|
|
1218 |
); |
); |
1219 |
|
|
1220 |
add_session_timer enabler 60. (fun _ -> |
add_session_timer enabler 60. (fun _ -> |
1221 |
|
|
1222 |
update_buckets (); |
update_buckets (); |
1223 |
|
|
1224 |
(* compute which peers to ping in the next minute *) |
(* compute which peers to ping in the next minute *) |
1225 |
to_ping := []; |
to_ping := []; |
1226 |
let n_to_ping = ref 0 in |
let n_to_ping = ref 0 in |
1227 |
|
|
1228 |
let ping_peers b = |
let ping_peers b = |
1229 |
let overtime = last_time () - 1800 in |
let overtime = last_time () - 1800 in |
1230 |
Fifo.iter (fun p -> |
Fifo.iter (fun p -> |
1235 |
if !n_to_ping = 60 then raise Exit |
if !n_to_ping = 60 then raise Exit |
1236 |
end |
end |
1237 |
) b |
) b |
1238 |
in |
in |
1239 |
|
|
1240 |
begin |
begin |
1241 |
try |
try |
1242 |
for i = !n_used_buckets downto 8 do |
for i = !n_used_buckets downto 8 do |
1243 |
ping_peers buckets.(i); |
ping_peers buckets.(i); |
1244 |
ping_peers prebuckets.(i); |
ping_peers prebuckets.(i); |
1245 |
done; |
done; |
1246 |
for i = min !n_used_buckets 7 downto 0 do |
for i = min !n_used_buckets 7 downto 0 do |
1247 |
ping_peers buckets.(i); |
ping_peers buckets.(i); |
1248 |
done; |
done; |
1249 |
for i = min !n_used_buckets 7 downto 0 do |
for i = min !n_used_buckets 7 downto 0 do |
1250 |
ping_peers prebuckets.(i); |
ping_peers prebuckets.(i); |
1251 |
done; |
done; |
1252 |
with Exit -> () |
with Exit -> () |
1253 |
end; |
end; |
1263 |
add_session_timer enabler 3600. (fun _ -> |
add_session_timer enabler 3600. (fun _ -> |
1264 |
let s = create_search FillBuckets !!overnet_md4 in |
let s = create_search FillBuckets !!overnet_md4 in |
1265 |
() |
() |
1266 |
); |
); |
1267 |
|
|
1268 |
let s = create_search FillBuckets !!overnet_md4 in |
let s = create_search FillBuckets !!overnet_md4 in |
1269 |
|
|
1270 |
add_session_option_timer enabler overnet_query_peer_period (fun _ -> |
add_session_option_timer enabler overnet_query_peer_period (fun _ -> |
1271 |
if !!enable_overnet then begin |
if !!enable_overnet then begin |
1272 |
query_next_peers () |
query_next_peers () |
1282 |
add_timer 30. (fun _ -> |
add_timer 30. (fun _ -> |
1283 |
if !!enable_overnet then begin |
if !!enable_overnet then begin |
1284 |
check_current_downloads (); |
check_current_downloads (); |
1285 |
end |
end |
1286 |
); |
); |
1287 |
|
|
1288 |
end |
end |
1289 |
|
|
1290 |
let disable () = |
let disable () = |
1291 |
if !is_enabled then |
if !is_enabled then |
1292 |
begin |
begin |
1293 |
is_enabled := false; |
is_enabled := false; |
1294 |
(match !udp_sock with |
(match !udp_sock with |
1295 |
None -> () |
None -> () |
1296 |
| Some sock -> |
| Some sock -> |
1297 |
udp_sock := None; |
udp_sock := None; |
1298 |
UdpSocket.close sock Closed_by_user); |
UdpSocket.close sock Closed_by_user); |
1299 |
end |
end |
1300 |
|
|
1301 |
let _ = |
let _ = |
1302 |
option_hook enable_overnet |
option_hook enable_overnet |
1303 |
(fun _ -> |
(fun _ -> |
1304 |
if !CommonOptions.start_running_plugins then |
if !CommonOptions.start_running_plugins then |
1305 |
if !!enable_overnet = false then disable() else enable () |
if !!enable_overnet = false then disable() else enable () |
1306 |
); |
); |
1307 |
option_hook overnet_query_peer_period |
option_hook overnet_query_peer_period |
1308 |
(fun _ -> if !!overnet_query_peer_period < 5. then overnet_query_peer_period =:= 5.) |
(fun _ -> if !!overnet_query_peer_period < 5. then overnet_query_peer_period =:= 5.) |
1309 |
|
|
1310 |
let load_contact_dat filename = |
let load_contact_dat filename = |
1340 |
(List2.tail_map (fun (n,f,h) -> (n, "Network/Overnet", f,h)) list) |
(List2.tail_map (fun (n,f,h) -> (n, "Network/Overnet", f,h)) list) |
1341 |
|
|
1342 |
let _ = |
let _ = |
1343 |
register_commands |
register_commands |
1344 |
(List.map (fun (command, args, help) -> |
(List.map (fun (command, args, help) -> |
1345 |
command_prefix ^ command, args, help) |
command_prefix ^ command, args, help) |
1346 |
[ |
[ |
1350 |
bootstrap ip port; |
bootstrap ip port; |
1351 |
Printf.sprintf "peer %s:%d added" (Ip.to_string ip) port |
Printf.sprintf "peer %s:%d added" (Ip.to_string ip) port |
1352 |
), "<ip> <port> :\t\t\tadd an Overnet/Kademlia peer"; |
), "<ip> <port> :\t\t\tadd an Overnet/Kademlia peer"; |
1353 |
|
|
1354 |
"link", Arg_multiple (fun args o -> |
"link", Arg_multiple (fun args o -> |
1355 |
let buf = o.conn_buf in |
let buf = o.conn_buf in |
1356 |
let url = String2.unsplit args ' ' in |
let url = String2.unsplit args ' ' in |
1357 |
if parse_overnet_url url then |
if parse_overnet_url url then |
1358 |
"download started" |
"download started" |
1359 |
else "bad syntax" |
else "bad syntax" |
1360 |
), "<fhalink> :\t\t\tdownload fha:// link"; |
), "<fhalink> :\t\t\tdownload fha:// link"; |
1361 |
|
|
1362 |
"stats", Arg_none (fun o -> |
"stats", Arg_none (fun o -> |
1363 |
let buf = o.conn_buf and sum = ref 0 in |
let buf = o.conn_buf and sum = ref 0 in |
1364 |
if o.conn_output = HTML then |
if o.conn_output = HTML then |
1397 |
end |
end |
1398 |
else |
else |
1399 |
Printf.bprintf buf "Search %s for %s\n" |
Printf.bprintf buf "Search %s for %s\n" |
1400 |
|
|
1401 |
(* ", %d asked, %d done, %d hits, %d results) %s%s\n" *) |
(* ", %d asked, %d done, %d hits, %d results) %s%s\n" *) |
1402 |
(match s.search_kind with |
(match s.search_kind with |
1403 |
KeywordSearch _ -> "keyword" |
KeywordSearch _ -> "keyword" |
1412 |
begin |
begin |
1413 |
Printf.bprintf buf "\\<tr class=\\\"dl-1\\\"\\>"; |
Printf.bprintf buf "\\<tr class=\\\"dl-1\\\"\\>"; |
1414 |
html_mods_td buf [ |
html_mods_td buf [ |
1415 |
("", "sr", |
("", "sr", |
1416 |
Printf.sprintf "nbits[%d] = %d peer(s) not asked, %d peer(s) asked" |
Printf.sprintf "nbits[%d] = %d peer(s) not asked, %d peer(s) asked" |
1417 |
i npeers nasked); ]; |
i npeers nasked); ]; |
1418 |
Printf.bprintf buf "\\</tr\\>"; |
Printf.bprintf buf "\\</tr\\>"; |
1428 |
) !overnet_searches; |
) !overnet_searches; |
1429 |
if o.conn_output = HTML then |
if o.conn_output = HTML then |
1430 |
Printf.bprintf buf "\\</div\\>\n"; |
Printf.bprintf buf "\\</div\\>\n"; |
1431 |
|
|
1432 |
""; |
""; |
1433 |
), ":\t\t\t\tOvernet/Kademlia Stats"; |
), ":\t\t\t\tOvernet/Kademlia Stats"; |
1434 |
|
|
1435 |
"web", Arg_multiple (fun args o -> |
"web", Arg_multiple (fun args o -> |
1436 |
let urls = |
let urls = |
1437 |
match args with |
match args with |
1453 |
try |
try |
1454 |
let n = load_contact_dat filename in |
let n = load_contact_dat filename in |
1455 |
Printf.sprintf "%d overnet peers loaded" n; |
Printf.sprintf "%d overnet peers loaded" n; |
1456 |
with e -> |
with e -> |
1457 |
Printf.sprintf "error %s while loading file" (Printexc2.to_string e) |
Printf.sprintf "error %s while loading file" (Printexc2.to_string e) |
1458 |
), "<filename> :\t\t\tload the peers from a contact.dat file"; |
), "<filename> :\t\t\tload the peers from a contact.dat file"; |
1459 |
|
|
1460 |
"md4", Arg_none (fun o -> "MD4 is " ^ (Md4.to_string !!overnet_md4); |
"md4", Arg_none (fun o -> "MD4 is " ^ (Md4.to_string !!overnet_md4); |
1461 |
), ":\t\t\t\t\tget client MD4 address on the Overnet/Kademlia network"; |
), ":\t\t\t\t\tget client MD4 address on the Overnet/Kademlia network"; |
1462 |
|
|
1463 |
"store", Arg_none (fun o -> |
"store", Arg_none (fun o -> |
1464 |
let buf = o.conn_buf in |
let buf = o.conn_buf in |
1465 |
Printf.bprintf buf "%s store:\n" |
Printf.bprintf buf "%s store:\n" |
1466 |
(if Proto.redirector_section = "DKKO" then "Overnet" else "Kademlia"); |
(if Proto.redirector_section = "DKKO" then "Overnet" else "Kademlia"); |
1495 |
Printf.bprintf buf "Number of used buckets %d with %d peers\n" |
Printf.bprintf buf "Number of used buckets %d with %d peers\n" |
1496 |
!n_used_buckets !connected_peers; |
!n_used_buckets !connected_peers; |
1497 |
for i = 0 to !n_used_buckets do |
for i = 0 to !n_used_buckets do |
1498 |
if Fifo.length buckets.(i) > 0 || |
if Fifo.length buckets.(i) > 0 || |
1499 |
Fifo.length prebuckets.(i) > 0 then |
Fifo.length prebuckets.(i) > 0 then |
1500 |
Printf.bprintf buf " bucket[%d] : %d peers (prebucket %d)\n" |
Printf.bprintf buf " bucket[%d] : %d peers (prebucket %d)\n" |
1501 |
i (Fifo.length buckets.(i)) (Fifo.length prebuckets.(i)); |
i (Fifo.length buckets.(i)) (Fifo.length prebuckets.(i)); |
1514 |
|
|
1515 |
]); |
]); |
1516 |
() |
() |
1517 |
|
|
1518 |
let overnet_search (ss : search) = |
let overnet_search (ss : search) = |
1519 |
if !!overnet_search_keyword && !!enable_overnet then |
if !!overnet_search_keyword && !!enable_overnet then |
1520 |
let q = ss.search_query in |
let q = ss.search_query in |
1521 |
if !verbose then lprintf_nl () "========= overnet_search ========="; |
if !verbose then lprintf_nl () "========= overnet_search ========="; |
1522 |
let ws = keywords_of_query q in |
let ws = keywords_of_query q in |
1523 |
List.iter (fun w -> |
List.iter (fun w -> |
1524 |
if !verbose then lprintf_nl () "overnet_search for %s" w; |
if !verbose then lprintf_nl () "overnet_search for %s" w; |
1525 |
let s = create_keyword_search w ss in |
let s = create_keyword_search w ss in |
1526 |
Hashtbl.iter (fun r_md4 r_tags -> |
Hashtbl.iter (fun r_md4 r_tags -> |
1527 |
DonkeyOneFile.search_found true ss r_md4 r_tags) s.search_results; |
DonkeyOneFile.search_found true ss r_md4 r_tags) s.search_results; |
1528 |
) |
) |
1529 |
ws |
ws |
1533 |
match s.search_kind with |
match s.search_kind with |
1534 |
KeywordSearch sss when ss == sss -> false |
KeywordSearch sss when ss == sss -> false |
1535 |
| _ -> true) !overnet_searches |
| _ -> true) !overnet_searches |
1536 |
|
|
1537 |
let _ = |
let _ = |
1538 |
CommonWeb.add_redirector_info Proto.redirector_section (fun buf -> |
CommonWeb.add_redirector_info Proto.redirector_section (fun buf -> |
1539 |
update_buckets (); |
update_buckets (); |
1540 |
let peers = get_any_peers 32 in |
let peers = get_any_peers 32 in |
1541 |
buf_int buf (List.length peers); |
buf_int buf (List.length peers); |
1542 |
List.iter (fun p -> |
List.iter (fun p -> |
1543 |
buf_ip buf p.peer_ip; |
buf_ip buf p.peer_ip; |
1544 |
buf_int16 buf p.peer_port; |
buf_int16 buf p.peer_port; |
1545 |
buf_int16 buf p.peer_tcpport; |
buf_int16 buf p.peer_tcpport; |
1546 |
) |
) |
1547 |
peers; |
peers; |
1548 |
) |
) |
1549 |
|
|
1550 |
let cancel_recover_file file = |
let cancel_recover_file file = |
1551 |
overnet_searches := List.filter (fun s -> |
overnet_searches := List.filter (fun s -> |
1552 |
match s.search_kind with |
match s.search_kind with |
1553 |
FileSearch f when f == file -> false |
FileSearch f when f == file -> false |
1554 |
| _ -> true) !overnet_searches |
| _ -> true) !overnet_searches |
1555 |
|
|
1556 |
let _ = |
let _ = |
1557 |
CommonWeb.add_web_kind web_info (fun _ filename -> |
CommonWeb.add_web_kind web_info (fun _ filename -> |
1558 |
let s = File.to_string filename in |
let s = File.to_string filename in |
1559 |
let s = String2.replace s '"' "" in |
let s = String2.replace s '"' "" in |
1567 |
Ip.async_ip name (fun ip -> |
Ip.async_ip name (fun ip -> |
1568 |
let port = int_of_string port in |
let port = int_of_string port in |
1569 |
if !verbose_overnet then begin |
if !verbose_overnet then begin |
1570 |
lprintf () "ADDING OVERNET PEER %s:%d\n" name port; |
lprintf_nl () "ADDING OVERNET PEER %s:%d" name port; |
1571 |
end; |
end; |
1572 |
bootstrap ip port) |
bootstrap ip port) |
1573 |
| _ -> |
| _ -> |
1574 |
lprintf () "BAD LINE ocl: %s\n" s; |
lprintf_nl () "BAD LINE ocl: %s" s; |
1575 |
with _ -> |
with _ -> |
1576 |
begin |
begin |
1577 |
lprintf () "DNS failed\n"; |
lprintf_nl () "DNS failed"; |
1578 |
end |
end |
1579 |
) lines |
) lines |
1580 |
); |
); |
1585 |
begin |
begin |
1586 |
CommonWeb.add_web_kind "contact.dat" (fun _ filename -> |
CommonWeb.add_web_kind "contact.dat" (fun _ filename -> |
1587 |
if !verbose_overnet then |
if !verbose_overnet then |
1588 |
lprintf () "LOADED contact.dat\n"; |
lprintf_nl () "LOADED contact.dat"; |
1589 |
let n = load_contact_dat filename in |
let n = load_contact_dat filename in |
1590 |
if !verbose_overnet then |
if !verbose_overnet then |
1591 |
lprintf () "%d PEERS ADDED\n" n; |
lprintf_nl () "%d PEERS ADDED" n; |
1592 |
); |
); |
1593 |
end; |
end; |
1594 |
|
|
1596 |
|
|
1597 |
Define a function to be called when the "mem_stats" command |
Define a function to be called when the "mem_stats" command |
1598 |
is used to display information on structure footprint. |
is used to display information on structure footprint. |
1599 |
|
|
1600 |
**************************************************************) |
**************************************************************) |
1601 |
|
|
1602 |
Heap.add_memstat |
Heap.add_memstat |