diff --git a/Git.hs b/Git.hs index 9420810a67..d8db471e90 100644 --- a/Git.hs +++ b/Git.hs @@ -29,7 +29,7 @@ module Git ( import qualified Data.Map as M import Data.Char -import Network.URI (uriPath, uriScheme) +import Network.URI (uriPath, uriScheme, unEscapeString) import Common import Git.Types @@ -107,7 +107,7 @@ gitDir repo - - Note that for URL repositories, this is the path on the remote host. -} workTree :: Repo -> FilePath -workTree Repo { location = Url u } = uriPath u +workTree Repo { location = Url u } = unEscapeString $ uriPath u workTree Repo { location = Dir d } = d workTree Repo { location = Unknown } = undefined diff --git a/Git/Construct.hs b/Git/Construct.hs index 2cc965b4ee..51fa656bc3 100644 --- a/Git/Construct.hs +++ b/Git/Construct.hs @@ -60,14 +60,23 @@ fromAbsPath dir where ret = return . newFrom . Dir -{- Remote Repo constructor. Throws exception on invalid url. -} +{- Remote Repo constructor. Throws exception on invalid url. + - + - Git is somewhat forgiving about urls to repositories, allowing + - eg spaces that are not normally allowed unescaped in urls. + -} fromUrl :: String -> IO Repo fromUrl url + | not (isURI url) = fromUrlStrict $ escapeURIString isUnescapedInURI url + | otherwise = fromUrlStrict url + +fromUrlStrict :: String -> IO Repo +fromUrlStrict url | startswith "file://" url = fromAbsPath $ uriPath u | otherwise = return $ newFrom $ Url u - where - u = fromMaybe bad $ parseURI url - bad = error $ "bad url " ++ url + where + u = fromMaybe bad $ parseURI url + bad = error $ "bad url " ++ url {- Creates a repo that has an unknown location. -} fromUnknown :: IO Repo @@ -117,7 +126,7 @@ fromRemoteLocation s repo = gen $ calcloc s where gen v | scpstyle v = fromUrl $ scptourl v - | isURI v = fromUrl v + | urlstyle v = fromUrl v | otherwise = fromRemotePath v repo -- insteadof config can rewrite remote location calcloc l @@ -137,6 +146,7 @@ fromRemoteLocation s repo = gen $ calcloc s M.toList $ fullconfig repo splitconfigs (k, vs) = map (\v -> (k, v)) vs (prefix, suffix) = ("url." , ".insteadof") + urlstyle v = isURI v || ":" `isInfixOf` v && "//" `isInfixOf` v -- git remotes can be written scp style -- [user@]host:dir scpstyle v = ":" `isInfixOf` v && not ("//" `isInfixOf` v) scptourl v = "ssh://" ++ host ++ slash dir diff --git a/debian/changelog b/debian/changelog index 721dde450a..e5687aac14 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +git-annex (3.20120106) UNRELEASED; urgency=low + + * Support unescaped repository urls, like git does. + + -- Joey Hess Thu, 05 Jan 2012 14:29:30 -0400 + git-annex (3.20120105) unstable; urgency=low * Added annex-web-options configuration settings, which can be