From 5d6ab3cb9921a476e73e42307d40addc1b86f30a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?T=C3=B5ivo=20Leedj=C3=A4rv?= Date: Sun, 30 Oct 2022 18:33:15 +0100 Subject: [PATCH 1/2] Make [Uicommon.repeat] a structured preference Parse and validate [Uicommon.repeat] at preference parsing instead of letting the code using the value interpret it freely and possibly error out very late in the process. Restructure the code in text UI to better align with this new preference representation and make it easier to expand in future. --- src/uicommon.ml | 23 +++++++++++++++++++++-- src/uicommon.mli | 2 +- src/uitext.ml | 30 ++++++++++++------------------ 3 files changed, 34 insertions(+), 21 deletions(-) diff --git a/src/uicommon.ml b/src/uicommon.ml index cbc368db7..e39d22e73 100644 --- a/src/uicommon.ml +++ b/src/uicommon.ml @@ -103,7 +103,23 @@ let contactingServerMsg () = Printf.sprintf "Unison %s: Contacting server..." Uutil.myVersion let repeat = - Prefs.createString "repeat" "" + let parseRepeat s = + let parseTime ts = + try int_of_string ts with Failure _ -> + raise (Prefs.IllegalValue ("Value of 'repeat' preference (" + ^ s ^ ") should be either a number or 'watch'")) + in + match s with + | "" -> `NoRepeat + | "watch" -> `Watch + | _ -> `Interval (parseTime s) + in + let externRepeat = function + | `NoRepeat -> "" + | `Watch -> "watch" + | `Interval i -> string_of_int i + in + Prefs.create "repeat" `NoRepeat ~category:(`Advanced `Syncprocess_CLI) "synchronize repeatedly (text interface only)" ("Setting this preference causes the text-mode interface to synchronize " @@ -112,7 +128,10 @@ let repeat = ^ "beginning again. When the argument is \\verb|watch|, Unison relies on " ^ "an external file monitoring process to synchronize whenever a change " ^ "happens.") -let repeatWatcher () = Prefs.read repeat = "watch" + (fun _ -> parseRepeat) + (fun r -> [externRepeat r]) + Umarshal.(sum1 string externRepeat parseRepeat) +let repeatWatcher () = Prefs.read repeat = `Watch let retry = Prefs.createInt "retry" 0 diff --git a/src/uicommon.mli b/src/uicommon.mli index 0bc9d5b18..7f78bba97 100644 --- a/src/uicommon.mli +++ b/src/uicommon.mli @@ -34,7 +34,7 @@ val contactingServerMsg : unit -> string val profileLabel : string Prefs.t (* User preference: Synchronize repeatedly *) -val repeat : string Prefs.t +val repeat : [ `NoRepeat | `Interval of int | `Watch ] Prefs.t (* User preference: Try failing paths N times *) val retry : int Prefs.t diff --git a/src/uitext.ml b/src/uitext.ml index acf3dacea..d0dfa192f 100644 --- a/src/uitext.ml +++ b/src/uitext.ml @@ -1051,7 +1051,7 @@ let rec interactAndPropagateChanges prevItemList reconItemList (* JV (5/09): Don't save the archive in repeat mode as it has some costs and its unlikely there is much change to the archives in this mode. *) - if !Update.foundArchives && Prefs.read Uicommon.repeat = "" then + if !Update.foundArchives && Prefs.read Uicommon.repeat = `NoRepeat then Update.commitUpdates (); display "No updates to propagate\n"; if skipped > 0 then begin @@ -1195,7 +1195,7 @@ let synchronizeOnce ?wantWatcher pathsOpt = if not !Update.foundArchives then Update.commitUpdates (); if reconItemList = [] then begin - if !Update.foundArchives && Prefs.read Uicommon.repeat = "" then + if !Update.foundArchives && Prefs.read Uicommon.repeat = `NoRepeat then Update.commitUpdates (); (if anyEqualUpdates then Trace.status ("Nothing to do: replicas have been changed only " @@ -1285,19 +1285,7 @@ let synchronizeUntilNoFailures repeatMode = end in loop (Prefs.read Uicommon.retry) None -let rec synchronizeUntilDone () = - let repeatinterval = - if Prefs.read Uicommon.repeat = "" then -1 else - try int_of_string (Prefs.read Uicommon.repeat) - with Failure _ -> - (* If the 'repeat' pref is not a valid number, switch modes... *) - if Prefs.read Uicommon.repeat = "watch" then - synchronizePathsFromFilesystemWatcher() - else - raise (Util.Fatal ("Value of 'repeat' preference (" - ^Prefs.read Uicommon.repeat - ^") should be either a number or 'watch'\n")) in - +let rec synchronizeUntilDone repeatinterval = let exitStatus = synchronizeUntilNoFailures(repeatinterval >= 0) in if repeatinterval < 0 then exitStatus @@ -1306,9 +1294,15 @@ let rec synchronizeUntilDone () = Trace.status (Printf.sprintf "\nSleeping for %d seconds...\n" repeatinterval); Unix.sleep repeatinterval; - synchronizeUntilDone () + synchronizeUntilDone repeatinterval end +let synchronizeUntilDone () = + match Prefs.read Uicommon.repeat with + | `Watch -> synchronizePathsFromFilesystemWatcher () + | `Interval i -> synchronizeUntilDone i + | `NoRepeat -> synchronizeUntilDone (-1) + (* ----------------- Startup ---------------- *) let profmgrPrefName = "i" @@ -1495,7 +1489,7 @@ let rec start interface = Prefs.set dumbtty true; Trace.sendLogMsgsToStderr := false; end; - if Prefs.read Uicommon.repeat <> "" then begin + if Prefs.read Uicommon.repeat <> `NoRepeat then begin Prefs.set Globals.batch true; end; setColorPreference (); @@ -1528,7 +1522,7 @@ let rec start interface = (* If any other bad thing happened and the -repeat preference is set, then restart *) handleException e; - if Prefs.read Uicommon.repeat = "" + if Prefs.read Uicommon.repeat = `NoRepeat || Prefs.read Uicommon.runtests then exit Uicommon.fatalExit; From e72c1c5838ba6e85bcfba690a5a8fb228633a83a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?T=C3=B5ivo=20Leedj=C3=A4rv?= Date: Tue, 25 Oct 2022 16:25:32 +0200 Subject: [PATCH 2/2] Add graceful stop in repeat mode - SIGUSR2 The repeat mode is basically an endless loop. It will run until the process is terminated or a fatal error occurs. Currently the only way for the user to stop repeat mode is to interrupt the process by pressing Ctrl-C or sending a signal that terminates or kills the process. This works but is not satisfactory if the delay between repeated syncs is very short (using fsmonitor on a busy root, for example). The chance of interrupting the process cleanly between syncs becomes very slim. Add a new way to stop repeat mode and do so cleanly. A stop can be requested (in this commit the request method is the signal SIGUSR2) by the user at any time and Unison decides when it is safe to act on that request. Any ongoing sync is allowed to run to completion. This way it is guaranteed that the process terminates between syncs. --- doc/unison-manual.tex | 6 +++ man/unison.1.in | 13 ++++++ src/uitext.ml | 95 ++++++++++++++++++++++++++++++++++++++----- 3 files changed, 104 insertions(+), 10 deletions(-) diff --git a/doc/unison-manual.tex b/doc/unison-manual.tex index 3b6ca6704..6ed8d5973 100644 --- a/doc/unison-manual.tex +++ b/doc/unison-manual.tex @@ -1990,6 +1990,12 @@ doing it repeatedly. This will bypass cleanup procedures and terminates the process forcibly (similar to \verb|SIGKILL|). Doing so may leave the archives or replicas in an inconsistent state or locked. + +When synchronizing continuously (time interval repeat or with filesystem +monitoring), interrupting with ``Ctrl-C'' or with signal \verb|SIGINT| or +\verb|SIGTERM| works the same way as described above and will additionally stop +the continuous process. To stop only the continuous process and let the last +synchronization complete normally, send signal \verb|SIGUSR2| instead. \end{textui} \SUBSECTION{Exit Code}{exit} diff --git a/man/unison.1.in b/man/unison.1.in index e8b924319..e2397e5bc 100644 --- a/man/unison.1.in +++ b/man/unison.1.in @@ -300,6 +300,19 @@ then keep doing it repeatedly. This will bypass cleanup procedures and terminates the process forcibly (similar to .Sy SIGKILL ) . Doing so may leave the archives or replicas in an inconsistent state or locked. +.Pp +When synchronizing continuously (time interval repeat or with filesystem +monitoring), interrupting with +.Sy Ctrl-C +or with signal +.Sy SIGINT +or +.Sy SIGTERM +works the same way as described above and will additionally stop the continuous +process. To stop only the continuous process and let the last synchronization +complete normally, send signal +.Sy SIGUSR2 +instead. .Sh ENVIRONMENT .Bl -tag .It Ev UNISON diff --git a/src/uitext.ml b/src/uitext.ml index d0dfa192f..d6812b16e 100644 --- a/src/uitext.ml +++ b/src/uitext.ml @@ -1211,6 +1211,79 @@ let synchronizeOnce ?wantWatcher pathsOpt = (exitStatus, failedPaths) end +(* ------------ Safe termination between synchronizations ------------ *) + +let safeStopReqd, requestSafeStop = + let safeStopReqd = ref false in + (* [safeStopReqd] can only go from false to true; + it must never be changed from true to false. *) + let isRequested () = !safeStopReqd + and request () = safeStopReqd := true in + isRequested, request + +(*** Requesting safe termination by signals ***) + +let set_signal_noerr signa nm behv = + try Sys.set_signal signa behv; true + with Invalid_argument _ | Sys_error _ as e -> + Trace.logonly + ("Warning: " ^ nm ^ " handler not set: " ^ (Printexc.to_string e) ^ "\n"); + false + +let stopPipe = ref None + +let setupSafeStop () = + if supportSignals then begin + let safeStop _ = + if not (safeStopReqd ()) then begin + requestSafeStop (); + (* Interrupt the interruptible sleep *) + match !stopPipe with + | Some (i, o) -> Unix.close o; Lwt_unix.close i + | None -> () + end + in + Util.blockSignals [Sys.sigusr2] (fun () -> + let ok = set_signal_noerr Sys.sigusr2 "SIGUSR2" (Signal_handle safeStop) in + if ok then stopPipe := Some (Lwt_unix.pipe_in ~cloexec:true ())) + end + +let safeStopRequested () = + safeStopReqd () + +(*** Sleep interruptible by a termination request ***) + +let safeStopWait = + let safeStopWait_aux () = + let readStop = + match !stopPipe with + | None -> Lwt.wait () + | Some (i, _) -> Lwt_unix.wait_read i + in + let readFail = function + | Unix.Unix_error (EBADF, _, _) -> Lwt.return (requestSafeStop ()) + | e -> Lwt.fail e + in + let rec loop () = + Lwt.catch + (fun () -> readStop) readFail >>= fun () -> + if not (safeStopRequested ()) then + Lwt_unix.sleep 0.15 >>= loop + else + Lwt.return () + in + loop () + in + let wt = ref None in + fun () -> + match !wt with + | Some t -> t + | None -> let t = safeStopWait_aux () in wt := Some t; t + +let interruptibleSleepf dt = + Lwt_unix.run (Lwt.choose [Lwt_unix.sleep dt; safeStopWait ()]) +let interruptibleSleep dt = interruptibleSleepf (float dt) + (* ----------------- Filesystem watching mode ---------------- *) let watchinterval = 1. (* Minimal interval between two synchronizations *) @@ -1231,7 +1304,7 @@ let waitForChanges t = Lwt_unix.run (Globals.allRootsMap (fun r -> Lwt.return (waitForChangesRoot r ())) >>= fun l -> - Lwt.choose (timeout @ l)) + Lwt.choose (timeout @ l @ [safeStopWait ()])) end let synchronizePathsFromFilesystemWatcher () = @@ -1263,11 +1336,11 @@ let synchronizePathsFromFilesystemWatcher () = PathMap.empty (Safelist.append delayedPaths failedPaths) in - Lwt_unix.run (Lwt_unix.sleep watchinterval); + interruptibleSleepf watchinterval; let nextTime = PathMap.fold (fun _ (t, d) t' -> min t t') delayInfo 1e20 in - waitForChanges nextTime; - loop false delayInfo + if not (safeStopRequested ()) then waitForChanges nextTime; + if safeStopRequested () then exitStatus else loop false delayInfo in loop true PathMap.empty @@ -1278,7 +1351,8 @@ let synchronizeUntilNoFailures repeatMode = let rec loop triesLeft pathsOpt = let (exitStatus, failedPaths) = synchronizeOnce ~wantWatcher pathsOpt in - if failedPaths <> [] && triesLeft <> 0 then begin + if failedPaths <> [] && triesLeft <> 0 + && not (repeatMode && safeStopRequested ()) then begin loop (triesLeft - 1) (Some (failedPaths, [])) end else begin exitStatus @@ -1287,14 +1361,14 @@ let synchronizeUntilNoFailures repeatMode = let rec synchronizeUntilDone repeatinterval = let exitStatus = synchronizeUntilNoFailures(repeatinterval >= 0) in - if repeatinterval < 0 then + if repeatinterval < 0 || safeStopRequested () then exitStatus else begin (* Do it again *) Trace.status (Printf.sprintf "\nSleeping for %d seconds...\n" repeatinterval); - Unix.sleep repeatinterval; - synchronizeUntilDone repeatinterval + interruptibleSleep repeatinterval; + if safeStopRequested () then exitStatus else synchronizeUntilDone repeatinterval end let synchronizeUntilDone () = @@ -1443,6 +1517,7 @@ let rec start interface = Sys.catch_break true; (* Just to make sure something is there... *) setWarnPrinterForInitialization(); + setupSafeStop (); let errorOut s = Util.msg "%s%s%s\n" Uicommon.shortUsageMsg profmgrUsageMsg s; exit 1 @@ -1527,8 +1602,8 @@ let rec start interface = exit Uicommon.fatalExit; Util.msg "\nRestarting in 10 seconds...\n\n"; - begin try Unix.sleep 10 with Sys.Break -> exit Uicommon.fatalExit end; - start interface + begin try interruptibleSleep 10 with Sys.Break -> exit Uicommon.fatalExit end; + if safeStopRequested () then exit Uicommon.fatalExit else start interface end end