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.
This commit is contained in:
Joey Hess 2013-03-10 23:00:33 -04:00
parent eedd248371
commit 0ecd05c28d
3 changed files with 21 additions and 11 deletions

View file

@ -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

3
debian/changelog vendored
View file

@ -43,6 +43,9 @@ git-annex (4.20130228) UNRELEASED; urgency=low
* bugfix: drop --from an unavailable remote no longer updates the location
log, incorrectly, to say the remote does not have the key.
* assistant: Generate better commits for renames.
* addurl: Escape invalid characters in urls, rather than failing to
use an invalid url.
* addurl: Properly handle url-escaped characters in file:// urls.
-- Joey Hess <joeyh@debian.org> Wed, 27 Feb 2013 23:20:40 -0400

View file

@ -25,4 +25,5 @@ Debian sid/experimental
supported repository versions: 3 4
upgrade supported from repository versions: 0 1 2
> Relaxed url parsing so this will work, and also in http:// urls etc.
> [[done]] --[[Joey]]