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
25 open CommonInteractive
30 open CommonComplexOptions
48 let send_client c m
= send_client c
.client_sock m
50 let as_ft file
= as_file file
.ft_file
51 let ft_num file
= file_num
(as_ft file
)
52 let ft_size file
= file
.ft_file
.impl_file_size
53 let ft_state file
= file_state
(as_ft file
)
55 let as_file file
= as_file file
.file_file
56 let file_size file
= file
.file_file
.impl_file_size
57 let file_downloaded file
= file_downloaded (as_file file
)
58 let file_age file
= file
.file_file
.impl_file_age
59 let file_fd file
= file_fd (as_file file
)
60 let file_disk_name file
= file_disk_name (as_file file
)
61 let file_state file
= file_state (as_file file
)
62 let file_num file
= file_num (as_file file
)
63 let file_must_update file
= file_must_update (as_file file
)
66 let set_file_state file state
=
67 CommonFile.set_file_state (as_file file
) state
69 let as_client c
= as_client c
.client_client
70 let client_type c
= client_type (as_client c
)
72 let set_client_state client state
=
73 CommonClient.set_client_state (as_client client
) state
75 let set_client_disconnected client
=
76 CommonClient.set_client_disconnected (as_client client
)
78 let client_num c
= client_num (as_client c
)
81 let network = new_network
"BT" "BitTorrent"
88 let connection_manager = network.network_connection_manager
90 let (shared_ops
: file
CommonShared.shared_ops
) =
91 CommonShared.new_shared_ops
network
93 let (server_ops
: server
CommonServer.server_ops
) =
94 CommonServer.new_server_ops
network
96 let (room_ops
: server
CommonRoom.room_ops
) =
97 CommonRoom.new_room_ops
network
99 let (user_ops
: user
CommonUser.user_ops
) =
100 CommonUser.new_user_ops
network
102 let (file_ops
: file
CommonFile.file_ops
) =
103 CommonFile.new_file_ops
network
105 let (ft_ops
: ft
CommonFile.file_ops
) =
106 CommonFile.new_file_ops
network
108 let (client_ops
: client
CommonClient.client_ops
) =
109 CommonClient.new_client_ops
network
111 let must_share_file file codedname has_old_impl
=
112 match file
.file_shared
with
117 impl_shared_update
= 1;
118 impl_shared_fullname
= file_disk_name file
;
119 impl_shared_codedname
= codedname
;
120 impl_shared_size
= file_size file
;
121 impl_shared_id
= Md4.null
;
123 impl_shared_uploaded
= Int64.zero
;
124 impl_shared_ops
= shared_ops
;
125 impl_shared_val
= file
;
126 impl_shared_requests
= 0;
127 impl_shared_file
= Some
(as_file file
);
128 impl_shared_servers
= [];
130 file
.file_shared
<- Some
impl;
131 incr
CommonGlobals.nshared_files
;
132 CommonShared.shared_calculate_total_bytes
();
133 match has_old_impl
with
134 None
-> update_shared_num
impl
135 | Some old_impl
-> replace_shared old_impl
impl
138 let must_share_file file
= must_share_file file
(file_best_name
(as_file file
)) None
140 let unshare_file file
=
141 match file
.file_shared
with
145 file
.file_shared
<- None
;
146 decr
CommonGlobals.nshared_files
;
147 CommonShared.shared_calculate_total_bytes
()
150 module DO
= CommonOptions
152 let current_files = ref ([] : BTTypes.file list
)
154 let listen_sock = ref (None
: TcpServerSocket.t
option)
156 let files_by_uid = Hashtbl.create
13
158 let max_range_len = Int64.of_int
(1 lsl 14)
159 let max_request_len = Int64.of_int
(1 lsl 16)
161 let bt_download_counter = ref Int64.zero
162 let bt_upload_counter = ref Int64.zero
164 let log_prefix = "[BT]"
167 lprintf_nl2
log_prefix fmt
170 lprintf2
log_prefix fmt
173 let check_if_interesting file c
=
175 if not c
.client_alrd_sent_notinterested
then
176 let up = match c
.client_uploader
with
180 let swarmer = CommonSwarming.uploader_swarmer
up in
182 (* The client has nothing to propose to us *)
183 (not
(CommonSwarming.is_interesting
up )) &&
184 (* All the requested ranges are useless *)
185 (List.filter
(fun (_
,_
,r
) ->
186 let x,y
= CommonSwarming.range_range r
in
187 x < y
) c
.client_ranges_sent
= []) &&
188 (match c
.client_range_waiting
with
191 let x,y
= CommonSwarming.range_range r
in
193 (* The current blocks are also useless *)
194 (match c
.client_chunk
with
196 | Some
(chunk
, blocks
) ->
197 List.for_all
(fun b
->
198 let chunk_num = CommonSwarming.block_chunk_num
swarmer b
.up_block
in
199 let bitmap = CommonSwarming.chunks_verified_bitmap
swarmer in
200 VB.get
bitmap chunk_num <> VB.State_verified
) blocks
)
204 c
.client_interesting
<- false;
205 c
.client_alrd_sent_notinterested
<- true;
206 send_client c NotInterested
209 let add_torrent_infos file trackers
=
210 file
.file_trackers
<- trackers
@ file
.file_trackers
212 let create_temp_file file_temp file_files
file_state =
213 if !verbose
then lprintf_nl "create_temp_file %s - %s" file_temp
(string_of_state
file_state);
215 if file_state = FileShared
then
221 if file_files
<> [] then
222 Unix32.create_multifile file_temp
writable file_files
224 Unix32.create_diskfile file_temp
writable
226 if Unix32.destroyed
file_fd then
229 "create_temp_file: Unix32.create returned a destroyed FD for %s\n"
233 let make_tracker_url url
=
234 if String2.check_prefix
(String.lowercase url
) "http://" then
235 `Http url
(* do not change the case of the url *)
237 try Scanf.sscanf
(String.lowercase url
) "udp://%s@:%d" (fun host port
-> `Udp
(host
,port
))
240 (** invariant: [make_tracker_url (show_tracker_url url) = url] *)
241 let show_tracker_url : tracker_url
-> string = function
242 | `Http url
| `Other url
-> url
243 | `Udp
(host
,port
) -> Printf.sprintf
"udp://%s:%d" host port
245 let can_handle_tracker = function
250 let set_trackers file file_trackers
=
251 List.iter
(fun url
->
252 let url = make_tracker_url url in
253 if not
(List.exists
(fun tracker
-> tracker
.tracker_url
= url) file
.file_trackers
) then
256 tracker_interval
= 600;
257 tracker_min_interval
= 600;
258 tracker_last_conn
= 0;
259 tracker_last_clients_num
= 0;
260 tracker_torrent_downloaded
= 0;
261 tracker_torrent_complete
= 0;
262 tracker_torrent_incomplete
= 0;
263 tracker_torrent_total_clients_count
= 0;
264 tracker_torrent_last_dl_req
= 0;
267 tracker_status
= if can_handle_tracker url then Enabled
268 else Disabled_mld
(intern
"Tracker type not supported")
270 file
.file_trackers
<- t :: file
.file_trackers
)
273 let new_file file_id
t torrent_diskname file_temp
file_state user group
=
275 Hashtbl.find
files_by_uid file_id
277 let file_fd = create_temp_file file_temp
t.torrent_files
file_state in
279 file_tracker_connected
= false;
280 file_file
= file_impl
;
281 file_piece_size
= t.torrent_piece_size
;
283 file_name
= t.torrent_name
;
284 file_comment
= t.torrent_comment
;
285 file_created_by
= t.torrent_created_by
;
286 file_creation_date
= t.torrent_creation_date
;
287 file_modified_by
= t.torrent_modified_by
;
288 file_encoding
= t.torrent_encoding
;
289 file_clients_num
= 0;
290 file_clients
= Hashtbl.create
113;
293 file_chunks
= t.torrent_pieces
;
294 file_files
= (List.map
(fun (file,size
) -> (file,size
,None
)) t.torrent_files
);
295 file_blocks_downloaded
= [];
296 file_uploaded
= Int64.zero
;
297 file_torrent_diskname
= torrent_diskname
;
298 file_completed_hook
= (fun _
-> ());
300 file_session_uploaded
= Int64.zero
;
301 file_session_downloaded
= Int64.zero
;
304 impl_file_owner
= user
;
305 impl_file_group
= group
;
306 impl_file_fd
= Some
file_fd;
307 impl_file_size
= t.torrent_length
;
308 impl_file_downloaded
= Int64.zero
;
309 impl_file_val
= file;
310 impl_file_ops
= file_ops
;
311 impl_file_age
= last_time
();
312 impl_file_best_name
= t.torrent_name
;
315 if t.torrent_announce_list
<> [] then
316 set_trackers file t.torrent_announce_list
318 set_trackers file [t.torrent_announce
];
319 if file_state <> FileShared
then begin
320 let kernel = CommonSwarming.create_swarmer file_temp
(file_size file) in
321 let swarmer = CommonSwarming.create
kernel (as_file file)
322 file.file_piece_size
in
323 file.file_swarmer
<- Some
swarmer;
324 CommonSwarming.set_verified
swarmer (fun _ num
->
325 file.file_blocks_downloaded
<- (num
) ::
326 file.file_blocks_downloaded
;
327 file_must_update file;
328 (*Automatically send Have to ALL clients once a piece is verified
329 NB : will probably have to check if client can be interested*)
330 Hashtbl.iter
(fun _ c
->
332 if c
.client_registered_bitfield
then
334 match c
.client_bitmap
with
337 if not
(Bitv.get
bitmap num
) then
338 send_client c
(Have
(Int64.of_int num
));
339 check_if_interesting file c
344 CommonSwarming.set_verifier
swarmer (Verification
345 (Array.map
(fun sha1
-> Sha1 sha1
) file.file_chunks
));
347 current_files := file :: !current_files;
348 Hashtbl.add
files_by_uid file_id
file;
349 file_add file_impl
file_state;
350 must_share_file file;
353 let new_download file_id
t torrent_diskname user
=
354 let file_temp = Filename.concat
!!DO.temp_directory
355 (Printf.sprintf
"BT-%s" (Sha1.to_string file_id
)) in
356 new_file file_id
t torrent_diskname
file_temp FileDownloading user
358 let ft_by_num = Hashtbl.create
13
359 let ft_counter = ref 0
361 let new_ft file_name user
=
366 ft_filename
= file_name
;
367 ft_retry
= (fun _
-> ());
370 impl_file_owner
= user
;
371 impl_file_group
= user
.user_default_group
;
373 impl_file_size
= zero
;
374 impl_file_downloaded
= Int64.zero
;
376 impl_file_ops
= ft_ops
;
377 impl_file_age
= last_time
();
378 impl_file_best_name
= file_name
;
381 Hashtbl.add
ft_by_num !ft_counter ft;
382 file_add file_impl FileDownloading
;
385 let _dot_string s h
=
386 let len = String.length s
in
388 let ic = int_of_char c
in
389 if ic >= 65 && ic <= 70 then
390 string_of_int
(ic - 55)
392 if ic >= 97 && ic <= 102 then
393 string_of_int
(ic - 87)
395 Printf.sprintf
"%c" c
399 if i
< len then begin
400 if h
then Buffer.add_string b
(char2hex s
.[i
])
401 else Buffer.add_char b s
.[i
];
402 if i
< len-1 then Buffer.add_char b '
.'
;
406 Buffer.contents
(iter 0 (Buffer.create
(len*2)))
414 let dot_string_of_list s l
=
415 let buf = Buffer.create
(List.length l
) in
416 List.iter (fun i
-> Buffer.add_char
buf s
.[i
]) l
;
417 dot_string (Buffer.contents
buf)
419 let dot_string_of_string s
=
420 let buf = Buffer.create
20 in
421 let found_non_int = ref false in
422 String.iter (fun s
->
425 if !found_non_int then Buffer.add_char
buf '
.'
;
426 found_non_int := false;
427 Buffer.add_char
buf s
428 | _
-> found_non_int := true
432 (* check string s for char c (dec) at position l (list) *)
433 let check_all s c l
=
434 let ch = char_of_int c
in
435 List.for_all
(fun i
-> s
.[i
] = ch) l
439 ignore
(int_of_string
(String.sub s p
1));
443 let strip_leading_zeroes s
=
444 let l = String.length s
in
447 else if s
.[i
] <> '
0'
then String.sub s i
(l - i
)
451 (* from azureus/gpl *)
452 let decode_az_style s
=
453 if check_all s
45 [0;7] then begin
454 let s_id = (String.sub s
1 2) in
457 | "AR" -> Brand_arctic
458 | "AZ" -> Brand_azureus
459 | "BB" -> Brand_bitbuddy
460 | "BC" -> Brand_bitcomet
461 | "BR" -> Brand_bitrocket
462 | "BS" -> Brand_btslave
463 | "BX" -> Brand_bittorrentx
464 | "CT" (* ctorrent *)
465 | "CD" -> Brand_ctorrent
466 | "lt" (* libtorrent *)
467 | "LT" -> Brand_libtorrent
468 | "MT" -> Brand_moonlighttorrent
469 | "SB" -> Brand_swiftbit
470 | "SN" -> Brand_sharenet
471 | "SS" -> Brand_swarmscope
472 | "SZ" (* shareaza *)
473 | "S~" -> Brand_shareaza
474 | "TN" -> Brand_torrentdotnet
475 | "TS" -> Brand_torrentstorm
476 | "XT" -> Brand_xantorrent
477 | "ZT" -> Brand_ziptorrent
478 | "bk" -> Brand_bitkitten
479 | "MP" -> Brand_moopolice
480 | "UM" -> Brand_utorrent_mac
481 | "UT" -> Brand_utorrent
482 | "KT" -> Brand_ktorrent
483 | "LP" -> Brand_lphant
484 | "TR" -> Brand_transmission
485 | "HN" -> Brand_hydranode
486 | "RT" -> Brand_retriever
487 | "PC" -> Brand_cachelogic
488 | "ES" -> Brand_electricsheep
489 | "qB" -> Brand_qbittorrent
491 | "UL" -> Brand_uleecher
492 | "XX" -> Brand_xtorrent
495 | "AX" -> Brand_bitpump
496 | "DE" -> Brand_deluge
497 | "TT" -> Brand_tuotu
498 | "SD" (* Thunder (aka XùnLéi) *)
499 | "XL" -> Brand_xunlei
500 | "FT" -> Brand_foxtorrent
501 | "BF" -> Brand_bitflu
502 | "OS" -> Brand_oneswarm
503 | "LW" -> Brand_limewire
504 | "HL" -> Brand_halite
506 | "PD" -> Brand_pando
509 if brand = Brand_unknown
then None
else
514 | Brand_bitcomet
-> (String.sub s
4 1) ^
"." ^
(String.sub s
5 2)
519 | Brand_utorrent
-> (String.sub s
3 1) ^
"." ^
(String.sub s
4 1) ^
"." ^
(String.sub s
5 1)
521 | Brand_transmission
-> (String.sub s
3 1) ^
"." ^
(String.sub s
4 2)
523 | Brand_ctorrent
-> (strip_leading_zeroes (String.sub s
3 2)) ^
"." ^
(strip_leading_zeroes(String.sub s
5 2))
524 (* 3.4.5->[R=RC.6|D=Dev|''] *)
526 let x = match s
.[5] with
527 | 'R'
-> " RC" ^
(String.sub s
6 1)
531 (String.sub s
3 1) ^
"." ^
(String.sub s
4 1) ^
x
533 | Brand_bitrocket
-> (String.sub s
3 1) ^
"." ^
(String.sub s
4 1) ^
"(" ^
(String.sub s
5 2) ^
")"
535 | Brand_xtorrent
-> "v" ^
(strip_leading_zeroes (String.sub s
3 4))
536 (* BitFlu is too complicated YMDD (Y+M -> HEX) eg. 7224 is 2007.02.24 *)
539 | _
-> (dot_string (String.sub s
3 4))
541 Some
(brand, version)
545 let decode_tornado_style s
=
546 if s
.[5] = '
-'
then begin
549 | 'T'
-> Brand_bittornado
550 | 'S'
-> Brand_shadow
553 | 'O'
-> Brand_osprey
554 | 'R'
-> Brand_tribler
559 if s
.[5] ='
-'
&& s
.[6] ='
-'
&& s
.[7] ='
-'
then begin
560 let brand = check_brand s
.[0] in
561 if not
(brand = Brand_unknown
) then
562 bv := Some
(brand, (dot_string_h (String.sub s
1 3)));
564 else if s
.[6] = (char_of_int
48) then begin
565 let brand = check_brand s
.[0] in
566 if not
(brand = Brand_unknown
) then
567 bv := Some
(brand, ("LM " ^
dot_string_h (String.sub s
1 3)));
573 let decode_mainline_style s
=
574 if check_all s
45 [2;7] && check_int s
1 then begin
578 | 'M'
-> Brand_mainline
581 if brand = Brand_unknown
then None
582 else Some
(brand, (dot_string_of_string (String.sub s
1 6)))
586 let decode_simple_style s
=
587 let simple_list = ref
588 [ (0, "martini", Brand_martiniman
, "");
589 (0, "oernu", Brand_btugaxp
, "");
590 (0, "BTDWV-", Brand_deadmanwalking
, "");
591 (0, "PRC.P---", Brand_btplus
, "II");
592 (0, "P87.P---", Brand_btplus
, "");
593 (0, "S587Plus", Brand_btplus
, "");
594 (5, "Azureus", Brand_azureus
, "2.0.3.2");
595 (0, "-G3", Brand_g3torrent
, "");
596 (0, "-AR", Brand_arctic
, "");
597 (4, "btfans", Brand_simplebt
, "");
598 (0, "btuga", Brand_btugaxp
, "");
599 (0, "BTuga", Brand_btugaxp
, "");
600 (0, "DansClient", Brand_xantorrent
, "");
601 (0, "Deadman Walking-", Brand_deadmanwalking
, "");
602 (0, "346-", Brand_torrenttopia
, "");
603 (0, "271-", Brand_greedbt
, "2.7.1");
604 (10, "BG", Brand_btgetit
, "");
605 (0, "a00---0", Brand_swarmy
, "");
606 (0, "a02---0", Brand_swarmy
, "");
607 (0, "10-------", Brand_jvtorrent
, "");
608 (0, "T00---0", Brand_teeweety
, "");
609 (0, "LIME", Brand_limewire
, "");
610 (0, "AZ2500BT", Brand_btyrant
, "");
611 (0, "Mbrst", Brand_burst
, (dot_string_of_list s
[5;7;9]));
612 (0, "Plus", Brand_plus
, (dot_string_of_list s
[4;5;6]));
613 (0, "OP", Brand_opera
, (dot_string(String.sub s
2 4)));
614 (0, "eX", Brand_exeem
, (String.sub s
2 18));
615 (0, "turbobt", Brand_turbobt
, (String.sub s
7 5));
616 (0, "btpd", Brand_btpd
, (dot_string(String.sub s
5 3)));
617 (0, "XBT", Brand_xbt
, (dot_string(String.sub s
3 3)));
618 (0, "-FG", Brand_flashget
, (dot_string(String.sub s
4 3)));
619 (0, "-SP", Brand_bitspirit
, (dot_string(String.sub s
3 3)));
622 let len = List.length
!simple_list in
624 if pos
>= len then None
626 let (x,y
,z
,v
) = List.nth
!simple_list pos
in
627 if (String.sub s
x (String.length y
)) = y
then Some
(z
,v
)
634 let minor = Char.code s
.[1] in
635 Printf.sprintf
"%d.%d.%d" (Char.code s
.[0]) (minor / 10) (minor mod 10) in
636 if "RS" = String.sub s
2 2 then
637 Some
(Brand_rufus
, release s
)
641 if "BOW" = String.sub s
0 3 ||
642 (check_all s
45 [0;7] && "BOW" = String.sub s
1 3) then
643 Some
(Brand_bitsonwheels
, (String.sub s
4 3))
647 if ("BTM" = String.sub s
0 3) && ("BTuga" = String.sub s
5 5) then
648 Some
(Brand_btuga
, dot_string(String.sub s
3 2))
651 let decode_shadow s
=
652 if "S" = String.sub s
0 1 then begin
654 if check_all s
45 [6;7;8] then begin
655 let i1 = int_of_string
("0x" ^
String.sub s
1 1) in
656 let i2 = int_of_string
("0x" ^
String.sub s
2 1) in
657 let i3 = int_of_string
("0x" ^
String.sub s
3 1) in
658 bv := Some
(Brand_shadow
, (Printf.sprintf
"%d.%d.%d" i1 i2 i3))
661 if s
.[8] = (char_of_int
0) then begin
662 let i1 = int_of_char s
.[1] in
663 let i2 = int_of_char s
.[2] in
664 let i3 = int_of_char s
.[3] in
665 bv := Some
(Brand_shadow
, (Printf.sprintf
"%d.%d.%d" i1 i2 i3))
671 let decode_bitspirit s
=
672 if "BS" = String.sub s
2 2 then begin
674 if s
.[1] = (char_of_int
0) then bv := Some
(Brand_bitspirit
, "v1");
675 if s
.[1] = (char_of_int
2) then bv := Some
(Brand_bitspirit
, "v2");
676 if s
.[1] = (char_of_int
3) then bv := Some
(Brand_bitspirit
, "v3");
682 if 'U'
= s
.[0] && s
.[8] = '
-'
then
683 Some
(Brand_upnp
, (dot_string (String.sub s
1 3)))
686 let decode_old_bitcomet s
=
687 let bitcomet = String.sub s
0 4 in
688 if "exbc" = bitcomet || "FUTB" = bitcomet || "xUTB" = bitcomet then
689 let brand = if "LORD" = String.sub s
6 4 then
690 Brand_bitlord
else Brand_bitcomet
692 let versionMajorNumber = int_of_char s
.[4] in
693 let versionMinorNubmer =
694 match versionMajorNumber with
695 0 -> (int_of_char s
.[5])
696 | _
-> ((int_of_char s
.[5]) mod 10)
698 let version = Printf.sprintf
"%d.%d"
699 versionMajorNumber versionMinorNubmer in
700 Some
(brand, version)
703 let decode_shareaza s
=
704 let rec not_zeros pos
=
705 if pos
> 15 then true else
706 if s
.[pos
] = (char_of_int
0) then false else not_zeros (pos
+1)
708 let rec weird_crap pos
=
709 if pos
> 19 then true else
710 let i1 = (int_of_char s
.[pos
]) in
711 let i2 = (int_of_char s
.[(pos
mod 16)]) in
712 let i3 = (int_of_char s
.[(15 - (pos
mod 16))]) in
713 if not
(i1 = (i2 lxor i3)) then false else weird_crap (pos
+1)
715 if (not_zeros 0) && (weird_crap 16) then Some
(Brand_shareaza
, "") else None
717 let decode_non_zero s
=
718 let max_pos = ((String.length s
) - 1) in
719 let zero = char_of_int
0 in
720 let rec find_non_zero pos
=
721 if pos
> max_pos then max_pos else
722 if not
(s
.[pos
] = zero) then pos
else
723 find_non_zero (pos
+1)
726 (match find_non_zero 0 with
727 8 -> (if "UDP0" = String.sub s
16 4 then
728 bv := Some
(Brand_bitcomet
, "UDP");
729 if "HTTPBT" = String.sub s
14 6 then
730 bv := Some
(Brand_bitcomet
, "HTTP"));
731 | 9 -> if check_all s
3 [9;10;11] then
732 bv := Some
(Brand_snark
, "");
733 | 12 -> if check_all s
97 [12;13] then
734 bv := Some
(Brand_experimental
, "3.2.1b2")
736 if check_all s
0 [12;13] then
737 bv := Some
(Brand_experimental
, "3.1")
739 bv := Some
(Brand_mainline
, "")
745 (* format is : "-ML" ^ version ( of unknown length) ^ "-" ^ random bytes ( of unknown length) *)
746 let decode_mldonkey_style s
=
747 if '
-'
= s
.[0] then begin
748 let s_id = String.sub s
1 2 in
751 | "ML" -> Brand_mldonkey
754 if brand = Brand_unknown
then None
else
756 (try String.index_from s
3 '
-'
759 let version = String.sub s
3 len in
760 Some
(brand, version)
766 decode_tornado_style;
767 decode_mainline_style;
776 decode_mldonkey_style;
781 let parse_software s
=
782 let default = (Brand_unknown
, "") in
785 [] -> lprintf_nl "Unknown BT client software version, report the next line to http://mldonkey.sourceforge.net/UnknownBtClients%s\nBTUC:\"%s\"" Autoconf.current_version
(String.escaped s
);
787 | d
:: t -> match (d s
) with
789 | Some
bv -> let (brand, version) = bv in
790 if !verbose_msg_clienttags
then
791 lprintf_nl "BTKC:\"%s\"; ID: \"%s\"; version:\"%s\"" (String.escaped s
) (brand_to_string
brand) version;
794 if Sha1.direct_of_string s
= Sha1.null
then
797 try iter decoder_list
800 let check_client_country_code c
=
801 if Geoip.active
() then
802 match c
.client_country_code
with
804 c
.client_country_code
<-
805 Geoip.get_country_code_option
(fst c
.client_host
)
808 let new_client file peer_id kind cc
=
810 let c = Hashtbl.find
file.file_clients kind
in
811 let old_ip = fst
c.client_host
in
812 c.client_host
<- kind
;
813 if old_ip <> Ip.null
&& old_ip <> fst
c.client_host
then
815 c.client_country_code
<- None
;
816 check_client_country_code c
820 let brand, release = parse_software (Sha1.direct_to_string peer_id
) in
822 client_client
= impl;
823 client_sock
= NoConnection
;
824 client_upload_requests
= [];
825 client_connection_control
= new_connection_control
(());
828 client_country_code
= cc
;
829 client_choked
= true;
830 client_received_peer_id
= false;
831 client_sent_choke
= false;
832 client_interested
= false;
833 client_uploader
= None
;
835 client_ranges_sent
= [];
836 client_range_waiting
= None
;
838 client_uid
= peer_id
;
839 client_brand
= brand;
840 client_release
= release;
841 client_bitmap
= None
;
842 client_allowed_to_write
= zero;
843 client_total_uploaded
= zero;
844 client_total_downloaded
= zero;
845 client_session_uploaded
= zero;
846 client_session_downloaded
= zero;
847 client_upload_rate
= Rate.new_rate
();
848 client_downloaded_rate
= Rate.new_rate
();
849 client_connect_time
= last_time
();
850 client_blocks_sent
= [];
851 client_new_chunks
= [];
854 client_alrd_sent_interested
= false;
855 client_alrd_sent_notinterested
= false;
856 client_interesting
= false;
857 client_incoming
= false;
858 client_registered_bitfield
= false;
859 client_last_optimist
= 0;
861 client_cache_extension
= false;
862 client_fast_extension
= false;
863 client_utorrent_extension
= false;
864 client_azureus_messaging_protocol
= false;
866 dummy_client_impl
with
868 impl_client_ops
= client_ops
;
869 impl_client_upload
= None
;
871 c.client_connection_control
.control_min_reask
<- 120;
872 check_client_country_code c;
874 Hashtbl.add
file.file_clients kind
c;
875 file.file_clients_num
<- file.file_clients_num
+ 1;
876 file_add_source
(as_file file) (as_client c);
879 let remove_file file =
880 Hashtbl.remove
files_by_uid file.file_id
;
881 current_files := List2.removeq
file !current_files
883 let remove_client c =
884 Hashtbl.remove
c.client_file
.file_clients
c.client_host
;
885 c.client_file
.file_clients_num
<- c.client_file
.file_clients_num
- 1;
886 file_remove_source
(as_file c.client_file
) (as_client c)
888 let remove_tracker url file =
889 if !verbose_msg_servers
then
890 List.iter (fun tracker
->
891 lprintf_nl "Old tracker list: %s" (show_tracker_url tracker
.tracker_url
)
892 ) file.file_trackers
;
893 List.iter (fun bad_tracker
->
894 if bad_tracker
.tracker_url
= url then
895 file.file_trackers
<- List2.remove_first bad_tracker
file.file_trackers
;
896 ) file.file_trackers
;
897 if !verbose_msg_servers
then
898 List.iter (fun tracker
->
899 lprintf_nl "New tracker list: %s" (show_tracker_url tracker
.tracker_url
)
902 let tracker_is_enabled t =
903 match t.tracker_status
with
905 | Disabled_failure
(i
,_
) ->
906 if !!tracker_retries
= 0 || i
< !!tracker_retries
then true else false
909 let torrents_directory = "torrents"
910 let new_torrents_directory = Filename.concat
torrents_directory "incoming"
911 let downloads_directory = Filename.concat
torrents_directory "downloads"
912 let tracked_directory = Filename.concat
torrents_directory "tracked"
913 let seeded_directory = Filename.concat
torrents_directory "seeded"
914 let old_directory = Filename.concat
torrents_directory "old"
916 (*************************************************************
918 Define a function to be called when the "mem_stats" command
919 is used to display information on structure footprint.
921 **************************************************************)
924 Heap.add_memstat
"BittorrentGlobals" (fun level
buf ->
925 Printf.bprintf
buf "Number of old files: %d\n" (List.length
!!old_files
);
926 let downloads = ref 0 in
927 let tracked = ref 0 in
928 let seeded = ref 0 in
929 Unix2.iter_directory
(fun file -> incr
downloads ) downloads_directory;
930 Unix2.iter_directory
(fun file -> incr
tracked ) tracked_directory;
931 Unix2.iter_directory
(fun file -> incr
seeded ) seeded_directory;
932 Printf.bprintf
buf "Files in downloads directory: %d\n" ! downloads;
933 Printf.bprintf
buf "Files in tracked directory: %d\n" ! tracked;
934 Printf.bprintf
buf "Files in seeded directory: %d\n" ! seeded;
935 Printf.bprintf
buf "files_by_uid: %d\n" (Hashtbl.length
files_by_uid);
936 Printf.bprintf
buf "ft_by_num: %d\n" (Hashtbl.length
ft_by_num);