src/networks/direct_connect/dcComplexOptions.ml

   1 (* Copyright 2001, 2002 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 CommonInteractive
  21 open Printf2
  22 open Md4
  23 open CommonOptions
  24 open CommonClient
  25 open CommonFile
  26 open CommonRoom
  27 open CommonComplexOptions
  28 open CommonServer
  29 open CommonResult
  30 open CommonTypes
  31 open CommonGlobals
  32 open BasicSocket
  33 open Options
  34
  35 open DcTypes
  36 open DcOptions
  37 open DcGlobals
  38
  39 let log_prefix = "[dcCO]"
  40
  41 let lprintf_nl fmt =
  42   lprintf_nl2 log_prefix fmt
  43
  44 let dc_shared_files_ini = create_options_file "shared_files_dc.ini"
  45
  46 let dc_shared_section = file_section dc_shared_files_ini [] ""
  47
  48 (*
  49 let addr_to_value addr =
  50   match addr with
  51     AddrIp ip -> to_value Ip.option ip
  52   | AddrName s -> string_to_value s
  53
  54 let value_to_addr v =
  55   let ip = from_value Ip.option v in
  56   if ip <> Ip.null then AddrIp ip else AddrName (value_to_string v)
  57 *)
  58
  59 module SharedDcFileOption = struct
  60
  61   let value_to_shinfo v =
  62     (match v with
  63     | Options.Module assocs ->
  64         let sh_fname =
  65           (try
  66              value_to_filename (List.assoc "fname" assocs)
  67           with _ -> failwith "Bad DC shared file fullname" )
  68         in
  69         let sh_cname =
  70           (try
  71              value_to_string (List.assoc "cname" assocs)
  72           with _ -> failwith "Bad DC shared file codedname" )
  73         in
  74         let sh_sname =
  75           (try
  76             String.lowercase (List.nth (String2.splitn sh_cname '/' 1) 1) (* strip the "shared##" *)
  77           with _ -> failwith "Bad DC shared file codedname" )
  78         in
  79         let sh_root =
  80           (try
  81              value_to_string (List.assoc "root" assocs)
  82           with _ -> failwith "Bad DC shared file tiger root hash" )
  83         in
  84         (*let sh_tths =
  85           (try
  86             value_to_array (fun v ->
  87               TigerTree.of_string (value_to_string v)) (List.assoc "tths" assocs)
  88           with _ -> failwith "Bad DC shared file tiger root hashes" )
  89         in*)
  90         let sh_size =
  91           (try
  92              value_to_int64 (List.assoc "size" assocs)
  93           with _ -> failwith "Bad DC shared file size" )
  94         in
  95         {
  96           dc_shared_fullname = sh_fname;
  97           dc_shared_codedname = sh_cname;
  98           dc_shared_searchname = sh_sname;
  99           dc_shared_size = sh_size;
 100           dc_shared_tiger_list = [];
 101           dc_shared_tiger_root = sh_root;
 102           (*dc_shared_tiger_array = sh_tths;*)
 103           dc_shared_pos = Int64.zero;
 104           dc_shared_chunks = 0;
 105         }
 106     | _ -> failwith "Options: not a shared file info option" )
 107
 108   let shinfo_to_value dcsh =
 109     Options.Module [
 110       "fname", filename_to_value dcsh.dc_shared_fullname;
 111       "cname", string_to_value dcsh.dc_shared_codedname;
 112       "root", string_to_value dcsh.dc_shared_tiger_root;
 113       (*"tths", array_to_value TigerTree.hash_to_value dcsh.dc_shared_tiger_array;*)
 114       "size", int64_to_value dcsh.dc_shared_size;
 115     ]
 116
 117   let t = define_option_class "SharedDcFile" value_to_shinfo shinfo_to_value
 118 end
 119
 120 let dc_saved_shared_files = define_option dc_shared_section
 121     ["shared_files"] ""
 122     (list_option SharedDcFileOption.t) []
 123
 124 (* End of shared file definition *)
 125
 126
 127 let value_to_server  assocs =
 128   let get_value name conv = conv (List.assoc name assocs) in
 129 (*  let get_value_nil name conv =
 130     try conv (List.assoc name assocs) with _ -> []
 131   in *)
 132   let server_addr = get_value "server_addr" Ip.value_to_addr in
 133   let server_port = get_value "server_port" value_to_int in
 134   let t = Ip.ip_of_addr server_addr in (* DNS *)
 135   if (Ip.valid t) && (server_port>0) && (server_port<65536) then begin
 136     let h = new_server server_addr t server_port in
 137   h.server_name <- get_value "server_name" value_to_string;
 138   h.server_info <- get_value "server_info" value_to_string;
 139     h.server_autoconnect <- get_value "server_autoconnect" value_to_bool;
 140   as_server h.server_server
 141   end else failwith "Bad Server DNS"
 142
 143 let server_to_value h =
 144   let list = [
 145       "server_name", string_to_value h.server_name;
 146       "server_addr", Ip.addr_to_value h.server_addr;
 147       "server_info", string_to_value h.server_info;
 148       (*"server_nusers", int_to_value (Int64.to_int h.server_nusers);*)
 149       "server_port", int_to_value h.server_port;
 150       "server_autoconnect", bool_to_value h.server_autoconnect;
 151     ] in
 152   list
 153
 154
 155 (* parse options for files *)
 156 let value_to_file file_size file_state user group assocs =
 157   let get_value name conv = conv (List.assoc name assocs) in
 158 (*  let get_value_nil name conv =
 159     try conv (List.assoc name assocs) with _ -> []
 160   in*)
 161   let f_unchecked_tiger_root = get_value "file_root" value_to_string in
 162   let f_directory = get_value "file_dir" value_to_string in
 163   let f_name = get_value "file_filename" value_to_string in
 164   let f_size = get_value "file_size" value_to_int64 in
 165   let f_downloaded = get_value "file_downloaded" value_to_int64 in
 166   let f = DcGlobals.new_file f_unchecked_tiger_root f_directory f_name f_size user group in
 167   if (file_downloaded f) <> f_downloaded then
 168     failwith "Disk file size don't match downloaded info";
 169   if f_downloaded <> f_size then begin            (* check if file is downloaded already *)
 170     file_add f.file_file FileDownloading;
 171     (try
 172       ignore (
 173         get_value "file_sources" (value_to_list (fun v ->
 174           let name = value_to_string v in
 175           if name <> empty_string then begin
 176             let u = DcGlobals.new_user None name in
 177             let c = new_client_to_user_with_file u f in
 178             c.client_state <- DcDownloadWaiting f;
 179             c.client_pos <- f_downloaded;
 180           end
 181         ))
 182       )
 183     with e ->
 184       lprintf_nl "Exception (%s) while loading source" (Printexc2.to_string e) )
 185   end else begin
 186     file_add f.file_file FileDownloaded;   (* file is downloaded to temp - committing is needed *)
 187     remove_file_not_clients f              (* remove it immediately from dc *)
 188   end;
 189   as_file f.file_file
 190
 191 let file_to_value file =
 192   [
 193     "file_root", string_to_value file.file_unchecked_tiger_root;
 194     "file_dir",  string_to_value file.file_directory;
 195     (*"file_name", string_to_value file.file_name;*)
 196     (*"file_size", int64_to_value (file_size file);*)
 197     "file_downloaded", int64_to_value (file_downloaded file);
 198     "file_sources",
 199     list_to_value (fun c ->
 200 (*      let ip, port =
 201         (match c.client_addr with
 202         | None -> "",""
 203         | Some (cip , cport) ->
 204             (Ip.to_string cip), cport )
 205       in
 206       SmallList [*)
 207       (match c.client_name with
 208       | Some name -> string_to_value name
 209       | None -> string_to_value "" )
 210 (*        string_to_value ip;
 211         int_to_value port ]*)
 212     ) file.file_clients;
 213   ]
 214
 215 let client_to_value c =
 216   let name =
 217     (match c.client_name with
 218     | Some name -> string_to_value name
 219     | None -> raise Not_found )
 220   in
 221   (match c.client_addr with
 222   | None -> raise Not_found
 223   | Some (ip, port) ->
 224       let list = [
 225           "client_name", name;
 226           "client_ip", Ip.ip_to_value ip;
 227           "client_port", int_to_value port;
 228         ]
 229       in
 230       list )
 231
 232 let value_to_client is_friend assocs = (* CHECK *)
 233   let get_value name conv = conv (List.assoc name assocs) in
 234   let ip = get_value "client_ip" Ip.value_to_ip in
 235   let port = get_value "client_port" value_to_int in
 236   let name = get_value "client_name" value_to_string in
 237   let c = DcGlobals.new_client () in
 238   c.client_addr <- Some (ip, port);
 239   c.client_name <- Some name;
 240   (*  if is_friend then friend_add (as_client c.client_client);*)
 241   c
 242
 243 let load () =
 244   (try
 245     Options.load dc_shared_files_ini;
 246   with Sys_error _ ->
 247     Options.save_with_help dc_shared_files_ini );
 248   dc_config_files_loaded := true;
 249   lprintf_nl "config files loaded"
 250
 251 let save () =
 252   if !dc_config_files_loaded then begin
 253     Options.save_with_help dc_shared_files_ini;
 254   end
 255
 256 let _ =
 257   set_after_load_hook dc_shared_files_ini (fun _ ->
 258     let to_be_removed = ref [] in
 259     List.iter (fun n_dcsh ->
 260       (try                                               (* lets try to find existing dcsh info *)
 261         ignore (Hashtbl.find dc_shared_files_by_fullname n_dcsh.dc_shared_fullname);
 262         (*if (dcsh.dc_shared_size = n_dcsh.dc_shared_size) then begin
 263           if (dcsh.dc_shared_codedname = n_dcsh.dc_shared_codedname) then ()
 264           else  *)
 265         to_be_removed := n_dcsh :: !to_be_removed;
 266       with _ ->
 267         if (Sys.file_exists n_dcsh.dc_shared_fullname) &&                                  (* if file exists ... *)
 268            (Unix32.getsize n_dcsh.dc_shared_fullname = n_dcsh.dc_shared_size) then begin   (* and size matches   *)
 269           (*lprintf_nl "New shared file from option-file (%s)" n_dcsh.dc_shared_codedname;*)
 270           Hashtbl.add dc_shared_files_by_fullname n_dcsh.dc_shared_fullname n_dcsh;
 271           Hashtbl.add dc_shared_files_by_codedname n_dcsh.dc_shared_codedname n_dcsh;
 272           if (n_dcsh.dc_shared_tiger_root = empty_string) (*|| (n_dcsh.dc_shared_tiger_array = [||])*) then begin
 273             dc_files_to_hash := n_dcsh :: !dc_files_to_hash;
 274           end else begin
 275             Hashtbl.add dc_shared_files_by_hash n_dcsh.dc_shared_tiger_root n_dcsh;
 276           end;
 277           dc_add_shared_file dc_shared_tree n_dcsh (String2.split n_dcsh.dc_shared_codedname '/')
 278         end else to_be_removed := n_dcsh :: !to_be_removed )
 279     ) !!dc_saved_shared_files;
 280
 281     List.iter (fun dcsh ->
 282       (*lprintf_nl "Removing shared file from option-file (%s)" dcsh.dc_shared_codedname;*)
 283       dc_saved_shared_files =:= List2.removeq dcsh !!dc_saved_shared_files
 284     ) !to_be_removed;
 285   );
 286
 287   set_after_load_hook files_ini (fun _ ->
 288     lprintf_nl "LETS reverse clients list NOW";
 289   );
 290
 291   network.op_network_load_complex_options <- (fun _ -> load () );
 292   network.op_network_save_complex_options <- (fun _ -> save () );
 293   server_ops.op_server_sort <- (fun s ->
 294       connection_last_conn s.server_connection_control);
 295   network.op_network_server_of_option <- value_to_server;
 296   server_ops.op_server_to_option <- server_to_value;
 297   network.op_network_file_of_option <- value_to_file;
 298   file_ops.op_file_to_option <- file_to_value;
 299   client_ops.op_client_to_option <- client_to_value;
 300   network.op_network_client_of_option <- (fun is_friend c ->
 301       as_client (value_to_client is_friend c).client_client)
 302