summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Annex/Content.hs1
-rw-r--r--Command/AddUrl.hs51
2 files changed, 30 insertions, 22 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs
index 99a2f6c28..316f05be0 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -222,7 +222,6 @@ 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 043bda3fd..7f3607b81 100644
--- a/Command/AddUrl.hs
+++ b/Command/AddUrl.hs
@@ -107,14 +107,21 @@ addUrlFileQuvi relaxed quviurl videourl file = do
ifM (pure relaxed <||> Annex.getState Annex.fast)
( cleanup quviurl file key Nothing
, do
- tmp <- fromRepo $ gitAnnexTmpLocation key
- showOutput
- ok <- Transfer.download webUUID key (Just file) Transfer.forwardRetry $ const $ do
- liftIO $ createDirectoryIfMissing True (parentDir tmp)
- downloadUrl [videourl] tmp
- if ok
- then cleanup quviurl file key (Just tmp)
- else return False
+ {- Get the size, and use that to check
+ - disk space. However, the size info is not
+ - retained, because the size of a video stream
+ - might change and we want to be able to download
+ - it later. -}
+ sizedkey <- addSizeUrlKey videourl key
+ prepGetViaTmpChecked sizedkey $ do
+ tmp <- fromRepo $ gitAnnexTmpLocation key
+ showOutput
+ ok <- Transfer.download webUUID key (Just file) Transfer.forwardRetry $ const $ do
+ liftIO $ createDirectoryIfMissing True (parentDir tmp)
+ downloadUrl [videourl] tmp
+ if ok
+ then cleanup quviurl file key (Just tmp)
+ else return False
)
#endif
@@ -151,7 +158,10 @@ addUrlFile relaxed url file = do
download :: URLString -> FilePath -> Annex Bool
download url file = do
- dummykey <- genkey
+ {- 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. -}
+ dummykey <- addSizeUrlKey url =<< Backend.URL.fromUrl url Nothing
prepGetViaTmpChecked dummykey $ do
tmp <- fromRepo $ gitAnnexTmpLocation dummykey
showOutput
@@ -170,23 +180,22 @@ download url file = do
, 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.
- -
- - 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
- 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
+{- Hits the url to get the size, if available.
+ -
+ - This is needed to avoid exceeding the diskreserve when downloading,
+ - and so the assistant can display a pretty progress bar.
+ -}
+addSizeUrlKey :: URLString -> Key -> Annex Key
+addSizeUrlKey url key = do
+ headers <- getHttpHeaders
+ size <- snd <$> Url.withUserAgent (Url.exists url headers)
+ return $ key { keySize = size }
+
cleanup :: URLString -> FilePath -> Key -> Maybe FilePath -> Annex Bool
cleanup url file key mtmp = do
when (isJust mtmp) $