diff options
Diffstat (limited to 'Git/Remote.hs')
| -rw-r--r-- | Git/Remote.hs | 65 |
1 files changed, 41 insertions, 24 deletions
diff --git a/Git/Remote.hs b/Git/Remote.hs index 69d6b52..9cdaad6 100644 --- a/Git/Remote.hs +++ b/Git/Remote.hs @@ -1,6 +1,6 @@ {- git remote stuff - - - Copyright 2012 Joey Hess <id@joeyh.name> + - Copyright 2012-2021 Joey Hess <id@joeyh.name> - - Licensed under the GNU AGPL version 3 or higher. -} @@ -23,19 +23,27 @@ import Network.URI import Git.FilePath #endif -{- Is a git config key one that specifies the location of a remote? -} -isRemoteKey :: ConfigKey -> Bool -isRemoteKey (ConfigKey k) = "remote." `S.isPrefixOf` k && ".url" `S.isSuffixOf` k +{- Is a git config key one that specifies the url of a remote? -} +isRemoteUrlKey :: ConfigKey -> Bool +isRemoteUrlKey = isRemoteKey "url" -{- Get a remote's name from the config key that specifies its location. -} -remoteKeyToRemoteName :: ConfigKey -> RemoteName -remoteKeyToRemoteName (ConfigKey k) = decodeBS' $ - S.intercalate "." $ dropFromEnd 1 $ drop 1 $ S8.split '.' k +isRemoteKey :: S.ByteString -> ConfigKey -> Bool +isRemoteKey want (ConfigKey k) = + "remote." `S.isPrefixOf` k && ("." <> want) `S.isSuffixOf` k + +{- Get a remote's name from the a config key such as remote.name.url + - or any other per-remote config key. -} +remoteKeyToRemoteName :: ConfigKey -> Maybe RemoteName +remoteKeyToRemoteName (ConfigKey k) + | "remote." `S.isPrefixOf` k = + let n = S.intercalate "." $ dropFromEnd 1 $ drop 1 $ S8.split '.' k + in if S.null n then Nothing else Just (decodeBS n) + | otherwise = Nothing {- Construct a legal git remote name out of an arbitrary input string. - - There seems to be no formal definition of this in the git source, - - just some ad-hoc checks, and some other things that fail with certian + - just some ad-hoc checks, and some other things that fail with certain - types of names (like ones starting with '-'). -} makeLegalName :: String -> RemoteName @@ -55,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 @@ -67,34 +75,43 @@ 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 | otherwise = replacement ++ drop (S.length bestvalue) l where - replacement = decodeBS' $ S.drop (S.length prefix) $ + replacement = decodeBS $ S.drop (S.length prefix) $ S.take (S.length bestkey - S.length suffix) bestkey - (ConfigKey bestkey, ConfigValue bestvalue) = maximumBy longestvalue insteadofs + (bestkey, bestvalue) = + case maximumBy longestvalue insteadofs of + (ConfigKey k, ConfigValue v) -> (k, v) + (ConfigKey k, NoConfigValue) -> (k, mempty) longestvalue (_, a) (_, b) = compare b a - insteadofs = filterconfig $ \(ConfigKey k, ConfigValue v) -> - prefix `S.isPrefixOf` k && - suffix `S.isSuffixOf` k && - v `S.isPrefixOf` encodeBS l + insteadofs = filterconfig $ \case + (ConfigKey k, ConfigValue v) -> + prefix `S.isPrefixOf` k && + suffix `S.isSuffixOf` k && + v `S.isPrefixOf` encodeBS l + (_, NoConfigValue) -> False filterconfig f = filter f $ concatMap splitconfigs $ 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 supports URIs that contain unescaped characters such as + -- spaces. So to test if it's a (git) URI, escape those. + urlstyle v = isURI (escapeURIString isUnescapedInURI v) -- git remotes can be written scp style -- [user@]host:dir -- but foo::bar is a git-remote-helper location instead scpstyle v = ":" `isInfixOf` v |