[Unison-hackers] Ignore files above a certain size

Alan Schmitt alan.schmitt at polytechnique.org
Fri Mar 8 13:43:33 EST 2013


Benjamin Pierce writes:

> Ok, this approach seems reasonable. The only thing that concerns me is
> adding one more ad hoc preference...

Here is a second, more controversial patch, to extend the Conflict
direction with a string that gives the reason of the conflict, so that
it may be displayed in the logs.

The main issue with this patch is that it touches many files, and the UI
code will need to be adapted (taking into account the extra argument to
Conflict). I've dealt with the text ui for the moment. If you agree with
this approach, I'll patch the other UIs (ignoring the extra string for
the moment, the UI maintainers can then take advantage of it).

Alan

diff --git a/src/common.ml b/src/common.ml
index db74b30..c4fe298 100644
--- a/src/common.ml
+++ b/src/common.ml
@@ -118,17 +118,21 @@ type replicaContent =
     props : Props.t list }         (* Parent properties *)
 
 type direction =
-    Conflict
+    Conflict of string (* The string is the reason of the conflict *)
   | Merge
   | Replica1ToReplica2
   | Replica2ToReplica1
 
 let direction2string = function
-    Conflict -> "conflict"
+    Conflict _ -> "conflict"
   | Merge -> "merge"
   | Replica1ToReplica2 -> "replica1 to replica2"
   | Replica2ToReplica1 -> "replica2 to replica1"
 
+let isConflict = function
+    Conflict _ -> true
+  | _ -> false
+
 type difference =
   { rc1 : replicaContent;
     rc2 : replicaContent;
@@ -176,7 +180,7 @@ let riLength ri =
       begin match dir with
         Replica1ToReplica2 -> rcLength rc1 rc2
       | Replica2ToReplica1 -> rcLength rc2 rc1
-      | Conflict           -> Uutil.Filesize.zero
+      | Conflict _         -> Uutil.Filesize.zero
       | Merge              -> Uutil.Filesize.zero (* underestimate :-*)
       end
   | _ ->
@@ -205,14 +209,14 @@ let fileInfos ui1 ui2 =
 let problematic ri =
   match ri.replicas with
     Problem _      -> true
-  | Different diff -> diff.direction = Conflict
+  | Different diff -> isConflict diff.direction
 
 let partiallyProblematic ri =
   match ri.replicas with
     Problem _      ->
       true
-  | Different diff ->
-      diff.direction = Conflict || diff.errors1 <> [] || diff.errors2 <> []
+  | Different diff -> 
+     isConflict diff.direction || diff.errors1 <> [] || diff.errors2 <> []
 
 let isDeletion ri =
   match ri.replicas with
diff --git a/src/common.mli b/src/common.mli
index e484c5b..dc12d59 100644
--- a/src/common.mli
+++ b/src/common.mli
@@ -96,13 +96,15 @@ type replicaContent =
     props : Props.t list }         (* Parent properties *)
 
 type direction =
-    Conflict
+    Conflict of string (* The string is the reason of the conflict *)
   | Merge
   | Replica1ToReplica2
   | Replica2ToReplica1
 
 val direction2string : direction -> string
 
+val isConflict : direction -> bool
+
 type difference =
   { rc1 : replicaContent;           (* - content of first replica *)
     rc2 : replicaContent;           (* - content of second replica *)
diff --git a/src/recon.ml b/src/recon.ml
index 77eb87c..ccd773f 100644
--- a/src/recon.ml
+++ b/src/recon.ml
@@ -27,7 +27,7 @@ let setDirection ri dir force =
   match ri.replicas with
     Different
       ({rc1 = rc1; rc2 = rc2; direction = d; default_direction = default } as diff)
-          when force=`Force || default=Conflict ->
+          when force=`Force || isConflict default ->
       if dir=`Replica1ToReplica2 then
         diff.direction <- Replica1ToReplica2
       else if dir=`Replica2ToReplica1 then
@@ -37,10 +37,10 @@ let setDirection ri dir force =
       end else begin  (* dir = `Older or dir = `Newer *)
         match rc1.status, rc2.status with
           `Deleted, _ ->
-            if default=Conflict then
+            if isConflict default then
               diff.direction <- Replica2ToReplica1
         | _, `Deleted ->
-            if default=Conflict then
+            if isConflict default then
               diff.direction <- Replica1ToReplica2
         | _ ->
             let comp = Props.time rc1.desc -. Props.time rc2.desc in
@@ -253,25 +253,33 @@ let shouldCancel path rc1 rc2 root2 =
                       (Int64.of_int (Prefs.read maxSizeThreshold)))
   in
   match actionKind rc1 rc2 with
