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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.32 by spiralvoice, Thu Jul 7 00:25:46 2005 UTC revision 1.33 by spiralvoice, Sun Jul 10 23:19:16 2005 UTC
# Line 33  open CommonInteractive Line 33  open CommonInteractive
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;
# Line 54  type peer = Line 54  type peer =
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    
# Line 71  type t = Line 71  type t =
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 *)
# Line 140  let print_peer buf p = Line 140  let print_peer buf p =
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  ----  ----
# Line 234  R 1Eh (30) : (nothing) (=> BCP type 2) Line 234  R 1Eh (30) : (nothing) (=> BCP type 2)
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  )  )
# Line 246  module XorSet = Set.Make ( Line 246  module XorSet = Set.Make (
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
# Line 258  module XorMd4Map = Map.Make ( Line 258  module XorMd4Map = Map.Make (
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;
# Line 272  type overnet_search = { Line 272  type overnet_search = {
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 *)
# Line 282  type overnet_search = { Line 282  type overnet_search = {
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    
# Line 324  let min_peers_before_connect = 5 Line 324  let min_peers_before_connect = 5
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    
# Line 334  let is_enabled = ref false Line 334  let is_enabled = ref false
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"]
# Line 381  let overnet_update_nodes = define_option Line 381  let overnet_update_nodes = define_option
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
# Line 396  let gui_overnet_options_panel = Line 396  let gui_overnet_options_panel =
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    
# Line 407  let overnet_options_version = Line 407  let overnet_options_version =
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
# Line 464  module LimitedList = struct Line 464  module LimitedList = struct
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;
# Line 475  module LimitedList = struct Line 475  module LimitedList = struct
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
# Line 517  bits. Once every 30 minutes, we remove t Line 517  bits. Once every 30 minutes, we remove t
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
# Line 546  let common_bits m1 m2 = Line 546  let common_bits m1 m2 =
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
# Line 611  module Publish (M : sig Line 611  module Publish (M : sig
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
# Line 630  module Publish (M : sig Line 630  module Publish (M : sig
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;
# Line 640  module Publish (M : sig Line 640  module Publish (M : sig
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
# Line 652  module Publish (M : sig Line 652  module Publish (M : sig
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    
# Line 661  module PublishedKeywords = Publish(struc Line 661  module PublishedKeywords = Publish(struc
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    
# Line 691  let bootstrap ip port = Line 691  let bootstrap ip port =
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
# Line 712  restart. *) Line 712  restart. *)
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)
# Line 724  restart. *) Line 724  restart. *)
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;
# Line 741  restart. *) Line 741  restart. *)
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
# Line 766  let get_closest_peers md4 nb = Line 766  let get_closest_peers md4 nb =
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;
# Line 776  let get_closest_peers md4 nb = Line 776  let get_closest_peers md4 nb =
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;
# Line 789  let get_closest_peers md4 nb = Line 789  let get_closest_peers md4 nb =
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;
# Line 830  let add_search_peer s p = Line 830  let add_search_peer s p =
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;
# Line 854  let create_search kind md4 = Line 854  let create_search kind 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 =
# Line 906  let udp_client_handler t p = Line 906  let udp_client_handler t p =
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
# Line 935  let udp_client_handler t p = Line 935  let udp_client_handler t p =
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
# Line 960  let udp_client_handler t p = Line 960  let udp_client_handler t p =
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;
# Line 981  let udp_client_handler t p = Line 981  let udp_client_handler t p =
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
# Line 997  let udp_client_handler t p = Line 997  let udp_client_handler t p =
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    
# Line 1023  let udp_client_handler t p = Line 1023  let udp_client_handler t p =
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
# Line 1057  let query_next_peers () = Line 1057  let query_next_peers () =
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
# Line 1067  let query_next_peers () = Line 1067  let query_next_peers () =
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
# Line 1078  let query_next_peers () = Line 1078  let query_next_peers () =
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 *)
# Line 1159  let enable () = Line 1159  let enable () =
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
# Line 1170  let enable () = Line 1170  let enable () =
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
# Line 1212  let enable () = Line 1212  let enable () =
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 ->
# Line 1235  let enable () = Line 1235  let enable () =
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;
# Line 1263  let enable () = Line 1263  let enable () =
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 ()
# Line 1282  let enable () = Line 1282  let enable () =
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 =
# Line 1340  let register_commands list = Line 1340  let register_commands list =
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      [      [
# Line 1350  let _ = Line 1350  let _ =
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
# Line 1397  let _ = Line 1397  let _ =
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"
# Line 1412  let _ = Line 1412  let _ =
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\\>";
# Line 1428  let _ = Line 1428  let _ =
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
# Line 1453  let _ = Line 1453  let _ =
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");
# Line 1495  let _ = Line 1495  let _ =
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));
# Line 1514  let _ = Line 1514  let _ =
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
# Line 1533  let forget_search ss = Line 1533  let forget_search ss =
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
# Line 1567  let _ = Line 1567  let _ =
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    );    );
# Line 1585  let _ = Line 1585  let _ =
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    
# Line 1596  let _ = Line 1596  let _ =
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

Legend:
Removed from v.1.32  
changed lines
  Added in v.1.33

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