20 |
open Int64ops |
open Int64ops |
21 |
open Printf2 |
open Printf2 |
22 |
open Md4 |
open Md4 |
23 |
|
|
24 |
open CommonSwarming |
open CommonSwarming |
25 |
open CommonInteractive |
open CommonInteractive |
26 |
open CommonClient |
open CommonClient |
27 |
open CommonUser |
open CommonUser |
28 |
open CommonTypes |
open CommonTypes |
29 |
|
open CommonOptions |
30 |
open CommonComplexOptions |
open CommonComplexOptions |
31 |
open CommonServer |
open CommonServer |
32 |
open CommonResult |
open CommonResult |
34 |
open BasicSocket |
open BasicSocket |
35 |
open CommonGlobals |
open CommonGlobals |
36 |
open Options |
open Options |
37 |
|
|
38 |
open BTRate |
open BTRate |
39 |
open BTTypes |
open BTTypes |
40 |
open BTOptions |
open BTOptions |
41 |
open BTProtocol |
open BTProtocol |
42 |
open CommonDownloads |
open CommonDownloads |
43 |
open CommonNetwork |
open CommonNetwork |
44 |
open TcpMessages |
open TcpMessages |
45 |
|
|
46 |
|
|
47 |
let send_client c m = send_client c.client_sock m |
let send_client c m = send_client c.client_sock m |
48 |
|
|
49 |
let as_ft file = as_file file.ft_file |
let as_ft file = as_file file.ft_file |
50 |
let ft_num file = file_num (as_ft file) |
let ft_num file = file_num (as_ft file) |
51 |
let ft_size file = file.ft_file.impl_file_size |
let ft_size file = file.ft_file.impl_file_size |
52 |
let ft_state file = file_state (as_ft file) |
let ft_state file = file_state (as_ft file) |
53 |
|
|
54 |
let as_file file = as_file file.file_file |
let as_file file = as_file file.file_file |
55 |
let file_size file = file.file_file.impl_file_size |
let file_size file = file.file_file.impl_file_size |
56 |
let file_downloaded file = file_downloaded (as_file file) |
let file_downloaded file = file_downloaded (as_file file) |
57 |
let file_age file = file.file_file.impl_file_age |
let file_age file = file.file_file.impl_file_age |
58 |
let file_fd file = file.file_file.impl_file_fd |
let file_fd file = file.file_file.impl_file_fd |
59 |
let file_disk_name file = file_disk_name (as_file file) |
let file_disk_name file = file_disk_name (as_file file) |
60 |
let file_state file = file_state (as_file file) |
let file_state file = file_state (as_file file) |
61 |
let file_num file = file_num (as_file file) |
let file_num file = file_num (as_file file) |
62 |
let file_must_update file = file_must_update (as_file file) |
let file_must_update file = file_must_update (as_file file) |
63 |
|
|
64 |
|
|
65 |
let set_file_state file state = |
let set_file_state file state = |
66 |
CommonFile.set_file_state (as_file file) state |
CommonFile.set_file_state (as_file file) state |
67 |
|
|
68 |
let as_client c = as_client c.client_client |
let as_client c = as_client c.client_client |
70 |
|
|
71 |
let set_client_state client state = |
let set_client_state client state = |
72 |
CommonClient.set_client_state (as_client client) state |
CommonClient.set_client_state (as_client client) state |
73 |
|
|
74 |
let set_client_disconnected client = |
let set_client_disconnected client = |
75 |
CommonClient.set_client_disconnected (as_client client) |
CommonClient.set_client_disconnected (as_client client) |
76 |
|
|
77 |
let client_num c = client_num (as_client c) |
let client_num c = client_num (as_client c) |
78 |
|
|
79 |
|
|
80 |
let network = new_network "BT" "BitTorrent" |
let network = new_network "BT" "BitTorrent" |
81 |
[ |
[ |
82 |
NetworkHasMultinet; |
NetworkHasMultinet; |
83 |
NetworkHasUpload; |
NetworkHasUpload; |
84 |
|
NetworkHasStats; |
85 |
] |
] |
86 |
|
|
87 |
let connection_manager = network.network_connection_manager |
let connection_manager = network.network_connection_manager |
88 |
|
|
89 |
let (shared_ops : file CommonShared.shared_ops) = |
let (shared_ops : file CommonShared.shared_ops) = |
90 |
CommonShared.new_shared_ops network |
CommonShared.new_shared_ops network |
91 |
|
|
92 |
let (server_ops : server CommonServer.server_ops) = |
let (server_ops : server CommonServer.server_ops) = |
93 |
CommonServer.new_server_ops network |
CommonServer.new_server_ops network |
94 |
|
|
95 |
let (room_ops : server CommonRoom.room_ops) = |
let (room_ops : server CommonRoom.room_ops) = |
96 |
CommonRoom.new_room_ops network |
CommonRoom.new_room_ops network |
97 |
|
|
98 |
let (user_ops : user CommonUser.user_ops) = |
let (user_ops : user CommonUser.user_ops) = |
99 |
CommonUser.new_user_ops network |
CommonUser.new_user_ops network |
100 |
|
|
101 |
let (file_ops : file CommonFile.file_ops) = |
let (file_ops : file CommonFile.file_ops) = |
102 |
CommonFile.new_file_ops network |
CommonFile.new_file_ops network |
103 |
|
|
104 |
let (ft_ops : ft CommonFile.file_ops) = |
let (ft_ops : ft CommonFile.file_ops) = |
105 |
CommonFile.new_file_ops network |
CommonFile.new_file_ops network |
106 |
|
|
107 |
let (client_ops : client CommonClient.client_ops) = |
let (client_ops : client CommonClient.client_ops) = |
108 |
CommonClient.new_client_ops network |
CommonClient.new_client_ops network |
109 |
|
|
110 |
module DO = CommonOptions |
module DO = CommonOptions |
111 |
|
|
112 |
let current_files = ref ([] : BTTypes.file list) |
let current_files = ref ([] : BTTypes.file list) |
113 |
|
|
114 |
let listen_sock = ref (None : TcpServerSocket.t option) |
let listen_sock = ref (None : TcpServerSocket.t option) |
115 |
|
|
116 |
let files_by_uid = Hashtbl.create 13 |
let files_by_uid = Hashtbl.create 13 |
117 |
|
|
118 |
let max_range_len = Int64.of_int (1 lsl 14) |
let max_range_len = Int64.of_int (1 lsl 14) |
119 |
let max_request_len = Int64.of_int (1 lsl 16) |
let max_request_len = Int64.of_int (1 lsl 16) |
120 |
|
|
121 |
let check_if_interesting file c = |
let check_if_interesting file c = |
122 |
|
|
123 |
if not c.client_alrd_sent_notinterested then |
if not c.client_alrd_sent_notinterested then |
124 |
let up = match c.client_uploader with |
let up = match c.client_uploader with |
125 |
None -> assert false |
None -> assert false |
126 |
| Some up -> up |
| Some up -> up |
127 |
in |
in |
128 |
let swarmer = Int64Swarmer.uploader_swarmer up in |
let swarmer = Int64Swarmer.uploader_swarmer up in |
129 |
let must_send = |
let must_send = |
130 |
(* The client has nothing to propose to us *) |
(* The client has nothing to propose to us *) |
131 |
(not (Int64Swarmer.is_interesting up )) && |
(not (Int64Swarmer.is_interesting up )) && |
132 |
(* All the requested ranges are useless *) |
(* All the requested ranges are useless *) |
141 |
(* The current block is also useless *) |
(* The current block is also useless *) |
142 |
(match c.client_block with |
(match c.client_block with |
143 |
None -> true |
None -> true |
144 |
| Some b -> |
| Some b -> |
145 |
let block_num = Int64Swarmer.block_num swarmer b in |
let block_num = Int64Swarmer.block_num swarmer b in |
146 |
let bitmap = Int64Swarmer.verified_bitmap swarmer in |
let bitmap = Int64Swarmer.verified_bitmap swarmer in |
147 |
bitmap.[block_num] <> '3') |
bitmap.[block_num] <> '3') |
165 |
Unix32.create_multifile file_temp |
Unix32.create_multifile file_temp |
166 |
[Unix.O_RDWR; Unix.O_CREAT] 0o666 file_files |
[Unix.O_RDWR; Unix.O_CREAT] 0o666 file_files |
167 |
else |
else |
168 |
Unix32.create_rw file_temp |
Unix32.create_rw file_temp |
169 |
in |
in |
170 |
if Unix32.destroyed file_fd then |
if Unix32.destroyed file_fd then |
171 |
failwith |
failwith |
172 |
(Printf.sprintf |
(Printf.sprintf |
173 |
"create_temp_file: Unix32.create returned a destroyed FD for %s\n" |
"create_temp_file: Unix32.create returned a destroyed FD for %s\n" |
174 |
file_temp); |
file_temp); |
182 |
tracker_last_clients_num = 0; |
tracker_last_clients_num = 0; |
183 |
} ) file_trackers) @ file.file_trackers |
} ) file_trackers) @ file.file_trackers |
184 |
|
|
185 |
let new_file file_id t torrent_diskname file_temp file_state = |
let new_file file_id t torrent_diskname file_temp file_state = |
186 |
try |
try |
187 |
Hashtbl.find files_by_uid file_id |
Hashtbl.find files_by_uid file_id |
188 |
with Not_found -> |
with Not_found -> |
189 |
let file_fd = create_temp_file file_temp t.torrent_files in |
let file_fd = create_temp_file file_temp t.torrent_files in |
190 |
let rec file = { |
let rec file = { |
191 |
file_tracker_connected = false; |
file_tracker_connected = false; |
211 |
impl_file_downloaded = Int64.zero; |
impl_file_downloaded = Int64.zero; |
212 |
impl_file_val = file; |
impl_file_val = file; |
213 |
impl_file_ops = file_ops; |
impl_file_ops = file_ops; |
214 |
impl_file_age = last_time (); |
impl_file_age = last_time (); |
215 |
impl_file_best_name = t.torrent_name; |
impl_file_best_name = t.torrent_name; |
216 |
} |
} |
217 |
in |
in |
219 |
if file_state <> FileShared then begin |
if file_state <> FileShared then begin |
220 |
let kernel = Int64Swarmer.create_swarmer file_temp (file_size file) |
let kernel = Int64Swarmer.create_swarmer file_temp (file_size file) |
221 |
(min max_range_len file.file_piece_size) in |
(min max_range_len file.file_piece_size) in |
222 |
let swarmer = Int64Swarmer.create kernel (as_file file) |
let swarmer = Int64Swarmer.create kernel (as_file file) |
223 |
file.file_piece_size in |
file.file_piece_size in |
224 |
file.file_swarmer <- Some swarmer; |
file.file_swarmer <- Some swarmer; |
225 |
Int64Swarmer.set_verified swarmer (fun _ num -> |
Int64Swarmer.set_verified swarmer (fun _ num -> |
226 |
file.file_blocks_downloaded <- (num) :: |
file.file_blocks_downloaded <- (num) :: |
227 |
file.file_blocks_downloaded; |
file.file_blocks_downloaded; |
228 |
file_must_update file; |
file_must_update file; |
229 |
(*Automatically send Have to ALL clients once a piece is verified |
(*Automatically send Have to ALL clients once a piece is verified |
230 |
NB : will probably have to check if client can be interested*) |
NB : will probably have to check if client can be interested*) |
231 |
Hashtbl.iter (fun _ c -> |
Hashtbl.iter (fun _ c -> |
232 |
|
|
233 |
if c.client_registered_bitfield then |
if c.client_registered_bitfield then |
234 |
begin |
begin |
235 |
match c.client_bitmap with |
match c.client_bitmap with |
237 |
| Some bitmap -> |
| Some bitmap -> |
238 |
if (bitmap.[num] <> '1') then |
if (bitmap.[num] <> '1') then |
239 |
send_client c (Have (Int64.of_int num)); |
send_client c (Have (Int64.of_int num)); |
240 |
check_if_interesting file c |
check_if_interesting file c |
241 |
end |
end |
242 |
) file.file_clients |
) file.file_clients |
243 |
|
|
244 |
); |
); |
245 |
Int64Swarmer.set_verifier swarmer (Verification |
Int64Swarmer.set_verifier swarmer (Verification |
246 |
(Array.map (fun sha1 -> Sha1 sha1) file.file_chunks)); |
(Array.map (fun sha1 -> Sha1 sha1) file.file_chunks)); |
250 |
file_add file_impl file_state; |
file_add file_impl file_state; |
251 |
(* lprintf "ADD FILE TO DOWNLOAD LIST\n"; *) |
(* lprintf "ADD FILE TO DOWNLOAD LIST\n"; *) |
252 |
file |
file |
253 |
|
|
254 |
let new_download file_id t torrent_diskname = |
let new_download file_id t torrent_diskname = |
255 |
let file_temp = Filename.concat !!DO.temp_directory |
let file_temp = Filename.concat !!DO.temp_directory |
256 |
(Printf.sprintf "BT-%s" (Sha1.to_string file_id)) in |
(Printf.sprintf "BT-%s" (Sha1.to_string file_id)) in |
257 |
new_file file_id t torrent_diskname file_temp FileDownloading |
new_file file_id t torrent_diskname file_temp FileDownloading |
258 |
|
|
259 |
let ft_by_num = Hashtbl.create 13 |
let ft_by_num = Hashtbl.create 13 |
260 |
let ft_counter = ref 0 |
let ft_counter = ref 0 |
261 |
|
|
262 |
let new_ft file_name = |
let new_ft file_name = |
263 |
incr ft_counter; |
incr ft_counter; |
264 |
let rec ft = { |
let rec ft = { |
273 |
impl_file_downloaded = Int64.zero; |
impl_file_downloaded = Int64.zero; |
274 |
impl_file_val = ft; |
impl_file_val = ft; |
275 |
impl_file_ops = ft_ops; |
impl_file_ops = ft_ops; |
276 |
impl_file_age = last_time (); |
impl_file_age = last_time (); |
277 |
impl_file_best_name = file_name; |
impl_file_best_name = file_name; |
278 |
} |
} |
279 |
in |
in |
280 |
Hashtbl.add ft_by_num !ft_counter ft; |
Hashtbl.add ft_by_num !ft_counter ft; |
281 |
file_add file_impl FileDownloading; |
file_add file_impl FileDownloading; |
282 |
ft |
ft |
283 |
|
|
284 |
let _dot_string s h = |
let _dot_string s h = |
285 |
let len = String.length s in |
let len = String.length s in |
286 |
let char2hex c = |
let char2hex c = |
287 |
let ic = int_of_char c in |
let ic = int_of_char c in |
288 |
if ic >= 65 && ic <= 70 then |
if ic >= 65 && ic <= 70 then |
289 |
string_of_int (ic - 55) |
string_of_int (ic - 55) |
346 |
if not (!result = "") then |
if not (!result = "") then |
347 |
result := !result ^ " " ^ (dot_string (String.sub s 3 4)); |
result := !result ^ " " ^ (dot_string (String.sub s 3 4)); |
348 |
!result; |
!result; |
349 |
end else "" |
end else "" |
350 |
|
|
351 |
let decode_tornado_style s = |
let decode_tornado_style s = |
352 |
let result = ref "" in |
let result = ref "" in |
353 |
if check_all s 45 [4;5] then begin |
if check_all s 45 [4;5] then begin |
354 |
let check_id s = |
let check_id s = |
355 |
match s with |
match s with |
356 |
| "T" -> "BitTornado" |
| "T" -> "BitTornado" |
357 |
| "A" -> "ABC" |
| "A" -> "ABC" |
359 |
in |
in |
360 |
if check_all s 45 [6;7;8] then |
if check_all s 45 [6;7;8] then |
361 |
let t = ref (check_id (String.sub s 0 1)) in |
let t = ref (check_id (String.sub s 0 1)) in |
362 |
if not (!t = "") then |
if not (!t = "") then |
363 |
result := !t ^ " " ^ dot_string_h (String.sub s 1 3); |
result := !t ^ " " ^ dot_string_h (String.sub s 1 3); |
364 |
else if s.[6] = (char_of_int 48) then |
else if s.[6] = (char_of_int 48) then |
365 |
let t = ref (check_id (String.sub s 0 1)) in |
let t = ref (check_id (String.sub s 0 1)) in |
366 |
if not (!t = "") then |
if not (!t = "") then |
367 |
result := !t ^ " LM " ^ dot_string_h (String.sub s 1 3); |
result := !t ^ " LM " ^ dot_string_h (String.sub s 1 3); |
368 |
end; |
end; |
369 |
!result |
!result |
370 |
|
|
371 |
let decode_mainline_style s = |
let decode_mainline_style s = |
372 |
if check_all s 45 [2;4;6;7] then begin |
if check_all s 45 [2;4;6;7] then begin |
409 |
in |
in |
410 |
check 0 |
check 0 |
411 |
|
|
412 |
let decode_mburst s = |
let decode_mburst s = |
413 |
if "Mbrst" = String.sub s 0 5 then |
if "Mbrst" = String.sub s 0 5 then |
414 |
"Burst! " ^ (dot_string_of_list s [5;7;9]) |
"Burst! " ^ (dot_string_of_list s [5;7;9]) |
415 |
else "" |
else "" |
424 |
"BitsOnWheels " ^ (String.sub s 4 3) |
"BitsOnWheels " ^ (String.sub s 4 3) |
425 |
else "" |
else "" |
426 |
|
|
427 |
let decode_exeem s = |
let decode_exeem s = |
428 |
if "eX" = String.sub s 0 2 then |
if "eX" = String.sub s 0 2 then |
429 |
"eXeem [" ^ (String.sub s 2 18) ^ "]" |
"eXeem [" ^ (String.sub s 2 18) ^ "]" |
430 |
else "" |
else "" |
459 |
!result; |
!result; |
460 |
else "" |
else "" |
461 |
|
|
462 |
let decode_bitspirit s = |
let decode_bitspirit s = |
463 |
let result = ref "" in |
let result = ref "" in |
464 |
if "BS" = String.sub s 2 2 then begin |
if "BS" = String.sub s 2 2 then begin |
465 |
if s.[1] = (char_of_int 0) then result := "BitSpirit v1"; |
if s.[1] = (char_of_int 0) then result := "BitSpirit v1"; |
473 |
else "" |
else "" |
474 |
|
|
475 |
let decode_bitcomet s = |
let decode_bitcomet s = |
476 |
if "exbc" = String.sub s 0 4 then |
if "exbc" = String.sub s 0 4 then |
477 |
Printf.sprintf "BitComet %d.%d%d" |
Printf.sprintf "BitComet %d.%d%d" |
478 |
(int_of_char s.[4]) |
(int_of_char s.[4]) |
479 |
((int_of_char s.[5]) / 10) |
((int_of_char s.[5]) / 10) |
480 |
((int_of_char s.[5]) mod 10) |
((int_of_char s.[5]) mod 10) |
481 |
else "" |
else "" |
482 |
|
|
483 |
let decode_shareaza s = |
let decode_shareaza s = |
484 |
let rec not_zeros pos = |
let rec not_zeros pos = |
485 |
if pos > 15 then true else |
if pos > 15 then true else |
486 |
if s.[pos] = (char_of_int 0) then false else not_zeros (pos+1) |
if s.[pos] = (char_of_int 0) then false else not_zeros (pos+1) |
487 |
in |
in |
488 |
let rec weird_crap pos = |
let rec weird_crap pos = |
489 |
if pos > 19 then true else |
if pos > 19 then true else |
490 |
let i1 = (int_of_char s.[pos]) in |
let i1 = (int_of_char s.[pos]) in |
491 |
let i2 = (int_of_char s.[(pos mod 16)]) in |
let i2 = (int_of_char s.[(pos mod 16)]) in |
492 |
let i3 = (int_of_char s.[(15 - (pos mod 16))]) in |
let i3 = (int_of_char s.[(15 - (pos mod 16))]) in |
503 |
find_non_zero (pos+1) |
find_non_zero (pos+1) |
504 |
in |
in |
505 |
let result = ref "" in |
let result = ref "" in |
506 |
(match find_non_zero 0 with |
(match find_non_zero 0 with |
507 |
8 -> (if "UDP0" = String.sub s 16 4 then |
8 -> (if "UDP0" = String.sub s 16 4 then |
508 |
result := "BitComet UDP"; |
result := "BitComet UDP"; |
509 |
if "HTTPBT" = String.sub s 14 6 then |
if "HTTPBT" = String.sub s 14 6 then |
510 |
result := "BitComet HTTP";) |
result := "BitComet HTTP";) |
511 |
| 9 -> if check_all s 3 [9;10;11] then |
| 9 -> if check_all s 3 [9;10;11] then |
512 |
result := "Snark"; |
result := "Snark"; |
513 |
| 12 -> if check_all s 97 [12;13] then |
| 12 -> if check_all s 97 [12;13] then |
514 |
result := "Experimental 3.2.1b2" |
result := "Experimental 3.2.1b2" |
523 |
!result |
!result |
524 |
|
|
525 |
let parse_software s = |
let parse_software s = |
526 |
try |
try |
527 |
let rec try_styles i = |
let rec try_styles i = |
528 |
if i > 16 then "UNKNOWN" else begin |
if i > 16 then "UNKNOWN" else begin |
529 |
let res = ref |
let res = ref |
554 |
in |
in |
555 |
try_styles 0 |
try_styles 0 |
556 |
with _ -> "ERROR" |
with _ -> "ERROR" |
557 |
|
|
558 |
let new_client file peer_id kind = |
let new_client file peer_id kind = |
559 |
try |
try |
560 |
let c = Hashtbl.find file.file_clients kind in |
let c = Hashtbl.find file.file_clients kind in |
595 |
client_incoming = false; |
client_incoming = false; |
596 |
client_registered_bitfield = false; |
client_registered_bitfield = false; |
597 |
client_last_optimist = 0; |
client_last_optimist = 0; |
598 |
client_software = if peer_id != Sha1.null then |
client_software = if peer_id != Sha1.null then |
599 |
(parse_software (Sha1.direct_to_string peer_id)) |
(parse_software (Sha1.direct_to_string peer_id)) |
600 |
else "NOT_RECEIVED"; |
else "NOT_RECEIVED"; |
601 |
} and impl = { |
} and impl = { |
620 |
c.client_file.file_clients_num <- c.client_file.file_clients_num - 1; |
c.client_file.file_clients_num <- c.client_file.file_clients_num - 1; |
621 |
file_remove_source (as_file c.client_file) (as_client c) |
file_remove_source (as_file c.client_file) (as_client c) |
622 |
|
|
|
|
|
623 |
let old_torrents_directory = "torrents" |
let old_torrents_directory = "torrents" |
624 |
let downloads_directory = Filename.concat old_torrents_directory "downloads" |
let downloads_directory = Filename.concat old_torrents_directory "downloads" |
625 |
let tracked_directory = Filename.concat old_torrents_directory "tracked" |
let tracked_directory = Filename.concat old_torrents_directory "tracked" |