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

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

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

revision 1.43 by spiralvoice, Sun Jul 17 16:12:59 2005 UTC revision 1.44 by spiralvoice, Fri Jul 22 10:58:55 2005 UTC
# Line 24  open Printf2 Line 24  open Printf2
24  open Md4  open Md4
25  open Options  open Options
26  open BasicSocket  open BasicSocket
27      
28  open CommonDownloads  open CommonDownloads
29  open CommonSwarming  open CommonSwarming
30  open CommonInteractive  open CommonInteractive
# Line 35  open CommonComplexOptions Line 35  open CommonComplexOptions
35  open CommonClient  open CommonClient
36  open CommonTypes  open CommonTypes
37  open CommonOptions  open CommonOptions
38  open CommonGlobals    open CommonGlobals
39  open CommonNetwork  open CommonNetwork
40      
41  open DonkeyTypes  open DonkeyTypes
42  open DonkeyOptions  open DonkeyOptions
43  open CommonOptions  open CommonOptions
44    
         
45  (*************************************************************  (*************************************************************
46    
47  Define the instances of the plugin classes, that we be filled  Define the instances of the plugin classes, that we be filled
48  later with functions defining the specialized methods for this  later with functions defining the specialized methods for this
49  plugin.  plugin.
50      
51  **************************************************************)    **************************************************************)
52      
53  let network = CommonNetwork.new_network "ED2K" "Donkey"  let network = CommonNetwork.new_network "ED2K" "Donkey"
54           [           [
55      NetworkHasServers;      NetworkHasServers;
56      NetworkHasSearch;      NetworkHasSearch;
57      NetworkHasUpload;      NetworkHasUpload;
58      NetworkHasMultinet;      NetworkHasMultinet;
# Line 64  let network = CommonNetwork.new_network Line 63  let network = CommonNetwork.new_network
63  let connection_manager = network.network_connection_manager  let connection_manager = network.network_connection_manager
64  let connections_controler = TcpServerSocket.create_connections_contoler  let connections_controler = TcpServerSocket.create_connections_contoler
65      "Edonkey" (fun _ _ -> true)      "Edonkey" (fun _ _ -> true)
66      
67  let (shared_ops : file CommonShared.shared_ops) =  let (shared_ops : file CommonShared.shared_ops) =
68    CommonShared.new_shared_ops network    CommonShared.new_shared_ops network
69    
70  let (server_ops : server CommonServer.server_ops) =  let (server_ops : server CommonServer.server_ops) =
71    CommonServer.new_server_ops network    CommonServer.new_server_ops network
72    
73  let (room_ops : server CommonRoom.room_ops) =  let (room_ops : server CommonRoom.room_ops) =
74    CommonRoom.new_room_ops network    CommonRoom.new_room_ops network
75      
76  let (user_ops : user CommonUser.user_ops) =  let (user_ops : user CommonUser.user_ops) =
77    CommonUser.new_user_ops network    CommonUser.new_user_ops network
78      
79  let (file_ops : file CommonFile.file_ops) =  let (file_ops : file CommonFile.file_ops) =
80    CommonFile.new_file_ops network    CommonFile.new_file_ops network
81    
82  let (client_ops : client CommonClient.client_ops) =  let (client_ops : client CommonClient.client_ops) =
83    CommonClient.new_client_ops network    CommonClient.new_client_ops network
84    
85  let (pre_shared_ops : file_to_share CommonShared.shared_ops) =  let (pre_shared_ops : file_to_share CommonShared.shared_ops) =
86    CommonShared.new_shared_ops network    CommonShared.new_shared_ops network
87        
88  let (shared_ops : file CommonShared.shared_ops) =  let (shared_ops : file CommonShared.shared_ops) =
89    CommonShared.new_shared_ops network    CommonShared.new_shared_ops network
     
90    
91  let client_must_update c =  let client_must_update c =
92    client_must_update (as_client c.client_client)    client_must_update (as_client c.client_client)
# Line 97  let server_must_update s = Line 95  let server_must_update s =
95    server_must_update (as_server s.server_server)    server_must_update (as_server s.server_server)
96    
97  let as_client c = as_client c.client_client  let as_client c = as_client c.client_client
98  let as_file file = as_file file.file_file      let as_file file = as_file file.file_file
99  let file_priority file = file.file_file.impl_file_priority  let file_priority file = file.file_file.impl_file_priority
100  let file_size file = file.file_file.impl_file_size  let file_size file = file.file_file.impl_file_size
101  let file_downloaded file = file_downloaded (as_file file)  let file_downloaded file = file_downloaded (as_file file)
# Line 105  let file_age file = file.file_file.impl_ Line 103  let file_age file = file.file_file.impl_
103  let file_fd file = file.file_file.impl_file_fd  let file_fd file = file.file_file.impl_file_fd
104  let file_disk_name file = file_disk_name (as_file file)  let file_disk_name file = file_disk_name (as_file file)
105  let file_best_name file = file_best_name (as_file file)  let file_best_name file = file_best_name (as_file file)
106      
107  let client_num c = client_num (as_client c)    let client_num c = client_num (as_client c)
108  let file_num c = file_num (as_file c)    let file_num c = file_num (as_file c)
109  let server_num c = server_num (as_server c.server_server)    let server_num c = server_num (as_server c.server_server)
110    
111    
112  (*************************************************************************)  (*************************************************************************)
# Line 122  let tag_client = 200 Line 120  let tag_client = 200
120  let tag_server = 201  let tag_server = 201
121  let tag_file   = 202  let tag_file   = 202
122    
123  let page_size = Int64.of_int 4096      let page_size = Int64.of_int 4096
124      
125  let client_to_client_tags = ref ([] : tag list)  let client_to_client_tags = ref ([] : tag list)
126  let client_to_server_tags = ref ([] : tag list)  let client_to_server_tags = ref ([] : tag list)
127  let emule_info =  let emule_info =
128    let module E = DonkeyProtoClient.EmuleClientInfo in    let module E = DonkeyProtoClient.EmuleClientInfo in
129    {    {
130      E.version = 66;      E.version = 66;
131      E.protversion = 66;      E.protversion = 66;
132      E.tags = [];      E.tags = [];
133    }    }
# Line 140  let overnet_connect_tags = ref ([] :  ta Line 138  let overnet_connect_tags = ref ([] :  ta
138  let overnet_md4 = Md4.random()  let overnet_md4 = Md4.random()
139  let nservers = ref 0  let nservers = ref 0
140  let xs_last_search = ref (-1)  let xs_last_search = ref (-1)
141      
142  let zone_size = Int64.of_int (180 * 1024)  let zone_size = Int64.of_int (180 * 1024)
143  let block_size = Int64.of_int 9728000  let block_size = Int64.of_int 9728000
144      
145  let queue_timeout = ref (60. *. 10.) (* 10 minutes *)  let queue_timeout = ref (60. *. 10.) (* 10 minutes *)
146        
147  let files_queries_per_minute = 3 (* queries for 3 files cost 3*16=48 server-credits; we did get 60 (1 each second) *)  let files_queries_per_minute = 3 (* queries for 3 files cost 3*16=48 server-credits; we did get 60 (1 each second) *)
148        
149  let nclients = ref 0  let nclients = ref 0
150    
151  let protocol_version = 62  let protocol_version = 62
152  let max_file_groups = 1000  let max_file_groups = 1000
153  let master_server = ref (None: DonkeyTypes.server option)    let master_server = ref (None: DonkeyTypes.server option)
154  let udp_sock = ref (None: UdpSocket.t option)  let udp_sock = ref (None: UdpSocket.t option)
155  let listen_sock = ref (None : TcpServerSocket.t option)    let listen_sock = ref (None : TcpServerSocket.t option)
156  let reversed_sock = ref (None : TcpServerSocket.t option)  let reversed_sock = ref (None : TcpServerSocket.t option)
157  let servers_ini_changed = ref true  let servers_ini_changed = ref true
158  let new_shared = ref false  let new_shared = ref false
# Line 164  let new_shared = ref false Line 162  let new_shared = ref false
162  (*                         Global tables                                 *)  (*                         Global tables                                 *)
163  (*                                                                       *)  (*                                                                       *)
164  (*************************************************************************)  (*************************************************************************)
165        
166  module H = Weak2.Make(struct  module H = Weak2.Make(struct
167        type t = client        type t = client
168        let hash c = Hashtbl.hash c.client_kind        let hash c = Hashtbl.hash c.client_kind
169          
170        let equal x y = x.client_kind = y.client_kind        let equal x y = x.client_kind = y.client_kind
171      end)      end)
172      
173  let clients_by_kind = H.create 127  let clients_by_kind = H.create 127
174  let clients_root = ref []  let clients_root = ref []
175  let servers_by_key = Hashtbl.create 127  let servers_by_key = Hashtbl.create 127
176  let servers_list = ref ([] : server list)  let servers_list = ref ([] : server list)
177      
178  (* let remaining_time_for_clients = ref (60 * 15) *)  (* let remaining_time_for_clients = ref (60 * 15) *)
179    
180  let current_files = ref ([] : file list)  let current_files = ref ([] : file list)
181  let xs_servers_list = ref ([] : server list)  let xs_servers_list = ref ([] : server list)
182  let connected_server_list = ref ([]  : server list)  let connected_server_list = ref ([]  : server list)
183      
184  let (banned_ips : (Ip.t, int) Hashtbl.t) = Hashtbl.create 113  let (banned_ips : (Ip.t, int) Hashtbl.t) = Hashtbl.create 113
185  let (old_requests : (int * int, request_record) Hashtbl.t) =  let (old_requests : (int * int, request_record) Hashtbl.t) =
186    Hashtbl.create 13013    Hashtbl.create 13013
187    
188  let (file_groups_fifo : Md4.t Fifo.t) = Fifo.create ()  let (file_groups_fifo : Md4.t Fifo.t) = Fifo.create ()
189  let (connected_clients : (Md4.t, client) Hashtbl.t) = Hashtbl.create 130  let (connected_clients : (Md4.t, client) Hashtbl.t) = Hashtbl.create 130
190      
191  let udp_servers_list = ref ([] : server list)  let udp_servers_list = ref ([] : server list)
192  let interesting_clients = ref ([] : client list)  let interesting_clients = ref ([] : client list)
193      
194  let files_by_md4 = Hashtbl.create 127  let files_by_md4 = Hashtbl.create 127
195  let find_file md4 = Hashtbl.find files_by_md4 md4  let find_file md4 = Hashtbl.find files_by_md4 md4
196    
# Line 201  in the shared_files_info *) Line 199  in the shared_files_info *)
199  let shared_files_info = (Hashtbl.create 127  let shared_files_info = (Hashtbl.create 127
200      : (string * int64 * float, shared_file_info) Hashtbl.t)      : (string * int64 * float, shared_file_info) Hashtbl.t)
201  let shared_files = ref ([] : file_to_share list)  let shared_files = ref ([] : file_to_share list)
202  let new_shared_files = ref []  let new_shared_files = ref []
203      
204  let udp_servers_replies = (Hashtbl.create 127 : (Md4.t, server) Hashtbl.t)  let udp_servers_replies = (Hashtbl.create 127 : (Md4.t, server) Hashtbl.t)
205        
206  let file_groups = (Hashtbl.create 1023 : (Md4.t, file_group) Hashtbl.t)  let file_groups = (Hashtbl.create 1023 : (Md4.t, file_group) Hashtbl.t)
207    
208  let file_md4s_to_register = ref ([] : file list)  let file_md4s_to_register = ref ([] : file list)
209      
210  module UdpClientWHashtbl = Weak2.Make(struct  module UdpClientWHashtbl = Weak2.Make(struct
211        type t = udp_client        type t = udp_client
212        let hash c = Hashtbl.hash (c.udp_client_ip, c.udp_client_port)        let hash c = Hashtbl.hash (c.udp_client_ip, c.udp_client_port)
213          
214        let equal x y = x.udp_client_port = y.udp_client_port        let equal x y = x.udp_client_port = y.udp_client_port
215          && x.udp_client_ip = y.udp_client_ip          && x.udp_client_ip = y.udp_client_ip
216      end)      end)
217    
218  let udp_clients = UdpClientWHashtbl.create 1023  let udp_clients = UdpClientWHashtbl.create 1023
219      
220  let join_queue_by_md4 = Hashtbl.create 13  let join_queue_by_md4 = Hashtbl.create 13
221  let join_queue_by_id  = Hashtbl.create 13  let join_queue_by_id  = Hashtbl.create 13
222    
# Line 227  let join_queue_by_id  = Hashtbl.create 1 Line 225  let join_queue_by_id  = Hashtbl.create 1
225  (*                         Global functions                              *)  (*                         Global functions                              *)
226  (*                                                                       *)  (*                                                                       *)
227  (*************************************************************************)  (*************************************************************************)
228      
229  let _ =  let _ =
230    network.op_network_connected_servers <- (fun _ ->    network.op_network_connected_servers <- (fun _ ->
231        List2.tail_map (fun s -> as_server s.server_server) !connected_server_list          List2.tail_map (fun s -> as_server s.server_server) !connected_server_list
232    )    )
233      
234  let hashtbl_remove table key v =  let lprintf_nl () =
235      lprintf "%s[EDK]: "
236      (log_time ()); lprintf_nl2
237    
238    let lprintf_n () =
239      lprintf "%s[EDK]: "
240      (log_time ()); lprintf
241    
242    let hashtbl_remove table key v =
243    try    try
244      let vv = Hashtbl.find table key in      let vv = Hashtbl.find table key in
245      if vv == v then      if vv == v then
246        Hashtbl.remove table key        Hashtbl.remove table key
247    with _ -> ()    with _ -> ()
248    
249  let add_connected_server c =  let add_connected_server c =
250    connected_server_list := c :: !connected_server_list    connected_server_list := c :: !connected_server_list
251      
252  let remove_connected_server c =  let remove_connected_server c =
253    connected_server_list := List2.removeq c !connected_server_list    connected_server_list := List2.removeq c !connected_server_list
254    
255  let connected_servers () = !connected_server_list  let connected_servers () = !connected_server_list
256            
257  let get_udp_sock () =  let get_udp_sock () =
258    match !udp_sock with    match !udp_sock with
259      None -> failwith "No UDP socket"      None -> failwith "No UDP socket"
260    | Some sock -> sock    | Some sock -> sock
261    
   
   
     
262  (* compute the name used to save the file *)  (* compute the name used to save the file *)
263      
264  let update_best_name file =  let update_best_name file =
265      
266    let best_name = file_best_name file in    let best_name = file_best_name file in
267  (*  lprintf "update_best_name: %s\n" best_name; *)  (*  lprintf "update_best_name: %s\n" best_name; *)
268    if best_name = file_string_of_uid (Ed2k file.file_md4)    if best_name = file_string_of_uid (Ed2k file.file_md4)
# Line 276  let update_best_name file = Line 279  let update_best_name file =
279        | Some best_name ->        | Some best_name ->
280            let best_name = String2.replace best_name '/' "::" in            let best_name = String2.replace best_name '/' "::" in
281            set_file_best_name file best_name;            set_file_best_name file best_name;
282            if !verbose then lprintf "BEST NAME now IS %s" best_name;            if !verbose then lprintf_nl () "BEST NAME now IS %s" best_name;
283      with Not_found -> ()      with Not_found -> ()
284    
           
285  let new_file file_diskname file_state md4 file_size filenames writable =  let new_file file_diskname file_state md4 file_size filenames writable =
286      
287    try    try
288        let file = find_file md4 in        let file = find_file md4 in
289        if file.file_diskname <> file_diskname then        if file.file_diskname <> file_diskname then
# Line 293  let new_file file_diskname file_state md Line 295  let new_file file_diskname file_state md
295              then              then
296                begin                begin
297                  if !verbose_share then                  if !verbose_share then
298                    lprintf_nl "EDK: New file with changed filename %s to %s"                    lprintf_nl () "New file with changed filename %s to %s"
299                      file.file_diskname file_diskname;                      file.file_diskname file_diskname;
300                  file.file_diskname <- file_diskname;                  file.file_diskname <- file_diskname;
301                end                end
302            else            else
303              if !verbose_share then              if !verbose_share then
304                lprintf_nl "EDK: New file with not changed different filename %s and %s"                lprintf_nl () "New file with not changed different filename %s and %s"
305                  file.file_diskname file_diskname;                  file.file_diskname file_diskname;
306          end;          end;
307        if Unix32.destroyed (file_fd file)        if Unix32.destroyed (file_fd file)
# Line 309  let new_file file_diskname file_state md Line 311  let new_file file_diskname file_state md
311            file.file_file.impl_file_fd <-            file.file_file.impl_file_fd <-
312              Unix32.create_diskfile file.file_diskname Unix32.rw_flag 0o666;              Unix32.create_diskfile file.file_diskname Unix32.rw_flag 0o666;
313        if Unix32.destroyed (file_fd file) then        if Unix32.destroyed (file_fd file) then
314            lprintf_nl "New Edonkey file with %b && %b remaining destroyed fd %s"            lprintf_nl () "New Edonkey file with %b && %b remaining destroyed fd %s"
315              (not writable) (file.file_diskname = file_diskname) file.file_diskname;              (not writable) (file.file_diskname = file_diskname) file.file_diskname;
316        file        file
317    with _ ->    with _ ->
318        if !verbose_share then        if !verbose_share then
319          lprintf_nl "EDK: New file with md4: %s" (Md4.to_string md4);          lprintf_nl () "New file with md4: %s" (Md4.to_string md4);
320        let file_exists = Unix32.file_exists file_diskname in        let file_exists = Unix32.file_exists file_diskname in
321          
322        let t =        let t =
323          if          if
324  (* Don't use this for shared files ! *)  (* Don't use this for shared files ! *)
325            writable &&            writable &&
326  (* Only if the option is set *)  (* Only if the option is set *)
327            !!emulate_sparsefiles &&            !!emulate_sparsefiles &&
328  (* Only if the file does not already exists *)  (* Only if the file does not already exists *)
# Line 338  let new_file file_diskname file_state md Line 340  let new_file file_diskname file_state md
340                failwith "Zero length file ?"                failwith "Zero length file ?"
341          else file_size          else file_size
342        in        in
343          
344        if file_size <> zero && writable then (* do not truncate if not writable *)        if file_size <> zero && writable then (* do not truncate if not writable *)
345          Unix32.ftruncate64 t file_size;          Unix32.ftruncate64 t file_size;
346          
347        let nchunks = Int64.to_int (Int64.div        let nchunks = Int64.to_int (Int64.div
348              (Int64.sub file_size Int64.one) block_size) + 1 in              (Int64.sub file_size Int64.one) block_size) + 1 in
349        let md4s = if file_size <= block_size then        let md4s = if file_size <= block_size then
350            [md4]            [md4]
351          else [] in          else [] in
352        let rec file = {        let rec file = {
353            file_diskname = file_diskname;            file_diskname = file_diskname;
# Line 358  let new_file file_diskname file_state md Line 360  let new_file file_diskname file_state md
360            file_computed_md4s = Array.of_list md4s;            file_computed_md4s = Array.of_list md4s;
361            file_format = FormatNotComputed 0;            file_format = FormatNotComputed 0;
362            file_sources = DonkeySources.create_file_sources_manager            file_sources = DonkeySources.create_file_sources_manager
363              (Md4.to_string md4)              (Md4.to_string md4)
364          }          }
365        and file_impl = {        and file_impl = {
366            dummy_file_impl with            dummy_file_impl with
367            impl_file_val = file;            impl_file_val = file;
368            impl_file_ops = file_ops;            impl_file_ops = file_ops;
369            impl_file_age = last_time ();                      impl_file_age = last_time ();
370            impl_file_size = file_size;            impl_file_size = file_size;
371            impl_file_fd = t;            impl_file_fd = t;
372            impl_file_best_name = Filename.basename file_diskname;            impl_file_best_name = Filename.basename file_diskname;
373            impl_file_last_seen = last_time () - 100 * 24 * 3600;            impl_file_last_seen = last_time () - 100 * 24 * 3600;
374          }          }
375        in        in
376          
377        file.file_sources.DonkeySources.manager_file <- (fun () -> as_file file);        file.file_sources.DonkeySources.manager_file <- (fun () -> as_file file);
378          
379        (match file_state with        (match file_state with
380            FileShared -> ()            FileShared -> ()
381          | _ ->          | _ ->
# Line 382  let new_file file_diskname file_state md Line 384  let new_file file_diskname file_state md
384              in              in
385              file.file_swarmer <- Some swarmer;              file.file_swarmer <- Some swarmer;
386  (*  (*
387          Int64Swarmer.set_writer swarmer (fun offset s pos len ->                Int64Swarmer.set_writer swarmer (fun offset s pos len ->
388  (*  (*
389        lprintf "DOWNLOADED: %d/%d/%d\n" pos len (String.length s);        lprintf "DOWNLOADED: %d/%d/%d\n" pos len (String.length s);
390        AnyEndian.dump_sub s pos len;        AnyEndian.dump_sub s pos len;
391  *)  *)
392                
393              if !!CommonOptions.buffer_writes then              if !!CommonOptions.buffer_writes then
394                Unix32.buffered_write_copy t offset s pos len                Unix32.buffered_write_copy t offset s pos len
395              else              else
396                Unix32.write  t offset s pos len                Unix32.write  t offset s pos len
397          ); *)          ); *)
398              Int64Swarmer.set_verifier swarmer              Int64Swarmer.set_verifier swarmer
399                (if md4s = [] then VerificationNotAvailable else                (if md4s = [] then VerificationNotAvailable else
400                  Verification (Array.of_list (List.map (fun md4 -> Ed2k md4) md4s))                  Verification (Array.of_list (List.map (fun md4 -> Ed2k md4) md4s))
401              );              );
# Line 403  let new_file file_diskname file_state md Line 405  let new_file file_diskname file_state md
405                      file_must_update file                      file_must_update file
406                    end)                    end)
407        );        );
408          
409        update_best_name file;        update_best_name file;
410        file_add file_impl file_state;        file_add file_impl file_state;
411        Heap.set_tag file tag_file;        Heap.set_tag file tag_file;
412        Hashtbl.add files_by_md4 md4 file;        Hashtbl.add files_by_md4 md4 file;
413        file        file
414      
415    (*    (*
416    
417    for i = 0 to file.file_nchunks - 1 do    for i = 0 to file.file_nchunks - 1 do
418      if client_chunks.(i) then      if client_chunks.(i) then
419        let new_n = file.file_available_chunks.(i) + 1 in        let new_n = file.file_available_chunks.(i) + 1 in
420        if new_n  < 11 then  file_must_update file;        if new_n  < 11 then  file_must_update file;
421        file.file_available_chunks.(i) <- new_n;        file.file_available_chunks.(i) <- new_n;
422    done    done
423    
424  let remove_client_chunks file client_chunks =  let remove_client_chunks file client_chunks =
425    for i = 0 to file.file_nchunks - 1 do    for i = 0 to file.file_nchunks - 1 do
426      if client_chunks.(i) then      if client_chunks.(i) then
427        let new_n = file.file_available_chunks.(i) - 1 in        let new_n = file.file_available_chunks.(i) - 1 in
428        if new_n < 11 then file_must_update file;        if new_n < 11 then file_must_update file;
429        file.file_available_chunks.(i) <- new_n;        file.file_available_chunks.(i) <- new_n;
430        client_chunks.(i) <- false          client_chunks.(i) <- false
431    done    done
432      *)      *)
433    
# Line 443  let is_black_address ip port = Line 445  let is_black_address ip port =
445          None -> false          None -> false
446        | Some br ->        | Some br ->
447            if !verbose_connect then            if !verbose_connect then
448              lprintf "%s:%d blocked: %s\n" (Ip.to_string ip) port br.Ip_set.blocking_description;              lprintf_nl () "%s:%d blocked: %s" (Ip.to_string ip) port br.Ip_set.blocking_description;
449            true))            true))
450      
451  let new_server ip port score =  let new_server ip port score =
452    let key = (ip) in    let key = (ip) in
453    try    try
454      let found = Hashtbl.find servers_by_key key in      let found = Hashtbl.find servers_by_key key in
# Line 486  let new_server ip port score = Line 488  let new_server ip port score =
488          server_flags = 0;          server_flags = 0;
489          server_has_zlib = false;          server_has_zlib = false;
490        }        }
491        and server_impl =        and server_impl =
492          {          {
493            dummy_server_impl with                      dummy_server_impl with
494            CommonServer.impl_server_val = s;            CommonServer.impl_server_val = s;
495            CommonServer.impl_server_ops = server_ops;            CommonServer.impl_server_ops = server_ops;
496          }          }
# Line 497  let new_server ip port score = Line 499  let new_server ip port score =
499        Heap.set_tag s tag_server;        Heap.set_tag s tag_server;
500        Hashtbl.add servers_by_key key s;        Hashtbl.add servers_by_key key s;
501        server_must_update s;        server_must_update s;
502        s              s
503    
504  let find_server ip port =  let find_server ip port =
505    let key = (ip) in    let key = (ip) in
506    Hashtbl.find servers_by_key key      Hashtbl.find servers_by_key key
507    
508  let remove_server ip port =  let remove_server ip port =
509    let key = (ip) in    let key = (ip) in
# Line 512  let remove_server ip port = Line 514  let remove_server ip port =
514      (match s.server_sock with      (match s.server_sock with
515          NoConnection -> ()          NoConnection -> ()
516        | ConnectionWaiting token -> cancel_token token        | ConnectionWaiting token -> cancel_token token
517        | Connection sock ->        | Connection sock ->
518            TcpBufferedSocket.shutdown sock Closed_by_user);            TcpBufferedSocket.shutdown sock Closed_by_user);
519      server_remove (as_server s.server_server)      server_remove (as_server s.server_server)
520    with _ -> ()    with _ -> ()
521    
522  let dummy_client =  let dummy_client =
523    let module D = DonkeyProtoClient in    let module D = DonkeyProtoClient in
524    let rec c = {    let rec c = {
525        client_client = client_impl;        client_client = client_impl;
# Line 562  let dummy_client = Line 564  let dummy_client =
564        client_connection_time = 0;        client_connection_time = 0;
565        } and        } and
566      client_impl = {      client_impl = {
567        dummy_client_impl with                    dummy_client_impl with
568        impl_client_val = c;        impl_client_val = c;
569        impl_client_ops = client_ops;        impl_client_ops = client_ops;
570        impl_client_upload = None;        impl_client_upload = None;
571      }      }
572    in    in
573    c      c
574        
575      let create_client key =
 let create_client key =    
