[Libguestfs] [supermin 3/3] Use the file tuple up to the point where files are copied into the filesystem / chroot

Hilko Bengen bengen at hilluzination.de
Thu Mar 13 19:39:50 UTC 2014


* Richard W.M. Jones:

> This seems to change the result of this (very important and complex)
> function.

Since you didn't answer my followup message, I take it that I failed to
convince you. I noticed that I can get away with leaving the structure
of the function as-is, just changing the type... What do you think about
this diff?

Cheers,
-Hilko

diff --git a/src/build.ml b/src/build.ml
index 9225184..0e2893d 100644
--- a/src/build.ml
+++ b/src/build.ml
@@ -345,21 +346,21 @@ and munge files =
   let rec loop = function
     | [] -> []
 
-    | "/" :: rest ->
+    | root :: rest when root.ft_path = "/" ->
       (* This is just to avoid a corner-case in subsequent rules. *)
       loop rest
 
-    | dir :: rest when stat_is_dir dir && dir_seen dir ->
+    | dir :: rest when stat_is_dir dir.ft_path && dir_seen dir.ft_path ->
       dir :: loop rest
 
-    | dir :: rest when is_lnk_to_dir dir ->
-      insert_dir dir;
+    | dir :: rest when is_lnk_to_dir dir.ft_path ->
+      insert_dir dir.ft_path;
 
       (* Symlink to a directory.  Insert the target directory before
        * if we've not seen it yet.
        *)
-      let target = readlink dir in
-      let parent = Filename.dirname dir in
+      let target = readlink dir.ft_path in
+      let parent = Filename.dirname dir.ft_path in
       (* Make the target an absolute path. *)
       let target =
         if String.length target < 1 || target.[0] <> '/' then
@@ -367,24 +368,27 @@ and munge files =
         else
           target in
       if not (dir_seen target) then
+        let target = {ft_path = target; ft_source_path = target; ft_config = false} in
         loop (target :: dir :: rest)
       else
         dir :: loop rest
 
-    | dir :: rest when stat_is_dir dir ->
-      insert_dir dir;
+    | dir :: rest when stat_is_dir dir.ft_path ->
+      insert_dir dir.ft_path;
 
       (* Have we seen the parent? *)
-      let parent = Filename.dirname dir in
+      let parent = Filename.dirname dir.ft_path in
       if not (dir_seen parent) then
+        let parent = {ft_path = parent; ft_source_path = parent; ft_config = false} in
         loop (parent :: dir :: rest)
       else
         dir :: loop rest
 
     | file :: rest ->
       (* Have we seen this parent directory before? *)
-      let dir = Filename.dirname file in
+      let dir = Filename.dirname file.ft_path in
       if not (dir_seen dir) then
+        let dir = {ft_path = dir; ft_source_path = dir; ft_config = false} in
         loop (dir :: file :: rest)
       else
         file :: loop rest




More information about the Libguestfs mailing list