summaryrefslogtreecommitdiff
path: root/Utility/Url.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-03-10 23:00:33 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-03-10 23:00:33 -0400
commit3529ab26188f49250ca2b8d254594e72e4aaeabb (patch)
tree3ca4a1ee37146f6cd1bd80a02d8696f7a7bf2b09 /Utility/Url.hs
parent233e177f91a6ac504e94b32a6950bfd3d37d0c65 (diff)
addurl url escaping foo
* addurl: Escape invalid characters in urls, rather than failing to use an invalid url. * addurl: Properly handle url-escaped characters in file:// urls.
Diffstat (limited to 'Utility/Url.hs')
-rw-r--r--Utility/Url.hs26
1 files changed, 16 insertions, 10 deletions
diff --git a/Utility/Url.hs b/Utility/Url.hs
index 14a6f8f6f..f548f887c 100644
--- a/Utility/Url.hs
+++ b/Utility/Url.hs
@@ -17,7 +17,6 @@ module Utility.Url (
import Common
import Network.URI
-import Utility.CopyFile
type URLString = String
@@ -35,10 +34,10 @@ 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
+exists url headers = case parseURIRelaxed url of
Just u
| uriScheme u == "file:" -> do
- s <- catchMaybeIO $ getFileStatus (uriPath u)
+ s <- catchMaybeIO $ getFileStatus (unEscapeString $ uriPath u)
case s of
Just stat -> return (True, Just $ fromIntegral $ fileSize stat)
Nothing -> dne
@@ -71,15 +70,18 @@ exists url headers = case parseURI url of
- 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.
- -
- - For file:// urls, neither program works well, so we just copy.
-}
download :: URLString -> Headers -> [CommandParam] -> FilePath -> IO Bool
-download url headers options file
- | "file://" `isPrefixOf` url =
- let f = drop (length "file://") url
- in copyFileExternal f file
- | otherwise = ifM (inPath "wget") (wget , curl)
+download url headers options file =
+ case parseURIRelaxed url of
+ Just u
+ | uriScheme u == "file:" -> do
+ -- curl does not create destination file
+ -- for an empty file:// url, so pre-create
+ writeFile file ""
+ curl
+ | otherwise -> ifM (inPath "wget") (wget , curl)
+ _ -> return False
where
headerparams = map (\h -> Param $ "--header=" ++ h) headers
wget = go "wget" $ headerparams ++ [Params "-c -O"]
@@ -96,3 +98,7 @@ download url headers options file
get :: URLString -> Headers -> IO String
get url headers = readProcess "curl" $
["-s", "-L", url] ++ concatMap (\h -> ["-H", h]) headers
+
+{- Allows for spaces and other stuff in urls, properly escaping them. -}
+parseURIRelaxed :: URLString -> Maybe URI
+parseURIRelaxed = parseURI . escapeURIString isAllowedInURI