Fix messy props when creating parent directory

This was a bug reported by Sebastian Elsner on the user mailing list:
https://groups.yahoo.com/neo/groups/unison-users/conversations/messages/11740

It seems that `Fs.mkdir` does not correctly apply mode, and anyway file owner
and group were never copied. And furthermore the porp list was not built
correctly so both mode and owner/group were false.

In order to prevent this kind of issue, one should document in which order prop
lists in content descriptions are (parent -> child or child -> parent). I do
not do it myself because I am actually not sure.

2 files changed, 20 insertions, 7 deletions

diff --git a/src/files.ml b/src/files.ml
index 3728c92..41f6580 100644
--- a/src/files.ml
+++ b/src/files.ml
@@ -377,7 +377,8 @@ let rec createDirectories fspath localPath props =
           createDirectories fspath parentPath rem;
           try
             let absolutePath = Fspath.concat fspath parentPath in
-             Fs.mkdir absolutePath (Props.perms desc)
+             Fs.mkdir absolutePath (Props.perms desc);
+             Fileinfo.set fspath parentPath (`Copy parentPath) desc
             (* The directory may have already been created
                if there are several paths with the same prefix *)
           with Unix.Unix_error (Unix.EEXIST, _, _) -> ()
@@ -452,15 +453,12 @@ let deleteSpuriousChildrenLocal (_, (fspathTo, pathTo, archChildren)) =
 let deleteSpuriousChildren =
   Remote.registerRootCmd "deleteSpuriousChildren" deleteSpuriousChildrenLocal
 
-let rec normalizePropsRec propsFrom propsTo =
+let rec normalizeProps propsFrom propsTo =
   match propsFrom, propsTo with
-    d :: r, d' :: r' -> normalizePropsRec r r'
-  | _, []            -> propsFrom
+    d :: r, d' :: r' -> normalizeProps r r'
+  | _, []            -> (Safelist.rev propsFrom)
   | [], _ :: _       -> assert false
 
-let normalizeProps propsFrom propsTo =
-  normalizePropsRec (Safelist.rev propsFrom) (Safelist.rev propsTo)
-
 (* ------------------------------------------------------------ *)
 
 let copyReg = Lwt_util.make_region 50
diff --git a/src/test.ml b/src/test.ml
index 31ad7c9..94404ee 100644
--- a/src/test.ml
+++ b/src/test.ml
@@ -522,6 +522,21 @@ let test() =
       put R1 (Dir ["y", Link "x"]); sync();
       check "1" R2 orig;
     );
+
+    (* Check for the bug reported by Sebastian Elsner (Jan 2017) *)
+    (* NOT POSSIBLE because the test API does not enable one to play with file
+       owners, but I put the test here anyway. *)
+    (*
+    runtest "owner of path directories" ["owner"; "path = a/b"] (fun() ->
+      put R1 (Dir ["a", Dir ["b", Dir["foo", File "Foo";
+                                      "bar", File "Bar";
+                                      "baz", File "Baz";]]]]);
+      setOwner R1 "a/b" "testuser";  (* does not exist *)
+      put R2 (Dir []);
+      sync();
+      checkOwner "1" R2 "a/b" "testuser";  (* does not exist *)
+    );
+    *)
   end;
 
   if !failures = 0 then