diff options
author | Joey Hess <joeyh@joeyh.name> | 2023-03-23 15:19:04 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2023-03-23 15:20:00 -0400 |
commit | a0badc5069f3b86cc283a181cc38ff31954280a8 (patch) | |
tree | 7981f79ff5c9fd41a27efb355160c1727551cd8e /Git | |
parent | 0e18bf029e6721b1c9665b0fbea6d281b9d65f7c (diff) |
sync: Fix parsing of gcrypt::rsync:// urls that use a relative path
Such an url is not valid; parseURI will fail on it. But git-annex doesn't
actually need to parse the url, because all it needs to do to support
syncing with it is know that it's not a local path, and use git pull and
push.
(Note that there is no good reason for the user to use such an url. An
absolute url is valid and I patched git-remote-gcrypt to support them
years ago. Still, users gonna do anything that tools allow, and
git-remote-gcrypt still supports them.)
Sponsored-by: Jack Hill on Patreon
Diffstat (limited to 'Git')
-rw-r--r-- | Git/Construct.hs | 14 | ||||
-rw-r--r-- | Git/GCrypt.hs | 10 | ||||
-rw-r--r-- | Git/Remote.hs | 18 |
3 files changed, 29 insertions, 13 deletions
diff --git a/Git/Construct.hs b/Git/Construct.hs index f82a3e91a1..d0b4f95582 100644 --- a/Git/Construct.hs +++ b/Git/Construct.hs @@ -140,7 +140,7 @@ fromRemotes repo = catMaybes <$> mapM construct remotepairs filterkeys f = filterconfig (\(k,_) -> f k) remotepairs = filterkeys isRemoteUrlKey construct (k,v) = remoteNamedFromKey k $ - fromRemoteLocation (fromConfigValue v) repo + fromRemoteLocation (fromConfigValue v) False repo {- Sets the name of a remote when constructing the Repo to represent it. -} remoteNamed :: String -> IO Repo -> IO Repo @@ -156,9 +156,15 @@ remoteNamedFromKey k r = case remoteKeyToRemoteName k of Just n -> Just <$> remoteNamed n r {- Constructs a new Repo for one of a Repo's remotes using a given - - location (ie, an url). -} -fromRemoteLocation :: String -> Repo -> IO Repo -fromRemoteLocation s repo = gen $ parseRemoteLocation s repo + - location (ie, an url). + - + - knownurl can be true if the location is known to be an url. This allows + - urls that don't parse as urls to be used, returning UnparseableUrl. + - If knownurl is false, the location may still be an url, if it parses as + - one. + -} +fromRemoteLocation :: String -> Bool -> Repo -> IO Repo +fromRemoteLocation s knownurl repo = gen $ parseRemoteLocation s knownurl repo where gen (RemotePath p) = fromRemotePath p repo gen (RemoteUrl u) = fromUrl u diff --git a/Git/GCrypt.hs b/Git/GCrypt.hs index 072598b755..07db13c1c0 100644 --- a/Git/GCrypt.hs +++ b/Git/GCrypt.hs @@ -55,7 +55,15 @@ encryptedRemote baserepo = go -- allows them); need to de-escape any such -- to get back the path to the repository. l' = Network.URI.unEscapeString l - in fromRemoteLocation l' baserepo + -- gcrypt supports relative urls for rsync + -- like "rsync://host:relative/path" + -- but that does not parse as a valid url + -- (while the absolute urls it supports are + -- valid). + -- In order to support it, force treating it as + -- an url. + knownurl = "rsync://" `isPrefixOf` l' + in fromRemoteLocation l' knownurl baserepo | otherwise = notencrypted notencrypted = giveup "not a gcrypt encrypted repository" diff --git a/Git/Remote.hs b/Git/Remote.hs index e6036a7b2c..9cdaad61ca 100644 --- a/Git/Remote.hs +++ b/Git/Remote.hs @@ -63,7 +63,7 @@ makeLegalName s = case filter legal $ replace "/" "_" s of legal c = isAlphaNum c data RemoteLocation = RemoteUrl String | RemotePath FilePath - deriving (Eq) + deriving (Eq, Show) remoteLocationIsUrl :: RemoteLocation -> Bool remoteLocationIsUrl (RemoteUrl _) = True @@ -75,16 +75,18 @@ remoteLocationIsSshUrl _ = False {- Determines if a given remote location is an url, or a local - path. Takes the repository's insteadOf configuration into account. -} -parseRemoteLocation :: String -> Repo -> RemoteLocation -parseRemoteLocation s repo = ret $ calcloc s +parseRemoteLocation :: String -> Bool -> Repo -> RemoteLocation +parseRemoteLocation s knownurl repo = go where - ret v + s' = calcloc s + go #ifdef mingw32_HOST_OS - | dosstyle v = RemotePath (dospath v) + | dosstyle s' = RemotePath (dospath s') #endif - | scpstyle v = RemoteUrl (scptourl v) - | urlstyle v = RemoteUrl v - | otherwise = RemotePath v + | scpstyle s' = RemoteUrl (scptourl s') + | urlstyle s' = RemoteUrl s' + | knownurl && s' == s = RemoteUrl s' + | otherwise = RemotePath s' -- insteadof config can rewrite remote location calcloc l | null insteadofs = l |