summaryrefslogtreecommitdiff
path: root/Annex/Content.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2014-01-04 15:08:06 -0400
committerGravatar Joey Hess <joey@kitenet.net>2014-01-04 15:08:06 -0400
commit009d7172cf29aabac762c6e8afccdb04aa3c5a49 (patch)
treec123f69144083e32079976485c29348b501c1800 /Annex/Content.hs
parent4e64bcbbdb970bc82dc9d47a174cb2296141880c (diff)
addurl, importfeed: Honor annex.diskreserve as long as the size of the url can be checked.
This adds a http HEAD before the download is done. That was already the case when the assistant was running, and it seems worth it to avoid filling up the whole disk, like happened to my server today.
Diffstat (limited to 'Annex/Content.hs')
-rw-r--r--Annex/Content.hs23
1 files changed, 18 insertions, 5 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs
index 62f1b1ccb..99a2f6c28 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -15,6 +15,7 @@ module Annex.Content (
getViaTmp,
getViaTmpChecked,
getViaTmpUnchecked,
+ prepGetViaTmpChecked,
withTmp,
checkDiskSpace,
moveAnnex,
@@ -158,20 +159,31 @@ getViaTmpUnchecked :: Key -> (FilePath -> Annex Bool) -> Annex Bool
getViaTmpUnchecked = finishGetViaTmp (return True)
getViaTmpChecked :: Annex Bool -> Key -> (FilePath -> Annex Bool) -> Annex Bool
-getViaTmpChecked check key action = do
+getViaTmpChecked check key action =
+ prepGetViaTmpChecked key $
+ finishGetViaTmp check key action
+
+{- Prepares to download a key via a tmp file, and checks that there is
+ - enough free disk space.
+ -
+ - When the temp file already exists, count the space it is using as
+ - free, since the download will overwrite it or resume.
+ -
+ - Wen there's enough free space, runs the download action.
+ -}
+prepGetViaTmpChecked :: Key -> Annex Bool -> Annex Bool
+prepGetViaTmpChecked key getkey = do
tmp <- fromRepo $ gitAnnexTmpLocation 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
alreadythere <- if e
then fromIntegral . fileSize <$> liftIO (getFileStatus tmp)
else return 0
ifM (checkDiskSpace Nothing key alreadythere)
( do
+ -- The tmp file may not have been left writable
when e $ thawContent tmp
- finishGetViaTmp check key action
+ getkey
, return False
)
@@ -210,6 +222,7 @@ checkDiskSpace destination key alreadythere = do
reserve <- annexDiskReserve <$> Annex.getGitConfig
free <- liftIO . getDiskFree =<< dir
force <- Annex.getState Annex.force
+ liftIO $ print (free, keySize key)
case (free, keySize key) of
(Just have, Just need) -> do
let ok = (need + reserve <= have + alreadythere) || force