Improved handling of --time-limit when combined with -J

When concurrency is enabled, there can be worker threads still running
when the time limit is checked. Exiting right there does not
give those threads time to finish what they're doing. Instead, the seeking
is wrapped up, and git-annex then shuts down cleanly.

The whole point of --time-limit existing, rather than using timeout(1)
when running git-annex is to let git-annex finish the action(s) it is
working on when the time limit is reached, and shut down cleanly.

I noticed this problem when investigating why restagePointerFile might
not have run after get/drop of an unlocked file. With --time-limit -J,
a worker thread may have finished updating a work tree file, and be killed
by the time limit check before it can run restagePointerFile. So despite
--time-limit running the shutdown actions, the work tree file didn't get
restaged.

Sponsored-by: Dartmouth College's DANDI project

CmdLine/Seek.hs

@@ -4,7 +4,7 @@
  - the values a user passes to a command, and prepare actions operating
  - on them.
  -
- - Copyright 2010-2021 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2022 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -41,7 +41,6 @@ import Annex.Link
 import Annex.InodeSentinal
 import Annex.Concurrent
 import Annex.CheckIgnore
-import Annex.Action
 import qualified Annex.Branch
 import qualified Database.Keys
 import qualified Utility.RawFilePath as R
@@ -49,6 +48,7 @@ import Utility.Tuple
 import Utility.HumanTime
 
 import Control.Concurrent.Async
+import Control.Concurrent.STM
 import System.Posix.Types
 import Data.IORef
 import Data.Time.Clock.POSIX
@@ -610,20 +610,25 @@ notSymlink :: RawFilePath -> IO Bool
 notSymlink f = liftIO $ not . isSymbolicLink <$> R.getSymbolicLinkStatus f
 
 {- Returns an action that, when there's a time limit, can be used
- - to check it before processing a file. The first action is run when over the
- - time limit, otherwise the second action is run. -}
+ - to check it before processing a file. The first action is run when
+ - over the time limit, otherwise the second action is run one time to
+ - clean up. -}
 mkCheckTimeLimit :: Annex (Annex () -> Annex () -> Annex ())
 mkCheckTimeLimit = Annex.getState Annex.timelimit >>= \case
 	Nothing -> return $ \_ a -> a
-	Just (duration, cutoff) -> return $ \cleanup a -> do
-		now <- liftIO getPOSIXTime
-		if now > cutoff
-			then do
-				warning $ "Time limit (" ++ fromDuration duration ++ ") reached! Shutting down..."
-				shutdown True
-				cleanup
-				liftIO $ exitWith $ ExitFailure 101
-			else a
+	Just (duration, cutoff) -> do
+		warningshownv <- liftIO $ newTVarIO False
+		return $ \cleanup a -> do
+			now <- liftIO getPOSIXTime
+			if now > cutoff
+				then do
+					warningshown <- liftIO $ atomically $
+						swapTVar warningshownv True
+					unless warningshown $ do
+						Annex.changeState $ \s -> s { Annex.reachedlimit = True }
+						warning $ "Time limit (" ++ fromDuration duration ++ ") reached! Shutting down..."
+						cleanup
+				else a
 
 propagateLsFilesError :: IO Bool -> Annex ()
 propagateLsFilesError cleanup =