{- 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.
-}
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]
-- 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)
{- 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.
-}
remoteNamed,
remoteNamedFromKey,
fromRemotes,
+ fromRemoteUrlRemotes,
fromRemoteLocation,
repoAbsPath,
checkForRepo,
- 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
| 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
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. -}