cronner builds, should work (untested)

I probably need to improve handling of the PleaseTerminate exception to
kill the fsck process. Also, if fsck finds bad files, something needs
to requeue downloads of them. Otherwise, this should work, but is probably
quite buggy since I have only tested the pure code over the past 2 days.

2 files changed, 70 insertions, 3 deletions

diff --git a/Assistant/Threads/Cronner.hs b/Assistant/Threads/Cronner.hs
index d1d7945e3..d123688c9 100644
--- a/Assistant/Threads/Cronner.hs
+++ b/Assistant/Threads/Cronner.hs
@@ -14,12 +14,18 @@ module Assistant.Threads.Cronner (
 import Assistant.Common
 import Assistant.DaemonStatus
 import Utility.NotificationBroadcaster
-import Logs.Schedule
 import Annex.UUID
+import Config.Files
+import Logs.Schedule
+import Utility.Scheduled
 import Types.ScheduledActivity
+import Utility.ThreadScheduler
+import Utility.HumanTime
+import qualified Build.SysConfig
 
 import Control.Concurrent.Async
 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
@@ -76,5 +82,65 @@ cronnerThread = namedThreadUnchecked "Cronner" $ do
  - the thread and any processes it has run shutting down.
  -}
 activityThread :: ScheduledActivity -> Maybe LocalTime -> Assistant ()
-activityThread activity lastrun = do
-	noop
+activityThread 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)) = runafter l t Nothing run
+	go l (Just (NextTimeWindow windowstart windowend)) =
+		runafter l windowstart (Just windowend) run
+	desc = fromScheduledActivity activity
+	schedule = getSchedule activity
+	runafter l t mmaxt a = 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 a 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
+		debug ["starting", desc]
+		runActivity activity
+		debug ["finished", desc]
+		liftAnnex $ setLastRunTime activity nowt
+		go (Just nowt) =<< getnexttime (Just nowt)
+
+secondsUntilLocalTime :: LocalTime -> IO Seconds
+secondsUntilLocalTime t = do
+	now <- getCurrentTime
+	tz <- getTimeZone now
+	let secs = truncate $ diffUTCTime now (localTimeToUTC tz t)
+	return $ if secs > 0
+		then Seconds secs
+		else Seconds 0
+
+runActivity :: ScheduledActivity -> Assistant ()
+runActivity (ScheduledSelfFsck _ d) = do
+	program <- liftIO $ readProgramFile
+	void $ liftIO $ niceShell $
+		program ++ " fsck --incremental-schedule=1d --duration=" ++ fromDuration d
+runActivity (ScheduledRemoteFsck _ _ _) =
+	debug ["remote fsck not implemented yet"]
+
+niceShell :: String -> IO Bool
+niceShell command = boolSystem "sh"
+	[ Param "-c"
+	, Param nicedcommand
+	]
+  where
+  	nicedcommand
+		| Build.SysConfig.nice = "nice " ++ command
+		| otherwise = command
diff --git a/Build/Configure.hs b/Build/Configure.hs
index aae874d48..3c3f39c8d 100644
--- a/Build/Configure.hs
+++ b/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")