Rewrote free disk space checking code
Moving the portability handling into a small C library cleans up things a lot, avoiding the pain of unpacking structs from inside haskell code.
This commit is contained in:
parent
f1398b5583
commit
e38a839a80
13 changed files with 124 additions and 237 deletions
18
Config.hs
18
Config.hs
|
@ -12,7 +12,6 @@ import qualified Git
|
|||
import qualified Git.Config
|
||||
import qualified Git.Command
|
||||
import qualified Annex
|
||||
import qualified Build.SysConfig
|
||||
import Utility.DataUnits
|
||||
|
||||
type ConfigKey = String
|
||||
|
@ -92,19 +91,8 @@ 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
|
||||
r <- getConfig "diskreserve" ""
|
||||
when sanitycheck $ check r
|
||||
return $ fromMaybe megabyte $ readSize dataUnits r
|
||||
getDiskReserve :: Annex Integer
|
||||
getDiskReserve = fromMaybe megabyte . readSize dataUnits
|
||||
<$> getConfig "diskreserve" ""
|
||||
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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue