From 88b19b94be43e710fa414a2289a2a370051ebe59 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?T=C3=B5ivo=20Leedj=C3=A4rv?= Date: Sun, 23 Oct 2022 16:40:13 +0200 Subject: [PATCH 1/6] Make it possible to stop update propagation Also make it quicker to react to the stop request by checking it more often during file copy/transfer. --- src/abort.ml | 12 ++++++++++-- src/abort.mli | 4 ++++ src/copy.ml | 3 +++ src/files.ml | 6 ++---- src/transport.ml | 1 + 5 files changed, 20 insertions(+), 6 deletions(-) diff --git a/src/abort.ml b/src/abort.ml index f356e64fe..2d8e8e0d4 100644 --- a/src/abort.ml +++ b/src/abort.ml @@ -60,12 +60,20 @@ let all () = abortAll := true (****) +let isAll () = !abortAll + +let checkAll () = + if !abortAll then raise (Util.Transient "Aborted by user request") + let check id = debug (fun() -> Util.msg "Checking line %s\n" (Uutil.File.toString id)); - if !abortAll || errorCount id >= Prefs.read maxerrors then begin + checkAll (); + if errorCount id >= Prefs.read maxerrors then begin debug (fun() -> Util.msg "Abort failure for line %s\n" (Uutil.File.toString id)); raise (Util.Transient "Aborted") end -let testException e = (e = Util.Transient "Aborted") +let testException e = + (e = Util.Transient "Aborted") || + (e = Util.Transient "Aborted by user request") diff --git a/src/abort.mli b/src/abort.mli index eca5ed409..9e33736e1 100644 --- a/src/abort.mli +++ b/src/abort.mli @@ -7,6 +7,10 @@ val reset : unit -> unit val file : Uutil.File.t -> unit val all : unit -> unit +(* Check whether stop of all transfers has been requested. *) +val isAll : unit -> bool +val checkAll : unit -> unit (* Raises a transient exception *) + (* Check whether an item is being aborted. A transient exception is raised if this is the case. *) val check : Uutil.File.t -> unit diff --git a/src/copy.ml b/src/copy.ml index 74cdc4074..c968de12a 100644 --- a/src/copy.ml +++ b/src/copy.ml @@ -433,6 +433,7 @@ let copyContents fspathFrom pathFrom fspathTo pathTo fileKind fileLength ido = (fun l -> use_id (fun id -> (* (Util.msg "Copied file %s (%d bytes)\n" (Path.toString pathFrom) l); *) + if fileKind <> `RESS then Abort.checkAll (); Uutil.showProgress id (Uutil.Filesize.ofInt l) "l")); closeFileIn inFd; closeFileOut outFd; @@ -592,6 +593,7 @@ let compress conn (fun () -> showPrefixProgress id fileKind; let showProgress count = + if fileKind <> `RESS then Abort.checkAll (); Uutil.showProgress id (Uutil.Filesize.ofInt count) "r" in let compr = match biOpt with @@ -701,6 +703,7 @@ let transferFileContents let outfd = ref None in let infd = ref None in let showProgress count = + if fileKind <> `RESS then Abort.checkAll (); Uutil.showProgress id (Uutil.Filesize.ofInt count) "r" in let destFileSize = diff --git a/src/files.ml b/src/files.ml index c1e3f6833..28a37ff8d 100644 --- a/src/files.ml +++ b/src/files.ml @@ -733,10 +733,8 @@ let copy (fun e -> match e with Util.Transient _ -> - if not (Abort.testException e) then begin - Abort.file id; - errors := e :: !errors - end; + if not (Abort.testException e) then Abort.file id; + errors := e :: !errors; Lwt.return (Update.NoArchive, [pFrom]) | _ -> Lwt.fail e) diff --git a/src/transport.ml b/src/transport.ml index 227a3ac4a..da65860f0 100644 --- a/src/transport.ml +++ b/src/transport.ml @@ -55,6 +55,7 @@ let maxThreads () = let run dispenseTask = let runConcurrent limit dispenseTask = + let dispenseTask () = if Abort.isAll () then None else dispenseTask () in let avail = ref limit in let rec runTask thr = Lwt.try_bind thr From a5df70cbe810ba814d5e1efbbcd78ca632da67fe Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?T=C3=B5ivo=20Leedj=C3=A4rv?= Date: Sun, 23 Oct 2022 16:40:31 +0200 Subject: [PATCH 2/6] Make it possible to stop update propagation in GUI --- doc/unison-manual.tex | 16 ++++++++++++++++ src/.depend | 2 ++ src/uigtk3.ml | 39 ++++++++++++++++++++++++++------------- 3 files changed, 44 insertions(+), 13 deletions(-) diff --git a/doc/unison-manual.tex b/doc/unison-manual.tex index 2bb8a3a27..14c74c164 100644 --- a/doc/unison-manual.tex +++ b/doc/unison-manual.tex @@ -1963,6 +1963,22 @@ terminal alone and process input a line at a time. \end{itemize} +\SUBSECTION{Interrupting a Synchronization}{intr} + +It is possible to interrupt an ongoing synchronization process before it +completes. Different user interfaces offer different ways of doing it. + +\begin{tkui} +In the graphical user interface the synchronization process can be interrupted +before it is finished by pressing the ``Stop'' button or by closing the window. +The ``Stop'' button causes the onging propagation to be stopped as quickly as +possible while still doing proper cleanup. The application keeps running and a +rescan can be performed or a different profile selected. Closing the window in +the middle of update propagation process will exit the application immediately +without doing proper cleanup; it is therefore not recommended unless the +``Stop'' button does not react quickly enough. +\end{tkui} + \SUBSECTION{Exit Code}{exit} When running in the textual mode, Unison returns an exit status, which diff --git a/src/.depend b/src/.depend index 694ee3017..85fb68b61 100644 --- a/src/.depend +++ b/src/.depend @@ -1348,6 +1348,7 @@ uigtk3.cmo : \ common.cmi \ clroot.cmi \ case.cmi \ + abort.cmi \ uigtk3.cmi uigtk3.cmx : \ uutil.cmx \ @@ -1373,6 +1374,7 @@ uigtk3.cmx : \ common.cmx \ clroot.cmx \ case.cmx \ + abort.cmx \ uigtk3.cmi uigtk3.cmi : \ uicommon.cmi diff --git a/src/uigtk3.ml b/src/uigtk3.ml index 0e9404637..a23c0e45e 100644 --- a/src/uigtk3.ml +++ b/src/uigtk3.ml @@ -2758,6 +2758,7 @@ let createToplevelWindow () = let grDiff = ref [] in let grGo = ref [] in let grRescan = ref [] in + let grStop = ref [] in let grDetail = ref [] in let grAdd gr w = gr := w#misc::!gr in let grSet gr st = Safelist.iter (fun x -> x#set_sensitive st) !gr in @@ -2766,6 +2767,7 @@ let createToplevelWindow () = grSet grDiff false; grSet grGo false; grSet grRescan false; + grSet grStop false; grSet grDetail false in @@ -3141,7 +3143,7 @@ let createToplevelWindow () = let width = let metrics = mainWindowSW#misc#pango_context#get_metrics () in let w = GPango.to_pixels metrics#approx_digit_width in - max (w * 112) 840 + max (w * 112) 860 in let width = min width (Gdk.Screen.width ~screen:toplevelWindow#screen ()) in (height, width) @@ -3635,6 +3637,7 @@ let createToplevelWindow () = Trace.status "Propagating changes"; Uicommon.transportStart (); + grSet grStop true; let totalLength = Array.fold_left (fun l si -> @@ -3695,6 +3698,7 @@ let createToplevelWindow () = Uicommon.transportItems !theState (fun {ri; _} -> not (Common.isDeletion ri)) uiWrapper; Uicommon.transportItems !theState (fun {ri; _} -> Common.isDeletion ri) uiWrapper; Uicommon.transportFinish (); + grSet grStop false; Trace.showTimer t; commitUpdates (); stopStats (); @@ -3758,19 +3762,29 @@ let createToplevelWindow () = if skippedCount = 0 then [] else [Printf.sprintf "%d skipped" skippedCount] in + let nostartCount = + if not (Abort.isAll ()) then 0 else + Array.fold_left + (fun c si -> if si.whatHappened = None then c + 1 else c) + 0 !theState + in + let nostart = + if nostartCount = 0 then [] else + [Printf.sprintf "%d not started" nostartCount] + in unsynchronizedPaths := Some (Safelist.map (fun (si, _, _) -> si.ri.path1) (failureList @ partialList @ skippedList), []); Trace.status (Printf.sprintf "Synchronization complete %s" - (String.concat ", " (failures @ partials @ skipped))); + (String.concat ", " (failures @ partials @ skipped @ nostart))); displayGlobalProgress 0.; grSet grRescan true; make_interactive toplevelWindow; - let totalCount = failureCount + partialCount + skippedCount in + let totalCount = failureCount + partialCount + skippedCount + nostartCount in if totalCount > 0 then begin let format n item sing plur = match n with @@ -3781,10 +3795,12 @@ let createToplevelWindow () = let infos = format failureCount "failure" "" "s" @ format partialCount "partially transferred director" "y" "ies" @ - format skippedCount "skipped item" "" "s" + format skippedCount "skipped item" "" "s" @ + format nostartCount "not started item" "" "s" in let message = - (if failureCount = 0 then "The synchronization was successful.\n\n" + (if failureCount = 0 && nostartCount = 0 then + "The synchronization was successful.\n\n" else "") ^ "The replicas are not fully synchronized.\n" ^ (if totalCount < 2 then "There was" else "There were") ^ @@ -3968,14 +3984,11 @@ let createToplevelWindow () = ~callback:(fun () -> getLock synchronize) ()); - (* Does not quite work: too slow, and Files.copy must be modifed to - support an interruption without error. *) - (* - ignore (actionBar#insert_button ~text:"Stop" - ~icon:((GMisc.image ~stock:`STOP ())#coerce) - ~tooltip:"Exit Unison" - ~callback:Abort.all ()); - *) + grAdd grStop + (insert_button actionBar ~text:"Stop" + ~stock:`STOP + ~tooltip:"Stop update propagation" + ~callback:Abort.all ()); (********************************************************************* Rescan button From 3cf64fb47f63d57fa3c60b8db698bb7cf1e1cc53 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?T=C3=B5ivo=20Leedj=C3=A4rv?= Date: Sun, 23 Oct 2022 19:39:22 +0200 Subject: [PATCH 3/6] Make it possible to stop update propagation in TUI --- doc/unison-manual.tex | 13 ++++++ man/unison.1.in | 18 ++++++++ src/.depend | 2 + src/uitext.ml | 99 ++++++++++++++++++++++++++++++++++++------- 4 files changed, 117 insertions(+), 15 deletions(-) diff --git a/doc/unison-manual.tex b/doc/unison-manual.tex index 14c74c164..3b21bbbe3 100644 --- a/doc/unison-manual.tex +++ b/doc/unison-manual.tex @@ -1979,6 +1979,19 @@ ``Stop'' button does not react quickly enough. \end{tkui} +\begin{textui} +When not synchronizing continuously, the text interface terminates when +synchronization is finished normally or due to a fatal error occuring. + +In the text interface, to interrupt synchronization before it is finished, +press ``Ctrl-C'' (or send signal \verb|SIGINT| or \verb|SIGTERM|). This will +interrupt update propagation as quickly as possible but still complete proper +cleanup. If the process does not stop even after pressing ``Ctrl-C'' then keep +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. +\end{textui} + \SUBSECTION{Exit Code}{exit} When running in the textual mode, Unison returns an exit status, which diff --git a/man/unison.1.in b/man/unison.1.in index 422d91741..60d77a424 100644 --- a/man/unison.1.in +++ b/man/unison.1.in @@ -282,6 +282,24 @@ beginning with #; both are ignored. .Pp When Unison starts, it first reads the profile and then the command line, so command-line options will override settings from the profile. +.Sh TERMINATION +When not synchronizing continuously, the text interface terminates when +synchronization is finished normally or due to a fatal error occuring. +.Pp +In the text interface, to interrupt synchronization before it is finished, +press +.Sy Ctrl-C +(or send signal +.Sy SIGINT +or +.Sy SIGTERM ) . +This will interrupt update propagation as quickly as possible but still +complete proper cleanup. If the process does not stop even after pressing +.Sy Ctrl-C +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. .Sh ENVIRONMENT .Bl -tag .It Ev UNISON diff --git a/src/.depend b/src/.depend index 85fb68b61..cbb511033 100644 --- a/src/.depend +++ b/src/.depend @@ -1451,6 +1451,7 @@ uitext.cmo : \ globals.cmi \ fswatchold.cmi \ common.cmi \ + abort.cmi \ uitext.cmi uitext.cmx : \ uutil.cmx \ @@ -1473,6 +1474,7 @@ uitext.cmx : \ globals.cmx \ fswatchold.cmx \ common.cmx \ + abort.cmx \ uitext.cmi uitext.cmi : \ uicommon.cmi diff --git a/src/uitext.ml b/src/uitext.ml index 1cbd52e57..0004d26c8 100644 --- a/src/uitext.ml +++ b/src/uitext.ml @@ -845,12 +845,57 @@ let doTransport reconItemList = in Uutil.setProgressPrinter showProgress; + let intrcount = ref 0 in + let sigtermHandler _ = + if !intrcount >= 3 then raise Sys.Break; + Abort.all (); + incr intrcount + in + let ctrlCHandler n = + sigtermHandler n; + if !intrcount = 1 then + let s = "\n\nUpdate propagation interrupted. It may take a while \ + to stop.\nIf the process doesn't stop soon then wait or press \ + Ctrl-C\n3 more times to force immediate termination.\n\n\n" in + (* Don't use [Printf.*printf] or [Format.*printf] (or other functions + which use [Stdlib.out_channel]) because this can cause a deadlock + with other outputting functions (in this case most likely at + [Util.set_infos] called in [showProgress]) before OCaml 4.12. *) + try Unix.write_substring Unix.stdout s 0 (String.length s) |> ignore + with Unix.Unix_error _ -> () + in + let stopAtIntr f = + let signal_noerr signa behv = + try Some (Sys.signal signa behv) + with Sys_error _ | Invalid_argument _ -> None + in + let restore_noerr signa = function + | Some prevSig -> ignore (signal_noerr signa prevSig) + | None -> () + in + let prevSigInt = signal_noerr Sys.sigint (Signal_handle ctrlCHandler) in + let prevSigTerm = signal_noerr Sys.sigterm (Signal_handle sigtermHandler) in + let restoreSig () = + (* Set handlers will still raise [Sys.Break]; can ignore errors here. *) + restore_noerr Sys.sigint prevSigInt; + restore_noerr Sys.sigterm prevSigTerm + in + + try f (); restoreSig () + with e -> + let origbt = Printexc.get_raw_backtrace () in + restoreSig (); + Printexc.raise_with_backtrace e origbt + in + Uicommon.transportStart (); let fFailedPaths = ref [] in let fPartialPaths = ref [] in + let notstarted = ref (Array.length items) in let uiWrapper i item = Lwt.try_bind - (fun () -> Transport.transportItem item.ri + (fun () -> decr notstarted; + Transport.transportItem item.ri (Uutil.File.ofLine i) verifyMerge) (fun () -> if partiallyProblematic item.ri && not (problematic item.ri) then @@ -872,14 +917,16 @@ let doTransport reconItemList = return () | _ -> fail e) in - Uicommon.transportItems items (fun {ri; _} -> not (Common.isDeletion ri)) uiWrapper; - Uicommon.transportItems items (fun {ri; _} -> Common.isDeletion ri) uiWrapper; + stopAtIntr begin fun () -> + Uicommon.transportItems items (fun {ri; _} -> not (Common.isDeletion ri)) uiWrapper; + Uicommon.transportItems items (fun {ri; _} -> Common.isDeletion ri) uiWrapper + end; Uicommon.transportFinish (); Uutil.setProgressPrinter (fun _ _ _ -> ()); Util.set_infos ""; - (Safelist.rev !fFailedPaths, Safelist.rev !fPartialPaths) + (Safelist.rev !fFailedPaths, Safelist.rev !fPartialPaths, !notstarted, !intrcount > 0) let setWarnPrinterForInitialization()= Util.warnPrinter := @@ -917,8 +964,8 @@ let formatStatus major minor = s let rec interactAndPropagateChanges prevItemList reconItemList - : bool * bool * bool * (Path.t list) - (* anySkipped?, anyPartial?, anyFailures?, failingPaths *) = + : bool * bool * bool * bool * (Path.t list) + (* anySkipped?, anyPartial?, anyFailures?, anyCancels?, failingPaths *) = let (proceed,newReconItemList) = interact prevItemList reconItemList in let (updatesToDo, skipped) = Safelist.fold_left @@ -926,21 +973,41 @@ let rec interactAndPropagateChanges prevItemList reconItemList if problematic ri then (howmany, skipped + 1) else (howmany + 1, skipped)) (0, 0) newReconItemList in + let doTransp newReconItemList = + try + doTransport newReconItemList + with e -> + let origbt = Printexc.get_raw_backtrace () in + let summary = + "\nSynchronization " + ^ (color `Failure) + ^ (match e with Sys.Break -> "interrupted" | _ -> "failed") + ^ (color `Reset) + ^ (try let tm = Util.localtime (Util.time ()) in + Printf.sprintf " at %02d:%02d:%02d" + tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec with _ -> "") + ^ (match e with Sys.Break -> " by user request" | _ -> " due to a fatal error") + ^ "\n\n" + in + Trace.log_color summary; + Printexc.raise_with_backtrace e origbt + in let doit() = if not (Prefs.read Globals.batch || Prefs.read Trace.terse) then newLine(); if not (Prefs.read Trace.terse) then Trace.status "Propagating updates"; let timer = Trace.startTimer "Transmitting all files" in - let (failedPaths, partialPaths) = doTransport newReconItemList in + let (failedPaths, partialPaths, notstarted, intr) = doTransp newReconItemList in let failures = Safelist.length failedPaths in let partials = Safelist.length partialPaths in Trace.showTimer timer; if not (Prefs.read Trace.terse) then Trace.status "Saving synchronizer state"; Update.commitUpdates (); - let trans = updatesToDo - failures in + let trans = updatesToDo - notstarted - failures in let summary = Printf.sprintf - "Synchronization %s at %s (%d item%s transferred, %s%s, %s)" - (if failures = 0 then (color `Success) ^ "complete" ^ (color `Reset) else (color `Failure) ^ "incomplete" ^ (color `Reset)) + "Synchronization %s at %s (%d item%s transferred, %s%s, %s%s)" + (if failures = 0 && notstarted = 0 then (color `Success) ^ "complete" ^ (color `Reset) + else (color `Failure) ^ "incomplete" ^ (color `Reset)) (let tm = Util.localtime (Util.time()) in Printf.sprintf "%02d:%02d:%02d" tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec) @@ -950,7 +1017,8 @@ let rec interactAndPropagateChanges prevItemList reconItemList else "") (if skipped = 0 then "0 skipped" else (color `Information) ^ (Printf.sprintf "%d skipped" skipped) ^ (color `Reset)) - (if failures = 0 then "0 failed" else (color `Failure) ^ (Printf.sprintf "%d failed" failures) ^ (color `Reset)) in + (if failures = 0 then "0 failed" else (color `Failure) ^ (Printf.sprintf "%d failed" failures) ^ (color `Reset)) + (if notstarted = 0 then "" else ", " ^ (color `Information) ^ (Printf.sprintf "%d not started" notstarted) ^ (color `Reset)) in Trace.log_color (summary ^ "\n"); if skipped>0 then Safelist.iter @@ -971,7 +1039,8 @@ let rec interactAndPropagateChanges prevItemList reconItemList Safelist.iter (fun p -> alwaysDisplayAndLog (" failed: " ^ (Path.toString p))) failedPaths; - (skipped > 0, partials > 0, failures > 0, failedPaths) in + if intr then raise Sys.Break; (* Make sure repeat mode is stopped *) + (skipped > 0, partials > 0, failures > 0, notstarted > 0, failedPaths) in if updatesToDo = 0 then begin (* BCP (3/09): We need to commit the archives even if there are no updates to propagate because some files (in fact, if we've @@ -1006,7 +1075,7 @@ let rec interactAndPropagateChanges prevItemList reconItemList | _ -> ()) newReconItemList end; - (skipped > 0, false, false, []) + (skipped > 0, false, false, false, []) end else if proceed=ProceedImmediately then begin doit() end else @@ -1133,9 +1202,9 @@ let synchronizeOnce ?wantWatcher pathsOpt = (Uicommon.perfectExit, []) end else begin checkForDangerousPath dangerousPaths; - let (anySkipped, anyPartial, anyFailures, failedPaths) = + let (anySkipped, anyPartial, anyFailures, anyCancel, failedPaths) = interactAndPropagateChanges [] reconItemList in - let exitStatus = Uicommon.exitCode(anySkipped || anyPartial,anyFailures) in + let exitStatus = Uicommon.exitCode (anySkipped || anyPartial || anyCancel, anyFailures) in (exitStatus, failedPaths) end From 3c626270c17e35ff6fed0e3701a9072c6bf66fa8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?T=C3=B5ivo=20Leedj=C3=A4rv?= Date: Sun, 23 Oct 2022 19:03:43 +0200 Subject: [PATCH 4/6] Remove duplicate failure output in text UI Individual propagation failures are displayed to the user in the UI (both text and graphical). The failure output in the Transport module looks more like it could be a debug output or intended for the log only. In the GUI this is not a problem because output to stdout/stderr is suppressed. In the text UI it is duplicating information and it can generate a lot of output when there are many failures. Make it write in the log only as otherwise the information might go missing when using the GUI. --- src/transport.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/transport.ml b/src/transport.ml index da65860f0..549091072 100644 --- a/src/transport.ml +++ b/src/transport.ml @@ -157,9 +157,9 @@ let doAction fromRoot fromPath uiFrom propsFrom toRoot toPath uiTo propsTo notDefault id)) - (fun e -> Trace.log + (fun e -> Trace.logonly (Printf.sprintf - "Failed: %s\n" (Util.printException e)); + "Failed [%s]: %s\n" (Path.toString toPath) (Util.printException e)); return ()) let propagate root1 root2 reconItem id showMergeFn = From 3b086a08b8e22baf41e0287362eb59db44c02a2a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?T=C3=B5ivo=20Leedj=C3=A4rv?= Date: Tue, 25 Oct 2022 11:08:56 +0200 Subject: [PATCH 5/6] Regen strings.ml --- src/strings.ml | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/src/strings.ml b/src/strings.ml index 69012b690..992921395 100644 --- a/src/strings.ml +++ b/src/strings.ml @@ -2728,6 +2728,36 @@ let docs = \032 Setting the dumbtty preference will force Unison to leave the\n\ \032 terminal alone and process input a line at a time.\n\ \n\ + Interrupting a Synchronization\n\ + \n\ + \032 It is possible to interrupt an ongoing synchronization process before\n\ + \032 it completes. Different user interfaces offer different ways of doing\n\ + \032 it.\n\ + \n\ + \032 Graphical Interface:\n\ + \032 * In the graphical user interface the synchronization process can be\n\ + \032 interrupted before it is finished by pressing the \226\128\156Stop\226\128\157 button or\n\ + \032 by closing the window. The \226\128\156Stop\226\128\157 button causes the onging\n\ + \032 propagation to be stopped as quickly as possible while still doing\n\ + \032 proper cleanup. The application keeps running and a rescan can be\n\ + \032 performed or a different profile selected. Closing the window in\n\ + \032 the middle of update propagation process will exit the application\n\ + \032 immediately without doing proper cleanup; it is therefore not\n\ + \032 recommended unless the \226\128\156Stop\226\128\157 button does not react quickly enough.\n\ + \n\ + \032 Textual Interface:\n\ + \032 * When not synchronizing continuously, the text interface terminates\n\ + \032 when synchronization is finished normally or due to a fatal error\n\ + \032 occuring.\n\ + \032 In the text interface, to interrupt synchronization before it is\n\ + \032 finished, press \226\128\156Ctrl-C\226\128\157 (or send signal SIGINT or SIGTERM). This\n\ + \032 will interrupt update propagation as quickly as possible but still\n\ + \032 complete proper cleanup. If the process does not stop even after\n\ + \032 pressing \226\128\156Ctrl-C\226\128\157 then keep doing it repeatedly. This will bypass\n\ + \032 cleanup procedures and terminates the process forcibly (similar to\n\ + \032 SIGKILL). Doing so may leave the archives or replicas in an\n\ + \032 inconsistent state or locked.\n\ + \n\ Exit Code\n\ \n\ \032 When running in the textual mode, Unison returns an exit status, which\n\ From ec3bba13aab2288b1d4bcdad70c88b30688cd3bb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?T=C3=B5ivo=20Leedj=C3=A4rv?= Date: Sat, 29 Oct 2022 14:28:59 +0200 Subject: [PATCH 6/6] Prevent ssh process from receiving SIGINT Certain signals can be generated by the terminal based on user input (for example, Ctrl-C -> SIGINT). The generated signals are sent not just to the process the user considers to be foreground but to all processes in the foreground process group. As a consequence, if one process needs the other(s) to do cleanup before terminating, it's no longer possible. This happens to Unison when it tries to do cleanup with the remote server. The ssh process has already died and the remote connection is broken. To prevent the ssh process from terminating too early, block some signals (here, SIGINT) before spawning the ssh child process. Child processes inherit the signal mask and signal settings so blocking some signals before spawning effectively blocks these signals for the ssh process (unless it changes the sigmask for itself). --- src/remote.ml | 48 ++++++++++++++++++++++++++++++++++++++++++++-- src/ubase/util.ml | 13 +++++++++++++ src/ubase/util.mli | 5 +++++ src/uitext.ml | 1 + 4 files changed, 65 insertions(+), 2 deletions(-) diff --git a/src/remote.ml b/src/remote.ml index 843c2729c..f8e00e843 100644 --- a/src/remote.ml +++ b/src/remote.ml @@ -1851,8 +1851,52 @@ let buildShellConnection shell host userOpt portOpt rootName termInteract = let (term, termPid) = Util.convertUnixErrorsToFatal "starting shell connection" (fun () -> match termInteract with - None -> - (None, System.create_process shellCmd argsarray i1 o2 Unix.stderr) + | None -> + (* Signals generated by the terminal from user input are sent to all + processes in the foreground process group. This means that the ssh + child process will receive SIGINT at the same time as Unison and + close the connection before Unison has the chance to do cleanup with + the remote end. To make matters more complicated, the ssh process + must be in the foreground process group because interaction with the + user is done via the terminal (not via stdin, stdout) and background + processes can't read from the terminal (unless we'd set up a pty + like is done for the GUI). + + Don't let these signals reach ssh by blocking them. + + The signals could be ignored instead of being blocked because ssh + does not set handlers for SIGINT and SIGQUIT if they've been ignored + at startup. But this triggers an error in ssh. The interactive + passphrase reading function captures these signals for the purpose + of restoring terminal settings (echo). When receiving a signal, and + after restoring previous signal handlers, it resends the signal to + itself. But now the signal is ignored and instead of terminating, + the process will continue running as if passphrase reading function + had returned with an empty result. + + Since the ssh process no longer receives the signals generated by + user input we have to make sure that it terminates when Unison does. + This usually happens due to its stdin and stdout being closed, + except for when it is interacting with the user via terminal. To get + around that, an [at_exit] handler is registered to send a SIGTERM + and SIGKILL to the ssh process. (Note, for [at_exit] handlers to + run, unison process must terminate normally, not be killed. For + SIGINT, this means that [Sys.catch_break true] (or an alternative + SIGINT handler) must be set before creating the ssh process.) *) + let pid = Util.blockSignals [Sys.sigint] (fun () -> + System.create_process shellCmd argsarray i1 o2 Unix.stderr) in + let end_ssh () = + let kill_noerr si = try Unix.kill pid si + with Unix.Unix_error _ -> () | Invalid_argument _ -> () in + match Unix.waitpid [WNOHANG] pid with + | (0, _) -> + (* Grace period before killing. Important to give ssh a chance + to restore terminal settings, should that be needed. *) + kill_noerr Sys.sigterm; Unix.sleepf 0.01; kill_noerr Sys.sigkill + | _ | exception Unix.Unix_error _ -> () + in + let () = at_exit end_ssh in + (None, pid) | Some callBack -> Terminal.create_session shellCmd argsarray i1 o2 Unix.stderr) in diff --git a/src/ubase/util.ml b/src/ubase/util.ml index 7abb1bf03..2f409a88f 100644 --- a/src/ubase/util.ml +++ b/src/ubase/util.ml @@ -272,6 +272,19 @@ let process_status_to_string = function | Unix.WSIGNALED i -> Printf.sprintf "Killed by signal %d" i | Unix.WSTOPPED i -> Printf.sprintf "Stopped by signal %d" i + +let blockSignals sigs f = + let (prevMask, ok) = + try (Unix.sigprocmask SIG_BLOCK sigs, true) + with Invalid_argument _ -> ([], false) in + let restoreMask () = + if ok then Unix.sigprocmask SIG_SETMASK prevMask |> ignore in + try let r = f () in restoreMask (); r + with e -> + let origbt = Printexc.get_raw_backtrace () in + restoreMask (); + Printexc.raise_with_backtrace e origbt + (*****************************************************************************) (* OS TYPE *) (*****************************************************************************) diff --git a/src/ubase/util.mli b/src/ubase/util.mli index 3a426e26a..330dc93f1 100644 --- a/src/ubase/util.mli +++ b/src/ubase/util.mli @@ -33,6 +33,11 @@ val printException : exn -> string val process_status_to_string : Unix.process_status -> string +(* [blockSignals sigs f] blocks signals [sigs] (if supported by OS), + executes [f ()] and restores the original signal mask before returning + the result of executing [f ()] (value or exception). *) +val blockSignals : int list -> (unit -> 'a) -> 'a + (* ---------------------------------------------------------------------- *) (* Strings *) diff --git a/src/uitext.ml b/src/uitext.ml index 0004d26c8..b8eea0f29 100644 --- a/src/uitext.ml +++ b/src/uitext.ml @@ -1443,6 +1443,7 @@ let rec start interface = if interface <> Uicommon.Text then Util.msg "This Unison binary only provides the text GUI...\n"; begin try + Sys.catch_break true; (* Just to make sure something is there... *) setWarnPrinterForInitialization(); let errorOut s =