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 BasicSocket
  22 open Md4
  23 open Options
  24
  25 open CommonTypes
  26 open CommonFile
  27
  28 open BTTypes
  29 open BTOptions
  30 open BTGlobals
  31
  32 let bt_dht_ini = create_options_file "bt_dht.ini"
  33 let bt_dht_section = file_section bt_dht_ini [] ""
  34
  35 let dht_routing_table = define_option bt_dht_section ["dht_routing_table"] ""
  36     Kademlia.RoutingTableOption.t (Kademlia.create ())
  37
  38 let bt_stats_ini = create_options_file "stats_bt.ini"
  39 let bt_stats_section = file_section bt_stats_ini [] ""
  40
  41 module StatsOption = struct
  42
  43     let value_to_stat v =
  44       match v with
  45         Options.Module assocs ->
  46           {
  47             brand_seen = value_to_int (List.assoc "seen" assocs);
  48             brand_banned = value_to_int (List.assoc "banned" assocs);
  49             brand_filerequest = value_to_int (List.assoc "filereqs" assocs);
  50             brand_download = value_to_int64 (List.assoc "download" assocs);
  51             brand_upload = value_to_int64 (List.assoc "upload" assocs);
  52           }
  53
  54       | _ -> failwith "Options: not a stat option"
  55
  56     let stat_to_value b =
  57       Options.Module [
  58         "seen", int_to_value b.brand_seen;
  59         "banned", int_to_value b.brand_banned;
  60         "filereqs", int_to_value b.brand_filerequest;
  61         "download", int64_to_value b.brand_download;
  62         "upload", int64_to_value b.brand_upload;
  63       ]
  64
  65
  66     let t = define_option_class "Stat" value_to_stat stat_to_value
  67   end
  68
  69 module ClientOption = struct
  70
  71     let value_to_client file v =
  72       match v with
  73       | Module assocs ->
  74
  75           let get_value name conv = conv (List.assoc name assocs) in
  76           let client_ip = get_value "client_ip" (from_value Ip.option)
  77           in
  78           let client_port = get_value "client_port" value_to_int in
  79           let client_uid = get_value "client_uid" (from_value Sha1.option) in
  80           let c = new_client file client_uid (client_ip, client_port) None in
  81
  82           c
  83       | _ -> failwith "Options: Not a client"
  84
  85
  86     let client_to_value c =
  87       let (ip,port) = c.client_host in
  88           Options.Module [
  89             "client_uid", to_value Sha1.option c.client_uid;
  90             "client_ip", to_value Ip.option ip;
  91             "client_port", int_to_value port;
  92           ]
  93
  94     let to_value = client_to_value
  95     let of_value = value_to_client
  96
  97   end
  98
  99 let value_to_file file_size file_state user group assocs =
 100   let get_value name conv = conv (List.assoc name assocs) in
 101   let file_trackers =
 102     try
 103       get_value "file_trackers" (value_to_list value_to_string)
 104     with _ ->
 105         try
 106           [get_value "file_tracker"  value_to_string]
 107         with _ -> failwith "Bad file_tracker"
 108   in
 109
 110   let file_id, torrent, torrent_diskname =
 111     try
 112       let torrent_diskname = get_value "file_torrent_name" value_to_string in
 113       let s = File.to_string torrent_diskname in
 114       let file_id, torrent = BTTorrent.decode_torrent s in
 115       file_id, torrent, torrent_diskname
 116     with _ ->
 117
 118         let file_name = get_value "file_name" value_to_string in
 119         let file_comment = try get_value "file_comment" value_to_string with Not_found -> "" in
 120         let file_id =
 121           try
 122             Sha1.of_string (get_value "file_id" value_to_string)
 123           with _ -> failwith "Bad file_id"
 124         in
 125         let file_piece_size = try
 126             value_to_int64 (List.assoc "file_piece_size" assocs)
 127           with _ -> failwith "Bad file size"
 128         in
 129         let file_chunks =
 130           get_value "file_hashes" (value_to_array
 131               (from_value Sha1.option))
 132         in
 133         let file_size = get_value "file_size" value_to_int64 in
 134         let file_created_by = try get_value "file_created_by" value_to_string with Not_found -> "" in
 135         let file_creation_date = try get_value "file_creation_date" value_to_int64 with Not_found -> Int64.zero in
 136         let file_modified_by = try get_value "file_modified_by" value_to_string with Not_found -> "" in
 137         let file_encoding = try get_value "file_encoding" value_to_string with Not_found -> "" in
 138         let file_is_private =
 139           try get_value "file_is_private" value_to_bool with
 140           | Not_found -> false
 141           | _ -> try get_value "file_is_private" value_to_int64 <> 0L with _ -> false
 142         in
 143         let file_files =
 144           try
 145             let file_files = (get_value "file_files"
 146                   (value_to_list (fun v ->
 147                       match v with
 148                         SmallList [name; p1]
 149                       | List [name; p1] ->
 150                           value_to_string name, value_to_int64 p1
 151                       | _ -> assert false
 152                   ))) in
 153             file_files
 154           with _ -> []
 155         in
 156         let torrent = {
 157             torrent_name = file_name;
 158             torrent_filename = "";
 159             torrent_name_utf8 = file_name;
 160             torrent_comment = file_comment;
 161             torrent_pieces = file_chunks;
 162             torrent_piece_size = file_piece_size;
 163             torrent_files = file_files;
 164             torrent_length = file_size;
 165             torrent_created_by = file_created_by;
 166             torrent_creation_date = file_creation_date;
 167             torrent_modified_by = file_modified_by;
 168             torrent_encoding = file_encoding;
 169             torrent_private = file_is_private;
 170 (*
 171             torrent_nodes = file_nodes;
 172 *)
 173             torrent_announce =
 174             (match file_trackers with
 175               | h::q -> h
 176               | [] -> "");
 177             torrent_announce_list = file_trackers;
 178           } in
 179         let torrent_diskname = Filename.concat downloads_directory
 180             (file_name ^ ".torrent") in
 181         file_id, torrent, torrent_diskname
 182
 183   in
 184   let file_temp = try
 185       get_value "file_temp" value_to_string
 186     with Not_found ->
 187         let file_temp = Filename.concat !!DO.temp_directory
 188             (Printf.sprintf "BT-%s" (Sha1.to_string file_id)) in
 189         file_temp
 190   in
 191   let file = new_file file_id torrent torrent_diskname
 192                file_temp file_state user group in
 193
 194   let file_uploaded = try
 195       value_to_int64 (List.assoc "file_uploaded" assocs)
 196     with _ -> zero
 197   in
 198   file.file_uploaded <- file_uploaded;
 199
 200   (match file.file_swarmer with
 201       None -> ()
 202     | Some swarmer ->
 203         CommonSwarming.value_to_frontend swarmer assocs;
 204   );
 205
 206 (*
 207   (try
 208       ignore
 209         (get_value  "file_sources" (
 210           value_to_list (ClientOption.of_value file)))
 211     with e ->
 212         lprintf_nl "Exception %s while loading sources"
 213           (Printexc2.to_string e);
 214   );
 215 *)
 216   as_file file
 217
 218 let file_to_value file =
 219   try
 220     let assocs =
 221       [
 222         "file_temp", string_to_value (Unix32.filename (file_fd file));
 223         "file_piece_size", int64_to_value (file.file_piece_size);
 224         "file_name", string_to_value file.file_name;
 225         "file_uploaded", int64_to_value  (file.file_uploaded);
 226         "file_id", string_to_value (Sha1.to_string file.file_id);
 227         "file_trackers", (list_to_value string_to_value)
 228         (List.map (fun t -> show_tracker_url t.tracker_url) file.file_trackers);
 229 (* OK, but I still don't like the idea of forgetting all the clients.
 230 We should have a better strategy, ie rating the clients and connecting
 231 to them depending on the results of our last connections. And then,
 232 if we could not download enough in the last interval, ask the tracker to
 233 send us more clients.
 234
 235     "file_sources",
 236     list_to_value "BT Sources" (fun c ->
 237         ClientOption.to_value c) sources
 238 ;
 239   *)
 240       ]
 241     in
 242     let assocs =
 243       ("file_torrent_name", string_to_value file.file_torrent_diskname) ::
 244       ("file_hashes", array_to_value
 245           (to_value Sha1.option) file.file_chunks) ::
 246       ("file_files", list_to_value
 247           (fun (name, p1, _) ->
 248             SmallList [string_to_value name; int64_to_value p1])
 249         file.file_files) ::
 250       assocs
 251     in
 252     match file.file_swarmer with
 253       None -> assocs
 254     | Some swarmer ->
 255         CommonSwarming.frontend_to_value swarmer assocs
 256   with
 257     e ->
 258       lprintf_file_nl (as_file file) "exception %s in file_to_value"
 259         (Printexc2.to_string e); raise e
 260
 261
 262 let save_config () =
 263   Options.save_with_help bittorrent_ini
 264
 265
 266 let config_files_loaded = ref false
 267
 268 let load _ =
 269   begin try Options.load bt_stats_ini with Sys_error _ -> () end;
 270   begin try Options.load bt_dht_ini with Sys_error _ -> () end;
 271   check_client_uid ();
 272   config_files_loaded := true
 273
 274 let guptime = define_option bt_stats_section ["guptime"] "" int_option 0
 275
 276 let new_stats_array () =
 277   Array.init brand_count (fun _ ->
 278       { dummy_stats with brand_seen = 0 }
 279   )
 280
 281
 282 let gstats_array = define_option bt_stats_section ["stats"] ""
 283     (array_option StatsOption.t) (new_stats_array ())
 284
 285
 286 let _ =
 287   option_hook gstats_array (fun _ ->
 288       let old_stats = !!gstats_array in
 289       let old_len = Array.length old_stats in
 290       if old_len <> brand_count then
 291         let t = new_stats_array () in
 292         for i = 0 to old_len - 1 do
 293           t.(i) <- old_stats.(i)
 294         done;
 295         gstats_array =:= t
 296   )
 297
 298 let diff_time = ref 0
 299
 300 let sources_loaded = ref false  (* added 2.5.24 *)
 301
 302 let save _ =
 303   if !config_files_loaded then begin
 304 (*  lprintf "SAVING SHARED FILES AND SOURCES\n"; *)
 305       guptime =:= !!guptime + (last_time () - start_time) - !diff_time;
 306       diff_time := (last_time () - start_time);
 307       Options.save_with_help bt_stats_ini;
 308       Options.save_with_help bt_dht_ini;
 309     end
 310 (*  lprintf "SAVED\n";  *)
 311
 312 let guptime () = !!guptime - !diff_time
 313
 314 let rec update_options () =
 315   let update v =
 316       lprintf_nl "Updating options to version %i" v;
 317       options_version =:= v;
 318       update_options ()
 319   in
 320
 321   match !!options_version with
 322   | 0 ->
 323       let present = ref false in
 324       (* drop obsolete addresses, add new *)
 325       dht_bootstrap_nodes =:= List.filter (function
 326         | "router.utorrent.com", 6881 -> false
 327         | "router.transmission.com", 6881 -> false
 328         | "router.bittorrent.com", 8991 -> present := true; true
 329         | _ -> true) !!dht_bootstrap_nodes;
 330       if not !present then
 331         dht_bootstrap_nodes =:= ("router.bittorrent.com", 8991) :: !!dht_bootstrap_nodes;
 332       update 1
 333   | _ -> ()
 334
 335 let () =
 336   network.op_network_file_of_option <- value_to_file;
 337   file_ops.op_file_to_option <- file_to_value;
 338
 339   (* Shut up message "Network.save/load_complex_options not implemented by BitTorrent" *)
 340   network.op_network_load_complex_options <- load;
 341   network.op_network_save_complex_options <- save;
 342   network.op_network_update_options <- update_options;
 343   network.op_network_save_sources <- (fun _ -> ())