diff options
| -rw-r--r-- | Annex/Content.hs | 13 | ||||
| -rw-r--r-- | Makefile | 4 | ||||
| -rw-r--r-- | configure.hs | 8 | ||||
| -rw-r--r-- | debian/changelog | 5 | ||||
| -rw-r--r-- | git-annex.cabal | 2 |
5 files changed, 28 insertions, 4 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs index 1713b5e12..ba67a2f15 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -177,6 +177,7 @@ checkDiskSpace' adjustment key = do r <- getConfig g "diskreserve" "" let reserve = fromMaybe megabyte $ readSize dataUnits r stats <- liftIO $ getFileSystemStats (gitAnnexDir g) + sanitycheck r stats case (stats, keySize key) of (Nothing, _) -> return () (_, Nothing) -> return () @@ -189,7 +190,17 @@ checkDiskSpace' adjustment key = do needmorespace n = unlessM (Annex.getState Annex.force) $ error $ "not enough free space, need " ++ roughSize storageUnits True n ++ - " more (use --force to override this check or adjust annex.diskreserve)" + " more" ++ forcemsg + forcemsg = " (use --force to override this check or adjust annex.diskreserve)" + sanitycheck r stats + | not (null r) && isNothing stats = 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 () {- Moves a file into .git/annex/objects/ - @@ -21,11 +21,13 @@ endif all: $(all) +sources: $(sources) + # Disables optimisation. Not for production use. fast: GHCFLAGS=-Wall $(IGNORE) fast: $(bins) -Build/SysConfig.hs: configure.hs Build/TestConfig.hs +Build/SysConfig.hs: configure.hs Build/TestConfig.hs Utility/StatFS.hs $(GHCMAKE) configure ./configure diff --git a/configure.hs b/configure.hs index 3b3626dd2..772df3e38 100644 --- a/configure.hs +++ b/configure.hs @@ -2,9 +2,11 @@ import System.Directory import Data.List +import Data.Maybe import System.Cmd.Utils import Build.TestConfig +import Utility.StatFS tests :: [TestCase] tests = @@ -21,6 +23,7 @@ tests = , TestCase "wget" $ testCmd "wget" "wget --version >/dev/null" , TestCase "bup" $ testCmd "bup" "bup --version >/dev/null" , TestCase "gpg" $ testCmd "gpg" "gpg --version >/dev/null" + , TestCase "StatFS" testStatFS ] ++ shaTestCases [1, 256, 512, 224, 384] shaTestCases :: [Int] -> [TestCase] @@ -63,6 +66,11 @@ getGitVersion = do let version = last $ words $ head $ lines s return $ Config "gitversion" (StringConfig version) +testStatFS :: Test +testStatFS = do + s <- getFileSystemStats "." + return $ Config "statfs_sane" $ BoolConfig $ isJust s + {- Set up cabal file with version. -} cabalSetup :: IO () cabalSetup = do diff --git a/debian/changelog b/debian/changelog index b8b0d7327..2e9468d8c 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,6 +1,9 @@ git-annex (3.20120114) UNRELEASED; urgency=low - * Add a sanity check for bad StatFS results. + * Add a sanity check for bad StatFS results. On architectures + where StatFS does not currently work (s390, mips, powerpc, sparc), + this disables the diskreserve checking code, and attempting to + configure an annex.diskreserve will result in an error. -- Joey Hess <joeyh@debian.org> Sat, 14 Jan 2012 17:12:04 -0400 diff --git a/git-annex.cabal b/git-annex.cabal index 4aee161b6..aaa773a3d 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -1,5 +1,5 @@ Name: git-annex -Version: 3.20120113 +Version: 3.20120114 Cabal-Version: >= 1.6 License: GPL Maintainer: Joey Hess <joey@kitenet.net> |