diff options
Diffstat (limited to 'Assistant/Threads/Cronner.hs')
| -rw-r--r-- | Assistant/Threads/Cronner.hs | 72 |
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 |