Much similar to unlink_on_exit, but recursively cleaning directories.
---
mllib/common_utils.ml | 29 +++++++++++++++++++++++++++++
1 file changed, 29 insertions(+)
diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml
index 3943417..f49ede6 100644
--- a/mllib/common_utils.ml
+++ b/mllib/common_utils.ml
@@ -386,6 +386,35 @@ 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 unlink_dirs () =
+ let rec recursive_rmdir fn =
+ if Sys.is_directory fn then (
+ let names = Array.map (fun d -> fn // d) (Sys.readdir fn) in
+ Array.iter recursive_rmdir names;
+ Unix.rmdir fn
+ ) else
+ Unix.unlink fn
+ in
+ List.iter (
+ fun dir -> try recursive_rmdir dir with _ -> ()
+ ) !dirs
+ and register_handlers () =
+ (* Remove on exit. *)
+ at_exit unlink_dirs
+ 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
--
1.8.3.1
_______________________________________________
Libguestfs mailing list
Libguestfs@redhat.com
https://www.redhat.com/mailman/listinfo/libguestfs
