Detect and propagate renames/moves

A rename or a move is currently seen as a delete on the old path and a
create on the new path. This means that propagating what was from
users's perspective a simple rename can require copying gigabytes of
data for big files and directories (this is in best case scenario when
local copy shortcut is used instead of transmitting those gigabytes over
a network).

Add new functionality that enables detecting renames and moves, and
propagating them without copying any data. If this is not possible (due
to conflicts, errors or user actions) then it falls back to copying, as
before. Add a new user preference to control this (defaults to "on").

This is just a shortcut (akin to copying locally instead of transmitting
over a network).

Renames/moves are detected for files and directories, and only if the
contents have not changed (for directories, "contents" means the names
and contents of all its children, recursively).

src/.depend

@@ -604,6 +604,35 @@ main.cmx : \
     remote.cmx \
     ubase/prefs.cmx \
     os.cmx
+moves.cmo : \
+    uutil.cmi \
+    ubase/util.cmi \
+    update.cmi \
+    ubase/trace.cmi \
+    ubase/safelist.cmi \
+    props.cmi \
+    ubase/prefs.cmi \
+    path.cmi \
+    os.cmi \
+    name.cmi \
+    common.cmi \
+    moves.cmi
+moves.cmx : \
+    uutil.cmx \
+    ubase/util.cmx \
+    update.cmx \
+    ubase/trace.cmx \
+    ubase/safelist.cmx \
+    props.cmx \
+    ubase/prefs.cmx \
+    path.cmx \
+    os.cmx \
+    name.cmx \
+    common.cmx \
+    moves.cmi
+moves.cmi : \
+    path.cmi \
+    common.cmi
 name.cmo : \
     ubase/util.cmi \
     ubase/rx.cmi \
@@ -765,6 +794,7 @@ recon.cmo : \
     pred.cmi \
     path.cmi \
     name.cmi \
+    moves.cmi \
     globals.cmi \
     fileinfo.cmi \
     common.cmi \
@@ -782,6 +812,7 @@ recon.cmx : \
     pred.cmx \
     path.cmx \
     name.cmx \
+    moves.cmx \
     globals.cmx \
     fileinfo.cmx \
     common.cmx \
@@ -1030,6 +1061,7 @@ transport.cmo : \
     ubase/prefs.cmi \
     path.cmi \
     osx.cmi \
+    moves.cmi \
     lwt/lwt_util.cmi \
     lwt/lwt.cmi \
     globals.cmi \
@@ -1046,6 +1078,7 @@ transport.cmx : \
     ubase/prefs.cmx \
     path.cmx \
     osx.cmx \
+    moves.cmx \
     lwt/lwt_util.cmx \
     lwt/lwt.cmx \
     globals.cmx \

src/Makefile.OCaml

@@ -216,7 +216,7 @@ OCAMLOBJS += \
           props.cmo fileinfo.cmo os.cmo lock.cmo clroot.cmo common.cmo \
           tree.cmo checksum.cmo terminal.cmo \
           transfer.cmo xferhint.cmo remote.cmo globals.cmo fswatchold.cmo \
-          fpcache.cmo update.cmo copy.cmo stasher.cmo \
+          fpcache.cmo update.cmo moves.cmo copy.cmo stasher.cmo \
 	  files.cmo sortri.cmo recon.cmo transport.cmo \
           strings.cmo uicommon.cmo uitext.cmo test.cmo
 

src/common.ml

@@ -113,9 +113,11 @@ type status =
   | `Modified
   | `PropsChanged
   | `Created
+  | `MovedOut of Path.t * replicaContent * replicaContent
+  | `MovedIn of Path.t * replicaContent * replicaContent
   | `Unchanged ]
 
