(* Copyright 2001, 2002 b8_bavard, b8_fee_carabine, INRIA *)
(*
    This file is part of mldonkey.

    mldonkey is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    mldonkey is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with mldonkey; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
*)

open Options
open Int64ops
open Printf2

open BasicSocket

open CommonInteractive

open CommonDownloads
open CommonTypes
open CommonOptions
open CommonGlobals
open CommonNetwork

open DriverInterface

module Dp500 = DriverLink.DP500(struct

      module CommonTypes = CommonTypes
      module CommonFile = CommonFile
      module CommonOptions = CommonOptions

      let incoming_directory () =
        (CommonComplexOptions.incoming_files ()).shdir_dirname
      let files () = !!CommonComplexOptions.files

    end)

open Gettext (* open last  as most modules redefine _s and _b *)

let _s x = _s "DriverMain" x
let _b x = _b "DriverMain" x

let keep_console_output = ref false
let pid = ref ""

let do_daily () =
  incr CommonWeb.days

let minute_timer () =
  CommonShared.shared_check_files ();
  CommonUploads.upload_credit_timer ();
  CommonInteractive.force_download_quotas ();
  CommonResult.dummy_result.result_time <- last_time ();
  (try
      Int64Swarmer.verify_some_chunks ()
    with _ -> ()
  );
  CommonClient.clear_upload_slots ();
  if !!auto_commit then
    List.iter (fun file ->
        file_commit file
    ) !!CommonComplexOptions.done_files

let hourly_timer timer =
  incr CommonWeb.hours;
  CommonWeb.load_web_infos false;
  if !CommonWeb.hours mod !!compaction_delay = 0 then Gc.compact ();
  if !!backup_options_delay <> 0
     && !CommonWeb.hours mod !!backup_options_delay = 0 then
       CommonComplexOptions.backup_options ();
  DriverControlers.check_calendar ();
  CommonWeb.connect_redirector ();
  CommonFile.propose_filenames ()


let second_timer timer =
  (try
      update_link_stats ()
    with e ->
        lprintf_nl (_b "Exception %s") (Printexc2.to_string e));
	  (try
     CommonUploads.refill_upload_slots ()
   with e ->
        lprintf_nl (_b "Exception %s") (Printexc2.to_string e));
  CommonUploads.reset_upload_timer ();
  CommonUploads.shared_files_timer ();
  ()

let start_interfaces () =


  if !!http_port <> 0 then begin try
        ignore (DriverControlers.create_http_handler ());
      with e ->
          lprintf_nl (_b "Exception %s while starting HTTP interface")
            (Printexc2.to_string e);
    end;

  ignore (find_port  "telnet server" !!telnet_bind_addr
      telnet_port DriverControlers.telnet_handler);

  Dp500.start ();

  if !!chat_port <> 0 then begin
      ignore (find_port "chat server" !!chat_bind_addr
          chat_port DriverControlers.chat_handler);
      try
        CommonChat.send_hello ()
      with _ -> if !verbose then lprintf (_b "CommonChat.send_hello failed");
    end;

  gui_server_sock := find_port "gui server"  !!gui_bind_addr
    gui_port gui_handler;
  if !!gift_port <> 0 then
    ignore (find_port "gift server"  !!gui_bind_addr
        gift_port gift_handler);

  add_infinite_option_timer update_gui_delay DriverInterface.update_gui_info;
  add_infinite_timer 1. second_timer


let _ =
  CommonWeb.add_web_kind "motd.html" (fun _ filename ->
      lprintf_nl (_b "motd.html changed");
    motd_html =:= File.to_string filename
  );
  CommonWeb.add_web_kind "motd.conf" (fun _ filename ->
    let ic = open_in filename in
    try
      while true do
	let line = input_line ic in
	let cmd, args = String2.cut_at line ' ' in
	let name, value = String2.cut_at args ' ' in
	match cmd with
	  "set" ->
            CommonInteractive.set_fully_qualified_options name value
	| "add_item" ->
            CommonInteractive.add_item_to_fully_qualified_options name value
	| "del_item" ->
            CommonInteractive.del_item_from_fully_qualified_options name value
	| _ ->
	    lprintf_nl (_b "UNUSED LINE: %s") line

      done;
    with
    | End_of_file ->
	close_in ic
    | e -> lprintf_nl (_b "Error while reading motd.conf(%s): %s") filename
	(Printexc2.to_string e);
	close_in ic
  );
  CommonWeb.add_web_kind "guarding.p2p" (fun _ filename ->
      Ip_set.bl := Ip_set.load filename
(*      Ip_set.bl := Ip_set.load_merge !Ip_set.bl filename *)
  )



