From 7f77f4fb28ca3320fd63c157537a332ef97533ac Mon Sep 17 00:00:00 2001 From: Pino Toscano Date: Thu, 20 Feb 2014 11:37:49 +0100 Subject: [PATCH] mllib: add an hook to cleanup directories on exit Much similar to unlink_on_exit, but recursively cleaning directories. --- mllib/common_utils.ml | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml index 3943417fc..de3bd4082 100644 --- a/mllib/common_utils.ml +++ b/mllib/common_utils.ml @@ -386,6 +386,29 @@ let unlink_on_exit = registered_handlers := true ) +(* Remove a temporary directory on exit. *) +let rmdir_on_exit = + let dirs = ref [] in + let registered_handlers = ref false in + + let rec rmdirs () = + List.iter ( + fun dir -> + let cmd = sprintf "rm -rf %s" (Filename.quote dir) in + ignore (Sys.command cmd) + ) !dirs + and register_handlers () = + (* Remove on exit. *) + at_exit rmdirs + in + + fun dir -> + dirs := dir :: !dirs; + if not !registered_handlers then ( + register_handlers (); + registered_handlers := true + ) + (* Using the libguestfs API, recursively remove only files from the * given directory. Useful for cleaning /var/cache etc in sysprep * without removing the actual directory structure. Also if 'dir' is