diff options
| -rw-r--r-- | Command/Migrate.hs | 2 | ||||
| -rw-r--r-- | Command/SetKey.hs | 3 | ||||
| -rw-r--r-- | Command/Unlock.hs | 2 | ||||
| -rw-r--r-- | Content.hs | 51 | ||||
| -rw-r--r-- | debian/changelog | 10 | ||||
| -rw-r--r-- | doc/bugs/free_space_checking.mdwn | 3 |
6 files changed, 69 insertions, 2 deletions
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/Content.hs b/Content.hs index 4bd8265c2..596274ad0 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,32 @@ 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 + liftIO $ putStrLn $ "adjust " ++ show adjustment + g <- Annex.gitRepo + stats <- liftIO $ getFileSystemStats (gitAnnexDir g) + case (stats, keySize key) of + (Nothing, _) -> return () + (_, Nothing) -> return () + (Just (FileSystemStats { fsStatBytesAvailable = have }), Just need) -> + if (need + overhead >= have + adjustment) + then error $ "not enough free space (have " ++ + showsize (have + adjustment) ++ "; need " ++ + showsize (need + overhead) ++ ")" + else return () + where + showsize i = show i + -- Adding a file to the annex requires some overhead beyond + -- just the file size; the git index must be updated, etc. + -- This is an arbitrary value. + overhead = 1024 * 1024 -- 1 mb + {- Removes the write bits from a file. -} preventWrite :: FilePath -> IO () preventWrite f = unsetFileMode f writebits diff --git a/debian/changelog b/debian/changelog index eb8d73504..a5830884a 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,13 @@ +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. + + -- 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/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]] |