/[mldonkey]/mldonkey/src/daemon/common/commonOptions.ml
ViewVC logotype

Diff of /mldonkey/src/daemon/common/commonOptions.ml

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

revision 1.92 by spiralvoice, Thu Oct 6 10:21:07 2005 UTC revision 1.93 by spiralvoice, Mon Oct 10 15:18:24 2005 UTC
# Line 94  let file_basedir = Line 94  let file_basedir =
94        | _ -> lprintf "Please provide an absolute path in MLDONKEY_DIR like d:\\mldonkey, exiting...\n"; exit 2        | _ -> lprintf "Please provide an absolute path in MLDONKEY_DIR like d:\\mldonkey, exiting...\n"; exit 2
95      else file_basedir_pre      else file_basedir_pre
96    
97    let exit_message file = Printf.sprintf
98    "\nThis means another MLDonkey process could still be working
99    in this directory. Please shut it down before starting
100    a new instance here. If you are sure no other process uses
101    this directory delete %s and restart the core.\n" file
102    
103  let _ =  let _ =
104    lprintf_nl "Starting MLDonkey %s ... " Autoconf.current_version;    lprintf_nl "Starting MLDonkey %s ... " Autoconf.current_version;
105    lprintf_nl "Language %s, locale %s"    lprintf_nl "Language %s, locale %s"
# Line 113  let _ = Line 119  let _ =
119      then      then
120        let pid_filename =        let pid_filename =
121          Printf.sprintf "%s.pid" (Filename.basename Sys.argv.(0)) in          Printf.sprintf "%s.pid" (Filename.basename Sys.argv.(0)) in
122        if Sys.file_exists pid_filename || Sys.file_exists "config_files_space.tmp"        let config_space = "config_files_space.tmp" in
123          if Sys.file_exists pid_filename || Sys.file_exists config_space
124        then begin        then begin
125          if Sys.file_exists pid_filename then          if Sys.file_exists pid_filename then
126            lprintf_nl "PID file %s exists."            lprintf_nl "PID file %s exists."
127              (Filename.concat file_basedir pid_filename)              (Filename.concat file_basedir pid_filename)
128          else          else
129            if Sys.file_exists "config_files_space.tmp" then            if Sys.file_exists config_space then begin
130              lprintf_nl "%s/config_files_space.tmp exists." file_basedir;              lprintf_nl "%s exists." (Filename.concat file_basedir config_space);
131          lprintf_nl "This means another MLDonkey process could still be working";              lprintf "%s" (exit_message config_space);
132          lprintf_nl "in this directory. Please shut it down before starting";              exit 2
133          lprintf_nl "a new instance here. If you are sure no other process uses";              end;
134          lprintf_nl "this directory delete mlnet.pid and restart the core.";          let pid =
135              try
136                let pid_ci = open_in pid_filename in
137                let pid = int_of_string (input_line pid_ci) in
138                close_in pid_ci;
139                pid
140              with _ ->
141                lprintf_nl "But it couldn't be read to check if the process still exists.";
142                lprintf_nl "To avoid doing any harm, MLDonkey will now stop.";
143                exit 2
144            in
145              try
146                Unix.kill pid 0;
147                lprintf "%s" (exit_message pid_filename);
148                exit 2
149              with
150                (* stalled pid file, disregard it *)
151                | Unix.Unix_error (Unix.ESRCH, _, _) ->
152                   (lprintf_nl "Removing stalled file %s " pid_filename;
153                   try Sys.remove pid_filename with _ -> ())
154                | e ->
155                  lprintf "%s" (exit_message pid_filename);
156                  if Autoconf.system = "mingw" then lprintf_nl
157                    "can not check for stalled pid file because Unix.kill is not implemented on MinGW";
158                  lprintf_nl "Exception %s, exiting..." (Printexc2.to_string e);
159          exit 2          exit 2
160        end;        end;
161    

Legend:
Removed from v.1.92  
changed lines
  Added in v.1.93

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