diff options
Diffstat (limited to 'Command')
| -rw-r--r-- | Command/Expire.hs | 106 | ||||
| -rw-r--r-- | Command/FromKey.hs | 4 | ||||
| -rw-r--r-- | Command/Fsck.hs | 114 | ||||
| -rw-r--r-- | Command/Info.hs | 5 | ||||
| -rw-r--r-- | Command/RegisterUrl.hs | 4 |
5 files changed, 132 insertions, 101 deletions
diff --git a/Command/Expire.hs b/Command/Expire.hs new file mode 100644 index 000000000..f4d1a06e3 --- /dev/null +++ b/Command/Expire.hs @@ -0,0 +1,106 @@ +{- git-annex command + - + - Copyright 2015 Joey Hess <id@joeyh.name> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Command.Expire where + +import Common.Annex +import Command +import Logs.Activity +import Logs.UUID +import Logs.MapLog +import Logs.Trust +import Annex.UUID +import qualified Remote +import Utility.HumanTime + +import Data.Time.Clock.POSIX +import qualified Data.Map as M + +cmd :: [Command] +cmd = [withOptions [activityOption, noActOption] $ command "expire" paramExpire seek + SectionMaintenance "expire inactive repositories"] + +paramExpire :: String +paramExpire = (paramRepeating $ paramOptional paramRemote ++ ":" ++ paramTime) + +activityOption :: Option +activityOption = fieldOption [] "activity" "Name" "specify activity" + +noActOption :: Option +noActOption = flagOption [] "no-act" "don't really do anything" + +seek :: CommandSeek +seek ps = do + expire <- parseExpire ps + wantact <- getOptionField activityOption (pure . parseActivity) + noact <- getOptionFlag noActOption + actlog <- lastActivities wantact + u <- getUUID + us <- filter (/= u) . M.keys <$> uuidMap + descs <- uuidMap + seekActions $ pure $ map (start expire noact actlog descs) us + +start :: Expire -> Bool -> Log Activity -> M.Map UUID String -> UUID -> CommandStart +start (Expire expire) noact actlog descs u = + case lastact of + Just ent | notexpired ent -> checktrust (== DeadTrusted) $ do + showStart "unexpire" desc + showNote =<< whenactive + unless noact $ + trustSet u SemiTrusted + _ -> checktrust (/= DeadTrusted) $ do + showStart "expire" desc + showNote =<< whenactive + unless noact $ + trustSet u DeadTrusted + where + lastact = changed <$> M.lookup u actlog + whenactive = case lastact of + Just (Date t) -> do + d <- liftIO $ durationSince $ posixSecondsToUTCTime t + return $ "last active: " ++ fromDuration d ++ " ago" + _ -> return "no activity" + desc = fromUUID u ++ " " ++ fromMaybe "" (M.lookup u descs) + notexpired ent = case ent of + Unknown -> False + Date t -> case lookupexpire of + Just (Just expiretime) -> t >= expiretime + _ -> True + lookupexpire = headMaybe $ catMaybes $ + map (`M.lookup` expire) [Just u, Nothing] + checktrust want a = ifM (want <$> lookupTrust u) + ( do + void a + next $ next $ return True + , stop + ) + +data Expire = Expire (M.Map (Maybe UUID) (Maybe POSIXTime)) + +parseExpire :: [String] -> Annex Expire +parseExpire [] = error "Specify an expire time." +parseExpire ps = do + now <- liftIO getPOSIXTime + Expire . M.fromList <$> mapM (parse now) ps + where + parse now s = case separate (== ':') s of + (t, []) -> return (Nothing, parsetime now t) + (n, t) -> do + r <- Remote.nameToUUID n + return (Just r, parsetime now t) + parsetime _ "never" = Nothing + parsetime now s = case parseDuration s of + Nothing -> error $ "bad expire time: " ++ s + Just d -> Just (now - durationToPOSIXTime d) + +parseActivity :: Maybe String -> Maybe Activity +parseActivity Nothing = Nothing +parseActivity (Just s) = case readish s of + Nothing -> error $ "Unknown activity. Choose from: " ++ + unwords (map show [minBound..maxBound :: Activity]) + Just v -> Just v + diff --git a/Command/FromKey.hs b/Command/FromKey.hs index 10484b840..ebc0e6f6e 100644 --- a/Command/FromKey.hs +++ b/Command/FromKey.hs @@ -41,10 +41,10 @@ start _ [] = do start _ _ = error "specify a key and a dest file" massAdd :: CommandPerform -massAdd = go True =<< map words . lines <$> liftIO getContents +massAdd = go True =<< map (separate (== ' ')) . lines <$> liftIO getContents where go status [] = next $ return status - go status ([keyname,f]:rest) = do + go status ((keyname,f):rest) | not (null keyname) && not (null f) = do let key = fromMaybe (error $ "bad key " ++ keyname) $ file2key keyname ok <- perform' key f let !status' = status && ok diff --git a/Command/Fsck.hs b/Command/Fsck.hs index ec89a4351..08753b612 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -22,8 +22,8 @@ import Annex.Direct import Annex.Perms import Annex.Link import Logs.Location -import Logs.Presence import Logs.Trust +import Logs.Activity import Config.NumCopies import Annex.UUID import Utility.DataUnits @@ -39,7 +39,6 @@ import Data.Time.Clock.POSIX import Data.Time import System.Posix.Types (EpochTime) import System.Locale -import qualified Data.Map as M cmd :: [Command] cmd = [withOptions fsckOptions $ command "fsck" paramPaths seek @@ -58,22 +57,12 @@ incrementalScheduleOption :: Option incrementalScheduleOption = fieldOption [] "incremental-schedule" paramTime "schedule incremental fscking" -distributedOption :: Option -distributedOption = flagOption [] "distributed" "distributed fsck mode" - -expireOption :: Option -expireOption = fieldOption [] "expire" - (paramRepeating $ paramOptional paramRemote ++ ":" ++ paramTime) - "distributed expire mode" - fsckOptions :: [Option] fsckOptions = [ fsckFromOption , startIncrementalOption , moreIncrementalOption , incrementalScheduleOption - , distributedOption - , expireOption ] ++ keyOptions ++ annexedMatchingOptions seek :: CommandSeek @@ -81,28 +70,28 @@ seek ps = do from <- getOptionField fsckFromOption Remote.byNameWithUUID u <- maybe getUUID (pure . Remote.uuid) from i <- getIncremental u - d <- getDistributed withKeyOptions False - (\k -> startKey i d k =<< getNumCopies) - (withFilesInGit $ whenAnnexed $ start from i d) + (\k -> startKey i k =<< getNumCopies) + (withFilesInGit $ whenAnnexed $ start from i) ps withFsckDb i FsckDb.closeDb + recordActivity Fsck u -start :: Maybe Remote -> Incremental -> Distributed -> FilePath -> Key -> CommandStart -start from inc dist file key = do +start :: Maybe Remote -> Incremental -> FilePath -> Key -> CommandStart +start from inc file key = do v <- Backend.getBackend file key case v of Nothing -> stop Just backend -> do numcopies <- getFileNumCopies file case from of - Nothing -> go $ perform dist key file backend numcopies - Just r -> go $ performRemote dist key file backend numcopies r + Nothing -> go $ perform key file backend numcopies + Just r -> go $ performRemote key file backend numcopies r where go = runFsck inc file key -perform :: Distributed -> Key -> FilePath -> Backend -> NumCopies -> Annex Bool -perform dist key file backend numcopies = check +perform :: Key -> FilePath -> Backend -> NumCopies -> Annex Bool +perform key file backend numcopies = check -- order matters [ fixLink key file , verifyLocationLog key file @@ -110,14 +99,13 @@ perform dist key file backend numcopies = check , verifyDirectMode key file , checkKeySize key , checkBackend backend key (Just file) - , checkDistributed dist key Nothing , checkKeyNumCopies key file numcopies ] {- To fsck a remote, the content is retrieved to a tmp file, - and checked locally. -} -performRemote :: Distributed -> Key -> FilePath -> Backend -> NumCopies -> Remote -> Annex Bool -performRemote dist key file backend numcopies remote = +performRemote :: Key -> FilePath -> Backend -> NumCopies -> Remote -> Annex Bool +performRemote key file backend numcopies remote = dispatch =<< Remote.hasKey remote key where dispatch (Left err) = do @@ -136,7 +124,6 @@ performRemote dist key file backend numcopies remote = [ verifyLocationLogRemote key file remote present , checkKeySizeRemote key remote localcopy , checkBackendRemote backend key remote localcopy - , checkDistributed dist key (Just $ Remote.uuid remote) , checkKeyNumCopies key file numcopies ] withtmp a = do @@ -157,19 +144,18 @@ performRemote dist key file backend numcopies remote = ) dummymeter _ = noop -startKey :: Incremental -> Distributed -> Key -> NumCopies -> CommandStart -startKey inc dist key numcopies = +startKey :: Incremental -> Key -> NumCopies -> CommandStart +startKey inc key numcopies = case Backend.maybeLookupBackendName (Types.Key.keyBackendName key) of Nothing -> stop Just backend -> runFsck inc (key2file key) key $ - performKey dist key backend numcopies + performKey key backend numcopies -performKey :: Distributed -> Key -> Backend -> NumCopies -> Annex Bool -performKey dist key backend numcopies = check +performKey :: Key -> Backend -> NumCopies -> Annex Bool +performKey key backend numcopies = check [ verifyLocationLog key (key2file key) , checkKeySize key , checkBackend backend key Nothing - , checkDistributed dist key Nothing , checkKeyNumCopies key (key2file key) numcopies ] @@ -513,69 +499,3 @@ getIncremental u = do when (now - realToFrac started >= durationToPOSIXTime delta) $ resetStartTime u return True - -data Distributed - = NonDistributed - | Distributed POSIXTime - | DistributedExpire POSIXTime (M.Map (Maybe UUID) (Maybe POSIXTime)) - deriving (Show) - -getDistributed :: Annex Distributed -getDistributed = go =<< getOptionField expireOption parseexpire - where - go (Just m) = DistributedExpire <$> liftIO getPOSIXTime <*> pure m - go Nothing = ifM (getOptionFlag distributedOption) - ( Distributed <$> liftIO getPOSIXTime - , return NonDistributed - ) - - parseexpire Nothing = return Nothing - parseexpire (Just s) = do - now <- liftIO getPOSIXTime - Just . M.fromList <$> mapM (parseexpire' now) (words s) - parseexpire' now s = case separate (== ':') s of - (t, []) -> return (Nothing, parsetime now t) - (n, t) -> do - r <- Remote.nameToUUID n - return (Just r, parsetime now t) - parsetime _ "never" = Nothing - parsetime now s = case parseDuration s of - Nothing -> error $ "bad expire time: " ++ s - Just d -> Just (now - durationToPOSIXTime d) - -checkDistributed :: Distributed -> Key -> Maybe UUID -> Annex Bool -checkDistributed d k mu = do - go d - return True - where - go NonDistributed = noop - - -- This is called after fsck has checked the key's content, so - -- if the key is present in the annex now, we just need to update - -- the location log with the timestamp of the start of the fsck. - -- - -- Note that reusing this timestamp means that the same log line - -- is generated for each key, which keeps the size increase - -- of the git-annex branch down. - go (Distributed ts) = whenM (inAnnex k) $ do - u <- maybe getUUID return mu - logChange' (logThen ts) k u InfoPresent - - -- Get the location log for the key, and expire all entries - -- that are older than their uuid's listed expiration date. - -- (Except for the local repository.) - go (DistributedExpire ts m) = do - ls <- locationLog k - hereu <- getUUID - forM_ ls $ \l -> do - let u = toUUID (info l) - unless (u == hereu) $ - case lookupexpire u of - Just (Just expiretime) - | date l < expiretime -> - logChange' (logThen ts) k u InfoMissing - _ -> noop - where - lookupexpire u = headMaybe $ catMaybes $ - map (`M.lookup` m) [Just u, Nothing] - diff --git a/Command/Info.hs b/Command/Info.hs index e04a72a3c..e489db0ea 100644 --- a/Command/Info.hs +++ b/Command/Info.hs @@ -198,6 +198,7 @@ remote_fast_stats r = map (\s -> s r) [ remote_name , remote_description , remote_uuid + , remote_trust , remote_cost , remote_type ] @@ -266,6 +267,10 @@ remote_uuid :: Remote -> Stat remote_uuid r = simpleStat "uuid" $ pure $ fromUUID $ Remote.uuid r +remote_trust :: Remote -> Stat +remote_trust r = simpleStat "trust" $ lift $ + showTrustLevel <$> lookupTrust (Remote.uuid r) + remote_cost :: Remote -> Stat remote_cost r = simpleStat "cost" $ pure $ show $ Remote.cost r diff --git a/Command/RegisterUrl.hs b/Command/RegisterUrl.hs index 3ff1becc9..d0e806597 100644 --- a/Command/RegisterUrl.hs +++ b/Command/RegisterUrl.hs @@ -34,10 +34,10 @@ start [] = do start _ = error "specify a key and an url" massAdd :: CommandPerform -massAdd = go True =<< map words . lines <$> liftIO getContents +massAdd = go True =<< map (separate (== ' ')) . lines <$> liftIO getContents where go status [] = next $ return status - go status ([keyname,u]:rest) = do + go status ((keyname,u):rest) | not (null keyname) && not (null u) = do let key = fromMaybe (error $ "bad key " ++ keyname) $ file2key keyname ok <- perform' key u let !status' = status && ok |