summaryrefslogtreecommitdiff
path: root/Utility/Url.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-10-21 01:28:10 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-10-21 01:28:10 -0400
commit7c589b7462e7296c9fbbc6e0627bd3a8f8f0421c (patch)
tree2175c2039de5a9cb008bd4e1f9f9e216c9dcbc7e /Utility/Url.hs
parentb3431cb37b5b7aff11ce9a25102bf5446b59a18c (diff)
file:/// URLs can now be used with the web special remote.
Diffstat (limited to 'Utility/Url.hs')
-rw-r--r--Utility/Url.hs19
1 files changed, 14 insertions, 5 deletions
diff --git a/Utility/Url.hs b/Utility/Url.hs
index 6a45c559c..2f5cb27c2 100644
--- a/Utility/Url.hs
+++ b/Utility/Url.hs
@@ -37,10 +37,15 @@ check url headers expected_size = handle <$> exists url headers
{- Checks that an url exists and could be successfully downloaded,
- also returning its size if available. -}
exists :: URLString -> Headers -> IO (Bool, Maybe Integer)
-exists url headers =
- case parseURI url of
- Nothing -> return (False, Nothing)
- Just u -> do
+exists url headers = case parseURI url of
+ Nothing -> return (False, Nothing)
+ Just u
+ | uriScheme u == "file:" -> do
+ s <- catchMaybeIO $ getFileStatus (uriPath u)
+ return $ case s of
+ Nothing -> (False, Nothing)
+ Just stat -> (True, Just $ fromIntegral $ fileSize stat)
+ | otherwise -> do
r <- request u headers HEAD
case rspCode r of
(2,_,_) -> return (True, size r)
@@ -54,9 +59,13 @@ exists url headers =
- so is preferred.) Which program to use is determined at run time; it
- would not be appropriate to test at configure time and build support
- for only one in.
+ -
+ - Curl is always used for file:// urls, as wget does not support them.
-}
download :: URLString -> Headers -> [CommandParam] -> FilePath -> IO Bool
-download url headers options file = ifM (inPath "wget") (wget , curl)
+download url headers options file
+ | "file://" `isPrefixOf` url = curl
+ | otherwise = ifM (inPath "wget") (wget , curl)
where
headerparams = map (\h -> Param $ "--header=" ++ h) headers
wget = go "wget" $ headerparams ++ [Params "-c -O"]