diff --git a/Annex/Content.hs b/Annex/Content.hs index 7bb94aec2c..8542d8775d 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -36,7 +36,7 @@ import qualified Git import qualified Annex import qualified Annex.Queue import qualified Annex.Branch -import Utility.StatFS +import Utility.DiskFree import Utility.FileMode import qualified Utility.Url as Url import Types.Key @@ -44,7 +44,6 @@ import Utility.DataUnits import Utility.CopyFile import Config import Annex.Exception -import qualified Build.SysConfig {- Checks if a given key's content is currently present. -} inAnnex :: Key -> Annex Bool @@ -176,22 +175,19 @@ checkDiskSpace = checkDiskSpace' 0 checkDiskSpace' :: Integer -> Key -> Annex () checkDiskSpace' adjustment key = do - reserve <- getDiskReserve True - stats <- inRepo $ getFileSystemStats .gitAnnexDir - case (cancheck, stats, keySize key) of - (False, _, _) -> return () - (_, Nothing, _) -> return () - (_, _, Nothing) -> return () - (_, Just (FileSystemStats { fsStatBytesAvailable = have }), Just need) -> + reserve <- getDiskReserve + free <- inRepo $ getDiskFree . gitAnnexDir + case (free, keySize key) of + (Just have, Just need) -> when (need + reserve > have + adjustment) $ needmorespace (need + reserve - have - adjustment) + _ -> return () where 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)" - cancheck = Build.SysConfig.statfs_sanity_checked == Just True {- Moves a file into .git/annex/objects/ - diff --git a/Build/Configure.hs b/Build/Configure.hs index 14667ba860..341b8840dc 100644 --- a/Build/Configure.hs +++ b/Build/Configure.hs @@ -10,12 +10,8 @@ import Control.Applicative import Build.TestConfig import Utility.SafeCommand -tests :: Bool -> [TestCase] -tests True = cabaltests ++ common -tests False = common - -common :: [TestCase] -common = +tests :: [TestCase] +tests = [ TestCase "version" getVersion , TestCase "git" $ requireCmd "git" "git --version >/dev/null" , TestCase "git version" getGitVersion @@ -32,11 +28,6 @@ common = , TestCase "ssh connection caching" getSshConnectionCaching ] ++ shaTestCases [1, 256, 512, 224, 384] -cabaltests :: [TestCase] -cabaltests = - [ TestCase "StatFS" testStatFSDummy - ] - shaTestCases :: [Int] -> [TestCase] shaTestCases l = map make l where make n = @@ -81,10 +72,6 @@ getSshConnectionCaching :: Test getSshConnectionCaching = Config "sshconnectioncaching" . BoolConfig <$> boolSystem "sh" [Param "-c", Param "ssh -o ControlPersist=yes -V >/dev/null 2>/dev/null"] -testStatFSDummy :: Test -testStatFSDummy = - return $ Config "statfs_sanity_checked" $ MaybeBoolConfig Nothing - {- Set up cabal file with version. -} cabalSetup :: IO () cabalSetup = do diff --git a/Command/Status.hs b/Command/Status.hs index aaf8489054..40cefb5cc2 100644 --- a/Command/Status.hs +++ b/Command/Status.hs @@ -22,7 +22,7 @@ import qualified Git import qualified Annex import Command import Utility.DataUnits -import Utility.StatFS +import Utility.DiskFree import Annex.Content import Types.Key import Backend @@ -30,7 +30,6 @@ 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)) @@ -173,19 +172,16 @@ bloom_info = stat "bloom filter size" $ json id $ do disk_size :: Stat disk_size = stat "available local disk space" $ json id $ lift $ - if Build.SysConfig.statfs_sanity_checked == Just True - then calcfree - <$> getDiskReserve False - <*> inRepo (getFileSystemStats . gitAnnexDir) - else return unknown + calcfree + <$> getDiskReserve + <*> inRepo (getDiskFree . gitAnnexDir) where - calcfree reserve (Just (FileSystemStats { fsStatBytesAvailable = have })) = + calcfree reserve (Just have) = roughSize storageUnits True $ nonneg $ have - reserve - calcfree _ _ = unknown + calcfree _ _ = "unknown" nonneg x | x >= 0 = x | otherwise = 0 - unknown = "unknown" backend_usage :: Stat backend_usage = stat "backend usage" $ nojson $ diff --git a/Config.hs b/Config.hs index f202984852..10a66e47b1 100644 --- a/Config.hs +++ b/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 diff --git a/Makefile b/Makefile index ddb5e3ff6a..a0447f2d21 100644 --- a/Makefile +++ b/Makefile @@ -1,6 +1,6 @@ PREFIX=/usr IGNORE=-ignore-package monads-fd -BASEFLAGS=-Wall $(IGNORE) -outputdir tmp +BASEFLAGS=-Wall $(IGNORE) -outputdir tmp -IUtility GHCFLAGS=-O2 $(BASEFLAGS) ifdef PROFILE @@ -11,7 +11,8 @@ GHCMAKE=ghc $(GHCFLAGS) --make bins=git-annex mans=git-annex.1 git-annex-shell.1 -sources=Build/SysConfig.hs Utility/StatFS.hs Utility/Touch.hs +sources=Build/SysConfig.hs Utility/Touch.hs +clibs=Utility/diskfree.o all=$(bins) $(mans) docs @@ -28,15 +29,16 @@ sources: $(sources) fast: GHCFLAGS=$(BASEFLAGS) fast: $(bins) -Build/SysConfig.hs: configure.hs Build/TestConfig.hs Utility/StatFS.hs +Build/SysConfig.hs: configure.hs Build/TestConfig.hs Build/Configure.hs $(GHCMAKE) configure ./configure %.hs: %.hsc hsc2hs $< -$(bins): $(sources) - $(GHCMAKE) $@ + +git-annex: $(sources) $(clibs) + $(GHCMAKE) $@ $(clibs) git-annex.1: doc/git-annex.mdwn ./mdwn2man git-annex 1 doc/git-annex.mdwn > git-annex.1 @@ -92,7 +94,7 @@ docs: $(mans) clean: rm -rf tmp $(bins) $(mans) test configure *.tix .hpc $(sources) \ - doc/.ikiwiki html dist + doc/.ikiwiki html dist $(clibs) # Workaround for cabal sdist not running Setup hooks, so I cannot # generate a file list there. diff --git a/Utility/DiskFree.hs b/Utility/DiskFree.hs new file mode 100644 index 0000000000..e02794954d --- /dev/null +++ b/Utility/DiskFree.hs @@ -0,0 +1,32 @@ +{- disk free space checking + - + - Copyright 2012 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE ForeignFunctionInterface #-} + +module Utility.DiskFree ( getDiskFree ) where + +import Common + +import Foreign.C.Types +import Foreign.C.String +import Foreign.C.Error + +foreign import ccall unsafe "diskfree.h diskfree" c_diskfree + :: CString -> IO CULLong + +getDiskFree :: String -> IO (Maybe Integer) +getDiskFree path = withFilePath path $ \c_path -> do + free <- c_diskfree c_path + ifM (safeErrno <$> getErrno) + ( return $ Just $ toInteger free + , do + Errno i <- getErrno + print i + return Nothing + ) + where + safeErrno (Errno v) = v == 0 diff --git a/Utility/StatFS.hsc b/Utility/StatFS.hsc deleted file mode 100644 index ed4c9f1cb6..0000000000 --- a/Utility/StatFS.hsc +++ /dev/null @@ -1,128 +0,0 @@ ------------------------------------------------------------------------------ --- | --- --- (This code originally comes from xmobar) --- --- Module : StatFS --- Copyright : (c) Jose A Ortega Ruiz --- License : BSD-3-clause --- --- All rights reserved. --- --- Redistribution and use in source and binary forms, with or without --- modification, are permitted provided that the following conditions --- are met: --- --- 1. Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- 2. Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in the --- documentation and/or other materials provided with the distribution. --- 3. Neither the name of the author nor the names of his contributors --- may be used to endorse or promote products derived from this software --- without specific prior written permission. --- --- THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND --- ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE --- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE --- ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE --- FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL --- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS --- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) --- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT --- LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY --- OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF --- SUCH DAMAGE. --- --- Maintainer : Jose A Ortega Ruiz --- Stability : unstable --- Portability : unportable --- --- A binding to C's statvfs(2) --- ------------------------------------------------------------------------------ - -{-# LANGUAGE CPP, ForeignFunctionInterface, EmptyDataDecls #-} - - -module Utility.StatFS ( FileSystemStats(..), getFileSystemStats ) where - -import Utility.FileSystemEncoding - -import Foreign -import Foreign.C.Types -import Foreign.C.String - -#if defined (__FreeBSD__) || defined (__FreeBSD_kernel__) || defined (__APPLE__) -# include -# include -#else -#if defined (__linux__) -#include -#else -#define UNKNOWN -#endif -#endif - -data FileSystemStats = FileSystemStats { - fsStatBlockSize :: Integer - -- ^ Optimal transfer block size. - , fsStatBlockCount :: Integer - -- ^ Total data blocks in file system. - , fsStatByteCount :: Integer - -- ^ Total bytes in file system. - , fsStatBytesFree :: Integer - -- ^ Free bytes in file system. - , fsStatBytesAvailable :: Integer - -- ^ Free bytes available to non-superusers. - , fsStatBytesUsed :: Integer - -- ^ Bytes used. - } deriving (Show, Eq) - -data CStatfs - -#ifdef UNKNOWN -#warning free space checking code not available for this OS -#else -#if defined(__APPLE__) -foreign import ccall unsafe "sys/mount.h statfs64" -#else -#if defined(__FreeBSD__) || defined (__FreeBSD_kernel__) -foreign import ccall unsafe "sys/mount.h statfs" -#else -foreign import ccall unsafe "sys/vfs.h statfs64" -#endif -#endif - c_statfs :: CString -> Ptr CStatfs -> IO CInt -#endif - -toI :: CULong -> Integer -toI = toInteger - -getFileSystemStats :: String -> IO (Maybe FileSystemStats) -getFileSystemStats path = -#ifdef UNKNOWN - return Nothing -#else - allocaBytes (#size struct statfs) $ \vfs -> - withFilePath path $ \cpath -> do - res <- c_statfs cpath vfs - if res == -1 then return Nothing - else do - bsize <- (#peek struct statfs, f_bsize) vfs - bcount <- (#peek struct statfs, f_blocks) vfs - bfree <- (#peek struct statfs, f_bfree) vfs - bavail <- (#peek struct statfs, f_bavail) vfs - let bpb = toI bsize - let stats = FileSystemStats - { fsStatBlockSize = bpb - , fsStatBlockCount = toI bcount - , fsStatByteCount = toI bcount * bpb - , fsStatBytesFree = toI bfree * bpb - , fsStatBytesAvailable = toI bavail * bpb - , fsStatBytesUsed = toI (bcount - bfree) * bpb - } - if fsStatBlockCount stats == 0 || fsStatBlockSize stats == 0 - then return Nothing - else return $ Just stats -#endif diff --git a/Utility/diskfree.c b/Utility/diskfree.c new file mode 100644 index 0000000000..9ac31a752d --- /dev/null +++ b/Utility/diskfree.c @@ -0,0 +1,61 @@ +/* disk free space checking, C mini-library + * + * Copyright 2012 Joey Hess + * + * Licensed under the GNU GPL version 3 or higher. + */ + +/* Include appropriate headers for the OS, and define what will be used to + * check the free space. */ +#if defined(__APPLE__) +# include +# include +# define STATSTRUCT statfs +# define STATCALL statfs64 +#else +#if defined (__FreeBSD__) || defined (__FreeBSD_kernel__) +# include +# include +# define STATSTRUCT statfs +# define STATCALL statfs +#else +#if defined (__linux__) +# include +# define STATSTRUCT statvfs +# define STATCALL statvfs +#else +# warning free space checking code not available for this OS +# define UNKNOWN +#endif +#endif +#endif + +#include + +/* Checks the amount of disk that is available to regular (non-root) users. + * (If there's an error, or this is not supported, + * returns 0 and sets errno to nonzero.) + */ +unsigned long long int diskfree(const char *path) { +#ifdef UNKNOWN + errno = 1; + return 0; +#else + unsigned long long int available, blocksize; + struct STATSTRUCT buf; + + errno = 0; + if (STATCALL(path, &buf) != 0) + return 0; /* errno is set */ + + available = buf.f_bavail; + blocksize = buf.f_bsize; + return available * blocksize; +#endif +} + +/* +main () { + printf("%lli\n", diskfree(".")); +} +*/ diff --git a/Utility/diskfree.h b/Utility/diskfree.h new file mode 100644 index 0000000000..e5b84754fe --- /dev/null +++ b/Utility/diskfree.h @@ -0,0 +1 @@ +unsigned long long int diskfree(const char *path); diff --git a/configure.hs b/configure.hs index 6fdc5fcb03..15833e62a7 100644 --- a/configure.hs +++ b/configure.hs @@ -1,23 +1,6 @@ {- configure program -} -import Data.Maybe - -import qualified Build.Configure as Configure -import Build.TestConfig -import Utility.StatFS - -tests :: [TestCase] -tests = [ TestCase "StatFS" testStatFS - ] ++ Configure.tests False - -{- This test cannot be included in Build.Configure due to needing - - Utility/StatFS.hs to be built, which it is not when "cabal configure" - - is run. -} -testStatFS :: Test -testStatFS = do - s <- getFileSystemStats "." - return $ Config "statfs_sanity_checked" $ - MaybeBoolConfig $ Just $ isJust s +import Build.Configure main :: IO () -main = Configure.run tests +main = run tests diff --git a/debian/changelog b/debian/changelog index fe91ee4e9e..66e7b83a71 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,8 +1,7 @@ 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. + * Rewrote free disk space checking code, moving the portability + handling into a small C library. -- Joey Hess Wed, 21 Mar 2012 21:19:16 -0400 diff --git a/debian/copyright b/debian/copyright index 85fd174fc0..332c1e71d2 100644 --- a/debian/copyright +++ b/debian/copyright @@ -7,33 +7,3 @@ License: GPL-3+ The full text of version 3 of the GPL is distributed as doc/GPL in this package's source, or in /usr/share/common-licenses/GPL-3 on Debian systems. - -Files: Utility/StatFS.hsc -Copyright: Jose A Ortega Ruiz -License: BSD-3-clause - -- All rights reserved. - -- - -- Redistribution and use in source and binary forms, with or without - -- modification, are permitted provided that the following conditions - -- are met: - -- - -- 1. Redistributions of source code must retain the above copyright - -- notice, this list of conditions and the following disclaimer. - -- 2. Redistributions in binary form must reproduce the above copyright - -- notice, this list of conditions and the following disclaimer in the - -- documentation and/or other materials provided with the distribution. - -- 3. Neither the name of the author nor the names of his contributors - -- may be used to endorse or promote products derived from this software - -- without specific prior written permission. - -- - -- THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND - -- ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - -- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - -- ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE - -- FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL - -- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS - -- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) - -- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT - -- LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY - -- OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF - -- SUCH DAMAGE. diff --git a/git-annex.cabal b/git-annex.cabal index 881e4d212b..184f6323a0 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -1,5 +1,5 @@ Name: git-annex -Version: 3.20120315 +Version: 3.20120316 Cabal-Version: >= 1.6 License: GPL Maintainer: Joey Hess