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 can_handle_tracker t
=
234 String2.check_prefix
(String.lowercase t
.tracker_url
) "http://"
236 let rec set_trackers file file_trackers
=
237 match file_trackers
with
240 if not
(List.exists
(fun tracker
->
241 tracker
.tracker_url
= url
242 ) file
.file_trackers
) then
245 tracker_interval
= 600;
246 tracker_min_interval
= 600;
247 tracker_last_conn
= 0;
248 tracker_last_clients_num
= 0;
249 tracker_torrent_downloaded
= 0;
250 tracker_torrent_complete
= 0;
251 tracker_torrent_incomplete
= 0;
252 tracker_torrent_total_clients_count
= 0;
253 tracker_torrent_last_dl_req
= 0;
256 tracker_status
= Enabled
258 if not
(can_handle_tracker t) then
259 t.tracker_status
<- Disabled_mld
(intern
"Tracker type not supported");
260 file
.file_trackers
<- t :: file
.file_trackers
;
263 let new_file file_id
t torrent_diskname file_temp
file_state user group
=
265 Hashtbl.find
files_by_uid file_id
267 let file_fd = create_temp_file file_temp
t.torrent_files
file_state in
269 file_tracker_connected
= false;
270 file_file
= file_impl
;
271 file_piece_size
= t.torrent_piece_size
;
273 file_name
= t.torrent_name
;
274 file_comment
= t.torrent_comment
;
275 file_created_by
= t.torrent_created_by
;
276 file_creation_date
= t.torrent_creation_date
;
277 file_modified_by
= t.torrent_modified_by
;
278 file_encoding
= t.torrent_encoding
;
279 file_clients_num
= 0;
280 file_clients
= Hashtbl.create
113;
283 file_chunks
= t.torrent_pieces
;
284 file_files
= (List.map
(fun (file,size
) -> (file,size
,None
)) t.torrent_files
);
285 file_blocks_downloaded
= [];
286 file_uploaded
= Int64.zero
;
287 file_torrent_diskname
= torrent_diskname
;
288 file_completed_hook
= (fun _
-> ());
290 file_session_uploaded
= Int64.zero
;
291 file_session_downloaded
= Int64.zero
;
294 impl_file_owner
= user
;
295 impl_file_group
= group
;
296 impl_file_fd
= Some
file_fd;
297 impl_file_size
= t.torrent_length
;
298 impl_file_downloaded
= Int64.zero
;
299 impl_file_val
= file;
300 impl_file_ops
= file_ops
;
301 impl_file_age
= last_time
();
302 impl_file_best_name
= t.torrent_name
;
305 if t.torrent_announce_list
<> [] then
306 set_trackers file t.torrent_announce_list
308 set_trackers file [t.torrent_announce
];
309 if file_state <> FileShared
then begin
310 let kernel = CommonSwarming.create_swarmer file_temp
(file_size file) in
311 let swarmer = CommonSwarming.create
kernel (as_file file)
312 file.file_piece_size
in
313 file.file_swarmer
<- Some
swarmer;
314 CommonSwarming.set_verified
swarmer (fun _ num
->
315 file.file_blocks_downloaded
<- (num
) ::
316 file.file_blocks_downloaded
;
317 file_must_update file;
318 (*Automatically send Have to ALL clients once a piece is verified
319 NB : will probably have to check if client can be interested*)
320 Hashtbl.iter
(fun _ c
->
322 if c
.client_registered_bitfield
then
324 match c
.client_bitmap
with
327 if not
(Bitv.get
bitmap num
) then
328 send_client c
(Have
(Int64.of_int num
));
329 check_if_interesting file c
334 CommonSwarming.set_verifier
swarmer (Verification
335 (Array.map
(fun sha1
-> Sha1 sha1
) file.file_chunks
));
337 current_files := file :: !current_files;
338 Hashtbl.add
files_by_uid file_id
file;
339 file_add file_impl
file_state;
340 must_share_file file;
343 let new_download file_id
t torrent_diskname user
=
344 let file_temp = Filename.concat
!!DO.temp_directory
345 (Printf.sprintf
"BT-%s" (Sha1.to_string file_id
)) in
346 new_file file_id
t torrent_diskname
file_temp FileDownloading user
348 let ft_by_num = Hashtbl.create
13
349 let ft_counter = ref 0
351 let new_ft file_name user
=
356 ft_filename
= file_name
;
357 ft_retry
= (fun _
-> ());
360 impl_file_owner
= user
;
361 impl_file_group
= user
.user_default_group
;
363 impl_file_size
= zero
;
364 impl_file_downloaded
= Int64.zero
;
366 impl_file_ops
= ft_ops
;
367 impl_file_age
= last_time
();
368 impl_file_best_name
= file_name
;
371 Hashtbl.add
ft_by_num !ft_counter ft;
372 file_add file_impl FileDownloading
;
375 let _dot_string s h
=
376 let len = String.length s
in
378 let ic = int_of_char c
in
379 if ic >= 65 && ic <= 70 then
380 string_of_int
(ic - 55)
382 if ic >= 97 && ic <= 102 then
383 string_of_int
(ic - 87)
385 Printf.sprintf
"%c" c
389 if i
< len then begin
390 if h
then Buffer.add_string b
(char2hex s
.[i
])
391 else Buffer.add_char b s
.[i
];
392 if i
< len-1 then Buffer.add_char b '
.'
;
396 Buffer.contents
(iter 0 (Buffer.create
(len*2)))
404 let dot_string_of_list s l
=
405 let buf = Buffer.create
(List.length l
) in
406 List.iter (fun i
-> Buffer.add_char
buf s
.[i
]) l
;
407 dot_string (Buffer.contents
buf)
409 let dot_string_of_string s
=
410 let buf = Buffer.create
20 in
411 let found_non_int = ref false in
412 String.iter (fun s
->
415 if !found_non_int then Buffer.add_char
buf '
.'
;
416 found_non_int := false;
417 Buffer.add_char
buf s
418 | _
-> found_non_int := true
422 (* check string s for char c (dec) at position l (list) *)
423 let check_all s c l
=
424 let ch = char_of_int c
in
425 List.for_all
(fun i
-> s
.[i
] = ch) l
429 ignore
(int_of_string
(String.sub s p
1));
433 let strip_leading_zeroes s
=
434 let l = String.length s
in
437 else if s
.[i
] <> '
0'
then String.sub s i
(l - i
)
441 (* from azureus/gpl *)
442 let decode_az_style s
=
443 if check_all s
45 [0;7] then begin
444 let s_id = (String.sub s
1 2) in
447 | "AR" -> Brand_arctic
448 | "AZ" -> Brand_azureus
449 | "BB" -> Brand_bitbuddy
450 | "BC" -> Brand_bitcomet
451 | "BR" -> Brand_bitrocket
452 | "BS" -> Brand_btslave
453 | "BX" -> Brand_bittorrentx
454 | "CT" (* ctorrent *)
455 | "CD" -> Brand_ctorrent
456 | "lt" (* libtorrent *)
457 | "LT" -> Brand_libtorrent
458 | "MT" -> Brand_moonlighttorrent
459 | "SB" -> Brand_swiftbit
460 | "SN" -> Brand_sharenet
461 | "SS" -> Brand_swarmscope
462 | "SZ" (* shareaza *)
463 | "S~" -> Brand_shareaza
464 | "TN" -> Brand_torrentdotnet
465 | "TS" -> Brand_torrentstorm
466 | "XT" -> Brand_xantorrent
467 | "ZT" -> Brand_ziptorrent
468 | "bk" -> Brand_bitkitten
469 | "MP" -> Brand_moopolice
470 | "UM" -> Brand_utorrent_mac
471 | "UT" -> Brand_utorrent
472 | "KT" -> Brand_ktorrent
473 | "LP" -> Brand_lphant
474 | "TR" -> Brand_transmission
475 | "HN" -> Brand_hydranode
476 | "RT" -> Brand_retriever
477 | "PC" -> Brand_cachelogic
478 | "ES" -> Brand_electricsheep
479 | "qB" -> Brand_qbittorrent
481 | "UL" -> Brand_uleecher
482 | "XX" -> Brand_xtorrent
485 | "AX" -> Brand_bitpump
486 | "DE" -> Brand_deluge
487 | "TT" -> Brand_tuotu
488 | "SD" (* Thunder (aka XùnLéi) *)
489 | "XL" -> Brand_xunlei
490 | "FT" -> Brand_foxtorrent
491 | "BF" -> Brand_bitflu
492 | "OS" -> Brand_oneswarm
493 | "LW" -> Brand_limewire
494 | "HL" -> Brand_halite
496 | "PD" -> Brand_pando
499 if brand = Brand_unknown
then None
else
504 | Brand_bitcomet
-> (String.sub s
4 1) ^
"." ^
(String.sub s
5 2)
509 | Brand_utorrent
-> (String.sub s
3 1) ^
"." ^
(String.sub s
4 1) ^
"." ^
(String.sub s
5 1)
511 | Brand_transmission
-> (String.sub s
3 1) ^
"." ^
(String.sub s
4 2)
513 | Brand_ctorrent
-> (strip_leading_zeroes (String.sub s
3 2)) ^
"." ^
(strip_leading_zeroes(String.sub s
5 2))
514 (* 3.4.5->[R=RC.6|D=Dev|''] *)
516 let x = match s
.[5] with
517 | 'R'
-> " RC" ^
(String.sub s
6 1)
521 (String.sub s
3 1) ^
"." ^
(String.sub s
4 1) ^
x
523 | Brand_bitrocket
-> (String.sub s
3 1) ^
"." ^
(String.sub s
4 1) ^
"(" ^
(String.sub s
5 2) ^
")"
525 | Brand_xtorrent
-> "v" ^
(strip_leading_zeroes (String.sub s
3 4))
526 (* BitFlu is too complicated YMDD (Y+M -> HEX) eg. 7224 is 2007.02.24 *)
529 | _
-> (dot_string (String.sub s
3 4))
531 Some
(brand, version)
535 let decode_tornado_style s
=
536 if s
.[5] = '
-'
then begin
539 | 'T'
-> Brand_bittornado
540 | 'S'
-> Brand_shadow
543 | 'O'
-> Brand_osprey
544 | 'R'
-> Brand_tribler
549 if s
.[5] ='
-'
&& s
.[6] ='
-'
&& s
.[7] ='
-'
then begin
550 let brand = check_brand s
.[0] in
551 if not
(brand = Brand_unknown
) then
552 bv := Some
(brand, (dot_string_h (String.sub s
1 3)));
554 else if s
.[6] = (char_of_int
48) then begin
555 let brand = check_brand s
.[0] in
556 if not
(brand = Brand_unknown
) then
557 bv := Some
(brand, ("LM " ^
dot_string_h (String.sub s
1 3)));
563 let decode_mainline_style s
=
564 if check_all s
45 [2;7] && check_int s
1 then begin
568 | 'M'
-> Brand_mainline
571 if brand = Brand_unknown
then None
572 else Some
(brand, (dot_string_of_string (String.sub s
1 6)))
576 let decode_simple_style s
=
577 let simple_list = ref
578 [ (0, "martini", Brand_martiniman
, "");
579 (0, "oernu", Brand_btugaxp
, "");
580 (0, "BTDWV-", Brand_deadmanwalking
, "");
581 (0, "PRC.P---", Brand_btplus
, "II");
582 (0, "P87.P---", Brand_btplus
, "");
583 (0, "S587Plus", Brand_btplus
, "");
584 (5, "Azureus", Brand_azureus
, "2.0.3.2");
585 (0, "-G3", Brand_g3torrent
, "");
586 (0, "-AR", Brand_arctic
, "");
587 (4, "btfans", Brand_simplebt
, "");
588 (0, "btuga", Brand_btugaxp
, "");
589 (0, "BTuga", Brand_btugaxp
, "");
590 (0, "DansClient", Brand_xantorrent
, "");
591 (0, "Deadman Walking-", Brand_deadmanwalking
, "");
592 (0, "346-", Brand_torrenttopia
, "");
593 (0, "271-", Brand_greedbt
, "2.7.1");
594 (10, "BG", Brand_btgetit
, "");
595 (0, "a00---0", Brand_swarmy
, "");
596 (0, "a02---0", Brand_swarmy
, "");
597 (0, "10-------", Brand_jvtorrent
, "");
598 (0, "T00---0", Brand_teeweety
, "");
599 (0, "LIME", Brand_limewire
, "");
600 (0, "AZ2500BT", Brand_btyrant
, "");
601 (0, "Mbrst", Brand_burst
, (dot_string_of_list s
[5;7;9]));
602 (0, "Plus", Brand_plus
, (dot_string_of_list s
[4;5;6]));
603 (0, "OP", Brand_opera
, (dot_string(String.sub s
2 4)));
604 (0, "eX", Brand_exeem
, (String.sub s
2 18));
605 (0, "turbobt", Brand_turbobt
, (String.sub s
7 5));
606 (0, "btpd", Brand_btpd
, (dot_string(String.sub s
5 3)));
607 (0, "XBT", Brand_xbt
, (dot_string(String.sub s
3 3)));
608 (0, "-FG", Brand_flashget
, (dot_string(String.sub s
4 3)));
609 (0, "-SP", Brand_bitspirit
, (dot_string(String.sub s
3 3)));
612 let len = List.length
!simple_list in
614 if pos
>= len then None
616 let (x,y
,z
,v
) = List.nth
!simple_list pos
in
617 if (String.sub s
x (String.length y
)) = y
then Some
(z
,v
)
624 let minor = Char.code s
.[1] in
625 Printf.sprintf
"%d.%d.%d" (Char.code s
.[0]) (minor / 10) (minor mod 10) in
626 if "RS" = String.sub s
2 2 then
627 Some
(Brand_rufus
, release s
)
631 if "BOW" = String.sub s
0 3 ||
632 (check_all s
45 [0;7] && "BOW" = String.sub s
1 3) then
633 Some
(Brand_bitsonwheels
, (String.sub s
4 3))
637 if ("BTM" = String.sub s
0 3) && ("BTuga" = String.sub s
5 5) then
638 Some
(Brand_btuga
, dot_string(String.sub s
3 2))
641 let decode_shadow s
=
642 if "S" = String.sub s
0 1 then begin
644 if check_all s
45 [6;7;8] then begin
645 let i1 = int_of_string
("0x" ^
String.sub s
1 1) in
646 let i2 = int_of_string
("0x" ^
String.sub s
2 1) in
647 let i3 = int_of_string
("0x" ^
String.sub s
3 1) in
648 bv := Some
(Brand_shadow
, (Printf.sprintf
"%d.%d.%d" i1 i2 i3))
651 if s
.[8] = (char_of_int
0) then begin
652 let i1 = int_of_char s
.[1] in
653 let i2 = int_of_char s
.[2] in
654 let i3 = int_of_char s
.[3] in
655 bv := Some
(Brand_shadow
, (Printf.sprintf
"%d.%d.%d" i1 i2 i3))
661 let decode_bitspirit s
=
662 if "BS" = String.sub s
2 2 then begin
664 if s
.[1] = (char_of_int
0) then bv := Some
(Brand_bitspirit
, "v1");
665 if s
.[1] = (char_of_int
2) then bv := Some
(Brand_bitspirit
, "v2");
666 if s
.[1] = (char_of_int
3) then bv := Some
(Brand_bitspirit
, "v3");
672 if 'U'
= s
.[0] && s
.[8] = '
-'
then
673 Some
(Brand_upnp
, (dot_string (String.sub s
1 3)))
676 let decode_old_bitcomet s
=
677 let bitcomet = String.sub s
0 4 in
678 if "exbc" = bitcomet || "FUTB" = bitcomet || "xUTB" = bitcomet then
679 let brand = if "LORD" = String.sub s
6 4 then
680 Brand_bitlord
else Brand_bitcomet
682 let versionMajorNumber = int_of_char s
.[4] in
683 let versionMinorNubmer =
684 match versionMajorNumber with
685 0 -> (int_of_char s
.[5])
686 | _
-> ((int_of_char s
.[5]) mod 10)
688 let version = Printf.sprintf
"%d.%d"
689 versionMajorNumber versionMinorNubmer in
690 Some
(brand, version)
693 let decode_shareaza s
=
694 let rec not_zeros pos
=
695 if pos
> 15 then true else
696 if s
.[pos
] = (char_of_int
0) then false else not_zeros (pos
+1)
698 let rec weird_crap pos
=
699 if pos
> 19 then true else
700 let i1 = (int_of_char s
.[pos
]) in
701 let i2 = (int_of_char s
.[(pos
mod 16)]) in
702 let i3 = (int_of_char s
.[(15 - (pos
mod 16))]) in
703 if not
(i1 = (i2 lxor i3)) then false else weird_crap (pos
+1)
705 if (not_zeros 0) && (weird_crap 16) then Some
(Brand_shareaza
, "") else None
707 let decode_non_zero s
=
708 let max_pos = ((String.length s
) - 1) in
709 let zero = char_of_int
0 in
710 let rec find_non_zero pos
=
711 if pos
> max_pos then max_pos else
712 if not
(s
.[pos
] = zero) then pos
else
713 find_non_zero (pos
+1)
716 (match find_non_zero 0 with
717 8 -> (if "UDP0" = String.sub s
16 4 then
718 bv := Some
(Brand_bitcomet
, "UDP");
719 if "HTTPBT" = String.sub s
14 6 then
720 bv := Some
(Brand_bitcomet
, "HTTP"));
721 | 9 -> if check_all s
3 [9;10;11] then
722 bv := Some
(Brand_snark
, "");
723 | 12 -> if check_all s
97 [12;13] then
724 bv := Some
(Brand_experimental
, "3.2.1b2")
726 if check_all s
0 [12;13] then
727 bv := Some
(Brand_experimental
, "3.1")
729 bv := Some
(Brand_mainline
, "")
735 (* format is : "-ML" ^ version ( of unknown length) ^ "-" ^ random bytes ( of unknown length) *)
736 let decode_mldonkey_style s
=
737 if '
-'
= s
.[0] then begin
738 let s_id = String.sub s
1 2 in
741 | "ML" -> Brand_mldonkey
744 if brand = Brand_unknown
then None
else
746 (try String.index_from s
3 '
-'
749 let version = String.sub s
3 len in
750 Some
(brand, version)
756 decode_tornado_style;
757 decode_mainline_style;
766 decode_mldonkey_style;
771 let parse_software s
=
772 let default = (Brand_unknown
, "") in
775 [] -> 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
);
777 | d
:: t -> match (d s
) with
779 | Some
bv -> let (brand, version) = bv in
780 if !verbose_msg_clienttags
then
781 lprintf_nl "BTKC:\"%s\"; ID: \"%s\"; version:\"%s\"" (String.escaped s
) (brand_to_string
brand) version;
784 if Sha1.direct_of_string s
= Sha1.null
then
787 try iter decoder_list
790 let check_client_country_code c
=
791 if Geoip.active
() then
792 match c
.client_country_code
with
794 c
.client_country_code
<-
795 Geoip.get_country_code_option
(fst c
.client_host
)
798 let new_client file peer_id kind cc
=
800 let c = Hashtbl.find
file.file_clients kind
in
801 let old_ip = fst
c.client_host
in
802 c.client_host
<- kind
;
803 if old_ip <> Ip.null
&& old_ip <> fst
c.client_host
then
805 c.client_country_code
<- None
;
806 check_client_country_code c
810 let brand, release = parse_software (Sha1.direct_to_string peer_id
) in
812 client_client
= impl;
813 client_sock
= NoConnection
;
814 client_upload_requests
= [];
815 client_connection_control
= new_connection_control
(());
818 client_country_code
= cc
;
819 client_choked
= true;
820 client_received_peer_id
= false;
821 client_sent_choke
= false;
822 client_interested
= false;
823 client_uploader
= None
;
825 client_ranges_sent
= [];
826 client_range_waiting
= None
;
828 client_uid
= peer_id
;
829 client_brand
= brand;
830 client_release
= release;
831 client_bitmap
= None
;
832 client_allowed_to_write
= zero;
833 client_total_uploaded
= zero;
834 client_total_downloaded
= zero;
835 client_session_uploaded
= zero;
836 client_session_downloaded
= zero;
837 client_upload_rate
= Rate.new_rate
();
838 client_downloaded_rate
= Rate.new_rate
();
839 client_connect_time
= last_time
();
840 client_blocks_sent
= [];
841 client_new_chunks
= [];
844 client_alrd_sent_interested
= false;
845 client_alrd_sent_notinterested
= false;
846 client_interesting
= false;
847 client_incoming
= false;
848 client_registered_bitfield
= false;
849 client_last_optimist
= 0;
851 client_cache_extension
= false;
852 client_fast_extension
= false;
853 client_utorrent_extension
= false;
854 client_azureus_messaging_protocol
= false;
856 dummy_client_impl
with
858 impl_client_ops
= client_ops
;
859 impl_client_upload
= None
;
861 c.client_connection_control
.control_min_reask
<- 120;
862 check_client_country_code c;
864 Hashtbl.add
file.file_clients kind
c;
865 file.file_clients_num
<- file.file_clients_num
+ 1;
866 file_add_source
(as_file file) (as_client c);
869 let remove_file file =
870 Hashtbl.remove
files_by_uid file.file_id
;
871 current_files := List2.removeq
file !current_files
873 let remove_client c =
874 Hashtbl.remove
c.client_file
.file_clients
c.client_host
;
875 c.client_file
.file_clients_num
<- c.client_file
.file_clients_num
- 1;
876 file_remove_source
(as_file c.client_file
) (as_client c)
878 let remove_tracker url
file =
879 if !verbose_msg_servers
then
880 List.iter (fun tracker
->
881 lprintf_nl "Old tracker list :%s" tracker
.tracker_url
882 ) file.file_trackers
;
883 List.iter (fun bad_tracker
->
884 if bad_tracker
.tracker_url
= url
then
885 file.file_trackers
<- List2.remove_first bad_tracker
file.file_trackers
;
886 ) file.file_trackers
;
887 if !verbose_msg_servers
then
888 List.iter (fun tracker
->
889 lprintf_nl "New tracker list :%s" tracker
.tracker_url
892 let tracker_is_enabled t =
893 match t.tracker_status
with
895 | Disabled_failure
(i
,_
) ->
896 if !!tracker_retries
= 0 || i
< !!tracker_retries
then true else false
899 let torrents_directory = "torrents"
900 let new_torrents_directory = Filename.concat
torrents_directory "incoming"
901 let downloads_directory = Filename.concat
torrents_directory "downloads"
902 let tracked_directory = Filename.concat
torrents_directory "tracked"
903 let seeded_directory = Filename.concat
torrents_directory "seeded"
904 let old_directory = Filename.concat
torrents_directory "old"
906 (*************************************************************
908 Define a function to be called when the "mem_stats" command
909 is used to display information on structure footprint.
911 **************************************************************)
914 Heap.add_memstat
"BittorrentGlobals" (fun level
buf ->
915 Printf.bprintf
buf "Number of old files: %d\n" (List.length
!!old_files
);
916 let downloads = ref 0 in
917 let tracked = ref 0 in
918 let seeded = ref 0 in
919 Unix2.iter_directory
(fun file -> incr
downloads ) downloads_directory;
920 Unix2.iter_directory
(fun file -> incr
tracked ) tracked_directory;
921 Unix2.iter_directory
(fun file -> incr
seeded ) seeded_directory;
922 Printf.bprintf
buf "Files in downloads directory: %d\n" ! downloads;
923 Printf.bprintf
buf "Files in tracked directory: %d\n" ! tracked;
924 Printf.bprintf
buf "Files in seeded directory: %d\n" ! seeded;
925 Printf.bprintf
buf "files_by_uid: %d\n" (Hashtbl.length
files_by_uid);
926 Printf.bprintf
buf "ft_by_num: %d\n" (Hashtbl.length
ft_by_num);