Improve shutdown due to --time-limit, especially for fsck

* Perform a clean shutdown when --time-limit is reached.
  This includes running queued git commands, and cleanup actions normally
  run when a command is finished.
* fsck: Commit incremental fsck database when --time-limit is reached.
  Previously, some of the last files fscked did not make it into the
  database when using --time-limit.

Note that this changes Annex.addCleanup hooks, to run after --time-limit
expires. Fsck was using such a hook to clean up after a
--incremental-schedule, and that shouldn't run when --time-limit exipires
it. So, instead, moved that cleanup code to be run by cleanupIncremental.
Resulted in some data type juggling.

Annex/Action.hs

@@ -0,0 +1,35 @@
+{- git-annex actions
+ -
+ - Copyright 2010-2015 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE CPP #-}
+
+module Annex.Action where
+
+import qualified Data.Map as M
+#ifndef mingw32_HOST_OS
+import System.Posix.Signals
+#endif
+
+import Common.Annex
+import qualified Annex
+import Annex.Content
+
+{- Actions to perform each time ran. -}
+startup :: Annex ()
+startup =
+#ifndef mingw32_HOST_OS
+	liftIO $ void $ installHandler sigINT Default Nothing
+#else
+	return ()
+#endif
+
+{- Cleanup actions. -}
+shutdown :: Bool -> Annex ()
+shutdown nocommit = do
+	saveState nocommit
+	sequence_ =<< M.elems <$> Annex.getState Annex.cleanup
+	liftIO reapZombies -- zombies from long-running git processes

CmdLine.hs

@@ -5,29 +5,22 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-{-# LANGUAGE CPP #-}
-
 module CmdLine (
 	dispatch,
 	usage,
-	shutdown
 ) where
 
 import qualified Options.Applicative as O
 import qualified Options.Applicative.Help as H
 import qualified Control.Exception as E
-import qualified Data.Map as M
 import Control.Exception (throw)
-#ifndef mingw32_HOST_OS
-import System.Posix.Signals
-#endif
 
 import Common.Annex
 import qualified Annex
 import qualified Git
 import qualified Git.AutoCorrect
 import qualified Git.Config
-import Annex.Content
+import Annex.Action
 import Annex.Environment
 import Command
 import Types.Messages
@@ -117,19 +110,3 @@ findCmd fuzzyok argv cmds
 	inexactcmds = case name of
 		Nothing -> []
 		Just n -> Git.AutoCorrect.fuzzymatches n cmdname cmds
-
-{- Actions to perform each time ran. -}
-startup :: Annex ()
-startup =
-#ifndef mingw32_HOST_OS
-	liftIO $ void $ installHandler sigINT Default Nothing
-#else
-	return ()
-#endif
-
-{- Cleanup actions. -}
-shutdown :: Bool -> Annex ()
-shutdown nocommit = do
-	saveState nocommit
-	sequence_ =<< M.elems <$> Annex.getState Annex.cleanup
-	liftIO reapZombies -- zombies from long-running git processes

Command/Fsck.hs

@@ -457,18 +457,12 @@ runFsck inc file key a = ifM (needFsck inc key)
 
 {- Check if a key needs to be fscked, with support for incremental fscks. -}
 needFsck :: Incremental -> Key -> Annex Bool
+needFsck (ScheduleIncremental _ _ i) k = needFsck i k
 #ifdef WITH_DATABASE
 needFsck (ContIncremental h) key = liftIO $ not <$> FsckDb.inDb h key
 #endif
 needFsck _ _ = return True
 
-#ifdef WITH_DATABASE
-withFsckDb :: Incremental -> (FsckDb.FsckHandle -> Annex ()) -> Annex ()
-withFsckDb (ContIncremental h) a = a h
-withFsckDb (StartIncremental h) a = a h
-withFsckDb NonIncremental _ = noop
-#endif
-
 recordFsckTime :: Incremental -> Key -> Annex ()
 #ifdef WITH_DATABASE
 recordFsckTime inc key = withFsckDb inc $ \h -> liftIO $ FsckDb.addDb h key
@@ -527,7 +521,8 @@ data Incremental
 	= NonIncremental
 #ifdef WITH_DATABASE
 	| StartIncremental FsckDb.FsckHandle 
-	| ContIncremental FsckDb.FsckHandle 
+	| ContIncremental FsckDb.FsckHandle
+	| ScheduleIncremental Duration UUID Incremental
 #endif
 
 prepIncremental :: UUID -> Maybe IncrementalOpt -> Annex Incremental
@@ -536,31 +531,44 @@ prepIncremental _ Nothing = pure NonIncremental
 prepIncremental u (Just StartIncrementalO) = do
 	recordStartTime u
 	ifM (FsckDb.newPass u)
-		( StartIncremental <$> FsckDb.openDb u
+		( StartIncremental <$> openFsckDb u
 		, error "Cannot start a new --incremental fsck pass; another fsck process is already running."
 		)
 prepIncremental u (Just MoreIncrementalO) =
-	ContIncremental <$> FsckDb.openDb u
+	ContIncremental <$> openFsckDb u
 prepIncremental u (Just (ScheduleIncrementalO delta)) = do
-	Annex.addCleanup FsckCleanup $ do
-		v <- getStartTime u
-		case v of
-			Nothing -> noop
-			Just started -> do
-				now <- liftIO getPOSIXTime
-				when (now - realToFrac started >= durationToPOSIXTime delta) $
-					resetStartTime u
 	started <- getStartTime u
-	prepIncremental u $ Just $ case started of
+	i <- prepIncremental u $ Just $ case started of
 		Nothing -> StartIncrementalO
 		Just _ -> MoreIncrementalO
+	return (ScheduleIncremental delta u i)
 #else
 prepIncremental _ _ = error "This git-annex was not built with database support; incremental fsck not supported"
 #endif
 
 cleanupIncremental :: Incremental -> Annex ()
-#ifdef WITH_DATABASE
+cleanupIncremental (ScheduleIncremental delta u i) = do
-cleanupIncremental i = withFsckDb i FsckDb.closeDb
+	v <- getStartTime u
-#else
+	case v of
+		Nothing -> noop
+		Just started -> do
+			now <- liftIO getPOSIXTime
+			when (now - realToFrac started >= durationToPOSIXTime delta) $
+				resetStartTime u
+	cleanupIncremental i
 cleanupIncremental _ = return ()
+
+#ifdef WITH_DATABASE
+openFsckDb :: UUID -> Annex FsckDb.FsckHandle
+openFsckDb u = do
+	h <- FsckDb.openDb u
+	Annex.addCleanup FsckCleanup $
+		FsckDb.closeDb h
+	return h
+
+withFsckDb :: Incremental -> (FsckDb.FsckHandle -> Annex ()) -> Annex ()
+withFsckDb (ContIncremental h) a = a h
+withFsckDb (StartIncremental h) a = a h
+withFsckDb NonIncremental _ = noop
+withFsckDb (ScheduleIncremental _ _ i) a = withFsckDb i a
 #endif

Command/RecvKey.hs

@@ -9,8 +9,8 @@ module Command.RecvKey where
 
 import Common.Annex
 import Command
-import CmdLine
 import Annex.Content
+import Annex.Action
 import Annex
 import Utility.Rsync
 import Logs.Transfer

Limit.hs

@@ -13,6 +13,7 @@ import qualified Utility.Matcher
 import qualified Remote
 import qualified Backend
 import Annex.Content
+import Annex.Action
 import Annex.UUID
 import Logs.Trust
 import Annex.NumCopies
@@ -271,6 +272,7 @@ addTimeLimit s = do
 		if now > cutoff
 			then do
 				warning $ "Time limit (" ++ s ++ ") reached!"
+				shutdown True
 				liftIO $ exitWith $ ExitFailure 101
 			else return True
 

debian/changelog

@@ -1,3 +1,14 @@
+git-annex (5.20150732) UNRELEASED; urgency=medium
+
+  * Perform a clean shutdown when --time-limit is reached.
+    This includes running queued git commands, and cleanup actions normally
+    run when a command is finished.
+  * fsck: Commit incremental fsck database when --time-limit is reached.
+    Previously, some of the last files fscked did not make it into the
+    database when using --time-limit.
+
+ -- Joey Hess <id@joeyh.name>  Fri, 31 Jul 2015 12:31:39 -0400
+
 git-annex (5.20150731) unstable; urgency=medium
 
   * webapp: Support enabling known gitlab.com remotes.

doc/bugs/incremental___40__continued__41___fsck_start_froms_beginning__44___rechecks_files_already_checked_/comment_3_4afd7d73952c7f9172c80f20a5047625._comment

@@ -0,0 +1,9 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 3"""
+ date="2015-07-31T20:01:09Z"
+ content="""
+Yeah, very good point about --time-limit. I've gone ahead and made that
+result in a fsck database save, so it will pick up right where it left off
+when using --time-limit.
+"""]]