diff --git a/ocaml/license/OMakefile b/ocaml/license/OMakefile index e030a0e60fa..95772040053 100644 --- a/ocaml/license/OMakefile +++ b/ocaml/license/OMakefile @@ -1,6 +1,6 @@ OCAML_LIBS = ../util/version ../idl/ocaml_backend/xapi_client OCAMLINCLUDES = ../idl/ocaml_backend ../idl ../autogen ../xapi ../gpg ../util -OCAMLPACKS = xml-light2 stdext stunnel http-svr xcp rpclib uuid +OCAMLPACKS = xml-light2 stdext stunnel http-svr xcp rpclib uuid systemd UseCamlp4(rpclib.syntax, v6rpc v6errors) diff --git a/ocaml/license/v6daemon.ml b/ocaml/license/v6daemon.ml index 67739a52629..6a2cf415c37 100644 --- a/ocaml/license/v6daemon.ml +++ b/ocaml/license/v6daemon.ml @@ -19,8 +19,6 @@ open Printf module D=Debug.Make(struct let name="v6daemon" end) open D -module W=Debug.Make(struct let name="watchdog" end) - let xmlrpc_handler process req bio _ = Debug.with_thread_associated "v6d_handler" (fun () -> let path = match String.split '/' req.Http.Request.uri with @@ -43,10 +41,9 @@ let xmlrpc_handler process req bio _ = let server = Http_svr.Server.empty () -let daemon_init post_daemonize_hook process = +let startup process = Debug.with_thread_associated "daemon_init" (fun () -> - post_daemonize_hook (); - + info "(Re)starting v6d..."; (* unix socket *) let unix_socket_path = Filename.concat "/var/lib/xcp" "v6" in Stdext.Unixext.mkdir_safe (Filename.dirname unix_socket_path) 0o700; @@ -54,138 +51,8 @@ let daemon_init post_daemonize_hook process = let domain_sock = Http_svr.bind (Unix.ADDR_UNIX(unix_socket_path)) "unix_rpc" in Http_svr.start server domain_sock; Http_svr.Server.add_handler server Http.Post "/" (Http_svr.BufIO (xmlrpc_handler process)); - - (* TCP socket: only use for testing! *) - (* let localhost = Unix.inet_addr_of_string "127.0.0.1" in - let localhost_sock = Http_svr.bind (Unix.ADDR_INET(localhost, 4094)) in - ignore(Http_svr.start (localhost_sock, "inet-RPC"));*) - + ignore Daemon.(notify State.Ready); (* keep daemon alive *) Stdext.Threadext.keep_alive () ) () -let watchdog f = - Debug.with_thread_associated "watchdog" (fun () -> - (* parent process blocks sigint and forward sigterm to child. *) - ignore(Unix.sigprocmask Unix.SIG_BLOCK [Sys.sigint]); - Sys.catch_break false; - - (* watchdog logic *) - let loginfo fmt = W.info fmt in - - let restart = ref true - and error_msg = ref "" and exit_code = ref 0 - and last_badsig = ref (0.) and pid = ref 0 - and last_badexit = ref (0.) and no_retry_interval = 10. in - - while !restart - do - begin - loginfo "(Re)starting v6d..."; - if !pid = 0 then - begin - let newpid = Unix.fork () in - if newpid = 0 then - begin - try - ignore(Unix.sigprocmask Unix.SIG_UNBLOCK [Sys.sigint]); - f (); - exit 127 - with e -> - error "Caught exception at toplevel: '%s'" (Printexc.to_string e); - Debug.log_backtrace e (Backtrace.get e); - raise e (* will exit the process with rc=2 *) - end; - (* parent just reset the sighandler *) - Sys.set_signal Sys.sigterm (Sys.Signal_handle (fun i -> - restart := false; Unix.kill newpid Sys.sigterm)); - pid := newpid - end; - try - (* remove the pid in all case, except stop *) - match snd (Unix.waitpid [] !pid) with - | Unix.WEXITED 0 -> - loginfo "Received exit code 0. Not restarting."; - pid := 0; - restart := false; - error_msg := ""; - | Unix.WEXITED i -> - loginfo "Received exit code %d" i; - exit_code := i; - pid := 0; - let ctime = Unix.time () in - if ctime < (!last_badexit +. no_retry_interval) then - begin - restart := false; - loginfo "Received 2 bad exits within no-retry-interval. Giving up."; - end - else - begin - (* restart := true; -- don't need to do this - it's true already *) - loginfo "Received bad exit, retrying"; - last_badexit := ctime - end - | Unix.WSIGNALED i -> - loginfo "Received signal %s" (Stdext.Unixext.string_of_signal i); - pid := 0; - (* arbitrary choice of signals, probably need more though, for real use *) - if i = Sys.sigsegv || i = Sys.sigpipe then - begin - let ctime = Unix.time () in - if ctime < (!last_badsig +. no_retry_interval) then - begin - restart := false; - error_msg := sprintf "v6d died with signal %d: not restarting (2 bad signals within no_retry_interval)" i; - exit_code := 13 - end - else - begin - loginfo "v6d died with signal %d: restarting" i; - last_badsig := ctime - end - end - else - begin - restart := false; - error_msg := sprintf "v6d died with signal %d: not restarting (watchdog never restarts on this signal)" i; - exit_code := 12 - end - | Unix.WSTOPPED i -> - loginfo "Receive stop code %i" i; - Unix.sleep 1; - (* well, just resume the stop process. the watchdog cannot do anything if the process is stopped *) - Unix.kill !pid Sys.sigcont; - with - | Unix.Unix_error(Unix.EINTR,_,_) -> () - | e -> loginfo "Watchdog received unexpected exception: %s" (Printexc.to_string e) - end; - done; - if !error_msg <> "" then - begin - loginfo "v6d watchdog exiting."; - loginfo "Fatal: %s" !error_msg; - eprintf "%s\n" !error_msg; - end; - exit !exit_code - ) () - - -let daemon = ref false -let pidfile = ref "" - -(* A lot of this boilerplate ought to go into a utility library *) -let startup post_daemonize_hook process = - (* Parse command-line arguments *) - Arg.parse [ "-daemon", Arg.Set daemon, "Daemonize"; - "-pidfile", Arg.Set_string pidfile, "pidfile"] - (fun x -> warn "Ignoring argument: %s" x) - "v6 licensing daemon"; - - if !daemon then - Stdext.Unixext.daemonize (); - - if !pidfile <> "" then - Stdext.Unixext.pidfile_write !pidfile; - - watchdog (fun () -> daemon_init post_daemonize_hook process) - diff --git a/ocaml/license/v6daemon.mli b/ocaml/license/v6daemon.mli index 29205080e3a..c5384e054f7 100644 --- a/ocaml/license/v6daemon.mli +++ b/ocaml/license/v6daemon.mli @@ -15,4 +15,4 @@ (** Licensing daemon creation module *) (** Create and start up the licensing daemon *) -val startup : (unit -> 'a) -> (Rpc.call -> Rpc.response) -> unit +val startup : (Rpc.call -> Rpc.response) -> unit