/[mldonkey]/mldonkey/src/networks/bittorrent/bTGlobals.ml
ViewVC logotype

Diff of /mldonkey/src/networks/bittorrent/bTGlobals.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 20  Line 20 
20  open Int64ops  open Int64ops
21  open Printf2  open Printf2
22  open Md4  open Md4
23      
24  open CommonSwarming  open CommonSwarming
25  open CommonInteractive  open CommonInteractive
26  open CommonClient  open CommonClient
27  open CommonUser  open CommonUser
28  open CommonTypes  open CommonTypes
29    open CommonOptions
30  open CommonComplexOptions  open CommonComplexOptions
31  open CommonServer  open CommonServer
32  open CommonResult  open CommonResult
# Line 33  open CommonFile Line 34  open CommonFile
34  open BasicSocket  open BasicSocket
35  open CommonGlobals  open CommonGlobals
36  open Options  open Options
37      
38  open BTRate  open BTRate
39  open BTTypes  open BTTypes
40  open BTOptions  open BTOptions
41  open BTProtocol  open BTProtocol
42  open CommonDownloads    open CommonDownloads
43  open CommonNetwork  open CommonNetwork
44  open TcpMessages  open TcpMessages
45      
46      
47  let send_client c m = send_client c.client_sock m  let send_client c m = send_client c.client_sock m
48    
49  let as_ft file = as_file file.ft_file  let as_ft file = as_file file.ft_file
50  let ft_num file = file_num (as_ft file)  let ft_num file = file_num (as_ft file)
51  let ft_size file = file.ft_file.impl_file_size  let ft_size file = file.ft_file.impl_file_size
52  let ft_state file = file_state (as_ft file)    let ft_state file = file_state (as_ft file)
53      
54  let as_file file = as_file file.file_file          let as_file file = as_file file.file_file
55  let file_size file = file.file_file.impl_file_size  let file_size file = file.file_file.impl_file_size
56  let file_downloaded file = file_downloaded (as_file file)  let file_downloaded file = file_downloaded (as_file file)
57  let file_age file = file.file_file.impl_file_age  let file_age file = file.file_file.impl_file_age
58  let file_fd file = file.file_file.impl_file_fd  let file_fd file = file.file_file.impl_file_fd
59  let file_disk_name file = file_disk_name (as_file file)  let file_disk_name file = file_disk_name (as_file file)
60  let file_state file = file_state (as_file file)    let file_state file = file_state (as_file file)
61  let file_num file = file_num (as_file file)  let file_num file = file_num (as_file file)
62  let file_must_update file = file_must_update (as_file file)  let file_must_update file = file_must_update (as_file file)
63    
64      
65  let set_file_state file state =  let set_file_state file state =
66   CommonFile.set_file_state (as_file file) state   CommonFile.set_file_state (as_file file) state
67    
68  let as_client c = as_client c.client_client  let as_client c = as_client c.client_client
# Line 69  let client_type c = client_type (as_clie Line 70  let client_type c = client_type (as_clie
70    
71  let set_client_state client state =  let set_client_state client state =
72    CommonClient.set_client_state (as_client client) state    CommonClient.set_client_state (as_client client) state
73      
74  let set_client_disconnected client =  let set_client_disconnected client =
75    CommonClient.set_client_disconnected (as_client client)    CommonClient.set_client_disconnected (as_client client)
76    
77  let client_num c = client_num (as_client c)  let client_num c = client_num (as_client c)
78    
79      
80  let network = new_network "BT" "BitTorrent"    let network = new_network "BT" "BitTorrent"
81      [      [
82      NetworkHasMultinet;      NetworkHasMultinet;
83      NetworkHasUpload;      NetworkHasUpload;
84        NetworkHasStats;
85    ]    ]
86    
87  let connection_manager = network.network_connection_manager  let connection_manager = network.network_connection_manager
88    
89  let (shared_ops : file CommonShared.shared_ops) =  let (shared_ops : file CommonShared.shared_ops) =
90    CommonShared.new_shared_ops network    CommonShared.new_shared_ops network
91    
92  let (server_ops : server CommonServer.server_ops) =  let (server_ops : server CommonServer.server_ops) =
93    CommonServer.new_server_ops network    CommonServer.new_server_ops network
94    
95  let (room_ops : server CommonRoom.room_ops) =  let (room_ops : server CommonRoom.room_ops) =
96    CommonRoom.new_room_ops network    CommonRoom.new_room_ops network
97      
98  let (user_ops : user CommonUser.user_ops) =  let (user_ops : user CommonUser.user_ops) =
99    CommonUser.new_user_ops network    CommonUser.new_user_ops network
100      
101  let (file_ops : file CommonFile.file_ops) =  let (file_ops : file CommonFile.file_ops) =
102    CommonFile.new_file_ops network    CommonFile.new_file_ops network
103      
104  let (ft_ops : ft CommonFile.file_ops) =  let (ft_ops : ft CommonFile.file_ops) =
105    CommonFile.new_file_ops network    CommonFile.new_file_ops network
106      
107  let (client_ops : client CommonClient.client_ops) =  let (client_ops : client CommonClient.client_ops) =
108    CommonClient.new_client_ops network    CommonClient.new_client_ops network
109        
110  module DO = CommonOptions  module DO = CommonOptions
111    
112  let current_files = ref ([] : BTTypes.file list)  let current_files = ref ([] : BTTypes.file list)
113    
114  let listen_sock = ref (None : TcpServerSocket.t option)  let listen_sock = ref (None : TcpServerSocket.t option)
115      
116  let files_by_uid = Hashtbl.create 13  let files_by_uid = Hashtbl.create 13
117      
118  let max_range_len = Int64.of_int (1 lsl 14)  let max_range_len = Int64.of_int (1 lsl 14)
119  let max_request_len = Int64.of_int (1 lsl 16)  let max_request_len = Int64.of_int (1 lsl 16)
120      
121  let check_if_interesting file c =  let check_if_interesting file c =
122      
123    if not c.client_alrd_sent_notinterested then    if not c.client_alrd_sent_notinterested then
124      let up = match c.client_uploader with      let up = match c.client_uploader with
125          None -> assert false          None -> assert false
126        | Some up -> up        | Some up -> up
127      in      in
128      let swarmer = Int64Swarmer.uploader_swarmer up in      let swarmer = Int64Swarmer.uploader_swarmer up in
129      let must_send =      let must_send =
130  (* The client has nothing to propose to us *)  (* The client has nothing to propose to us *)
131        (not (Int64Swarmer.is_interesting up )) &&        (not (Int64Swarmer.is_interesting up )) &&
132  (* All the requested ranges are useless *)  (* All the requested ranges are useless *)
# Line 139  let check_if_interesting file c = Line 141  let check_if_interesting file c =
141  (* The current block is also useless *)  (* The current block is also useless *)
142        (match c.client_block with        (match c.client_block with
143            None -> true            None -> true
144          | Some b ->          | Some b ->
145              let block_num = Int64Swarmer.block_num swarmer b in              let block_num = Int64Swarmer.block_num swarmer b in
146              let bitmap = Int64Swarmer.verified_bitmap swarmer in              let bitmap = Int64Swarmer.verified_bitmap swarmer in
147              bitmap.[block_num] <> '3')              bitmap.[block_num] <> '3')
# Line 163  let create_temp_file file_temp file_file Line 165  let create_temp_file file_temp file_file
165        Unix32.create_multifile file_temp        Unix32.create_multifile file_temp
166          [Unix.O_RDWR; Unix.O_CREAT] 0o666 file_files          [Unix.O_RDWR; Unix.O_CREAT] 0o666 file_files
167      else      else
168        Unix32.create_rw file_temp        Unix32.create_rw file_temp
169    in    in
170    if Unix32.destroyed file_fd then    if Unix32.destroyed file_fd then
171      failwith      failwith
172        (Printf.sprintf        (Printf.sprintf
173          "create_temp_file: Unix32.create returned a destroyed FD for %s\n"          "create_temp_file: Unix32.create returned a destroyed FD for %s\n"
174          file_temp);          file_temp);
# Line 180  let set_trackers file file_trackers = Line 182  let set_trackers file file_trackers =
182            tracker_last_clients_num = 0;            tracker_last_clients_num = 0;
183          } ) file_trackers) @ file.file_trackers          } ) file_trackers) @ file.file_trackers
184            
185  let new_file file_id t torrent_diskname file_temp file_state =  let new_file file_id t torrent_diskname file_temp file_state =
186    try    try
187      Hashtbl.find files_by_uid file_id      Hashtbl.find files_by_uid file_id
188    with Not_found ->    with Not_found ->
189        let file_fd = create_temp_file file_temp t.torrent_files in        let file_fd = create_temp_file file_temp t.torrent_files in
190        let rec file = {        let rec file = {
191            file_tracker_connected = false;            file_tracker_connected = false;
# Line 209  let new_file file_id t torrent_diskname Line 211  let new_file file_id t torrent_diskname
211            impl_file_downloaded = Int64.zero;            impl_file_downloaded = Int64.zero;
212            impl_file_val = file;            impl_file_val = file;
213            impl_file_ops = file_ops;            impl_file_ops = file_ops;
214            impl_file_age = last_time ();                      impl_file_age = last_time ();
215            impl_file_best_name = t.torrent_name;            impl_file_best_name = t.torrent_name;
216          }          }
217        in        in
# Line 217  let new_file file_id t torrent_diskname Line 219  let new_file file_id t torrent_diskname
219        if file_state <> FileShared then begin        if file_state <> FileShared then begin
220            let kernel = Int64Swarmer.create_swarmer file_temp (file_size file)            let kernel = Int64Swarmer.create_swarmer file_temp (file_size file)
221              (min max_range_len file.file_piece_size) in              (min max_range_len file.file_piece_size) in
222            let swarmer = Int64Swarmer.create kernel (as_file file)            let swarmer = Int64Swarmer.create kernel (as_file file)
223              file.file_piece_size in              file.file_piece_size in
224            file.file_swarmer <- Some swarmer;            file.file_swarmer <- Some swarmer;
225            Int64Swarmer.set_verified swarmer (fun _ num ->            Int64Swarmer.set_verified swarmer (fun _ num ->
226                file.file_blocks_downloaded <- (num) ::                file.file_blocks_downloaded <- (num) ::
227                file.file_blocks_downloaded;                file.file_blocks_downloaded;
228                file_must_update file;                file_must_update file;
229  (*Automatically send Have to ALL clients once a piece is verified  (*Automatically send Have to ALL clients once a piece is verified
230              NB : will probably have to check if client can be interested*)              NB : will probably have to check if client can be interested*)
231                Hashtbl.iter (fun _ c ->                Hashtbl.iter (fun _ c ->
232                      
233                    if c.client_registered_bitfield then                    if c.client_registered_bitfield then
234                      begin                      begin
235                        match c.client_bitmap with                        match c.client_bitmap with
# Line 235  let new_file file_id t torrent_diskname Line 237  let new_file file_id t torrent_diskname
237                        | Some bitmap ->                        | Some bitmap ->
238                            if (bitmap.[num] <> '1') then                            if (bitmap.[num] <> '1') then
239                              send_client c (Have (Int64.of_int num));                              send_client c (Have (Int64.of_int num));
240                            check_if_interesting file c                                                      check_if_interesting file c
241                      end                                              end
242                ) file.file_clients                ) file.file_clients
243              
244            );            );
245            Int64Swarmer.set_verifier swarmer (Verification            Int64Swarmer.set_verifier swarmer (Verification
246                (Array.map (fun sha1 -> Sha1 sha1) file.file_chunks));                (Array.map (fun sha1 -> Sha1 sha1) file.file_chunks));
# Line 248  let new_file file_id t torrent_diskname Line 250  let new_file file_id t torrent_diskname
250        file_add file_impl file_state;        file_add file_impl file_state;
251  (*      lprintf "ADD FILE TO DOWNLOAD LIST\n"; *)  (*      lprintf "ADD FILE TO DOWNLOAD LIST\n"; *)
252        file        file
253          
254  let new_download file_id t torrent_diskname =  let new_download file_id t torrent_diskname =
255    let file_temp = Filename.concat !!DO.temp_directory    let file_temp = Filename.concat !!DO.temp_directory
256        (Printf.sprintf "BT-%s" (Sha1.to_string file_id)) in        (Printf.sprintf "BT-%s" (Sha1.to_string file_id)) in
257    new_file file_id t torrent_diskname file_temp FileDownloading    new_file file_id t torrent_diskname file_temp FileDownloading
258          
259  let ft_by_num = Hashtbl.create 13  let ft_by_num = Hashtbl.create 13
260  let ft_counter = ref 0  let ft_counter = ref 0
261      
262  let new_ft file_name =  let new_ft file_name =
263    incr ft_counter;    incr ft_counter;
264    let rec ft = {    let rec ft = {
# Line 271  let new_ft file_name = Line 273  let new_ft file_name =
273        impl_file_downloaded = Int64.zero;        impl_file_downloaded = Int64.zero;
274        impl_file_val = ft;        impl_file_val = ft;
275        impl_file_ops = ft_ops;        impl_file_ops = ft_ops;
276        impl_file_age = last_time ();                  impl_file_age = last_time ();
277        impl_file_best_name = file_name;        impl_file_best_name = file_name;
278      }      }
279    in    in
280    Hashtbl.add ft_by_num !ft_counter ft;    Hashtbl.add ft_by_num !ft_counter ft;
281    file_add file_impl FileDownloading;    file_add file_impl FileDownloading;
282    ft    ft
283      
284  let _dot_string s h =  let _dot_string s h =
285    let len = String.length s in    let len = String.length s in
286    let char2hex c =    let char2hex c =
287      let ic = int_of_char c in      let ic = int_of_char c in
288      if ic >= 65 && ic <= 70 then      if ic >= 65 && ic <= 70 then
289        string_of_int (ic - 55)        string_of_int (ic - 55)
# Line 344  let decode_az_style s = Line 346  let decode_az_style s =
346      if not (!result = "") then      if not (!result = "") then
347        result := !result ^ " " ^ (dot_string (String.sub s 3 4));        result := !result ^ " " ^ (dot_string (String.sub s 3 4));
348      !result;      !result;
349    end else ""    end else ""
350    
351  let decode_tornado_style s =  let decode_tornado_style s =
352    let result = ref "" in    let result = ref "" in
353    if check_all s 45 [4;5] then begin    if check_all s 45 [4;5] then begin
354      let check_id s =      let check_id s =
355       match s with       match s with
356       | "T" -> "BitTornado"       | "T" -> "BitTornado"
357       | "A" -> "ABC"       | "A" -> "ABC"
# Line 357  let decode_tornado_style s = Line 359  let decode_tornado_style s =
359      in      in
360      if check_all s 45 [6;7;8] then      if check_all s 45 [6;7;8] then
361        let t = ref (check_id (String.sub s 0 1)) in        let t = ref (check_id (String.sub s 0 1)) in
362        if not (!t = "") then        if not (!t = "") then
363          result := !t ^ " " ^ dot_string_h (String.sub s 1 3);          result := !t ^ " " ^ dot_string_h (String.sub s 1 3);
364      else if s.[6] = (char_of_int 48) then      else if s.[6] = (char_of_int 48) then
365        let t = ref (check_id (String.sub s 0 1)) in        let t = ref (check_id (String.sub s 0 1)) in
366        if not (!t = "") then        if not (!t = "") then
367          result := !t ^ " LM " ^ dot_string_h (String.sub s 1 3);          result := !t ^ " LM " ^ dot_string_h (String.sub s 1 3);
368    end;    end;
369    !result    !result
370    
371  let decode_mainline_style s =  let decode_mainline_style s =
372    if check_all s 45 [2;4;6;7] then begin    if check_all s 45 [2;4;6;7] then begin
# Line 407  let decode_simple_style s = Line 409  let decode_simple_style s =
409    in    in
410    check 0    check 0
411    
412  let decode_mburst s =  let decode_mburst s =
413    if "Mbrst" = String.sub s 0 5 then    if "Mbrst" = String.sub s 0 5 then
414       "Burst! " ^ (dot_string_of_list s [5;7;9])       "Burst! " ^ (dot_string_of_list s [5;7;9])
415    else ""    else ""
# Line 422  let decode_bow s = Line 424  let decode_bow s =
424      "BitsOnWheels " ^ (String.sub s 4 3)      "BitsOnWheels " ^ (String.sub s 4 3)
425    else ""    else ""
426    
427  let decode_exeem s =  let decode_exeem s =
428    if "eX" = String.sub s 0 2 then    if "eX" = String.sub s 0 2 then
429      "eXeem [" ^ (String.sub s 2 18) ^ "]"      "eXeem [" ^ (String.sub s 2 18) ^ "]"
430    else ""    else ""
# Line 457  let decode_shadow s = Line 459  let decode_shadow s =
459      !result;      !result;
460    else ""    else ""
461    
462  let decode_bitspirit s =  let decode_bitspirit s =
463    let result = ref "" in    let result = ref "" in
464    if "BS" = String.sub s 2 2 then begin    if "BS" = String.sub s 2 2 then begin
465      if s.[1] = (char_of_int 0) then result := "BitSpirit v1";      if s.[1] = (char_of_int 0) then result := "BitSpirit v1";
# Line 471  let decode_upnp s = Line 473  let decode_upnp s =
473    else ""    else ""
474    
475  let decode_bitcomet s =  let decode_bitcomet s =
476    if "exbc" = String.sub s 0 4 then    if "exbc" = String.sub s 0 4 then
477      Printf.sprintf "BitComet %d.%d%d"      Printf.sprintf "BitComet %d.%d%d"
478        (int_of_char s.[4])        (int_of_char s.[4])
479        ((int_of_char s.[5]) / 10)        ((int_of_char s.[5]) / 10)
480        ((int_of_char s.[5]) mod 10)        ((int_of_char s.[5]) mod 10)
481    else ""    else ""
482    
483  let decode_shareaza s =  let decode_shareaza s =
484    let rec not_zeros pos =    let rec not_zeros pos =
485      if pos > 15 then true else      if pos > 15 then true else
486        if s.[pos] = (char_of_int 0) then false else not_zeros (pos+1)        if s.[pos] = (char_of_int 0) then false else not_zeros (pos+1)
487    in    in
488    let rec weird_crap pos =    let rec weird_crap pos =
489      if pos > 19 then true else      if pos > 19 then true else
490        let i1 = (int_of_char s.[pos]) in        let i1 = (int_of_char s.[pos]) in
491        let i2 = (int_of_char s.[(pos mod 16)]) in        let i2 = (int_of_char s.[(pos mod 16)]) in
492        let i3 = (int_of_char s.[(15 - (pos mod 16))]) in        let i3 = (int_of_char s.[(15 - (pos mod 16))]) in
# Line 501  let decode_non_zero s = Line 503  let decode_non_zero s =
503          find_non_zero (pos+1)          find_non_zero (pos+1)
504    in    in
505    let result = ref "" in    let result = ref "" in
506    (match find_non_zero 0 with    (match find_non_zero 0 with
507       8 -> (if "UDP0" = String.sub s 16 4 then       8 -> (if "UDP0" = String.sub s 16 4 then
508              result := "BitComet UDP";              result := "BitComet UDP";
509            if "HTTPBT" = String.sub s 14 6 then            if "HTTPBT" = String.sub s 14 6 then
510              result := "BitComet HTTP";)              result := "BitComet HTTP";)
511    |  9 -> if check_all s 3 [9;10;11] then    |  9 -> if check_all s 3 [9;10;11] then
512        result := "Snark";        result := "Snark";
513    | 12 -> if check_all s 97 [12;13] then    | 12 -> if check_all s 97 [12;13] then
514          result := "Experimental 3.2.1b2"          result := "Experimental 3.2.1b2"
# Line 521  let decode_non_zero s = Line 523  let decode_non_zero s =
523    !result    !result
524    
525  let parse_software s =  let parse_software s =
526    try    try
527    let rec try_styles i =    let rec try_styles i =
528      if i > 16 then "UNKNOWN" else begin      if i > 16 then "UNKNOWN" else begin
529      let res = ref      let res = ref
# Line 552  let parse_software s = Line 554  let parse_software s =
554    in    in
555    try_styles 0    try_styles 0
556    with _ -> "ERROR"    with _ -> "ERROR"
557          
558  let new_client file peer_id kind =  let new_client file peer_id kind =
559    try    try
560      let c = Hashtbl.find file.file_clients kind in      let c = Hashtbl.find file.file_clients kind in
# Line 593  let new_client file peer_id kind = Line 595  let new_client file peer_id kind =
595            client_incoming = false;            client_incoming = false;
596            client_registered_bitfield = false;            client_registered_bitfield = false;
597            client_last_optimist = 0;            client_last_optimist = 0;
598            client_software = if peer_id != Sha1.null then            client_software = if peer_id != Sha1.null then
599                (parse_software (Sha1.direct_to_string peer_id))                (parse_software (Sha1.direct_to_string peer_id))
600              else "NOT_RECEIVED";              else "NOT_RECEIVED";
601          } and impl = {          } and impl = {
# Line 618  let remove_client c = Line 620  let remove_client c =
620      c.client_file.file_clients_num <- c.client_file.file_clients_num  - 1;      c.client_file.file_clients_num <- c.client_file.file_clients_num  - 1;
621      file_remove_source (as_file c.client_file) (as_client c)      file_remove_source (as_file c.client_file) (as_client c)
622    
     
623  let old_torrents_directory = "torrents"  let old_torrents_directory = "torrents"
624  let downloads_directory = Filename.concat old_torrents_directory "downloads"  let downloads_directory = Filename.concat old_torrents_directory "downloads"
625  let tracked_directory = Filename.concat old_torrents_directory "tracked"  let tracked_directory = Filename.concat old_torrents_directory "tracked"

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