576    let module D = DonkeyProtoClient in    let module D = DonkeyProtoClient in
577    let s = DonkeySources.find_source_by_uid key in    let s = DonkeySources.find_source_by_uid key in
578    let rec c = {    let rec c = {
579  (*      dummy_client with *)  (*      dummy_client with *)
580          
581        client_client = client_impl;        client_client = client_impl;
582  (*      client_connection_control =  new_connection_control_recent_ok ( ()); *)  (*      client_connection_control =  new_connection_control_recent_ok ( ()); *)
583        client_next_view_files = last_time () - 1;        client_next_view_files = last_time () - 1;
584        client_kind = key;          client_kind = key;
585        client_upload = None;        client_upload = None;
586        client_source = s;        client_source = s;
587  (*      client_sock = NoConnection; *)  (*      client_sock = NoConnection; *)
# Line 610  let create_client key = Line 611  let create_client key =
611        client_connect_time = 0;        client_connect_time = 0;
612        client_requests_received = 0;        client_requests_received = 0;
613        client_requests_sent = 0;        client_requests_sent = 0;
614        client_indirect_address = None;              client_indirect_address = None;
615        client_slot = SlotNotAsked;        client_slot = SlotNotAsked;
616        client_debug = Intset.mem s.DonkeySources.source_num !debug_clients;        client_debug = Intset.mem s.DonkeySources.source_num !debug_clients;
617        client_pending_messages = [];        client_pending_messages = [];
618        client_emule_proto = emule_proto ();        client_emule_proto = emule_proto ();
# Line 619  let create_client key = Line 620  let create_client key =
620        client_connection_time = 0;        client_connection_time = 0;
621        } and        } and
622      client_impl = {      client_impl = {
623        dummy_client_impl with                    dummy_client_impl with
624        impl_client_val = c;        impl_client_val = c;
625        impl_client_ops = client_ops;        impl_client_ops = client_ops;
626        impl_client_upload = None;        impl_client_upload = None;
# Line 639  let new_client key = Line 640  let new_client key =
640    
641  let create_client = ()  let create_client = ()
642    
643  let find_client_by_key key =  let find_client_by_key key =
644    H.find clients_by_kind { dummy_client with client_kind = key }    H.find clients_by_kind { dummy_client with client_kind = key }
645      
646  let client_type c =  let client_type c =
647    client_type (as_client c)    client_type (as_client c)
648    
# Line 650  let set_client_type c t= Line 651  let set_client_type c t=
651    
652  let friend_add c =  let friend_add c =
653    friend_add (as_client c)    friend_add (as_client c)
654          
655  let set_client_name c name md4 =  let set_client_name c name md4 =
656    if name <> c.client_name || c.client_md4 <> md4 then begin    if name <> c.client_name || c.client_md4 <> md4 then begin
657        c.client_name <- name;        c.client_name <- name;
658        c.client_md4 <- md4;        c.client_md4 <- md4;
659      end      end
660        
661  exception ClientFound of client  exception ClientFound of client
662  let find_client_by_name name =  let find_client_by_name name =
663    try    try
# Line 666  let find_client_by_name name = Line 667  let find_client_by_name name =
667      raise Not_found      raise Not_found
668    with ClientFound c -> c    with ClientFound c -> c
669    
670  let local_mem_stats level buf =  let local_mem_stats level buf =
671    Gc.compact ();    Gc.compact ();
672    let client_counter = ref 0 in    let client_counter = ref 0 in
673    let unconnected_unknown_clients = ref 0 in    let unconnected_unknown_clients = ref 0 in
# Line 704  end; Line 705  end;
705            let buf_len, nmsgs = TcpBufferedSocket.buf_size sock in            let buf_len, nmsgs = TcpBufferedSocket.buf_size sock in
706            (try            (try
707                Hashtbl.find connected_clients_by_num num                Hashtbl.find connected_clients_by_num num
708              with _ ->              with _ ->
709                  incr connected_clients;                  incr connected_clients;
710                  waiting_msgs := !waiting_msgs + nmsgs;                  waiting_msgs := !waiting_msgs + nmsgs;
711                  buffers := !buffers + buf_len;                  buffers := !buffers + buf_len;
# Line 715  end; Line 716  end;
716            if TcpBufferedSocket.closed sock then            if TcpBufferedSocket.closed sock then
717              incr closed_connections;              incr closed_connections;
718    ) clients_by_kind;    ) clients_by_kind;
719      
720    let bad_clients_in_files = ref 0 in    let bad_clients_in_files = ref 0 in
721    Hashtbl.iter (fun _ file ->    Hashtbl.iter (fun _ file ->
722        DonkeySources.iter_all_sources (fun s ->        DonkeySources.iter_all_sources (fun s ->
# Line 725  end; Line 726  end;
726                    Indirect_address _ -> incr bad_clients_in_files                    Indirect_address _ -> incr bad_clients_in_files
727                  | _ -> ()                  | _ -> ()
728                end                end
729            | _ -> ()                          | _ -> ()
730        ) file.file_sources;        ) file.file_sources;
731    ) files_by_md4;    ) files_by_md4;
732      
733    Printf.bprintf buf "Clients: %d\n" !client_counter;    Printf.bprintf buf "Clients: %d\n" !client_counter;
734    Printf.bprintf buf "   Bad Clients: %d/%d\n" !unconnected_unknown_clients    Printf.bprintf buf "   Bad Clients: %d/%d\n" !unconnected_unknown_clients
735      !bad_clients_in_files;      !bad_clients_in_files;
# Line 743  end; Line 744  end;
744    Printf.bprintf buf "   Dead clients: %d\n" !dead_clients;    Printf.bprintf buf "   Dead clients: %d\n" !dead_clients;
745    Printf.bprintf buf "   Disconnected aliases: %d\n" !disconnected_alias;    Printf.bprintf buf "   Disconnected aliases: %d\n" !disconnected_alias;
746    ()    ()
747      
748  let remove_client c =  let remove_client c =
749    client_remove (as_client c);    client_remove (as_client c);
750  (*  hashtbl_remove clients_by_kind c.client_kind c; *)  (*  hashtbl_remove clients_by_kind c.client_kind c; *)
# Line 751  let remove_client c = Line 752  let remove_client c =
752    ()    ()
753    
754    
755  let friend_remove c =  let friend_remove c =
756    friend_remove  (as_client c)    friend_remove  (as_client c)
757    
758    
# Line 762  let last_connected_master () = Line 763  let last_connected_master () =
763    let masters = ref [] in    let masters = ref [] in
764    List.iter (    List.iter (
765      fun s ->      fun s ->
766        if s.server_master then        if s.server_master then
767          match s.server_sock with          match s.server_sock with
768            | Connection _ ->            | Connection _ ->
769                masters := s :: !masters                masters := s :: !masters
770            | _ -> s.server_master <- false            | _ -> s.server_master <- false
771    ) server_list;    ) server_list;
772    match !masters with    match !masters with
773    | s :: _ -> s    | s :: _ -> s
774    | [] -> raise Not_found    | [] -> raise Not_found
775      
776  let last_connected_server () =  let last_connected_server () =
777    match !servers_list with    match !servers_list with
778    | s :: _ -> s    | s :: _ -> s
779    | [] ->    | [] ->
780        servers_list :=        servers_list :=
781        Hashtbl.fold (fun key s l ->        Hashtbl.fold (fun key s l ->
782            s :: l            s :: l
783        ) servers_by_key [];        ) servers_by_key [];
# Line 784  let last_connected_server () = Line 785  let last_connected_server () =
785          [] -> raise Not_found          [] -> raise Not_found
786        | s :: _ -> s        | s :: _ -> s
787    
             
788  let all_servers () =  let all_servers () =
789    Hashtbl.fold (fun key s l ->    Hashtbl.fold (fun key s l ->
790        s :: l        s :: l
# Line 800  let string_of_file_state s = Line 800  let string_of_file_state s =
800    | FileNew -> "File New"    | FileNew -> "File New"
801    | FileAborted s -> Printf.sprintf "Aborted: %s" s    | FileAborted s -> Printf.sprintf "Aborted: %s" s
802    | FileQueued -> "File Queued"    | FileQueued -> "File Queued"
803          
804  let left_bytes = "MLDK"  let left_bytes = "MLDK"
805    
806  let overnet_server_ip = ref Ip.null  let overnet_server_ip = ref Ip.null
# Line 939  let brand_mod_to_string b = Line 939  let brand_mod_to_string b =
939    | Brand_mod_freeangel -> "freeangel"    | Brand_mod_freeangel -> "freeangel"
940    | Brand_mod_enos -> "enos"    | Brand_mod_enos -> "enos"
941    | Brand_mod_webys -> "webys"    | Brand_mod_webys -> "webys"
942        
943  let string_of_client c =  let string_of_client c =
944    Printf.sprintf "client[%d] %s(%s) %s" (client_num c)    Printf.sprintf "client[%d] %s(%s) %s" (client_num c)
945    c.client_name (brand_to_string c.client_brand)    c.client_name (brand_to_string c.client_brand)
# Line 954  let string_of_client c = Line 954  let string_of_client c =
954  let check_result r tags =  let check_result r tags =
955    if r.result_names = [] || r.result_size = Int64.zero then begin    if r.result_names = [] || r.result_size = Int64.zero then begin
956        if !verbose then begin        if !verbose then begin
957            lprintf "BAD RESULT:\n";            lprintf_n () "BAD RESULT:";
958            List.iter (fun tag ->            List.iter (fun tag ->
959                lprintf "[%s] = [%s]" (string_of_field tag.tag_name)                lprintf "[%s] = [%s]" (string_of_field tag.tag_name)
960                  (string_of_tag_value tag.tag_value);                  (string_of_tag_value tag.tag_value);
961                lprintf "\n";                lprint_newline ();
962            ) tags;            ) tags;
963          end;          end;
964        false        false
965      end      end
966    else true    else true
967        
968  let result_of_file md4 tags =  let result_of_file md4 tags =
969    let rec r = {  dummy_result with    let rec r = {  dummy_result with
970        result_uids = [Uid.create (Ed2k md4)];        result_uids = [Uid.create (Ed2k md4)];
971      } in        } in
972    List.iter (fun tag ->    List.iter (fun tag ->
973        match tag with        match tag with
974          { tag_name = Field_Filename; tag_value = String s } ->          { tag_name = Field_Filename; tag_value = String s } ->
# Line 989  let result_of_file md4 tags = Line 989  let result_of_file md4 tags =
989      Some rs      Some rs
990    else None    else None
991    
         
992  (*************************************************************  (*************************************************************
993    
994  Define a function to be called when the "mem_stats" command  Define a function to be called when the "mem_stats" command
995    is used to display information on structure footprint.    is used to display information on structure footprint.
996      
997  **************************************************************)    **************************************************************)
998    
999  let _ =  let _ =
1000    Heap.add_memstat "DonkeyGlobals" (fun level buf ->    Heap.add_memstat "DonkeyGlobals" (fun level buf ->
# Line 1004  let _ = Line 1003  let _ =
1003        Printf.bprintf buf  "Clients_by_kind: %d\n" (List.length list);        Printf.bprintf buf  "Clients_by_kind: %d\n" (List.length list);
1004        if level > 0 then        if level > 0 then
1005          List.iter (fun c ->          List.iter (fun c ->
1006              Printf.bprintf buf "[%d ok: %s rating: %d]\n"              Printf.bprintf buf "[%d ok: %s rating: %d]\n"
1007                (client_num c)                (client_num c)
1008              (string_of_date (c.client_source.DonkeySources.source_age))              (string_of_date (c.client_source.DonkeySources.source_age))
1009  (* TODO: add connection state *)  (* TODO: add connection state *)
# Line 1012  let _ = Line 1011  let _ =
1011              ;              ;
1012          ) list;          ) list;
1013    );    );
1014          
1015    Heap.add_memstat "DonkeyGlobals" local_mem_stats    Heap.add_memstat "DonkeyGlobals" local_mem_stats
1016    
       
1017  (*************************************************************  (*************************************************************
1018    
1019     Save the state of the client positive queries for files     Save the state of the client positive queries for files
1020   if a JoinQueue message was sent. Use this information if   if a JoinQueue message was sent. Use this information if
1021   an AvailableSlot message is received while not JoinQueue   an AvailableSlot message is received while not JoinQueue
1022   message was sent (client_asked_for_slot false).   message was sent (client_asked_for_slot false).
1023      
1024  **************************************************************)  **************************************************************)
1025      
1026      let client_id c =
 let client_id c =  
1027    match c.client_kind with    match c.client_kind with
1028      Direct_address (ip, port) -> (ip, port, zero)      Direct_address (ip, port) -> (ip, port, zero)
1029    | Indirect_address (ip, port, id) -> (ip, port, id)    | Indirect_address (ip, port, id) -> (ip, port, id)
1030    | Invalid_address _ -> (Ip.null, 0, zero)    | Invalid_address _ -> (Ip.null, 0, zero)
1031          
1032  let save_join_queue c =  let save_join_queue c =
1033    if c.client_file_queue <> [] then    if c.client_file_queue <> [] then
1034      let files = List.map (fun (file, chunks, _) ->      let files = List.map (fun (file, chunks, _) ->
1035            file, Array.copy chunks            file, Array.copy chunks
1036        ) c.client_file_queue in        ) c.client_file_queue in
1037      begin      begin
1038        if c.client_debug then        if c.client_debug then
1039          lprintf "Saving %d files associated with %s\n"          lprintf_nl () "Saving %d files associated with %s"
1040          (List.length files) (Md4.to_string c.client_md4);          (List.length files) (Md4.to_string c.client_md4);
1041        Hashtbl.add join_queue_by_md4 c.client_md4 (files, last_time ());        Hashtbl.add join_queue_by_md4 c.client_md4 (files, last_time ());
1042        try        try
# Line 1051  let save_join_queue c = Line 1048  let save_join_queue c =
1048  let half_hour = 30 * 60  let half_hour = 30 * 60
1049  let clean_join_queue_tables () =  let clean_join_queue_tables () =
1050    let current_time = last_time () in    let current_time = last_time () in
1051      
1052    let list = Hashtbl2.to_list2 join_queue_by_md4 in    let list = Hashtbl2.to_list2 join_queue_by_md4 in
1053    Hashtbl.clear join_queue_by_md4;    Hashtbl.clear join_queue_by_md4;
1054    List.iter (fun (key, ((v,time) as e)) ->    List.iter (fun (key, ((v,time) as e)) ->
1055        if time + half_hour > current_time then        if time + half_hour > current_time then
1056          Hashtbl.add join_queue_by_md4 key e          Hashtbl.add join_queue_by_md4 key e
1057    ) list;    ) list;
1058        
1059    let list = Hashtbl2.to_list2 join_queue_by_id in    let list = Hashtbl2.to_list2 join_queue_by_id in
1060    Hashtbl.clear join_queue_by_id;    Hashtbl.clear join_queue_by_id;
1061    List.iter (fun (key, ((v,time) as e)) ->    List.iter (fun (key, ((v,time) as e)) ->
1062        if time + half_hour > current_time then        if time + half_hour > current_time then
1063          Hashtbl.add join_queue_by_id key e          Hashtbl.add join_queue_by_id key e
1064    ) list    ) list
1065      
     
1066  let server_accept_multiple_getsources s =  let server_accept_multiple_getsources s =
1067    (s.server_flags land DonkeyProtoUdp.PingServerReplyUdp.multiple_getsources) <> 0    (s.server_flags land DonkeyProtoUdp.PingServerReplyUdp.multiple_getsources) <> 0
1068    

Legend:
Removed from v.1.43  
changed lines
  Added in v.1.44

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