Merge branch 'incrementalfsck'

Annex/Content.hs

@@ -30,6 +30,7 @@ module Annex.Content (
 	freezeContent,
 	thawContent,
 	cleanObjectLoc,
+	dirKeys,
 ) where
 
 import System.IO.Unsafe (unsafeInterleaveIO)
@@ -522,3 +523,18 @@ thawContent file = unlessM crippledFileSystem $
 	go GroupShared = groupWriteRead file
 	go AllShared = groupWriteRead file
 	go _ = allowWrite file
+
+{- Finds files directly inside a directory like gitAnnexBadDir 
+ - (not in subdirectories) and returns the corresponding keys. -}
+dirKeys :: (Git.Repo -> FilePath) -> Annex [Key]
+dirKeys dirspec = do
+	dir <- fromRepo dirspec
+	ifM (liftIO $ doesDirectoryExist dir)
+		( do
+			contents <- liftIO $ getDirectoryContents dir
+			files <- liftIO $ filterM doesFileExist $
+				map (dir </>) contents
+			return $ mapMaybe (fileKey . takeFileName) files
+		, return []
+		)
+

Assistant.hs

@@ -22,6 +22,7 @@ import Assistant.Threads.Merger
 import Assistant.Threads.TransferWatcher
 import Assistant.Threads.Transferrer
 import Assistant.Threads.SanityChecker
+import Assistant.Threads.Cronner
 #ifdef WITH_CLIBS
 import Assistant.Threads.MountWatcher
 #endif
@@ -133,6 +134,7 @@ startDaemon assistant foreground listenhost startbrowser = do
 			, assist $ netWatcherThread
 			, assist $ netWatcherFallbackThread
 			, assist $ transferScannerThread urlrenderer
+			, assist $ cronnerThread urlrenderer
 			, assist $ configMonitorThread
 			, assist $ glacierThread
 			, watch $ watchThread

Assistant/Alert.hs

@@ -15,6 +15,7 @@ import Assistant.Alert.Utility
 import qualified Remote
 import Utility.Tense
 import Logs.Transfer
+import Git.Remote (RemoteName)
 
 import Data.String
 import qualified Data.Text as T
@@ -27,17 +28,19 @@ import Assistant.WebApp
 import Yesod
 #endif
 
-{- Makes a button for an alert that opens a Route. The button will
+{- Makes a button for an alert that opens a Route. 
- - close the alert it's attached to when clicked. -}
+ -
+ - If autoclose is set, the button will close the alert it's
+ - attached to when clicked. -}
 #ifdef WITH_WEBAPP
-mkAlertButton :: T.Text -> UrlRenderer -> Route WebApp -> Assistant AlertButton
+mkAlertButton :: Bool -> T.Text -> UrlRenderer -> Route WebApp -> Assistant AlertButton
-mkAlertButton label urlrenderer route = do
+mkAlertButton autoclose label urlrenderer route = do
 	close <- asIO1 removeAlert
 	url <- liftIO $ renderUrl urlrenderer route []
 	return $ AlertButton
 		{ buttonLabel = label
 		, buttonUrl = url
-		, buttonAction = Just close
+		, buttonAction = if autoclose then Just close else Nothing
 		}
 #endif
 
@@ -147,6 +150,14 @@ sanityCheckFixAlert msg = Alert
 	alerthead = "The daily sanity check found and fixed a problem:"
 	alertfoot = "If these problems persist, consider filing a bug report."
 
+fsckAlert :: AlertButton -> Maybe RemoteName -> Alert
+fsckAlert button n = baseActivityAlert
+	{ alertData = case n of
+		Nothing -> [ UnTensed $ T.pack $ "Consistency check in progress" ]
+		Just remotename -> [ UnTensed $ T.pack $ "Consistency check of " ++ remotename ++ " in progress"]
+	, alertButton = Just button
+	}
+
 pairingAlert :: AlertButton -> Alert
 pairingAlert button = baseActivityAlert
 	{ alertData = [ UnTensed "Pairing in progress" ]

Assistant/DaemonStatus.hs

@@ -76,6 +76,10 @@ updateSyncRemotes = do
 			M.filter $ \alert ->
 				alertName alert /= Just CloudRepoNeededAlert
 
+updateScheduleLog :: Assistant ()
+updateScheduleLog =
+	liftIO . sendNotification =<< scheduleLogNotifier <$> getDaemonStatus
+
 {- Load any previous daemon status file, and store it in a MVar for this
  - process to use as its DaemonStatus. Also gets current transfer status. -}
 startDaemonStatus :: Annex DaemonStatusHandle

Assistant/DeleteRemote.hs

@@ -81,7 +81,7 @@ finishRemovingRemote :: UrlRenderer -> UUID -> Assistant ()
 #ifdef WITH_WEBAPP
 finishRemovingRemote urlrenderer uuid = do
 	desc <- liftAnnex $ Remote.prettyUUID uuid
-	button <- mkAlertButton (T.pack "Finish deletion process") urlrenderer $
+	button <- mkAlertButton True (T.pack "Finish deletion process") urlrenderer $
 		FinishDeleteRepositoryR uuid
 	void $ addAlert $ remoteRemovalAlert desc button
 #else

Assistant/NamedThread.hs

@@ -76,7 +76,7 @@ startNamedThread urlrenderer (NamedThread afterstartupsanitycheck name a) = do
 					]
 				hPutStrLn stderr msg
 #ifdef WITH_WEBAPP
-				button <- runAssistant d $ mkAlertButton
+				button <- runAssistant d $ mkAlertButton True
 					(T.pack "Restart Thread")
 					urlrenderer 
 					(RestartThreadR name)

Assistant/Sync.hs

@@ -44,13 +44,19 @@ import Control.Concurrent
  - they push to us. Since XMPP pushes run ansynchronously, any scan of the
  - XMPP remotes has to be deferred until they're done pushing to us, so
  - all XMPP remotes are marked as possibly desynced.
+ -
+ - Also handles signaling any connectRemoteNotifiers, after the syncing is
+ - done.
  -}
 reconnectRemotes :: Bool -> [Remote] -> Assistant ()
 reconnectRemotes _ [] = noop
 reconnectRemotes notifypushes rs = void $ do
