diff options
| -rw-r--r-- | Annex/Content.hs | 18 | ||||
| -rw-r--r-- | Command/Status.hs | 21 | ||||
| -rw-r--r-- | Config.hs | 21 | ||||
| -rw-r--r-- | debian/changelog | 2 |
4 files changed, 46 insertions, 16 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs index 6bf5391df..1794fb5d9 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -177,11 +177,8 @@ checkDiskSpace = checkDiskSpace' 0 checkDiskSpace' :: Integer -> Key -> Annex () checkDiskSpace' adjustment key = do - g <- gitRepo - r <- getConfig g "diskreserve" "" - sanitycheck r - let reserve = fromMaybe megabyte $ readSize dataUnits r - stats <- liftIO $ getFileSystemStats (gitAnnexDir g) + reserve <- getDiskReserve True + stats <- inRepo $ getFileSystemStats .gitAnnexDir case (cancheck, stats, keySize key) of (False, _, _) -> return () (_, Nothing, _) -> return () @@ -190,22 +187,11 @@ checkDiskSpace' adjustment key = do when (need + reserve > have + adjustment) $ needmorespace (need + reserve - have - adjustment) where - megabyte :: Integer - megabyte = 1000000 needmorespace n = unlessM (Annex.getState Annex.force) $ error $ "not enough free space, need " ++ roughSize storageUnits True n ++ " more" ++ forcemsg forcemsg = " (use --force to override this check or adjust annex.diskreserve)" - sanitycheck r - | not (null r) && not cancheck = do - unlessM (Annex.getState Annex.force) $ - error $ "You have configured a diskreserve of " - ++ r ++ - " but disk space checking is not working" - ++ forcemsg - return () - | otherwise = return () cancheck = Build.SysConfig.statfs_sanity_checked == Just True {- Moves a file into .git/annex/objects/ diff --git a/Command/Status.hs b/Command/Status.hs index 39e71e750..576c3bba6 100644 --- a/Command/Status.hs +++ b/Command/Status.hs @@ -22,12 +22,15 @@ import qualified Git import qualified Annex import Command import Utility.DataUnits +import Utility.StatFS import Annex.Content import Types.Key import Backend import Logs.UUID import Logs.Trust import Remote +import Config +import qualified Build.SysConfig -- a named computation that produces a statistic type Stat = StatState (Maybe (String, StatState String)) @@ -76,6 +79,7 @@ slow_stats = , local_annex_size , known_annex_keys , known_annex_size + , disk_size , bloom_info , backend_usage ] @@ -157,6 +161,23 @@ known_annex_size :: Stat known_annex_size = stat "known annex size" $ json id $ showSizeKeys <$> cachedReferencedData +disk_size :: Stat +disk_size = stat "available local disk space" $ json id $ lift go + where + go + | Build.SysConfig.statfs_sanity_checked == Just True = + calcfree + <$> getDiskReserve False + <*> inRepo (getFileSystemStats . gitAnnexDir) + | otherwise = return unknown + calcfree reserve (Just (FileSystemStats { fsStatBytesAvailable = have })) = + roughSize storageUnits True $ unreserved reserve have + calcfree _ _ = unknown + unreserved reserve have + | have >= reserve = have - reserve + | otherwise = 0 + unknown = "unknown" + known_annex_keys :: Stat known_annex_keys = stat "known annex keys" $ json show $ countKeys <$> cachedReferencedData @@ -12,6 +12,8 @@ import qualified Git import qualified Git.Config import qualified Git.Command import qualified Annex +import qualified Build.SysConfig +import Utility.DataUnits type ConfigKey = String @@ -85,3 +87,22 @@ getNumCopies v = perhaps (use v) =<< Annex.getState Annex.forcenumcopies {- Gets the trust level set for a remote in git config. -} getTrustLevel :: Git.Repo -> Annex (Maybe String) getTrustLevel r = fromRepo $ Git.Config.getMaybe $ remoteConfig r "trustlevel" + +{- Gets annex.diskreserve setting. -} +getDiskReserve :: Bool -> Annex Integer +getDiskReserve sanitycheck = do + g <- gitRepo + r <- getConfig g "diskreserve" "" + when sanitycheck $ check r + return $ fromMaybe megabyte $ readSize dataUnits r + where + megabyte = 1000000 + check r + | not (null r) && not cancheck = do + unlessM (Annex.getState Annex.force) $ + error $ "You have configured a diskreserve of " + ++ r ++ + " but disk space checking is not working" + return () + | otherwise = return () + cancheck = Build.SysConfig.statfs_sanity_checked == Just True diff --git a/debian/changelog b/debian/changelog index cf732ab34..fe91ee4e9 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,6 +1,8 @@ git-annex (3.20120316) UNRELEASED; urgency=low * Improve detection of inability to check free disk space. + * status: Prints available local disk space, or shows if git-annex + doesn't know. -- Joey Hess <joeyh@debian.org> Wed, 21 Mar 2012 21:19:16 -0400 |