[Libguestfs] [PATCH common 2/4] mltools: Reimplement On_exit to use a list of actions
Laszlo Ersek
lersek at redhat.com
Fri Jul 15 07:12:24 UTC 2022
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>
More information about the Libguestfs
mailing list