1 (* Copyright 2001, 2002 b52_simon :), b8_bavard, b8_fee_carabine, INRIA *)
3 This file is part of mldonkey.
5 mldonkey is free software; you can redistribute it and/or modify
6 it under the terms of the GNU General Public License as published by
7 the Free Software Foundation; either version 2 of the License, or
8 (at your option) any later version.
10 mldonkey is distributed in the hope that it will be useful,
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 GNU General Public License for more details.
15 You should have received a copy of the GNU General Public License
16 along with mldonkey; if not, write to the Free Software
17 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
34 open CommonComplexOptions
38 open CommonInteractive
50 let _s x
= _s "BTInteractive" x
51 let _b x
= _b "BTInteractive" x
53 module VB
= VerificationBitmap
55 let porttest_result = ref PorttestNotStarted
57 let interpret_azureus_porttest s
=
58 let failure_message fmt
=
59 Printf.sprintf
("Port test failure, " ^^ fmt
) in
61 let value = decode s
in
65 match List.assoc
(String
"result") alist
with
66 | Int
1L -> "Port test OK!"
69 match List.assoc
(String
"reason") alist
with
70 | String reason
-> failure_message "%s" reason
71 | _
-> raise Not_found
73 failure_message "%s" "no reason given")
75 failure_message "unknown status code (%Ld)" status
76 | _
-> raise Not_found
78 failure_message "%s" "no status given")
80 failure_message "unexpected value type %s" (Bencode.print
value)
82 failure_message "%s" "broken bencoded value"
84 let op_file_all_sources file
=
86 Hashtbl.iter
(fun _ c
->
87 list := (as_client c
) :: !list
91 let op_file_active_sources file
=
93 Hashtbl.iter
(fun _ c
->
94 let as_c = as_client c
in
95 match client_state
as_c with
96 Connected_downloading _
-> list := as_c :: !list
101 let op_file_files file impl
=
102 match file
.file_swarmer
with
103 None
-> [CommonFile.as_file impl
]
105 CommonSwarming.subfiles swarmer
107 let op_file_debug file
=
108 let buf = Buffer.create
100 in
109 (* CommonSwarming.debug_print buf file.file_swarmer; *)
110 Hashtbl.iter
(fun _ c
->
111 Printf.bprintf
buf "Client %d: %s\n" (client_num c
)
112 (match c
.client_sock
with
113 NoConnection
-> "No Connection"
114 | Connection _
-> "Connected"
115 | ConnectionWaiting _
-> "Waiting for Connection"
120 let op_file_commit file new_name
=
121 CommonSwarming.remove_swarmer file
.file_swarmer
;
122 file
.file_swarmer
<- None
;
123 if file_state file
<> FileShared
then
125 if not
(List.mem
(file
.file_name
, file_size file
) !!old_files
) then
126 old_files
=:= (file
.file_name
, file_size file
) :: !!old_files
;
127 set_file_state file FileShared
;
129 if Unix32.destroyed
(file_fd file
) then
130 if !verbose
then lprintf_file_nl
(as_file file
) "op_file_commit: FD is destroyed... repairing";
132 (* During the commit operation, for security, the file_fd is destroyed. So
133 we create it again to be able to share this file again. *)
136 (create_temp_file new_name
(List.map
(fun (file
,size
,_
) -> (file
,size
)) file
.file_files
) (file_state file
));
138 if Unix32.destroyed
(file_fd file
) then
139 lprintf_file_nl
(as_file file
) "op_file_commit: FD is destroyed... could not repair!";
141 let new_torrent_diskname =
142 Filename.concat seeded_directory
143 (Filename.basename file
.file_torrent_diskname
)
146 Unix2.rename file
.file_torrent_diskname
new_torrent_diskname;
148 (lprintf_file_nl
(as_file file
) "op_file_commit: failed to rename %s to %s"
149 file
.file_torrent_diskname
new_torrent_diskname));
150 file
.file_torrent_diskname
<- new_torrent_diskname;
152 (* update file_shared with new path to commited file *)
153 match file
.file_shared
with
158 impl_shared_update
= 1;
159 impl_shared_fullname
= file_disk_name file
;
160 impl_shared_codedname
= old_impl
.impl_shared_codedname
;
161 impl_shared_size
= file_size file
;
162 impl_shared_id
= Md4.null
;
164 impl_shared_uploaded
= old_impl
.impl_shared_uploaded
;
165 impl_shared_ops
= shared_ops
;
166 impl_shared_val
= file
;
167 impl_shared_requests
= old_impl
.impl_shared_requests
;
168 impl_shared_file
= Some
(as_file file
);
169 impl_shared_servers
= [];
171 file
.file_shared
<- Some
impl;
172 replace_shared old_impl
impl;
177 let re = Str.regexp_case_fold
"\\(https?://[a-zA-Z0-9_.!~*'();/?:@&=+$,%-]+\\)" in
178 fun s
-> Str.global_replace
re "\\<a href=\\\"\\1\\\"\\>\\1\\</a\\>" s
180 let op_file_print file o
=
182 let buf = o
.conn_buf
in
183 if use_html_mods o
then begin
184 Printf.bprintf
buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr
());
186 ("Filename", "sr br", "Filename");
187 ("", "sr", file
.file_name
) ];
189 Printf.bprintf
buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr
());
191 ("Torrent metadata hash", "sr", "Hash");
192 ("", "sr", Sha1.to_hexa file
.file_id
) ];
194 Printf.bprintf
buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr
());
196 ("Search for other possible Torrent Files", "sr br", "Torrent Srch");
197 ("", "sr", Printf.sprintf
"\\<a target=\\\"_blank\\\" href=\\\"http://isohunt.com/%s\\\"\\>IsoHunt\\</a\\>"
202 Printf.bprintf
buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr
());
203 let tracker_header_printed = ref false in
204 List.iter
(fun tracker
->
206 match tracker
.tracker_status
with
207 | Disabled s
| Disabled_mld s
->
208 Printf.sprintf
"\\<font color=\\\"red\\\"\\>disabled: %s\\<br\\>\\--error: %s\\</font\\>" tracker
.tracker_url s
209 | Disabled_failure
(i
,s
) ->
210 Printf.sprintf
"\\<font color=\\\"red\\\"\\>disabled: %s\\<br\\>\\--error: %s (try %d)\\</font\\>" tracker
.tracker_url s i
212 Printf.sprintf
"enabled: %s" tracker
.tracker_url
216 (if not
!tracker_header_printed then
217 ("Tracker(s)", "sr br", "Tracker(s)")
221 (tracker
.tracker_url
, "sr", tracker_text)];
222 Printf.bprintf
buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr
());
223 tracker_header_printed := true;
224 ) file
.file_trackers
;
227 ("Torrent Filename", "sr br", "Torrent Fname");
228 ("", "sr", file
.file_torrent_diskname
) ];
230 Printf.bprintf
buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr
());
233 ("Comment", "sr br", "Comment");
234 ("", "sr", match file
.file_comment
with
236 | s
-> auto_links s
) ];
238 Printf.bprintf
buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr
());
240 ("Created by", "sr br", "Created by");
241 ("", "sr", match file
.file_created_by
with
243 | s
-> auto_links s
) ];
245 Printf.bprintf
buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr
());
247 ("Creation date", "sr br", "Creation date");
248 ("", "sr", Date.to_string
(Int64.to_float file
.file_creation_date
) ) ];
250 Printf.bprintf
buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr
());
252 ("Modified by", "sr br", "Modified by");
253 ("", "sr", match file
.file_modified_by
with
255 | s
-> auto_links s
) ];
257 Printf.bprintf
buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr
());
259 ("Encoding", "sr br", "Encoding");
260 ("", "sr", match file
.file_encoding
with
262 | _
-> file
.file_encoding
) ];
264 Printf.bprintf
buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr
());
266 ("Piece size", "sr br", "Piece size");
267 ("", "sr", Int64.to_string file
.file_piece_size
) ];
269 let rec print_first_tracker l
=
273 if not
(tracker_is_enabled t
) then print_first_tracker q
275 Printf.bprintf
buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr
());
277 ("Last Tracker Announce", "sr br", "Last Announce");
278 ("", "sr", string_of_date t
.tracker_last_conn
) ];
280 if t
.tracker_last_conn
> 1 then
282 Printf.bprintf
buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr
());
284 ("Next Tracker Announce (planned)", "sr br", "Next Announce");
285 ("", "sr", string_of_date
(t
.tracker_last_conn
+ t
.tracker_interval
)) ];
288 Printf.bprintf
buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr
());
290 ("Tracker Announce Interval", "sr br", "Announce Interval");
291 ("", "sr", Printf.sprintf
"%d seconds" t
.tracker_interval
) ];
293 Printf.bprintf
buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr
());
295 ("Minimum Tracker Announce Interval", "sr br", "Min Announce Interval");
296 ("", "sr", Printf.sprintf
"%d seconds" t
.tracker_min_interval
) ];
298 (* show only interesting answers*)
299 if t
.tracker_torrent_downloaded
> 0 then begin
300 Printf.bprintf
buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr
());
302 ("Downloaded", "sr br", "Downloaded");
303 ("", "sr", Printf.sprintf
"%d" t
.tracker_torrent_downloaded
) ]
305 if t
.tracker_torrent_complete
> 0 then begin
306 Printf.bprintf
buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr
());
308 ("Complete (seeds)", "sr br", "Complete");
309 ("", "sr", Printf.sprintf
"%d" t
.tracker_torrent_complete
) ]
311 if t
.tracker_torrent_incomplete
> 0 then begin
312 Printf.bprintf
buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr
());
314 ("Incomplete (peers)", "sr br", "Incomplete");
315 ("", "sr", Printf.sprintf
"%d" t
.tracker_torrent_incomplete
) ]
317 if t
.tracker_torrent_total_clients_count
> 0 then begin
318 Printf.bprintf
buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr
());
320 ("Total client count", "sr br", "All clients");
321 ("", "sr", Printf.sprintf
"%d" t
.tracker_torrent_total_clients_count
) ]
323 if t
.tracker_torrent_last_dl_req
> 0 then begin
324 Printf.bprintf
buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr
());
326 ("Latest torrent request", "sr br", "Latest request");
327 ("", "sr", Printf.sprintf
"%ds" t
.tracker_torrent_last_dl_req
) ]
329 if String.length t
.tracker_id
> 0 then begin
330 Printf.bprintf
buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr
());
332 ("Tracker id", "sr br", "Tracker id");
333 ("", "sr", t
.tracker_id
) ]
335 if String.length t
.tracker_key
> 0 then begin
336 Printf.bprintf
buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr
());
338 ("Tracker key", "sr br", "Tracker key");
339 ("", "sr", t
.tracker_key
) ]
342 print_first_tracker file
.file_trackers
;
344 (* This is bad. Magic info should be automatically filled in when
345 the corresponding chunks complete. (see CommonSwarming)
347 This code only fills in the magic info for subfiles when a user
348 manually performs a "vd #". (interfaces out of sync)
350 Magic info for shared files with subfiles is missing as well?
352 if !Autoconf.magic_works
then begin
353 let check_magic file
=
354 match Magic.M.magic_fileinfo file
false with
356 | Some s
-> Some
(intern s
)
358 let fdn = file_disk_name file
in
359 let new_file_files = ref [] in
361 List.iter
(fun (f
, s
, m
) ->
362 let subfile = Filename.concat
fdn f
in
363 new_file_files := (f
,s
, check_magic subfile) :: !new_file_files;
366 file
.file_files
<- List.rev
!new_file_files;
367 file_must_update file
; (* Send update to guis *)
373 List.iter
(fun (filename
, size
, magic
) ->
374 Printf.bprintf
buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr
());
375 let fs = Printf.sprintf
"File %d" !cntr in
379 | Some m
-> Printf.sprintf
" / %s" m
;
383 ("", "sr", (Printf.sprintf
"%s (%Ld bytes)%s" filename size
magic_string))
387 end (* use_html_mods *)
390 Printf.bprintf
buf "Trackers:\n";
391 List.iter
(fun tracker
->
392 match tracker
.tracker_status
with
393 | Disabled s
| Disabled_mld s
->
394 Printf.bprintf
buf "%s, disabled: %s\n" tracker
.tracker_url s
395 | Disabled_failure
(i
,s
) ->
396 Printf.bprintf
buf "%s, disabled (try %d): %s\n" tracker
.tracker_url i s
397 | _
-> Printf.bprintf
buf "%s\n" tracker
.tracker_url
398 ) file
.file_trackers
;
399 if file
.file_torrent_diskname
<> "" then
400 Printf.bprintf
buf "Torrent diskname: %s\n" file
.file_torrent_diskname
;
401 if file
.file_comment
<> "" then Printf.bprintf
buf "Comment: %s\n" file
.file_comment
;
402 if file
.file_created_by
<> "" then Printf.bprintf
buf "Created by %s\n" file
.file_created_by
;
403 let s = Date.to_string
(Int64.to_float file
.file_creation_date
) in
404 if s <> "" then Printf.bprintf
buf "Creation date: %s\n" s;
405 if file
.file_modified_by
<> "" then Printf.bprintf
buf "Modified by %s\n" file
.file_modified_by
;
406 if file
.file_encoding
<> "" then Printf.bprintf
buf "Encoding: %s\n" file
.file_encoding
;
407 if file
.file_files
<> [] then Printf.bprintf
buf "Subfiles: %d\n" (List.length file
.file_files
);
409 List.iter
(fun (filename
, size
, magic
) ->
414 | Some m
-> Printf.sprintf
" / %s" m
;
416 Printf.bprintf
buf "File %d: %s (%Ld bytes)%s\n" !cntr filename size
magic_string
420 let op_file_print_sources file o
=
421 let buf = o
.conn_buf
in
423 (* redefine functions for telnet output *)
424 let html_mods_td buf l
=
425 if use_html_mods o
then
429 List.iter
(fun (t
,c
,d
) ->
430 (* Title Class Value *)
431 Printf.bprintf
buf "%s "
435 let html_mods_table_header buf n c l
=
436 if use_html_mods o
then
437 html_mods_table_header buf n c l
439 if List.length l
> 0 then begin
440 Printf.bprintf
buf "\n";
441 List.iter
(fun (w
,x
,y
,z
) ->
442 (* Sort Class Title Value *)
443 Printf.bprintf
buf "%s "
446 Printf.bprintf
buf "\n"
450 if Hashtbl.length file
.file_clients
> 0 then begin
453 ( "1", "srh br ac", "Client number", "Num" ) ;
454 ( "0", "srh br", "Client UID", "UID" ) ;
455 ( "0", "srh br", "Client software", "Soft" ) ;
456 ( "0", "srh", "IP address", "IP address" ) ;
457 ( "0", "srh br ar", "Port", "Port" ) ;
458 ] @ (if Geoip.active
() then [( "0", "srh br ar", "Country Code/Name", "CC" )] else []) @ [
459 ( "1", "srh ar", "Total UL bytes to this client for all files", "tUL" ) ;
460 ( "1", "srh ar br", "Total DL bytes from this client for all files", "tDL" ) ;
461 ( "1", "srh ar", "Session UL bytes to this client for all files", "sUL" ) ;
462 ( "1", "srh ar br", "Session DL bytes from this client for all files", "sDL" ) ;
463 ( "0", "srh ar", "Interested [T]rue, [F]alse", "I" ) ;
464 ( "0", "srh ar", "Choked [T]rue, [F]alse", "C" ) ;
465 ( "1", "srh br ar", "Allowed to write", "A" ) ;
466 ( "0", "srh ar", "Interesting [T]rue, [F]alse", "I" );
467 ( "0", "srh ar", "Already sent interested [T]rue, [F]alse", "A" );
468 ( "0", "srh br ar", "Already sent not interested [T]rue, [F]alse", "N" );
470 ( "0", "srh ar", "Good [T]rue, [F]alse", "G" );
471 ( "0", "srh ar", "Incoming [T]rue, [F]alse", "I" );
472 ( "0", "srh br ar", "Registered bitfield [T]rue, [F]alse", "B" );
474 ( "0", "srh ar", "Connect Time", "T" );
475 ( "0", "srh ar", "Last optimist", "L.Opt" );
476 ( "0", "srh br ar", "Num try", "N" );
478 ( "0", "srh", "DHT [T]rue, [F]alse", "D" );
479 ( "0", "srh", "Cache extensions [T]rue, [F]alse", "C" );
480 ( "0", "srh", "Fast extensions [T]rue, [F]alse", "F" );
481 ( "0", "srh", "uTorrent extensions [T]rue, [F]alse", "U" );
482 ( "0", "srh br", "Azureus messaging protocol [T]rue, [F]alse", "A" );
484 ( "0", "srh", "Bitmap (absent|partial|present|verified)", (colored_chunks
485 (Array.init (String.length info.G.file_chunks)
486 (fun i -> ((int_of_char info.G.file_chunks.[i])-48)))) ) ;
488 ( "1", "srh ar", "Number of full chunks", (Printf.sprintf
"%d"
489 (match file
.file_swarmer
with
493 CommonSwarming.chunks_verified_bitmap swarmer
in
494 VB.fold_lefti
(fun acc _
s ->
495 if s = VB.State_verified
then acc
+ 1 else acc
) 0 bitmap)))
498 html_mods_table_header buf "sourcesTable" "sources al" header_list;
500 Hashtbl.iter
(fun _ c
->
501 let cinfo = client_info
(as_client c
) in
502 if use_html_mods o
then
503 Printf.bprintf
buf "\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr
());
505 let btos b
= if b
then "T" else "F" in
506 let cc,cn
= Geoip.get_country_code_name
cinfo.GuiTypes.client_country_code
in
508 ("", "sr br ar", Printf.sprintf
"%d" (client_num c
));
509 ("", "sr br", (Sha1.to_string c
.client_uid
));
510 ("", "sr br", Printf.sprintf
"%s %s" (brand_to_string c
.client_brand
) c
.client_release
);
511 ("", "sr", (Ip.to_string
(fst c
.client_host
)));
512 ("", "sr br ar", Printf.sprintf
"%d" (snd c
.client_host
));
513 ] @ (if Geoip.active
() then
514 [( cn
, "sr br", if use_html_mods o
then CommonPictures.flag_html
cc else cc)]
516 ("", "sr ar", (size_of_int64 c
.client_total_uploaded
));
517 ("", "sr ar br", (size_of_int64 c
.client_total_downloaded
));
518 ("", "sr ar", (size_of_int64 c
.client_session_uploaded
));
519 ("", "sr ar br", (size_of_int64 c
.client_session_downloaded
));
520 ("", "sr", (btos c
.client_interested
));
521 ("", "sr", (btos c
.client_choked
));
522 ("", "sr br ar", (Int64.to_string c
.client_allowed_to_write
));
523 (* This is way too slow for 1000's of chunks on a page with 100's of sources
524 ("", "sr", (CommonFile.colored_chunks (Array.init (String.length c.client_bitmap)
525 (fun i -> (if c.client_bitmap.[i] = '1' then 2 else 0)) )) );
527 ("", "sr", (btos c
.client_interesting
));
528 ("", "sr", (btos c
.client_alrd_sent_interested
));
529 ("", "br sr", (btos c
.client_alrd_sent_notinterested
));
531 ("", "sr", (btos c
.client_good
));
532 ("", "sr", (btos c
.client_incoming
));
533 ("", "br sr", (btos c
.client_registered_bitfield
));
535 ("", "sr", Printf.sprintf
"%d" c
.client_connect_time
);
536 ("", "ar sr", string_of_date c
.client_last_optimist
);
537 ("", "br sr", Printf.sprintf
"%d" c
.client_num_try
);
539 ("", "sr", (btos c
.client_dht
));
540 ("", "sr", (btos c
.client_cache_extension
));
541 ("", "sr", (btos c
.client_fast_extension
));
542 ("", "sr", (btos c
.client_utorrent_extension
));
543 ("", "br sr", (btos c
.client_azureus_messaging_protocol
));
545 ("", "sr ar", (let fc = ref 0 in
546 (match c
.client_bitmap
with
549 Bitv.iter
(fun s -> if s then incr
fc) bitmap);
550 (Printf.sprintf
"%d" !fc) ) )
553 html_mods_td buf td_list;
554 if use_html_mods o
then Printf.bprintf
buf "\\</tr\\>"
555 else Printf.bprintf
buf "\n";
559 if use_html_mods o
then Printf.bprintf
buf "\\</table\\>\\</div\\>\\<br\\>"
560 else Printf.bprintf
buf "\n";
564 let op_file_check file
=
565 lprintf_file_nl
(as_file file
) "Checking chunks of %s" file
.file_name
;
566 match file
.file_swarmer
with
568 lprintf_file_nl
(as_file file
) "verify_chunks: no swarmer to verify chunks"
570 CommonSwarming.verify_all_chunks_immediately swarmer
572 let remove_all_clients file
=
573 Hashtbl.clear file
.file_clients
;
574 file
.file_clients_num
<- 0
576 let op_file_cancel file
=
577 CommonSwarming.remove_swarmer file
.file_swarmer
;
578 file
.file_swarmer
<- None
;
579 BTClients.file_stop file
;
581 BTClients.disconnect_clients file
;
582 remove_all_clients file
;
583 if Sys.file_exists file
.file_torrent_diskname
then Sys.remove file
.file_torrent_diskname
585 let op_ft_cancel ft
=
586 Hashtbl.remove ft_by_num ft
.ft_id
588 let op_ft_commit ft newname
=
589 Hashtbl.remove ft_by_num ft
.ft_id
591 let op_file_info file
=
593 let module P
= GuiTypes
in
595 let last_seen = match file
.file_swarmer
with
596 None
-> [| last_time
() |]
597 | Some swarmer
-> CommonSwarming.compute_last_seen swarmer
in
599 { (impl_file_info file
.file_file
) with
601 P.file_name
= file
.file_name
;
602 P.file_network
= network
.network_num
;
603 P.file_chunks
= (match file
.file_swarmer
with
605 | Some swarmer
-> Some
(CommonSwarming.chunks_verified_bitmap swarmer
));
606 P.file_chunk_size
= (match file
.file_swarmer
with
608 | Some t
-> Some
(List.map
(fun t
-> t
.CommonSwarming.t_chunk_size
) t
.CommonSwarming.t_s
.CommonSwarming.s_networks
));
609 P.file_availability
=
610 [network
.network_num
,(match file
.file_swarmer
with
611 None
-> "" | Some swarmer
->
612 CommonSwarming.chunks_availability swarmer
)];
614 P.file_chunks_age
= last_seen;
615 P.file_uids
= [Uid.create
(BTUrl file
.file_id
)];
616 P.file_sub_files
= file
.file_files
;
617 P.file_active_sources
= List.length
(op_file_active_sources file
);
618 P.file_all_sources
= (Hashtbl.length file
.file_clients
);
619 P.file_comment
= file
.file_comment
;
624 let module P
= GuiTypes
in
627 P.file_fields
= P.Fields_file_info.all
;
629 P.file_comment
= file_comment
(as_ft ft
);
630 P.file_name
= ft
.ft_filename
;
631 P.file_num
= ft_num ft
;
632 P.file_network
= network
.network_num
;
633 P.file_names
= [ft
.ft_filename
];
634 P.file_md4
= Md4.null
;
635 P.file_size
= ft_size ft
;
636 P.file_downloaded
= zero
;
637 P.file_all_sources
= 0;
638 P.file_active_sources
= 0;
639 P.file_state
= ft_state ft
;
640 P.file_sources
= None
;
641 P.file_download_rate
= 0.;
642 P.file_chunks
= None
;
643 P.file_chunk_size
= None
;
644 P.file_availability
= [network
.network_num
, ""];
645 P.file_format
= FormatNotComputed
0;
646 P.file_chunks_age
= [| last_time
() |];
648 P.file_last_seen
= BasicSocket.last_time
();
651 P.file_sub_files
= [];
653 P.file_comments
= [];
656 P.file_release
= file_release
(as_ft ft
);
661 let load_torrent_string s user group
=
662 if !verbose
then lprintf_nl
"load_torrent_string";
663 let file_id, torrent
= BTTorrent.decode_torrent
s in
665 (* Save the torrent, because we later want to put
666 it in the seeded directory. *)
667 let torrent_is_usable = ref false in
668 let can_handle_tracker url
=
669 String2.check_prefix url
"http://" in
670 List.iter
(fun url
-> if can_handle_tracker url
then torrent_is_usable := true)
671 (if torrent
.torrent_announce_list
<> [] then torrent
.torrent_announce_list
else [torrent
.torrent_announce
]);
672 if not
!torrent_is_usable then raise
(Torrent_can_not_be_used torrent
.torrent_name
);
674 let torrent_diskname =
675 let fs = Unix32.filesystem downloads_directory
in
677 match Unix32.fnamelen downloads_directory
with
681 Filename.concat downloads_directory
682 (Filename2.filesystem_compliant torrent
.torrent_name
fs namemax) ^
".torrent"
684 if Sys.file_exists
torrent_diskname then
686 if !verbose
then lprintf_nl
"load_torrent_string: %s already exists, ignoring" torrent_diskname;
687 raise
(Torrent_already_exists torrent
.torrent_name
)
689 File.from_string
torrent_diskname s;
692 lprintf_nl
"Starting torrent download with diskname: %s"
694 let file = new_download
file_id torrent
torrent_diskname user group
in
695 BTClients.talk_to_tracker
file true;
696 CommonInteractive.start_download
(file_find
(file_num
file));
699 let load_torrent_file filename user group
=
701 lprintf_nl
"load_torrent_file %s" filename
;
702 let s = File.to_string filename
in
703 (* Delete the torrent if it is in the downloads dir. because it gets saved
704 again under the torrent name and we don't want to clutter up this dir. .*)
705 if Sys.file_exists filename
706 && (Filename.dirname filename
) = downloads_directory
then
708 ignore
(load_torrent_string s user group
)
711 let parse_tracker_reply file t filename =
712 (*This is the function which will be called by the http client
713 for parsing the response*)
714 (* Interested only in interval*)
715 if !verbose_msg_servers
then lprintf_file_nl
(as_file
file) "Filename %s" filename
;
718 File.to_string filename
719 with e
-> lprintf_file_nl
(as_file
file) "Empty reply from tracker"; ""
722 match tracker_reply with
724 if !verbose_connect
then
725 lprintf_file_nl
(as_file
file) "Empty reply from tracker";
727 | _
-> Bencode.decode
tracker_reply
729 if !verbose_msg_servers
then lprintf_file_nl
(as_file
file) "Received: %s" (Bencode.print
v);
730 t
.tracker_interval
<- 600;
733 List.iter
(fun (key
,value) ->
734 match (key
, value) with
735 String
"interval", Int n
->
736 t
.tracker_interval
<- Int64.to_int n
;
737 if !verbose_msg_servers
then lprintf_file_nl
(as_file
file) ".. interval %d .." t
.tracker_interval
738 | String
"failure reason", String failure
->
739 lprintf_file_nl
(as_file
file) "Failure from Tracker in file: %s Reason: %s" file.file_name failure
740 (*TODO: merge with f from get_sources_from_tracker and parse the rest of the answer, too.
741 also connect to the sources we receive or instruct tracker to send none, perhaps based
742 on an config option. firewalled people could activate the option and then seed torrents, too.*)
748 let try_share_file torrent_diskname =
749 if !verbose_share
then lprintf_nl
"try_share_file: %s" torrent_diskname;
750 let s = File.to_string
torrent_diskname in
751 let file_id, torrent
= BTTorrent.decode_torrent
s in
757 [] -> raise Not_found
759 let s = sharing_strategy sh
.shdir_strategy
in
760 if match torrent
.torrent_files
with
761 [] -> not
s.sharing_directories
762 | _
-> s.sharing_directories
then
764 Filename.concat sh
.shdir_dirname torrent
.torrent_name
766 if !verbose_share
then lprintf_nl
"Checking for %s" filename;
767 if Sys.file_exists
filename then filename else
772 iter (shared_directories_including_user_commit
())
775 let user = CommonUserDb.admin_user
() in
776 let file = new_file
file_id torrent
torrent_diskname
777 filename FileShared
user user.user_default_group
in
779 if !verbose_share
then
780 lprintf_file_nl
(as_file
file) "Sharing file %s" filename;
781 BTClients.talk_to_tracker
file false
784 (* if the torrent is still there while the file is gone, remove the torrent *)
785 if !verbose_share
then lprintf_nl
"Removing torrent for %s" s;
786 let new_torrent_diskname =
787 Filename.concat old_directory
788 (Filename.basename
torrent_diskname)
791 Unix2.rename
torrent_diskname new_torrent_diskname;
793 (lprintf_nl
"Failed to rename %s to %s"
794 torrent_diskname new_torrent_diskname));
796 lprintf_nl
"Cannot share torrent %s for %s"
797 torrent_diskname (Printexc2.to_string e
)
799 (* Call one minute after start, and then every 20 minutes. Should
800 automatically contact the tracker. *)
802 if !verbose_share
then lprintf_nl
"share_files";
803 List.iter (fun file ->
804 try_share_file (Filename.concat seeded_directory
file)
805 ) (Unix2.list_directory seeded_directory
);
806 let shared_files_copy = !current_files
in
807 (* if the torrent is gone while the file is still shared, remove the share *)
808 List.iter (fun file ->
809 (* if !verbose_share then lprintf_nl "Checking torrent share for %s" file.file_torrent_diskname; *)
810 if not
(Sys.file_exists
file.file_torrent_diskname
) &&
811 file_state
file = FileShared
then
813 if !verbose_share
then lprintf_nl
"Removing torrent share for %s" file.file_torrent_diskname
;
814 BTClients.file_stop
file;
816 BTClients.disconnect_clients
file;
817 remove_all_clients file;
821 let scan_new_torrents_directory () =
822 let filenames = Unix2.list_directory new_torrents_directory
in
823 List.iter (fun file ->
824 let file = Filename.concat new_torrents_directory
file in
825 let file_basename = Filename.basename
file in
826 if not
(Unix2.is_directory
file) then
828 let file_owner = fst
(Unix32.owner
file) in
831 CommonUserDb.user2_user_find
file_owner
832 with Not_found
-> CommonUserDb.admin_user
()
834 load_torrent_file file user user.user_default_group
;
835 (try Sys.remove
file with _
-> ())
837 Torrent_can_not_be_used _
->
838 Unix2.rename
file (Filename.concat old_directory
file_basename);
839 lprintf_nl
"Torrent %s does not have valid tracker URLs, moved to torrents/old ..." file_basename
841 Unix2.rename
file (Filename.concat old_directory
file_basename);
842 lprintf_nl
"Error %s in scan_new_torrents_directory for %s, moved to torrents/old ..."
843 (Printexc2.to_string e
) file_basename
846 let retry_all_ft () =
847 Hashtbl.iter (fun _ ft
->
848 try ft
.ft_retry ft
with e
->
849 lprintf_nl
"ft_retry: exception %s" (Printexc2.to_string e
)
852 let load_torrent_from_web r
user group ft
=
853 let module H
= Http_client
in
854 H.wget r
(fun filename ->
855 if ft_state ft
= FileDownloading
then begin
856 load_torrent_file filename user group
;
857 file_cancel
(as_ft ft
) (CommonUserDb.admin_user
())
860 let valid_torrent_extension url
=
861 let ext = String.lowercase
(Filename2.last_extension url
) in
862 ext = ".torrent" || ext = ".tor"
864 let get_regexp_string text r
=
865 ignore
(Str.search_forward r text
0);
866 let a = Str.group_beginning
1 in
867 let b = Str.group_end
1 in
868 String.sub text
a (b - a)
870 let op_network_parse_url url
user group
=
871 let location_regexp = "Location: \\(.*\\)" in
873 let real_url = get_regexp_string url
(Str.regexp
location_regexp) in
874 if (valid_torrent_extension real_url)
875 || (String2.contains url
"Content-Type: application/x-bittorrent")
877 let u = Url.of_string
real_url in
878 let module H
= Http_client
in
882 H.req_proxy
= !CommonOptions.http_proxy
;
883 H.req_user_agent
= get_user_agent
();
885 let (rule_search
,rule_value
) =
886 try (List.find
(fun (rule_search
,rule_value
) ->
887 Str.string_match
(Str.regexp rule_search
) real_url 0
889 with Not_found
-> ("",real_url) in
890 Some
(Url.of_string rule_value
) );
892 let cookies = List.assoc
u.Url.server
!!cookies in
893 [ ( "Cookie", List.fold_left
(fun res
(key
, value) ->
897 res ^
"; " ^ key ^
"=" ^
value
900 with Not_found
-> []);
901 H.req_max_retry
= 10;
904 let file_diskname = Filename.basename
u.Url.short_file
in
905 let ft = new_ft
file_diskname user in
906 ft.ft_retry
<- (load_torrent_from_web r user group
);
907 load_torrent_from_web r user group
ft;
908 "started download", true
914 if (valid_torrent_extension url
) then
916 if !verbose
then lprintf_nl
"Not_found and trying to load %s" url
;
918 load_torrent_file url
user group
;
921 Torrent_already_exists _
-> "A torrent with this name is already in the download queue", false
922 | Torrent_can_not_be_used _
-> "This torrent does not have valid tracker URLs", false
924 lprintf_nl
"Exception %s while 2nd loading" (Printexc2.to_string e
);
925 let s = Printf.sprintf
"Can not load load torrent file: %s"
926 (Printexc2.to_string e
) in
930 if !verbose
then lprintf_nl
"Not_found and url has non valid torrent extension: %s" url
;
931 "Not_found and url has non valid torrent extension", false
934 lprintf_nl
"Exception %s while loading" (Printexc2.to_string e
);
935 let s = Printf.sprintf
"Can not load load torrent file: %s"
936 (Printexc2.to_string e
) in
939 let op_client_info c
=
940 check_client_country_code c
;
941 let module P
= GuiTypes
in
942 let (ip
,port
) = c
.client_host
in
943 { (impl_client_info c
.client_client
) with
945 P.client_network
= network
.network_num
;
946 P.client_kind
= Known_location
(ip
,port
);
947 P.client_country_code
= c
.client_country_code
;
948 P.client_state
= client_state
(as_client c
);
949 P.client_type
= client_type c
;
950 P.client_name
= (Printf.sprintf
"%s:%d" (Ip.to_string ip
) port
);
951 P.client_software
= (brand_to_string c
.client_brand
);
952 P.client_release
= c
.client_release
;
953 P.client_total_downloaded
= c
.client_total_downloaded
;
954 P.client_total_uploaded
= c
.client_total_uploaded
;
955 P.client_session_downloaded
= c
.client_session_downloaded
;
956 P.client_session_uploaded
= c
.client_session_uploaded
;
957 P.client_upload
= Some
(c
.client_file
.file_name
);
958 P.client_connect_time
= c
.client_connect_time
;
962 let op_client_connect c
=
963 BTClients.connect_client c
965 let op_client_disconnect c
=
966 BTClients.disconnect_client c Closed_by_user
968 let op_client_bprint c
buf =
969 let cc = as_client c
in
970 let cinfo = client_info
cc in
971 Printf.bprintf
buf "%s (%s)\n"
972 cinfo.GuiTypes.client_name
973 (Sha1.to_string c
.client_uid
)
975 let op_client_dprint c o
file =
976 let info = file_info
file in
977 let buf = o
.conn_buf
in
978 let cc = as_client c
in
980 Printf.bprintf
buf (_b "\n%18sDown : %-10s Uploaded: %-10s Ratio: %s%1.1f (%s)\n") ""
981 (Int64.to_string c
.client_total_downloaded
)
982 (Int64.to_string c
.client_total_uploaded
)
983 (if c
.client_total_downloaded
> c
.client_total_uploaded
then "-" else "+")
984 (if c
.client_total_uploaded
> Int64.zero
then
985 Int64.to_float
(c
.client_total_downloaded
// c
.client_total_uploaded
)
988 (Printf.bprintf
buf (_b "%18sFile : %s\n") "" info.GuiTypes.file_name
)
990 let op_client_dprint_html c o
file str
=
991 let info = file_info
file in
992 let buf = o
.conn_buf
in
993 let ac = as_client c
in
994 let cinfo = client_info
ac in
995 Printf.bprintf
buf " \\<tr onMouseOver=\\\"mOvr(this);\\\"
996 onMouseOut=\\\"mOut(this);\\\" class=\\\"%s\\\"\\>" str
;
998 let show_emulemods_column = ref false in
999 if Autoconf.donkey
= "yes" then begin
1000 if !!emule_mods_count
then
1001 show_emulemods_column := true
1004 let cc,cn
= Geoip.get_country_code_name
cinfo.GuiTypes.client_country_code
in
1007 ("", "srb ar", Printf.sprintf
"%d" (client_num c
));
1008 ((string_of_connection_state
(client_state
ac)), "sr",
1009 (short_string_of_connection_state
(client_state
ac)));
1010 ((Sha1.to_string c
.client_uid
), "sr", cinfo.GuiTypes.client_name
);
1011 ("", "sr", (brand_to_string c
.client_brand
)); (* cinfo.GuiTypes.client_software *)
1012 ("", "sr", c
.client_release
);
1014 (if !show_emulemods_column then [("", "sr", "")] else [])
1017 ("", "sr ar", Printf.sprintf
"%d"
1018 (((last_time
()) - cinfo.GuiTypes.client_connect_time
) / 60));
1021 ("", "sr", (Ip.to_string
(fst c
.client_host
)));
1022 ] @ (if Geoip.active
() then [(cn
, "sr", CommonPictures.flag_html
cc)] else []) @ [
1023 ("", "sr ar", (size_of_int64 c
.client_total_uploaded
));
1024 ("", "sr ar", (size_of_int64 c
.client_total_downloaded
));
1025 ("", "sr ar", (size_of_int64 c
.client_session_uploaded
));
1026 ("", "sr ar", (size_of_int64 c
.client_session_downloaded
));
1027 ("", "sr", info.GuiTypes.file_name
); ]);
1030 let op_network_connected _
= true
1033 let get_default_tracker () =
1034 if !!BTTracker.default_tracker
= "" then
1035 Printf.sprintf
"http://%s:%d/announce"
1036 (Ip.to_string
(CommonOptions.client_ip None
))
1037 !!BTTracker.tracker_port
1039 !!BTTracker.default_tracker
1041 let compute_torrent filename announce comment
=
1042 let announce = if announce = "" then get_default_tracker () else announce in
1043 if !verbose
then lprintf_nl
"compute_torrent: [%s] [%s] [%s]"
1044 filename announce comment
;
1045 let basename = Filename.basename filename in
1046 let torrent = Filename.concat seeded_directory
1047 (Printf.sprintf
"%s.torrent" basename) in
1048 let is_private = 0 in
1049 let file_id = BTTorrent.generate_torrent
announce torrent comment
(Int64.of_int
is_private) filename in
1050 try_share_file torrent;
1051 ignore
(BTTracker.new_tracker
file_id)
1056 "compute_torrent", "Network/Bittorrent", Arg_multiple
(fun args o
->
1057 let buf = o
.conn_buf
in
1059 let filename = ref "" in
1060 let comment = ref "" in
1062 fname
:: [comm
] -> filename := fname
; comment := comm
1063 | [fname
] -> filename := fname
1064 | _
-> raise Not_found
);
1066 compute_torrent !filename "" !comment;
1068 if o
.conn_output
= HTML
then
1069 (* TODO: really htmlize it *)
1070 Printf.bprintf
buf ".torrent file generated"
1072 Printf.bprintf
buf ".torrent file generated\n";
1076 if o
.conn_output
= HTML
then
1077 (* TODO: really htmlize it *)
1078 Printf.bprintf
buf "Not enough parameters"
1080 Printf.bprintf
buf "Not enough parameters\n";
1083 if o
.conn_output
= HTML
then
1084 (* TODO: really htmlize it *)
1085 Printf.bprintf
buf "Error: %s" (Printexc2.to_string exn
)
1087 Printf.bprintf
buf "Error: %s\n" (Printexc2.to_string exn
);
1089 ), _s "<filename> <comment> :\tgenerate the corresponding <filename> .torrent file with <comment> in torrents/tracked/.\n\t\t\t\t\tThe file is automatically tracked, and seeded if in incoming/";
1091 "torrents", "Network/Bittorrent", Arg_none
(fun o
->
1092 let buf = o
.conn_buf
in
1093 if !!BTTracker.tracker_port
<> 0 then begin
1094 Printf.bprintf o
.conn_buf
(_b ".torrent files available:\n");
1095 let files_tracked = Unix2.list_directory tracked_directory
in
1096 let files_downloading = Unix2.list_directory downloads_directory
in
1097 let files_seeded = Unix2.list_directory seeded_directory
in
1098 let all_torrents_files = files_tracked @ files_downloading @ files_seeded in
1100 if o
.conn_output
= HTML
then
1101 (* TODO: really htmlize it *)
1102 List.iter (fun file ->
1103 Printf.bprintf
buf "http://%s:%d/%s "
1104 (Ip.to_string
(CommonOptions.client_ip None
))
1105 !!BTTracker.tracker_port
1107 ) all_torrents_files
1109 List.iter (fun file ->
1110 Printf.bprintf
buf "http://%s:%d/%s\n"
1111 (Ip.to_string
(CommonOptions.client_ip None
))
1112 !!BTTracker.tracker_port
1114 ) all_torrents_files;
1117 if o
.conn_output
= HTML
then
1118 (* TODO: really htmlize it *)
1119 Printf.bprintf
buf "Tracker not activated (tracker_port = 0)"
1121 Printf.bprintf
buf "Tracker not activated (tracker_port = 0)\n";
1123 ), _s ":\t\t\t\tprint all .torrent files on this server";
1125 "print_torrent", "Network/Bittorrent", Arg_one
(fun arg o
->
1126 if CommonUserDb.user2_is_admin o
.conn_user
.ui_user
then begin
1129 Some
(as_file_impl
(file_find
(int_of_string arg
)))
1133 | None
-> Printf.sprintf
"file %s not found" arg
1136 if use_html_mods o
then begin
1137 html_mods_cntr_init
();
1138 html_mods_table_header o
.conn_buf
"sourcesInfo" "sourcesInfo" [
1139 ( "0", "srh br", "File Info", "Info" ) ;
1140 ( "0", "srh", "Value", "Value" ) ]
1142 op_file_print file.impl_file_val o
;
1143 if use_html_mods o
then begin
1144 Printf.bprintf o
.conn_buf
"\\</tr\\>\\</table\\>\\</div\\>";
1145 Printf.bprintf o
.conn_buf
"\\</td\\>\\</tr\\>\\</table\\>\\</div\\>\\<br\\>"
1150 begin print_command_result o
"You are not allowed to use print_torrent";
1152 ), _s "<num> :\t\t\tshow internal data of .torrent file";
1154 "seeded_torrents", "Network/Bittorrent", Arg_none
(fun o
->
1155 if CommonUserDb.user2_is_admin o
.conn_user
.ui_user
then begin
1156 List.iter (fun file ->
1157 if file_state
file = FileShared
then
1158 Printf.bprintf o
.conn_buf
"%s [U %Ld u/d %Ld/%Ld]\n"
1159 file.file_name
file.file_uploaded
file.file_session_uploaded
file.file_session_downloaded
1163 begin print_command_result o
"You are not allowed to use seeded_torrents";
1165 ), _s ":\t\t\tprint all seeded .torrent files on this server (output: name, total upload, session upload, session download)";
1167 "reshare_torrents", "Network/Bittorrent", Arg_none
(fun o
->
1170 ), _s ":\t\t\trecheck torrents/* directories for changes";
1172 "rm_old_torrents", "Network/Bittorrent", Arg_none
(fun o
->
1173 let files_outdated = Unix2.list_directory old_directory
in
1174 let buf = o
.conn_buf
in
1175 if o
.conn_output
= HTML
then begin
1176 (* TODO: really htmlize it *)
1177 Printf.bprintf
buf "Removing old torrents...";
1178 List.iter (fun file ->
1179 Printf.bprintf
buf "%s "
1184 Printf.bprintf
buf "Removing old torrents...\n";
1185 List.iter (fun file ->
1186 Printf.bprintf
buf "%s\n"
1190 List.iter (fun file ->
1191 Sys.remove
(Filename.concat old_directory
file)
1194 ), _s ":\t\t\tremove all old .torrent files";
1196 "startbt", "Network/Bittorrent", Arg_one
(fun url o
->
1197 let buf = o
.conn_buf
in
1198 if Sys.file_exists url
then
1200 load_torrent_file url o
.conn_user
.ui_user o
.conn_user
.ui_user
.user_default_group
;
1201 Printf.bprintf
buf "loaded file %s\n" url
1205 let url = "Location: " ^
url ^
"\nContent-Type: application/x-bittorrent" in
1206 let result = fst
(op_network_parse_url url o
.conn_user
.ui_user o
.conn_user
.ui_user
.user_default_group
) in
1207 Printf.bprintf
buf "%s\n" result
1210 ), "<url|file> :\t\t\tstart BT download";
1212 "stop_all_bt", "Network/Bittorrent", Arg_none
(fun o
->
1213 List.iter (fun file -> BTClients.file_stop
file ) !current_files
;
1214 let buf = o
.conn_buf
in
1215 if o
.conn_output
= HTML
then
1216 (* TODO: really htmlize it *)
1217 Printf.bprintf
buf "started sending stops..."
1219 Printf.bprintf
buf "started sending stops...\n";
1221 ), _s ":\t\t\t\tstops all bittorrent downloads, use this if you want to make sure that the stop signal actually\n\t\t\t\t\tgets to the tracker when shutting mlnet down, but you have to wait till the stops get to the\n\t\t\t\t\ttracker and not wait too long, so mldonkey reconnects to the tracker :)";
1223 "tracker", "Network/Bittorrent", Arg_multiple
(fun args o
->
1226 let urls = ref [] in
1228 | nums
:: [] -> raise Not_found
1229 | nums
:: rest
-> num := nums
; urls := rest
1230 | _
-> raise Not_found
);
1232 let num = int_of_string
!num in
1233 Hashtbl.iter (fun _
file ->
1234 if file_num
file = num then begin
1236 lprintf_file_nl
(as_file
file) "adding trackers for file %i" num;
1237 set_trackers
file !urls;
1241 let buf = o
.conn_buf
in
1242 if o
.conn_output
= HTML
then
1243 html_mods_table_one_row
buf "serversTable" "servers" [
1244 ("", "srh", "file not found"); ]
1246 Printf.bprintf
buf "file not found";
1250 let buf = o
.conn_buf
in
1251 if o
.conn_output
= HTML
then
1252 html_mods_table_one_row
buf "serversTable" "servers" [
1253 ("", "srh", "tracker added"); ]
1255 Printf.bprintf
buf "tracker added";
1259 lprintf_nl
"Not enough or wrong parameters.";
1260 let buf = o
.conn_buf
in
1261 if o
.conn_output
= HTML
then
1262 html_mods_table_one_row
buf "serversTable" "servers" [
1263 ("", "srh", "Not enough or wrong parameters."); ]
1265 Printf.bprintf
buf "Not enough or wrong parameters.";
1267 ), "<num> <url> <url>... :\t\tadd URLs as trackers for num";
1269 (* TODO : add some code from make_torrent
1270 "print_torrent", Arg_one (fun filename o ->
1272 ".torrent file printed"
1273 ), "<filename.torrent> :\t\tprint the content of filename"
1281 let op_gui_message s user =
1282 match get_int16
s 0 with
1284 let text = String.sub
s 2 (String.length
s - 2) in
1285 if !verbose
then lprintf_nl
"received torrent from gui...";
1287 let file = load_torrent_string text user user.user_default_group
in
1288 raise
(Torrent_started
file.file_name
)
1289 with e
-> (match e
with
1290 | Torrent_can_not_be_used
s -> lprintf_nl
"Loading torrent from GUI: torrent %s can not be used" s
1291 | Torrent_already_exists
s -> lprintf_nl
"Loading torrent from GUI: torrent %s is already in download queue" s
1295 let n = get_int
s 2 in
1296 let a, pos
= get_string
s 6 in
1297 let c, pos
= get_string
s pos
in
1298 let sf = CommonShared.shared_find
n in
1299 let f = shared_fullname
sf in
1300 compute_torrent f a c;
1301 | opcode
-> failwith
(Printf.sprintf
"[BT] Unknown message opcode %d" opcode
)
1305 ft_ops
.op_file_cancel <- op_ft_cancel;
1306 ft_ops
.op_file_commit <- op_ft_commit;
1307 ft_ops
.op_file_info <- op_ft_info;
1308 ft_ops
.op_file_active_sources <- (fun _ -> []);
1309 ft_ops
.op_file_all_sources <- (fun _ -> []);
1311 file_ops
.op_file_all_sources <- op_file_all_sources;
1312 file_ops
.op_file_files <- op_file_files;
1313 file_ops
.op_file_active_sources <- op_file_active_sources;
1314 file_ops
.op_file_debug <- op_file_debug;
1315 file_ops
.op_file_commit <- op_file_commit;
1316 file_ops
.op_file_print <- op_file_print;
1317 file_ops
.op_file_print_sources <- op_file_print_sources;
1318 file_ops
.op_file_check <- op_file_check;
1319 file_ops
.op_file_cancel <- op_file_cancel;
1320 file_ops
.op_file_info <- op_file_info;
1321 file_ops
.op_file_save_as
<- (fun file name
-> ());
1322 file_ops
.op_file_shared
<- (fun file ->
1323 match file.file_shared
with
1325 | Some sh
-> Some
(as_shared sh
)
1327 file_ops
.op_file_download_order
<- (fun file strategy
->
1328 match file.file_swarmer
with
1331 (match strategy
with
1332 (* return current strategy *)
1333 | None
-> Some
(CommonSwarming.get_strategy
s)
1334 | Some strategy
-> CommonSwarming.set_strategy
s strategy
;
1335 Some
(CommonSwarming.get_strategy
s))
1338 network
.op_network_gui_message
<- op_gui_message;
1339 network
.op_network_connected <- op_network_connected;
1340 network
.op_network_parse_url <- op_network_parse_url;
1341 network
.op_network_share
<- (fun fullname codedname size
-> ());
1342 network
.op_network_close_search
<- (fun s -> ());
1343 network
.op_network_forget_search
<- (fun s -> ());
1344 network
.op_network_connect_servers
<- (fun s -> ());
1345 network
.op_network_search
<- (fun ss
buf -> ());
1346 network
.op_network_download
<- (fun r user group
-> dummy_file
);
1347 network
.op_network_recover_temp
<- (fun s -> ());
1348 let clean_exit_started = ref false in
1349 network
.op_network_clean_exit
<- (fun s ->
1350 if not
!clean_exit_started then
1352 List.iter (fun file -> BTClients.file_stop
file) !current_files
;
1353 clean_exit_started := true;
1355 List.for_all
(fun file -> not
file.file_tracker_connected
) !current_files
;
1357 network
.op_network_reset
<- (fun _ ->
1358 List.iter (fun file -> BTClients.file_stop
file) !current_files
);
1359 network
.op_network_ports
<- (fun _ ->
1361 !!client_port
, "client_port TCP";
1362 !!BTTracker.tracker_port
, "tracker_port TCP";
1364 network
.op_network_porttest_result
<- (fun _ -> !porttest_result);
1365 network
.op_network_porttest_start
<- (fun _ ->
1366 let module H
= Http_client
in
1367 azureus_porttest_random
:= (Random.int 100000);
1368 porttest_result := PorttestInProgress
(last_time
());
1370 H.basic_request
with
1372 Url.of_string
(Printf.sprintf
1373 "http://azureus.aelitis.com/natcheck.php?port=%d&check=azureus_rand_%d"
1374 !!client_port
!azureus_porttest_random
);
1375 H.req_proxy
= !CommonOptions.http_proxy
;
1376 H.req_user_agent
= get_user_agent
();
1378 H.wget
r (fun file ->
1379 let result = interpret_azureus_porttest (File.to_string
file) in
1380 porttest_result := PorttestResult
(last_time
(), result)
1383 network
.op_network_check_upload_slots
<- (fun _ -> check_bt_uploaders
());
1384 client_ops
.op_client_info <- op_client_info;
1385 client_ops
.op_client_connect <- op_client_connect;
1386 client_ops
.op_client_disconnect <- op_client_disconnect;
1387 client_ops
.op_client_bprint <- op_client_bprint;
1388 client_ops
.op_client_dprint <- op_client_dprint;
1389 client_ops
.op_client_dprint_html <- op_client_dprint_html;
1390 client_ops
.op_client_browse
<- (fun _ _ -> ());
1391 client_ops
.op_client_files
<- (fun _ -> []);
1392 client_ops
.op_client_clear_files
<- (fun _ -> ());
1394 CommonNetwork.register_commands
commands;
1396 shared_ops
.op_shared_state
<- (fun file o
->
1397 if o
.conn_output
= HTML
then
1398 Printf.sprintf
"\\<a href=\\\"submit?q=print_torrent+%d\\\"\\>Details\\</a\\>"
1400 else Printf.sprintf
"Shared using %s" file.file_torrent_diskname
1402 shared_ops
.op_shared_unshare
<- (fun file ->
1403 (if !verbose_share
then lprintf_file_nl
(as_file
file) "unshare file");
1404 BTGlobals.unshare_file
file);
1405 shared_ops
.op_shared_info
<- (fun file ->
1406 let module T
= GuiTypes
in
1407 match file.file_shared
with
1408 None
-> assert false
1410 { (impl_shared_info
impl) with
1411 T.shared_network
= network
.network_num
;
1412 T.shared_filename
= file_best_name
(as_file
file);
1413 T.shared_uids
= [Uid.create
(Sha1
file.file_id)];
1414 T.shared_sub_files
= file.file_files
;