diff options
Diffstat (limited to 'Assistant')
| -rw-r--r-- | Assistant/Alert.hs | 2 | ||||
| -rw-r--r-- | Assistant/Threads/SanityChecker.hs | 56 | ||||
| -rw-r--r-- | Assistant/Unused.hs | 86 |
3 files changed, 94 insertions, 50 deletions
diff --git a/Assistant/Alert.hs b/Assistant/Alert.hs index b5ee706b8..58264cfbf 100644 --- a/Assistant/Alert.hs +++ b/Assistant/Alert.hs @@ -1,6 +1,6 @@ {- git-annex assistant alerts - - - Copyright 2012, 2013 Joey Hess <joey@kitenet.net> + - Copyright 2012-2014 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Threads/SanityChecker.hs b/Assistant/Threads/SanityChecker.hs index bdde1726d..8a513a43b 100644 --- a/Assistant/Threads/SanityChecker.hs +++ b/Assistant/Threads/SanityChecker.hs @@ -21,7 +21,6 @@ import Assistant.Ssh import Assistant.TransferQueue import Assistant.Types.UrlRenderer import qualified Annex.Branch -import qualified Git import qualified Git.LsFiles import qualified Git.Command import qualified Git.Config @@ -30,25 +29,21 @@ import qualified Assistant.Threads.Watcher as Watcher import Utility.LogFile import Utility.Batch import Utility.NotificationBroadcaster -import Utility.DiskFree import Config import Utility.HumanTime -import Utility.DataUnits +import Utility.Tense import Git.Repair import Git.Index +import Assistant.Unused import Logs.Unused -import Logs.Location import Logs.Transfer -import Annex.Content import Config.Files -import Types.Key import qualified Annex #ifdef WITH_WEBAPP import Assistant.WebApp.Types #endif import Data.Time.Clock.POSIX -import qualified Data.Map as M import qualified Data.Text as T {- This thread runs once at startup, and most other threads wait for it @@ -226,56 +221,19 @@ oneDay = 24 * oneHour - for the specified duration, and remove them. - - Otherwise, check to see if unused keys are piling up, and let the user - - know. 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. -} + - know. -} checkOldUnused :: UrlRenderer -> Assistant () checkOldUnused urlrenderer = go =<< annexExpireUnused <$> liftAnnex Annex.getGitConfig where go (Just Nothing) = noop - go (Just (Just expireunused)) = do - m <- liftAnnex $ readUnusedLog "" - now <- liftIO getPOSIXTime - let duration = durationToPOSIXTime expireunused - let oldkeys = M.keys $ M.filter (tooold now duration) m - forM_ oldkeys $ \k -> do - debug ["removing old unused key", key2file k] - liftAnnex $ do - removeAnnex k - logStatus k InfoMissing - go Nothing = maybe noop prompt - =<< toobig =<< liftAnnex (readUnusedLog "") - - tooold now duration (_, mt) = - maybe False (\t -> now - t >= duration) mt - - toobig m = do - let num = M.size m - let diskused = foldl' sumkeysize 0 (M.keys m) - df <- forpath getDiskFree - disksize <- forpath getDiskSize - return $ if moreused df diskused || tenthused disksize diskused - then Just $ roughSize storageUnits False diskused ++ - " is used by old files" - else if num > 1000 - then Just $ show num ++ " old files exist" - 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 (keySize k) - - forpath a = liftAnnex $ inRepo $ liftIO . a . Git.repoPath + go (Just (Just expireunused)) = expireUnused (Just expireunused) + go Nothing = maybe noop prompt =<< describeUnusedWhenBig prompt msg = #ifdef WITH_WEBAPP do - button <- mkAlertButton True (T.pack "Fix This") urlrenderer ConfigUnusedR - void $ addAlert $ unusedFilesAlert [button] msg + button <- mkAlertButton True (T.pack "Configure") urlrenderer ConfigUnusedR + void $ addAlert $ unusedFilesAlert [button] $ T.unpack $ renderTense Present msg #else debug [msg] #endif diff --git a/Assistant/Unused.hs b/Assistant/Unused.hs new file mode 100644 index 000000000..3ad98c12e --- /dev/null +++ b/Assistant/Unused.hs @@ -0,0 +1,86 @@ +{- git-annex assistant unused files + - + - Copyright 2014 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE OverloadedStrings #-} + +module Assistant.Unused where + +import qualified Data.Map as M + +import Assistant.Common +import qualified Git +import Types.Key +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 (keySize k) + + forpath a = inRepo $ liftIO . a . 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", key2file k] + liftAnnex $ do + removeAnnex k + logStatus k InfoMissing + where + boundry = durationToPOSIXTime <$> duration + tooold now (_, mt) = case boundry of + Nothing -> True + Just b -> maybe False (\t -> now - t >= b) mt |