[xen staging] tools/oxenstored: Add cooperative live-update command

[patchbot@xxxxxxx]

commit 401c67e9bc8b80eff7589307dba498ae0bfdfea6
Author:     Edwin Török <edvin.torok@xxxxxxxxxx>
AuthorDate: Fri Jan 8 11:57:37 2021 +0000
Commit:     Andrew Cooper <andrew.cooper3@xxxxxxxxxx>
CommitDate: Fri Jan 22 16:49:21 2021 +0000

    tools/oxenstored: Add cooperative live-update command
    
    See docs/misc/xenstore.txt for documentation on live-update command.  
Validate
    that the binary exists and that the cmdline is valid, to prevent typos from
    taking down xenstore; if live-update fails there is no way back due to the 
use
    of exec().
    
    Live update only proceeds if there are no active transactions, and no
    unprocessed input or unflushed output.
    
    Signed-off-by: Edwin Török <edvin.torok@xxxxxxxxxx>
    Reviewed-by: Pau Ruiz Safont <pau.safont@xxxxxxxxxx>
    Reviewed-by: Christian Lindig <christian.lindig@xxxxxxxxxx>
---
 tools/ocaml/xenstored/process.ml | 109 +++++++++++++++++++++++++++++++++++++++
 tools/ocaml/xenstored/stdext.ml  |   6 +++
 2 files changed, 115 insertions(+)

diff --git a/tools/ocaml/xenstored/process.ml b/tools/ocaml/xenstored/process.ml
index 437d2dcf9e..bf18488094 100644
--- a/tools/ocaml/xenstored/process.ml
+++ b/tools/ocaml/xenstored/process.ml
@@ -15,6 +15,7 @@
  *)
 
 let error fmt = Logging.error "process" fmt
+let warn fmt = Logging.warn "process" fmt
 let info fmt = Logging.info "process" fmt
 let debug fmt = Logging.debug "process" fmt
 
@@ -84,11 +85,119 @@ let create_implicit_path t perm path =
                List.iter (fun s -> Transaction.mkdir ~with_watch:false t perm 
s) ret
        )
 
+module LiveUpdate = struct
+type t =
+       { binary: string
+       ; cmdline: string list
+       ; deadline: float
+       ; force: bool
+       ; pending: bool }
+
+let state = ref
+       { binary= Sys.executable_name
+       ; cmdline= []
+       ; deadline= 0.
+       ; force= false
+       ; pending= false }
+
+let debug = Printf.eprintf
+
+let args_of_t t = (t.binary, "--restart" :: t.cmdline)
+
+let string_of_t t =
+       let executable, rest = args_of_t t in
+       Filename.quote_command executable rest
+
+let launch_exn t =
+       let executable, rest = args_of_t t in
+       let args = Array.of_list (executable :: rest) in
+       Unix.execv args.(0) args
+
+let validate_exn t =
+       (* --help must be last to check validity of earlier arguments *)
+       let t = {t with cmdline= t.cmdline @ ["--help"]} in
+       let cmd = string_of_t t in
+       debug "Executing %s" cmd ;
+       match Unix.fork () with
+       | 0 ->   ( try launch_exn t with _ -> exit 2 )
+       | pid -> (
+               match Unix.waitpid [] pid with
+                       | _, Unix.WEXITED 0 ->
+                               debug "Live update validated cmdline %s" cmd;
+                       t
+                       | _, Unix.WEXITED n ->
+                               invalid_arg (Printf.sprintf "Command %s exited 
with code %d" cmd n)
+                       | _, Unix.WSIGNALED n ->
+                               invalid_arg (Printf.sprintf "Command %s killed 
by ocaml signal number %d" cmd n)
+                       | _, Unix.WSTOPPED n ->
+                               invalid_arg (Printf.sprintf "Command %s stopped 
by ocaml signal number %d" cmd n)
+       )
+
+let parse_live_update args =
+       try
+       (state :=
+               match args with
+               | ["-f"; file] ->
+                       validate_exn {!state with binary= file}
+               | ["-a"] ->
+                       debug "Live update aborted" ;
+                       {!state with pending= false}
+               | "-c" :: cmdline ->
+                       validate_exn {!state with cmdline}
+               | "-s" :: _ ->
+                       let timeout = ref 60 in
+                       let force = ref false in
+                       Arg.parse_argv ~current:(ref 1) (Array.of_list args)
+                               [ ( "-t"
+                                 , Arg.Set_int timeout
+                                 , "timeout in seconds to wait for active 
transactions to finish"
+                                 )
+                               ; ( "-F"
+                                 , Arg.Set force
+                                 , "force live update to happen even with 
running transactions after timeout elapsed"
+                                 )
+                               ]
+                       (fun x -> raise (Arg.Bad x))
+                       "live-update -s" ;
+                       debug "Live update process queued" ;
+                               {!state with deadline = Unix.gettimeofday () +. 
float !timeout
+                               ; force= !force; pending= true}
+               | _ ->
+                       invalid_arg ("Unknown arguments: " ^ String.concat "," 
args)) ;
+       None
+       with
+       | Arg.Bad s | Arg.Help s | Invalid_argument s ->
+               Some s
+       | Unix.Unix_error (e, fn, args) ->
+               Some (Printf.sprintf "%s(%s): %s" fn args (Unix.error_message 
e))
+
+       let should_run cons =
+               let t = !state in
+               if t.pending then begin
+                       match Connections.prevents_quit cons with
+                       | [] -> true
+                       | _ when Unix.gettimeofday () < t.deadline -> false
+                       | l ->
+                               info "Live update timeout reached: %d active 
connections" (List.length l);
+                               List.iter (fun con -> warn "%s prevents live 
update" (Connection.get_domstr con)) l;
+                               if t.force then begin
+                                       warn "Live update forced, some domain 
connections may break!";
+                                       true
+                               end else begin
+                                       warn "Live update aborted, try 
migrating or shutting down the domains/toolstack";
+                                       state := { t with pending = false };
+                                       false
+                               end
+               end else false
+end
+
 (* packets *)
 let do_debug con t _domains cons data =
        if not (Connection.is_dom0 con) && not !allow_debug
        then None
        else try match split None '\000' data with
+       | "live-update" :: params ->
+               LiveUpdate.parse_live_update params
        | "print" :: msg :: _ ->
                Logging.xb_op ~tid:0 ~ty:Xenbus.Xb.Op.Debug ~con:"=======>" msg;
                None
diff --git a/tools/ocaml/xenstored/stdext.ml b/tools/ocaml/xenstored/stdext.ml
index 4f2f3a2c8c..e1567c4dfa 100644
--- a/tools/ocaml/xenstored/stdext.ml
+++ b/tools/ocaml/xenstored/stdext.ml
@@ -44,6 +44,12 @@ let default d v =
 let maybe f v =
        match v with None -> () | Some x -> f x
 
+module Filename = struct
+       include Filename
+       let quote_command cmd args =
+               cmd :: args |> List.map quote |> String.concat " "
+end
+
 module String = struct include String
 
 let of_char c = String.make 1 c
--
generated by git-patchbot for /home/xen/git/xen.git#staging