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 bt_dht = ref (None
: BT_DHT.M.t
option)
158 let files_by_uid = Hashtbl.create
13
160 let max_range_len = Int64.of_int
(1 lsl 14)
161 let max_request_len = Int64.of_int
(1 lsl 16)
163 let bt_download_counter = ref Int64.zero
164 let bt_upload_counter = ref Int64.zero
166 let log_prefix = "[BT]"
169 lprintf_nl2
log_prefix fmt
172 lprintf2
log_prefix fmt
175 let check_if_interesting file c
=
177 if not c
.client_alrd_sent_notinterested
then
178 let up = match c
.client_uploader
with
182 let swarmer = CommonSwarming.uploader_swarmer
up in
184 (* The client has nothing to propose to us *)
185 (not
(CommonSwarming.is_interesting
up )) &&
186 (* All the requested ranges are useless *)
187 (List.filter
(fun (_
,_
,r
) ->
188 let x,y
= CommonSwarming.range_range r
in
189 x < y
) c
.client_ranges_sent
= []) &&
190 (match c
.client_range_waiting
with
193 let x,y
= CommonSwarming.range_range r
in
195 (* The current blocks are also useless *)
196 (match c
.client_chunk
with
198 | Some
(chunk
, blocks
) ->
199 List.for_all
(fun b
->
200 let chunk_num = CommonSwarming.block_chunk_num
swarmer b
.up_block
in
201 let bitmap = CommonSwarming.chunks_verified_bitmap
swarmer in
202 VB.get
bitmap chunk_num <> VB.State_verified
) blocks
)
206 c
.client_interesting
<- false;
207 c
.client_alrd_sent_notinterested
<- true;
208 send_client c NotInterested
211 let add_torrent_infos file trackers
=
212 file
.file_trackers
<- trackers
@ file
.file_trackers
214 let create_temp_file file_temp file_files
file_state =
215 if !verbose
then lprintf_nl "create_temp_file %s - %s" file_temp
(string_of_state
file_state);
217 if file_state = FileShared
then
223 if file_files
<> [] then
224 Unix32.create_multifile file_temp
writable file_files
226 Unix32.create_diskfile file_temp
writable
228 if Unix32.destroyed
file_fd then
231 "create_temp_file: Unix32.create returned a destroyed FD for %s\n"
235 let make_tracker_url url
=
236 if String2.check_prefix
(String.lowercase url
) "http://" then
237 `Http url
(* do not change the case of the url *)
239 try Scanf.sscanf
(String.lowercase url
) "udp://%s@:%d" (fun host port
-> `Udp
(host
,port
))
242 (** invariant: [make_tracker_url (show_tracker_url url) = url] *)
243 let show_tracker_url : tracker_url
-> string = function
244 | `Http url
| `Other url
-> url
245 | `Udp
(host
,port
) -> Printf.sprintf
"udp://%s:%d" host port
247 let can_handle_tracker = function
252 let set_trackers file file_trackers
=
253 List.iter
(fun url
->
254 let url = make_tracker_url url in
255 if not
(List.exists
(fun tracker
-> tracker
.tracker_url
= url) file
.file_trackers
) then
258 tracker_interval
= 600;
259 tracker_min_interval
= 600;
260 tracker_last_conn
= 0;
261 tracker_last_clients_num
= 0;
262 tracker_torrent_downloaded
= 0;
263 tracker_torrent_complete
= 0;
264 tracker_torrent_incomplete
= 0;
265 tracker_torrent_total_clients_count
= 0;
266 tracker_torrent_last_dl_req
= 0;
269 tracker_status
= if can_handle_tracker url then Enabled
270 else Disabled_mld
(intern
"Tracker type not supported")
272 file
.file_trackers
<- t :: file
.file_trackers
)
275 let new_file file_id
t torrent_diskname file_temp
file_state user group
=
277 Hashtbl.find
files_by_uid file_id
279 let file_fd = create_temp_file file_temp
t.torrent_files
file_state in
281 file_tracker_connected
= false;
282 file_file
= file_impl
;
283 file_piece_size
= t.torrent_piece_size
;
285 file_name
= t.torrent_name
;
286 file_comment
= t.torrent_comment
;
287 file_created_by
= t.torrent_created_by
;
288 file_creation_date
= t.torrent_creation_date
;
289 file_modified_by
= t.torrent_modified_by
;
290 file_encoding
= t.torrent_encoding
;
291 file_clients_num
= 0;
292 file_clients
= Hashtbl.create
113;
295 file_chunks
= t.torrent_pieces
;
296 file_files
= (List.map
(fun (file,size
) -> (file,size
,None
)) t.torrent_files
);
297 file_blocks_downloaded
= [];
298 file_uploaded
= Int64.zero
;
299 file_torrent_diskname
= torrent_diskname
;
300 file_completed_hook
= (fun _
-> ());
302 file_session_uploaded
= Int64.zero
;
303 file_session_downloaded
= Int64.zero
;
304 file_last_dht_announce
= 0;
305 file_private
= t.torrent_private
;
308 impl_file_owner
= user
;
309 impl_file_group
= group
;
310 impl_file_fd
= Some
file_fd;
311 impl_file_size
= t.torrent_length
;
312 impl_file_downloaded
= Int64.zero
;
313 impl_file_val
= file;
314 impl_file_ops
= file_ops
;
315 impl_file_age
= last_time
();
316 impl_file_best_name
= t.torrent_name
;
319 if t.torrent_announce_list
<> [] then
320 set_trackers file t.torrent_announce_list
322 set_trackers file [t.torrent_announce
];
323 if file_state <> FileShared
then begin
324 let kernel = CommonSwarming.create_swarmer file_temp
(file_size file) in
325 let swarmer = CommonSwarming.create
kernel (as_file file)
326 file.file_piece_size
in
327 file.file_swarmer
<- Some
swarmer;
328 CommonSwarming.set_verified
swarmer (fun _ num
->
329 file.file_blocks_downloaded
<- (num
) ::
330 file.file_blocks_downloaded
;
331 file_must_update file;
332 (*Automatically send Have to ALL clients once a piece is verified
333 NB : will probably have to check if client can be interested*)
334 Hashtbl.iter
(fun _ c
->
336 if c
.client_registered_bitfield
then
338 match c
.client_bitmap
with
341 if not
(Bitv.get
bitmap num
) then
342 send_client c
(Have
(Int64.of_int num
));
343 check_if_interesting file c
348 CommonSwarming.set_verifier
swarmer (Verification
349 (Array.map
(fun sha1
-> Sha1 sha1
) file.file_chunks
));
351 current_files := file :: !current_files;
352 Hashtbl.add
files_by_uid file_id
file;
353 file_add file_impl
file_state;
354 must_share_file file;
357 let new_download file_id
t torrent_diskname user
=
358 let file_temp = Filename.concat
!!DO.temp_directory
359 (Printf.sprintf
"BT-%s" (Sha1.to_string file_id
)) in
360 new_file file_id
t torrent_diskname
file_temp FileDownloading user
362 let ft_by_num = Hashtbl.create
13
363 let ft_counter = ref 0
365 let new_ft file_name user
=
370 ft_filename
= file_name
;
371 ft_retry
= (fun _
-> ());
374 impl_file_owner
= user
;
375 impl_file_group
= user
.user_default_group
;
377 impl_file_size
= zero
;
378 impl_file_downloaded
= Int64.zero
;
380 impl_file_ops
= ft_ops
;
381 impl_file_age
= last_time
();
382 impl_file_best_name
= file_name
;
385 Hashtbl.add
ft_by_num !ft_counter ft;
386 file_add file_impl FileDownloading
;
389 let _dot_string s h
=
390 let len = String.length s
in
392 let ic = int_of_char c
in
393 if ic >= 65 && ic <= 70 then
394 string_of_int
(ic - 55)
396 if ic >= 97 && ic <= 102 then
397 string_of_int
(ic - 87)
399 Printf.sprintf
"%c" c
403 if i
< len then begin
404 if h
then Buffer.add_string b
(char2hex s
.[i
])
405 else Buffer.add_char b s
.[i
];
406 if i
< len-1 then Buffer.add_char b '
.'
;
410 Buffer.contents
(iter 0 (Buffer.create
(len*2)))
418 let dot_string_of_list s l
=
419 let buf = Buffer.create
(List.length l
) in
420 List.iter (fun i
-> Buffer.add_char
buf s
.[i
]) l
;
421 dot_string (Buffer.contents
buf)
423 let dot_string_of_string s
=
424 let buf = Buffer.create
20 in
425 let found_non_int = ref false in
426 String.iter (fun s
->
429 if !found_non_int then Buffer.add_char
buf '
.'
;
430 found_non_int := false;
431 Buffer.add_char
buf s
432 | _
-> found_non_int := true
436 (* check string s for char c (dec) at position l (list) *)
437 let check_all s c l
=
438 let ch = char_of_int c
in
439 List.for_all
(fun i
-> s
.[i
] = ch) l
443 ignore
(int_of_string
(String.sub s p
1));
447 let strip_leading_zeroes s
=
448 let l = String.length s
in
451 else if s
.[i
] <> '
0'
then String.sub s i
(l - i
)
455 (* from azureus/gpl *)
456 let decode_az_style s
=
457 if check_all s
45 [0;7] then begin
458 let s_id = (String.sub s
1 2) in
461 | "AR" -> Brand_arctic
462 | "AZ" -> Brand_azureus
463 | "BB" -> Brand_bitbuddy
464 | "BC" -> Brand_bitcomet
465 | "BR" -> Brand_bitrocket
466 | "BS" -> Brand_btslave
467 | "BX" -> Brand_bittorrentx
468 | "CT" (* ctorrent *)
469 | "CD" -> Brand_ctorrent
470 | "lt" (* libtorrent *)
471 | "LT" -> Brand_libtorrent
472 | "MT" -> Brand_moonlighttorrent
473 | "SB" -> Brand_swiftbit
474 | "SN" -> Brand_sharenet
475 | "SS" -> Brand_swarmscope
476 | "SZ" (* shareaza *)
477 | "S~" -> Brand_shareaza
478 | "TN" -> Brand_torrentdotnet
479 | "TS" -> Brand_torrentstorm
480 | "XT" -> Brand_xantorrent
481 | "ZT" -> Brand_ziptorrent
482 | "bk" -> Brand_bitkitten
483 | "MP" -> Brand_moopolice
484 | "UM" -> Brand_utorrent_mac
485 | "UT" -> Brand_utorrent
486 | "KT" -> Brand_ktorrent
487 | "LP" -> Brand_lphant
488 | "TR" -> Brand_transmission
489 | "HN" -> Brand_hydranode
490 | "RT" -> Brand_retriever
491 | "PC" -> Brand_cachelogic
492 | "ES" -> Brand_electricsheep
493 | "qB" -> Brand_qbittorrent
495 | "UL" -> Brand_uleecher
496 | "XX" -> Brand_xtorrent
499 | "AX" -> Brand_bitpump
500 | "DE" -> Brand_deluge
501 | "TT" -> Brand_tuotu
502 | "SD" (* Thunder (aka XùnLéi) *)
503 | "XL" -> Brand_xunlei
504 | "FT" -> Brand_foxtorrent
505 | "BF" -> Brand_bitflu
506 | "OS" -> Brand_oneswarm
507 | "LW" -> Brand_limewire
508 | "HL" -> Brand_halite
510 | "PD" -> Brand_pando
513 if brand = Brand_unknown
then None
else
518 | Brand_bitcomet
-> (String.sub s
4 1) ^
"." ^
(String.sub s
5 2)
523 | Brand_utorrent
-> (String.sub s
3 1) ^
"." ^
(String.sub s
4 1) ^
"." ^
(String.sub s
5 1)
525 | Brand_transmission
-> (String.sub s
3 1) ^
"." ^
(String.sub s
4 2)
527 | Brand_ctorrent
-> (strip_leading_zeroes (String.sub s
3 2)) ^
"." ^
(strip_leading_zeroes(String.sub s
5 2))
528 (* 3.4.5->[R=RC.6|D=Dev|''] *)
530 let x = match s
.[5] with
531 | 'R'
-> " RC" ^
(String.sub s
6 1)
535 (String.sub s
3 1) ^
"." ^
(String.sub s
4 1) ^
x
537 | Brand_bitrocket
-> (String.sub s
3 1) ^
"." ^
(String.sub s
4 1) ^
"(" ^
(String.sub s
5 2) ^
")"
539 | Brand_xtorrent
-> "v" ^
(strip_leading_zeroes (String.sub s
3 4))
540 (* BitFlu is too complicated YMDD (Y+M -> HEX) eg. 7224 is 2007.02.24 *)
543 | _
-> (dot_string (String.sub s
3 4))
545 Some
(brand, version)
549 let decode_tornado_style s
=
550 if s
.[5] = '
-'
then begin
553 | 'T'
-> Brand_bittornado
554 | 'S'
-> Brand_shadow
557 | 'O'
-> Brand_osprey
558 | 'R'
-> Brand_tribler
563 if s
.[5] ='
-'
&& s
.[6] ='
-'
&& s
.[7] ='
-'
then begin
564 let brand = check_brand s
.[0] in
565 if not
(brand = Brand_unknown
) then
566 bv := Some
(brand, (dot_string_h (String.sub s
1 3)));
568 else if s
.[6] = (char_of_int
48) then begin
569 let brand = check_brand s
.[0] in
570 if not
(brand = Brand_unknown
) then
571 bv := Some
(brand, ("LM " ^
dot_string_h (String.sub s
1 3)));
577 let decode_mainline_style s
=
578 if check_all s
45 [2;7] && check_int s
1 then begin
582 | 'M'
-> Brand_mainline
585 if brand = Brand_unknown
then None
586 else Some
(brand, (dot_string_of_string (String.sub s
1 6)))
590 let decode_simple_style s
=
591 let simple_list = ref
592 [ (0, "martini", Brand_martiniman
, "");
593 (0, "oernu", Brand_btugaxp
, "");
594 (0, "BTDWV-", Brand_deadmanwalking
, "");
595 (0, "PRC.P---", Brand_btplus
, "II");
596 (0, "P87.P---", Brand_btplus
, "");
597 (0, "S587Plus", Brand_btplus
, "");
598 (5, "Azureus", Brand_azureus
, "2.0.3.2");
599 (0, "-G3", Brand_g3torrent
, "");
600 (0, "-AR", Brand_arctic
, "");
601 (4, "btfans", Brand_simplebt
, "");
602 (0, "btuga", Brand_btugaxp
, "");
603 (0, "BTuga", Brand_btugaxp
, "");
604 (0, "DansClient", Brand_xantorrent
, "");
605 (0, "Deadman Walking-", Brand_deadmanwalking
, "");
606 (0, "346-", Brand_torrenttopia
, "");
607 (0, "271-", Brand_greedbt
, "2.7.1");
608 (10, "BG", Brand_btgetit
, "");
609 (0, "a00---0", Brand_swarmy
, "");
610 (0, "a02---0", Brand_swarmy
, "");
611 (0, "10-------", Brand_jvtorrent
, "");
612 (0, "T00---0", Brand_teeweety
, "");
613 (0, "LIME", Brand_limewire
, "");
614 (0, "AZ2500BT", Brand_btyrant
, "");
615 (0, "Mbrst", Brand_burst
, (dot_string_of_list s
[5;7;9]));
616 (0, "Plus", Brand_plus
, (dot_string_of_list s
[4;5;6]));
617 (0, "OP", Brand_opera
, (dot_string(String.sub s
2 4)));
618 (0, "eX", Brand_exeem
, (String.sub s
2 18));
619 (0, "turbobt", Brand_turbobt
, (String.sub s
7 5));
620 (0, "btpd", Brand_btpd
, (dot_string(String.sub s
5 3)));
621 (0, "XBT", Brand_xbt
, (dot_string(String.sub s
3 3)));
622 (0, "-FG", Brand_flashget
, (dot_string(String.sub s
4 3)));
623 (0, "-SP", Brand_bitspirit
, (dot_string(String.sub s
3 3)));
626 let len = List.length
!simple_list in
628 if pos
>= len then None
630 let (x,y
,z
,v
) = List.nth
!simple_list pos
in
631 if (String.sub s
x (String.length y
)) = y
then Some
(z
,v
)
638 let minor = Char.code s
.[1] in
639 Printf.sprintf
"%d.%d.%d" (Char.code s
.[0]) (minor / 10) (minor mod 10) in
640 if "RS" = String.sub s
2 2 then
641 Some
(Brand_rufus
, release s
)
645 if "BOW" = String.sub s
0 3 ||
646 (check_all s
45 [0;7] && "BOW" = String.sub s
1 3) then
647 Some
(Brand_bitsonwheels
, (String.sub s
4 3))
651 if ("BTM" = String.sub s
0 3) && ("BTuga" = String.sub s
5 5) then
652 Some
(Brand_btuga
, dot_string(String.sub s
3 2))
655 let decode_shadow s
=
656 if "S" = String.sub s
0 1 then begin
658 if check_all s
45 [6;7;8] then begin
659 let i1 = int_of_string
("0x" ^
String.sub s
1 1) in
660 let i2 = int_of_string
("0x" ^
String.sub s
2 1) in
661 let i3 = int_of_string
("0x" ^
String.sub s
3 1) in
662 bv := Some
(Brand_shadow
, (Printf.sprintf
"%d.%d.%d" i1 i2 i3))
665 if s
.[8] = (char_of_int
0) then begin
666 let i1 = int_of_char s
.[1] in
667 let i2 = int_of_char s
.[2] in
668 let i3 = int_of_char s
.[3] in
669 bv := Some
(Brand_shadow
, (Printf.sprintf
"%d.%d.%d" i1 i2 i3))
675 let decode_bitspirit s
=
676 if "BS" = String.sub s
2 2 then begin
678 if s
.[1] = (char_of_int
0) then bv := Some
(Brand_bitspirit
, "v1");
679 if s
.[1] = (char_of_int
2) then bv := Some
(Brand_bitspirit
, "v2");
680 if s
.[1] = (char_of_int
3) then bv := Some
(Brand_bitspirit
, "v3");
686 if 'U'
= s
.[0] && s
.[8] = '
-'
then
687 Some
(Brand_upnp
, (dot_string (String.sub s
1 3)))
690 let decode_old_bitcomet s
=
691 let bitcomet = String.sub s
0 4 in
692 if "exbc" = bitcomet || "FUTB" = bitcomet || "xUTB" = bitcomet then
693 let brand = if "LORD" = String.sub s
6 4 then
694 Brand_bitlord
else Brand_bitcomet
696 let versionMajorNumber = int_of_char s
.[4] in
697 let versionMinorNubmer =
698 match versionMajorNumber with
699 0 -> (int_of_char s
.[5])
700 | _
-> ((int_of_char s
.[5]) mod 10)
702 let version = Printf.sprintf
"%d.%d"
703 versionMajorNumber versionMinorNubmer in
704 Some
(brand, version)
707 let decode_shareaza s
=
708 let rec not_zeros pos
=
709 if pos
> 15 then true else
710 if s
.[pos
] = (char_of_int
0) then false else not_zeros (pos
+1)
712 let rec weird_crap pos
=
713 if pos
> 19 then true else
714 let i1 = (int_of_char s
.[pos
]) in
715 let i2 = (int_of_char s
.[(pos
mod 16)]) in
716 let i3 = (int_of_char s
.[(15 - (pos
mod 16))]) in
717 if not
(i1 = (i2 lxor i3)) then false else weird_crap (pos
+1)
719 if (not_zeros 0) && (weird_crap 16) then Some
(Brand_shareaza
, "") else None
721 let decode_non_zero s
=
722 let max_pos = ((String.length s
) - 1) in
723 let zero = char_of_int
0 in
724 let rec find_non_zero pos
=
725 if pos
> max_pos then max_pos else
726 if not
(s
.[pos
] = zero) then pos
else
727 find_non_zero (pos
+1)
730 (match find_non_zero 0 with
731 8 -> (if "UDP0" = String.sub s
16 4 then
732 bv := Some
(Brand_bitcomet
, "UDP");
733 if "HTTPBT" = String.sub s
14 6 then
734 bv := Some
(Brand_bitcomet
, "HTTP"));
735 | 9 -> if check_all s
3 [9;10;11] then
736 bv := Some
(Brand_snark
, "");
737 | 12 -> if check_all s
97 [12;13] then
738 bv := Some
(Brand_experimental
, "3.2.1b2")
740 if check_all s
0 [12;13] then
741 bv := Some
(Brand_experimental
, "3.1")
743 bv := Some
(Brand_mainline
, "")
749 (* format is : "-ML" ^ version ( of unknown length) ^ "-" ^ random bytes ( of unknown length) *)
750 let decode_mldonkey_style s
=
751 if '
-'
= s
.[0] then begin
752 let s_id = String.sub s
1 2 in
755 | "ML" -> Brand_mldonkey
758 if brand = Brand_unknown
then None
else
760 (try String.index_from s
3 '
-'
763 let version = String.sub s
3 len in
764 Some
(brand, version)
770 decode_tornado_style;
771 decode_mainline_style;
780 decode_mldonkey_style;
785 let parse_software s
=
786 let default = (Brand_unknown
, "") in
789 [] -> 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
);
791 | d
:: t -> match (d s
) with
793 | Some
bv -> let (brand, version) = bv in
794 if !verbose_msg_clienttags
then
795 lprintf_nl "BTKC:\"%s\"; ID: \"%s\"; version:\"%s\"" (String.escaped s
) (brand_to_string
brand) version;
798 if Sha1.direct_of_string s
= Sha1.null
then
801 try iter decoder_list
804 let check_client_country_code c
=
805 if Geoip.active
() then
806 match c
.client_country_code
with
808 c
.client_country_code
<-
809 Geoip.get_country_code_option
(fst c
.client_host
)
812 let new_client file peer_id kind cc
=
814 let c = Hashtbl.find
file.file_clients kind
in
815 let old_ip = fst
c.client_host
in
816 c.client_host
<- kind
;
817 if old_ip <> Ip.null
&& old_ip <> fst
c.client_host
then
819 c.client_country_code
<- None
;
820 check_client_country_code c
824 let brand, release = parse_software (Sha1.direct_to_string peer_id
) in
826 client_client
= impl;
827 client_sock
= NoConnection
;
828 client_upload_requests
= [];
829 client_connection_control
= new_connection_control
(());
832 client_country_code
= cc
;
833 client_choked
= true;
834 client_received_peer_id
= false;
835 client_sent_choke
= false;
836 client_interested
= false;
837 client_uploader
= None
;
839 client_ranges_sent
= [];
840 client_range_waiting
= None
;
842 client_uid
= peer_id
;
843 client_brand
= brand;
844 client_release
= release;
845 client_bitmap
= None
;
846 client_allowed_to_write
= zero;
847 client_total_uploaded
= zero;
848 client_total_downloaded
= zero;
849 client_session_uploaded
= zero;
850 client_session_downloaded
= zero;
851 client_upload_rate
= Rate.new_rate
();
852 client_downloaded_rate
= Rate.new_rate
();
853 client_connect_time
= last_time
();
854 client_blocks_sent
= [];
855 client_new_chunks
= [];
858 client_alrd_sent_interested
= false;
859 client_alrd_sent_notinterested
= false;
860 client_interesting
= false;
861 client_incoming
= false;
862 client_registered_bitfield
= false;
863 client_last_optimist
= 0;
865 client_cache_extension
= false;
866 client_fast_extension
= false;
867 client_utorrent_extension
= false;
868 client_azureus_messaging_protocol
= false;
870 dummy_client_impl
with
872 impl_client_ops
= client_ops
;
873 impl_client_upload
= None
;
875 c.client_connection_control
.control_min_reask
<- 120;
876 check_client_country_code c;
878 Hashtbl.add
file.file_clients kind
c;
879 file.file_clients_num
<- file.file_clients_num
+ 1;
880 file_add_source
(as_file file) (as_client c);
883 let remove_file file =
884 Hashtbl.remove
files_by_uid file.file_id
;
885 current_files := List2.removeq
file !current_files
887 let remove_client c =
888 Hashtbl.remove
c.client_file
.file_clients
c.client_host
;
889 c.client_file
.file_clients_num
<- c.client_file
.file_clients_num
- 1;
890 file_remove_source
(as_file c.client_file
) (as_client c)
892 let remove_tracker url file =
893 if !verbose_msg_servers
then
894 List.iter (fun tracker
->
895 lprintf_nl "Old tracker list: %s" (show_tracker_url tracker
.tracker_url
)
896 ) file.file_trackers
;
897 List.iter (fun bad_tracker
->
898 if bad_tracker
.tracker_url
= url then
899 file.file_trackers
<- List2.remove_first bad_tracker
file.file_trackers
;
900 ) file.file_trackers
;
901 if !verbose_msg_servers
then
902 List.iter (fun tracker
->
903 lprintf_nl "New tracker list: %s" (show_tracker_url tracker
.tracker_url
)
906 let tracker_is_enabled t =
907 match t.tracker_status
with
909 | Disabled_failure
(i
,_
) ->
910 if !!tracker_retries
= 0 || i
< !!tracker_retries
then true else false
913 let torrents_directory = "torrents"
914 let new_torrents_directory = Filename.concat
torrents_directory "incoming"
915 let downloads_directory = Filename.concat
torrents_directory "downloads"
916 let tracked_directory = Filename.concat
torrents_directory "tracked"
917 let seeded_directory = Filename.concat
torrents_directory "seeded"
918 let old_directory = Filename.concat
torrents_directory "old"
920 (*************************************************************
922 Define a function to be called when the "mem_stats" command
923 is used to display information on structure footprint.
925 **************************************************************)
928 Heap.add_memstat
"BittorrentGlobals" (fun level
buf ->
929 Printf.bprintf
buf "Number of old files: %d\n" (List.length
!!old_files
);
930 let downloads = ref 0 in
931 let tracked = ref 0 in
932 let seeded = ref 0 in
933 Unix2.iter_directory
(fun file -> incr
downloads ) downloads_directory;
934 Unix2.iter_directory
(fun file -> incr
tracked ) tracked_directory;
935 Unix2.iter_directory
(fun file -> incr
seeded ) seeded_directory;
936 Printf.bprintf
buf "Files in downloads directory: %d\n" ! downloads;
937 Printf.bprintf
buf "Files in tracked directory: %d\n" ! tracked;
938 Printf.bprintf
buf "Files in seeded directory: %d\n" ! seeded;
939 Printf.bprintf
buf "files_by_uid: %d\n" (Hashtbl.length
files_by_uid);
940 Printf.bprintf
buf "ft_by_num: %d\n" (Hashtbl.length
ft_by_num);