summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Annex/Content.hs18
-rw-r--r--Command/Status.hs21
-rw-r--r--Config.hs21
-rw-r--r--debian/changelog2
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
diff --git a/Config.hs b/Config.hs
index a93e2610e..aecf77a2a 100644
--- a/Config.hs
+++ b/Config.hs
@@ -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