Libguestfs - Jul 2022 - [PATCH common 2/4] mltools: Reimplement On_exit to use a list of actions

On 07/14/22 14:36, Richard W.M. Jones wrote:
> Previously we used separate lists of files, dirs, pids, etc.  This
> makes it harder to introduce new features to reorder actions.
> Reimplement the module so we use a simple list of actions, where each
> action can have type File, Rm_rf, Kill, etc.  Iterate through this
> list on exit to execute the actions.
> 
> The actions will run in a different order from before, but we didn't
> guarantee the ordering before.  Apart from that the functionality is
> unchanged.
> ---
>  mltools/on_exit.ml | 48 ++++++++++++++++++++++------------------------
>  1 file changed, 23 insertions(+), 25 deletions(-)
> 
> diff --git a/mltools/on_exit.ml b/mltools/on_exit.ml
> index 9cdc496..4fa2c3b 100644
> --- a/mltools/on_exit.ml
> +++ b/mltools/on_exit.ml
> @@ -23,23 +23,29 @@ open Common_gettext.Gettext
>  open Unix
>  open Printf
>  
> -(* List of files to unlink. *)
> -let files = ref []
> +type action > +  | Unlink of string     (* filename *)
> +  | Rm_rf of string      (* directory *)
> +  | Kill of int * int    (* signal, pid *)
> +  | Fn of (unit -> unit) (* generic function *)
>  
> -(* List of directories to remove. *)
> -let rmdirs = ref []
> -
> -(* List of PIDs to kill. *)
> -let kills = ref []
> -
> -(* List of functions to call. *)
> -let fns = ref []
> +(* List of actions. *)
> +let actions = ref []
>  
>  (* Perform a single exit action, printing any exception but
>   * otherwise ignoring failures.
>   *)
> -let do_action f arg > -  try f arg with exn -> debug "%s"
(Printexc.to_string exn)
> +let do_action action > +  try
> +    match action with
> +    | Unlink file -> Unix.unlink file
> +    | Rm_rf dir ->
> +       let cmd = sprintf "rm -rf %s" (Filename.quote dir) in
(1) feel free to sneak in the "--" option/operand separator here,
rather
than in a separate patch :)

(2) Shouldn't we use two spaces for indentation here, relative to
"R"?
> +       ignore (Tools_utils.shell_command cmd)
> +    | Kill (signal, pid) ->
> +       kill pid signal
> +    | Fn f -> f ()
> +  with exn -> debug "%s" (Printexc.to_string exn)
>  
>  (* Make sure the actions are performed only once. *)
>  let done_actions = ref false
> @@ -47,15 +53,7 @@ let done_actions = ref false
>  (* Perform the exit actions. *)
>  let do_actions () >    if not !done_actions then (
> -    List.iter (do_action (fun f -> f ())) !fns;
> -    List.iter (do_action (fun (signal, pid) -> kill pid signal))
!kills;
> -    List.iter (do_action (fun file -> Unix.unlink file)) !files;
> -    List.iter (do_action (
> -      fun dir ->
> -        let cmd = sprintf "rm -rf %s" (Filename.quote dir) in
> -        ignore (Tools_utils.shell_command cmd)
> -      )
> -    ) !rmdirs;
> +    List.iter do_action !actions
>    );
>    done_actions := true
>  
> @@ -96,16 +94,16 @@ let register () >  
>  let f fn >    register ();
> -  List.push_front fn fns
> +  List.push_front (Fn fn) actions
>  
>  let unlink filename >    register ();
> -  List.push_front filename files
> +  List.push_front (Unlink filename) actions
>  
>  let rm_rf dir >    register ();
> -  List.push_front dir rmdirs
> +  List.push_front (Rm_rf dir) actions
>  
>  let kill ?(signal = Sys.sigterm) pid >    register ();
> -  List.push_front (signal, pid) kills
> +  List.push_front (Kill (signal, pid)) actions
> 
For some reason I feel like this patch is a good demonstration of OCaml
features :)

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

On Fri, Jul 15, 2022 at 09:12:24AM +0200, Laszlo Ersek
wrote:
> > +let do_action action > > +  try
> > +    match action with
> > +    | Unlink file -> Unix.unlink file
> > +    | Rm_rf dir ->
> > +       let cmd = sprintf "rm -rf %s" (Filename.quote dir)
in
...
> 
> (2) Shouldn't we use two spaces for indentation here, relative to
"R"?
Possibly, but this is what emacs tuareg-mode gives me.

I guess we need to get more serious about OCaml formatting at some
point which may require fixing tuareg-mode too since it's quite
erratic sometimes.

Rich.

-- 
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Read my programming and virtualization blog: http://rwmj.wordpress.com
nbdkit - Flexible, fast NBD server with plugins
https://gitlab.com/nbdkit/nbdkit