-type replicaContent =
+and replicaContent =
   { typ : Fileinfo.typ;
     status : status;
     desc : Props.t;                (* Properties (for the UI) *)

src/common.mli

@@ -85,15 +85,81 @@ and updateContent =
 (*            COMMON TYPES SHARED BY RECONCILER AND TRANSPORT AGENT          *)
 (*****************************************************************************)
 
+(* `MovedOut is set as the status on the old path. In this case, the new path
+   will not have a separate difference record at all (the corresponding
+   replicaContent records for both replicas are embedded in the `MovedOut
+   status). Status of the new path is guaranteed to be not conflicting.
+   `MovedOut is a combination of `Deleted on the old path and `Created on the
+   new path. The virtual status equivalent for both paths combined is
+   `Unchanged or `PropsChanged, meaning that except for the path change (and
+   potentially the props), the file/dir contents have not changed.
+
+       (in the illustrations below, the boxes with double lines represent
+          the two replicaContents of the one difference record that is
+                  visible to the user and will be propagated)
+
+                         REPLICA A                          REPLICA B
+
+                                                on path n'
+                              /   +--------------+      +-----------------+
+         on path n           |    | p = `Created |      | q = `Unchanged  |
+  +======================+   |    +--------------+      +-----------------+
+  |                      |   /
+  | `MovedOut (n', p, q) |  <                   on path n
+  |                      |   \    +--------------+      +=================+
+  +======================+   |    |   `Deleted   |      | anything except |
+                             |    +--------------+      |    `Deleted     |
+                              \                         +=================+
+
+
+   If `MovedOut can not be set (for example, there is a conflict on the new
+   path) then `MovedIn may be set instead. `MovedOut and `MovedIn are never
+   used together on a pair of paths.
+   `MovedIn is set as the status of the new path. In this case, the old path
+   will not have a separate difference record at all (the corresponding
+   replicaContent records for both replicas are embedded in the `MovedIn
+   status). Status of the old path is guaranteed to be not conflicting.
+   `MovedIn is a combination of `Created on the new path and `Deleted on the
+   old path. The virtual status equivalent for both paths combined is
+   `Unchanged or `PropsChanged, meaning tat except for the path change (and
+   potentially the props), the file/dir contents have not changed.
+
+                         REPLICA A                          REPLICA B
+
+                                                on path n
+                              /   +--------------+      +================+
+         on path n           |    |   `Created   |      |    anything    |
+  +======================+   |    +--------------+      +================+
+  |                      |   /
+  | `MovedIn  (n', p, q) |  <
+  |                      |   \                  on path n'
+  +======================+   |    +--------------+      +----------------+
+                             |    | p = `Deleted |      | q = `Unchanged |
+                              \   +--------------+      +----------------+
+
+  (Usually the status of replica b on path n will not be `Unchanged, because
+   then `MovedOut will be used instead. It can be `Unchanged if typ is not
+   `ABSENT. In other words, `Create in replica b is overwriting something.)
+
+   Note that even though path for only one replica is recorded in `MovedOut/
+   `MovedIn, it will not cause trouble when in case insensitive mode on a
+   case sensitive filesystem (commit 005a53075b998dba27eeff74a1fc8f9d73558fb8
+   for details). Correct path translation is done by [Update.translatePath]. *)
 type status =
   [ `Deleted
   | `Modified
   | `PropsChanged
   | `Created
+  | `MovedOut of Path.t          (* new path *)
+              * replicaContent   (* rc of new path, this replica *)
+              * replicaContent   (* rc of new path, other replica *)
+  | `MovedIn of Path.t           (* old path *)
+              * replicaContent   (* rc of old path, this replica *)
+              * replicaContent   (* rc of old path, other replica *)
   | `Unchanged ]
 
 (* Variable name prefix: "rc" *)
-type replicaContent =
+and replicaContent =
   { typ : Fileinfo.typ;
     status : status;
     desc : Props.t;                (* Properties (for the UI) *)

src/files.ml

@@ -235,14 +235,16 @@ let makeSymlink =
 
 (* ------------------------------------------------------------ *)
 
-let performRename fspathTo localPathTo workingDir pathFrom pathTo prevArch =
-  debug (fun () -> Util.msg "Renaming %s to %s in %s; root is %s\n"
+let performRename fspathTo localPathTo (workingDirFrom, pathFrom)
+      (workingDirTo, pathTo) ?exdev prevArch =
+  debug (fun () -> Util.msg "Renaming %s in %s to %s in %s; root is %s\n"
       (Path.toString pathFrom)
+      (Fspath.toDebugString workingDirFrom)
       (Path.toString pathTo)
-      (Fspath.toDebugString workingDir)
+      (Fspath.toDebugString workingDirTo)
       (Fspath.toDebugString fspathTo));
-  let source = Fspath.concat workingDir pathFrom in
-  let target = Fspath.concat workingDir pathTo in
+  let source = Fspath.concat workingDirFrom pathFrom in
+  let target = Fspath.concat workingDirTo pathTo in
   Util.convertUnixErrorsToTransient
     (Printf.sprintf "renaming %s to %s"
        (Fspath.toDebugString source) (Fspath.toDebugString target))
@@ -273,8 +275,8 @@ let performRename fspathTo localPathTo workingDir pathFrom pathTo prevArch =
         | _                       -> true (* Safe default *) in
       if moveFirst then begin
         debug (fun() -> Util.msg "rename: moveFirst=true\n");
-        let tmpPath = Os.tempPath workingDir pathTo in
-        let temp = Fspath.concat workingDir tmpPath in
+        let tmpPath = Os.tempPath workingDirTo pathTo in
+        let temp = Fspath.concat workingDirTo tmpPath in
         let temp' = Fspath.toDebugString temp in
 
         debug (fun() ->
@@ -295,7 +297,7 @@ let performRename fspathTo localPathTo workingDir pathFrom pathTo prevArch =
               debug (fun() -> Util.msg "rename %s to %s\n"
                        (Fspath.toDebugString source)
                        (Fspath.toDebugString target));
-              Os.rename "renameLocal(2)"
+              Os.rename "renameLocal(2)" ?exdev
                 source Path.empty target Path.empty))
           (fun _ -> clearCommitLog pathTo);
         (* It is ok to leave a temporary file.  So, the log can be
@@ -304,7 +306,7 @@ let performRename fspathTo localPathTo workingDir pathFrom pathTo prevArch =
       end else begin
         debug (fun() -> Util.msg "rename: moveFirst=false\n");
         Stasher.backup fspathTo localPathTo `ByCopying prevArch;
-        Os.rename "renameLocal(3)" source Path.empty target Path.empty;
+        Os.rename "renameLocal(3)" ?exdev source Path.empty target Path.empty;
         debug (fun() ->
           if filetypeFrom = `FILE then
             Util.msg
@@ -337,7 +339,7 @@ let renameLocal
   let pathTo = match finishCopy copyInfo with
   | Some conflictPath -> conflictPath
   | None -> pathTo in
-  performRename fspathTo localPathTo workingDir pathFrom pathTo prevArch;
+  performRename fspathTo localPathTo (workingDir, pathFrom) (workingDir, pathTo) prevArch;
   begin match archOpt with
     Some archTo -> Stasher.stashCurrentVersion fspathTo localPathTo None;
                    Update.iterFiles fspathTo localPathTo archTo
@@ -643,6 +645,105 @@ let copy
 
 (* ------------------------------------------------------------ *)
 
+let updateMovedArchivesLocal (fspath, (pathFrom, uiFrom, pathFrom', uiFrom')) =
+  let updateArchive path ui ~stash =
+    let localPath = Update.translatePathLocal fspath path in
+    (* Archive update must be done first (before Stasher call) *)
+    let newArch = Update.updateArchive fspath localPath ui in
+    (* We update the archive with what was actually moved on disk *)
+    Update.replaceArchiveLocal fspath localPath newArch;
+    if stash then
+      Stasher.stashCurrentVersion fspath localPath None
+  in
+  let moved = match uiFrom with
+    | Updates (Absent, NoArchive) -> false
+    | _ -> true
+  in
+  updateArchive pathFrom uiFrom ~stash:false;
+  updateArchive pathFrom' uiFrom' ~stash:moved;
+  Lwt.return ()
+
+let updateMovedArchivesOnRoot =
+  Remote.registerRootCmd "updateMovedArchives" updateMovedArchivesLocal
+
+let rec setMoveProps workingDir path = function
+  | ArchiveFile (desc, _, _, _) ->
+      Fileinfo.set workingDir path (`Copy path) desc
+  | ArchiveDir (desc, children) ->
+      Fileinfo.set workingDir path (`Copy path) desc;
+      Update.NameMap.iter
+        (fun name arch -> setMoveProps workingDir (Path.child path name) arch)
+        children
+  | ArchiveSymlink _ | NoArchive -> ()
+
+let moveLocal (fspath, (pathSource, uiSource, pathTarget, uiTarget, propsTarget,
+                        newUiSource, newUiTarget, notDefault)) =
+  (* Calculate source and target paths *)
+  setupTargetPathsAndCreateParentDirectoryLocal
+    (fspath, (pathTarget, propsTarget))
+     >>= fun (workingDirTo, realPathTo, _, localPathTo) ->
+  let localPathFrom = Update.translatePathLocal fspath pathSource in
+  let (workingDirFrom, realPathFrom) =
+    Fspath.findWorkingDir fspath localPathFrom in
+  debug (fun () -> Util.msg "moveLocal: %s/%s to %s/%s\n"
+    (Fspath.toDebugString fspath)
+    (Path.toString localPathFrom)
+    (Fspath.toDebugString fspath)
+    (Path.toString localPathTo));
+  (* When in Unicode case-insensitive mode, we want to create files
+     with NFC normal-form filenames. *)
+  let realPathTo =
+    match Path.deconstructRev realPathTo with
+    | None -> assert false
+    | Some (name, parentPath) ->
+        Path.child parentPath (Name.normalize name)
+  in
+  (* Check that move source is unchanged *)
+  let fastCheck = Update.useFastChecking () in
+  let _ = Update.checkNoUpdates ~fastCheck fspath localPathFrom uiSource in
+  let copyInfo = prepareCopy workingDirTo realPathTo notDefault in
+  (* Make sure the target is unchanged, then do the rename.
+     (Note that there is an unavoidable race condition here...) *)
+  let prevArch = Update.checkNoUpdates fspath localPathTo uiTarget in
+  let realPathTo = match finishCopy copyInfo with
+  | Some conflictPath -> conflictPath
+  | None -> realPathTo in
+  performRename fspath localPathTo
+    (workingDirFrom, realPathFrom) (workingDirTo, realPathTo) prevArch
+    ~exdev:(fun () -> raise_notrace (Util.Transient "EXDEV"));
+  let moveSrcArch = Update.updateArchive fspath localPathFrom newUiSource in
+  let moveDstArch = Update.updateArchive fspath localPathTo newUiTarget in
+  (* Set the props after the rename to avoid the move changing them
+     (can happen with inheritance, xattrs, and such). *)
+  setMoveProps workingDirTo realPathTo moveDstArch;
+  Stasher.stashCurrentVersion fspath localPathTo None;
+  Update.iterFiles fspath localPathTo moveDstArch Xferhint.insertEntry;
+  (* Archive update must be done last *)
+  Update.replaceArchiveLocal fspath localPathFrom moveSrcArch;
+  Update.replaceArchiveLocal fspath localPathTo moveDstArch;
+  Lwt.return ()
+
+let moveOnRoot = Remote.registerRootCmd "move" moveLocal
+
+let move
+      rootFrom
+        pathFrom uiFrom
+        pathFrom' uiFrom' propsFrom'
+      rootTo
+        pathTo uiTo
+        pathTo' uiTo' propsTo'
+      notDefault =
+  debug (fun () ->
+    Util.msg "move %s %s --> %s\n   %s %s --> %s\n"
+      (root2string rootFrom) (Path.toString pathFrom) (Path.toString pathFrom')
+      (root2string rootTo) (Path.toString pathTo) (Path.toString pathTo'));
+  let props' = normalizeProps propsFrom' propsTo' in
+  moveOnRoot rootTo (pathTo, uiTo, pathTo', uiTo', props',
+                     uiFrom, uiFrom', notDefault) >>= fun () ->
+  updateMovedArchivesOnRoot rootFrom (pathFrom, uiFrom, pathFrom', uiFrom')
+
+(* ------------------------------------------------------------ *)
+
 let (>>=) = Lwt.bind
 
 let diffCmd =

src/files.mli

@@ -49,6 +49,24 @@ val setProp :
   -> Common.updateItem          (* target updates *)
   -> unit Lwt.t
 
+(* Replicate a rename/move done on a path in one replica to a rename/move on  *)
+(* another path in a second replica (or revert the original rename/move).     *)
+val move :
+     Common.root                (* from what root *)
+  -> Path.t                     (* original path *)
+  -> Common.updateItem          (* original path updates *)
+  -> Path.t                     (* moved path (new path) *)
+  -> Common.updateItem          (* moved path updates *)
+  -> Props.t list               (* properties of new parent directories *)
+  -> Common.root                (* to what root *)
+  -> Path.t                     (* path to rename *)
+  -> Common.updateItem          (* original path updates *)
+  -> Path.t                     (* path after rename (new path) *)
+  -> Common.updateItem          (* new path updates (before move) *)
+  -> Props.t list               (* properties of new parent directories *)
+  -> bool                       (* [true] if not Unison's default action *)
+  -> unit Lwt.t
+
 (* Generate a difference summary for two (possibly remote) versions of a     *)
 (* file and send it to a given function                                      *)
 val diff :