diff options
| -rw-r--r-- | Assistant/Alert.hs | 2 | ||||
| -rw-r--r-- | Assistant/Threads/SanityChecker.hs | 56 | ||||
| -rw-r--r-- | Assistant/Unused.hs | 86 | ||||
| -rw-r--r-- | Logs/Unused.hs | 8 | ||||
| -rw-r--r-- | Utility/HumanTime.hs | 15 | ||||
| -rw-r--r-- | doc/assistant/unused.png | bin | 0 -> 49957 bytes |
6 files changed, 116 insertions, 51 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 diff --git a/Logs/Unused.hs b/Logs/Unused.hs index cdfcd2165..0af319f04 100644 --- a/Logs/Unused.hs +++ b/Logs/Unused.hs @@ -20,9 +20,10 @@ module Logs.Unused ( updateUnusedLog, readUnusedLog, readUnusedMap, + dateUnusedLog, unusedKeys, + unusedKeys', setUnusedKeys, - unusedKeys' ) where import qualified Data.Map as M @@ -88,6 +89,11 @@ readUnusedLog prefix = do readUnusedMap :: FilePath -> Annex UnusedMap readUnusedMap = log2map <$$> readUnusedLog +dateUnusedLog :: FilePath -> Annex (Maybe UTCTime) +dateUnusedLog prefix = do + f <- fromRepo $ gitAnnexUnusedLog prefix + liftIO $ catchMaybeIO $ getModificationTime f + {- Set of unused keys. This is cached for speed. -} unusedKeys :: Annex (S.Set Key) unusedKeys = maybe (setUnusedKeys =<< unusedKeys') return diff --git a/Utility/HumanTime.hs b/Utility/HumanTime.hs index 644e6fbab..297b2bd97 100644 --- a/Utility/HumanTime.hs +++ b/Utility/HumanTime.hs @@ -7,7 +7,10 @@ module Utility.HumanTime ( Duration(..), + durationSince, durationToPOSIXTime, + durationToDays, + daysToDuration, parseDuration, fromDuration, prop_duration_roundtrips @@ -17,6 +20,7 @@ import Utility.PartialPrelude import Utility.Applicative import Utility.QuickCheck +import Data.Time.Clock import Data.Time.Clock.POSIX (POSIXTime) import Data.Char import Control.Applicative @@ -25,9 +29,20 @@ import qualified Data.Map as M newtype Duration = Duration { durationSeconds :: Integer } deriving (Eq, Ord, Read, Show) +durationSince :: UTCTime -> IO Duration +durationSince pasttime = do + now <- getCurrentTime + return $ Duration $ round $ diffUTCTime now pasttime + durationToPOSIXTime :: Duration -> POSIXTime durationToPOSIXTime = fromIntegral . durationSeconds +durationToDays :: Duration -> Integer +durationToDays d = durationSeconds d `div` dsecs + +daysToDuration :: Integer -> Duration +daysToDuration i = Duration $ i * dsecs + {- Parses a human-input time duration, of the form "5h", "1m", "5h1m", etc -} parseDuration :: String -> Maybe Duration parseDuration = Duration <$$> go 0 diff --git a/doc/assistant/unused.png b/doc/assistant/unused.png Binary files differnew file mode 100644 index 000000000..b0ace763c --- /dev/null +++ b/doc/assistant/unused.png |
