/[mldonkey]/mldonkey/src/networks/fileTP/fileTPGlobals.ml
ViewVC logotype

Diff of /mldonkey/src/networks/fileTP/fileTPGlobals.ml

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

revision 1.12 by spiralvoice, Thu Jul 7 00:25:46 2005 UTC revision 1.13 by spiralvoice, Tue Jul 26 23:16:48 2005 UTC
# Line 25  open Md4 Line 25  open Md4
25  open BasicSocket  open BasicSocket
26  open Options  open Options
27  open TcpBufferedSocket  open TcpBufferedSocket
28      
29  open CommonOptions  open CommonOptions
30  open CommonClient  open CommonClient
31  open CommonUser  open CommonUser
# Line 35  open CommonServer Line 35  open CommonServer
35  open CommonResult  open CommonResult
36  open CommonFile  open CommonFile
37  open CommonGlobals  open CommonGlobals
38  open CommonDownloads    open CommonDownloads
39  open CommonNetwork  open CommonNetwork
40      
41  open FileTPTypes  open FileTPTypes
42  open FileTPOptions  open FileTPOptions
43    
44      let network = new_network "FTP" "FileTP"
     
 let network = new_network "FTP" "FileTP"    
45      [ ]      [ ]
46    
47  let connection_manager = network.network_connection_manager  let connection_manager = network.network_connection_manager
48      
49    (*    (*
50  let (result_ops : result CommonResult.result_ops) =  let (result_ops : result CommonResult.result_ops) =
51    CommonResult.new_result_ops network    CommonResult.new_result_ops network
52      *)      *)
53    
54  let (server_ops : server CommonServer.server_ops) =  let (server_ops : server CommonServer.server_ops) =
55    CommonServer.new_server_ops network    CommonServer.new_server_ops network
56    
57  let (room_ops : server CommonRoom.room_ops) =  let (room_ops : server CommonRoom.room_ops) =
58    CommonRoom.new_room_ops network    CommonRoom.new_room_ops network
59      
60  let (user_ops : user CommonUser.user_ops) =  let (user_ops : user CommonUser.user_ops) =
61    CommonUser.new_user_ops network    CommonUser.new_user_ops network
62      
63  let (file_ops : file CommonFile.file_ops) =  let (file_ops : file CommonFile.file_ops) =
64    CommonFile.new_file_ops network    CommonFile.new_file_ops network
65      
66  let (client_ops : client CommonClient.client_ops) =  let (client_ops : client CommonClient.client_ops) =
67    CommonClient.new_client_ops network    CommonClient.new_client_ops network
68    
69  let as_client c = as_client c.client_client  let as_client c = as_client c.client_client
70  let as_file file = as_file file.file_file      let as_file file = as_file file.file_file
71  let file_size file = file.file_file.impl_file_size  let file_size file = file.file_file.impl_file_size
72  let file_downloaded file = file_downloaded (as_file file)  let file_downloaded file = file_downloaded (as_file file)
73  let file_age file = file.file_file.impl_file_age  let file_age file = file.file_file.impl_file_age
74  let file_fd file = file.file_file.impl_file_fd  let file_fd file = file.file_file.impl_file_fd
75  let file_disk_name file = file_disk_name (as_file file)  let file_disk_name file = file_disk_name (as_file file)
76  let file_best_name file = file_best_name (as_file file)  let file_best_name file = file_best_name (as_file file)
77      
78  let current_files = ref ([] : FileTPTypes.file list)  let current_files = ref ([] : FileTPTypes.file list)
79    
80  let listen_sock = ref (None : TcpServerSocket.t option)  let listen_sock = ref (None : TcpServerSocket.t option)
     
