Libguestfs - Jul 2022 - [PATCH common 3/4] mltools: Introduce priority for ordering actions in On_exit

Introduce a new, optional ?prio parameter which can be used to control
the order that actions run on exit.  By default actions have priority
1000.  Higher numbered actions run first.  Lower numbered actions run
last.  So to have an action run at the very end before exit you might
use ~prio:0

Note that even with this change, some actions (eg kill) are still
asynchronous.
---
 mltools/on_exit.ml  | 24 +++++++++++++-----------
 mltools/on_exit.mli | 18 +++++++++++++-----
 2 files changed, 26 insertions(+), 16 deletions(-)

diff --git a/mltools/on_exit.ml b/mltools/on_exit.ml
index 4fa2c3b..e8353df 100644
--- a/mltools/on_exit.ml
+++ b/mltools/on_exit.ml
@@ -29,7 +29,7 @@ type action    | Kill of int * int    (* signal, pid *)
   | Fn of (unit -> unit) (* generic function *)
 
-(* List of actions. *)
+(* List of (priority, action). *)
 let actions = ref []
 
 (* Perform a single exit action, printing any exception but
@@ -50,10 +50,12 @@ let do_action action  (* Make sure the actions are performed
only once. *)
 let done_actions = ref false
 
-(* Perform the exit actions. *)
+(* Perform the exit actions in reverse priority order (highest first). *)
 let do_actions ()    if not !done_actions then (
-    List.iter do_action !actions
+    let actions = List.sort (fun (a, _) (b, _) -> compare b a) !actions in
+    let actions = List.map snd actions in
+    List.iter do_action actions
   );
   done_actions := true
 
@@ -92,18 +94,18 @@ let register ()    );
   registered := true
 
-let f fn +let f ?(prio = 1000) fn    register ();
-  List.push_front (Fn fn) actions
+  List.push_front (prio, Fn fn) actions
 
-let unlink filename +let unlink ?(prio = 1000) filename    register ();
-  List.push_front (Unlink filename) actions
+  List.push_front (prio, Unlink filename) actions
 
-let rm_rf dir +let rm_rf ?(prio = 1000) dir    register ();
-  List.push_front (Rm_rf dir) actions
+  List.push_front (prio, Rm_rf dir) actions
 
-let kill ?(signal = Sys.sigterm) pid +let kill ?(prio = 1000) ?(signal =
Sys.sigterm) pid    register ();
-  List.push_front (Kill (signal, pid)) actions
+  List.push_front (prio, Kill (signal, pid)) actions
diff --git a/mltools/on_exit.mli b/mltools/on_exit.mli
index 9bcf104..910783e 100644
--- a/mltools/on_exit.mli
+++ b/mltools/on_exit.mli
@@ -28,6 +28,12 @@
     killing another process, so we provide simple
     wrappers for those common actions here.
 
+    Actions can be ordered by setting the optional [?prio]
+    parameter.  By default all actions have priority 1000.
+    Higher numbered actions run first.  Lower numbered
+    actions run last.  So to have an action run at the
+    very end before exit you might use [~prio:0]
+
     Note this module registers signal handlers for
     SIGINT, SIGQUIT, SIGTERM and SIGHUP.  This means
     that any program that links with mltools.cmxa
@@ -39,18 +45,20 @@
     Your cleanup action might no longer run unless the
     program calls {!Stdlib.exit}. *)
 
-val f : (unit -> unit) -> unit
+val f : ?prio:int -> (unit -> unit) -> unit
 (** Register a function [f] which runs when the program exits.
     Similar to [Stdlib.at_exit] but also runs if the program is
-    killed with a signal that we can catch. *)
+    killed with a signal that we can catch.
 
-val unlink : string -> unit
+    [?prio] is the priority, default 1000.  See the description above. *)
+
+val unlink : ?prio:int -> string -> unit
 (** Unlink a single temporary file on exit. *)
 
-val rm_rf : string -> unit
+val rm_rf : ?prio:int -> string -> unit
 (** Recursively remove a temporary directory on exit (using [rm -rf]). *)
 
