/[mldonkey]/mldonkey/src/networks/donkey/donkeyOvernet.ml
ViewVC logotype

Contents of /mldonkey/src/networks/donkey/donkeyOvernet.ml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (show annotations) (download)
Fri May 23 17:39:27 2003 UTC (20 years, 11 months ago) by simon_mld
Branch: MAIN
CVS Tags: release-2-4-5, release-2-5-rc3, release-2-5-rc2, release-2-5-rc1, release-2-5-4, release-2-5-2, release-2-5-3, release-2-5-1, release-2-5-devel-4, release-2-5
Branch point for: release-2-5-devel, release-2-5-1-patches
Changes since 1.3: +1 -1 lines
-

1 (* Copyright 2001, 2002 b8_bavard, b8_fee_carabine, INRIA *)
2 (*
3 This file is part of mldonkey.
4
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.
9
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.
14
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
18 *)
19
20 open AnyEndian
21 open Printf2
22 open Md4
23 open Options
24
25 open BasicSocket
26 open TcpBufferedSocket
27 open LittleEndian
28
29 open GuiTypes
30 open CommonTypes
31 open CommonGlobals
32 open CommonInteractive
33 open CommonNetwork
34 open CommonOptions
35
36 open DonkeyTypes
37 open DonkeyGlobals
38 open DonkeyOptions
39 open DonkeyMftp
40 open DonkeyProtoOvernet
41
42 (*
43 TODO
44 ----
45 Enforce correct search
46 Add BCP type2 support again
47 Check 15/16/18/19/1A/1B/1C/1D/1E
48 *)
49
50 (*
51 S 18h (24) : md4 (md4 of the firewalled server) port (my TCP port) -verified-
52 R 19h (25) : md4
53 OR
54 R 1Ah (26) : md4
55
56 R 11h (17) : GetResult answer, the list always end by a 12h packet (No Result) -verified-
57 R 12h (18) : NoResult -verified-
58
59 S 1Bh (27) : port (my TCP port) -verified-
60 R 1Ch (28) : ip (returns my ip) -verified-
61
62 R 1Dh (29) : (nothing) -verified- (=> BCP type 1)
63 OR
64 R 1Eh (30) : (nothing) (=> BCP type 2)
65
66 (in BCP type 2 case)
67 S 15h (21) : md4 (my MD4) IP (my ip) port (my port UDP)
68 R 16h (22) : port (his ??? TCP port)
69 *)
70
71 module XorSet = Set.Make (
72 struct
73 type t = Md4.t * peer
74 let compare (m1,p1) (m2,p2) =
75 compare (m1,p1.peer_md4, p1.peer_ip) (m2,p2.peer_md4, p2.peer_ip)
76 end
77 )
78
79 module XorMd4Set = Set.Make (
80 struct
81 type t = Md4.t (* distance *) * Md4.t (* md4 *)
82 let compare (m1,p1) (m2,p2) =
83 let c = compare m1 m2 in
84 if c = 0 then compare p1 p2 else c
85 end
86 )
87
88 module XorMd4Map = Map.Make (
89 struct
90 type t = Md4.t
91 let compare = compare
92 end
93 )
94
95
96 type search_for =
97 FileSearch of file
98 | KeywordSearch of CommonTypes.search list
99
100 type overnet_search = {
101 search_md4 : Md4.t;
102 mutable search_kind : search_for;
103 mutable search_last_insert : int;
104
105 mutable search_not_asked_peers : XorSet.t;
106 mutable search_asked_peers : XorSet.t;
107 mutable search_done_peers : XorSet.t;
108
109 (* nb of peers in search_not_asked_peers + search_asked_peers + search_done_peers *)
110 mutable search_total_peers : int;
111
112 (* already tested peers, either they are in asked/not_asked/done, either they are useless*)
113 mutable search_known_peers : (Ip.t*int, peer) Hashtbl.t;
114
115 mutable search_nresults : int;
116 mutable search_results : (Md4.t, tag list) Hashtbl.t;
117 mutable search_hits : int;
118 mutable search_publish_files : file list;
119 mutable search_publish_file : bool;
120 }
121
122 (********************************************************************
123
124
125 STATIC MEMORY
126
127
128 *********************************************************************)
129
130 let min_peers_per_block = 2
131 let min_peers_before_connect = 5
132 let max_searches_for_publish = 5
133 let search_max_queries = 64
134
135 let global_peers_size = Array.make 256 0
136
137
138
139 (********************************************************************
140
141
142 OPTIONS
143
144
145 *********************************************************************)
146
147 module PeerOption = struct
148
149 let value_to_peer v =
150 match v with
151 SmallList [md4; ip; port; kind]
152 | List [md4; ip; port; kind] ->
153 let v_md4 = Md4.value_to_hash md4 in
154 let t_md4 = Md4.up v_md4 in
155 global_peers_size.(t_md4)<-global_peers_size.(t_md4)+1;
156 (t_md4,v_md4, {
157 peer_md4 = v_md4;
158 peer_ip = Ip.value_to_ip ip;
159 peer_port = value_to_int port;
160 peer_kind = value_to_int kind;
161 peer_last_msg = last_time ();
162 });
163 | _ -> assert false
164
165 let peer_to_value v =
166 match v with
167 (_,_,p) ->
168 SmallList [
169 Md4.hash_to_value p.peer_md4;
170 Ip.ip_to_value p.peer_ip;
171 int_to_value p.peer_port;
172 int_to_value p.peer_kind
173 ]
174
175 let t = define_option_class "Peer" value_to_peer peer_to_value
176 end
177
178 let overnet_expert_ini = donkey_expert_ini
179
180 let overnet_store_size =
181 define_option overnet_expert_ini ["overnet_store_size"] "Size of the filename storage used to answer queries"
182 int_option 2000
183
184 let overnet_protocol_connect_version =
185 define_option overnet_expert_ini ["overnet_protocol_connect_version"]
186 "The protocol version sent on Overnet connections"
187 int_option 1044
188
189 let overnet_protocol_connectreply_version =
190 define_option overnet_expert_ini ["overnet_protocol_connectreply_version"]
191 "The protocol version sent on Overnet connections replies"
192 int_option 44
193
194 let overnet_port =
195 define_option overnet_expert_ini ["overnet_port"] "port for overnet"
196 int_option (2000 + Random.int 20000)
197
198 let overnet_max_known_peers =
199 define_option overnet_expert_ini ["overnet_max_known_peers"]
200 "maximal number of peers to keep overnet connected (should be >2048)"
201 int_option 8192
202
203 let overnet_search_keyword =
204 define_option overnet_expert_ini ["overnet_search_keyword"]
205 "allow extended search to search on overnet" bool_option false
206
207 let overnet_search_timeout =
208 define_option overnet_expert_ini ["overnet_search_timeout"]
209 "How long shoud a search on Overnet wait for the last answer before terminating"
210 int_option 140
211
212 let overnet_query_peer_period =
213 define_option overnet_expert_ini ["overnet_query_peer_period"]
214 "Period between two queries in the overnet tree (should not be set under 5)"
215 float_option 5.
216
217 let overnet_max_search_hits =
218 define_option overnet_expert_ini ["overnet_max_search_hits"]
219 "Max number of hits in a search on Overnet"
220 int_option 200
221
222 let gui_overnet_options_panel =
223 (*
224 define_option overnet_expert_ini ["gui_overnet_options_panel"]
225 "Which options are configurable in the GUI option panel, and in the
226 Overnet section. Last entry indicates the kind of widget used (B=Boolean,T=Text)"
227 (list_option (tuple3_option (string_option, string_option, string_option)))
228 *)
229 [
230 "Enable Overnet", shortname enable_overnet, "B";
231 "Port", shortname overnet_port, "T";
232 "Search for keywords", shortname overnet_search_keyword, "B";
233 "Search Timeout", shortname overnet_search_timeout, "T";
234 "Search Internal Period", shortname overnet_query_peer_period, "T";
235 "Search Max Hits", shortname overnet_max_search_hits, "T";
236 ]
237
238 let overnet_options_version =
239 define_option overnet_expert_ini ["overnet_options_version"]
240 "(internal)"
241 int_option 0
242
243
244 (********************************************************************
245
246
247 MUTABLE STRUCTURES
248
249
250 *********************************************************************)
251
252
253 let global_peers : (Md4.t, peer) Hashtbl.t array Options.option_record = define_option servers_ini
254 ["overnet_peers"] "List of overnet peers"
255 (hasharray_option Md4.null PeerOption.t)
256 (Array.init 256 (fun _ -> Hashtbl.create 10))
257
258 let boot_peers = ref []
259
260 (*let firewalled_overnet_peers = Hashtbl.create 13*)
261
262 let published_keyword_set = ref XorMd4Set.empty
263 let published_keyword_table = Hashtbl.create 103
264 let published_keyword_size = ref 0
265
266
267 let search_hits = ref 0
268 let source_hits = ref 0
269
270 let all_overnet_searches = ref ([] : int list)
271
272 let udp_sock = ref None
273 let tcp_sock = ref None
274
275 let udp_buf = Buffer.create 2000
276
277
278 let overnet_searches = Hashtbl.create 13
279 let files_to_be_published = ref []
280
281 (********************************************************************
282
283
284 FUNCTIONS
285
286
287 *********************************************************************)
288
289 let udp_send ip port msg =
290 match !udp_sock with
291 None -> ()
292 | Some sock ->
293 try
294 Buffer.clear udp_buf;
295 buf_int8 udp_buf 227;
296 DonkeyProtoOvernet.write udp_buf msg;
297 let s = Buffer.contents udp_buf in
298 if !verbose_overnet then
299 begin
300 (*Too much traffic for a correct debug*)
301 if (get_int8 s 1) <> 15 && (get_int8 s 1) <> 14 && (get_int8 s 1) <> 19 then
302 begin
303
304 if !verbose_overnet then begin
305 lprintf "Sending UDP to %s:%d type %d (0x%02X)"
306 (Ip.to_string ip) port (get_int8 s 1) (get_int8 s 1);
307 lprint_newline ();
308 (*dump s; lprint_newline ();*)
309 end;
310 end;
311 end;
312 let len = String.length s in
313 UdpSocket.write sock s ip port
314 with e ->
315 lprintf "Exception %s in udp_send" (Printexc2.to_string e);
316 lprint_newline ()
317
318 let remove_old_global_peers () =
319 for i=0 to 255 do
320 Hashtbl.iter ( fun a b ->
321 if (b.peer_last_msg < last_time () - 14400) &&
322 (global_peers_size.(i)>min_peers_per_block) then
323 begin
324 (*lprintf "REM global_peers %s\n" (Md4.to_string a);*)
325 Hashtbl.remove !!global_peers.(i) a;
326 global_peers_size.(i) <- global_peers_size.(i)-1;
327 end
328 ) !!global_peers.(i)
329 done
330
331 (* Find nb peers close to md4 in the peer set *)
332 let get_local_distribution md4 nb =
333 let start_pos=Md4.up md4
334 and peers = ref []
335 and size = ref 0 in
336 begin
337 try
338 let xorset = ref XorSet.empty in
339 Hashtbl.iter
340 ( fun a b -> xorset:=XorSet.add (Md4.xor md4 a,b) !xorset ) !!global_peers.(start_pos);
341
342 begin
343 try
344 for i=1 to nb do
345 let (_,b) as e = XorSet.min_elt !xorset in
346 peers := b :: !peers;
347 xorset:=XorSet.remove e !xorset;
348 incr size;
349 done
350 with _ -> ()
351 end;
352
353 for i=1 to 127 do
354 Hashtbl.iter
355 ( fun a b -> if !size<nb then begin peers := b :: !peers; incr size; end else raise Not_found)
356 !!global_peers.((start_pos+i) mod 256);
357 Hashtbl.iter
358 ( fun a b -> if !size<nb then begin peers := b :: !peers; incr size; end else raise Not_found)
359 !!global_peers.((start_pos-i+256) mod 256);
360 done;
361 with _ -> ()
362 end;
363 !peers
364
365 let get_uniform_distribution () =
366 let peers = ref [] in
367 for i=0 to 15 do
368 let size = ref 0 in
369 for j=0 to 15 do
370 size:=!size+global_peers_size.(16*i+j);
371 done;
372 if !size <> 0 then
373 let pos=ref (Random.int !size) in
374 for j=0 to 15 do
375 if global_peers_size.(16*i+j) < !pos || !pos < 0 then
376 pos := !pos - global_peers_size.(16*i+j)
377 else Hashtbl.iter ( fun a b -> if !pos=0 then peers := b :: !peers; decr pos )
378 !!global_peers.(16*i+j);
379 done;
380 done;
381 !peers
382
383 let find_oldest_peer hashtbl =
384 let md4 = ref Md4.null and
385 time = ref (last_time () ) in
386 Hashtbl.iter ( fun a b ->
387 if b.peer_last_msg < !time then
388 begin
389 md4 := a;
390 time := b.peer_last_msg;
391 end
392 ) hashtbl;
393 !md4
394
395 let private_address ip =
396 Ip.matches ip [(Ip.of_string "0.0.0.0"); (Ip.of_string "127.0.0.255");
397 (Ip.of_string "10.255.255.255"); (Ip.of_string "192.168.255.255") ]
398
399 (* Replace private IP by public IPs in peer list *)
400 let change_private_address ip public_ip =
401 if private_address ip then public_ip
402 else ip
403
404 let add_global_peer peer =
405 if not ( is_black_address peer.peer_ip peer.peer_port ) &&
406 not ( private_address peer.peer_ip ) then
407 begin
408 if (peer.peer_ip <> client_ip None) && (peer.peer_md4 <> overnet_md4) then
409 begin
410 let i=Md4.up peer.peer_md4 in
411 if Hashtbl.mem !!global_peers.(i) peer.peer_md4 then
412 begin
413 (*lprintf "UPD global_peers: %s\n" (Md4.to_string peer.peer_md4);*)
414 (Hashtbl.find !!global_peers.(i) peer.peer_md4).peer_last_msg <- last_time();
415 end
416 else
417 begin
418 if global_peers_size.(i) >= (!!overnet_max_known_peers/256) then
419 begin
420 let p = find_oldest_peer !!global_peers.(i) in
421 (*lprintf "REM global_peers: %s\n" (Md4.to_string p);*)
422 Hashtbl.remove !!global_peers.(i) p;
423 global_peers_size.(i) <- global_peers_size.(i)-1;
424 end;
425 (*lprintf "ADD global_peers: %s\n" (Md4.to_string peer.peer_md4);*)
426 peer.peer_last_msg <- last_time();
427 Hashtbl.add !!global_peers.(i) peer.peer_md4 peer;
428 global_peers_size.(i) <- global_peers_size.(i)+1;
429 end
430 end
431 else
432 if !verbose_overnet then
433 begin
434 lprintf "Tried to add myself as a peer: %s/%s %s/%s\n"
435 (Ip.to_string peer.peer_ip) (Ip.to_string (client_ip None))
436 (Md4.to_string peer.peer_md4) (Md4.to_string overnet_md4);
437 end
438 end
439
440 (*advertize an uniform distribution then a local distribution (around our MD4) that we are UP*)
441 let publicize_peers () =
442 let global_dist = get_uniform_distribution () in
443 let local_dist = get_local_distribution overnet_md4 search_max_queries in
444 List.iter (fun a ->
445 udp_send a.peer_ip a.peer_port
446 (OvernetPublicize(overnet_md4,
447 client_ip None,!overnet_client_port, 0) ) )
448 global_dist;
449 List.iter (fun a ->
450 udp_send a.peer_ip a.peer_port
451 (OvernetPublicize(overnet_md4,
452 client_ip None,!overnet_client_port, 0) ) )
453 local_dist
454
455 (* If one peer block is running low, try to get new peers using Connect *)
456 let find_new_peers () =
457 try
458 for i=0 to 255 do
459 if global_peers_size.(i) < min_peers_before_connect then raise Not_found;
460 done
461 with _ ->
462 begin
463 if !verbose_overnet then begin
464 lprintf "FINDING NEW PEERS"; lprint_newline ();
465 end;
466 List.iter (fun a -> udp_send a.peer_ip a.peer_port
467 (OvernetConnect(overnet_md4,client_ip None,!overnet_client_port, 0) ) )
468 (get_uniform_distribution () ) ;
469 end
470
471 (*
472 (* Used to prevent reloading the pages too often (max is 1/hour) *)
473 let next_automatic_ocl_load = ref 0
474 let automatic_ocl_load force =
475 match get_uniform_distribution () with
476 [] ->
477 if force || !next_automatic_ocl_load < last_time () then
478 begin
479 next_automatic_ocl_load := last_time () + 3600;
480 if !verbose_overnet then begin
481 lprintf "NEED TO BOOT FROM KNOWN PEERS"; lprint_newline();
482 end;
483 List.iter (fun url ->
484 lprintf "Loading %s\n" url;
485 load_url "ocl" url) !!overnet_default_ocl;
486 end
487 | _ -> ()
488 *)
489
490 let add_search_peer s p =
491 if not (Hashtbl.mem s.search_known_peers (p.peer_ip,p.peer_port)) &&
492 not (is_black_address p.peer_ip p.peer_port) &&
493 not (private_address p.peer_ip) then
494 begin
495 Hashtbl.add s.search_known_peers (p.peer_ip,p.peer_port) p;
496 let distance = Md4.xor s.search_md4 p.peer_md4 in
497 if s.search_total_peers >= search_max_queries then
498 begin
499 let (dd1,pp1) as e1 =
500 if (XorSet.cardinal s.search_not_asked_peers)=0 then (Md4.null,p)
501 else XorSet.max_elt s.search_not_asked_peers and
502 (dd2,pp2) as e2 =
503 if (XorSet.cardinal s.search_asked_peers)=0 then (Md4.null,p)
504 else XorSet.max_elt s.search_asked_peers and
505 (dd3,pp3) as e3 =
506 if (XorSet.cardinal s.search_done_peers)=0 then (Md4.null,p)
507 else XorSet.max_elt s.search_done_peers in
508
509 if dd1>distance then
510 begin
511 (* Better than one not-yet-asked peer : replace it ! *)
512 s.search_not_asked_peers <- XorSet.remove (dd1, pp1) s.search_not_asked_peers;
513 s.search_not_asked_peers <- XorSet.add (distance, p) s.search_not_asked_peers;
514 (*lprintf "add_search_peer(%s) : add peer at distance %s [REPLACE]\n"
515 (Md4.to_string s.search_md4) (Md4.to_string distance);*)
516
517 end
518 else if dd2>distance || dd3>distance then
519 begin
520 (* We have already asked a peer which is worse. Anyway, we shouldn't drop this one*)
521 s.search_not_asked_peers <- XorSet.add (distance, p) s.search_not_asked_peers;
522 s.search_total_peers <- s.search_total_peers + 1 ;
523 (*lprintf "add_search_peer(%s) : add peer at distance %s [ADD]\n"
524 (Md4.to_string s.search_md4) (Md4.to_string distance);*)
525 end
526 end
527 else
528 begin
529 s.search_not_asked_peers <- XorSet.add (distance, p) s.search_not_asked_peers;
530 s.search_total_peers <- s.search_total_peers + 1 ;
531 (*lprintf "add_search_peer(%s) : add peer at distance %s [NOT ENOUGH]\n"
532 (Md4.to_string s.search_md4) (Md4.to_string distance);*)
533
534 end
535 end
536
537 let create_search kind md4 =
538 let search = {
539 search_md4 = md4;
540 search_kind = kind;
541 search_last_insert=last_time();
542
543 search_not_asked_peers=XorSet.empty;
544 search_asked_peers=XorSet.empty;
545 search_done_peers=XorSet.empty;
546 search_total_peers=0;
547 search_known_peers = Hashtbl.create 32;
548
549 search_nresults = 0;
550 search_publish_files = [];
551 search_publish_file = false;
552 search_results = Hashtbl.create 13;
553 search_hits = 0;
554 } in
555 List.iter (fun peer -> add_search_peer search peer) (get_local_distribution md4 search_max_queries);
556 search
557
558 let create_keyword_search w =
559 let md4 = Md4.string w in
560 try
561 let search=Hashtbl.find overnet_searches md4 in
562 List.iter (fun peer -> add_search_peer search peer) (get_local_distribution md4 search_max_queries);
563 search
564 with _ ->
565 let search = {
566 search_md4 = md4;
567 search_kind = KeywordSearch [];
568 search_last_insert=last_time();
569
570 search_not_asked_peers=XorSet.empty;
571 search_asked_peers=XorSet.empty;
572 search_done_peers=XorSet.empty;
573 search_total_peers=0;
574 search_known_peers = Hashtbl.create 32;
575
576 search_publish_files = [];
577 search_publish_file = false;
578 search_results = Hashtbl.create 13;
579 search_nresults = 0;
580 search_hits = 0;
581 } in
582 List.iter (fun peer -> add_search_peer search peer) (get_local_distribution md4 search_max_queries);
583 search
584
585 let store_published_file kw_md4 file_md4 file_tags time =
586 let dist = Md4.xor overnet_md4 kw_md4 in
587
588 if !verbose_overnet then
589 begin
590 lprintf "PUBLISH at %s (dist=%s)" (Md4.to_string kw_md4) (Md4.to_string dist);
591 lprint_newline ();
592 end;
593
594 try
595 let (size, files) = Hashtbl.find published_keyword_table kw_md4 in
596
597 try
598 let (tags, file_time) = XorMd4Map.find file_md4 !files in
599 file_time := time
600 with _ ->
601 incr size;
602 files := XorMd4Map.add file_md4 (file_tags, ref time) !files
603
604 with _ ->
605 let do_it =
606 if !published_keyword_size > !!overnet_store_size then
607
608 (* Take the keyword which is the furthest from us, and remove it if
609 it is farther than the new file *)
610
611 let (max_elt, max_md4) as e =
612 XorMd4Set.min_elt !published_keyword_set in
613 let distance = Md4.xor overnet_md4 kw_md4 in
614 if distance < max_elt then begin
615 published_keyword_set := XorMd4Set.remove e
616 !published_keyword_set;
617 Hashtbl.remove published_keyword_table max_md4;
618 decr published_keyword_size;
619 true
620 end else false
621 else true
622 in
623
624 if do_it then begin
625 incr published_keyword_size;
626 Hashtbl.add published_keyword_table kw_md4
627 (ref 1, ref (XorMd4Map.add file_md4 (file_tags, ref time)
628 XorMd4Map.empty));
629 published_keyword_set := XorMd4Set.add
630 (Md4.xor overnet_md4 kw_md4, kw_md4)
631 !published_keyword_set
632 end
633
634
635 (*
636 if Md4.up2 dist = 0 then
637 begin
638 if !published_files_size2 >= ((!!overnet_store_size*8)/10) then
639 begin
640 let rem = (Queue.take published_files_fifo2) in
641 decr published_files_size2;
642 Hashtbl.remove published_files2 rem;
643 end;
644 Queue.add md4 published_files_fifo2;
645 Hashtbl.add published_files2 md4 file (last_time ());
646 incr published_files_size2;
647 end
648 else
649 begin
650 if !published_files_size1 >= ((!!overnet_store_size*2)/10) then
651 begin
652 let rem = (Queue.take published_files_fifo1) in
653 decr published_files_size1;
654 Hashtbl.remove published_files1 rem;
655 end;
656 Queue.add md4 published_files_fifo1;
657 Hashtbl.add published_files1 md4 (file, last_time ());
658 incr published_files_size1;
659 end
660 *)
661
662 let clean_published_files () =
663 let min_time = last_time () - 3600 in
664 let keywords = Hashtbl2.to_list2 published_keyword_table in
665 Hashtbl.clear published_keyword_table;
666 published_keyword_set := XorMd4Set.empty;
667 published_keyword_size := 0;
668 List.iter (fun (kw_md4, (size, files)) ->
669 XorMd4Map.iter (fun file_md4 (file_tags, time) ->
670 if !time > min_time then
671 store_published_file kw_md4 file_md4 file_tags !time
672 ) !files
673 ) keywords
674
675 let get_results_from_query ip port kw_md4 min max =
676
677 let rec iter1 n xorset =
678 if n < max then
679 let (distance,md4) as e = XorMd4Set.min_elt xorset in
680 let (size, files) = Hashtbl.find published_keyword_table md4 in
681 iter2 n xorset files
682
683 and iter2 n xorset files =
684 let n_sent = ref n in
685 XorMd4Map.iter (fun file_md4 (file_tags, time) ->
686 incr n_sent;
687 if !n_sent > min then
688 udp_send ip port (OvernetSearchResult(kw_md4,file_md4,file_tags));
689 if !n_sent > max then raise Exit) !files;
690 iter1 !n_sent xorset
691 in
692
693 let xorset = ref XorMd4Set.empty in
694 Hashtbl.iter (fun key_md4 _ ->
695 xorset:=XorMd4Set.add (Md4.xor kw_md4 key_md4,key_md4) !xorset )
696 published_keyword_table;
697 iter1 0 !xorset
698
699 let recover_file (file : DonkeyTypes.file) =
700 try
701 let s = Hashtbl.find overnet_searches file.file_md4 in ()
702 with _ ->
703 let s=create_search (FileSearch file) file.file_md4 in
704 Hashtbl.add overnet_searches s.search_md4 s
705
706 let publish_file (file : DonkeyTypes.file) =
707 begin
708 try
709 begin
710 let s = Hashtbl.find overnet_searches file.file_md4 in
711 s.search_publish_file <- true;
712 end
713 with _ ->
714 begin
715 let s = create_search (FileSearch file) file.file_md4 in
716 s.search_publish_file <- true;
717 files_to_be_published := s :: !files_to_be_published;
718 end
719 end;
720 if !!overnet_search_keyword then
721 begin
722 let index_string w =
723 let s = create_keyword_search w in
724 s.search_publish_files <- file :: s.search_publish_files;
725 files_to_be_published := s :: !files_to_be_published;
726 in
727 List.iter (fun name -> List.iter index_string (String2.stem name) )
728 file.file_filenames;
729 end
730
731 let recover_all_files () =
732 List.iter (fun file ->
733 if file_state file = FileDownloading then
734 recover_file file
735 ) !DonkeyGlobals.current_files
736
737 let ip_of_udp_packet p =
738 match p.UdpSocket.addr with
739 Unix.ADDR_INET (inet, port) ->
740 Ip.of_inet_addr inet
741 | _ -> assert false
742
743 let port_of_udp_packet p =
744 match p.UdpSocket.addr with
745 Unix.ADDR_INET (inet, port) -> port
746 | _ -> assert false
747
748 let rec get_filename tags =
749 match tags
750 with
751 [] -> ""
752 | tag :: tags ->
753 begin
754 if tag.tag_name = "filename"
755 then
756 match tag.tag_value with
757 | String s -> s
758 | _ -> ""
759 else get_filename tags
760 end
761
762 let check_filename q tags =
763 let filename = get_filename tags in
764 let rec check_iter q =
765 match q with
766 QAnd (q1, q2) -> (check_iter q1) && (check_iter q2)
767 | QOr (q1, q2) -> (check_iter q1) || (check_iter q2)
768 | QAndNot (q1, q2) -> (check_iter q1) && (not (check_iter q2))
769 | QHasWord s ->
770 begin
771 if !verbose_overnet then begin
772 lprintf "%s CONTAINS[%s]" filename s;
773 lprint_newline ();
774 end;
775 true
776 end
777 | _ -> true
778 in
779 check_iter q
780
781 let udp_client_handler t p =
782 match t with
783 | OvernetConnectReply peers ->
784 begin
785 let peers = List.rev peers in
786 match peers with
787 peer :: tail ->
788
789 let other_ip = ip_of_udp_packet p in
790 if !verbose_overnet then begin
791 lprintf "sender IP was %s" (Ip.to_string peer.peer_ip); lprint_newline ();
792 end;
793 peer.peer_ip <- (change_private_address peer.peer_ip other_ip);
794
795 peer.peer_last_msg <- last_time ();
796 add_global_peer peer;
797
798 if !verbose_overnet then
799 begin
800 lprintf "Connected to %s:%d" (Ip.to_string peer.peer_ip) peer.peer_port;
801 lprint_newline ();
802 end;
803
804 (* everything else sould be added *)
805 List.iter add_global_peer tail;
806
807 Hashtbl.iter
808 (fun _ search -> add_search_peer search peer)
809 overnet_searches;
810
811 Hashtbl.iter
812 (fun _ search -> List.iter (fun a -> add_search_peer search a) tail)
813 overnet_searches;
814
815 | _ -> ()
816 end
817
818 | OvernetPublicize (md4, ip, port, kind ) ->
819 begin
820 let other_ip = ip_of_udp_packet p in
821 if !verbose_overnet then
822 begin
823 lprintf "sender IP was %s - packet was from %s"
824 (Ip.to_string ip) (Ip.to_string other_ip);
825 lprint_newline ();
826 end;
827 add_global_peer {
828 peer_md4=md4;
829 peer_ip=(change_private_address ip other_ip);
830 peer_port=port;
831 peer_kind=kind;
832 peer_last_msg=last_time();
833 };
834
835 (* send the PUBLICIZED message *)
836 udp_send other_ip port OvernetPublicized
837 end
838 | OvernetPublicized -> ()
839 | OvernetSearch (nb, md4) ->
840 begin
841 try
842 let (s_ip, s_port) as s_addr =
843 match p.UdpSocket.addr with
844 | Unix.ADDR_INET(ip, port) -> Ip.of_inet_addr ip, port
845 | _ -> raise Not_found
846 in
847
848 let peers = (get_local_distribution md4 nb) in
849 udp_send s_ip s_port (OvernetSearchReply(md4,peers));
850 with _ -> lprintf "Cannot find the client IP\n"
851 end
852 | OvernetPublish (md4, r_md4, r_tags) ->
853 begin
854 let other_ip = ip_of_udp_packet p in
855 let other_port = port_of_udp_packet p in
856 store_published_file md4 r_md4 r_tags (last_time ());
857 udp_send other_ip other_port (OvernetPublished md4);
858 end
859 | OvernetGetSearchResults (md4, kind, min, max) ->
860 begin
861 let other_ip = ip_of_udp_packet p in
862 let other_port = port_of_udp_packet p in
863 if !verbose_overnet then
864 begin
865 lprintf "GET SEARCH RESULT for %s %d %d %d"
866 (Md4.to_string md4) kind min max;
867 lprint_newline ();
868 end;
869 get_results_from_query other_ip other_port md4 min max;
870 udp_send other_ip other_port (OvernetNoResult md4);
871 end
872 | OvernetPublished (md4) -> ()
873 | OvernetSearchReply (md4, peers) ->
874 begin
875 try
876 begin
877 let s = Hashtbl.find overnet_searches md4 in
878 begin
879 try
880 let (s_ip, s_port) as s_addr =
881 match p.UdpSocket.addr with
882 | Unix.ADDR_INET(ip, port) -> Ip.of_inet_addr ip, port
883 | _ -> raise Not_found
884 in
885
886 begin
887 try
888 let sender = Hashtbl.find s.search_known_peers s_addr in
889 let distance = Md4.xor sender.peer_md4 md4 in
890
891 sender.peer_last_msg <- last_time();
892 if XorSet.mem (distance, sender) s.search_asked_peers then
893 begin
894 s.search_asked_peers <- XorSet.remove (distance, sender) s.search_asked_peers;
895 s.search_done_peers <- XorSet.add (distance, sender) s.search_done_peers;
896 end
897 else
898 lprintf "BUG: This peer returned results but cannot be found !\n";
899
900 if !verbose_overnet then
901 begin
902 lprintf "SEARCH_PEER(%s): got answer" (Md4.to_string md4);
903 lprint_newline ();
904 end;
905 with _ -> (* Cannot find this peer to update his last_msg, this is not an issue*)
906 ()
907 end
908
909 with _ -> ()
910 (* Cannot find sender IP... However, we can still use his results *)
911 end;
912
913 List.iter (fun p -> add_search_peer s p; add_global_peer p) peers
914 end
915 with _ -> lprintf "NO SUCH SEARCH : %s" (Md4.to_string md4); lprint_newline ();
916 end
917 | OvernetNoResult(md4) -> ()
918 (* Nothing to do here, there is just no results to our search *)
919 | OvernetSearchResult (md4, r_md4, r_tags) ->
920 begin
921 try
922 let s = Hashtbl.find overnet_searches md4 in
923 s.search_nresults <- s.search_nresults + 1;
924
925 (* If we cannot find the peer, we can still use his results*)
926 begin
927 try
928 let (s_ip, s_port) as s_addr =
929 match p.UdpSocket.addr with
930 | Unix.ADDR_INET(ip, port) -> Ip.of_inet_addr ip, port
931 | _ -> raise Not_found
932 in
933 let sender = Hashtbl.find s.search_known_peers s_addr in
934 sender.peer_last_msg <- last_time();
935 with _ -> ()
936 end;
937
938 match s.search_kind with
939 FileSearch file ->
940
941 List.iter (fun tag ->
942 if tag.tag_name = "loc" then
943 begin
944 match tag.tag_value with
945 String bcp ->
946 if String2.starts_with bcp "bcp://" then
947 let bcp2 = String.sub bcp 6 (String.length bcp - 6)
948 in
949 begin
950 match String2.split_simplify bcp2 ':' with
951 | [_;ip;port] ->
952 if !verbose_overnet then begin
953 lprintf "FIXME: Received a BCP type 2 %s for MD4 %s, port=%d"
954 bcp (Md4.to_string md4) 4662;
955 lprint_newline ();
956 end;
957 (*Hashtbl.add firewalled_overnet_peers md4 file;
958 udp_send
959 (Ip.of_string ip) (int_of_string port)
960 (OvernetFirewallConnection(r_md4,4662))*)
961 | [ip;port] ->
962 incr source_hits;
963 let ip = Ip.of_string ip in
964 let port = int_of_string port in
965 (*lprintf "FIXME: Received a BCP type 1 %s for MD4 %s"
966 bcp (Md4.to_string md4);
967 lprint_newline (); *)
968 if Ip.valid ip && Ip.reachable ip then
969 let c = DonkeySources.new_source (ip, port) file in
970 c.source_overnet <- true;
971 | _ ->
972 lprintf "Ill formed bcp: %s" bcp;
973 lprint_newline ();
974 end
975 else
976 begin
977 lprintf "Not a bcp !!!";
978 lprint_newline ();
979 end
980 | _ ->
981 lprintf "Not a string location ??";
982 lprint_newline ();
983 end
984 ) r_tags;
985 | KeywordSearch sss ->
986 incr search_hits;
987 if not (Hashtbl.mem s.search_results r_md4) then
988 begin
989 s.search_hits <- s.search_hits + 1;
990 Hashtbl.add s.search_results r_md4 r_tags;
991
992 (*lprintf "FILE FOUND, TAGS: "; lprint_newline ();
993 print_tags r_tags; lprint_newline ();*)
994
995 List.iter (fun ss ->
996 (*
997 if check_filename ss.search_query r_tags then
998 begin
999 lprintf "Matched";
1000 lprint_newline ();
1001 *)
1002 DonkeyOneFile.search_found true ss r_md4 r_tags;
1003 (* end
1004 else
1005 begin
1006 lprintf "Not matched";
1007 lprint_newline ();
1008 end
1009 *)
1010 ) sss
1011
1012 end;
1013
1014 with _ ->
1015 lprintf "NO SUCH SEARCH..."; lprint_newline ();
1016 end
1017
1018 | OvernetFirewallConnectionACK(md4) ->
1019 begin
1020 lprintf "OVERNET FIREWALL ACK for md4=%s" (Md4.to_string md4);
1021 lprint_newline ();
1022 end
1023
1024 | OvernetFirewallConnectionNACK(md4) ->
1025 begin
1026 lprintf "OVERNET FIREWALL NACK for md4=%s" (Md4.to_string md4);
1027 lprint_newline ();
1028 end
1029
1030 (* send the answer *)
1031 | OvernetGetMyIP other_port ->
1032 begin
1033 let other_ip = ip_of_udp_packet p in
1034 (* FIXME : should be able to flush the UDP buffer*)
1035 udp_send other_ip other_port (OvernetGetMyIPResult other_ip);
1036 udp_send other_ip other_port OvernetGetMyIPDone;
1037 end
1038
1039 | OvernetGetMyIPResult(ip) -> ()
1040
1041 | OvernetGetMyIPDone -> ()
1042
1043 | OvernetUnknown _ ->
1044 lprintf "Last Unknown message coming from %s:%d"
1045 (Ip.to_string (ip_of_udp_packet p)) (port_of_udp_packet p);
1046 lprint_newline ()
1047
1048
1049 | _ ->
1050 if !verbose_overnet then begin
1051 lprintf "UNUSED MESSAGE"; lprint_newline ()
1052 end
1053
1054 let query_min_peer s =
1055 try
1056 let (d,p) as e = XorSet.min_elt s.search_not_asked_peers in
1057 if !verbose_overnet then
1058 begin
1059 lprintf "SEARCH(%s): Query a not asked peer at distance %s"
1060 (Md4.to_string s.search_md4) (Md4.to_string d);
1061 lprint_newline ();
1062 end;
1063 s.search_not_asked_peers <- XorSet.remove e s.search_not_asked_peers;
1064 s.search_asked_peers <- XorSet.add e s.search_asked_peers;
1065 s.search_last_insert <- last_time();
1066
1067 udp_send p.peer_ip p.peer_port (OvernetSearch (10, s.search_md4));
1068
1069 begin
1070 match s.search_kind with
1071 KeywordSearch sss ->
1072 if sss <> [] then
1073 udp_send p.peer_ip p.peer_port
1074 (OvernetGetSearchResults (s.search_md4,0,0,100));
1075 List.iter
1076 (fun file ->
1077 udp_send p.peer_ip p.peer_port
1078 (OvernetPublish (s.search_md4, file.file_md4,
1079 DonkeyProtoCom.tag_file file))
1080 ) s.search_publish_files
1081 | FileSearch file ->
1082 if file_state file = FileDownloading then
1083 udp_send p.peer_ip p.peer_port
1084 (OvernetGetSearchResults (s.search_md4,0,0,100));
1085 if s.search_publish_file then
1086 udp_send p.peer_ip p.peer_port
1087 (OvernetPublish (s.search_md4, overnet_md4,
1088 [{
1089 tag_name = "loc";
1090 tag_value = String (
1091 Printf.sprintf "bcp://%s:%d"
1092 (Ip.to_string (client_ip None))
1093 (!!overnet_port)
1094 )
1095 }]
1096 )
1097 )
1098 end
1099 with _ -> ()
1100
1101 let query_next_peers () =
1102 Hashtbl2.safe_iter (fun s ->
1103 let asked_card = XorSet.cardinal s.search_asked_peers and
1104 not_asked_card = XorSet.cardinal s.search_not_asked_peers in
1105
1106 (* Cases to stop a search :
1107 1/ enough hits
1108 2/ size(asked)=0 && size(not_asked)=0
1109 3/ size(not_asked)=0 && timeout *)
1110
1111 if (s.search_hits > !!overnet_max_search_hits) ||
1112 ( (s.search_last_insert + !!overnet_search_timeout < last_time ()) && not_asked_card=0 ) ||
1113 ( not_asked_card = 0 && asked_card = 0 ) then
1114 begin
1115 if !verbose_overnet then begin
1116 lprintf "Search for %s finished (%d hits %d results)"
1117 (Md4.to_string s.search_md4) s.search_hits s.search_nresults;
1118 lprint_newline ();
1119 end;
1120 Hashtbl.remove overnet_searches s.search_md4;
1121 end
1122 else
1123 begin
1124 query_min_peer s;
1125 query_min_peer s;
1126 end
1127 ) overnet_searches
1128
1129
1130 let do_publish_shared_files () =
1131 let nb_searches = ref 0 in
1132 Hashtbl.iter (fun _ _ -> incr nb_searches) overnet_searches;
1133 let launch () =
1134 match !files_to_be_published with
1135 [] -> ()
1136 | file::tail ->
1137 begin
1138 if !verbose_overnet then
1139 begin
1140 lprintf "OVERNET: I am publishing a file";
1141 lprint_newline ();
1142 end;
1143 files_to_be_published := tail;
1144 Hashtbl.add overnet_searches file.search_md4 file;
1145 end
1146 in
1147 if !nb_searches <= max_searches_for_publish then
1148 begin
1149 (*lprintf "OVERNET: currently %d searches" !nb_searches;
1150 lprint_newline ();*)
1151 for i=1 to 5 do
1152 launch ();
1153 done;
1154 end
1155
1156 let publish_shared_files () =
1157 match !files_to_be_published with
1158 [] -> List.iter (fun file -> publish_file file) (DonkeyShare.all_shared ())
1159 | _ -> ()
1160
1161 let check_curent_downloads () =
1162 List.iter (fun file ->
1163 if file_state file = FileDownloading
1164 &&
1165 not (Hashtbl.mem overnet_searches file.file_md4) then
1166 let search = create_search (FileSearch file) file.file_md4 in
1167 Hashtbl.add overnet_searches file.file_md4 search;
1168 ) !DonkeyGlobals.current_files
1169
1170 let enable enabler =
1171
1172 let sock = (UdpSocket.create (Ip.to_inet_addr !!donkey_bind_addr)
1173 (!!overnet_port) (udp_handler udp_client_handler)) in
1174 udp_sock := Some sock;
1175
1176 UdpSocket.set_write_controler sock udp_write_controler;
1177
1178 begin
1179 try
1180 let sock = TcpServerSocket.create
1181 "overnet client server"
1182 (Ip.to_inet_addr !!donkey_bind_addr)
1183 (!!overnet_port) (DonkeyClient.client_connection_handler true) in
1184
1185 tcp_sock := Some sock;
1186
1187 match Unix.getsockname (BasicSocket.fd (TcpServerSocket.sock sock)) with
1188 Unix.ADDR_INET (ip, port) ->
1189 overnet_client_port := port
1190 | _ -> failwith "Bad socket address"
1191 with e ->
1192 lprintf "Could not affect a TCP port %d for Overnet" !!overnet_port;
1193 lprint_newline ();
1194 tcp_sock := None;
1195 end;
1196
1197 (* every 3min try a new publish search, if any *)
1198 add_session_timer enabler 180. (fun _ ->
1199 if !!enable_overnet then begin
1200 find_new_peers ();
1201 do_publish_shared_files ();
1202 end
1203 );
1204
1205 add_session_timer enabler 1. (fun _ ->
1206 if !!enable_overnet then begin
1207 match !boot_peers with
1208 [] -> ()
1209 | _ ->
1210 for i = 1 to 5 do
1211 match !boot_peers with
1212 [] -> ()
1213 | (ip, port) :: tail ->
1214 boot_peers := tail;
1215 udp_send ip port (OvernetConnect(overnet_md4,client_ip None,
1216 !overnet_client_port, 0));
1217 done
1218 end
1219 );
1220
1221 add_session_option_timer enabler overnet_query_peer_period (fun _ ->
1222 if !!enable_overnet then begin
1223 query_next_peers ();
1224 end
1225 );
1226 (* every 3h for re-publish and cleaning *)
1227 add_session_timer enabler 10800. (fun _ ->
1228 (try clean_published_files () with _ -> ());
1229 if !!enable_overnet then begin
1230 remove_old_global_peers ();
1231 publish_shared_files ()
1232 end
1233 );
1234
1235 (* every 30min for common operations *)
1236 add_session_timer enabler 1800. (fun _ ->
1237 if !!enable_overnet then begin
1238 recover_all_files ();
1239 end
1240 );
1241
1242 (* every 15min for light operations *)
1243 add_session_timer enabler 900. (fun _ ->
1244 if !!enable_overnet then begin
1245 publicize_peers ();
1246 check_curent_downloads ();
1247 end
1248 );
1249
1250 (* 1st time timers : we cannot afford waiting too much to get connected *)
1251 add_timer 50. (fun timer ->
1252 if !!enable_overnet then begin
1253 publicize_peers ()
1254 end
1255 );
1256
1257 add_timer 20. (fun timer ->
1258 if !!enable_overnet then begin
1259 find_new_peers ();
1260 (*publish is in fact controled by do_publish_shared_files, every 2 min*)
1261 publish_shared_files ()
1262 end
1263 )
1264
1265 let _ =
1266 option_hook overnet_query_peer_period
1267 (fun _ -> if !!overnet_query_peer_period < 5. then overnet_query_peer_period =:= 5.);
1268 option_hook overnet_max_known_peers
1269 (fun _ -> if !!overnet_max_known_peers < 2048 then overnet_max_known_peers =:= 2048)
1270
1271 let disable () =
1272 match !udp_sock with
1273 None -> ()
1274 | Some sock ->
1275 udp_sock := None;
1276 UdpSocket.close sock Closed_by_user
1277
1278 let parse_overnet_url url =
1279 match String2.split (String.escaped url) '|' with
1280 | "fha://" :: "boot" :: name :: port :: _
1281 | "boot" :: name :: port :: _ ->
1282 let ip = Ip.from_name name in
1283 let port = int_of_string port in
1284 udp_send ip port (OvernetConnect(overnet_md4,client_ip None,!overnet_client_port, 0));
1285 true
1286 | _ -> false
1287
1288 let connected_peers () =
1289 List.map (fun p -> p.peer_ip, p.peer_port) (get_uniform_distribution ())
1290
1291 let _ =
1292 register_commands
1293 [
1294 "boot", Arg_two (fun ip port o ->
1295 let ip = Ip.from_name ip in
1296 let port = int_of_string port in
1297 udp_send ip port (OvernetConnect(overnet_md4,client_ip None,!overnet_client_port, 0));
1298 Printf.sprintf "peer %s:%d added" (Ip.to_string ip) port
1299 ), "<ip> <port> :\t\t\tadd an Overnet peer";
1300
1301 "ovlink", Arg_multiple (fun args o ->
1302 let buf = o.conn_buf in
1303 let url = String2.unsplit args ' ' in
1304 if parse_overnet_url url then
1305 "download started"
1306 else "bad syntax"
1307 ), "<fhalink> :\t\t\tdownload fha:// link";
1308
1309 "ovstats", Arg_none (fun o ->
1310 let buf = o.conn_buf and sum = ref 0 in
1311 Printf.bprintf buf "Overnet statistics:\n";
1312 Printf.bprintf buf " Search hits: %d\n" !search_hits;
1313 Printf.bprintf buf " Source hits: %d\n" !source_hits;
1314 Printf.bprintf buf " peers blocks (max peer number per block = %d) :\n" (!!overnet_max_known_peers/256);
1315 Printf.bprintf buf " This is a list of known peers, sorted by the first byte of their md4 address ( 05FE15E90678... => block 05)\n";
1316 for i=0 to 15 do
1317 Printf.bprintf buf " ";
1318 for j=0 to 15 do
1319 Printf.bprintf buf "%02X: %3d " (i*16+j) global_peers_size.(i*16+j);
1320 sum := !sum + global_peers_size.(i*16+j);
1321 done;
1322 Printf.bprintf buf "\n";
1323 done;
1324 Printf.bprintf buf " Number of known Overnet peers = %d\n" !sum;
1325
1326 Hashtbl.iter (fun _ s ->
1327 Printf.bprintf buf
1328 "Search %s for %s (%d not_asked, %d asked, %d done, %d hits, %d results) %s%s\n"
1329 (match s.search_kind with
1330 KeywordSearch _ -> "keyword"
1331 | FileSearch _ -> "file")
1332 (Md4.to_string s.search_md4)
1333 (XorSet.cardinal s.search_not_asked_peers)
1334 (XorSet.cardinal s.search_asked_peers)
1335 (XorSet.cardinal s.search_done_peers)
1336 s.search_hits
1337 s.search_nresults
1338 (match s.search_kind, s.search_publish_files with
1339 | KeywordSearch [], _ :: _ -> "publish "
1340 | KeywordSearch (_ :: _) , [] -> "query "
1341 | KeywordSearch (_ :: _), _ :: _ -> "publish+query "
1342 | KeywordSearch [], [] -> "??? "
1343 | FileSearch _, _ -> "")
1344 (if s.search_publish_file then "file_publish " else "")
1345 ;
1346 ) overnet_searches;
1347
1348 "";
1349 ), ":\t\t\t\tOvernet Stats";
1350
1351 "ovweb", Arg_multiple (fun args o ->
1352 let urls =
1353 match args with
1354 [] -> let list = ref [] in
1355 List.iter (fun (kind,_, url) ->
1356 if kind = "ocl" then list := url :: !list
1357 )!!web_infos;
1358 !list
1359 | _ -> args
1360 in
1361 List.iter (fun url ->
1362 Printf.bprintf o.conn_buf "Loading %s\n" url;
1363 load_url "ocl" url) urls;
1364 "web boot started"
1365 ), "<urls> :\t\t\t\tdownload .ocl URLS (no arg load default)";
1366
1367 "ovmd4", Arg_none (fun o -> "MD4 is " ^ (Md4.to_string overnet_md4);
1368 ), ":\t\t\t\t\tget client MD4 address on the overnet network";
1369
1370 "ovstore", Arg_none (fun o ->
1371 let buf = o.conn_buf in
1372
1373 Printf.bprintf buf "Overnet store:\n";
1374 Printf.bprintf buf " size = %d, max_size = %d\n"
1375 !published_keyword_size !!overnet_store_size;
1376 Printf.bprintf buf "\n";
1377
1378 Hashtbl.iter (fun kw_md4 (size, files) ->
1379 Printf.bprintf buf " md4=%s, files =\n" (Md4.to_string kw_md4);
1380 XorMd4Map.iter (fun file_md4 (file_tags,_) ->
1381 Printf.bprintf buf " r_md4=%s\n" (Md4.to_string file_md4);
1382 Printf.bprintf buf " tags=";
1383 bprint_tags buf file_tags;
1384 Printf.bprintf buf "\n";
1385 ) !files
1386 ) published_keyword_table;
1387
1388 ""
1389 ), ":\t\t\t\tdump the Overnet File Store";
1390
1391
1392 "ovtst", Arg_two (fun a b o ->
1393 let md41 = Md4.of_string a in
1394 let md42 = Md4.of_string b in
1395 store_published_file md41 md42
1396 [
1397 string_tag "filename" "john" ;
1398 int_tag "size" (Random.int 200);
1399 ] 0;
1400 ""
1401 ), ":\t\t\t\t\t(not documented)";
1402
1403 "ovtst2", Arg_two (fun a b o ->
1404 let md4 = Md4.of_string a in
1405 let size = int_of_string b in
1406 get_results_from_query (Ip.of_string "10.0.0.10") (4665) md4 0 size;
1407 ""
1408 ), ":\t\t\t\t(not documented)";
1409
1410 ];
1411
1412 add_web_kind "ocl" (fun filename ->
1413 let s = File.to_string filename in
1414 let s = String2.replace s '"' "" in
1415 let lines = String2.split_simplify s '\n' in
1416 List.iter (fun s ->
1417 try
1418 match String2.split_simplify s ',' with
1419 name :: port :: _ ->
1420 let name = String2.replace name '"' "" in
1421 let port = String2.replace port '"' "" in
1422 Ip.async_ip name (fun ip ->
1423 let port = int_of_string port in
1424 if !verbose_overnet then begin
1425 lprintf "ADDING OVERNET PEER %s:%d" name port;
1426 lprint_newline ();
1427 end;
1428 boot_peers := (ip, port) :: !boot_peers)
1429 | _ ->
1430 lprintf "BAD LINE ocl: %s" s;
1431 lprint_newline ();
1432 with _ ->
1433 begin
1434 lprintf "DNS failed"; lprint_newline ();
1435 end
1436 ) lines
1437 )
1438
1439 let overnet_search (ss : search) =
1440 if !!overnet_search_keyword && not (List.mem ss.search_num !all_overnet_searches) then
1441 let q = ss.search_query in
1442 all_overnet_searches := ss.search_num :: !all_overnet_searches;
1443 let ws = keywords_of_query q in
1444 List.iter (fun w ->
1445 let s = create_keyword_search w in
1446 Hashtbl.iter (fun r_md4 r_tags ->
1447 DonkeyOneFile.search_found true ss r_md4 r_tags) s.search_results;
1448 begin
1449 match s.search_kind with
1450 KeywordSearch sss -> s.search_kind <- KeywordSearch (ss :: sss)
1451 | _ -> ()
1452 end;
1453 Hashtbl.add overnet_searches s.search_md4 s;
1454 )
1455 ws
1456

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26