status: Prints available local disk space, or shows if git-annex doesn't know.
This commit is contained in:
parent
181d2ccd20
commit
188e2edc41
4 changed files with 46 additions and 16 deletions
|
@ -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/
|
||||
|
|
|
@ -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
|
||||
|
|
21
Config.hs
21
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
|
||||
|
|
2
debian/changelog
vendored
2
debian/changelog
vendored
|
@ -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
|
||||
|
||||
|
|
Loading…
Reference in a new issue