-val kill : ?signal:int -> int -> unit
+val kill : ?prio:int -> ?signal:int -> int -> unit
 (** Kill [PID] on exit.  The signal sent defaults to [Sys.sigterm].
 
     Use this with care since you can end up unintentionally killing
-- 
2.37.0.rc2

On 07/14/22 14:36, Richard W.M. Jones wrote:
> Introduce a new, optional ?prio parameter which can be used to control
> the order that actions run on exit.  By default actions have priority
> 1000.  Higher numbered actions run first.  Lower numbered actions run
> last.  So to have an action run at the very end before exit you might
> use ~prio:0
> 
> Note that even with this change, some actions (eg kill) are still
> asynchronous.
> ---
>  mltools/on_exit.ml  | 24 +++++++++++++-----------
>  mltools/on_exit.mli | 18 +++++++++++++-----
>  2 files changed, 26 insertions(+), 16 deletions(-)
> 
> diff --git a/mltools/on_exit.ml b/mltools/on_exit.ml
> index 4fa2c3b..e8353df 100644
> --- a/mltools/on_exit.ml
> +++ b/mltools/on_exit.ml
> @@ -29,7 +29,7 @@ type action >    | Kill of int * int    (* signal, pid
*)
>    | Fn of (unit -> unit) (* generic function *)
>  
> -(* List of actions. *)
> +(* List of (priority, action). *)
>  let actions = ref []
>  
>  (* Perform a single exit action, printing any exception but
> @@ -50,10 +50,12 @@ let do_action action >  (* Make sure the actions are
performed only once. *)
>  let done_actions = ref false
>  
> -(* Perform the exit actions. *)
> +(* Perform the exit actions in reverse priority order (highest first). *)
>  let do_actions () >    if not !done_actions then (
> -    List.iter do_action !actions
> +    let actions = List.sort (fun (a, _) (b, _) -> compare b a) !actions
in
> +    let actions = List.map snd actions in
> +    List.iter do_action actions
>    );
>    done_actions := true
>  
> @@ -92,18 +94,18 @@ let register () >    );
>    registered := true
>  
> -let f fn > +let f ?(prio = 1000) fn >    register ();
> -  List.push_front (Fn fn) actions
> +  List.push_front (prio, Fn fn) actions
>  
> -let unlink filename > +let unlink ?(prio = 1000) filename >   
register ();
> -  List.push_front (Unlink filename) actions
> +  List.push_front (prio, Unlink filename) actions
>  
> -let rm_rf dir > +let rm_rf ?(prio = 1000) dir >    register ();
> -  List.push_front (Rm_rf dir) actions
> +  List.push_front (prio, Rm_rf dir) actions
>  
> -let kill ?(signal = Sys.sigterm) pid > +let kill ?(prio = 1000)
?(signal = Sys.sigterm) pid >    register ();
> -  List.push_front (Kill (signal, pid)) actions
> +  List.push_front (prio, Kill (signal, pid)) actions
> diff --git a/mltools/on_exit.mli b/mltools/on_exit.mli
> index 9bcf104..910783e 100644
> --- a/mltools/on_exit.mli
> +++ b/mltools/on_exit.mli
> @@ -28,6 +28,12 @@
>      killing another process, so we provide simple
>      wrappers for those common actions here.
>  
> +    Actions can be ordered by setting the optional [?prio]
> +    parameter.  By default all actions have priority 1000.
> +    Higher numbered actions run first.  Lower numbered
> +    actions run last.  So to have an action run at the
> +    very end before exit you might use [~prio:0]
> +
>      Note this module registers signal handlers for
>      SIGINT, SIGQUIT, SIGTERM and SIGHUP.  This means
>      that any program that links with mltools.cmxa
> @@ -39,18 +45,20 @@
>      Your cleanup action might no longer run unless the
>      program calls {!Stdlib.exit}. *)
>  
> -val f : (unit -> unit) -> unit
> +val f : ?prio:int -> (unit -> unit) -> unit
>  (** Register a function [f] which runs when the program exits.
>      Similar to [Stdlib.at_exit] but also runs if the program is
> -    killed with a signal that we can catch. *)
> +    killed with a signal that we can catch.
>  
> -val unlink : string -> unit
> +    [?prio] is the priority, default 1000.  See the description above. *)
> +
> +val unlink : ?prio:int -> string -> unit
>  (** Unlink a single temporary file on exit. *)
>  
> -val rm_rf : string -> unit
> +val rm_rf : ?prio:int -> string -> unit
>  (** Recursively remove a temporary directory on exit (using [rm -rf]). *)
>  
> -val kill : ?signal:int -> int -> unit
> +val kill : ?prio:int -> ?signal:int -> int -> unit
>  (** Kill [PID] on exit.  The signal sent defaults to [Sys.sigterm].
>  
>      Use this with care since you can end up unintentionally killing
> 
I think this patch is good, but I'm surprised that ~prio:0 is for
placing stuff at the *end* of the list, where 1000 is the default. This
ordering differs from both the firstboot script priorities we did
recently (lower prio number -> runs earlier) and also from the operation
ordering in virt-sysprep (default is 0, 99 puts stuff at the end).

Swapping around the arguments to "compare" wouldn't be difficult,
the
more laborious update would be for the documentation (commit message,
comments). Up to you...

Reviewed-by: Laszlo Ersek <lersek at redhat.com>