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
36 let bt_stats_ini = create_options_file
"stats_bt.ini"
37 let bt_stats_section = file_section
bt_stats_ini [] ""
39 module StatsOption
= struct
43 Options.Module assocs
->
45 brand_seen
= value_to_int
(List.assoc
"seen" assocs
);
46 brand_banned
= value_to_int
(List.assoc
"banned" assocs
);
47 brand_filerequest
= value_to_int
(List.assoc
"filereqs" assocs
);
48 brand_download
= value_to_int64
(List.assoc
"download" assocs
);
49 brand_upload
= value_to_int64
(List.assoc
"upload" assocs
);
52 | _
-> failwith
"Options: not a stat option"
56 "seen", int_to_value b
.brand_seen
;
57 "banned", int_to_value b
.brand_banned
;
58 "filereqs", int_to_value b
.brand_filerequest
;
59 "download", int64_to_value b
.brand_download
;
60 "upload", int64_to_value b
.brand_upload
;
64 let t = define_option_class
"Stat" value_to_stat stat_to_value
67 module ClientOption
= struct
69 let value_to_client file v
=
73 let get_value name conv
= conv
(List.assoc name assocs
) in
74 let client_ip = get_value "client_ip" (from_value
Ip.option)
76 let client_port = get_value "client_port" value_to_int
in
77 let client_uid = get_value "client_uid" (from_value
Sha1.option) in
78 let c = new_client file
client_uid (client_ip, client_port) None
in
81 | _
-> failwith
"Options: Not a client"
84 let client_to_value c =
85 let (ip
,port
) = c.client_host
in
87 "client_uid", to_value
Sha1.option c.client_uid;
88 "client_ip", to_value
Ip.option ip
;
89 "client_port", int_to_value port
;
92 let to_value = client_to_value
93 let of_value = value_to_client
97 let value_to_file file_size file_state user group assocs
=
98 let get_value name conv
= conv
(List.assoc name assocs
) in
101 get_value "file_trackers" (value_to_list value_to_string
)
104 [get_value "file_tracker" value_to_string
]
105 with _
-> failwith
"Bad file_tracker"
108 let file_id, torrent
, torrent_diskname
=
110 let torrent_diskname = get_value "file_torrent_name" value_to_string
in
111 let s = File.to_string
torrent_diskname in
112 let file_id, torrent
= BTTorrent.decode_torrent
s in
113 file_id, torrent
, torrent_diskname
116 let file_name = get_value "file_name" value_to_string
in
117 let file_comment = try get_value "file_comment" value_to_string
with Not_found
-> "" in
120 Sha1.of_string
(get_value "file_id" value_to_string
)
121 with _
-> failwith
"Bad file_id"
123 let file_piece_size = try
124 value_to_int64
(List.assoc
"file_piece_size" assocs
)
125 with _
-> failwith
"Bad file size"
128 get_value "file_hashes" (value_to_array
129 (from_value
Sha1.option))
131 let file_size = get_value "file_size" value_to_int64
in
132 let file_created_by = try get_value "file_created_by" value_to_string
with Not_found
-> "" in
133 let file_creation_date = try get_value "file_creation_date" value_to_int64
with Not_found
-> Int64.zero
in
134 let file_modified_by = try get_value "file_modified_by" value_to_string
with Not_found
-> "" in
135 let file_encoding = try get_value "file_encoding" value_to_string
with Not_found
-> "" in
136 let file_is_private = try get_value "file_is_private" value_to_int64
with Not_found
-> Int64.zero
in
139 let file_files = (get_value "file_files"
140 (value_to_list
(fun v
->
144 value_to_string name
, value_to_int64 p1
151 torrent_name
= file_name;
152 torrent_filename
= "";
153 torrent_name_utf8
= file_name;
154 torrent_comment
= file_comment;
155 torrent_pieces
= file_chunks;
156 torrent_piece_size
= file_piece_size;
157 torrent_files
= file_files;
158 torrent_length
= file_size;
159 torrent_created_by
= file_created_by;
160 torrent_creation_date
= file_creation_date;
161 torrent_modified_by
= file_modified_by;
162 torrent_encoding
= file_encoding;
163 torrent_private
= file_is_private;
165 torrent_nodes = file_nodes;
168 (match file_trackers with
171 torrent_announce_list
= file_trackers;
173 let torrent_diskname = Filename.concat downloads_directory
174 (file_name ^
".torrent") in
175 file_id, torrent, torrent_diskname
179 get_value "file_temp" value_to_string
181 let file_temp = Filename.concat
!!DO.temp_directory
182 (Printf.sprintf
"BT-%s" (Sha1.to_string
file_id)) in
185 let file = new_file
file_id torrent torrent_diskname
186 file_temp file_state user group
in
188 let file_uploaded = try
189 value_to_int64
(List.assoc
"file_uploaded" assocs
)
192 file.file_uploaded <- file_uploaded;
194 (match file.file_swarmer
with
197 CommonSwarming.value_to_frontend swarmer assocs
;
203 (get_value "file_sources" (
204 value_to_list (ClientOption.of_value file)))
206 lprintf_nl "Exception %s while loading sources"
207 (Printexc2.to_string e);
212 let file_to_value file =
216 "file_temp", string_to_value
(Unix32.filename
(file_fd
file));
217 "file_piece_size", int64_to_value
(file.file_piece_size);
218 "file_name", string_to_value
file.file_name;
219 "file_uploaded", int64_to_value
(file.file_uploaded);
220 "file_id", string_to_value
(Sha1.to_string
file.file_id);
221 "file_trackers", (list_to_value string_to_value
)
222 (List.map
(fun t -> t.tracker_url
) file.file_trackers);
223 (* OK, but I still don't like the idea of forgetting all the clients.
224 We should have a better strategy, ie rating the clients and connecting
225 to them depending on the results of our last connections. And then,
226 if we could not download enough in the last interval, ask the tracker to
227 send us more clients.
230 list_to_value "BT Sources" (fun c ->
231 ClientOption.to_value c) sources
237 ("file_torrent_name", string_to_value
file.file_torrent_diskname
) ::
238 ("file_hashes", array_to_value
239 (to_value Sha1.option) file.file_chunks) ::
240 ("file_files", list_to_value
241 (fun (name
, p1
, _
) ->
242 SmallList
[string_to_value name
; int64_to_value p1
])
246 match file.file_swarmer
with
249 CommonSwarming.frontend_to_value swarmer
assocs
252 lprintf_file_nl
(as_file
file) "exception %s in file_to_value"
253 (Printexc2.to_string e
); raise e
257 Options.save_with_help bittorrent_ini
260 let config_files_loaded = ref false
264 Options.load bt_stats_ini;
265 with Sys_error _
-> ());
267 config_files_loaded := true
269 let guptime = define_option
bt_stats_section ["guptime"] "" int_option
0
271 let new_stats_array () =
272 Array.init brand_count
(fun _
->
273 { dummy_stats
with brand_seen
= 0 }
277 let gstats_array = define_option
bt_stats_section ["stats"] ""
278 (array_option
StatsOption.t) (new_stats_array ())
282 option_hook
gstats_array (fun _ ->
283 let old_stats = !!gstats_array in
284 let old_len = Array.length
old_stats in
285 if old_len <> brand_count
then
286 let t = new_stats_array () in
287 for i
= 0 to old_len - 1 do
288 t.(i
) <- old_stats.(i
)
293 let diff_time = ref 0
295 let sources_loaded = ref false (* added 2.5.24 *)
298 if !config_files_loaded then begin
299 (* lprintf "SAVING SHARED FILES AND SOURCES\n"; *)
300 guptime =:= !!guptime + (last_time
() - start_time
) - !diff_time;
301 diff_time := (last_time
() - start_time
);
302 Options.save_with_help
bt_stats_ini;
304 (* lprintf "SAVED\n"; *)
306 let guptime () = !!guptime - !diff_time
309 network
.op_network_file_of_option
<- value_to_file;
310 file_ops
.op_file_to_option
<- file_to_value;
312 (* Shut up message "Network.save/load_complex_options not implemented by BitTorrent" *)
313 network
.op_network_load_complex_options
<- load;
314 network
.op_network_save_complex_options
<- save;
315 network
.op_network_update_options
<- (fun _ -> ());
316 network
.op_network_save_sources
<- (fun _ -> ())