/[mldonkey]/mldonkey/src/daemon/driver/driverMain.ml
ViewVC logotype

Diff of /mldonkey/src/daemon/driver/driverMain.ml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.50 by spiralvoice, Thu Jul 7 17:22:43 2005 UTC revision 1.51 by spiralvoice, Sun Jul 10 23:19:16 2005 UTC
# Line 22  open Int64ops Line 22  open Int64ops
22  open Printf2  open Printf2
23    
24  open BasicSocket  open BasicSocket
25      
26  open CommonInteractive  open CommonInteractive
27  open CommonInteractive  open CommonInteractive
28    
# Line 30  open CommonDownloads Line 30  open CommonDownloads
30  open CommonTypes  open CommonTypes
31  open CommonOptions  open CommonOptions
32  open CommonGlobals  open CommonGlobals
33  open CommonNetwork    open CommonNetwork
34      
35  open DriverInterface  open DriverInterface
36    
37  module Dp500 = DriverLink.DP500(struct  module Dp500 = DriverLink.DP500(struct
38          
39        module CommonTypes = CommonTypes        module CommonTypes = CommonTypes
40        module CommonFile = CommonFile        module CommonFile = CommonFile
41        module CommonOptions = CommonOptions        module CommonOptions = CommonOptions
# Line 43  module Dp500 = DriverLink.DP500(struct Line 43  module Dp500 = DriverLink.DP500(struct
43        let incoming_directory () =        let incoming_directory () =
44          (CommonComplexOptions.incoming_files ()).shdir_dirname          (CommonComplexOptions.incoming_files ()).shdir_dirname
45        let files () = !!CommonComplexOptions.files        let files () = !!CommonComplexOptions.files
46          
47      end)      end)
48      
49  open Gettext (* open last  as most modules redefine _s and _b *)  open Gettext (* open last  as most modules redefine _s and _b *)
50      
51  let _s x = _s "DriverMain" x  let _s x = _s "DriverMain" x
52  let _b x = _b "DriverMain" x  let _b x = _b "DriverMain" x
53      
54  let keep_console_output = ref false  let keep_console_output = ref false
55      
56  let do_daily () =  let do_daily () =
57    incr CommonWeb.days;    incr CommonWeb.days;
58    CommonWeb.load_web_infos ()    CommonWeb.load_web_infos ()
# Line 65  let minute_timer () = Line 65  let minute_timer () =
65        Int64Swarmer.verify_some_chunks ()        Int64Swarmer.verify_some_chunks ()
66      with _ -> ()      with _ -> ()
67    );    );
68      
69    if !!auto_commit then    if !!auto_commit then
70      List.iter (fun file ->      List.iter (fun file ->
71          file_commit file          file_commit file
72      ) !!CommonComplexOptions.done_files      ) !!CommonComplexOptions.done_files
73      
74  let hourly_timer timer =  let hourly_timer timer =
75    incr CommonWeb.hours;    incr CommonWeb.hours;
76    if !CommonWeb.hours mod 24 = 0 then do_daily ();    if !CommonWeb.hours mod 24 = 0 then do_daily ();
# Line 79  let hourly_timer timer = Line 79  let hourly_timer timer =
79    DriverControlers.check_calendar ();    DriverControlers.check_calendar ();
80    CommonWeb.connect_redirector ();    CommonWeb.connect_redirector ();
81    CommonFile.propose_filenames ()    CommonFile.propose_filenames ()
82      
83    
84  let second_timer timer =  let second_timer timer =
85    (try    (try
86        update_link_stats ()        update_link_stats ()
87      with e ->      with e ->
88          lprintf_nl (_b "Exception %s") (Printexc2.to_string e));          lprintf_nl (_b "Exception %s") (Printexc2.to_string e));
89            (try            (try
90       CommonUploads.refill_upload_slots ()       CommonUploads.refill_upload_slots ()
91     with e ->     with e ->
92          lprintf_nl (_b "Exception %s") (Printexc2.to_string e));          lprintf_nl (_b "Exception %s") (Printexc2.to_string e));
93    CommonUploads.reset_upload_timer ();    CommonUploads.reset_upload_timer ();
94    CommonUploads.shared_files_timer ();    CommonUploads.shared_files_timer ();
95    ()    ()
96      
97  let start_interfaces () =  let start_interfaces () =
98      
99      
100    if !!http_port <> 0 then begin try    if !!http_port <> 0 then begin try
101          ignore (DriverControlers.create_http_handler ());          ignore (DriverControlers.create_http_handler ());
102        with e ->        with e ->
103            lprintf_nl (_b "Exception %s while starting HTTP interface")            lprintf_nl (_b "Exception %s while starting HTTP interface")
104              (Printexc2.to_string e);              (Printexc2.to_string e);
105      end;      end;
106      
107    ignore (find_port  "telnet server" !!telnet_bind_addr    ignore (find_port  "telnet server" !!telnet_bind_addr
108        telnet_port DriverControlers.telnet_handler);          telnet_port DriverControlers.telnet_handler);
109    
110    Dp500.start ();    Dp500.start ();
111      
112    if !!chat_port <> 0 then begin    if !!chat_port <> 0 then begin
113        ignore (find_port "chat server" !!chat_bind_addr        ignore (find_port "chat server" !!chat_bind_addr
114            chat_port DriverControlers.chat_handler);              chat_port DriverControlers.chat_handler);
115        try        try
116          CommonChat.send_hello ()          CommonChat.send_hello ()
117        with _ -> if !verbose then lprintf (_b "CommonChat.send_hello failed");        with _ -> if !verbose then lprintf (_b "CommonChat.send_hello failed");
118      end;      end;
119      
120    gui_server_sock := find_port "gui server"  !!gui_bind_addr    gui_server_sock := find_port "gui server"  !!gui_bind_addr
121      gui_port gui_handler;        gui_port gui_handler;
122    if !!gift_port <> 0 then    if !!gift_port <> 0 then
123      ignore (find_port "gift server"  !!gui_bind_addr      ignore (find_port "gift server"  !!gui_bind_addr
124          gift_port gift_handler);          gift_port gift_handler);
125      
126    add_infinite_option_timer update_gui_delay DriverInterface.update_gui_info;    add_infinite_option_timer update_gui_delay DriverInterface.update_gui_info;
127    add_infinite_timer 1. second_timer    add_infinite_timer 1. second_timer
128    
129    
130  let _ =  let _ =
131    CommonWeb.add_web_kind "motd.html" (fun _ filename ->    CommonWeb.add_web_kind "motd.html" (fun _ filename ->
132        lprintf_nl (_b "motd.html changed");        lprintf_nl (_b "motd.html changed");
133      motd_html =:= File.to_string filename      motd_html =:= File.to_string filename
134    );    );
135    CommonWeb.add_web_kind "motd.conf" (fun _ filename ->    CommonWeb.add_web_kind "motd.conf" (fun _ filename ->
# Line 146  let _ = Line 146  let _ =
146              CommonInteractive.add_item_to_fully_qualified_options name value              CommonInteractive.add_item_to_fully_qualified_options name value
147          | "del_item" ->          | "del_item" ->
148              CommonInteractive.del_item_from_fully_qualified_options name value              CommonInteractive.del_item_from_fully_qualified_options name value
149          | _ ->          | _ ->
150              lprintf_nl (_b "UNUSED LINE: %s") line              lprintf_nl (_b "UNUSED LINE: %s") line
151              
152        done;        done;
153      with      with
154      | End_of_file ->      | End_of_file ->
155          close_in ic          close_in ic
156      | e -> lprintf_nl (_b "Error while reading motd.conf(%s): %s") filename      | e -> lprintf_nl (_b "Error while reading motd.conf(%s): %s") filename
157          (Printexc2.to_string e);          (Printexc2.to_string e);
158          close_in ic          close_in ic
159                             );                             );
160    CommonWeb.add_web_kind "guarding.p2p" (fun _ filename ->    CommonWeb.add_web_kind "guarding.p2p" (fun _ filename ->
# Line 165  let _ = Line 165  let _ =
165    
166    
167  let save_mlsubmit_reg () =  let save_mlsubmit_reg () =
168      
169  (* Generate the mlsubmit.reg file *)  (* Generate the mlsubmit.reg file *)
170    
171    let file = Printf.sprintf    let file = Printf.sprintf
172        
173     "Windows Registry Editor Version 5.00     "Windows Registry Editor Version 5.00
174    
175  [HKEY_CLASSES_ROOT\\ed2k]  [HKEY_CLASSES_ROOT\\ed2k]
# Line 187  let save_mlsubmit_reg () = Line 187  let save_mlsubmit_reg () =
187      "admin" "" (Ip.to_string (client_ip None)) !!http_port      "admin" "" (Ip.to_string (client_ip None)) !!http_port
188    in    in
189    File.from_string (Filename.concat file_basedir "mlsubmit.reg") file;    File.from_string (Filename.concat file_basedir "mlsubmit.reg") file;
190        
191  (* Generate the mldonkey_submit file *)  (* Generate the mldonkey_submit file *)
192      
193    let file = Printf.sprintf    let file = Printf.sprintf
194      
195  "#!%s  "#!%s
196    
197  # Submit an eDonkey download request to mldonkey  # Submit an eDonkey download request to mldonkey
# Line 230  while (my $uri = shift @ARGV) { Line 230  while (my $uri = shift @ARGV) {
230                  print \"Not an ed2k URI: $_\n\";                  print \"Not an ed2k URI: $_\n\";
231          }          }
232  }  }
233  "  "
234        Autoconf.perl_path        Autoconf.perl_path
235      (Ip.to_string (client_ip None)) !!http_port      (Ip.to_string (client_ip None)) !!http_port
236      "admin" ""      "admin" ""
# Line 242  while (my $uri = shift @ARGV) { Line 242  while (my $uri = shift @ARGV) {
242    e -> ()    e -> ()
243    
244  let load_config () =  let load_config () =
245      
246    DriverInterface.install_hooks ();    DriverInterface.install_hooks ();
247    
248  (**** LOAD OPTIONS ****)  (**** LOAD OPTIONS ****)
249      
250    let exists_downloads_ini =    let exists_downloads_ini =
251      Sys.file_exists (options_file_name downloads_ini) in      Sys.file_exists (options_file_name downloads_ini) in
252    let exists_users_ini =    let exists_users_ini =
# Line 255  let load_config () = Line 255  let load_config () =
255    if not exists_downloads_ini then    if not exists_downloads_ini then
256      begin      begin
257        let oc = open_out (options_file_name downloads_ini) in        let oc = open_out (options_file_name downloads_ini) in
258        close_out oc;        close_out oc;
259        if not exists_users_ini then        if not exists_users_ini then
260          begin          begin
261            let oc = open_out (options_file_name users_ini) in            let oc = open_out (options_file_name users_ini) in
262            close_out oc;            close_out oc;
263          end;          end;
264      end      end
265    else    else
266      if not exists_users_ini then      if not exists_users_ini then
267        begin        begin
268          lprintf_nl "No config file (users.ini) found. Importing users from downloads.ini.";          lprintf_nl "No config file (users.ini) found. Importing users from downloads.ini.";
269          ( try Unix2.copy "downloads.ini" "users.ini" with _ -> () );          ( try Unix2.copy "downloads.ini" "users.ini" with _ -> () );
270        end;        end;
271    
272  (*  (*
273    let exists_expert_ini = Sys.file_exists    let exists_expert_ini = Sys.file_exists
274        (options_file_name downloads_expert_ini) in        (options_file_name downloads_expert_ini) in
275    if not exists_expert_ini then begin    if not exists_expert_ini then begin
276        if exists_downloads_ini then begin        if exists_downloads_ini then begin
# Line 280  let load_config () = Line 280  let load_config () =
280            (try Unix2.copy "downloads.ini" "donkey_expert.ini" with _ -> ());            (try Unix2.copy "downloads.ini" "donkey_expert.ini" with _ -> ());
281    
282            end else begin            end else begin
283              
284            lprintf "No config file found. Generating one.\n";            lprintf "No config file found. Generating one.\n";
285            let oc = open_out (options_file_name downloads_expert_ini) in            let oc = open_out (options_file_name downloads_expert_ini) in
286            close_out oc;            close_out oc;
287          end          end
288      end; *)      end; *)
289    (try    (try
290        Options.load downloads_ini;        Options.load downloads_ini;
291        Options.load users_ini;        Options.load users_ini;
292  (*      Options.load downloads_expert_ini;       *)  (*      Options.load downloads_expert_ini;       *)
293      with e ->      with e ->
294          lprintf_nl "Exception %s during options load" (Printexc2.to_string e);          lprintf_nl "Exception %s during options load" (Printexc2.to_string e);
295          exit 2;          exit 2;
296          ());            ());
297      
298    (* Here, we try to update options when a new version of mldonkey is    (* Here, we try to update options when a new version of mldonkey is
299       used. For example, we can add new web_infos... *)       used. For example, we can add new web_infos... *)
300    CommonOptions.update_options ();    CommonOptions.update_options ();
# Line 305  let load_config () = Line 305  let load_config () =
305          commands_frame_height =:= (snd !html_mods_styles.(!!html_mods_style));          commands_frame_height =:= (snd !html_mods_styles.(!!html_mods_style));
306        CommonMessages.colour_changer ();        CommonMessages.colour_changer ();
307      end;      end;
308    networks_iter_all (fun r ->    networks_iter_all (fun r ->
309  (*      lprintf "(n) loading network config file\n"; *)  (*      lprintf "(n) loading network config file\n"; *)
310        List.iter (fun opfile ->        List.iter (fun opfile ->
311            try            try
312              Options.load opfile              Options.load opfile
313            with Sys_error _ ->            with Sys_error _ ->
314                Options.save_with_help opfile                Options.save_with_help opfile
315        )              )
316        r.network_config_file        r.network_config_file
317    );    );
318    
319    
320  (**** PARSE ARGUMENTS ***)      (**** PARSE ARGUMENTS ***)
321      
322    let more_args = ref [] in    let more_args = ref [] in
323      
324      
325    more_args := !more_args    more_args := !more_args
326      @ (Options.simple_args "" downloads_ini);      @ (Options.simple_args "" downloads_ini);
327    more_args := !more_args    more_args := !more_args
328      @ (Options.simple_args "" users_ini);      @ (Options.simple_args "" users_ini);
329      
330    networks_iter_all (fun r ->    networks_iter_all (fun r ->
331        List.iter (fun opfile ->        List.iter (fun opfile ->
332            let prefix = r.network_shortname ^ "-" in            let prefix = r.network_shortname ^ "-" in
# Line 335  let load_config () = Line 335  let load_config () =
335                  (Printf.sprintf "-%s" arg, spec, help)) args                  (Printf.sprintf "-%s" arg, spec, help)) args
336            in            in
337            more_args := !more_args @ args            more_args := !more_args @ args
338        ) r.network_config_file        ) r.network_config_file
339    );    );
340      
341    Arg.parse ([    Arg.parse ([
342        "-v", Arg.Unit (fun _ ->        "-v", Arg.Unit (fun _ ->
343            lprintf_nl "%s" (CommonGlobals.version ());            lprintf_nl "%s" (CommonGlobals.version ());
# Line 356  let load_config () = Line 356  let load_config () =
356            CommonFile.check_file_implementations ();            CommonFile.check_file_implementations ();
357  (*          CommonResult.check_result_implementations (); *)  (*          CommonResult.check_result_implementations (); *)
358            lprintf_nl "";            lprintf_nl "";
359            exit 0),            exit 0),
360        _s " : display information on the implementations";        _s " : display information on the implementations";
361        "-stdout", Arg.Unit (fun _ ->        "-stdout", Arg.Unit (fun _ ->
362            keep_console_output := true;            keep_console_output := true;
363            log_to_file stdout;            log_to_file stdout;
364        ),        ),
365         _s ": keep output to stdout after startup";         _s ": keep output to stdout after startup";
366         "-stderr", Arg.Unit (fun _ ->         "-stderr", Arg.Unit (fun _ ->
367             keep_console_output := true;             keep_console_output := true;
368             log_to_file stderr;             log_to_file stderr;
369         ),         ),
370         _s ": keep output to stderr after startup";         _s ": keep output to stderr after startup";
371        "-daemon", Arg.Unit (fun _ ->        "-daemon", Arg.Unit (fun _ ->
372            (* Removed due to savannah bug #11514 . *)            (* Removed due to savannah bug #11514 . *)
373            lprintf_nl "\n\nOption -daemon was removed.\nUse 'mlnet > /dev/null 2>&1 &' instead. Exiting...";            lprintf_nl "\n\nOption -daemon was removed.\nUse 'mlnet > /dev/null 2>&1 &' instead. Exiting...";
374            exit 0), _s " : this argument was removed, core will exit";            exit 0), _s " : this argument was removed, core will exit";
375        "-find_port", Arg.Set find_other_port,        "-find_port", Arg.Set find_other_port,
376        _s " : find another port when one is already used";        _s " : find another port when one is already used";
377      ] @      ] @
378        !more_args        !more_args
379        @        @
380      !main_options)      !main_options)
381      (fun file -> ()      (fun file -> ()
382  (*      Files.dump_file file; exit 0 *)  (*      Files.dump_file file; exit 0 *)
383    ) "";    ) "";
384        
385    
386  (**** CREATE DIRS   ****)  (**** CREATE DIRS   ****)
387      
388    (*    (*
389    Unix2.safe_mkdir !!incoming_directory;    Unix2.safe_mkdir !!incoming_directory;
390      
391    File.from_string (Filename.concat !!incoming_directory "Readme.txt")    File.from_string (Filename.concat !!incoming_directory "Readme.txt")
392    "This directory contains the files downloaded, after commit.    "This directory contains the files downloaded, after commit.
393  The 'incoming/files/' folder contains simple files.  The 'incoming/files/' folder contains simple files.
394  The 'incoming/directories/' folder contains whole directories (probably  The 'incoming/directories/' folder contains whole directories (probably
395     downloaded with Bittorrent).     downloaded with Bittorrent).
396    
# Line 399  If you want to share files, you should: Line 399  If you want to share files, you should:
399     in the 'incoming/files/' folder, or better, in the shared/ folder.     in the 'incoming/files/' folder, or better, in the shared/ folder.
400     is for downloaded files. Files to be shared should be     is for downloaded files. Files to be shared should be
401     put in the 'shared/' directory instead.     put in the 'shared/' directory instead.
402    - Put directories that should be shared as one file in the    - Put directories that should be shared as one file in the
403     'incoming/directories/' folder. Currently, such directories can only be     'incoming/directories/' folder. Currently, such directories can only be
404     shared on the Bittorrent network, by providing the corresponding     shared on the Bittorrent network, by providing the corresponding
405     .torrent in the 'torrents/seeded/' folder.     .torrent in the 'torrents/seeded/' folder.
406  ";  ";
407      
408    Unix2.safe_mkdir (Filename.concat !!incoming_directory "files");    Unix2.safe_mkdir (Filename.concat !!incoming_directory "files");
409    Unix2.safe_mkdir (Filename.concat !!incoming_directory "directories");    Unix2.safe_mkdir (Filename.concat !!incoming_directory "directories");
410  *)  *)
411      
412    List.iter (fun s ->    List.iter (fun s ->
413        Unix2.safe_mkdir s.shdir_dirname;        Unix2.safe_mkdir s.shdir_dirname;
414        if s.shdir_strategy = "incoming_directories" ||        if s.shdir_strategy = "incoming_directories" ||
# Line 425  let _ = Line 425  let _ =
425    let t = Unix.localtime (Unix.time ()) in    let t = Unix.localtime (Unix.time ()) in
426    if (t.Unix.tm_year<=104) then    if (t.Unix.tm_year<=104) then
427      begin      begin
428        lprintf (_b "\n\n\nYour system has a system date earlier than 2004, please correct it.\n");        lprintf_nl (_b "\n\n\nYour system has a system date earlier than 2004, please correct it.");
429        lprintf (_b "MLdonkey can not work with such a system date, exiting...\n");        lprintf_nl (_b "MLdonkey can not work with such a system date, exiting...");
430        CommonGlobals.exit_properly 0        CommonGlobals.exit_properly 0
431      end;      end;
432    
# Line 447  http://mldonkey.berlios.de/modules.php?n Line 447  http://mldonkey.berlios.de/modules.php?n
447    
448    load_config ();    load_config ();
449        
450    add_infinite_option_timer download_sample_rate CommonFile.sample_timer;      add_infinite_option_timer download_sample_rate CommonFile.sample_timer;
451    
452  (*  lprintf "(1) CommonComplexOptions.load\n"; *)  (*  lprintf "(1) CommonComplexOptions.load\n"; *)
453    CommonComplexOptions.load ();    CommonComplexOptions.load ();
# Line 467  http://mldonkey.berlios.de/modules.php?n Line 467  http://mldonkey.berlios.de/modules.php?n
467    lprintf (_b "\nCheck http://www.mldonkey.net/ for updates\n");    lprintf (_b "\nCheck http://www.mldonkey.net/ for updates\n");
468    networks_iter (fun r -> network_load_complex_options r);    networks_iter (fun r -> network_load_complex_options r);
469    lprintf (_b "enabling networks: ");    lprintf (_b "enabling networks: ");
470    networks_iter (fun r ->    networks_iter (fun r ->
471  (*      lprintf "(4) networks_iter enabling\n"; *)  (*      lprintf "(4) networks_iter enabling\n"; *)
472        network_enable r;        network_enable r;
473        lprintf (_b "%s ") r.network_name;        lprintf (_b "%s ") r.network_name;
# Line 475  http://mldonkey.berlios.de/modules.php?n Line 475  http://mldonkey.berlios.de/modules.php?n
475        if !!recover_temp_on_startup then        if !!recover_temp_on_startup then
476          network_recover_temp r;          network_recover_temp r;
477    );    );
478    lprintf_nl "";    lprintf (_b "\ndisabled networks: ");
   lprintf (_b "disabled networks: ");  
479    let found = ref false in    let found = ref false in
480      networks_iter_all (fun r ->      networks_iter_all (fun r ->
481          if not (network_is_enabled r) then          if not (network_is_enabled r) then
# Line 488  http://mldonkey.berlios.de/modules.php?n Line 487  http://mldonkey.berlios.de/modules.php?n
487    lprintf_nl "";    lprintf_nl "";
488    CommonOptions.start_running_plugins := true;    CommonOptions.start_running_plugins := true;
489    CommonInteractive.force_download_quotas ();    CommonInteractive.force_download_quotas ();
490      
491    TcpBufferedSocket.set_max_opened_connections    TcpBufferedSocket.set_max_opened_connections
492      (fun _ -> !!max_opened_connections);      (fun _ -> !!max_opened_connections);
493    TcpBufferedSocket.set_max_connections_per_second    TcpBufferedSocket.set_max_connections_per_second
494      (fun _ -> !!max_connections_per_second);      (fun _ -> !!max_connections_per_second);
495      
496    add_infinite_option_timer save_options_delay (fun timer ->    add_infinite_option_timer save_options_delay (fun timer ->
497        DriverInteractive.save_config ());        DriverInteractive.save_config ());
498    start_interfaces ();    start_interfaces ();
499      
500    add_infinite_timer 60. minute_timer;    add_infinite_timer 60. minute_timer;
501    add_infinite_timer 3600. hourly_timer;    add_infinite_timer 3600. hourly_timer;
502    add_infinite_timer 0.1 CommonUploads.upload_download_timer;    add_infinite_timer 0.1 CommonUploads.upload_download_timer;
503    
504    List.iter    List.iter
505      CommonShared.shared_add_directory      CommonShared.shared_add_directory
506    !!CommonComplexOptions.shared_directories;      !!CommonComplexOptions.shared_directories;
507      
508    add_infinite_timer 1800. (fun timer ->    add_infinite_timer 1800. (fun timer ->
509        DriverInteractive.browse_friends ());        DriverInteractive.browse_friends ());
510      
511    Options.prune_file downloads_ini;    Options.prune_file downloads_ini;
512    Options.prune_file users_ini;    Options.prune_file users_ini;
513  (*  Options.prune_file downloads_expert_ini; *)  (*  Options.prune_file downloads_expert_ini; *)
# Line 525  http://mldonkey.berlios.de/modules.php?n Line 524  http://mldonkey.berlios.de/modules.php?n
524                  else Ip.to_string !!gui_bind_addr)  !!gui_port;                  else Ip.to_string !!gui_bind_addr)  !!gui_port;
525    lprintf (_b "If you connect from a remote machine adjust allowed_ips\n");    lprintf (_b "If you connect from a remote machine adjust allowed_ips\n");
526    if Autoconf.system = "windows" then lprintf (_b "%s") win_message;    if Autoconf.system = "windows" then lprintf (_b "%s") win_message;
527      
528    if Autoconf.system <> "windows" then    if Autoconf.system <> "windows" then
529      (* Doesn't work on windows with mingw, because getpid always returns 948 *)      (* Doesn't work on windows with mingw, because getpid always returns 948 *)
530      (      (
# Line 547  http://mldonkey.berlios.de/modules.php?n Line 546  http://mldonkey.berlios.de/modules.php?n
546            if !!ask_for_gui  && Sys.file_exists !!mldonkey_gui &&            if !!ask_for_gui  && Sys.file_exists !!mldonkey_gui &&
547              Sys.file_exists asker then              Sys.file_exists asker then
548              ignore (Sys.command (Printf.sprintf "%s %s&" asker !!mldonkey_gui));              ignore (Sys.command (Printf.sprintf "%s %s&" asker !!mldonkey_gui));
549          with Not_found ->          with Not_found ->
550              lprintf_nl (_b "Not running under X, not trying to start the GUI")              lprintf_nl (_b "Not running under X, not trying to start the GUI")
551              );              );
552    );    );
553    
554    if !!run_as_user <> "" then begin    if !!run_as_user <> "" then begin
555        try        try
556          let new_pw = Unix.getpwnam !!run_as_user  in          let new_pw = Unix.getpwnam !!run_as_user in
557          MlUnix.setuid new_pw.Unix.pw_uid;          MlUnix.setuid new_pw.Unix.pw_uid;
558          let pw = Unix.getpwuid (Unix.getuid()) in          let pw = Unix.getpwuid (Unix.getuid()) in
559          lprintf_nl (_b "mldonkey is now running as user %s")  pw.Unix.pw_name;          lprintf_nl (_b "mldonkey is now running as user %s") pw.Unix.pw_name;
560        with e ->        with e ->
561            lprintf_nl (_b "Exception %s trying to set user_uid [%s]")            lprintf_nl (_b "Exception %s trying to set user_uid [%s]")
562            (Printexc2.to_string e) !!run_as_user;            (Printexc2.to_string e) !!run_as_user;
563            exit 2            exit 2
564      end;      end;
565    
566    if !!run_as_useruid <> 0 then begin    if !!run_as_useruid <> 0 then begin
567        try        try
568          MlUnix.setuid !!run_as_useruid;          MlUnix.setuid !!run_as_useruid;
# Line 573  http://mldonkey.berlios.de/modules.php?n Line 572  http://mldonkey.berlios.de/modules.php?n
572            (Printexc2.to_string e) !!run_as_useruid;            (Printexc2.to_string e) !!run_as_useruid;
573            exit 2            exit 2
574      end;      end;
575      
576    if !!create_mlsubmit then save_mlsubmit_reg ();    if !!create_mlsubmit then save_mlsubmit_reg ();
577    DriverInteractive.initialization_completed := true;    DriverInteractive.initialization_completed := true;
578    DriverInteractive.save_config ();    DriverInteractive.save_config ();
579    
580    if Autoconf.system <> "windows" then    if Autoconf.system <> "windows" then
581      MlUnix.set_signal  Sys.sigchld      MlUnix.set_signal  Sys.sigchld
582        (Sys.Signal_handle (fun _ -> lprintf_nl "SIGCHLD"));        (Sys.Signal_handle (fun _ -> lprintf_nl "SIGCHLD"));
583    
584    if Autoconf.system <> "windows" then    if Autoconf.system <> "windows" then
585      MlUnix.set_signal  Sys.sighup      MlUnix.set_signal  Sys.sighup
586        (Sys.Signal_handle (fun _ -> lprintf_nl "SIGHUP";        (Sys.Signal_handle (fun _ -> lprintf_nl "SIGHUP";
587           BasicSocket.close_all ();           BasicSocket.close_all ();
# Line 602  http://mldonkey.berlios.de/modules.php?n Line 601  http://mldonkey.berlios.de/modules.php?n
601          CommonGlobals.exit_properly 0));          CommonGlobals.exit_properly 0));
602    
603    if !verbose then lprintf_nl (_b "Activated system signal handling\n");    if !verbose then lprintf_nl (_b "Activated system signal handling\n");
604      
605    Unix32.max_cache_size := MlUnix.max_filedescs    Unix32.max_cache_size := MlUnix.max_filedescs
606    
607  let _ =  let _ =
608    let security_space_filename = "config_files_space.tmp" in    let security_space_filename = "config_files_space.tmp" in
609      
610    lprintf (_b "Core started");    lprintf (_b "Core started");
611    core_included := true;    core_included := true;
612    CommonGlobals.print_localtime ();    CommonGlobals.print_localtime ();
613    
614    begin    begin
615  (* Create a 'config_files_security_space' megabytes file to protect some space  (* Create a 'config_files_security_space' megabytes file to protect some space
616  for config files at the end. *)  for config files at the end. *)
# Line 635  for config files at the end. *) Line 634  for config files at the end. *)
634          lprintf_nl (_b " not enough space on device or bad permissions");          lprintf_nl (_b " not enough space on device or bad permissions");
635          lprintf_nl (_b "Exiting...");          lprintf_nl (_b "Exiting...");
636          exit 2;          exit 2;
637    end;      end;
638    CommonGlobals.do_at_exit (fun _ ->    CommonGlobals.do_at_exit (fun _ ->
639        (* If we have an error with too many file-descriptors,        (* If we have an error with too many file-descriptors,
640           just close all of them *)           just close all of them *)
641        (try        (try
642           BasicSocket.close_all ();           BasicSocket.close_all ();
643         with e ->         with e ->
644             lprintf "Exception %s in do_at_exit while closing sockets.\n"             lprintf_nl "Exception %s in do_at_exit while closing sockets."
645               (Printexc2.to_string e);               (Printexc2.to_string e);
646        );        );
       CommonGraphics.remove_files ();  
647        (* In case we have no more space on filesystem for        (* In case we have no more space on filesystem for
648           config files, remove the security space file *)           config files, remove the security space file *)
649        Sys.remove security_space_filename;        Sys.remove security_space_filename;
# Line 654  for config files at the end. *) Line 652  for config files at the end. *)
652        lprintf (_b "Core stopped");        lprintf (_b "Core stopped");
653        CommonGlobals.print_localtime ()        CommonGlobals.print_localtime ()
654      );      );
655      
656    if not !keep_console_output then begin    if not !keep_console_output then begin
657        lprintf (_b "Disabling output to console, to enable: stdout true\n");        lprintf_nl (_b "Disabling output to console, to enable: stdout true");
658          
659        if !!log_file <> "" then begin        if !!log_file <> "" then begin
660            (*            (*
661            try            try
662              Printf.printf "+XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX+\n";              Printf.printf "+XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX+\n";
663              let oc = open_out !!log_file in              let oc = open_out !!log_file in
664              lprintf "Logging in %s\n" !!log_file;              lprintf "Logging in %s\n" !!log_file;
665                
666              (* Don't close stdout !!!              (* Don't close stdout !!!
667              (match !lprintf_output with              (match !lprintf_output with
668                 None -> () | Some oc -> close_out oc);                 None -> () | Some oc -> close_out oc);

Legend:
Removed from v.1.50  
changed lines
  Added in v.1.51

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26