diff options
| -rw-r--r-- | Annex/Content.hs | 23 | ||||
| -rw-r--r-- | Command/AddUrl.hs | 49 | ||||
| -rw-r--r-- | debian/changelog | 2 |
3 files changed, 42 insertions, 32 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 diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index 28f6ff741..043bda3fd 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -28,7 +28,6 @@ import Config import Annex.Content.Direct import Logs.Location import qualified Logs.Transfer as Transfer -import Utility.Daemon (checkDaemon) #ifdef WITH_QUVI import Annex.Quvi import qualified Utility.Quvi as Quvi @@ -153,44 +152,40 @@ addUrlFile relaxed url file = do download :: URLString -> FilePath -> Annex Bool download url file = do dummykey <- genkey - tmp <- fromRepo $ gitAnnexTmpLocation dummykey - showOutput - ifM (runtransfer dummykey tmp) - ( do - backend <- chooseBackend file - let source = KeySource - { keyFilename = file - , contentLocation = tmp - , inodeCache = Nothing - } - k <- genKey source backend - case k of - Nothing -> return False - Just (key, _) -> cleanup url file key (Just tmp) - , return False - ) + prepGetViaTmpChecked dummykey $ do + tmp <- fromRepo $ gitAnnexTmpLocation dummykey + showOutput + ifM (runtransfer dummykey tmp) + ( do + backend <- chooseBackend file + let source = KeySource + { keyFilename = file + , contentLocation = tmp + , inodeCache = Nothing + } + k <- genKey source backend + case k of + Nothing -> return False + Just (key, _) -> cleanup url file key (Just tmp) + , return False + ) where {- Generate a dummy key to use for this download, before we can - examine the file and find its real key. This allows resuming - downloads, as the dummy key for a given url is stable. - - - If the assistant is running, actually hits the url here, - - to get the size, so it can display a pretty progress bar. + - Actually hits the url here, to get the size. This is needed to + - avoid exceeding the diskreserve, and so the assistant can + - display a pretty progress bar. -} genkey = do - pidfile <- fromRepo gitAnnexPidFile - size <- ifM (liftIO $ isJust <$> checkDaemon pidfile) - ( do - headers <- getHttpHeaders - snd <$> Url.withUserAgent (Url.exists url headers) - , return Nothing - ) + headers <- getHttpHeaders + size <- snd <$> Url.withUserAgent (Url.exists url headers) Backend.URL.fromUrl url size runtransfer dummykey tmp = Transfer.download webUUID dummykey (Just file) Transfer.forwardRetry $ const $ do liftIO $ createDirectoryIfMissing True (parentDir tmp) downloadUrl [url] tmp - cleanup :: URLString -> FilePath -> Key -> Maybe FilePath -> Annex Bool cleanup url file key mtmp = do diff --git a/debian/changelog b/debian/changelog index bd5b459bc..28a11900b 100644 --- a/debian/changelog +++ b/debian/changelog @@ -15,6 +15,8 @@ git-annex (5.20131231) UNRELEASED; urgency=medium * assistant: Ensure that .ssh/config and .ssh/authorized_keys are not group or world writable when writing to those files, as that can make ssh refuse to use them, if it allows another user to write to them. + * addurl, importfeed: Honor annex.diskreserve as long as the size of the + url can be checked. -- Joey Hess <joeyh@debian.org> Tue, 31 Dec 2013 13:41:18 -0400 |