annex.diskreserve can be given in arbitrary units (ie "0.5 gigabytes")

This commit is contained in:
Joey Hess 2011-03-26 14:37:39 -04:00
parent ceb9593a9c
commit 8bcdf42b99
5 changed files with 27 additions and 12 deletions

View file

@ -198,6 +198,6 @@ checkKeySize key = do
else do
dest <- moveBad key
warning $ "Bad file size (" ++
compareSizes True size size' ++
compareSizes storageUnits True size size' ++
"); moved to " ++ dest
return False

View file

@ -122,7 +122,9 @@ 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)
let reserve = case readSize dataUnits r of
Nothing -> megabyte
Just v -> v
stats <- liftIO $ getFileSystemStats (gitAnnexDir g)
case (stats, keySize key) of
(Nothing, _) -> return ()
@ -133,12 +135,12 @@ checkDiskSpace' adjustment key = do
else return ()
where
megabyte :: Integer
megabyte = 1024 * 1024
megabyte = 1000000
needmorespace n = do
force <- Annex.getState Annex.force
unless force $
error $ "not enough free space, need " ++
roughSize True n ++
roughSize storageUnits True n ++
" more (use --force to override this check or adjust annex.diskreserve)"
{- Removes the write bits from a file. -}

View file

@ -11,7 +11,8 @@ module DataUnits (
memoryUnits,
oldSchoolUnits,
roughSize,
compareSizes
compareSizes,
readSize
) where
import Data.List
@ -53,6 +54,7 @@ data Unit = Unit ByteSize Abbrev Name
- progress?
-}
dataUnits :: [Unit]
dataUnits = storageUnits ++ memoryUnits
{- Storage units are (stupidly) powers of ten. -}
@ -69,6 +71,7 @@ storageUnits =
, Unit (p 0) "B" "byte"
]
where
p :: Integer -> Integer
p n = 1000^n
{- Memory units are (stupidly named) powers of 2. -}
@ -85,12 +88,14 @@ memoryUnits =
, Unit (p 0) "B" "byte"
]
where
p :: Integer -> Integer
p n = 2^(n*10)
{- Do you yearn for the days when men were men and megabytes were megabytes? -}
oldSchoolUnits :: [Unit]
oldSchoolUnits = map mingle $ zip storageUnits memoryUnits
where
mingle (Unit s a n, Unit s' a' n') = Unit s' a n
mingle (Unit _ a n, Unit s' _ _) = Unit s' a n
{- approximate display of a particular number of bytes -}
roughSize :: [Unit] -> Bool -> ByteSize -> String
@ -124,8 +129,8 @@ compareSizes units abbrev old new
| otherwise = "same"
{- Parses strings like "10 kilobytes" or "0.5tb". -}
readSize :: String -> [Unit] -> Maybe ByteSize
readSize s units
readSize :: [Unit] -> String -> Maybe ByteSize
readSize units input
| null parsednum = Nothing
| null parsedunit = Nothing
| otherwise = Just $ round $ number * (fromIntegral multiplier)
@ -133,14 +138,14 @@ readSize s units
(number, rest) = head parsednum
multiplier = head $ parsedunit
parsednum = reads s :: [(Double, String)]
parsednum = reads input :: [(Double, String)]
parsedunit = lookupUnit units unit
unit = takeWhile isAlpha $ dropWhile isSpace rest
lookupUnit _ [] = [1] -- no unit given, assume bytes
lookupUnit [] _ = []
lookupUnit (u@(Unit s a n):us) v
lookupUnit (Unit s a n:us) v
| a ~~ v || n ~~ v = [s]
| plural n ~~ v || a ~~ byteabbrev v = [s]
| otherwise = lookupUnit us v

6
debian/changelog vendored
View file

@ -1,3 +1,9 @@
git-annex (0.20110326) UNRELEASED; urgency=low
* annex.diskreserve can be given in arbitrary units (ie "0.5 gigabytes")
-- Joey Hess <joeyh@debian.org> Sat, 26 Mar 2011 14:36:16 -0400
git-annex (0.20110325) experimental; urgency=low
* Free space checking is now done, for transfers of data for keys

View file

@ -387,8 +387,10 @@ Here are all the supported configuration settings.
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).
commit logs). Can be specified with any commonly used units, for example,
"0.5 gb" or "100 KiloBytes"
The default reserve is 1 megabyte.
* `annex.version`