diff options
| -rw-r--r-- | .gitignore | 1 | ||||
| -rw-r--r-- | Annex.hs | 2 | ||||
| -rw-r--r-- | Backend/SHA.hs | 3 | ||||
| -rw-r--r-- | Command/Migrate.hs | 2 | ||||
| -rw-r--r-- | Command/SetKey.hs | 3 | ||||
| -rw-r--r-- | Command/Unlock.hs | 2 | ||||
| -rw-r--r-- | Command/Unused.hs | 27 | ||||
| -rw-r--r-- | Command/Upgrade.hs | 2 | ||||
| -rw-r--r-- | Content.hs | 50 | ||||
| -rw-r--r-- | Makefile | 2 | ||||
| -rw-r--r-- | Options.hs | 3 | ||||
| -rw-r--r-- | StatFS.hsc | 121 | ||||
| -rw-r--r-- | Upgrade/V0.hs | 2 | ||||
| -rw-r--r-- | Upgrade/V1.hs | 5 | ||||
| -rw-r--r-- | debian/changelog | 17 | ||||
| -rw-r--r-- | debian/copyright | 4 | ||||
| -rw-r--r-- | doc/bugs/free_space_checking.mdwn | 3 | ||||
| -rw-r--r-- | doc/git-annex.mdwn | 14 |
18 files changed, 248 insertions, 15 deletions
diff --git a/.gitignore b/.gitignore index 69d2c8070..aa677c133 100644 --- a/.gitignore +++ b/.gitignore @@ -12,3 +12,4 @@ html *.tix .hpc Touch.hs +StatFS.hs @@ -40,6 +40,7 @@ data AnnexState = AnnexState , repoqueue :: GitQueue.Queue , quiet :: Bool , force :: Bool + , fast :: Bool , defaultbackend :: Maybe String , defaultkey :: Maybe String , toremote :: Maybe String @@ -56,6 +57,7 @@ newState gitrepo allbackends = AnnexState , repoqueue = GitQueue.empty , quiet = False , force = False + , fast = False , defaultbackend = Nothing , defaultkey = Nothing , toremote = Nothing diff --git a/Backend/SHA.hs b/Backend/SHA.hs index 056385107..0ec555ce3 100644 --- a/Backend/SHA.hs +++ b/Backend/SHA.hs @@ -80,9 +80,10 @@ keyValue size file = do checkKeyChecksum :: SHASize -> Key -> Annex Bool checkKeyChecksum size key = do g <- Annex.gitRepo + fast <- Annex.getState Annex.fast let file = gitAnnexLocation g key present <- liftIO $ doesFileExist file - if not present + if (not present || fast) then return True else do s <- shaN size file diff --git a/Command/Migrate.hs b/Command/Migrate.hs index 584f6e34e..56147113b 100644 --- a/Command/Migrate.hs +++ b/Command/Migrate.hs @@ -55,7 +55,7 @@ perform file oldkey newbackend = do case stored of Nothing -> return Nothing Just (newkey, _) -> do - ok <- getViaTmp newkey $ \t -> do + ok <- getViaTmpUnchecked newkey $ \t -> do -- Make a hard link to the old backend's -- cached key, to avoid wasting disk space. liftIO $ createLink src t diff --git a/Command/SetKey.hs b/Command/SetKey.hs index af46fe06e..6f6078e4b 100644 --- a/Command/SetKey.hs +++ b/Command/SetKey.hs @@ -32,7 +32,8 @@ perform :: FilePath -> CommandPerform perform file = do key <- cmdlineKey -- the file might be on a different filesystem, so mv is used - -- rather than simply calling moveToObjectDir + -- rather than simply calling moveToObjectDir; disk space is also + -- checked this way. ok <- getViaTmp key $ \dest -> do if dest /= file then liftIO $ diff --git a/Command/Unlock.hs b/Command/Unlock.hs index ac7b22ac7..bf593e1e9 100644 --- a/Command/Unlock.hs +++ b/Command/Unlock.hs @@ -41,6 +41,8 @@ perform dest key = do inbackend <- Backend.hasKey key when (not inbackend) $ error "content not present" + + checkDiskSpace key g <- Annex.gitRepo let src = gitAnnexLocation g key diff --git a/Command/Unused.hs b/Command/Unused.hs index a1c4ee03c..518e98656 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -44,7 +44,6 @@ perform = do checkUnused :: Annex Bool checkUnused = do - showNote "checking for unused data..." (unused, staletmp) <- unusedKeys let unusedlist = number 0 unused let staletmplist = number (length unused) staletmp @@ -81,17 +80,27 @@ number n (x:xs) = (n+1, x):(number (n+1) xs) unusedKeys :: Annex ([Key], [Key]) unusedKeys = do g <- Annex.gitRepo - present <- getKeysPresent - referenced <- getKeysReferenced - tmps <- tmpKeys - let (unused, staletmp, duptmp) = calcUnusedKeys present referenced tmps + fast <- Annex.getState Annex.fast + if fast + then do + showNote "fast mode enabled; assuming all temporary files are unused" + tmps <- tmpKeys + return ([], tmps) + else do + showNote "checking for unused data..." + present <- getKeysPresent + referenced <- getKeysReferenced + tmps <- tmpKeys + + let (unused, staletmp, duptmp) = calcUnusedKeys present referenced tmps - -- Tmp files that are dups of content already present can simply - -- be removed. - liftIO $ forM_ duptmp $ \t -> removeFile $ gitAnnexTmpLocation g t + -- Tmp files that are dups of content already present + -- can simply be removed. + liftIO $ forM_ duptmp $ \t -> removeFile $ + gitAnnexTmpLocation g t - return (unused, staletmp) + return (unused, staletmp) calcUnusedKeys :: [Key] -> [Key] -> [Key] -> ([Key], [Key], [Key]) calcUnusedKeys present referenced tmps = (unused, staletmp, duptmp) diff --git a/Command/Upgrade.hs b/Command/Upgrade.hs index 94398c70a..880a5324f 100644 --- a/Command/Upgrade.hs +++ b/Command/Upgrade.hs @@ -10,6 +10,7 @@ module Command.Upgrade where import Command import Upgrade import Version +import Messages command :: [Command] command = [standaloneCommand "upgrade" paramNothing seek @@ -20,6 +21,7 @@ seek = [withNothing start] start :: CommandStartNothing start = do + showStart "upgrade" "" r <- upgrade checkVersion return $ Just $ return $ Just $ return r diff --git a/Content.hs b/Content.hs index 4bd8265c2..39a3addcc 100644 --- a/Content.hs +++ b/Content.hs @@ -10,6 +10,8 @@ module Content ( calcGitLink, logStatus, getViaTmp, + getViaTmpUnchecked, + checkDiskSpace, preventWrite, allowWrite, moveAnnex, @@ -35,6 +37,8 @@ import UUID import qualified GitRepo as Git import qualified Annex import Utility +import StatFS +import Key {- Checks if a given key is currently present in the gitAnnexLocation. -} inAnnex :: Key -> Annex Bool @@ -75,6 +79,27 @@ getViaTmp :: Key -> (FilePath -> Annex Bool) -> Annex Bool getViaTmp key action = do g <- Annex.gitRepo let tmp = gitAnnexTmpLocation g key + + -- Check that there is enough free disk space. + -- When the temp file already exists, count the space + -- it is using as free. + e <- liftIO $ doesFileExist tmp + if e + then do + stat <- liftIO $ getFileStatus tmp + checkDiskSpace' (fromIntegral $ fileSize stat) key + else checkDiskSpace key + + getViaTmpUnchecked key action + +{- Like getViaTmp, but does not check that there is enough disk space + - for the incoming key. For use when the key content is already on disk + - and not being copied into place. -} +getViaTmpUnchecked :: Key -> (FilePath -> Annex Bool) -> Annex Bool +getViaTmpUnchecked key action = do + g <- Annex.gitRepo + let tmp = gitAnnexTmpLocation g key + liftIO $ createDirectoryIfMissing True (parentDir tmp) success <- action tmp if success @@ -87,6 +112,31 @@ getViaTmp key action = do -- to resume its transfer return False +{- Checks that there is disk space available to store a given key, + - throwing an error if not. -} +checkDiskSpace :: Key -> Annex () +checkDiskSpace = checkDiskSpace' 0 + +checkDiskSpace' :: Integer -> Key -> Annex () +checkDiskSpace' adjustment key = do + g <- Annex.gitRepo + r <- Annex.repoConfig g "diskreserve" "" + let reserve = if null r then megabyte else (read r :: Integer) + stats <- liftIO $ getFileSystemStats (gitAnnexDir g) + case (stats, keySize key) of + (Nothing, _) -> return () + (_, Nothing) -> return () + (Just (FileSystemStats { fsStatBytesAvailable = have }), Just need) -> + if (need + reserve > have + adjustment) + then error $ "not enough free space (have " ++ + showsize (have + adjustment) ++ "; need " ++ + showsize (need + reserve) ++ ")" + else return () + where + showsize i = show i + megabyte :: Integer + megabyte = 1024 * 1024 + {- Removes the write bits from a file. -} preventWrite :: FilePath -> IO () preventWrite f = unsetFileMode f writebits @@ -11,7 +11,7 @@ SysConfig.hs: configure.hs TestConfig.hs $(GHCMAKE) configure ./configure -Touch.hs: Touch.hsc +%.hs: %.hsc hsc2hs $< perl -i -pe 's/^{-# INCLUDE.*//' $@ diff --git a/Options.hs b/Options.hs index 4cd62c222..10c3714e4 100644 --- a/Options.hs +++ b/Options.hs @@ -22,6 +22,8 @@ commonOptions :: [Option] commonOptions = [ Option ['f'] ["force"] (NoArg (setforce True)) "allow actions that may lose annexed data" + , Option ['F'] ["fast"] (NoArg (setfast True)) + "avoid slow operations" , Option ['q'] ["quiet"] (NoArg (setquiet True)) "avoid verbose output" , Option ['v'] ["verbose"] (NoArg (setquiet False)) @@ -31,5 +33,6 @@ commonOptions = ] where setforce v = Annex.changeState $ \s -> s { Annex.force = v } + setfast v = Annex.changeState $ \s -> s { Annex.fast = v } setquiet v = Annex.changeState $ \s -> s { Annex.quiet = v } setdefaultbackend v = Annex.changeState $ \s -> s { Annex.defaultbackend = Just v } diff --git a/StatFS.hsc b/StatFS.hsc new file mode 100644 index 000000000..8b453dc19 --- /dev/null +++ b/StatFS.hsc @@ -0,0 +1,121 @@ +----------------------------------------------------------------------------- +-- | +-- +-- (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 <jao@gnu.org> +-- Stability : unstable +-- Portability : unportable +-- +-- A binding to C's statvfs(2) +-- +----------------------------------------------------------------------------- + +{-# LANGUAGE CPP, ForeignFunctionInterface, EmptyDataDecls #-} + + +module StatFS ( FileSystemStats(..), getFileSystemStats ) where + +import Foreign +import Foreign.C.Types +import Foreign.C.String +import Data.ByteString (useAsCString) +import Data.ByteString.Char8 (pack) + +#if defined (__FreeBSD__) +# include <sys/param.h> +# include <sys/mount.h> +#else +#if defined (__linux__) +#include <sys/vfs.h> +#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(__FreeBSD__) +foreign import ccall unsafe "sys/mount.h statfs" +#else +foreign import ccall unsafe "sys/vfs.h statfs64" +#endif + c_statfs :: CString -> Ptr CStatfs -> IO CInt +#endif + +toI :: CLong -> Integer +toI = toInteger + +getFileSystemStats :: String -> IO (Maybe FileSystemStats) +getFileSystemStats path = +#ifdef UNKNOWN + return Nothing +#else + allocaBytes (#size struct statfs) $ \vfs -> + useAsCString (pack 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 + return $ Just FileSystemStats + { fsStatBlockSize = bpb + , fsStatBlockCount = toI bcount + , fsStatByteCount = toI bcount * bpb + , fsStatBytesFree = toI bfree * bpb + , fsStatBytesAvailable = toI bavail * bpb + , fsStatBytesUsed = toI (bcount - bfree) * bpb + } +#endif diff --git a/Upgrade/V0.hs b/Upgrade/V0.hs index 5ba305817..eabd03009 100644 --- a/Upgrade/V0.hs +++ b/Upgrade/V0.hs @@ -23,7 +23,7 @@ import qualified Upgrade.V1 upgrade :: Annex Bool upgrade = do - showSideAction "Upgrading object directory layout v0 to v1..." + showNote "v0 to v1..." g <- Annex.gitRepo -- do the reorganisation of the key files diff --git a/Upgrade/V1.hs b/Upgrade/V1.hs index 43f279ad0..c0470a3bc 100644 --- a/Upgrade/V1.hs +++ b/Upgrade/V1.hs @@ -55,7 +55,7 @@ import qualified Command.Init upgrade :: Annex Bool upgrade = do - showSideAction "Upgrading object directory layout v1 to v2..." + showNote "v1 to v2" g <- Annex.gitRepo if Git.repoIsLocalBare g @@ -78,6 +78,7 @@ upgrade = do moveContent :: Annex () moveContent = do + showNote "moving content..." keys <- getKeysPresent1 forM_ keys move where @@ -92,6 +93,7 @@ moveContent = do updateSymlinks :: Annex () updateSymlinks = do + showNote "updating symlinks..." g <- Annex.gitRepo files <- liftIO $ Git.inRepo g [Git.workTree g] forM_ files $ fixlink @@ -109,6 +111,7 @@ updateSymlinks = do moveLocationLogs :: Annex () moveLocationLogs = do + showNote "moving location logs..." logkeys <- oldlocationlogs forM_ logkeys move where diff --git a/debian/changelog b/debian/changelog index eb8d73504..88e0986a9 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,20 @@ +git-annex (0.20110321) UNRELEASED; urgency=low + + * Free space checking is now done, for transfers of data for keys + that have free space metadata. (Notably, not for SHA* keys generated + with git-annex 0.24 or earlier.) The code is believed to work on + Linux, FreeBSD, and OSX; check compile-time messages to see if it + is not enabled for your OS. + * Add annex.diskreserve config setting, to control how much free space + to reserve for other purposes and avoid using (defaults to 1 mb). + * Add --fast flag, that can enable less expensive, but also less thurough + versions of some commands. + * fsck: In fast mode, avoid checking checksums. + * unused: In fast mode, just show all existing temp files as unused, + and avoid expensive scan for other unused content. + + -- Joey Hess <joeyh@debian.org> Tue, 22 Mar 2011 16:52:00 -0400 + git-annex (0.20110320) experimental; urgency=low * Fix dropping of files using the URL backend. diff --git a/debian/copyright b/debian/copyright index 90e26b752..2144501e1 100644 --- a/debian/copyright +++ b/debian/copyright @@ -7,3 +7,7 @@ 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: StatFS.hsc +Copyright: Jose A Ortega Ruiz <jao@gnu.org> +License: BSD-3-clause diff --git a/doc/bugs/free_space_checking.mdwn b/doc/bugs/free_space_checking.mdwn index eaa3294d6..92e8be40d 100644 --- a/doc/bugs/free_space_checking.mdwn +++ b/doc/bugs/free_space_checking.mdwn @@ -16,3 +16,6 @@ file around. find files that lack size info, and rename their keys to add the size info. Users with old repos can run this on them, to get the missing info recorded. + +> [[done]]; no migtation process for old SHA1 keys from v1 repo though. +> --[[Joey]] diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 1e4af022f..3cf408939 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -278,6 +278,12 @@ Many git-annex commands will stage changes for later `git commit` by you. Force unsafe actions, such as dropping a file's content when no other source of it can be verified to still exist. Use with care. +* --fast + + Enables less expensive, but also less thorough versions of some commands. + What is avoided depends on the command. A fast fsck avoids calculating + checksums; a fast unused only shows temp files and not other unused files. + * --quiet Avoid the default verbose logging of what is done; only show errors @@ -371,6 +377,14 @@ Here are all the supported configuration settings. Default ssh and rsync options to use if a remote does not have specific options. +* `annex.diskreserve` + + Amount of disk space to reserve. Disk space is checked when transferring + content to avoid running out, and additional free space can be reserved + via this option, to make space for more important content (such as git + commit logs). The units are bytes. + The default reserve is 1048576 (1 megabyte). + * `annex.version` Automatically maintained, and used to automate upgrades between versions. |