let save_mlsubmit_reg () =

(* Generate the mlsubmit.reg file *)

  let file = Printf.sprintf

   "Windows Registry Editor Version 5.00

[HKEY_CLASSES_ROOT\\ed2k]
@=\"URL: ed2k Protocol\"
\"URL Protocol\"=\"\"

[HKEY_CLASSES_ROOT\\ed2k\\shell]

[HKEY_CLASSES_ROOT\\ed2k\\shell\\open]

[HKEY_CLASSES_ROOT\\ed2k\\shell\\open\\command]
@=\"\\\"IEXPLORE.EXE\\\" \\\"http://%s:%s@%s:%d/submit?q=dllink+%%1\\\"\"
"

    "admin" "" (Ip.to_string (client_ip None)) !!http_port
  in
  File.from_string (Filename.concat file_basedir "mlsubmit.reg") file;

(* Generate the mldonkey_submit file *)

  let file = Printf.sprintf

"#!%s

# Submit an eDonkey download request to mldonkey
#
# Argument(s): An ed2k URI of the form:
#
# ed2k://|file|<filename>|<filesize>|<MD4-sum|
use LWP::UserAgent;

($#ARGV >= 0) || die \"Usage: mldonkey_submit <ed2kURI> ...\n\";

$vars{'HTTPURL'} = \"http://%s:%d\";
$vars{'HTTPUSER'} = \"%s\";
$vars{'HTTPPASS'} = \"%s\";

my $ua = LWP::UserAgent->new;

while (my $uri = shift @ARGV) {
	$_ = URI::Escape::uri_unescape($uri);
	if (/^ed2k:\\/\\/\\|file\\|[^|]+\\|(\\d+)\\|([\\dabcdef]+)\\|$/) {
		my $size = $1;
		my $md4 = $2;
		my $req = HTTP::Request->new(
			GET => \"$vars{'HTTPURL'}/submit?q=dllink+$uri\"
		);
		if (($vars{'HTTPUSER'}) && ($vars{'HTTPPASS'})) {
			$req->authorization_basic($vars{'HTTPUSER'},
				$vars{'HTTPPASS'});
		}
		my $response = $ua->request($req);
		if (!($response->is_success)) {
			print $response->error_as_HTML;
			exit 1;
		}
	} else {
		print \"Not an ed2k URI: $_\n\";
	}
}
"
      Autoconf.perl_path
    (Ip.to_string (client_ip None)) !!http_port
    "admin" ""
  in
  File.from_string (Filename.concat file_basedir "mldonkey_submit") file;
  Unix2.chmod (Filename.concat file_basedir "mldonkey_submit") 0o755

let load_config () =

  DriverInterface.install_hooks ();

(**** LOAD OPTIONS ****)

  let exists_downloads_ini =
    Sys.file_exists (options_file_name downloads_ini) in
  let exists_users_ini =
    Sys.file_exists (options_file_name users_ini)
  in
  if not exists_users_ini && exists_downloads_ini then
    begin
      lprintf_nl "No config file (users.ini) found. Importing users from downloads.ini.";
      ( try Unix2.copy "downloads.ini" "users.ini" with _ -> () );
    end;

  let ini_files_exist = Sys.file_exists (options_file_name downloads_ini) in

  (try
      Options.load downloads_ini;
      Options.load users_ini;
    with e ->
        lprintf_nl "Exception %s during options load" (Printexc2.to_string e);
        exit 70);

  (* Here, we try to update options when a new version of mldonkey is
     used. For example, we can add new web_infos... *)
  CommonOptions.update_options ();

  CommonMessages.load_message_file ();
  if !!html_mods then begin
      if !!html_mods_style > 0 && !!html_mods_style < Array.length CommonMessages.styles then
        commands_frame_height =:= CommonMessages.styles.(!!html_mods_style).CommonMessages.frame_height;
      CommonMessages.colour_changer ();
    end;
  networks_iter_all (fun r ->
(*      lprintf "(n) loading network config file\n"; *)
      List.iter (fun opfile ->
          try
            Options.load opfile
          with Sys_error _ ->
              Options.save_with_help opfile
      )
      r.network_config_file
  );


(**** PARSE ARGUMENTS ***)

  let more_args = ref [] in


  more_args := !more_args
    @ (Options.simple_args "" downloads_ini);
  more_args := !more_args
    @ (Options.simple_args "" users_ini);

  networks_iter_all (fun r ->
      List.iter (fun opfile ->
          let prefix = r.network_shortname ^ "-" in
          let args = simple_args prefix opfile in
          let args = List2.tail_map (fun (arg, spec, help) ->
                (Printf.sprintf "-%s" arg, spec, help)) args
          in
          more_args := !more_args @ args
      ) r.network_config_file
  );

  Arg.parse ([
      "-v", Arg.Unit (fun _ ->
          lprintf_nl "%s" (CommonGlobals.version ());
          exit 0), _s " : print version number and exit";
      "-exit", Arg.Unit (fun _ -> exit 0), ": exit immediatly";
      "-format", Arg.String (fun file ->
          ignore (CommonMultimedia.get_info file)),
          _s  " <filename> : check file format";
      "-test_ip", Arg.String (fun ip ->
          lprintf_nl "%s = %s" ip (Ip.to_string (Ip.of_string ip));
          exit 0), _s "<ip> : undocumented";
      "-check_impl", Arg.Unit (fun _ ->
          CommonNetwork.check_network_implementations ();
          CommonClient.check_client_implementations ();
          CommonServer.check_server_implementations ();
          CommonFile.check_file_implementations ();
(*          CommonResult.check_result_implementations (); *)
          lprint_newline ();
          exit 0),
      _s " : display information on the implementations";
      "-stdout", Arg.Unit (fun _ ->
          keep_console_output := true;
          log_to_file stdout;
      ),
       _s ": keep output to stdout after startup";
       "-stderr", Arg.Unit (fun _ ->
           keep_console_output := true;
           log_to_file stderr;
       ),
       _s ": keep output to stderr after startup";
      "-daemon", Arg.Unit (fun _ ->
          (* Removed due to savannah bug #11514 . *)
          lprintf_nl "\n\nOption -daemon was removed.\nUse 'mlnet > /dev/null 2>&1 &' instead. Exiting...";
          exit 64), _s " : this argument was removed, core will exit";
      "-find_port", Arg.Set find_other_port,
      _s " : find another port when one is already used";
      "-pid", Arg.String (fun s -> pid := s;
      ),
       _s ": directory for pid file";
    ] @
      !more_args
      @
    !main_options)
    (fun file -> ()
(*      Files.dump_file file; exit 0 *)
  ) "";

  if not ini_files_exist && not !keep_console_output then log_file =:= "mlnet.log";

  (**** CREATE DIRS   ****)

  List.iter (fun s ->
      Unix2.safe_mkdir s.shdir_dirname;
      if s.shdir_strategy = "incoming_directories" ||
         s.shdir_strategy = "incoming_files" then
	Unix2.can_write_to_directory s.shdir_dirname
  ) !!CommonComplexOptions.shared_directories;
  Unix2.safe_mkdir "searches";
  Unix2.can_write_to_directory "searches";
  Unix2.safe_mkdir !!temp_directory;
  Unix2.can_write_to_directory !!temp_directory

let _ =

  let t = Unix.localtime (Unix.time ()) in
  if (t.Unix.tm_year<=104) then
    begin
      lprintf_nl (_b "\n\n\nYour system has a system date earlier than 2004, please correct it.");
      lprintf_nl (_b "MLdonkey can not work with such a system date, exiting...");
      CommonGlobals.exit_properly 71
    end;

  (
    let hostname = "www.mldonkey.net" in
    try
      ignore(Ip.from_name hostname)
    with
     e ->
        lprintf (_b "\nDNS resolution does not work! Looking up %s failed with %s.")
           hostname (Printexc2.to_string e);
	lprintf "
The core therefore is unable to get eDonkey serverlists and loading
.torrent files via dllink from websites is also impossible.
If you are using MLDonkey in a chroot environment you should
consider reading this article to get DNS support back:
http://mldonkey.berlios.de/modules.php?name=Wiki&pagename=Chroot\n\n");
  (
    let real_glibc_version = MlUnix.glibc_version_num () in
      if real_glibc_version <> Autoconf.glibc_version
         && real_glibc_version <> "" then
        lprintf (_b"
Attention!
This core is running with glibc %s but it was compiled with glibc %s.
This can lead to unexpected behaviour. Consider compiling the core yourself
or getting a binary compiled with glibc %s.\n\n")
          real_glibc_version Autoconf.glibc_version Autoconf.glibc_version
  );
  load_config ();
  
  add_infinite_option_timer download_sample_rate CommonFile.sample_timer;

(*  lprintf "(1) CommonComplexOptions.load\n"; *)
  CommonComplexOptions.load ();
  CommonUploads.load ();

(*  lprintf "(2) CommonComplexOptions.load done\n"; *)
  begin
    let old_save_results = !!save_results in
    save_results =:= 0;
    CommonComplexOptions.save ();
    CommonUploads.save ();
    save_results =:= old_save_results;
  end;

(*  lprintf "(3) networks_iter load_complex_options\n"; *)
  lprintf_nl (_b "Check http://www.mldonkey.net/ for updates");
  networks_iter (fun r -> network_load_complex_options r);
  lprintf (_b "%senabling networks: ") (log_time ());
  networks_iter (fun r ->
(*      lprintf "(4) networks_iter enabling\n"; *)
      lprintf (_b "%s ") r.network_name;
      network_enable r;
(* are there drawbacks to start recover_temp unconditionally here ? *)
      if !!recover_temp_on_startup then
        network_recover_temp r;
  );
  lprintf (_b "\n%sdisabled networks: ") (log_time ());
  let found = ref false in
    networks_iter_all (fun r ->
        if not (network_is_enabled r) then
	  begin
	    found := true;
            lprintf (_b "%s ") r.network_name
	  end);
  if not !found then lprintf (_b "none");
  lprint_newline ();
  networks_iter_all (fun n -> network_update_options n);
  CommonOptions.start_running_plugins := true;
  CommonInteractive.force_download_quotas ();

  TcpBufferedSocket.set_max_connections_per_second
    (fun _ -> !!max_connections_per_second);

  add_infinite_option_timer save_options_delay (fun timer ->
      DriverInteractive.save_config ());
  start_interfaces ();

  add_infinite_timer 60. minute_timer;
  add_infinite_timer 3600. hourly_timer;
  add_infinite_timer 0.1 CommonUploads.upload_download_timer;

  List.iter
    CommonShared.shared_add_directory
  !!CommonComplexOptions.shared_directories;

  add_infinite_timer 1800. (fun timer ->
      DriverInteractive.browse_friends ());

  Options.prune_file downloads_ini;
  Options.prune_file users_ini;
(*  Options.prune_file downloads_expert_ini; *)
  add_timer 10. (fun _ -> try CommonWeb.load_web_infos true with _ -> ());
  lprintf_nl (_b "To command: telnet %s %d")
	(if !!telnet_bind_addr = Ip.any then "127.0.0.1"
		else Ip.to_string !!telnet_bind_addr)  !!telnet_port;
  lprintf_nl (_b "Or with browser: http://%s:%d")
	(if !!http_bind_addr = Ip.any then "127.0.0.1"
		else Ip.to_string !!http_bind_addr)  !!http_port;
  lprintf_nl (_b "For a GUI check out http://sancho-gui.sourceforge.net");
  lprintf_nl (_b "Connect to IP %s, port %d")
	(if !!gui_bind_addr = Ip.any then "127.0.0.1"
		else Ip.to_string !!gui_bind_addr)  !!gui_port;
  lprintf_nl (_b "If you connect from a remote machine adjust allowed_ips");
  if Autoconf.system = "cygwin" && not !keep_console_output then lprintf (_b "%s") win_message;

  add_init_hook (fun _ ->
      if not !gui_included && ( !!start_gui || !!ask_for_gui ) then
      (try
          let _ = Sys.getenv("DISPLAY") in
          if !!start_gui && Sys.file_exists !!mldonkey_gui then
            ignore (Sys.command (Printf.sprintf "%s &" !!mldonkey_gui))
          else
          let asker = Filename.concat !!mldonkey_bin "mlguistarter" in
          if !!ask_for_gui  && Sys.file_exists !!mldonkey_gui &&
            Sys.file_exists asker then
            ignore (Sys.command (Printf.sprintf "%s %s&" asker !!mldonkey_gui));
        with Not_found ->
            lprintf_nl (_b "Not running under X, not trying to start the GUI")
            );
  );

  if !!run_as_user <> "" then begin
      try
        let new_pw = Unix.getpwnam !!run_as_user in
        MlUnix.setuid new_pw.Unix.pw_uid;
        let pw = Unix.getpwuid (Unix.getuid()) in
        lprintf_nl (_b "mldonkey is now running as user %s") pw.Unix.pw_name;
      with e ->
          lprintf_nl (_b "Exception %s trying to set user_uid [%s]")
          (Printexc2.to_string e) !!run_as_user;
          exit 67
    end;

  if !!run_as_useruid <> 0 then begin
      try
        MlUnix.setuid !!run_as_useruid;
        lprintf_nl (_b "mldonkey is now running as uid %d")  !!run_as_useruid;
      with e ->
          lprintf_nl (_b "Exception %s trying to set user_uid [%d]")
          (Printexc2.to_string e) !!run_as_useruid;
          exit 67
    end;

  if !!create_mlsubmit then save_mlsubmit_reg ();
  DriverInteractive.initialization_completed := true;
  DriverInteractive.save_config ();

  if not Autoconf.windows then
    MlUnix.set_signal  Sys.sigchld
      (Sys.Signal_handle (fun _ -> if !verbose then lprintf_nl "Received SIGCHLD, doing nothing"));

  if not Autoconf.windows then
    MlUnix.set_signal  Sys.sighup
      (Sys.Signal_handle (fun _ ->
	 lprintf_nl "Received SIGHUP, closing all files/sockets";
         BasicSocket.close_all ();
	 Unix32.close_all ()
         ));

  if not Autoconf.windows then
    MlUnix.set_signal  Sys.sigpipe
      (Sys.Signal_handle (fun _ -> if !verbose then lprintf_nl "Received SIGPIPE, doing nothing"));

  MlUnix.set_signal  Sys.sigint
    (Sys.Signal_handle (fun _ -> lprintf_nl "Received SIGINT, stopping MLDonkey...";
        CommonInteractive.clean_exit 0));

  MlUnix.set_signal  Sys.sigterm
    (Sys.Signal_handle (fun _ -> lprintf_nl "Received SIGTERM, stopping MLDonkey...";
        CommonInteractive.clean_exit 0));

  if !verbose then lprintf_nl (_b "Activated system signal handling")

let _ =
  let security_space_filename = "config_files_space.tmp" in
  begin
(* Create a 'config_files_security_space' megabytes file to protect some space
for config files at the end. *)
    try
      let security_space_fd = Unix32.create_rw security_space_filename in
      let _ =
        let len = 32768 in
        let len64 = Int64.of_int len in
        let s = String.create len in
        let pos = ref zero in
        for i = 1 to !!config_files_security_space do
          for j = 1 to 32 do (* 32 = 1 MB / 32kB *)
            Unix32.write security_space_fd !pos s 0 len;
            pos := !pos ++ len64
          done
        done
      in
      Unix32.close security_space_fd;
    with _ ->
        lprintf_nl (_b "Cannot create Security space file:");
        lprintf_nl (_b " not enough space on device or bad permissions");
        lprintf_nl (_b "Exiting...");
        exit 73;
  end;
  Unix32.external_start (CommonGlobals.version());

  (
    let pid_filename =
      Printf.sprintf "%s.pid" (Filename.basename Sys.argv.(0))
    in
    let pid_file, s =
        Filename.concat !pid pid_filename,
	Printf.sprintf "%s\n" (string_of_int(Unix.getpid()))
    in
    let oc = open_out pid_file in
    output_string oc s;
    close_out oc;
    CommonGlobals.do_at_exit (fun _ -> try Sys.remove pid_file with _ -> ());
    if !verbose then
      lprintf_nl (_b "Starting with pid %s") (string_of_int(Unix.getpid ()))
  );

(* When a core is spawned from a gui, the only way to know the startup has
   succeeded is the string token "Core started". *)
  if not !keep_console_output then
    begin
      try
        Printf.fprintf Pervasives.stderr "%sCore started\n" (log_time ());
        Pervasives.flush Pervasives.stderr;
      with _ -> ()
    end;

  lprintf_nl (_b "Core started");
  core_included := true;

  CommonGlobals.do_at_exit (fun _ ->
      (* If we have an error with too many file-descriptors,
         just close all of them *)
      (try
         BasicSocket.close_all ();
       with e ->
           lprintf_nl "Exception %s in do_at_exit while closing sockets."
             (Printexc2.to_string e);
      );
      CommonGraphics.remove_files ();
      (* In case we have no more space on filesystem for
         config files, remove the security space file *)
      Sys.remove security_space_filename;
      DriverInteractive.save_config ();
      CommonComplexOptions.save_sources ();
      CommonComplexOptions.backup_options ();
      Unix32.external_exit ();
      lprintf_nl (_b "Core stopped")
    );

  if not !keep_console_output then
    if !!log_file = "" then 
      begin
        lprintf_nl (_b "Option log_file is empty, disable logging completely...");
        lprintf_nl (_b "Disabling output to console, to enable: stdout true");
	log_to_file stdout;
        close_log ()
      end