81    
82    (*    (*
83  let redirector_connected = ref false  let redirector_connected = ref false
# Line 91  let redirectors_to_try = ref ( [] : stri Line 88  let redirectors_to_try = ref ( [] : stri
88  let files_by_uid = Hashtbl.create 13  let files_by_uid = Hashtbl.create 13
89    
90  let clients_by_uid = Hashtbl.create 127  let clients_by_uid = Hashtbl.create 127
91  let protos_by_name = Hashtbl.create 13    let protos_by_name = Hashtbl.create 13
92      
93  let find_proto (name : string) =  let find_proto (name : string) =
94    (Hashtbl.find protos_by_name name : tp_proto)    (Hashtbl.find protos_by_name name : tp_proto)
     
 (***************************************************************  
95    
96    (***************************************************************
97    
98               HOST SCHEDULER               HOST SCHEDULER
99    
   
100  ****************************************************************)  ****************************************************************)
101      
     
           
102  let min_range_size = megabyte  let min_range_size = megabyte
103    
104  let set_file_size file size =    let set_file_size file size =
105    lprintf "set_file_size\n";    lprintf "set_file_size\n";
106    if file_size file = zero && size <> zero then begin    if file_size file = zero && size <> zero then begin
107        lprintf "Setting SWARMER\n";        lprintf "Setting SWARMER\n";
# Line 120  let set_file_size file size = Line 113  let set_file_size file size =
113        file.file_file.impl_file_size <- size;        file.file_file.impl_file_size <- size;
114        let file_temp = Unix32.filename (file_fd file) in        let file_temp = Unix32.filename (file_fd file) in
115        let kernel = Int64Swarmer.create_swarmer file_temp size min_range_size in        let kernel = Int64Swarmer.create_swarmer file_temp size min_range_size in
116        let swarmer = Int64Swarmer.create kernel (as_file file)        let swarmer = Int64Swarmer.create kernel (as_file file)
117            file_chunk_size in            file_chunk_size in
118        file.file_swarmer <- Some swarmer;            file.file_swarmer <- Some swarmer;
119        lprintf "Swarmer set\n";        lprintf "Swarmer set\n";
120        Int64Swarmer.set_verified swarmer (fun _ _ ->        Int64Swarmer.set_verified swarmer (fun _ _ ->
121            file_must_update (as_file file);            file_must_update (as_file file);
122        );        );
123        (*        (*
124        Int64Swarmer.set_writer swarmer (fun offset s pos len ->              Int64Swarmer.set_writer swarmer (fun offset s pos len ->
125    
126  (*  (*
127        lprintf "DOWNLOADED: %d/%d/%d\n" pos len (String.length s);        lprintf "DOWNLOADED: %d/%d/%d\n" pos len (String.length s);
128        AnyEndian.dump_sub s pos len;        AnyEndian.dump_sub s pos len;
129  *)  *)
130              
131            if !!CommonOptions.buffer_writes then            if !!CommonOptions.buffer_writes then
132              Unix32.buffered_write_copy (file_fd file) offset s pos len              Unix32.buffered_write_copy (file_fd file) offset s pos len
133            else            else
134              Unix32.write  (file_fd file) offset s pos len              Unix32.write  (file_fd file) offset s pos len
135        ) *)        ) *)
136      end      end
137        
138  let new_file file_id file_name file_size =  let new_file file_id file_name file_size =
139    let file_temp = Filename.concat !!temp_directory    let file_temp = Filename.concat !!temp_directory
140        (Printf.sprintf "FileTP-%s" (Md4.to_string file_id)) in        (Printf.sprintf "FileTP-%s" (Md4.to_string file_id)) in
141    let t = Unix32.create_rw file_temp in    let t = Unix32.create_rw file_temp in
142    let rec file = {    let rec file = {
# Line 162  let new_file file_id file_name file_size Line 155  let new_file file_id file_name file_size
155        impl_file_downloaded = zero;        impl_file_downloaded = zero;
156        impl_file_val = file;        impl_file_val = file;
157        impl_file_ops = file_ops;        impl_file_ops = file_ops;
158        impl_file_age = last_time ();                  impl_file_age = last_time ();
159        impl_file_best_name = Filename.basename file_name;        impl_file_best_name = Filename.basename file_name;
160      }      }
161    in    in
# Line 173  let new_file file_id file_name file_size Line 166  let new_file file_id file_name file_size
166    file    file
167    
168  exception FileFound of file  exception FileFound of file
169      
170  let new_file file_id file_name file_size =  let new_file file_id file_name file_size =
171    try    try
172      Hashtbl.find files_by_uid file_id      Hashtbl.find files_by_uid file_id
173    with _ ->    with _ ->
174        let file = new_file file_id file_name file_size  in        let file = new_file file_id file_name file_size  in
175        Hashtbl.add files_by_uid file_id file;        Hashtbl.add files_by_uid file_id file;
176        file            file
177          
178  let new_client proto hostname port =  let new_client proto hostname port =
179    let key = (hostname,port) in    let key = (hostname,port) in
180    try    try
# Line 190  let new_client proto hostname port = Line 183  let new_client proto hostname port =
183        let rec c = {        let rec c = {
184            client_client = impl;            client_client = impl;
185            client_sock = NoConnection;            client_sock = NoConnection;
186  (*          client_name = name;  (*          client_name = name;
187            client_kind = None; *)            client_kind = None; *)
188            client_requests = [];            client_requests = [];
189  (*  (*
190  client_pos = Int32.zero;  client_pos = Int32.zero;
191  client_error = false;  client_error = false;
192    *)    *)
193      
194            client_connection_control = new_connection_control (());            client_connection_control = new_connection_control (());
195            client_downloads = [];            client_downloads = [];
196            client_hostname = hostname;            client_hostname = hostname;
# Line 215  client_error = false; Line 208  client_error = false;
208        new_client impl;        new_client impl;
209        Hashtbl.add clients_by_uid key c;        Hashtbl.add clients_by_uid key c;
210        c        c
211        
212  let add_download file c url =  let add_download file c url =
213  (*  let r = new_result file.file_name (file_size file) in *)  (*  let r = new_result file.file_name (file_size file) in *)
214  (*  add_source r c.client_user index; *)  (*  add_source r c.client_user index; *)
# Line 223  let add_download file c url = Line 216  let add_download file c url =
216    if not (List.memq c file.file_clients) then begin    if not (List.memq c file.file_clients) then begin
217        let chunks = [ Int64.zero, file_size file ] in        let chunks = [ Int64.zero, file_size file ] in
218        (*        (*
219        let bs = Int64Swarmer.register_uploader file.file_swarmer        let bs = Int64Swarmer.register_uploader file.file_swarmer
220          (Int64Swarmer.AvailableRanges chunks) in *)          (Int64Swarmer.AvailableRanges chunks) in *)
221        c.client_downloads <- c.client_downloads @ [{        c.client_downloads <- c.client_downloads @ [{
222            download_file = file;            download_file = file;
# Line 241  let add_download file c url = Line 234  let add_download file c url =
234          end;          end;
235      end      end
236    
237  let rec find_download file list =  let rec find_download file list =
238    match list with    match list with
239      [] -> raise Not_found      [] -> raise Not_found
240    | d :: tail ->    | d :: tail ->
241        if d.download_file == file then d else find_download file tail        if d.download_file == file then d else find_download file tail
242    
243            let rec find_download_by_index index list =
 let rec find_download_by_index index list =  
244    match list with    match list with
245      [] -> raise Not_found      [] -> raise Not_found
246    | d :: tail ->    | d :: tail ->
247        if d.download_url = index then        if d.download_url = index then
248          d          d
249        else        else
250          find_download_by_index index tail          find_download_by_index index tail
             
251    
252  let remove_download file list =  let remove_download file list =
253    let rec iter file list rev =    let rec iter file list rev =
# Line 268  let remove_download file list = Line 259  let remove_download file list =
259            iter file tail (d :: rev)            iter file tail (d :: rev)
260    in    in
261    iter file list []    iter file list []
262      
263  let file_state file = file_state (as_file file)  let file_state file = file_state (as_file file)
264      
265  let file_num file =  file_num (as_file file)  let file_num file =  file_num (as_file file)
266      
267  let file_must_update file =  let file_must_update file =
268    file_must_update (as_file file)    file_must_update (as_file file)
269    
# Line 280  let client_type c = client_type (as_clie Line 271  let client_type c = client_type (as_clie
271    
272  let set_client_state client state =  let set_client_state client state =
273    CommonClient.set_client_state (as_client client) state    CommonClient.set_client_state (as_client client) state
274      
275  let set_client_disconnected client =  let set_client_disconnected client =
276    CommonClient.set_client_disconnected (as_client client)    CommonClient.set_client_disconnected (as_client client)
277      
278      let remove_file file =
 let remove_file file =  
279    Hashtbl.remove files_by_uid file.file_id;    Hashtbl.remove files_by_uid file.file_id;
280    current_files := List2.removeq file !current_files      current_files := List2.removeq file !current_files
281    
282  let udp_sock = ref (None : UdpSocket.t option)  let udp_sock = ref (None : UdpSocket.t option)
283    
# Line 297  let client_ip sock = Line 287  let client_ip sock =
287    
288  let old_client_name = ref ""  let old_client_name = ref ""
289  let ft_client_name = ref ""  let ft_client_name = ref ""
290      
291      let client_name () =
292  let client_name () =  
     
293    let name = !!global_login in    let name = !!global_login in
294    if name != !old_client_name then  begin    if name != !old_client_name then  begin
295        let len = String.length name in        let len = String.length name in
# Line 309  let client_name () = Line 298  let client_name () =
298        String2.replace_char !ft_client_name ' ' '_';        String2.replace_char !ft_client_name ' ' '_';
299      end;      end;
300    !ft_client_name    !ft_client_name
301      
302  let file_chunk_size = 307200  let file_chunk_size = 307200
     
     

Legend:
Removed from v.1.12  
changed lines
  Added in v.1.13

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