19 |
|
|
20 |
open Int64ops |
open Int64ops |
21 |
open Printf2 |
open Printf2 |
22 |
|
open BasicSocket |
23 |
open Md4 |
open Md4 |
24 |
open Options |
open Options |
25 |
|
|
26 |
open CommonGlobals |
open CommonGlobals |
27 |
open CommonDownloads |
open CommonDownloads |
28 |
open CommonTypes |
open CommonTypes |
47 |
let client_port = get_value "client_port" value_to_int in |
let client_port = get_value "client_port" value_to_int in |
48 |
let client_uid = get_value "client_uid" (from_value Sha1.option) in |
let client_uid = get_value "client_uid" (from_value Sha1.option) in |
49 |
let c = new_client file client_uid (client_ip, client_port) in |
let c = new_client file client_uid (client_ip, client_port) in |
50 |
|
|
51 |
c |
c |
52 |
| _ -> failwith "Options: Not a client" |
| _ -> failwith "Options: Not a client" |
53 |
|
|
54 |
|
|
55 |
let client_to_value c = |
let client_to_value c = |
56 |
let (ip,port) = c.client_host in |
let (ip,port) = c.client_host in |
57 |
Options.Module [ |
Options.Module [ |
62 |
|
|
63 |
let to_value = client_to_value |
let to_value = client_to_value |
64 |
let of_value = value_to_client |
let of_value = value_to_client |
65 |
|
|
66 |
end |
end |
67 |
|
|
68 |
let value_to_file file_size file_state assocs = |
let value_to_file file_size file_state assocs = |
69 |
let get_value name conv = conv (List.assoc name assocs) in |
let get_value name conv = conv (List.assoc name assocs) in |
70 |
let get_value_nil name conv = |
let get_value_nil name conv = |
71 |
try conv (List.assoc name assocs) with _ -> [] |
try conv (List.assoc name assocs) with _ -> [] |
72 |
in |
in |
73 |
|
|
74 |
let file_trackers = |
let file_trackers = |
75 |
try |
try |
76 |
get_value "file_trackers" (value_to_list value_to_string) |
get_value "file_trackers" (value_to_list value_to_string) |
77 |
with _ -> |
with _ -> |
78 |
try |
try |
79 |
[get_value "file_tracker" value_to_string] |
[get_value "file_tracker" value_to_string] |
80 |
with _ -> failwith "Bad file_tracker" |
with _ -> failwith "Bad file_tracker" |
81 |
in |
in |
82 |
|
|
83 |
let file_id, torrent, torrent_diskname = |
let file_id, torrent, torrent_diskname = |
84 |
try |
try |
85 |
let torrent_diskname = get_value "file_torrent_name" value_to_string in |
let torrent_diskname = get_value "file_torrent_name" value_to_string in |
87 |
let file_id, torrent = BTTorrent.decode_torrent s in |
let file_id, torrent = BTTorrent.decode_torrent s in |
88 |
file_id, torrent, torrent_diskname |
file_id, torrent, torrent_diskname |
89 |
with _ -> |
with _ -> |
90 |
|
|
91 |
let file_name = get_value "file_name" value_to_string in |
let file_name = get_value "file_name" value_to_string in |
92 |
let file_id = |
let file_id = |
93 |
try |
try |
95 |
with _ -> failwith "Bad file_id" |
with _ -> failwith "Bad file_id" |
96 |
in |
in |
97 |
let file_piece_size = try |
let file_piece_size = try |
98 |
value_to_int64 (List.assoc "file_piece_size" assocs) |
value_to_int64 (List.assoc "file_piece_size" assocs) |
99 |
with _ -> failwith "Bad file size" |
with _ -> failwith "Bad file size" |
100 |
in |
in |
101 |
let file_chunks = |
let file_chunks = |
102 |
get_value "file_hashes" (value_to_array |
get_value "file_hashes" (value_to_array |
103 |
(from_value Sha1.option)) |
(from_value Sha1.option)) |
104 |
in |
in |
105 |
let file_size = get_value "file_size" value_to_int64 in |
let file_size = get_value "file_size" value_to_int64 in |
106 |
let file_files = |
let file_files = |
107 |
try |
try |
108 |
let file_files = (get_value "file_files" |
let file_files = (get_value "file_files" |
109 |
(value_to_list (fun v -> |
(value_to_list (fun v -> |
110 |
match v with |
match v with |
111 |
SmallList [name; p1] |
SmallList [name; p1] |
122 |
torrent_piece_size = file_piece_size; |
torrent_piece_size = file_piece_size; |
123 |
torrent_files = file_files; |
torrent_files = file_files; |
124 |
torrent_length = file_size; |
torrent_length = file_size; |
125 |
torrent_announce = |
torrent_announce = |
126 |
( |
( |
127 |
try |
try |
128 |
(List.hd file_trackers) |
(List.hd file_trackers) |
129 |
with _ -> "" |
with _ -> "" |
130 |
); |
); |
131 |
} in |
} in |
132 |
let torrent_diskname = Filename.concat downloads_directory |
let torrent_diskname = Filename.concat downloads_directory |
133 |
(file_name ^ ".torrent") in |
(file_name ^ ".torrent") in |
134 |
file_id, torrent, torrent_diskname |
file_id, torrent, torrent_diskname |
135 |
|
|
136 |
in |
in |
137 |
let file_temp = try |
let file_temp = try |
138 |
get_value "file_temp" value_to_string |
get_value "file_temp" value_to_string |
139 |
with Not_found -> |
with Not_found -> |
140 |
let file_temp = Filename.concat !!DO.temp_directory |
let file_temp = Filename.concat !!DO.temp_directory |
141 |
(Printf.sprintf "BT-%s" (Sha1.to_string file_id)) in |
(Printf.sprintf "BT-%s" (Sha1.to_string file_id)) in |
142 |
file_temp |
file_temp |
143 |
in |
in |
144 |
let file = new_file file_id torrent torrent_diskname file_temp file_state in |
let file = new_file file_id torrent torrent_diskname file_temp file_state in |
145 |
|
|
146 |
let file_uploaded = try |
let file_uploaded = try |
147 |
value_to_int64 (List.assoc "file_uploaded" assocs) |
value_to_int64 (List.assoc "file_uploaded" assocs) |
148 |
with _ -> zero |
with _ -> zero |
149 |
in |
in |
150 |
file.file_uploaded <- file_uploaded; |
file.file_uploaded <- file_uploaded; |
151 |
|
|
152 |
(match file.file_swarmer with |
(match file.file_swarmer with |
153 |
None -> () |
None -> () |
154 |
| Some swarmer -> |
| Some swarmer -> |
159 |
ignore |
ignore |
160 |
(get_value "file_sources" ( |
(get_value "file_sources" ( |
161 |
value_to_list (ClientOption.of_value file))) |
value_to_list (ClientOption.of_value file))) |
162 |
with e -> |
with e -> |
163 |
lprintf_nl "[BT]: Exception %s while loading sources" |
lprintf_nl "[BT]: Exception %s while loading sources" |
164 |
(Printexc2.to_string e); |
(Printexc2.to_string e); |
165 |
); |
); |
166 |
|
|
167 |
as_file file |
as_file file |
168 |
|
|
169 |
let file_to_value file = |
let file_to_value file = |
170 |
try |
try |
171 |
let sources = Hashtbl2.to_list file.file_clients in |
let sources = Hashtbl2.to_list file.file_clients in |
176 |
"file_name", string_to_value file.file_name; |
"file_name", string_to_value file.file_name; |
177 |
"file_uploaded", int64_to_value (file.file_uploaded); |
"file_uploaded", int64_to_value (file.file_uploaded); |
178 |
"file_id", string_to_value (Sha1.to_string file.file_id); |
"file_id", string_to_value (Sha1.to_string file.file_id); |
179 |
"file_trackers", (list_to_value string_to_value) |
"file_trackers", (list_to_value string_to_value) |
180 |
(List.map (fun t -> t.tracker_url) file.file_trackers); |
(List.map (fun t -> t.tracker_url) file.file_trackers); |
181 |
(* OK, but I still don't like the idea of forgetting all the clients. |
(* OK, but I still don't like the idea of forgetting all the clients. |
182 |
We should have a better strategy, ie rating the clients and connecting |
We should have a better strategy, ie rating the clients and connecting |
183 |
to them depending on the results of our last connections. And then, |
to them depending on the results of our last connections. And then, |
184 |
if we could not download enough in the last interval, ask the tracker to |
if we could not download enough in the last interval, ask the tracker to |
185 |
send us more clients. |
send us more clients. |
186 |
|
|
187 |
"file_sources", |
"file_sources", |
188 |
list_to_value "BT Sources" (fun c -> |
list_to_value "BT Sources" (fun c -> |
189 |
ClientOption.to_value c) sources |
ClientOption.to_value c) sources |
190 |
; |
; |
193 |
in |
in |
194 |
let assocs = |
let assocs = |
195 |
("file_torrent_name", string_to_value file.file_torrent_diskname) :: |
("file_torrent_name", string_to_value file.file_torrent_diskname) :: |
196 |
("file_hashes", array_to_value |
("file_hashes", array_to_value |
197 |
(to_value Sha1.option) file.file_chunks) :: |
(to_value Sha1.option) file.file_chunks) :: |
198 |
("file_files", list_to_value |
("file_files", list_to_value |
199 |
(fun (name, p1) -> |
(fun (name, p1) -> |
202 |
assocs |
assocs |
203 |
in |
in |
204 |
match file.file_swarmer with |
match file.file_swarmer with |
205 |
None -> assocs |
None -> assocs |
206 |
| Some swarmer -> |
| Some swarmer -> |
207 |
Int64Swarmer.swarmer_to_value swarmer assocs |
Int64Swarmer.swarmer_to_value swarmer assocs |
208 |
with |
with |
210 |
lprintf_nl "BTComplexOptions: exception %s in file_to_value" |
lprintf_nl "BTComplexOptions: exception %s in file_to_value" |
211 |
(Printexc2.to_string e); raise e |
(Printexc2.to_string e); raise e |
212 |
|
|
213 |
let old_files = |
let old_files = |
214 |
define_option bittorrent_section ["old_files"] |
define_option bittorrent_section ["old_files"] |
215 |
"" (list_option (tuple2_option (string_option, int64_option))) [] |
"" (list_option (tuple2_option (string_option, int64_option))) [] |
216 |
|
|
217 |
|
|
218 |
let save_config () = |
let save_config () = |
219 |
Options.save_with_help bittorrent_ini |
Options.save_with_help bittorrent_ini |
220 |
|
|