src/networks/donkey/donkeyMain.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 Printf2
  21 open Options
  22
  23 open BasicSocket
  24 open TcpBufferedSocket
  25
  26 open CommonDownloads
  27 open CommonNetwork
  28 open CommonInteractive
  29 open CommonClient
  30 open CommonFile
  31 open CommonComplexOptions
  32 open CommonTypes
  33 open CommonOptions
  34 open CommonGlobals
  35
  36 open DonkeyMftp
  37 open DonkeyProtoCom
  38 open DonkeyServers
  39 open DonkeyComplexOptions
  40 open DonkeyOneFile
  41 open DonkeyFiles
  42 open DonkeyTypes
  43 open DonkeyGlobals
  44 open DonkeyClient
  45 open DonkeyThieves
  46 open DonkeyOptions
  47
  48 let log_prefix = "[EDK]"
  49
  50 let lprintf_nl fmt =
  51   lprintf_nl2 log_prefix fmt
  52
  53 let _ =
  54   network.op_network_is_enabled <- (fun _ -> !!enable_donkey);
  55   option_hook enable_donkey (fun _ ->
  56       if !CommonOptions.start_running_plugins then
  57         if !!enable_donkey then network_enable network
  58         else network_disable network);
  59   network.network_config_file <- [
  60     donkey_ini]
  61
  62 let hourly_timer timer =
  63   DonkeyClient.clean_groups ();
  64   DonkeyClient.clean_requests ();
  65   Hashtbl.clear udp_servers_replies;
  66   DonkeyThieves.clean_thieves ()
  67
  68 let quarter_timer timer =
  69   clean_join_queue_tables ()
  70
  71 let fivemin_timer timer =
  72   clients_root := []
  73
  74 let second_timer timer =
  75   (try
  76       DonkeySources.connect_sources connection_manager;
  77     with e ->
  78         if !verbose_sources > 2 then
  79           lprintf_nl "Exception %s while checking sources"
  80             (Printexc2.to_string e)
  81   )
  82
  83 let five_second_timer timer =
  84   DonkeyServers.check_server_connections ();
  85   DonkeyServers.walker_timer ();
  86   DonkeyOneFile.check_files_downloaded ();
  87   DonkeyServers.udp_walker_timer ();
  88   DonkeyShare.check_shared_files ()
  89
  90 let min_timer timer =
  91   DonkeySources.clean_sources (); (* Moved here from fivemin_timer. *)
  92   DonkeyServers.update_master_servers ();
  93   DonkeyServers.check_for_preferred_servers ();
  94  (try
  95       DonkeyServers.query_locations_timer ();
  96     with _ -> ());
  97   DonkeyShare.send_new_shared ()
  98
  99 let local_login () =
 100   if !!login = "" then !!global_login else !!login
 101
 102 let is_enabled = ref false
 103
 104 let disable enabler () =
 105   if !enabler then begin
 106       is_enabled := false;
 107       enabler := false;
 108       if !!enable_donkey then enable_donkey =:= false;
 109       Hashtbl2.safe_iter (fun s -> DonkeyServers.disconnect_server s Closed_by_user)
 110       servers_by_key;
 111       H.iter (fun c -> DonkeyClient.disconnect_client c Closed_by_user)
 112       clients_by_kind;
 113       (match !listen_sock with None -> ()
 114         | Some sock ->
 115             listen_sock := None;
 116             TcpServerSocket.close sock Closed_by_user);
 117       (match !udp_sock with None -> ()
 118         | Some sock ->
 119             udp_sock := None;
 120             UdpSocket.close sock Closed_by_user);
 121       servers_list := [];
 122       if !!enable_donkey then enable_donkey =:= false;
 123       DonkeyProtoOvernet.Overnet.disable ();
 124       DonkeyProtoKademlia.Kademlia.disable ()
 125     end
 126
 127 let reset_tags () =
 128   let module D = DonkeyProtoClient in
 129   let m = D.mldonkey_emule_proto in
 130
 131   let secident = if sec_ident_enabled () then 3 else 0 in
 132     m.emule_secident <- secident;
 133     m.emule_features <- secident;
 134
 135   let advertise_browse =
 136     match !!allow_browse_share with
 137         1 | 2 -> 0
 138       | _ -> 1
 139   in
 140    m.emule_noviewshared <- advertise_browse;
 141
 142   let emule_miscoptions1 = D.emule_miscoptions1 m in
 143   let emule_miscoptions2 = D.emule_miscoptions2 m in
 144   let emule_compatoptions = D.emule_compatoptions m in
 145   client_to_client_tags :=
 146   [
 147     string_tag (Field_KNOWN "name") (local_login ());
 148     int_tag (Field_KNOWN "port") !!donkey_port;
 149     int_tag (Field_KNOWN "version") protocol_version;
 150     int_tag (Field_KNOWN "emule_udpports") (!!donkey_port+4);
 151     int_tag (Field_KNOWN "emule_version") m.emule_version;
 152     int64_tag (Field_KNOWN "emule_miscoptions1") emule_miscoptions1;
 153     int64_tag (Field_KNOWN "emule_miscoptions2") emule_miscoptions2;
 154     int_tag (Field_KNOWN "emule_compatoptions") emule_compatoptions;
 155   ];
 156
 157 (* server capabilities *)
 158   let extended = ref 0x0 in
 159   extended := !extended lor 0x01; (* support of compression *)
 160 (*extended := !extended lor 0x02;    IP in login, deprecated *)
 161   extended := !extended lor 0x04; (* support of auxport *)
 162   extended := !extended lor 0x08; (* newtags *)
 163 (*extended := !extended lor 0x10; (* unicode *) *)
 164   extended := !extended lor 0x100; (* files > 4GB *)
 165 (*extended := !extended lor 0x200; (* support crypt *) *)
 166 (*extended := !extended lor 0x400; (* request crypt *) *)
 167 (*extended := !extended lor 0x800; (* require crypt *) *)
 168
 169   client_to_server_tags :=
 170   [
 171     string_tag (Field_KNOWN "name") (local_login ());
 172     int_tag (Field_KNOWN "version") protocol_version;
 173     int_tag (Field_KNOWN "extended") !extended;
 174     int_tag (Field_KNOWN "emule_version") m.emule_version;
 175   ];
 176
 177   client_to_server_reply_tags :=
 178   [
 179     string_tag (Field_KNOWN "name") (local_login ());
 180     int_tag (Field_KNOWN "version") protocol_version;
 181     int_tag (Field_KNOWN "emule_udpports") (!!donkey_port+4);
 182     int64_tag (Field_KNOWN "emule_miscoptions1") emule_miscoptions1;
 183     int64_tag (Field_KNOWN "emule_miscoptions2") emule_miscoptions2;
 184     int_tag (Field_KNOWN "emule_version") m.emule_version;
 185   ];
 186
 187   emule_info.DonkeyProtoClient.EmuleClientInfo.tags <- [
 188     int_tag (Field_KNOWN "compression") m.emule_compression;
 189     int_tag (Field_KNOWN "udpver") m.emule_udpver;
 190     int_tag (Field_KNOWN "udpport") (!!donkey_port+4);
 191     int_tag (Field_KNOWN "sourceexchange") m.emule_sourceexchange;
 192     int_tag (Field_KNOWN "comments") m.emule_comments;
 193     int_tag (Field_KNOWN "compatibleclient") !DonkeyProtoClient.compatibleclient;
 194     int_tag (Field_KNOWN "extendedrequest") m.emule_extendedrequest;
 195     int_tag (Field_KNOWN "features") m.emule_features;
 196
 197   ];
 198   overnet_connect_tags :=
 199   [
 200     string_tag (Field_KNOWN "name") (local_login ());
 201     int_tag (Field_KNOWN "version") !!DonkeyProtoOvernet.overnet_protocol_connect_version;
 202   ];
 203   overnet_connectreply_tags :=
 204   [
 205     string_tag (Field_KNOWN "name") (local_login ());
 206     int_tag (Field_KNOWN "version") !!DonkeyProtoOvernet.overnet_protocol_connectreply_version;
 207   ]
 208
 209 let enable () =
 210   if not !is_enabled then
 211     let enabler = ref true in
 212     is_enabled := true;
 213     network.op_network_disable <- disable enabler;
 214     if Autoconf.donkey_sui_works () then
 215     (try
 216       client_public_key := DonkeySui.SUI.load_key (!!client_private_key)
 217     with _ -> ());
 218     if not !!enable_donkey then enable_donkey =:= true;
 219
 220     try
 221 (*  DonkeyClient.verbose := true; *)
 222
 223 (**** LOAD OTHER OPTIONS ****)
 224
 225 (* TODO INDEX      DonkeyIndexer.load_comments comment_filename; *)
 226 (* TODO INDEX      DonkeyIndexer.install_hooks (); *)
 227 (* TODO INDEX x CommonGlobals.do_at_exit (fun _ -> DonkeyIndexer.save_history ()); *)
 228
 229 (*
 230     BasicSocket.add_timer 10. (fun timer ->
 231         BasicSocket.reactivate_timer timer;
 232         match !indexer with
 233           None -> ()
 234         | Some (t_in, t_out) ->
 235             if TcpBufferedSocket.can_write t_out then begin
 236                 TcpBufferedSocket.close t_out "timed";
 237                 indexer := None;
 238               end)
 239 *)
 240
 241       Hashtbl.iter (fun _ file ->
 242           try
 243             if file_state file <> FileDownloaded then begin (* add not finished files *)
 244                 current_files := file :: !current_files;
 245 (*                set_file_size file (file_size file) *)
 246               end else begin
 247                 try
 248                   let file_disk_name = file_disk_name file in
 249                   if Unix32.file_exists file_disk_name &&
 250                     Unix32.getsize file_disk_name <> Int64.zero then begin
 251                     (* getsize writable=false is ok because file has state FileDownloaded *)
 252                       lprintf_nl "FILE DOWNLOADED";
 253
 254                       DonkeyOneFile.declare_completed_file file;
 255                     end
 256                   else raise Not_found
 257                 with _ ->
 258                     file_commit (as_file file)
 259               end
 260           with e ->
 261               lprintf_nl "Exception %s while recovering download %s"
 262                 (Printexc2.to_string e) (file_disk_name file);
 263       ) files_by_md4;
 264
 265 (* Normally, we should check that downloaded files are still there.  *)
 266       let list = ref [] in
 267       List.iter (fun file ->
 268
 269 (* Hum, maybe we should not remove all these descriptions, as they might
 270 be useful when users want to share files that they had already previously
 271   shared *)
 272           let key = (file.sh_name, file.sh_size, file.sh_mtime) in
 273           (try
 274           if Unix32.file_exists file.sh_name &&
 275             not (Hashtbl.mem shared_files_info key)
 276             then begin
 277               Hashtbl.add shared_files_info key file;
 278               list := file :: !list
 279             end
 280           with e ->
 281             lprintf_nl "ignoring share: %s" (Printexc2.to_string e))
 282       ) !!known_shared_files;
 283       known_shared_files =:= !list;
 284
 285 (**** CREATE WAITING SOCKETS ****)
 286       let rec find_port new_port =
 287         try
 288           let sock = TcpServerSocket.create
 289               "donkey client server"
 290               (Ip.to_inet_addr !!client_bind_addr)
 291             !!donkey_port ~backlog:!!max_upload_slots (client_connection_handler false) in
 292
 293           TcpServerSocket.set_accept_controler sock connections_controler;
 294           listen_sock := Some sock;
 295           donkey_port =:= new_port;
 296
 297           begin try
 298               let sock =
 299                 (UdpSocket.create (Ip.to_inet_addr !!client_bind_addr)
 300                   (!!donkey_port + 4)
 301                   (udp_handler DonkeyUdp.udp_client_handler))
 302               in
 303               udp_sock := Some sock;
 304               UdpSocket.set_write_controler sock udp_write_controler;
 305             with e ->
 306                 lprintf_nl "Exception %s while binding UDP socket"
 307                   (Printexc2.to_string e);
 308           end;
 309           sock
 310         with e ->
 311             if !find_other_port then find_port (new_port+1)
 312             else  raise e
 313       in
 314       let sock = find_port !!donkey_port in
 315       DonkeyProtoOvernet.Overnet.enable ();
 316       DonkeyProtoKademlia.Kademlia.enable ();
 317
 318       begin
 319         match Unix.getsockname (BasicSocket.fd (TcpServerSocket.sock sock)) with
 320           Unix.ADDR_INET (ip, port) ->
 321             assert (!!donkey_port = port);
 322         | _ -> failwith "Bad socket address"
 323       end;
 324
 325       reset_tags ();
 326
 327       Options.option_hook global_login reset_tags;
 328       Options.option_hook login reset_tags;
 329       Options.option_hook enable_sui reset_tags;
 330       Options.option_hook allow_browse_share reset_tags;
 331
 332 (**** START TIMERS ****)
 333       add_session_option_timer enabler check_client_connections_delay
 334         (fun _ ->
 335           DonkeyUdp.extent_search ();
 336           DonkeyServers.udp_query_sources ()
 337          );
 338
 339       add_session_timer enabler 3600. hourly_timer;
 340       add_session_timer enabler 60. min_timer;
 341       add_session_timer enabler 300. fivemin_timer;
 342       add_session_timer enabler 900. quarter_timer;
 343       add_session_timer enabler 1. second_timer;
 344       add_session_timer enabler 5. five_second_timer;
 345       add_session_option_timer enabler remove_old_servers_delay
 346           DonkeyServers.remove_old_servers;
 347
 348       DonkeyComplexOptions.load_sources ();
 349
 350 (**** START PLAYING ****)
 351 (* removed, just wait for timer to start the action *)
 352 (*
 353     (try DonkeyUdp.force_check_locations () with _ -> ());
 354     (try force_check_server_connections true with _ -> ());
 355 *)
 356
 357   with e ->
 358       lprintf_nl "Error: Exception %s during startup"
 359         (Printexc2.to_string e)
 360
 361
 362 let rec update_options () =
 363   let update v =
 364       lprintf_nl "Updating options to version %i" v;
 365       options_version =:= v;
 366       update_options ()
 367   in
 368
 369   match !!options_version with
 370     0 ->
 371       if !!max_sources_per_file = 20000 then
 372         max_sources_per_file =:= 5000;
 373       update 1
 374   | 1 ->
 375       if !!upload_timeout = 1800. then
 376         upload_timeout =:= 60.;
 377       update 2
 378   | 2 ->
 379       if !!upload_timeout = 60. then
 380         upload_timeout =:= 600.;
 381       update 3
 382   | 3 ->
 383       propagate_sources =:= false;
 384       update_server_list_server =:= false;
 385       upload_full_chunks =:= true;
 386       update 4
 387   | _ -> ()
 388
 389
 390 let _ =
 391
 392 (* TODO INDEX  DonkeyIndexer.init (); *)
 393
 394 (*
 395   file_ops.op_file_commit <- (fun file ->
 396       DonkeyInteractive.save_file file
 397         (DonkeyInteractive.saved_name file);
 398       lprintf "SAVED\n";
 399 );
 400   *)
 401   network.op_network_enable <- enable;
 402   network.op_network_update_options <- update_options;
 403 (*  network.network_config_file <- []; *)
 404   network.op_network_info <- (fun n ->
 405       {
 406         network_netnum = network.network_num;
 407         network_config_filename = (match network.network_config_file with
 408             [] -> "" | opfile :: _ -> options_file_name opfile);
 409         network_netname = network.network_name;
 410         network_netflags = network.network_flags;
 411         network_enabled = network_is_enabled network;
 412         network_uploaded = !donkey_upload_counter;
 413         network_downloaded = !donkey_download_counter;
 414         network_connected_servers = List.length (connected_servers ());
 415       });
 416   network.op_network_ports <- (fun _ ->
 417     [
 418     !!donkey_port, "client_port TCP";
 419     !!donkey_port+4, "client_port UDP";
 420     !overnet_port_info, "overnet_port TCP+UDP";
 421     !kademlia_port_info, "kademlia_port UDP";
 422     ]);
 423   network.op_network_porttest_result <-
 424     (fun _ -> match !DonkeyInteractive.porttest_result with
 425         | PorttestResult (time, s) ->
 426             PorttestResult (time, (String2.dehtmlize s))
 427         | _ -> !DonkeyInteractive.porttest_result);
 428   CommonInteractive.register_gui_options_panel "eDonkey"
 429     gui_donkey_options_panel;
 430   CommonInteractive.register_gui_options_panel "Overnet"
 431     DonkeyProtoOvernet.Overnet.gui_overnet_options_panel;
 432   CommonInteractive.register_gui_options_panel "Kademlia"
 433     DonkeyProtoKademlia.Kademlia.gui_overnet_options_panel
 434
 435
 436 let _ =
 437   CommonInteractive.add_main_options
 438
 439     [
 440     "-dump", Arg.String (fun file ->
 441         DonkeyImport.dump_file file), " <filename> : dump file";
 442     "-known", Arg.String (fun file ->
 443         let module K = DonkeyImport.Known in
 444         let s = File.to_string file in
 445         let t = K.read s in
 446         K.print t;
 447         lprint_newline ();
 448     ), " <filename> : print a known.met file";
 449     "-part", Arg.String (fun file ->
 450         let module K = DonkeyImport.Part in
 451         let s = File.to_string file in
 452         let t = K.read s in
 453         K.print t;
 454         lprint_newline ();
 455     ), " <filename> : print a .part.met file";
 456     "-server", Arg.String (fun file ->
 457         let module K = DonkeyImport.Server in
 458         let s = File.to_string file in
 459         let t = K.read s in
 460         K.print t;
 461         lprint_newline ();
 462         exit 0
 463     ), " <filename> : print a server.met file";
 464     "-pref", Arg.String (fun file ->
 465         let module K = DonkeyImport.Pref in
 466         let s = File.to_string file in
 467         let t = K.read s in
 468         K.print t;
 469         lprint_newline ();
 470     ), " <filename> : print a server.met file";
 471     "-peers", Arg.String (fun file ->
 472         let module K = DonkeyOvernetImport.Peer in
 473         let s = File.to_string file in
 474         let t = K.read s in
 475         K.print t;
 476         lprint_newline ();
 477         exit 0
 478     ), " <filename> : print a contact.dat file";
 479   ]