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

Diff of /mldonkey/src/networks/bittorrent/bTInteractive.ml

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

revision 1.43 by spiralvoice, Thu Jul 7 00:25:46 2005 UTC revision 1.44 by spiralvoice, Sun Jul 10 23:19:16 2005 UTC
# Line 46  open BTProtocol Line 46  open BTProtocol
46    
47  open Bencode  open Bencode
48    
49  open Gettext    open Gettext
50  let _s x = _s "BTInteractive" x  let _s x = _s "BTInteractive" x
51  let _b x = _b "BTInteractive" x  let _b x = _b "BTInteractive" x
52    
# Line 78  let op_file_debug file = Line 78  let op_file_debug file =
78    Buffer.contents buf    Buffer.contents buf
79    
80  let op_file_commit file new_name =  let op_file_commit file new_name =
81    if file_state file <> FileShared then    if file_state file <> FileShared then
82      begin      begin
83        if not (List.mem (file.file_name, file_size file) !!old_files) then        if not (List.mem (file.file_name, file_size file) !!old_files) then
84          old_files =:= (file.file_name, file_size file) :: !!old_files;          old_files =:= (file.file_name, file_size file) :: !!old_files;
# Line 93  let op_file_commit file new_name = Line 93  let op_file_commit file new_name =
93    
94        if Unix32.destroyed (file_fd file) then        if Unix32.destroyed (file_fd file) then
95          lprintf_nl "[BT]: op_file_commit: FD is destroyed... could not repair !!!";          lprintf_nl "[BT]: op_file_commit: FD is destroyed... could not repair !!!";
96          
97        let new_torrent_diskname =        let new_torrent_diskname =
98          Filename.concat seeded_directory          Filename.concat seeded_directory
99            (Filename.basename file.file_torrent_diskname)            (Filename.basename file.file_torrent_diskname)
100        in        in
101        (try        (try
102            Unix2.rename file.file_torrent_diskname new_torrent_diskname;            Unix2.rename file.file_torrent_diskname new_torrent_diskname;
103          with _ ->          with _ ->
104            (lprintf "BT op_file_commit: failed to rename %s to %s\n"            (lprintf_nl "BT op_file_commit: failed to rename %s to %s"
105                file.file_torrent_diskname new_torrent_diskname));                file.file_torrent_diskname new_torrent_diskname));
106        file.file_torrent_diskname <- new_torrent_diskname;        file.file_torrent_diskname <- new_torrent_diskname;
107    
108      end      end
109        
110  let op_file_print_html file buf =  let op_file_print_html file buf =
111      
112    html_mods_cntr_init ();    html_mods_cntr_init ();
113      
114    Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr ());    Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr ());
115    html_mods_td buf [    html_mods_td buf [
116      ("Filename", "sr br", "Filename");      ("Filename", "sr br", "Filename");
117      ("", "sr", file.file_name ) ];      ("", "sr", file.file_name) ];
118      
119    Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr ());    Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr ());
120      
121    html_mods_td buf [    html_mods_td buf [
122      ("Tracker", "sr br", "Tracker");      ("Tracker", "sr br", "Tracker");
123      ("", "sr", match file.file_trackers with      ("", "sr", match file.file_trackers with
124          [] -> ""          [] -> ""
125        | t :: _ -> t.tracker_url) ];        | t :: _ -> t.tracker_url) ];
126      
127    Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>"    Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>"
128      (html_mods_cntr ());      (html_mods_cntr ());
129    html_mods_td buf [    html_mods_td buf [
130      ("Torrent Fname", "sr br", "Torrent Fname");      ("Torrent Fname", "sr br", "Torrent Fname");
131      ("", "sr", file.file_torrent_diskname) ];      ("", "sr", file.file_torrent_diskname) ];
132      
133    Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr ());    Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr ());
134    html_mods_td buf [    html_mods_td buf [
135      ("Connect Interval", "sr br", "Con Inverval");      ("Connect Interval", "sr br", "Con Inverval");
136      ("", "sr", match file.file_trackers with      ("", "sr", match file.file_trackers with
137          [] -> "-"          [] -> "-"
138        | t :: _ -> Printf.sprintf "%d" t.tracker_interval ) ];        | t :: _ -> Printf.sprintf "%d" t.tracker_interval ) ];
139      
140    Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr ());    Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr ());
141    html_mods_td buf [    html_mods_td buf [
142      ("Last Connect", "sr br", "Last Connect");      ("Last Connect", "sr br", "Last Connect");
# Line 145  let op_file_print_html file buf = Line 145  let op_file_print_html file buf =
145        | t :: _ -> string_of_date t.tracker_last_conn) ]        | t :: _ -> string_of_date t.tracker_last_conn) ]
146    
147  let op_file_print_sources_html file buf =  let op_file_print_sources_html file buf =
148      
149    if Hashtbl.length file.file_clients > 0 then begin    if Hashtbl.length file.file_clients > 0 then begin
150          
151        let chunks = (match file.file_swarmer with        let chunks = (match file.file_swarmer with
152              None -> "" | Some swarmer ->              None -> "" | Some swarmer ->
153                Int64Swarmer.verified_bitmap swarmer) in                Int64Swarmer.verified_bitmap swarmer) in
154          
155        html_mods_table_header buf "sourcesTable" "sources al" [        html_mods_table_header buf "sourcesTable" "sources al" [
156          ( "1", "srh br ac", "Client number", "Num" ) ;          ( "1", "srh br ac", "Client number", "Num" ) ;
157          ( "0", "srh br", "Client UID", "UID" ) ;          ( "0", "srh br", "Client UID", "UID" ) ;
158          ( "0", "srh br", "Client software", "Soft" ) ;          ( "0", "srh br", "Client software", "Soft" ) ;
159          ( "0", "srh", "IP address", "IP address" ) ;          ( "0", "srh", "IP address", "IP address" ) ;
160          ( "0", "srh br ar", "Port", "Port" ) ;          ( "0", "srh br ar", "Port", "Port" ) ;
161          ( "1", "srh ar", "Total UL bytes to this client for all files", "UL" ) ;          ( "1", "srh ar", "Total UL bytes to this client for all files", "UL" ) ;
162          ( "1", "srh ar br", "Total DL bytes from this client for all files", "DL" ) ;          ( "1", "srh ar br", "Total DL bytes from this client for all files", "DL" ) ;
163          ( "1", "srh ar", "Interested [T]rue, [F]alse", "I" ) ;          ( "1", "srh ar", "Interested [T]rue, [F]alse", "I" ) ;
164          ( "1", "srh ar", "Choked [T]rue, [F]alse", "C" ) ;          ( "1", "srh ar", "Choked [T]rue, [F]alse", "C" ) ;
165          ( "1", "srh br ar", "Allowed to write", "A" ) ;          ( "1", "srh br ar", "Allowed to write", "A" ) ;
166            
167          ( "1", "srh ar", "Interesting [T]rue, [F]alse", "I" );          ( "1", "srh ar", "Interesting [T]rue, [F]alse", "I" );
168          ( "1", "srh ar", "Already sent interested [T]rue, [F]alse", "A" );          ( "1", "srh ar", "Already sent interested [T]rue, [F]alse", "A" );
169          ( "1", "srh br ar", "Already sent not interested [T]rue, [F]alse", "N" );          ( "1", "srh br ar", "Already sent not interested [T]rue, [F]alse", "N" );
170            
171          ( "1", "srh ar", "Good [T]rue, [F]alse", "G" );          ( "1", "srh ar", "Good [T]rue, [F]alse", "G" );
172          ( "1", "srh ar", "Incoming [T]rue, [F]alse", "I" );          ( "1", "srh ar", "Incoming [T]rue, [F]alse", "I" );
173          ( "1", "srh br ar", "Registered bitfield [T]rue, [F]alse", "B" );          ( "1", "srh br ar", "Registered bitfield [T]rue, [F]alse", "B" );
174            
175          ( "1", "srh ar", "Optimist Time", "O" );          ( "1", "srh ar", "Optimist Time", "O" );
176          ( "1", "srh ar", "Last optimist", "L.Opt" );          ( "1", "srh ar", "Last optimist", "L.Opt" );
177          ( "1", "srh br ar", "Num try", "N" );          ( "1", "srh br ar", "Num try", "N" );
178    
179  (*  (*
180          ( "0", "srh", "Bitmap (absent|partial|present|verified)", (colored_chunks          ( "0", "srh", "Bitmap (absent|partial|present|verified)", (colored_chunks
181          (Array.init (String.length info.G.file_chunks)          (Array.init (String.length info.G.file_chunks)
182          (fun i -> ((int_of_char info.G.file_chunks.[i])-48)))) ) ;          (fun i -> ((int_of_char info.G.file_chunks.[i])-48)))) ) ;
183  *)  *)
184          ( "1", "srh ar", "Number of full chunks", (Printf.sprintf "%d"          ( "1", "srh ar", "Number of full chunks", (Printf.sprintf "%d"
185                (String.length (String2.replace                (String.length (String2.replace
# Line 187  let op_file_print_sources_html file buf Line 187  let op_file_print_sources_html file buf
187    
188        Hashtbl.iter (fun _ c ->        Hashtbl.iter (fun _ c ->
189            Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr());            Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr());
190              
191            html_mods_td buf [            html_mods_td buf [
192              ("", "sr br ar", Printf.sprintf "%d" (client_num c));              ("", "sr br ar", Printf.sprintf "%d" (client_num c));
193              ("", "sr br", (Sha1.to_string c.client_uid));              ("", "sr br", (Sha1.to_string c.client_uid));
# Line 199  let op_file_print_sources_html file buf Line 199  let op_file_print_sources_html file buf
199              ("", "sr", (if c.client_interested then "T" else "F"));              ("", "sr", (if c.client_interested then "T" else "F"));
200              ("", "sr", (if c.client_choked then "T" else "F"));              ("", "sr", (if c.client_choked then "T" else "F"));
201              ("", "sr br ar", (Int64.to_string c.client_allowed_to_write));              ("", "sr br ar", (Int64.to_string c.client_allowed_to_write));
202  (* This is way too slow for 1000's of chunks on a page with 100's of sources  (* This is way too slow for 1000's of chunks on a page with 100's of sources
203      ("", "sr", (CommonFile.colored_chunks (Array.init (String.length c.client_bitmap)      ("", "sr", (CommonFile.colored_chunks (Array.init (String.length c.client_bitmap)
204         (fun i -> (if c.client_bitmap.[i] = '1' then 2 else 0)) )) );         (fun i -> (if c.client_bitmap.[i] = '1' then 2 else 0)) )) );
205  *)  *)
206              ("", "sr", (if c.client_interesting then "T" else "F"));              ("", "sr", (if c.client_interesting then "T" else "F"));
207              ("", "sr", (if c.client_alrd_sent_interested then "T" else "F"));              ("", "sr", (if c.client_alrd_sent_interested then "T" else "F"));
208              ("", "br sr", (if c.client_alrd_sent_notinterested then "T" else "F"));              ("", "br sr", (if c.client_alrd_sent_notinterested then "T" else "F"));
209                
210              ("", "sr", (if c.client_good then "T" else "F"));              ("", "sr", (if c.client_good then "T" else "F"));
211              ("", "sr", (if c.client_incoming then "T" else "F"));              ("", "sr", (if c.client_incoming then "T" else "F"));
212              ("", "br sr", (if c.client_registered_bitfield then "T" else "F"));              ("", "br sr", (if c.client_registered_bitfield then "T" else "F"));
213                
214              ("", "sr", Printf.sprintf "%d" c.client_optimist_time);              ("", "sr", Printf.sprintf "%d" c.client_optimist_time);
215              ("", "ar sr", string_of_date c.client_last_optimist);              ("", "ar sr", string_of_date c.client_last_optimist);
216              ("", "br sr", Printf.sprintf "%d" c.client_num_try);              ("", "br sr", Printf.sprintf "%d" c.client_num_try);
217                
218              ("", "sr ar", (let fc = ref 0 in              ("", "sr ar", (let fc = ref 0 in
219                  (match c.client_bitmap with                  (match c.client_bitmap with
220                      None -> ()                      None -> ()
221                    | Some bitmap ->                    | Some bitmap ->
222                        String.iter (fun s -> if s = '1' then incr fc) bitmap );                        String.iter (fun s -> if s = '1' then incr fc) bitmap );
223                  (Printf.sprintf "%d" !fc) ) ) ];                  (Printf.sprintf "%d" !fc) ) ) ];
224              
225            Printf.bprintf buf "\\</tr\\>";            Printf.bprintf buf "\\</tr\\>";
226    
227        ) file.file_clients;        ) file.file_clients;
228    
229        Printf.bprintf buf "\\</table\\>\\</div\\>\\<br\\>";        Printf.bprintf buf "\\</table\\>\\</div\\>\\<br\\>";
230        
231      end      end
232    
233  let op_file_check file =  let op_file_check file =
# Line 244  let op_file_cancel file = Line 244  let op_file_cancel file =
244    BTClients.disconnect_clients file;    BTClients.disconnect_clients file;
245    Sys.remove file.file_torrent_diskname    Sys.remove file.file_torrent_diskname
246    
247  let op_ft_cancel ft =  let op_ft_cancel ft =
248    Hashtbl.remove ft_by_num ft.ft_id    Hashtbl.remove ft_by_num ft.ft_id
249    
250  let op_ft_commit ft newname =  let op_ft_commit ft newname =
251    Hashtbl.remove ft_by_num ft.ft_id    Hashtbl.remove ft_by_num ft.ft_id
252    
253  let op_file_info file =  let op_file_info file =
254      
255    let module P = GuiTypes in    let module P = GuiTypes in
256      
257    let last_seen = match file.file_swarmer with    let last_seen = match file.file_swarmer with
258        None -> [| last_time () |]        None -> [| last_time () |]
259      | Some swarmer -> Int64Swarmer.compute_last_seen swarmer in      | Some swarmer -> Int64Swarmer.compute_last_seen swarmer in
260    {    {
261      P.file_fields = P.Fields_file_info.all;      P.file_fields = P.Fields_file_info.all;
262        
263      P.file_comment = file_comment (as_file file);      P.file_comment = file_comment (as_file file);
264      P.file_name = file.file_name;      P.file_name = file.file_name;
265      P.file_num = (file_num file);      P.file_num = (file_num file);
# Line 276  let op_file_info file = Line 276  let op_file_info file =
276      P.file_chunks = (match file.file_swarmer with      P.file_chunks = (match file.file_swarmer with
277          None -> "" | Some swarmer ->          None -> "" | Some swarmer ->
278            Int64Swarmer.verified_bitmap swarmer);            Int64Swarmer.verified_bitmap swarmer);
279      P.file_availability =        P.file_availability =
280      [network.network_num,(match file.file_swarmer with      [network.network_num,(match file.file_swarmer with
281            None -> "" | Some swarmer ->            None -> "" | Some swarmer ->
282              Int64Swarmer.availability swarmer)];              Int64Swarmer.availability swarmer)];
# Line 294  let op_ft_info ft = Line 294  let op_ft_info ft =
294    
295    {    {
296      P.file_fields = P.Fields_file_info.all;      P.file_fields = P.Fields_file_info.all;
297        
298      P.file_comment = file_comment (as_ft ft);      P.file_comment = file_comment (as_ft ft);
299      P.file_name = ft.ft_filename;      P.file_name = ft.ft_filename;
300      P.file_num = ft_num ft;      P.file_num = ft_num ft;
# Line 322  let op_ft_info ft = Line 322  let op_ft_info ft =
322    
323  let load_torrent_string s =  let load_torrent_string s =
324    let file_id, torrent = BTTorrent.decode_torrent s in    let file_id, torrent = BTTorrent.decode_torrent s in
325      
326    (* Save the torrent, because we later want to put    (* Save the torrent, because we later want to put
327       it in the seeded directory. *)       it in the seeded directory. *)
328    let torrent_diskname = Filename.concat    let torrent_diskname = Filename.concat
329      downloads_directory      downloads_directory
# Line 378  for parsing the response*) Line 378  for parsing the response*)
378    
379  let try_share_file torrent_diskname =  let try_share_file torrent_diskname =
380    if !verbose_share then lprintf_nl "[BT]: BTInteractive.try_share_file: %s" torrent_diskname;    if !verbose_share then lprintf_nl "[BT]: BTInteractive.try_share_file: %s" torrent_diskname;
381    let s = File.to_string torrent_diskname in      let s = File.to_string torrent_diskname in
382    let file_id, torrent = BTTorrent.decode_torrent s in    let file_id, torrent = BTTorrent.decode_torrent s in
383    
384    try    try
385      let filename =      let filename =
386        let rec iter list =        let rec iter list =
387          match list with          match list with
388            [] -> raise Not_found            [] -> raise Not_found
# Line 391  let try_share_file torrent_diskname = Line 391  let try_share_file torrent_diskname =
391              if match torrent.torrent_files with              if match torrent.torrent_files with
392                  [] -> not s.sharing_directories                  [] -> not s.sharing_directories
393                | _ ->  s.sharing_directories then                | _ ->  s.sharing_directories then
394                let filename =                let filename =
395                  Filename.concat sh.shdir_dirname torrent.torrent_name                  Filename.concat sh.shdir_dirname torrent.torrent_name
396                in                in
397                if !verbose_share then lprintf_nl "[BT]: Checking for %s" filename;                if !verbose_share then lprintf_nl "[BT]: Checking for %s" filename;
# Line 403  let try_share_file torrent_diskname = Line 403  let try_share_file torrent_diskname =
403        iter !!shared_directories        iter !!shared_directories
404      in      in
405    
406      let file = new_file file_id torrent torrent_diskname      let file = new_file file_id torrent torrent_diskname
407          filename FileShared in          filename FileShared in
408      BTShare.must_share_file file;      BTShare.must_share_file file;
409      if !verbose_share then lprintf_nl "[BT]: Sharing file %s" filename;      if !verbose_share then lprintf_nl "[BT]: Sharing file %s" filename;
410      BTClients.connect_trackers file "started"      BTClients.connect_trackers file "started"
411        (parse_tracker_reply file)        (parse_tracker_reply file)
412    with e ->    with e ->
413        lprintf_nl "[BT]: BTInteractive: cannot share torrent %s for %s"        lprintf_nl "[BT]: BTInteractive: cannot share torrent %s for %s"
414          torrent_diskname (Printexc2.to_string e)          torrent_diskname (Printexc2.to_string e)
415    
416  (* Call one minute after start, and then every 20 minutes. Should  (* Call one minute after start, and then every 20 minutes. Should
417    automatically contact the tracker. *)        automatically contact the tracker. *)
418  let share_files _ =  let share_files _ =
419    if !verbose_share then lprintf_nl "[BT]: BTInteractive.share_files";    if !verbose_share then lprintf_nl "[BT]: BTInteractive.share_files";
420    List.iter (fun dir ->    List.iter (fun dir ->
# Line 426  let share_files _ = Line 426  let share_files _ =
426    ) [seeded_directory];    ) [seeded_directory];
427    let copy_shfiles = !current_files in    let copy_shfiles = !current_files in
428    List.iter (fun file ->    List.iter (fun file ->
429        if not (Sys.file_exists file.file_torrent_diskname) &&        if not (Sys.file_exists file.file_torrent_diskname) &&
430          file_state file = FileShared then          file_state file = FileShared then
431          begin          begin
432            if !verbose_share then lprintf_nl "[BT]: Removing torrent share for %s" file.file_torrent_diskname;            if !verbose_share then lprintf_nl "[BT]: Removing torrent share for %s" file.file_torrent_diskname;
# Line 485  let op_network_parse_url url = Line 485  let op_network_parse_url url =
485              H.req_user_agent = Printf.sprintf "MLdonkey/%s" Autoconf.current_version;              H.req_user_agent = Printf.sprintf "MLdonkey/%s" Autoconf.current_version;
486              H.req_referer = (              H.req_referer = (
487                let referers = !!BTOptions.referers in                let referers = !!BTOptions.referers in
488                let (rule_search,rule_value) =                let (rule_search,rule_value) =
489                  try (List.find(fun (rule_search,rule_value) ->                  try (List.find(fun (rule_search,rule_value) ->
490                          Str.string_match (Str.regexp rule_search) real_url 0                          Str.string_match (Str.regexp rule_search) real_url 0
491                      ) referers )                      ) referers )
492                  with Not_found -> ("",real_url) in                  with Not_found -> ("",real_url) in
493                Some (Url.of_string rule_value) );                Some (Url.of_string rule_value) );
494              H.req_headers = try              H.req_headers = try
495                let cookies = List.assoc u.Url.server !!BTOptions.cookies in                let cookies = List.assoc u.Url.server !!BTOptions.cookies in
496                [ ( "Cookie", List.fold_left (fun res (key, value) ->                [ ( "Cookie", List.fold_left (fun res (key, value) ->
# Line 502  let op_network_parse_url url = Line 502  let op_network_parse_url url =
502                  ) ]                  ) ]
503              with Not_found -> [];              with Not_found -> [];
504            } in            } in
505            
506          let file_diskname = Filename.basename u.Url.short_file in          let file_diskname = Filename.basename u.Url.short_file in
507          let ft = new_ft file_diskname in          let ft = new_ft file_diskname in
508          ft.ft_retry <- load_torrent_from_web r ;          ft.ft_retry <- load_torrent_from_web r ;
# Line 541  let op_client_info c = Line 541  let op_client_info c =
541      P.client_state = client_state (as_client c);      P.client_state = client_state (as_client c);
542      P.client_type = client_type c;      P.client_type = client_type c;
543      P.client_tags = [];      P.client_tags = [];
544      P.client_name =      P.client_name =
545      (Printf.sprintf "%s:%d" (Ip.to_string ip) port);      (Printf.sprintf "%s:%d" (Ip.to_string ip) port);
546      P.client_files = None;      P.client_files = None;
547      P.client_num = (client_num c);      P.client_num = (client_num c);
# Line 557  let op_client_info c = Line 557  let op_client_info c =
557    }    }
558    
559  let op_client_connect c =  let op_client_connect c =
560    BTClients.connect_client c      BTClients.connect_client c
561    
562  let op_client_disconnect c=  let op_client_disconnect c=
563    BTClients.disconnect_client c Closed_by_user    BTClients.disconnect_client c Closed_by_user
# Line 565  let op_client_disconnect c= Line 565  let op_client_disconnect c=
565  let op_client_bprint c buf =  let op_client_bprint c buf =
566    let cc = as_client c in    let cc = as_client c in
567    let cinfo = client_info cc in    let cinfo = client_info cc in
568    Printf.bprintf buf "%s (%s)\n"    Printf.bprintf buf "%s (%s)\n"
569      cinfo.GuiTypes.client_name      cinfo.GuiTypes.client_name
570      (Sha1.to_string c.client_uid)      (Sha1.to_string c.client_uid)
571    
# Line 581  let op_client_dprint c o file = Line 581  let op_client_dprint c o file =
581    (if c.client_downloaded > c.client_uploaded then "-" else "+")    (if c.client_downloaded > c.client_uploaded then "-" else "+")
582    (if c.client_uploaded > Int64.zero then (Int64.to_float (Int64.div c.client_downloaded c.client_uploaded)) else (1.))    (if c.client_uploaded > Int64.zero then (Int64.to_float (Int64.div c.client_downloaded c.client_uploaded)) else (1.))
583    ("BT");    ("BT");
584    (Printf.bprintf buf (_b "%18sFile  : %s\n") "" info.GuiTypes.file_name)      (Printf.bprintf buf (_b "%18sFile  : %s\n") "" info.GuiTypes.file_name)
585    
586  let op_client_dprint_html c o file str =  let op_client_dprint_html c o file str =
587    let info = file_info file in    let info = file_info file in
# Line 599  let op_client_dprint_html c o file str = Line 599  let op_client_dprint_html c o file str =
599    
600      html_mods_td buf ([      html_mods_td buf ([
601          ("", "srb ar", Printf.sprintf "%d" (client_num c));          ("", "srb ar", Printf.sprintf "%d" (client_num c));
602          ((string_of_connection_state (client_state cc)), "sr",          ((string_of_connection_state (client_state cc)), "sr",
603            (short_string_of_connection_state (client_state cc)));            (short_string_of_connection_state (client_state cc)));
604          ((Sha1.to_string c.client_uid), "sr", cinfo.GuiTypes.client_name);          ((Sha1.to_string c.client_uid), "sr", cinfo.GuiTypes.client_name);
605          ("", "sr", "bT"); (* cinfo.GuiTypes.client_software *)          ("", "sr", "bT"); (* cinfo.GuiTypes.client_software *)
# Line 607  let op_client_dprint_html c o file str = Line 607  let op_client_dprint_html c o file str =
607          (if !show_emulemods_column then [("", "sr", "")] else [])          (if !show_emulemods_column then [("", "sr", "")] else [])
608        @ [        @ [
609          ("", "sr", "F");          ("", "sr", "F");
610          ("", "sr ar", Printf.sprintf "%d"          ("", "sr ar", Printf.sprintf "%d"
611              (((last_time ()) - cinfo.GuiTypes.client_connect_time) / 60));              (((last_time ()) - cinfo.GuiTypes.client_connect_time) / 60));
612          ("", "sr", "D");          ("", "sr", "D");
613          ("", "sr", (Ip.to_string (fst c.client_host)));          ("", "sr", (Ip.to_string (fst c.client_host)));
614          ("", "sr ar", (size_of_int64 c.client_uploaded));          ("", "sr ar", (size_of_int64 c.client_uploaded));
615          ("", "sr ar", (size_of_int64 c.client_downloaded));          ("", "sr ar", (size_of_int64 c.client_downloaded));
616          ("", "sr", info.GuiTypes.file_name); ]);          ("", "sr", info.GuiTypes.file_name); ]);
617      true          true
618          
619  let op_network_connected _ = true  let op_network_connected _ = true
620        
621        
622  let commands =  let commands =
623      
624      [      [
625      "compute_torrent", "Network/Bittorrent", Arg_one (fun filename o ->      "compute_torrent", "Network/Bittorrent", Arg_one (fun filename o ->
626          let announce = Printf.sprintf "http://%s:%d/"          let announce = Printf.sprintf "http://%s:%d/"
627              (Ip.to_string (CommonOptions.client_ip None))              (Ip.to_string (CommonOptions.client_ip None))
628            !!BTTracker.tracker_port in            !!BTTracker.tracker_port in
629            
630          let basename = Filename.basename filename in          let basename = Filename.basename filename in
631          let torrent = Filename.concat seeded_directory          let torrent = Filename.concat seeded_directory
632              (Printf.sprintf "%s.torrent" basename)              (Printf.sprintf "%s.torrent" basename)
633          in          in
634          BTTorrent.generate_torrent announce torrent filename;          BTTorrent.generate_torrent announce torrent filename;
635          try_share_file torrent;          try_share_file torrent;
636          ".torrent file generated"          ".torrent file generated"
637      ), _s " <filename> :\t\tgenerate the corresponding <filename>.torrent file in torrents/tracked/.\n\t\t\t\t\tThe file is automatically tracked, and seeded if in incoming/";      ), _s " <filename> :\t\tgenerate the corresponding <filename>.torrent file in torrents/tracked/.\n\t\t\t\t\tThe file is automatically tracked, and seeded if in incoming/";
638        
639      "torrents", "Network/Bittorrent", Arg_none (fun o ->      "torrents", "Network/Bittorrent", Arg_none (fun o ->
640            
641          if !!BTTracker.tracker_port <> 0 then          if !!BTTracker.tracker_port <> 0 then
642            begin                      begin
643              Printf.bprintf o.conn_buf (_b ".torrent files available:\n");              Printf.bprintf o.conn_buf (_b ".torrent files available:\n");
644              let files1 = Unix2.list_directory tracked_directory in              let files1 = Unix2.list_directory tracked_directory in
645              let files2 = Unix2.list_directory downloads_directory in              let files2 = Unix2.list_directory downloads_directory in
# Line 647  let commands = Line 647  let commands =
647              let files = files1 @ files2 @ files3 in              let files = files1 @ files2 @ files3 in
648              List.iter (fun file ->              List.iter (fun file ->
649                  Printf.bprintf o.conn_buf "http://%s:%d/%s\n"                  Printf.bprintf o.conn_buf "http://%s:%d/%s\n"
650                    (Ip.to_string (CommonOptions.client_ip None))                    (Ip.to_string (CommonOptions.client_ip None))
651                  !!BTTracker.tracker_port                  !!BTTracker.tracker_port
652                    file                    file
653              ) files;              ) files;
# Line 681  let commands = Line 681  let commands =
681    
682          ".torrent file printed"          ".torrent file printed"
683      ), " <filename.torrent> : print the content of filename"      ), " <filename.torrent> : print the content of filename"
684  *)      *)
685    
686    ]    ]
687    
# Line 715  let _ = Line 715  let _ =
715    (* We don't do anything here as the name to save as is defined by the    (* We don't do anything here as the name to save as is defined by the
716       torrent. We could change the name if we changed the torrent, too. *)       torrent. We could change the name if we changed the torrent, too. *)
717    file_ops.op_file_save_as <- (fun file name -> ());    file_ops.op_file_save_as <- (fun file name -> ());
718      
719    network.op_network_gui_message <- op_gui_message;    network.op_network_gui_message <- op_gui_message;
720    network.op_network_connected <- op_network_connected;    network.op_network_connected <- op_network_connected;
721    network.op_network_parse_url <- op_network_parse_url;    network.op_network_parse_url <- op_network_parse_url;
# Line 748  let _ = Line 748  let _ =
748       match file.file_shared with       match file.file_shared with
749          None -> assert false          None -> assert false
750        | Some impl ->        | Some impl ->
751            { (impl_shared_info impl) with            { (impl_shared_info impl) with
752              T.shared_network = network.network_num;              T.shared_network = network.network_num;
753              T.shared_filename = file_best_name (as_file file);              T.shared_filename = file_best_name (as_file file);
754              T.shared_uids = [Uid.create (Sha1 file.file_id)];              T.shared_uids = [Uid.create (Sha1 file.file_id)];

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