map: Fix buggy handling of remotes that are bare git repositories accessed via ssh
authorJoey Hess <joeyh@joeyh.name>
Tue, 22 Apr 2025 19:08:49 +0000 (15:08 -0400)
committerJoey Hess <joeyh@joeyh.name>
Tue, 22 Apr 2025 19:21:01 +0000 (15:21 -0400)
It was treating remote paths of a remote repo as if they were local paths,
and so trying to expand git directories and so forth on them. That led to
bad results, including a path like "foo.git" getting turned into
"foo.git.git"

Sponsored-by: Dartmouth College's OpenNeuro project
CHANGELOG
Command/Map.hs
Git/Construct.hs
Remote/Bup.hs

index 080230a615455d1f564ff86812a55bab658c822b..71168b39d357525cbaea2e60d25ccfa3a6561b00 100644 (file)
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -1,3 +1,10 @@
+git-annex (10.20250417) UNRELEASED; urgency=medium
+
+  * map: Fix buggy handling of remotes that are bare git repositories
+    accessed via ssh.
+
+ -- Joey Hess <id@joeyh.name>  Tue, 22 Apr 2025 14:33:26 -0400
+
 git-annex (10.20250416) upstream; urgency=medium
 
   * Added the mask special remote.
index 41ce5f0b3ea5247cc0221152859c9b1b633ad9e0..ce28ca32c3ebb5070ec9966e23e0029b9bc2a63f 100644 (file)
@@ -1,6 +1,6 @@
 {- git-annex command
  -
- - Copyright 2010 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2025 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -154,7 +154,7 @@ trustDecorate trustmap u s = case M.lookup u trustmap of
        Just DeadTrusted -> Dot.fillColor "grey" s
        Nothing -> Dot.fillColor "white" s
 
-{- Recursively searches out remotes starting with the specified repo. -}
+{- Recursively searches out remotes starting with the specified local repo. -}
 spider :: Git.Repo -> Annex [RepoRemotes]
 spider r = spider' [r] []
 spider' :: [Git.Repo] -> [RepoRemotes] -> Annex [RepoRemotes]
@@ -166,15 +166,18 @@ spider' (r:rs) known
 
                -- The remotes will be relative to r', and need to be
                -- made absolute for later use.
-               remotes <- mapM (absRepo r')
-                       =<< (liftIO $ Git.Construct.fromRemotes r')
-       
+               remotes <- mapM (absRepo r') =<<
+                       if Git.repoIsUrl r
+                               then liftIO $ Git.Construct.fromRemoteUrlRemotes r'
+                               else liftIO $ Git.Construct.fromRemotes r'
+
                spider' (rs ++ remotes) ((r', remotes):known)
 
 {- Converts repos to a common absolute form. -}
 absRepo :: Git.Repo -> Git.Repo -> Annex Git.Repo
 absRepo reference r
-       | Git.repoIsUrl reference = return $ Git.Construct.localToUrl reference r
+       | Git.repoIsUrl reference = return $
+               Git.Construct.localToUrl reference r
        | Git.repoIsUrl r = return r
        | otherwise = liftIO $ do
                r' <- Git.Construct.fromPath =<< absPath (Git.repoPath r)
index 3d503a5ebce55cf72ba4acfef76fbaf71e8ea845..3d37e137c6c439bcf67c5fa93ae8ea8bcd520017 100644 (file)
@@ -1,6 +1,6 @@
 {- Construction of Git Repo objects
  -
- - Copyright 2010-2023 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2025 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -18,6 +18,7 @@ module Git.Construct (
        remoteNamed,
        remoteNamedFromKey,
        fromRemotes,
+       fromRemoteUrlRemotes,
        fromRemoteLocation,
        repoAbsPath,
        checkForRepo,
@@ -97,14 +98,15 @@ fromAbsPath dir
  - or is invalid, because git can also function despite remotes having
  - such urls, only failing if such a remote is used.
  -}
-fromUrl :: String -> IO Repo
-fromUrl url
-       | not (isURI url) = fromUrl' $ escapeURIString isUnescapedInURI url
-       | otherwise = fromUrl' url
+fromUrl :: Bool -> String -> IO Repo
+fromUrl fileurlislocal url
+       | not (isURI url) = fromUrl' fileurlislocal $
+               escapeURIString isUnescapedInURI url
+       | otherwise = fromUrl' fileurlislocal url
 
-fromUrl' :: String -> IO Repo
-fromUrl' url
-       | "file://" `isPrefixOf` url = case parseURIPortable url of
+fromUrl' :: Bool -> String -> IO Repo
+fromUrl' fileurlislocal url
+       | "file://" `isPrefixOf` url && fileurlislocal = case parseURIPortable url of
                Just u -> fromAbsPath $ toOsPath $ unEscapeString $ uriPath u
                Nothing -> pure $ newFrom $ UnparseableUrl url
        | otherwise = case parseURIPortable url of
@@ -123,24 +125,41 @@ localToUrl reference r
        | repoIsUrl r = r
        | otherwise = case (Url.authority reference, Url.scheme reference) of
                (Just auth, Just s) -> 
-                       let absurl = concat
+                       let referencepath = fromMaybe "" $ Url.path reference
+                           absurl = concat
                                [ s
                                , "//"
                                , auth
-                               , fromOsPath (repoPath r)
+                               , fromOsPath $
+                                       toOsPath referencepath </> repoPath r
                                ]
                        in r { location = Url $ fromJust $ parseURIPortable absurl }
                _ -> r
 
 {- Calculates a list of a repo's configured remotes, by parsing its config. -}
 fromRemotes :: Repo -> IO [Repo]
-fromRemotes repo = catMaybes <$> mapM construct remotepairs
+fromRemotes = fromRemotes' fromRemoteLocation
+
+fromRemotes' :: (String -> Bool -> Repo -> IO Repo) -> Repo -> IO [Repo]
+fromRemotes' fromremotelocation repo = catMaybes <$> mapM construct remotepairs
   where
        filterconfig f = filter f $ M.toList $ config repo
        filterkeys f = filterconfig (\(k,_) -> f k)
        remotepairs = filterkeys isRemoteUrlKey
        construct (k,v) = remoteNamedFromKey k $
-               fromRemoteLocation (fromConfigValue v) False repo
+               fromremotelocation (fromConfigValue v) False repo
+
+{- Calculates a list of a remote repo's configured remotes, by parsing its
+ - config. Unlike fromRemotes, this does not do any local path checking. 
+ - The remote repo must have an url path. -}
+fromRemoteUrlRemotes :: Repo -> IO [Repo]
+fromRemoteUrlRemotes = fromRemotes' go
+  where
+       go s knownurl repo = 
+               case parseRemoteLocation s knownurl repo of
+                       RemotePath p -> pure $ localToUrl repo $ 
+                               newFrom $ LocalUnknown $ toOsPath p
+                       RemoteUrl u -> fromUrl False u
 
 {- Sets the name of a remote when constructing the Repo to represent it. -}
 remoteNamed :: String -> IO Repo -> IO Repo
@@ -167,7 +186,7 @@ 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
+       gen (RemoteUrl u) = fromUrl True u
 
 {- Constructs a Repo from the path specified in the git remotes of
  - another Repo. -}
index 5003608acd51124e71c15e552c421cb7a1e06d4b..d98901d441184ae3e16d406fad010f4e0b4a0daa 100644 (file)
@@ -304,7 +304,7 @@ bup2GitRemote r
                if "/" `isPrefixOf` r
                        then Git.Construct.fromPath (toOsPath r)
                        else giveup "please specify an absolute path"
-       | otherwise = Git.Construct.fromUrl $ "ssh://" ++ host ++ slash dir
+       | otherwise = Git.Construct.fromUrl False $ "ssh://" ++ host ++ slash dir
   where
        bits = splitc ':' r
        host = fromMaybe "" $ headMaybe bits