summaryrefslogtreecommitdiff
path: root/Assistant/Threads/Cronner.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Assistant/Threads/Cronner.hs')
-rw-r--r--Assistant/Threads/Cronner.hs72
1 files changed, 69 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