-    `UPDATE   -> test `UPDATE || testSize rc1
-  | `DELETION -> test `UPDATE || test `DELETION
-  | `CREATION -> test `CREATION  || testSize rc1
+    `UPDATE   -> 
+     if test `UPDATE then true, "would update a file with noupdate or noupdatepartial set"
+     else testSize rc1, "would transfer a file of size greater than maxsizethreshold"
+  | `DELETION -> 
+     if test `UPDATE then true, "would update a file with noupdate or noupdatepartial set"
+     else test `DELETION, "would delete a file with nodeletion or nodeletionpartial set"
+  | `CREATION ->
+     if test `CREATION then true, "would create a file with nocreation or nocreationpartial set"
+     else testSize rc1, "would transfer a file of size greater than maxsizethreshold"
 
 let filterRi root1 root2 ri =
   match ri.replicas with
     Problem _ ->
       ()
   | Different diff ->
-      if
-        match diff.direction with
-          Replica1ToReplica2 ->
-            shouldCancel (Path.toString ri.path1) diff.rc1 diff.rc2 root2
-        | Replica2ToReplica1 ->
-            shouldCancel (Path.toString ri.path1) diff.rc2 diff.rc1 root1
-        | Conflict | Merge ->
-            false
-      then
-        diff.direction <- Conflict
+     let cancel,reason = 
+       match diff.direction with
+         Replica1ToReplica2 ->
+          shouldCancel (Path.toString ri.path1) diff.rc1 diff.rc2 root2
+       | Replica2ToReplica1 ->
+          shouldCancel (Path.toString ri.path1) diff.rc2 diff.rc1 root1
+       | Conflict _ | Merge ->
+          false,""
+     in 
+     if cancel 
+     then
+       diff.direction <- Conflict reason
 
 let filterRis ris =
   let (root1, root2) = Globals.rawRootPair () in
@@ -534,7 +542,7 @@ let add_equal (counter, archiveUpdated) equal v =
 (* --                                                                        *)
 let rec reconcile
           allowPartial path ui1 props1 ui2 props2 counter equals unequals =
