diff options
| -rw-r--r-- | Command/Schedule.hs | 50 | ||||
| -rw-r--r-- | Command/Vicfg.hs | 16 | ||||
| -rw-r--r-- | GitAnnex.hs | 2 | ||||
| -rw-r--r-- | Logs/Schedule.hs | 4 | ||||
| -rw-r--r-- | Types/ScheduledActivity.hs | 13 | ||||
| -rw-r--r-- | debian/changelog | 3 | ||||
| -rw-r--r-- | doc/git-annex.mdwn | 36 |
7 files changed, 109 insertions, 15 deletions
diff --git a/Command/Schedule.hs b/Command/Schedule.hs new file mode 100644 index 000000000..35f144c75 --- /dev/null +++ b/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 diff --git a/Command/Vicfg.hs b/Command/Vicfg.hs index c6fc5ffc9..22c641408 100644 --- a/Command/Vicfg.hs +++ b/Command/Vicfg.hs @@ -12,7 +12,6 @@ import qualified Data.Set as S import System.Environment (getEnv) import Data.Tuple (swap) import Data.Char (isSpace) -import Data.Either import Common.Annex import Command @@ -132,7 +131,7 @@ genCfg cfg descs = unlines $ concat , com "Scheduled activities" , com "(Separate multiple activities with \"; \")" ] - (\(l, u) -> line "schedule" u $ intercalate "; " $ map fromScheduledActivity l) + (\(l, u) -> line "schedule" u $ fromScheduledActivities l) (\u -> line "schedule" u "") settings field desc showvals showdefaults = concat @@ -188,14 +187,11 @@ parseCfg curcfg = go [] curcfg . lines Nothing -> let m = M.insert u value (cfgPreferredContentMap cfg) in Right $ cfg { cfgPreferredContentMap = m } - | setting == "schedule" = - let (bad, good) = partitionEithers $ - map parseScheduledActivity $ split "; " value - in if null bad - then - let m = M.insert u good (cfgScheduleMap cfg) - in Right $ cfg { cfgScheduleMap = m } - else Left $ intercalate "; " bad + | 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] diff --git a/GitAnnex.hs b/GitAnnex.hs index ad04d9fdc..36fe6aa83 100644 --- a/GitAnnex.hs +++ b/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 diff --git a/Logs/Schedule.hs b/Logs/Schedule.hs index 35745b9f3..56fb3399e 100644 --- a/Logs/Schedule.hs +++ b/Logs/Schedule.hs @@ -34,7 +34,7 @@ scheduleSet uuid@(UUID _) activities = do Annex.Branch.change scheduleLog $ showLog id . changeLog ts uuid val . parseLog Just where - val = intercalate "; " $ map fromScheduledActivity activities + val = fromScheduledActivities activities scheduleSet NoUUID _ = error "unknown UUID; cannot modify" scheduleMap :: Annex (M.Map UUID [ScheduledActivity]) @@ -42,7 +42,7 @@ scheduleMap = simpleMap . parseLogWithUUID parser <$> Annex.Branch.get scheduleLog where - parser _uuid = Just . mapMaybe toScheduledActivity . split "; " + parser _uuid = eitherToMaybe . parseScheduledActivities scheduleGet :: UUID -> Annex (S.Set ScheduledActivity) scheduleGet u = do diff --git a/Types/ScheduledActivity.hs b/Types/ScheduledActivity.hs index e29050d8e..386f42333 100644 --- a/Types/ScheduledActivity.hs +++ b/Types/ScheduledActivity.hs @@ -12,6 +12,8 @@ import Utility.Scheduled import Utility.HumanTime import Types.UUID +import Data.Either + data ScheduledActivity = ScheduledSelfFsck Schedule Duration | ScheduledRemoteFsck UUID Schedule Duration @@ -48,3 +50,14 @@ parseScheduledActivity s = case words s of 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 diff --git a/debian/changelog b/debian/changelog index d558b83ae..fa604fb94 100644 --- a/debian/changelog +++ b/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. diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 7c16d7bbf..dd266f67c 100644 --- a/doc/git-annex.mdwn +++ b/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 -by the git-annex assistant. +using `git annex vicfg` or `git annex content`. +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. |