src/networks/bittorrent/bTComplexOptions.ml

   1 (* Copyright 2001, 2002 b52_simon :), b8_bavard, b8_fee_carabine, INRIA *)
   2 (*
   3     This file is part of mldonkey.
   4
   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.
   9
  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.
  14
  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
  18 *)
  19
  20 open Int64ops
  21 open Printf2
  22 open BasicSocket
  23 open Md4
  24 open Options
  25
  26 open CommonGlobals
  27 open CommonDownloads
  28 open CommonTypes
  29 open CommonFile
  30
  31 open BTTypes
  32 open BTOptions
  33 open BTGlobals
  34
  35
  36 let bt_stats_ini = create_options_file "stats_bt.ini"
  37 let bt_stats_section = file_section bt_stats_ini [] ""
  38
  39 module StatsOption = struct
  40
  41     let value_to_stat v =
  42       match v with
  43         Options.Module assocs ->
  44           {
  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);
  50           }
  51
  52       | _ -> failwith "Options: not a stat option"
  53
  54     let stat_to_value b =
  55       Options.Module [
  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;
  61       ]
  62
  63
  64     let t = define_option_class "Stat" value_to_stat stat_to_value
  65   end
  66
  67 module ClientOption = struct
  68
  69     let value_to_client file v =
  70       match v with
  71       | Module assocs ->
  72
  73           let get_value name conv = conv (List.assoc name assocs) in
  74           let client_ip = get_value "client_ip" (from_value Ip.option)
  75           in
  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
  79
  80           c
  81       | _ -> failwith "Options: Not a client"
  82
  83
  84     let client_to_value c =
  85       let (ip,port) = c.client_host in
  86           Options.Module [
  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;
  90           ]
  91
  92     let to_value = client_to_value
  93     let of_value = value_to_client
  94
  95   end
  96
  97 let value_to_file file_size file_state user group assocs =
  98   let get_value name conv = conv (List.assoc name assocs) in
  99   let file_trackers =
 100     try
 101       get_value "file_trackers" (value_to_list value_to_string)
 102     with _ ->
 103         try
 104           [get_value "file_tracker"  value_to_string]
 105         with _ -> failwith "Bad file_tracker"
 106   in
 107
 108   let file_id, torrent, torrent_diskname =
 109     try
 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
 114     with _ ->
 115
 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
 118         let file_id =
 119           try
 120             Sha1.of_string (get_value "file_id" value_to_string)
 121           with _ -> failwith "Bad file_id"
 122         in
 123         let file_piece_size = try
 124             value_to_int64 (List.assoc "file_piece_size" assocs)
 125           with _ -> failwith "Bad file size"
 126         in
 127         let file_chunks =
 128           get_value "file_hashes" (value_to_array
 129               (from_value Sha1.option))
 130         in
 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
 137         let file_files =
 138           try
 139             let file_files = (get_value "file_files"
 140                   (value_to_list (fun v ->
 141                       match v with
 142                         SmallList [name; p1]
 143                       | List [name; p1] ->
 144                           value_to_string name, value_to_int64 p1
 145                       | _ -> assert false
 146                   ))) in
 147             file_files
 148           with _ -> []
 149         in
 150         let torrent = {
 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;
 164 (*
 165             torrent_nodes = file_nodes;
 166 *)
 167             torrent_announce =
 168             (match file_trackers with
 169               | h::q -> h
 170               | [] -> "");
 171             torrent_announce_list = file_trackers;
 172           } in
 173         let torrent_diskname = Filename.concat downloads_directory
 174             (file_name ^ ".torrent") in
 175         file_id, torrent, torrent_diskname
 176
 177   in
 178   let file_temp = try
 179       get_value "file_temp" value_to_string
 180     with Not_found ->
 181         let file_temp = Filename.concat !!DO.temp_directory
 182             (Printf.sprintf "BT-%s" (Sha1.to_string file_id)) in
 183         file_temp
 184   in
 185   let file = new_file file_id torrent torrent_diskname
 186                file_temp file_state user group in
 187
 188   let file_uploaded = try
 189       value_to_int64 (List.assoc "file_uploaded" assocs)
 190     with _ -> zero
 191   in
 192   file.file_uploaded <- file_uploaded;
 193
 194   (match file.file_swarmer with
 195       None -> ()
 196     | Some swarmer ->
 197         CommonSwarming.value_to_frontend swarmer assocs;
 198   );
 199
 200 (*
 201   (try
 202       ignore
 203         (get_value  "file_sources" (
 204           value_to_list (ClientOption.of_value file)))
 205     with e ->
 206         lprintf_nl "Exception %s while loading sources"
 207           (Printexc2.to_string e);
 208   );
 209 *)
 210   as_file file
 211
 212 let file_to_value file =
 213   try
 214     let assocs =
 215       [
 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 -> show_tracker_url 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.
 228
 229     "file_sources",
 230     list_to_value "BT Sources" (fun c ->
 231         ClientOption.to_value c) sources
 232 ;
 233   *)
 234       ]
 235     in
 236     let assocs =
 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])
 243         file.file_files) ::
 244       assocs
 245     in
 246     match file.file_swarmer with
 247       None -> assocs
 248     | Some swarmer ->
 249         CommonSwarming.frontend_to_value swarmer assocs
 250   with
 251     e ->
 252       lprintf_file_nl (as_file file) "exception %s in file_to_value"
 253         (Printexc2.to_string e); raise e
 254
 255
 256 let save_config () =
 257   Options.save_with_help bittorrent_ini
 258
 259
 260 let config_files_loaded = ref false
 261
 262 let load _ =
 263   (try
 264       Options.load bt_stats_ini;
 265     with Sys_error _ -> ());
 266   check_client_uid ();
 267   config_files_loaded := true
 268
 269 let guptime = define_option bt_stats_section ["guptime"] "" int_option 0
 270
 271 let new_stats_array () =
 272   Array.init brand_count (fun _ ->
 273       { dummy_stats with brand_seen = 0 }
 274   )
 275
 276
 277 let gstats_array = define_option bt_stats_section ["stats"] ""
 278     (array_option StatsOption.t) (new_stats_array ())
 279
 280
 281 let _ =
 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)
 289         done;
 290         gstats_array =:= t
 291   )
 292
 293 let diff_time = ref 0
 294
 295 let sources_loaded = ref false  (* added 2.5.24 *)
 296
 297 let save _ =
 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;
 303     end
 304 (*  lprintf "SAVED\n";  *)
 305
 306 let guptime () = !!guptime - !diff_time
 307
 308 let _ =
 309   network.op_network_file_of_option <- value_to_file;
 310   file_ops.op_file_to_option <- file_to_value;
 311
 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 _ -> ())