From 188e2edc41551fa145d6cb8b36838fcb85132088 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 21 Mar 2012 21:55:02 -0400
Subject: status: Prints available local disk space, or shows if git-annex
 doesn't know.

---
 Annex/Content.hs  | 18 ++----------------
 Command/Status.hs | 21 +++++++++++++++++++++
 Config.hs         | 21 +++++++++++++++++++++
 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
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
 
-- 
cgit v1.2.3