diff options
| author | Elie Michel <elie.michel@ens.fr> | 2017-03-01 11:44:47 +0100 |
|---|---|---|
| committer | Elie Michel <elie.michel@ens.fr> | 2017-03-01 11:44:47 +0100 |
| commit | 65399525f74c60becfc868dd29ad832c547e28db (patch) | |
| tree | b353b79f4058b502875a35856e80192fa6cfae0c /src/files.ml | |
| parent | d860a697fcd507cabae25dfded22dd03f5a6d920 (diff) | |
| download | unison-65399525f74c60becfc868dd29ad832c547e28db.zip unison-65399525f74c60becfc868dd29ad832c547e28db.tar.gz unison-65399525f74c60becfc868dd29ad832c547e28db.tar.bz2 | |
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.
Diffstat (limited to 'src/files.ml')
| -rw-r--r-- | src/files.ml | 12 |
1 files changed, 5 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 |