78da00c7a6When the log has an activity that is not known, eg added by a future version of git-annex, it used to be treated as no activity at all, which would make git-annex expire think it should expire the repository, despite it having some kind of recent activity. Hopefully there will be no reason to add a new activity until enough time has passed that this commit is in use everywhere. Sponsored-by: Jake Vosloo on Patreon
116 lines
3.3 KiB
Haskell
116 lines
3.3 KiB
Haskell
{- git-annex command
|
|
-
|
|
- Copyright 2015 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
module Command.Expire where
|
|
|
|
import Command
|
|
import Logs.Activity
|
|
import Logs.UUID
|
|
import Logs.MapLog
|
|
import Logs.Trust
|
|
import Annex.UUID
|
|
import Annex.VectorClock
|
|
import qualified Remote
|
|
import Utility.HumanTime
|
|
|
|
import Control.Monad.Fail as Fail (MonadFail(..))
|
|
import Data.Time.Clock.POSIX
|
|
import qualified Data.Map as M
|
|
|
|
cmd :: Command
|
|
cmd = command "expire" SectionMaintenance
|
|
"expire inactive repositories"
|
|
paramExpire (seek <$$> optParser)
|
|
|
|
paramExpire :: String
|
|
paramExpire = (paramRepeating $ paramOptional paramRemote ++ ":" ++ paramTime)
|
|
|
|
data ExpireOptions = ExpireOptions
|
|
{ expireParams :: CmdParams
|
|
, activityOption :: Maybe Activity
|
|
, noActOption :: Bool
|
|
}
|
|
|
|
optParser :: CmdParamsDesc -> Parser ExpireOptions
|
|
optParser desc = ExpireOptions
|
|
<$> cmdParams desc
|
|
<*> optional (option (str >>= parseActivity)
|
|
( long "activity" <> metavar paramName
|
|
<> help "specify activity that prevents expiry"
|
|
))
|
|
<*> switch
|
|
( long "no-act"
|
|
<> help "don't really do anything"
|
|
)
|
|
|
|
seek :: ExpireOptions -> CommandSeek
|
|
seek o = do
|
|
expire <- parseExpire (expireParams o)
|
|
actlog <- lastActivities (activityOption o)
|
|
u <- getUUID
|
|
us <- filter (/= u) . M.keys <$> uuidDescMap
|
|
descs <- uuidDescMap
|
|
commandActions $ map (start expire (noActOption o) actlog descs) us
|
|
|
|
start :: Expire -> Bool -> Log Activity -> UUIDDescMap -> UUID -> CommandStart
|
|
start (Expire expire) noact actlog descs u =
|
|
case lastact of
|
|
Just ent | notexpired ent -> checktrust (== DeadTrusted) $
|
|
starting "unexpire" ai si $ do
|
|
showNote =<< whenactive
|
|
unless noact $
|
|
trustSet u SemiTrusted
|
|
next $ return True
|
|
_ -> checktrust (/= DeadTrusted) $
|
|
starting "expire" ai si $ do
|
|
showNote =<< whenactive
|
|
unless noact $
|
|
trustSet u DeadTrusted
|
|
next $ return True
|
|
where
|
|
lastact = changed <$> M.lookup u actlog
|
|
whenactive = case lastact of
|
|
Just (VectorClock c) -> do
|
|
d <- liftIO $ durationSince $ posixSecondsToUTCTime c
|
|
return $ "last active: " ++ fromDuration d ++ " ago"
|
|
_ -> return "no activity"
|
|
desc = fromUUID u ++ " " ++ fromUUIDDesc (fromMaybe mempty (M.lookup u descs))
|
|
ai = ActionItemOther (Just desc)
|
|
si = SeekInput []
|
|
notexpired ent = case ent of
|
|
Unknown -> False
|
|
VectorClock c -> case lookupexpire of
|
|
Just (Just expiretime) -> c >= expiretime
|
|
_ -> True
|
|
lookupexpire = headMaybe $ catMaybes $
|
|
map (`M.lookup` expire) [Just u, Nothing]
|
|
checktrust want = stopUnless (want <$> lookupTrust u)
|
|
|
|
data Expire = Expire (M.Map (Maybe UUID) (Maybe POSIXTime))
|
|
|
|
parseExpire :: [String] -> Annex Expire
|
|
parseExpire [] = giveup "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
|
|
Right d -> Just (now - durationToPOSIXTime d)
|
|
Left e -> giveup $ "bad expire time: " ++ e
|
|
|
|
parseActivity :: MonadFail m => String -> m Activity
|
|
parseActivity s = case readish s of
|
|
Nothing -> Fail.fail $ "Unknown activity. Choose from: " ++
|
|
unwords (map show allActivities)
|
|
Just v -> return v
|
|
|