-  let different uc1 uc2 oldType equals unequals =
+  let different uc1 uc2 reason oldType equals unequals =
     (equals,
      Tree.add unequals
        (propagateErrors allowPartial
@@ -542,7 +550,8 @@ let rec reconcile
                               path true ui1 props1 uc1 oldType;
                       rc2 = update2replicaContent
                               path true ui2 props2 uc2 oldType;
-                      direction = Conflict; default_direction = Conflict;
+                      direction = Conflict reason;
+                      default_direction = Conflict reason;
                       errors1 = []; errors2 = []}))) in
   let toBeMerged uc1 uc2 oldType equals unequals =
     (equals,
@@ -583,7 +592,7 @@ let rec reconcile
            let action =
              if propsChanged1 = PropsSame then Replica2ToReplica1
              else if propsChanged2 = PropsSame then Replica1ToReplica2
-             else Conflict in
+             else Conflict "properties changed on both sides" in
            (equals,
             Tree.add unequals
               (Different
@@ -618,23 +627,27 @@ let rec reconcile
 (* expect this.)                                                             *)
              let uc1' = File(desc1,ContentsSame) in
              let uc2' = File(desc2,ContentsSame) in
-             different uc1' uc2' (oldType prev) equals unequals
+             different uc1' uc2' "properties changed on both sides" 
+                       (oldType prev) equals unequals
        | ContentsSame, ContentsSame when Props.similar desc1 desc2 ->
            (add_equal counter equals (uc1, uc2), unequals)
        | ContentsUpdated _, ContentsUpdated _
              when Globals.shouldMerge path ->
            toBeMerged uc1 uc2 (oldType prev) equals unequals
        | _ ->
-           different uc1 uc2 (oldType prev) equals unequals
+           different uc1 uc2 "contents changed on both sides"
+                     (oldType prev) equals unequals
        end
   | (Updates (Symlink(l1) as uc1, prev),
      Updates (Symlink(l2) as uc2, _)) ->
        if l1 = l2 then
          (add_equal counter equals (uc1, uc2), unequals)
        else
-         different uc1 uc2 (oldType prev) equals unequals
+         different uc1 uc2 "symbolic links changed on both sides"
+                   (oldType prev) equals unequals
   | (Updates (uc1, prev), Updates (uc2, _)) ->
-      different uc1 uc2 (oldType prev) equals unequals
+      different uc1 uc2 "conflicting updates"
+                (oldType prev) equals unequals
 
 (* Sorts the paths so that they will be displayed in order                   *)
 let sortPaths pathUpdatesList =
diff --git a/src/transport.ml b/src/transport.ml
index b578e53..b319a15 100644
--- a/src/transport.ml
+++ b/src/transport.ml
@@ -151,9 +151,9 @@ let propagate root1 root2 reconItem id showMergeFn =
         {rc1 = rc1; rc2 = rc2; direction = dir; default_direction = def} ->
       let notDefault = dir <> def in
       match dir with
-        Conflict ->
-          Trace.log (Printf.sprintf "[CONFLICT] Skipping %s\n"
-                       (Path.toString path));
+        Conflict c ->
+          Trace.log (Printf.sprintf "[CONFLICT] Skipping %s\n  %s\n"
+                       (Path.toString path) c);
           return ()
       | Replica1ToReplica2 ->
           doAction
diff --git a/src/uicommon.ml b/src/uicommon.ml
index 555a154..34ba3c0 100644
--- a/src/uicommon.ml
+++ b/src/uicommon.ml
@@ -267,7 +267,7 @@ type action = AError | ASkip of bool | ALtoR of bool | ARtoL of bool | AMerge
 
 let direction2action partial dir =
   match dir with
-    Conflict           -> ASkip partial
+    Conflict _         -> ASkip partial
   | Replica1ToReplica2 -> ALtoR partial
   | Replica2ToReplica1 -> ARtoL partial
   | Merge              -> AMerge
diff --git a/src/uitext.ml b/src/uitext.ml
index 552c9fd..5fca0d9 100644
--- a/src/uitext.ml
+++ b/src/uitext.ml
@@ -218,7 +218,7 @@ let displayri ri =
   match ri.replicas with
     Problem _ ->
       alwaysDisplay s
-  | Different {direction = d} when d=Conflict ->
+  | Different {direction = d} when isConflict d ->
       alwaysDisplay s
   | _ ->
       display s
@@ -254,7 +254,7 @@ let interact rilist =
         match ri.replicas with
           Problem s -> display "\n"; display s; display "\n"; next()
         | Different ({rc1 = rc1; rc2 = rc2; direction = dir} as diff) ->
-            if Prefs.read Uicommon.auto && dir<>Conflict then begin
+            if Prefs.read Uicommon.auto && not (isConflict dir) then begin
               display "\n"; next()
             end else
               let (descr, descl) =
@@ -271,14 +271,14 @@ let interact rilist =
               end;
               selectAction
                 (if Prefs.read Globals.batch then Some " " else None)
-                [((if dir=Conflict && not (Prefs.read Globals.batch)
+                [((if (isConflict dir) && not (Prefs.read Globals.batch)
                      then ["f"]  (* Offer no default behavior if we've got
                                     a conflict and we're in interactive mode *)
                      else ["";"f";" "]),
                   ("follow " ^ Uutil.myName ^ "'s recommendation (if any)"),
                   fun ()->
                     newLine ();
-                    if dir = Conflict && not (Prefs.read Globals.batch)
+                    if (isConflict dir) && not (Prefs.read Globals.batch)
                     then begin
                       display "No default action [type '?' for help]\n";
                       repeat()
@@ -360,7 +360,7 @@ let interact rilist =
                  (["/"],
                   ("skip"),
                   (fun () ->
-                    diff.direction <- Conflict;
+                    if not (isConflict dir) then diff.direction <- Conflict "skip requested";
                     redisplayri();
                     next()));
                  ([">";"."],


More information about the Unison-hackers mailing list