2a45b5ae9a
This was already prevented in other ways, but as seen in commit
c30fd24d91, those were a bit fragile.
And I'm not sure races were avoided in every case before. At least a
race between two separate git-annex processes, dropping the same
content, seemed possible.
This way, if locking fails, and the content is not present, it will
always do the right thing. Also, it avoids the overhead of an unncessary
inAnnex check for every file.
This commit was sponsored by Denis Dzyubenko on Patreon.
85 lines
2.4 KiB
Haskell
85 lines
2.4 KiB
Haskell
{- git-annex assistant unused files
|
|
-
|
|
- Copyright 2014 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Assistant.Unused where
|
|
|
|
import qualified Data.Map as M
|
|
|
|
import Assistant.Common
|
|
import qualified Git
|
|
import Logs.Unused
|
|
import Logs.Location
|
|
import Annex.Content
|
|
import Utility.DataUnits
|
|
import Utility.DiskFree
|
|
import Utility.HumanTime
|
|
import Utility.Tense
|
|
|
|
import Data.Time.Clock.POSIX
|
|
import qualified Data.Text as T
|
|
|
|
describeUnused :: Assistant (Maybe TenseText)
|
|
describeUnused = describeUnused' False
|
|
|
|
describeUnusedWhenBig :: Assistant (Maybe TenseText)
|
|
describeUnusedWhenBig = describeUnused' True
|
|
|
|
{- This uses heuristics: 1000 unused keys, or more unused keys
|
|
- than the remaining free disk space, or more than 1/10th the total
|
|
- disk space being unused keys all suggest a problem. -}
|
|
describeUnused' :: Bool -> Assistant (Maybe TenseText)
|
|
describeUnused' whenbig = liftAnnex $ go =<< readUnusedLog ""
|
|
where
|
|
go m = do
|
|
let num = M.size m
|
|
let diskused = foldl' sumkeysize 0 (M.keys m)
|
|
df <- forpath getDiskFree
|
|
disksize <- forpath getDiskSize
|
|
return $ if num == 0
|
|
then Nothing
|
|
else if not whenbig || moreused df diskused || tenthused disksize diskused
|
|
then Just $ tenseWords
|
|
[ UnTensed $ T.pack $ roughSize storageUnits False diskused
|
|
, Tensed "are" "were"
|
|
, "taken up by unused files"
|
|
]
|
|
else if num > 1000
|
|
then Just $ tenseWords
|
|
[ UnTensed $ T.pack $ show num ++ " unused files"
|
|
, Tensed "exist" "existed"
|
|
]
|
|
else Nothing
|
|
|
|
moreused Nothing _ = False
|
|
moreused (Just df) used = df <= used
|
|
|
|
tenthused Nothing _ = False
|
|
tenthused (Just disksize) used = used >= disksize `div` 10
|
|
|
|
sumkeysize s k = s + fromMaybe 0 (fromKey keySize k)
|
|
|
|
forpath a = inRepo $ liftIO . a . fromRawFilePath . Git.repoPath
|
|
|
|
{- With a duration, expires all unused files that are older.
|
|
- With Nothing, expires *all* unused files. -}
|
|
expireUnused :: Maybe Duration -> Assistant ()
|
|
expireUnused duration = do
|
|
m <- liftAnnex $ readUnusedLog ""
|
|
now <- liftIO getPOSIXTime
|
|
let oldkeys = M.keys $ M.filter (tooold now) m
|
|
forM_ oldkeys $ \k -> do
|
|
debug ["removing old unused key", serializeKey k]
|
|
liftAnnex $ tryNonAsync $ do
|
|
lockContentForRemoval k noop removeAnnex
|
|
logStatus k InfoMissing
|
|
where
|
|
boundry = durationToPOSIXTime <$> duration
|
|
tooold now (_, mt) = case boundry of
|
|
Nothing -> True
|
|
Just b -> maybe False (\t -> now - t >= b) mt
|