-	modifyDaemonStatus_ $ \s -> s
+	rs' <- filterM (checkavailable . Remote.repo) rs
-		{ desynced = S.union (S.fromList $ map Remote.uuid xmppremotes) (desynced s) }
+	unless (null rs') $ do
-	syncAction rs (const go)
+		modifyDaemonStatus_ $ \s -> s
+			{ desynced = S.union (S.fromList $ map Remote.uuid xmppremotes) (desynced s) }
+		failedrs <- syncAction rs' (const go)
+		mapM_ signal $ filter (`notElem` failedrs) rs'
   where
 	gitremotes = filter (notspecialremote . Remote.repo) rs
 	(xmppremotes, nonxmppremotes) = partition isXMPPRemote rs
@@ -73,6 +79,13 @@ reconnectRemotes notifypushes rs = void $ do
 			filter (not . remoteAnnexIgnore . Remote.gitconfig)
 				nonxmppremotes
 		return failed
+	signal r = liftIO . mapM_ (flip tryPutMVar ())
+		=<< fromMaybe [] . M.lookup (Remote.uuid r) . connectRemoteNotifiers
+			<$> getDaemonStatus
+	checkavailable r
+		| Git.repoIsLocal r || Git.repoIsLocalUnknown r =
+			liftIO $ doesDirectoryExist $ Git.repoPath r
+		| otherwise = return True
 
 {- Updates the local sync branch, then pushes it to all remotes, in
  - parallel, along with the git-annex branch. This is the same

Assistant/Threads/ConfigMonitor.hs

@@ -12,9 +12,9 @@ import Assistant.BranchChange
 import Assistant.DaemonStatus
 import Assistant.Commits
 import Utility.ThreadScheduler
+import Logs
 import Logs.UUID
 import Logs.Trust
-import Logs.Remote
 import Logs.PreferredContent
 import Logs.Group
 import Remote.List (remoteListRefresh)
@@ -52,12 +52,13 @@ configMonitorThread = namedThread "ConfigMonitor" $ loop =<< getConfigs
 type Configs = S.Set (FilePath, String)
 
 {- All git-annex's config files, and actions to run when they change. -}
-configFilesActions :: [(FilePath, Annex ())]
+configFilesActions :: [(FilePath, Assistant ())]
 configFilesActions =
-	[ (uuidLog, void uuidMapLoad)
+	[ (uuidLog, void $ liftAnnex uuidMapLoad)
-	, (remoteLog, void remoteListRefresh)
+	, (remoteLog, void $ liftAnnex remoteListRefresh)
-	, (trustLog, void trustMapLoad)
+	, (trustLog, void $ liftAnnex trustMapLoad)
-	, (groupLog, void groupMapLoad)
+	, (groupLog, void $ liftAnnex groupMapLoad)
+	, (scheduleLog, void updateScheduleLog)
 	-- Preferred content settings depend on most of the other configs,
 	-- so will be reloaded whenever any configs change.
 	, (preferredContentLog, noop)
@@ -65,9 +66,8 @@ configFilesActions =
 
 reloadConfigs :: Configs -> Assistant ()
 reloadConfigs changedconfigs = do
-	liftAnnex $ do
+	sequence_ as
-		sequence_ as
+	void $ liftAnnex preferredContentMapLoad
-		void preferredContentMapLoad
 	{- Changes to the remote log, or the trust log, can affect the
 	 - syncRemotes list. Changes to the uuid log may affect its
 	 - display so are also included. -}

Assistant/Threads/Cronner.hs

@@ -0,0 +1,225 @@
+{- git-annex assistant sceduled jobs runner
+ -
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE DeriveDataTypeable, CPP #-}
+
+module Assistant.Threads.Cronner (
+	cronnerThread
+) where
+
+import Assistant.Common
+import Assistant.DaemonStatus
+import Utility.NotificationBroadcaster
+import Annex.UUID
+import Config.Files
+import Logs.Schedule
+import Utility.Scheduled
+import Types.ScheduledActivity
+import Utility.ThreadScheduler
+import Utility.HumanTime
+import Utility.Batch
+import Assistant.TransferQueue
+import Annex.Content
+import Logs.Transfer
+import Assistant.Types.UrlRenderer
+import Assistant.Alert
+import Remote
+#ifdef WITH_WEBAPP
+import Assistant.WebApp.Types
+#endif
+import Git.Remote (RemoteName)
+
+import Control.Concurrent.Async
+import Control.Concurrent.MVar
+import Data.Time.LocalTime
+import Data.Time.Clock
+import qualified Data.Map as M
+import qualified Data.Set as S
+import qualified Control.Exception as E
+import qualified Data.Text as T
+
+{- Loads schedules for this repository, and fires off one thread for each 
+ - scheduled event that runs on this repository. Each thread sleeps until
+ - its event is scheduled to run.
+ -
+ - To handle events that run on remotes, which need to only run when
+ - their remote gets connected, threads are also started, and are passed
+ - a MVar to wait on, which is stored in the DaemonStatus's
+ - connectRemoteNotifiers.
+ -
+ - In the meantime the main thread waits for any changes to the
+ - schedules. When there's a change, compare the old and new list of
+ - schedules to find deleted and added ones. Start new threads for added
+ - ones, and kill the threads for deleted ones. -}
+cronnerThread :: UrlRenderer -> NamedThread
+cronnerThread urlrenderer = namedThreadUnchecked "Cronner" $ do
+	dstatus <- getDaemonStatus
+	h <- liftIO $ newNotificationHandle False (scheduleLogNotifier dstatus)
+	go h M.empty M.empty
+  where
+	go h amap nmap = do
+		activities <- liftAnnex $ scheduleGet =<< getUUID
+
+		let addedactivities = activities `S.difference` M.keysSet amap
+		let removedactivities = M.keysSet amap `S.difference` activities
+
+		forM_ (S.toList removedactivities) $ \activity ->
+			case M.lookup activity amap of
+				Just a -> do
+					debug ["stopping removed job for", fromScheduledActivity activity, show (asyncThreadId a)]
+					liftIO $ cancel a
+				Nothing -> noop
+
+		lastruntimes <- liftAnnex getLastRunTimes
+		started <- startactivities (S.toList addedactivities) lastruntimes
+		let addedamap = M.fromList $ map fst started
+		let addednmap = M.fromList $ catMaybes $ map snd started
+
+		let removefiltered = M.filterWithKey (\k _ -> S.member k removedactivities)
+		let amap' = M.difference (M.union addedamap amap) (removefiltered amap)
+		let nmap' = M.difference (M.union addednmap nmap) (removefiltered nmap)
+		modifyDaemonStatus_ $ \s -> s { connectRemoteNotifiers = M.fromListWith (++) (M.elems nmap') }
+
+		liftIO $ waitNotification h
+		debug ["reloading changed activities"]
+		go h amap' nmap'
+  	startactivities as lastruntimes = forM as $ \activity ->
+		case connectActivityUUID activity of
+			Nothing -> do
+				runner <- asIO2 (sleepingActivityThread urlrenderer)
+				a <- liftIO $ async $
+					runner activity (M.lookup activity lastruntimes)
+				return ((activity, a), Nothing)
+			Just u -> do
+				mvar <- liftIO newEmptyMVar
+				runner <- asIO2 (remoteActivityThread urlrenderer mvar)
+				a <- liftIO $ async $
+					runner activity (M.lookup activity lastruntimes)
+				return ((activity, a), Just (activity, (u, [mvar])))
+
+{- Calculate the next time the activity is scheduled to run, then
+ - sleep until that time, and run it. Then call setLastRunTime, and
+ - loop.
+ -}
+sleepingActivityThread :: UrlRenderer -> ScheduledActivity -> Maybe LocalTime -> Assistant ()
+sleepingActivityThread urlrenderer activity lasttime = go lasttime =<< getnexttime lasttime
+  where
+  	getnexttime = liftIO . nextTime schedule
+  	go _ Nothing = debug ["no scheduled events left for", desc]
+	go l (Just (NextTimeExactly t)) = waitrun l t Nothing
+	go l (Just (NextTimeWindow windowstart windowend)) =
+		waitrun l windowstart (Just windowend)
+	desc = fromScheduledActivity activity
+	schedule = getSchedule activity
+	waitrun l t mmaxt = do
+		seconds <- liftIO $ secondsUntilLocalTime t
+		when (seconds > Seconds 0) $ do
+			debug ["waiting", show seconds, "for next scheduled", desc]
+			liftIO $ threadDelaySeconds seconds
+		now <- liftIO getCurrentTime
+		tz <- liftIO $ getTimeZone now
+		let nowt = utcToLocalTime tz now
+		if tolate nowt tz
+			then do
+				debug ["too late to run scheduled", desc]
+				go l =<< getnexttime l
+			else run nowt
+	  where
+	  	tolate nowt tz = case mmaxt of
+			Just maxt -> nowt > maxt
+			-- allow the job to start 10 minutes late
+			Nothing ->diffUTCTime 
+				(localTimeToUTC tz nowt)
+				(localTimeToUTC tz t) > 600
+	run nowt = do
+		runActivity urlrenderer activity nowt
+		go (Just nowt) =<< getnexttime (Just nowt)
+
+{- Wait for the remote to become available by waiting on the MVar.
+ - Then check if the time is within a time window when activity
+ - is scheduled to run, and if so run it.
+ - Otherwise, just wait again on the MVar.
+ -}
+remoteActivityThread :: UrlRenderer -> MVar () -> ScheduledActivity -> Maybe LocalTime -> Assistant ()
+remoteActivityThread urlrenderer mvar activity lasttime = do
+	liftIO $ takeMVar mvar
+	go =<< liftIO (nextTime (getSchedule activity) lasttime)
+  where
+	go (Just (NextTimeWindow windowstart windowend)) = do
+		now <- liftIO getCurrentTime
+		tz <- liftIO $ getTimeZone now
+		if now >= localTimeToUTC tz windowstart && now <= localTimeToUTC tz windowend
+			then do
+				let nowt = utcToLocalTime tz now
+				runActivity urlrenderer activity nowt
+				loop (Just nowt)
+			else loop lasttime
+	go _ = noop -- running at exact time not handled here
+	loop = remoteActivityThread urlrenderer mvar activity
+
+secondsUntilLocalTime :: LocalTime -> IO Seconds
+secondsUntilLocalTime t = do
+	now <- getCurrentTime
+	tz <- getTimeZone now
+	let secs = truncate $ diffUTCTime (localTimeToUTC tz t) now
+	return $ if secs > 0
+		then Seconds secs
+		else Seconds 0
+
+runActivity :: UrlRenderer -> ScheduledActivity -> LocalTime -> Assistant ()
+runActivity urlrenderer activity nowt = do
+	debug ["starting", desc]
+	runActivity' urlrenderer activity
+	debug ["finished", desc]
+	liftAnnex $ setLastRunTime activity nowt
+  where
+	desc = fromScheduledActivity activity
+
+runActivity' :: UrlRenderer -> ScheduledActivity -> Assistant ()
+runActivity' urlrenderer (ScheduledSelfFsck _ d) = do
+	program <- liftIO $ readProgramFile
+	void $ runFsck urlrenderer Nothing $
+  		batchCommand program (Param "fsck" : fsckParams d)
+	mapM_ reget =<< liftAnnex (dirKeys gitAnnexBadDir)
+  where
+	reget k = queueTransfers "fsck found bad file; redownloading" Next k Nothing Download
+runActivity' urlrenderer (ScheduledRemoteFsck u s d) = go =<< liftAnnex (remoteFromUUID u)
+  where
+	go (Just r) = void $ case Remote.remoteFsck r of
+		Nothing -> void $ runFsck urlrenderer (Just $ Remote.name r) $ do
+			program <- readProgramFile
+			batchCommand program $ 
+				[ Param "fsck"
+				-- avoid downloading files
+				, Param "--fast"
+				, Param "--from"
+				, Param $ Remote.name r
+				] ++ fsckParams d
+		Just mkfscker ->
+			{- Note that having mkfsker return an IO action
+			 - avoids running a long duration fsck in the
+			 - Annex monad. -}
+			void . runFsck urlrenderer (Just $ Remote.name r)
+				=<< liftAnnex (mkfscker (fsckParams d))
+	go Nothing = debug ["skipping remote fsck of uuid without a configured remote", fromUUID u, fromSchedule s]
+
+runFsck :: UrlRenderer -> Maybe RemoteName -> IO Bool -> Assistant Bool
+runFsck urlrenderer remotename a = do
+#ifdef WITH_WEBAPP
+	button <- mkAlertButton False (T.pack "Configure") urlrenderer ConfigFsckR
+	r <- alertDuring (fsckAlert button remotename) $ liftIO $ do
+		E.try a :: IO (Either E.SomeException Bool)
+	either (liftIO . E.throwIO) return r
+#else
+	a
+#endif
+
+fsckParams :: Duration -> [CommandParam]
+fsckParams d =
+	[ Param "--incremental-schedule=1d"
+	, Param $ "--time-limit=" ++ fromDuration d
+	]

Assistant/Threads/PairListener.hs

@@ -102,7 +102,7 @@ pairListenerThread urlrenderer = namedThread "PairListener" $ do
 pairReqReceived :: Bool -> UrlRenderer -> PairMsg -> Assistant ()
 pairReqReceived True _ _ = noop -- ignore our own PairReq
 pairReqReceived False urlrenderer msg = do
-	button <- mkAlertButton (T.pack "Respond") urlrenderer (FinishLocalPairR msg)
+	button <- mkAlertButton True (T.pack "Respond") urlrenderer (FinishLocalPairR msg)
 	void $ addAlert $ pairRequestReceivedAlert repo button
   where
 	repo = pairRepo msg

Assistant/Threads/WebApp.hs

@@ -29,6 +29,7 @@ import Assistant.WebApp.Configurators.XMPP
 import Assistant.WebApp.Configurators.Preferences
 import Assistant.WebApp.Configurators.Edit
 import Assistant.WebApp.Configurators.Delete
+import Assistant.WebApp.Configurators.Fsck
 import Assistant.WebApp.Documentation
 import Assistant.WebApp.Control
 import Assistant.WebApp.OtherRepos

Assistant/Threads/XMPPClient.hs

@@ -336,7 +336,7 @@ pairMsgReceived urlrenderer PairReq theiruuid selfjid theirjid
 		finishXMPPPairing theirjid theiruuid
 	-- Show an alert to let the user decide if they want to pair.
 	showalert = do
-		button <- mkAlertButton (T.pack "Respond") urlrenderer $
+		button <- mkAlertButton True (T.pack "Respond") urlrenderer $
 			ConfirmXMPPPairFriendR $
 				PairKey theiruuid $ formatJID theirjid
 		void $ addAlert $ pairRequestReceivedAlert

Assistant/Types/DaemonStatus.hs

@@ -18,6 +18,7 @@ import Assistant.Types.NetMessager
 import Assistant.Types.Alert
 
 import Control.Concurrent.STM
+import Control.Concurrent.MVar
 import Control.Concurrent.Async
 import Data.Time.Clock.POSIX
 import qualified Data.Map as M
@@ -62,10 +63,15 @@ data DaemonStatus = DaemonStatus
 	, alertNotifier :: NotificationBroadcaster
 	-- Broadcasts notifications when the syncRemotes change
 	, syncRemotesNotifier :: NotificationBroadcaster
+	-- Broadcasts notifications when the scheduleLog changes
+	, scheduleLogNotifier :: NotificationBroadcaster
+	-- Broadcasts a notification once the startup sanity check has run.
 	, startupSanityCheckNotifier :: NotificationBroadcaster
 	-- When the XMPP client is connected, this will contain the XMPP
 	-- address.
 	, xmppClientID :: Maybe ClientID
+	-- MVars to signal when a remote gets connected.
+	, connectRemoteNotifiers :: M.Map UUID [MVar ()]
 	}
 
 type TransferMap = M.Map Transfer TransferInfo
@@ -95,4 +101,6 @@ newDaemonStatus = DaemonStatus
 	<*> newNotificationBroadcaster
 	<*> newNotificationBroadcaster
 	<*> newNotificationBroadcaster
+	<*> newNotificationBroadcaster
 	<*> pure Nothing
+	<*> pure M.empty

Assistant/WebApp/Configurators/Fsck.hs

@@ -0,0 +1,150 @@
+{- git-annex assistant fsck configuration
+ -
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+{-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell, OverloadedStrings, FlexibleContexts #-}
+{-# LANGUAGE CPP #-}
+
+module Assistant.WebApp.Configurators.Fsck where
+
+import qualified Data.Map as M
+import qualified Data.Set as S
+import qualified Data.Text as T
+
+import Assistant.WebApp.Common
+import Types.ScheduledActivity
+import Utility.HumanTime
+import Utility.Scheduled
+import Logs.Schedule
+import Annex.UUID
+import qualified Remote
+import Assistant.DaemonStatus
+import qualified Annex.Branch
+
+{- This adds a form to the page. It does not handle posting of the form,
+ - because unlike a typical yesod form that posts using the same url
+ - that generated it, this form posts using one of two other routes. -}
+showFsckForm :: Bool -> ScheduledActivity -> Widget
+showFsckForm new activity = do
+	u <- liftAnnex getUUID
+	let action = if new
+		then AddActivityR u
+		else ChangeActivityR u activity
+	((res, form), enctype) <- liftH $ runFsckForm new activity
+	case res of
+		FormSuccess _ -> noop
+		_ -> $(widgetFile "configurators/fsck/form")
+
+{- This does not display a form, but it does get it from a post, and run
+ - some Annex action on it. -}
+withFsckForm :: (ScheduledActivity -> Annex ()) -> Handler ()
+withFsckForm a = do
+	((res, _form), _enctype) <- runFsckForm False defaultFsck
+	case res of
+		FormSuccess activity -> liftAnnex $ a activity
+		_ -> noop
+
+mkFsck :: UUID -> UUID -> Schedule -> Duration -> ScheduledActivity
+mkFsck hereu u s d
+	| u == hereu = ScheduledSelfFsck s d 
+	| otherwise = ScheduledRemoteFsck u s d
+
+runFsckForm :: Bool -> ScheduledActivity -> Handler ((FormResult ScheduledActivity, Widget), Enctype)
+runFsckForm new activity = case activity of
+	ScheduledSelfFsck s d -> go s d =<< liftAnnex getUUID
+	ScheduledRemoteFsck ru s d -> go s d ru
+  where
+  	go (Schedule r t) d ru = do
+		u <- liftAnnex getUUID
+		repolist <- liftAssistant (getrepolist ru)
+		runFormPostNoToken $ \msg -> do
+			(reposRes, reposView) <- mreq (selectFieldList repolist) "" (Just ru)
+			(durationRes, durationView) <- mreq intField "" (Just $ durationSeconds d `quot` 60 )
+			(timeRes, timeView) <- mreq (selectFieldList times) "" (Just t)
+			(recurranceRes, recurranceView) <- mreq (selectFieldList recurrances) "" (Just r)
+			let form = do
+				webAppFormAuthToken
+				$(widgetFile "configurators/fsck/formcontent")
+			let formresult = mkFsck
+				<$> pure u
+				<*> reposRes
+				<*> (Schedule <$> recurranceRes <*> timeRes)
+				<*> (Duration <$> ((60 *) <$> durationRes))
+			return (formresult, form)
+	  where
+		times :: [(Text, ScheduledTime)]
+		times = ensurevalue t (T.pack $ fromScheduledTime t) $
+			map (\x -> (T.pack $ fromScheduledTime x, x)) $
+				AnyTime : map (\h -> SpecificTime h 0) [0..23]
+		recurrances :: [(Text, Recurrance)]
+		recurrances = ensurevalue r (T.pack $ fromRecurrance r) $
+			[ ("every day", Daily)
+			, ("every Sunday", Weekly 1)
+			, ("every Monday", Weekly 2)
+			, ("every Tuesday", Weekly 3)
+			, ("every Wednesday", Weekly 4)
+			, ("every Thursday", Weekly 5)
+			, ("every Friday", Weekly 6)
+			, ("every Saturday", Weekly 7)
+			, ("monthly", Monthly 1)
+			, ("twice a month", Divisible 2 (Weekly 1))
+			, ("yearly", Yearly 1)
+			, ("twice a year", Divisible 6 (Monthly 1))
+			, ("quarterly", Divisible 4 (Monthly 1))
+			]
+	ensurevalue v desc l = case M.lookup v (M.fromList $ map (\(x,y) -> (y,x)) l) of
+		Just _ -> l
+		Nothing -> (desc, v) : l
+	getrepolist :: UUID -> Assistant [(Text, UUID)]
+	getrepolist ensureu = do
+		-- It is possible to have fsck jobs for remotes that
+		-- do not implement remoteFsck, but it's not too useful,
+		-- so omit them from the UI normally.
+		remotes <- filter (\r -> Remote.uuid r == ensureu || isJust (Remote.remoteFsck r)) . syncRemotes
+			<$> getDaemonStatus
+		u <- liftAnnex getUUID
+		let us = u : (map Remote.uuid remotes)
+		liftAnnex $ 
+			zip <$> (map T.pack <$> Remote.prettyListUUIDs us) <*> pure us
+
+defaultFsck :: ScheduledActivity
+defaultFsck = ScheduledSelfFsck (Schedule Daily AnyTime) (Duration $ 60*60)
+
+showFsckStatus :: ScheduledActivity -> Widget
+showFsckStatus activity = do
+	m <- liftAnnex getLastRunTimes
+	let lastrun = M.lookup activity m
+	$(widgetFile "configurators/fsck/status")
+
+getConfigFsckR :: Handler Html
+getConfigFsckR = postConfigFsckR
+postConfigFsckR :: Handler Html
+postConfigFsckR = page "Consistency checks" (Just Configuration) $ do
+	checks <- liftAnnex $ S.toList <$> (scheduleGet =<< getUUID)
+	$(widgetFile "configurators/fsck")
+
+changeSchedule :: Handler () -> Handler Html
+changeSchedule a = do
+	a
+	liftAnnex $ Annex.Branch.commit "update"
+	redirect ConfigFsckR
+
+getRemoveActivityR :: UUID -> ScheduledActivity -> Handler Html
+getRemoveActivityR u activity = changeSchedule $
+	liftAnnex $ scheduleRemove u activity
+
+getAddActivityR :: UUID -> Handler Html
+getAddActivityR = postAddActivityR
+postAddActivityR :: UUID -> Handler Html
+postAddActivityR u = changeSchedule $
+	withFsckForm $ scheduleAdd u
+
+getChangeActivityR :: UUID -> ScheduledActivity -> Handler Html
+getChangeActivityR = postChangeActivityR
+postChangeActivityR :: UUID -> ScheduledActivity -> Handler Html
+postChangeActivityR u oldactivity = changeSchedule $
+	withFsckForm $ \newactivity -> scheduleChange u $
+			S.insert newactivity . S.delete oldactivity

Assistant/WebApp/Configurators/XMPP.hs

@@ -55,7 +55,7 @@ checkCloudRepos :: UrlRenderer -> Remote -> Assistant ()
 checkCloudRepos urlrenderer r =
 	unlessM (syncingToCloudRemote <$> getDaemonStatus) $ do
 		buddyname <- getBuddyName $ Remote.uuid r
-		button <- mkAlertButton "Add a cloud repository" urlrenderer $
+		button <- mkAlertButton True "Add a cloud repository" urlrenderer $
 			NeedCloudRepoR $ Remote.uuid r
 		void $ addAlert $ cloudRepoNeededAlert buddyname button
 #else

Assistant/WebApp/Types.hs

@@ -23,6 +23,7 @@ import Utility.Yesod
 import Logs.Transfer
 import Utility.Gpg (KeyId)
 import Build.SysConfig (packageversion)
+import Types.ScheduledActivity
 
 import Yesod.Static
 import Text.Hamlet
@@ -211,3 +212,8 @@ instance PathPiece RepoSelector where
 instance PathPiece ThreadName where
 	toPathPiece = pack . show
 	fromPathPiece = readish . unpack
+
+instance PathPiece ScheduledActivity where
+	toPathPiece = pack . show
+	fromPathPiece = readish . unpack
+

Assistant/WebApp/routes

@@ -19,6 +19,7 @@
 /config/xmpp/for/self XMPPConfigForPairSelfR GET POST
 /config/xmpp/for/frield XMPPConfigForPairFriendR GET POST
 /config/xmpp/needcloudrepo/#UUID NeedCloudRepoR GET
+/config/fsck ConfigFsckR GET POST
 
 /config/addrepository AddRepositoryR GET
 /config/repository/new NewRepositoryR GET POST
@@ -83,6 +84,10 @@
 /config/repository/delete/finish/#UUID FinishDeleteRepositoryR GET
 /config/repository/delete/here DeleteCurrentRepositoryR GET POST
 
+/config/activity/add/#UUID AddActivityR GET POST
+/config/activity/change/#UUID/#ScheduledActivity ChangeActivityR GET POST
+/config/activity/remove/#UUID/#ScheduledActivity RemoveActivityR GET
+
 /transfers/#NotificationId TransfersR GET
 /notifier/transfers NotifierTransfersR GET
 

Build/Configure.hs

@@ -33,6 +33,7 @@ tests =
 	, TestCase "wget" $ testCmd "wget" "wget --version >/dev/null"
 	, TestCase "bup" $ testCmd "bup" "bup --version >/dev/null"
 	, TestCase "quvi" $ testCmd "quvi" "quvi --version >/dev/null"
+	, TestCase "nice" $ testCmd "nice" "nice true >/dev/null"
 	, TestCase "ionice" $ testCmd "ionice" "ionice -c3 true >/dev/null"
 	, TestCase "gpg" $ maybeSelectCmd "gpg"
 		[ ("gpg", "--version >/dev/null")

Command/Fsck.hs

@@ -104,7 +104,7 @@ withIncremental = withValue $ do
 				Nothing -> noop
 				Just started -> do
 					now <- liftIO getPOSIXTime
-					when (now - realToFrac started >= delta)
+					when (now - realToFrac started >= durationToPOSIXTime delta)
 						resetStartTime
 		return True
 

Command/Schedule.hs

@@ -0,0 +1,50 @@
+{- git-annex command
+ -
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.Schedule where
+
+import Common.Annex
+import Command
+import qualified Remote
+import Logs.Schedule
+import Types.ScheduledActivity
+
+import qualified Data.Set as S
+
+def :: [Command]
+def = [command "schedule" (paramPair paramRemote (paramOptional paramExpression)) seek
+	SectionSetup "get or set scheduled jobs"]
+
+seek :: [CommandSeek]
+seek = [withWords start]
+
+start :: [String] -> CommandStart
+start = parse
+  where
+  	parse (name:[]) = go name performGet
+	parse (name:expr:[]) = go name $ \uuid -> do
+		showStart "schedile" name
+		performSet expr uuid
+	parse _ = error "Specify a repository."
+
+	go name a = do
+		u <- Remote.nameToUUID name
+		next $ a u
+
+performGet :: UUID -> CommandPerform
+performGet uuid = do
+	s <- scheduleGet uuid
+	liftIO $ putStrLn $ intercalate "; " $ 
+		map fromScheduledActivity $ S.toList s
+	next $ return True
+
+performSet :: String -> UUID -> CommandPerform
+performSet expr uuid = case parseScheduledActivities expr of
+	Left e -> error $ "Parse error: " ++ e
+	Right l -> do
+		scheduleSet uuid l
+		next $ return True

Command/Status.hs

@@ -363,7 +363,7 @@ showSizeKeys d = total ++ missingnote
 			" keys of unknown size"
 
 staleSize :: String -> (Git.Repo -> FilePath) -> Stat
-staleSize label dirspec = go =<< lift (Command.Unused.staleKeys dirspec)
+staleSize label dirspec = go =<< lift (dirKeys dirspec)
   where
 	go [] = nostat
 	go keys = onsize =<< sum <$> keysizes keys

Command/Unused.hs

@@ -304,7 +304,7 @@ withKeysReferencedInGitRef a ref = do
  -}
 staleKeysPrune :: (Git.Repo -> FilePath) -> Bool -> Annex [Key]
 staleKeysPrune dirspec nottransferred = do
-	contents <- staleKeys dirspec
+	contents <- dirKeys dirspec
 	
 	dups <- filterM inAnnex contents
 	let stale = contents `exclude` dups
@@ -319,18 +319,6 @@ staleKeysPrune dirspec nottransferred = do
 			return $ filter (`S.notMember` inprogress) stale
 		else return stale
 
-staleKeys :: (Git.Repo -> FilePath) -> Annex [Key]
-staleKeys dirspec = do
-	dir <- fromRepo dirspec
-	ifM (liftIO $ doesDirectoryExist dir)
-		( do
-			contents <- liftIO $ getDirectoryContents dir
-			files <- liftIO $ filterM doesFileExist $
-				map (dir </>) contents
-			return $ mapMaybe (fileKey . takeFileName) files
-		, return []
-		)
-
 data UnusedMaps = UnusedMaps
 	{ unusedMap :: UnusedMap
 	, unusedBadMap :: UnusedMap

Command/Vicfg.hs

@@ -21,7 +21,9 @@ import Types.Group
 import Logs.Trust
 import Logs.Group
 import Logs.PreferredContent
+import Logs.Schedule
 import Types.StandardGroups
+import Types.ScheduledActivity
 import Remote
 
 def :: [Command]
@@ -59,6 +61,7 @@ data Cfg = Cfg
 	{ cfgTrustMap :: TrustMap
 	, cfgGroupMap :: M.Map UUID (S.Set Group)
 	, cfgPreferredContentMap :: M.Map UUID String
+	, cfgScheduleMap :: M.Map UUID [ScheduledActivity]
 	}
 
 getCfg :: Annex Cfg
@@ -66,22 +69,25 @@ getCfg = Cfg
 	<$> trustMapRaw -- without local trust overrides
 	<*> (groupsByUUID <$> groupMap)
 	<*> preferredContentMapRaw
+	<*> scheduleMap
 
 setCfg :: Cfg -> Cfg -> Annex ()
 setCfg curcfg newcfg = do
-	let (trustchanges, groupchanges, preferredcontentchanges) = diffCfg curcfg newcfg
+	let (trustchanges, groupchanges, preferredcontentchanges, schedulechanges) = diffCfg curcfg newcfg
 	mapM_ (uncurry trustSet) $ M.toList trustchanges
 	mapM_ (uncurry groupSet) $ M.toList groupchanges
 	mapM_ (uncurry preferredContentSet) $ M.toList preferredcontentchanges
+	mapM_ (uncurry scheduleSet) $ M.toList schedulechanges
 
-diffCfg :: Cfg -> Cfg -> (TrustMap, M.Map UUID (S.Set Group), M.Map UUID String)
+diffCfg :: Cfg -> Cfg -> (TrustMap, M.Map UUID (S.Set Group), M.Map UUID String, M.Map UUID [ScheduledActivity])
-diffCfg curcfg newcfg = (diff cfgTrustMap, diff cfgGroupMap, diff cfgPreferredContentMap)
+diffCfg curcfg newcfg = (diff cfgTrustMap, diff cfgGroupMap, diff cfgPreferredContentMap, diff cfgScheduleMap)
   where
 	diff f = M.differenceWith (\x y -> if x == y then Nothing else Just x)
 		(f newcfg) (f curcfg)
 
 genCfg :: Cfg -> M.Map UUID String -> String
-genCfg cfg descs = unlines $ concat [intro, trust, groups, preferredcontent]
+genCfg cfg descs = unlines $ concat
+	[intro, trust, groups, preferredcontent, schedule]
   where
 	intro =
 		[ com "git-annex configuration"
@@ -120,6 +126,14 @@ genCfg cfg descs = unlines $ concat [intro, trust, groups, preferredcontent]
 		(\(s, u) -> line "content" u s)
 		(\u -> line "content" u "")
 
+	schedule = settings cfgScheduleMap
+		[ ""
+		, com "Scheduled activities"
+		, com "(Separate multiple activities with \"; \")"
+		]
+		(\(l, u) -> line "schedule" u $ fromScheduledActivities l)
+		(\u -> line "schedule" u "")
+
 	settings field desc showvals showdefaults = concat
 		[ desc
 		, concatMap showvals $ sort $ map swap $ M.toList $ field cfg
@@ -173,6 +187,11 @@ parseCfg curcfg = go [] curcfg . lines
 				Nothing ->
 					let m = M.insert u value (cfgPreferredContentMap cfg)
 					in Right $ cfg { cfgPreferredContentMap = m }
+		| setting == "schedule" = case parseScheduledActivities value of
+			Left e -> Left e
+			Right l -> 
+				let m = M.insert u l (cfgScheduleMap cfg)
+				in Right $ cfg { cfgScheduleMap = m }
 		| otherwise = badval "setting" setting
 
 	showerr (Just msg, l) = [parseerr ++ msg, l]

GitAnnex.hs

@@ -54,6 +54,7 @@ import qualified Command.Semitrust
 import qualified Command.Dead
 import qualified Command.Group
 import qualified Command.Content
+import qualified Command.Schedule
 import qualified Command.Ungroup
 import qualified Command.Vicfg
 import qualified Command.Sync
@@ -117,6 +118,7 @@ cmds = concat
 	, Command.Dead.def
 	, Command.Group.def
 	, Command.Content.def
+	, Command.Schedule.def
 	, Command.Ungroup.def
 	, Command.Vicfg.def
 	, Command.FromKey.def

Limit.hs

@@ -238,7 +238,8 @@ limitSize vs s = case readSize dataUnits s of
 
 addTimeLimit :: String -> Annex ()
 addTimeLimit s = do
-	let seconds = fromMaybe (error "bad time-limit") $ parseDuration s
+	let seconds = maybe (error "bad time-limit") durationToPOSIXTime $
+		parseDuration s
 	start <- liftIO getPOSIXTime
 	let cutoff = start + seconds
 	addLimit $ Right $ const $ const $ do

Locations.hs

@@ -28,6 +28,7 @@ module Locations (
 	gitAnnexBadLocation,
 	gitAnnexUnusedLog,
 	gitAnnexFsckState,
+	gitAnnexScheduleState,
 	gitAnnexTransferDir,
 	gitAnnexCredsDir,
 	gitAnnexFeedStateDir,
@@ -192,6 +193,11 @@ gitAnnexUnusedLog prefix r = gitAnnexDir r </> (prefix ++ "unused")
 gitAnnexFsckState :: Git.Repo -> FilePath
 gitAnnexFsckState r = gitAnnexDir r </> "fsckstate"
 
+{- .git/annex/schedulestate is used to store information about when
+ - scheduled jobs were last run. -}
+gitAnnexScheduleState :: Git.Repo -> FilePath
+gitAnnexScheduleState r = gitAnnexDir r </> "schedulestate"
+
 {- .git/annex/creds/ is used to store credentials to access some special
  - remotes. -}
 gitAnnexCredsDir :: Git.Repo -> FilePath

Logs.hs

@@ -28,6 +28,7 @@ uuidBasedLogs =
 	, trustLog
 	, groupLog 
 	, preferredContentLog
+	, scheduleLog
 	]
 
 {- All the ways to get a key from a presence log file -}
@@ -52,6 +53,9 @@ groupLog = "group.log"
 preferredContentLog :: FilePath
 preferredContentLog = "preferred-content.log"
 
+scheduleLog :: FilePath
+scheduleLog = "schedule.log"
+
 {- The pathname of the location log file for a given key. -}
 locationLogFile :: Key -> String
 locationLogFile key = hashDirLower key ++ keyFile key ++ ".log"

Logs/Schedule.hs

@@ -0,0 +1,72 @@
+{- git-annex scheduled activities log
+ -
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Logs.Schedule (
+	scheduleLog,
+	scheduleSet,
+	scheduleAdd,
+	scheduleRemove,
+	scheduleChange,
+	scheduleGet,
+	scheduleMap,
+	getLastRunTimes,
+	setLastRunTime,
+) where
+
+import qualified Data.Map as M
+import qualified Data.Set as S
+import Data.Time.Clock.POSIX
+import Data.Time.LocalTime
+
+import Common.Annex
+import Types.ScheduledActivity
+import qualified Annex.Branch
+import Logs
+import Logs.UUIDBased
+import Utility.Tmp
+
+scheduleSet :: UUID -> [ScheduledActivity] -> Annex ()
+scheduleSet uuid@(UUID _) activities = do
+	ts <- liftIO getPOSIXTime
+	Annex.Branch.change scheduleLog $
+		showLog id . changeLog ts uuid val . parseLog Just
+  where
+  	val = fromScheduledActivities activities
+scheduleSet NoUUID _ = error "unknown UUID; cannot modify"
+
+scheduleMap :: Annex (M.Map UUID [ScheduledActivity])
+scheduleMap = simpleMap
+	. parseLogWithUUID parser
+	<$> Annex.Branch.get scheduleLog
+  where
+	parser _uuid = eitherToMaybe . parseScheduledActivities
+
+scheduleGet :: UUID -> Annex (S.Set ScheduledActivity)
+scheduleGet u = do
+	m <- scheduleMap
+	return $ maybe S.empty S.fromList (M.lookup u m)
+
+scheduleRemove :: UUID -> ScheduledActivity -> Annex ()
+scheduleRemove u activity = scheduleChange u $ S.delete activity
+
+scheduleAdd :: UUID -> ScheduledActivity -> Annex ()
+scheduleAdd u activity = scheduleChange u $ S.insert activity
+
+scheduleChange :: UUID -> (S.Set ScheduledActivity -> S.Set ScheduledActivity) -> Annex ()
+scheduleChange u a = scheduleSet u . S.toList . a =<< scheduleGet u
+
+getLastRunTimes :: Annex (M.Map ScheduledActivity LocalTime)
+getLastRunTimes = do
+	f <- fromRepo gitAnnexScheduleState
+	liftIO $ fromMaybe M.empty
+		<$> catchDefaultIO Nothing (readish <$> readFile f)
+
+setLastRunTime :: ScheduledActivity -> LocalTime -> Annex ()
+setLastRunTime activity lastrun = do
+	f <- fromRepo gitAnnexScheduleState
+	liftIO . viaTmp writeFile f . show . M.insert activity lastrun
+		=<< getLastRunTimes

Remote.hs

@@ -16,6 +16,7 @@ module Remote (
 	hasKey,
 	hasKeyCheap,
 	whereisKey,
+	remoteFsck,
 
 	remoteTypes,
 	remoteList,

Remote/Bup.hs

@@ -63,6 +63,7 @@ gen r u c gc = do
 		, hasKey = checkPresent r bupr'
 		, hasKeyCheap = bupLocal buprepo
 		, whereisKey = Nothing
+		, remoteFsck = Nothing
 		, config = c
 		, repo = r
 		, gitconfig = gc

Remote/Directory.hs

@@ -54,6 +54,7 @@ gen r u c gc = do
 			hasKey = checkPresent dir chunksize,
 			hasKeyCheap = True,
 			whereisKey = Nothing,
+			remoteFsck = Nothing,
 			config = M.empty,
 			repo = r,
 			gitconfig = gc,

Remote/GCrypt.hs

@@ -107,6 +107,7 @@ gen' r u c gc = do
 		, hasKey = checkPresent this rsyncopts
 		, hasKeyCheap = repoCheap r
 		, whereisKey = Nothing
+		, remoteFsck = Nothing
 		, config = M.empty
 		, localpath = localpathCalc r
 		, repo = r

Remote/Git.hs

@@ -42,10 +42,13 @@ import Utility.Metered
 #ifndef mingw32_HOST_OS
 import Utility.CopyFile
 #endif
+import Utility.Env
+import Utility.Batch
 import Remote.Helper.Git
 import Remote.Helper.Messages
 import qualified Remote.Helper.Ssh as Ssh
 import qualified Remote.GCrypt
+import Config.Files
 
 import Control.Concurrent
 import Control.Concurrent.MSampleVar
@@ -111,6 +114,9 @@ gen r u c gc
 			, hasKey = inAnnex r
 			, hasKeyCheap = repoCheap r
 			, whereisKey = Nothing
+			, remoteFsck = if Git.repoIsUrl r
+				then Nothing
+				else Just $ fsckOnRemote r
 			, config = M.empty
 			, localpath = localpathCalc r
 			, repo = r
@@ -396,6 +402,23 @@ copyToRemote r key file p
 							(\d -> rsyncOrCopyFile params object d p)
 			)
 
+fsckOnRemote :: Git.Repo -> [CommandParam] -> Annex (IO Bool)
+fsckOnRemote r params
+	| Git.repoIsUrl r = do
+		s <- Ssh.git_annex_shell r "fsck" params []
+		return $ case s of
+			Nothing -> return False
+			Just (c, ps) -> batchCommand c ps
+	| otherwise = return $ do
+		program <- readProgramFile
+		env <- getEnvironment
+		r' <- Git.Config.read r
+		let env' =
+			[ ("GIT_WORK_TREE", Git.repoPath r')
+			, ("GIT_DIR", Git.localGitDir r')
+			] ++ env
+		batchCommandEnv program (Param "fsck" : params) (Just env')
+
 {- Runs an action on a local repository inexpensively, by making an annex
  - monad using that repository. -}
 onLocal :: Git.Repo -> Annex a -> IO a

Remote/Glacier.hs

@@ -59,6 +59,7 @@ gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost
 			hasKey = checkPresent this,
 			hasKeyCheap = False,
 			whereisKey = Nothing,
+			remoteFsck = Nothing,
 			config = c,
 			repo = r,
 			gitconfig = gc,

Remote/Hook.hs

@@ -52,6 +52,7 @@ gen r u c gc = do
 			hasKey = checkPresent r hooktype,
 			hasKeyCheap = False,
 			whereisKey = Nothing,
+			remoteFsck = Nothing,
 			config = M.empty,
 			localpath = Nothing,
 			repo = r,

Remote/Rsync.hs

@@ -79,6 +79,7 @@ gen r u c gc = do
 			, hasKey = checkPresent r o
 			, hasKeyCheap = False
 			, whereisKey = Nothing
+			, remoteFsck = Nothing
 			, config = M.empty
 			, repo = r
 			, gitconfig = gc

Remote/S3.hs

@@ -62,6 +62,7 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
 			hasKey = checkPresent this,
 			hasKeyCheap = False,
 			whereisKey = Nothing,
+			remoteFsck = Nothing,
 			config = c,
 			repo = r,
 			gitconfig = gc,

Remote/Web.hs

@@ -56,6 +56,7 @@ gen r _ _ gc =
 		hasKey = checkKey,
 		hasKeyCheap = False,
 		whereisKey = Just getUrls,
+		remoteFsck = Nothing,
 		config = M.empty,
 		gitconfig = gc,
 		localpath = Nothing,

Remote/WebDAV.hs

@@ -65,6 +65,7 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
 			hasKey = checkPresent this,
 			hasKeyCheap = False,
 			whereisKey = Nothing,
+			remoteFsck = Nothing,
 			config = c,
 			repo = r,
 			gitconfig = gc,

Test.hs

@@ -59,6 +59,8 @@ import qualified Utility.Env
 import qualified Utility.Matcher
 import qualified Utility.Exception
 import qualified Utility.Hash
+import qualified Utility.Scheduled
+import qualified Utility.HumanTime
 #ifndef mingw32_HOST_OS
 import qualified GitAnnex
 import qualified Remote.Helper.Encryptable
@@ -138,6 +140,8 @@ quickcheck =
 	, check "prop_read_show_TrustLevel" Types.TrustLevel.prop_read_show_TrustLevel
 	, check "prop_parse_show_TrustLog" Logs.Trust.prop_parse_show_TrustLog
 	, check "prop_hashes_stable" Utility.Hash.prop_hashes_stable
+	, check "prop_schedule_roundtrips" Utility.Scheduled.prop_schedule_roundtrips
+	, check "prop_duration_roundtrips" Utility.HumanTime.prop_duration_roundtrips
 	]
   where
 	check desc prop = do

Types/Remote.hs

@@ -19,6 +19,7 @@ import Types.GitConfig
 import Config.Cost
 import Utility.Metered
 import Git.Remote
+import Utility.SafeCommand
 
 type RemoteConfigKey = String
 type RemoteConfig = M.Map RemoteConfigKey String
@@ -64,6 +65,10 @@ data RemoteA a = Remote {
 	hasKeyCheap :: Bool,
 	-- Some remotes can provide additional details for whereis.
 	whereisKey :: Maybe (Key -> a [String]),
+	-- Some remotes can run a fsck operation on the remote,
+	-- without transferring all the data to the local repo
+	-- The parameters are passed to the fsck command on the remote.
+	remoteFsck :: Maybe ([CommandParam] -> a (IO Bool)),
 	-- a Remote has a persistent configuration store
 	config :: RemoteConfig,
 	-- git repo for the Remote

Types/ScheduledActivity.hs

@@ -0,0 +1,69 @@
+{- git-annex scheduled activities
+ -
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Types.ScheduledActivity where
+
+import Common
+import Utility.Scheduled
+import Utility.HumanTime
+import Types.UUID
+
+import Data.Either
+
+data ScheduledActivity 
+	= ScheduledSelfFsck Schedule Duration
+	| ScheduledRemoteFsck UUID Schedule Duration
+  deriving (Eq, Read, Show, Ord)
+
+{- Activities that run on a remote, within a time window, so
+ - should be run when the remote gets connected. -}
+connectActivityUUID :: ScheduledActivity -> Maybe UUID
+connectActivityUUID (ScheduledRemoteFsck u (Schedule _ AnyTime) _) = Just u
+connectActivityUUID _ = Nothing
+
+getSchedule :: ScheduledActivity -> Schedule
+getSchedule (ScheduledSelfFsck s _) = s
+getSchedule (ScheduledRemoteFsck _ s _) = s
+
+getDuration :: ScheduledActivity -> Duration
+getDuration (ScheduledSelfFsck _ d) = d
+getDuration (ScheduledRemoteFsck _ _ d) = d
+
+fromScheduledActivity :: ScheduledActivity -> String
+fromScheduledActivity (ScheduledSelfFsck s d) = unwords
+	[ "fsck self", fromDuration d, fromSchedule s ]
+fromScheduledActivity (ScheduledRemoteFsck u s d) = unwords
+	[ "fsck", fromUUID u, fromDuration d, fromSchedule s ]
+
+toScheduledActivity :: String -> Maybe ScheduledActivity
+toScheduledActivity = eitherToMaybe . parseScheduledActivity
+
+parseScheduledActivity :: String -> Either String ScheduledActivity
+parseScheduledActivity s = case words s of
+	("fsck":"self":d:rest) -> qualified $ ScheduledSelfFsck
+		<$> parseSchedule (unwords rest)
+		<*> getduration d
+	("fsck":u:d:rest) -> qualified $ ScheduledRemoteFsck
+		<$> pure (toUUID u)
+		<*> parseSchedule (unwords rest)
+		<*> getduration d
+	_ -> qualified $ Left "unknown activity"
+  where
+	qualified (Left e) = Left $ e ++ " in \"" ++ s ++ "\""
+	qualified v = v
+	getduration d = maybe (Left $ "failed to parse duration \""++d++"\"") Right (parseDuration d)
+
+fromScheduledActivities :: [ScheduledActivity] -> String
+fromScheduledActivities = intercalate "; " . map fromScheduledActivity
+
+parseScheduledActivities :: String -> Either String [ScheduledActivity]
+parseScheduledActivities s
+	| null bad = Right good
+	| otherwise = Left $ intercalate "; " bad
+  where
+	(bad, good) = partitionEithers $
+		map parseScheduledActivity $ split "; " s

Utility/Batch.hs

@@ -9,10 +9,15 @@
 
 module Utility.Batch where
 
+import Common
+import qualified Build.SysConfig
+
 #if defined(linux_HOST_OS) || defined(__ANDROID__)
 import Control.Concurrent.Async
 import System.Posix.Process
 #endif
+import qualified Control.Exception as E
+import System.Process (env)
 
 {- Runs an operation, at batch priority.
  -
@@ -38,3 +43,31 @@ batch a = a
 
 maxNice :: Int
 maxNice = 19
+
+{- Runs a command in a way that's suitable for batch jobs.
+ - The command is run niced. If the calling thread receives an async
+ - exception, it sends the command a SIGTERM, and after the command
+ - finishes shuttting down, it re-raises the async exception. -}
+batchCommand :: String -> [CommandParam] -> IO Bool
+batchCommand command params = batchCommandEnv command params Nothing
+
+batchCommandEnv :: String -> [CommandParam] -> Maybe [(String, String)] -> IO Bool
+batchCommandEnv command params environ = do
+	(_, _, _, pid) <- createProcess $ p { env = environ }
+	r <- E.try (waitForProcess pid) :: IO (Either E.SomeException ExitCode)
+	case r of
+		Right ExitSuccess -> return True
+		Right _ -> return False
+		Left asyncexception -> do
+			terminateProcess pid
+			void $ waitForProcess pid
+			E.throwIO asyncexception
+  where
+  	p = proc "sh"
+		[ "-c"
+		, "exec " ++ nicedcommand
+		]
+  	commandline = unwords $ map shellEscape $ command : toCommand params
+  	nicedcommand
+		| Build.SysConfig.nice = "nice " ++ commandline
+		| otherwise = commandline

Utility/Daemon.hs

@@ -16,6 +16,7 @@ import Utility.LogFile
 
 #ifndef mingw32_HOST_OS
 import System.Posix
+import Control.Concurrent.Async
 #else
 import System.PosixCompat
 #endif
@@ -46,7 +47,9 @@ daemonize logfd pidfile changedirectory a = do
 		nullfd <- openFd "/dev/null" ReadOnly Nothing defaultFileFlags
 		redir nullfd stdInput
 		redirLog logfd
-		a
+		{- forkProcess masks async exceptions; unmask them inside
+		 - the action. -}
+		wait =<< asyncWithUnmask (\unmask -> unmask a)
 		out
 	out = exitImmediately ExitSuccess
 #else

Utility/HumanTime.hs

@@ -1,26 +1,84 @@
 {- Time for humans.
  -
- - Copyright 2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2012-2013 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-module Utility.HumanTime where
+module Utility.HumanTime (
+	Duration(..),
+	durationToPOSIXTime,
+	parseDuration,
+	fromDuration,
+	prop_duration_roundtrips
+) where
 
 import Utility.PartialPrelude
+import Utility.Applicative
+import Utility.QuickCheck
 
 import Data.Time.Clock.POSIX (POSIXTime)
+import Data.Char
+import Control.Applicative
+import qualified Data.Map as M
 
-{- Parses a human-input time duration, of the form "5h" or "1m". -}
+newtype Duration = Duration { durationSeconds :: Integer }
-parseDuration :: String -> Maybe POSIXTime
+  deriving (Eq, Ord, Read, Show)
-parseDuration s = do
+
-	num <- readish s :: Maybe Integer
+durationToPOSIXTime :: Duration -> POSIXTime
-	units <- findUnits =<< lastMaybe s
+durationToPOSIXTime = fromIntegral . durationSeconds
-	return $ fromIntegral num * units
+
+{- Parses a human-input time duration, of the form "5h", "1m", "5h1m", etc -}
+parseDuration :: String -> Maybe Duration
+parseDuration = Duration <$$> go 0
   where
-	findUnits 's' = Just 1
+  	go n [] = return n
-	findUnits 'm' = Just 60
+  	go n s = do
-	findUnits 'h' = Just $ 60 * 60
+		num <- readish s :: Maybe Integer
-	findUnits 'd' = Just $ 60 * 60 * 24
+		let (c:rest) = dropWhile isDigit s
-	findUnits 'y' = Just $ 60 * 60 * 24 * 365
+		u <- M.lookup c unitmap
-	findUnits _ = Nothing
+		go (n + num * u) rest
+
+fromDuration :: Duration -> String
+fromDuration Duration { durationSeconds = d }
+	| d == 0 = "0s"
+	| otherwise = concat $ map showunit $ go [] units d
+  where
+	showunit (u, n)
+		| n > 0 = show n ++ [u]
+		| otherwise = ""
+	go c [] _ = reverse c
+	go c ((u, n):us) v =
+		let (q,r) = v `quotRem` n
+		in go ((u, q):c) us r
+
+units :: [(Char, Integer)]
+units = 
+	[ ('y', ysecs)
+	, ('d', dsecs)
+	, ('h', hsecs)
+	, ('m', msecs)
+	, ('s', 1)
+	]
+
+unitmap :: M.Map Char Integer
+unitmap = M.fromList units
+
+ysecs :: Integer
+ysecs = dsecs * 365
+
+dsecs :: Integer
+dsecs = hsecs * 24
+
+hsecs :: Integer
+hsecs = msecs * 60
+
+msecs :: Integer
+msecs = 60
+
+-- Durations cannot be negative.
+instance Arbitrary Duration where
+	arbitrary = Duration <$> nonNegative arbitrary
+
+prop_duration_roundtrips :: Duration -> Bool
+prop_duration_roundtrips d = parseDuration (fromDuration d) == Just d

Utility/QuickCheck.hs

@@ -43,3 +43,6 @@ instance Arbitrary FileOffset where
 
 nonNegative :: (Num a, Ord a) => Gen a -> Gen a
 nonNegative g = g `suchThat` (>= 0)
+
+positive :: (Num a, Ord a) => Gen a -> Gen a
+positive g = g `suchThat` (> 0)

Utility/Scheduled.hs

@@ -8,40 +8,148 @@
 module Utility.Scheduled (
 	Schedule(..),
 	Recurrance(..),
-	TimeOfDay(..),
+	ScheduledTime(..),
+	NextTime(..),
+	nextTime,
 	fromSchedule,
-	toSchedule
+	fromScheduledTime,
+	toScheduledTime,
+	fromRecurrance,
+	toRecurrance,
+	toSchedule,
+	parseSchedule,
+	prop_schedule_roundtrips
 ) where
 
 import Common
+import Utility.QuickCheck
+
+import Data.Time.Clock
+import Data.Time.LocalTime
+import Data.Time.Calendar
+import Data.Time.Calendar.WeekDate
+import Data.Time.Calendar.OrdinalDate
+import Data.Tuple.Utils
+import Data.Char
 
 {- Some sort of scheduled event. -}
-data Schedule = Schedule Recurrance TimeOfDay Duration
+data Schedule = Schedule Recurrance ScheduledTime
-  deriving (Show)
+  deriving (Eq, Read, Show, Ord)
 
 data Recurrance
 	= Daily
 	| Weekly WeekDay
 	| Monthly MonthDay
 	| Yearly YearDay
-	-- Divisible 3 Daily is every day of the year evenly divisible by 3
+	-- Days, Weeks, or Months of the year evenly divisible by a number.
-	| Divisable Int Recurrance
+	-- (Divisible Year is years evenly divisible by a number.)
-  deriving (Show)
+	| Divisible Int Recurrance
+  deriving (Eq, Read, Show, Ord)
 
 type WeekDay = Int
 type MonthDay = Int
 type YearDay = Int
 
-data TimeOfDay
+data ScheduledTime
 	= AnyTime
-	| Hour Int
+	| SpecificTime Hour Minute
-  deriving (Show)
+  deriving (Eq, Read, Show, Ord)
 
-data Duration = MinutesDuration Int
+type Hour = Int
-  deriving (Show)
+type Minute = Int
+
+{- Next time a Schedule should take effect. The NextTimeWindow is used
+ - when a Schedule is allowed to start at some point within the window. -}
+data NextTime
+	= NextTimeExactly LocalTime
+	| NextTimeWindow LocalTime LocalTime
+  deriving (Eq, Read, Show)
+
+nextTime :: Schedule -> Maybe LocalTime -> IO (Maybe NextTime)
+nextTime schedule lasttime = do
+	now <- getCurrentTime
+	tz <- getTimeZone now
+	return $ calcNextTime schedule lasttime $ utcToLocalTime tz now
+
+{- Calculate the next time that fits a Schedule, based on the
+ - last time it occurred, and the current time. -}
+calcNextTime :: Schedule -> Maybe LocalTime -> LocalTime -> Maybe NextTime
+calcNextTime (Schedule recurrance scheduledtime) lasttime currenttime
+	| scheduledtime == AnyTime = do
+		start <- findfromtoday True
+		return $ NextTimeWindow
+			start
+			(LocalTime (localDay start) (TimeOfDay 23 59 0))
+	| otherwise = NextTimeExactly <$> findfromtoday False
+  where
+  	findfromtoday anytime = 
+		LocalTime <$> nextday <*> pure nexttime
+	  where
+	  	nextday = findnextday recurrance afterday today
+	  	today = localDay currenttime
+		afterday = sameaslastday || toolatetoday
+		toolatetoday = not anytime && localTimeOfDay currenttime >= nexttime
+		sameaslastday = (localDay <$> lasttime) == Just today
+	nexttime = case scheduledtime of
+		AnyTime -> TimeOfDay 0 0 0
+		SpecificTime h m -> TimeOfDay h m 0
+	findnextday r afterday day = case r of
+		Daily
+			| afterday -> Just $ addDays 1 day
+			| otherwise -> Just day
+		Weekly w
+			| w < 0 || w > maxwday -> Nothing
+			| w == wday day -> if afterday
+				then Just $ addDays 7 day
+				else Just day
+			| otherwise -> Just $ 
+				addDays (fromIntegral $ (w - wday day) `mod` 7) day
+		Monthly m
+			| m < 0 || m > maxmday -> Nothing
+			-- TODO can be done more efficiently than recursing
+			| m == mday day -> if afterday
+				then findnextday r False (addDays 1 day)
+				else Just day
+			| otherwise -> findnextday r False (addDays 1 day)
+		Yearly y
+			| y < 0 || y > maxyday -> Nothing
+			| y == yday day -> if afterday
+				then findnextday r False (addDays 365 day)
+				else Just day
+			| otherwise -> findnextday r False (addDays 1 day)
+		Divisible n r'@Daily -> handlediv n r' yday (Just maxyday)
+		Divisible n r'@(Weekly _) -> handlediv n r' wnum (Just maxwnum)
+		Divisible n r'@(Monthly _) -> handlediv n r' mnum (Just maxmnum)
+		Divisible n r'@(Yearly _) -> handlediv n r' year Nothing
+		Divisible _ r'@(Divisible _ _) -> findnextday r' afterday day
+	  where
+	  	handlediv n r' getval mmax
+			| n > 0 && maybe True (n <=) mmax =
+				findnextdaywhere r' (divisible n . getval) afterday day
+			| otherwise = Nothing
+	findnextdaywhere r p afterday day
+		| maybe True p d = d
+		| otherwise = maybe d (findnextdaywhere r p True) d
+	  where
+		d = findnextday r afterday day
+	divisible n v = v `rem` n == 0
+
+	-- extracting various quantities from a Day
+	wday = thd3 . toWeekDate
+	wnum = snd3 . toWeekDate
+	mday = thd3 . toGregorian
+	mnum = snd3 . toGregorian
+	yday = snd . toOrdinalDate
+	year = fromIntegral . fst . toOrdinalDate
+
+	maxyday = 366 -- with leap days
+	maxwnum = 53 -- some years have more than 52
+	maxmday = 31
+	maxmnum = 12
+	maxwday = 7
 
 fromRecurrance :: Recurrance -> String
-fromRecurrance (Divisable n r) =
+fromRecurrance (Divisible n r) =
 	fromRecurrance' (++ "s divisible by " ++ show n) r
 fromRecurrance r = fromRecurrance' ("every " ++) r
 
@@ -50,67 +158,115 @@ fromRecurrance' a Daily = a "day"
 fromRecurrance' a (Weekly n) = onday n (a "week")
 fromRecurrance' a (Monthly n) = onday n (a "month")
 fromRecurrance' a (Yearly n) = onday n (a "year")
-fromRecurrance' a (Divisable _n r) = fromRecurrance' a r -- not used
+fromRecurrance' a (Divisible _n r) = fromRecurrance' a r -- not used
 
 onday :: Int -> String -> String
-onday n s = s ++ " on day " ++ show n
+onday n s = "on day " ++ show n ++ " of " ++ s
 
 toRecurrance :: String -> Maybe Recurrance
 toRecurrance s = case words s of
-	("every":something:l) -> parse something l
+	("every":"day":[]) -> Just Daily
-	(something:"divisible":"by":sn:l) -> do
+	("on":"day":sd:"of":"every":something:[]) -> parse something sd
-		r <- parse something l
+	("days":"divisible":"by":sn:[]) -> 
-		n <- readish sn
+		Divisible <$> getdivisor sn <*> pure Daily
-		if n > 0
+	("on":"day":sd:"of":something:"divisible":"by":sn:[]) -> 
-			then Just $ Divisable n r
+		Divisible
-			else Nothing
+			<$> getdivisor sn
+			<*> parse something sd
 	_ -> Nothing
   where
-	parse "day" [] = Just Daily
+	parse "week" sd = withday Weekly sd
-	parse "week" l = withday Weekly l
+	parse "month" sd = withday Monthly sd
-	parse "month" l = withday Monthly l
+	parse "year" sd = withday Yearly sd
-	parse "year" l = withday Yearly l
+	parse v sd
-	parse v l
+		| "s" `isSuffixOf` v = parse (reverse $ drop 1 $ reverse v) sd
-		| "s" `isSuffixOf` v = parse (reverse $ drop 1 $ reverse v) l
 		| otherwise = Nothing
-	withday a ("on":"day":n:[]) = a <$> readish n
+	withday c sd = c <$> readish sd
-	withday _ _ = Nothing
+	getdivisor sn = do
+		n <- readish sn
+		if n > 0
+			then Just n
+			else Nothing
 
-fromTimeOfDay :: TimeOfDay -> String
+fromScheduledTime :: ScheduledTime -> String
-fromTimeOfDay AnyTime = "any time"
+fromScheduledTime AnyTime = "any time"
-fromTimeOfDay (Hour n) = "hour " ++ show n
+fromScheduledTime (SpecificTime h m) = 
+	show h' ++ (if m > 0 then ":" ++ pad 2 (show m) else "") ++ " " ++ ampm
+  where
+  	pad n s = take (n - length s) (repeat '0') ++ s
+	(h', ampm)
+		| h == 0 = (12, "AM")
+		| h < 12 = (h, "AM")
+		| h == 12 = (h, "PM")
+		| otherwise = (h - 12, "PM")
 
-toTimeOfDay :: String -> Maybe TimeOfDay
+toScheduledTime :: String -> Maybe ScheduledTime
-toTimeOfDay s = case words s of
+toScheduledTime "any time" = Just AnyTime
-	("any":"time":[]) -> Just AnyTime
+toScheduledTime v = case words v of
-	("hour":n:[]) -> Hour <$> readish n
+	(s:ampm:[])
-	_ -> Nothing
+		| map toUpper ampm == "AM" ->
-
+			go s (\h -> if h == 12 then 0 else h)
-fromDuration :: Duration -> String
+		| map toUpper ampm == "PM" ->
-fromDuration (MinutesDuration n) = show n ++ " minutes"
+			go s (+ 12)
-
+		| otherwise -> Nothing
-toDuration :: String -> Maybe Duration
+	(s:[]) -> go s id
-toDuration s = case words s of
-	(n:"minutes":[]) -> MinutesDuration <$> readish n
-	(n:"minute":[]) -> MinutesDuration <$> readish n
 	_ -> Nothing
+  where
+  	go :: String -> (Int -> Int) -> Maybe ScheduledTime
+	go s adjust =
+		let (h, m) = separate (== ':') s
+		in SpecificTime
+			<$> (adjust <$> readish h)
+			<*> if null m then Just 0 else readish m
 
 fromSchedule :: Schedule -> String
-fromSchedule (Schedule recurrance timeofday duration) = unwords
+fromSchedule (Schedule recurrance scheduledtime) = unwords
 	[ fromRecurrance recurrance
 	, "at"
-	, fromTimeOfDay timeofday
+	, fromScheduledTime scheduledtime
-	, "for"
-	, fromDuration duration
 	]
 
 toSchedule :: String -> Maybe Schedule
-toSchedule s = Schedule
+toSchedule = eitherToMaybe . parseSchedule
-	<$> toRecurrance (unwords recurrance)
-	<*> toTimeOfDay (unwords timeofday)
-	<*> toDuration (unwords duration)
-  where
-  	ws = words s
-	(recurrance, ws') = separate (== "at") ws
-	(timeofday, duration) = separate (== "for") ws'
 
+parseSchedule :: String -> Either String Schedule
+parseSchedule s = do
+	r <- maybe (Left $ "bad recurrance: " ++ recurrance) Right
+		(toRecurrance recurrance)
+	t <- maybe (Left $ "bad time of day: " ++ scheduledtime) Right
+		(toScheduledTime scheduledtime)
+	Right $ Schedule r t
+  where
+	(rws, tws) = separate (== "at") (words s)
+	recurrance = unwords rws
+	scheduledtime = unwords tws
+
+instance Arbitrary Schedule where
+	arbitrary = Schedule <$> arbitrary <*> arbitrary
+
+instance Arbitrary ScheduledTime where
+	arbitrary = oneof
+		[ pure AnyTime
+		, SpecificTime 
+			<$> nonNegative arbitrary 
+			<*> nonNegative arbitrary
+		]
+
+instance Arbitrary Recurrance where
+	arbitrary = oneof
+		[ pure Daily
+		, Weekly <$> nonNegative arbitrary
+		, Monthly <$> nonNegative arbitrary
+		, Yearly <$> nonNegative arbitrary
+		, Divisible
+			<$> positive arbitrary
+			<*> oneof -- no nested Divisibles
+				[ pure Daily
+				, Weekly <$> nonNegative arbitrary
+				, Monthly <$> nonNegative arbitrary
+				, Yearly <$> nonNegative arbitrary
+				]
+		]
+
+prop_schedule_roundtrips :: Schedule -> Bool
+prop_schedule_roundtrips s = toSchedule (fromSchedule s) == Just s

debian/changelog

@@ -1,5 +1,8 @@
 git-annex (4.20131003) UNRELEASED; urgency=low
 
+  * The assitant can now run scheduled incremental fsck jobs on the local
+    repository and remotes. These can be configured using vicfg or with the
+    webapp.
   * Automatically and safely detect and recover from dangling
     .git/annex/index.lock files, which would prevent git from
     committing to the git-annex branch, eg after a crash.

doc/git-annex.mdwn

@@ -410,6 +410,12 @@ subdirectories).
   Without an expression, displays the current preferred content setting
   of the repository.
 
+* `schedule repository [expression]`
+
+  When run with an expression, configures scheduled jobs to run at a
+  particular time. This can be used to make the assistant periodically run
+  incremental fscks. See SCHEDULED JOBS below.
+
 * `vicfg`
 
   Opens EDITOR on a temp file containing most of the above configuration
@@ -935,8 +941,8 @@ file contents are present at either of two repositories.
 
 Each repository has a preferred content setting, which specifies content
 that the repository wants to have present. These settings can be configured
-using `git annex vicfg`. They are used by the `--auto` option, and
+using `git annex vicfg` or `git annex content`.
-by the git-annex assistant.
+They are used by the `--auto` option, and by the git-annex assistant.
 
 The preferred content settings are similar, but not identical to
 the file matching options specified above, just without the dashes.
@@ -952,7 +958,31 @@ When a repository is in one of the standard predefined groups, like "backup"
 and "client", setting its preferred content to "standard" will use a
 built-in preferred content expression ddeveloped for that group.
 
-# CONFIGURATION
+# SCHEDULED JOBS
+
+The git-annex assistant daemon can be configured to run jobs at scheduled
+times. This is similar to cron (and you can use cron if you prefer), but
+has the advantage of being integrated into git-annex, and so being able
+to eg, fsck a repository on a removable drive when the drive gets
+connected.
+
+The scheduled jobs can be configured using `git annex vicfg` or
+`git annex schedule`. 
+
+These actions are available: "fsck self", "fsck UUID" (where UUID
+is the UUID of a remote to fsck). After the action comes the duration
+to allow the action to run, and finally the schedule of when to run it.
+
+To schedule multiple jobs, separate them with "; ".
+
+Some examples:
+
+	fsck self 30m every day at any time
+	fsck self 1h every day at 3 AM
+	fsck self 1h on day 1 of every month at any time
+	fsck self 1h on day 1 of weeks divisible by 2 at any time
+
+# CONFIGURATION VIA .git/config
 
 Like other git commands, git-annex is configured via `.git/config`.
 Here are all the supported configuration settings.

templates/configurators/fsck.cassius

@@ -0,0 +1,4 @@
+input[type=number]
+  width: 5em
+select
+  width: 10em

templates/configurators/fsck.hamlet

@@ -0,0 +1,21 @@
+<div .span9 .hero-unit>
+  <h2>
+    Consistency checks
+  <p>
+    Checking the contents of a repository periodically will ensure that #
+    your data is in good shape. Any problems that are detected will #
+    be automatically fixed.
+  <p>
+    Running the consistency check involves reading all the files in the #
+    repository, which can take a long time if it's large. Running just a #
+    little at a time will eventually check the whole repository.
+  $if (not (null checks))
+    <p>
+      Currently scheduled checks:
+      $forall check <- checks
+        ^{showFsckForm False check}
+        <div style="margin-left: 5em">
+          ^{showFsckStatus check}
+  <p>
+    Add a check:
+    ^{showFsckForm True defaultFsck}

templates/configurators/fsck/form.hamlet

@@ -0,0 +1,2 @@
+<form method="post" .form-inline enctype=#{enctype} action="@{action}">
+  ^{form}

templates/configurators/fsck/formcontent.hamlet

@@ -0,0 +1,15 @@
+#{msg}
+<p>
+  <div .input-prepend .input-append>
+    Check ^{fvInput reposView} for #
+    ^{fvInput durationView} minutes #
+    ^{fvInput recurranceView} #
+    starting at ^{fvInput timeView} #
+    $if new
+      <button type=submit .btn .btn-primary>
+        Add
+    $else
+      <button type=submit .btn>
+        Save
+      <a .btn href="@{RemoveActivityR u activity}">
+        Remove

templates/configurators/fsck/status.hamlet

@@ -0,0 +1,5 @@
+<i>
+  $maybe t <- lastrun
+    (last run: #{show t})
+  $nothing
+    (not yet run)

templates/configurators/main.hamlet

@@ -13,6 +13,7 @@
       <p>
         Tune the behavior of git-annex, including how many copies #
         to retain of each file, and how much disk space it can use.
+  <div .row-fluid>
     <div .span4>
       $if xmppconfigured
         <h3>
@@ -28,3 +29,10 @@
        <p>
          Keep in touch with remote devices, and with your friends, #
          by configuring a jabber account.
+    <div .span4>
+      <h3>
+        <a href="@{ConfigFsckR}">
+          Configure consistency checks
+      <p>
+        Set up periodic checks of your data to detect and recover from #
+        disk problems.