2cecc8d2a3
Can be used to override the default timestamps used in log files in the git-annex branch. This is a dangerous environment variable; use with caution. Note that this only affects writing to the logs on the git-annex branch. It is not used for metadata in git commits (other env vars can be set for that). There are many other places where timestamps are still used, that don't get committed to git, but do touch disk. Including regular timestamps of files, and timestamps embedded in some files in .git/annex/, including the last fsck timestamp and timestamps in transfer log files. A good way to find such things in git-annex is to get for getPOSIXTime and getCurrentTime, although some of the results are of course false positives that never hit disk (unless git-annex gets swapped out..) So this commit does NOT necessarily make git-annex comply with some HIPPA privacy regulations; it's up to the user to determine if they can use it in a way compliant with such regulations. Benchmarking: It takes 0.00114 milliseconds to call getEnv "GIT_ANNEX_VECTOR_CLOCK" when that env var is not set. So, 100 thousand log files can be written with an added overhead of only 0.114 seconds. That should be by far swamped by the actual overhead of writing the log files and making the commit containing them. This commit was supported by the NSF-funded DataLad project.
116 lines
3.2 KiB
Haskell
116 lines
3.2 KiB
Haskell
{- git-annex command
|
|
-
|
|
- Copyright 2015 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU GPL 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 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 <$> uuidMap
|
|
descs <- uuidMap
|
|
seekActions $ pure $ map (start expire (noActOption o) 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 (VectorClock c) -> do
|
|
d <- liftIO $ durationSince $ posixSecondsToUTCTime c
|
|
return $ "last active: " ++ fromDuration d ++ " ago"
|
|
_ -> return "no activity"
|
|
desc = fromUUID u ++ " " ++ fromMaybe "" (M.lookup u descs)
|
|
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 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 [] = 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
|
|
Nothing -> giveup $ "bad expire time: " ++ s
|
|
Just d -> Just (now - durationToPOSIXTime d)
|
|
|
|
parseActivity :: Monad m => String -> m Activity
|
|
parseActivity s = case readish s of
|
|
Nothing -> fail $ "Unknown activity. Choose from: " ++
|
|
unwords (map show [minBound..maxBound :: Activity])
|
|
Just v -> return v
|
|
|