git-lfs: remember urls, and autoenable remotes using known urls
* git-lfs: The url provided to initremote/enableremote will now be stored in the git-annex branch, allowing enableremote to be used without an url. initremote --sameas can be used to add additional urls. * git-lfs: When there's a git remote with an url that's known to be used for git-lfs, automatically enable the special remote.
This commit is contained in:
Joey Hess
parent
d06b5bcd7b
commit
5877de5e80
9 changed files with 141 additions and 46 deletions
|
|
@ -143,7 +143,9 @@ configRead autoinit r = do
|
|||
(True, _, _)
|
||||
| remoteAnnexCheckUUID gc -> tryGitConfigRead autoinit r
|
||||
| otherwise -> return r
|
||||
(False, _, NoUUID) -> tryGitConfigRead autoinit r
|
||||
(False, _, NoUUID) -> configSpecialGitRemotes r >>= \case
|
||||
Nothing -> tryGitConfigRead autoinit r
|
||||
Just r' -> return r'
|
||||
_ -> return r
|
||||
|
||||
gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
|
||||
|
|
@ -231,7 +233,7 @@ repoAvail r
|
|||
tryGitConfigRead :: Bool -> Git.Repo -> Annex Git.Repo
|
||||
tryGitConfigRead autoinit r
|
||||
| haveconfig r = return r -- already read
|
||||
| Git.repoIsSsh r = store $ do
|
||||
| Git.repoIsSsh r = storeUpdatedRemote $ do
|
||||
v <- Ssh.onRemote NoConsumeStdin r
|
||||
(pipedconfig, return (Left $ giveup "configlist failed"))
|
||||
"configlist" [] configlistfields
|
||||
|
|
@ -240,10 +242,10 @@ tryGitConfigRead autoinit r
|
|||
| haveconfig r' -> return r'
|
||||
| otherwise -> configlist_failed
|
||||
Left _ -> configlist_failed
|
||||
| Git.repoIsHttp r = store geturlconfig
|
||||
| Git.repoIsHttp r = storeUpdatedRemote geturlconfig
|
||||
| Git.GCrypt.isEncrypted r = handlegcrypt =<< getConfigMaybe (remoteConfig r "uuid")
|
||||
| Git.repoIsUrl r = return r
|
||||
| otherwise = store $ liftIO $
|
||||
| otherwise = storeUpdatedRemote $ liftIO $
|
||||
readlocalannexconfig `catchNonAsync` (const $ return r)
|
||||
where
|
||||
haveconfig = not . M.null . Git.config
|
||||
|
|
@ -278,18 +280,6 @@ tryGitConfigRead autoinit r
|
|||
set_ignore "not usable by git-annex" False
|
||||
return r
|
||||
|
||||
store = observe $ \r' -> do
|
||||
l <- Annex.getGitRemotes
|
||||
let rs = exchange l r'
|
||||
Annex.changeState $ \s -> s { Annex.gitremotes = Just rs }
|
||||
|
||||
exchange [] _ = []
|
||||
exchange (old:ls) new
|
||||
| Git.remoteName old == Git.remoteName new =
|
||||
new : exchange ls new
|
||||
| otherwise =
|
||||
old : exchange ls new
|
||||
|
||||
{- Is this remote just not available, or does
|
||||
- it not have git-annex-shell?
|
||||
- Find out by trying to fetch from the remote. -}
|
||||
|
|
@ -319,7 +309,7 @@ tryGitConfigRead autoinit r
|
|||
g <- gitRepo
|
||||
case Git.GCrypt.remoteRepoId g (Git.remoteName r) of
|
||||
Nothing -> return r
|
||||
Just v -> store $ liftIO $ setUUID r $
|
||||
Just v -> storeUpdatedRemote $ liftIO $ setUUID r $
|
||||
genUUIDInNameSpace gCryptNameSpace v
|
||||
|
||||
{- The local repo may not yet be initialized, so try to initialize
|
||||
|
|
@ -337,6 +327,31 @@ tryGitConfigRead autoinit r
|
|||
then [(Fields.autoInit, "1")]
|
||||
else []
|
||||
|
||||
{- Handles special remotes that can be enabled by the presence of
|
||||
- regular git remotes.
|
||||
-
|
||||
- When a remote repo is found to be such a special remote, its
|
||||
- UUID is cached in the git config, and the repo returned with
|
||||
- the UUID set.
|
||||
-}
|
||||
configSpecialGitRemotes :: Git.Repo -> Annex (Maybe Git.Repo)
|
||||
configSpecialGitRemotes r = Remote.GitLFS.configKnownUrl r >>= \case
|
||||
Nothing -> return Nothing
|
||||
Just r' -> Just <$> storeUpdatedRemote (return r')
|
||||
|
||||
storeUpdatedRemote :: Annex Git.Repo -> Annex Git.Repo
|
||||
storeUpdatedRemote = observe $ \r' -> do
|
||||
l <- Annex.getGitRemotes
|
||||
let rs = exchange l r'
|
||||
Annex.changeState $ \s -> s { Annex.gitremotes = Just rs }
|
||||
where
|
||||
exchange [] _ = []
|
||||
exchange (old:ls) new
|
||||
| Git.remoteName old == Git.remoteName new =
|
||||
new : exchange ls new
|
||||
| otherwise =
|
||||
old : exchange ls new
|
||||
|
||||
{- Checks if a given remote has the content for a key in its annex. -}
|
||||
inAnnex :: Remote -> State -> Key -> Annex Bool
|
||||
inAnnex rmt st key = do
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@
|
|||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
||||
module Remote.GitLFS (remote, gen) where
|
||||
module Remote.GitLFS (remote, gen, configKnownUrl) where
|
||||
|
||||
import Annex.Common
|
||||
import Types.Remote
|
||||
|
|
@ -13,9 +13,11 @@ import Annex.Url
|
|||
import Types.Key
|
||||
import Types.Creds
|
||||
import qualified Annex
|
||||
import qualified Annex.SpecialRemote.Config
|
||||
import qualified Git
|
||||
import qualified Git.Types as Git
|
||||
import qualified Git.Url
|
||||
import qualified Git.Remote
|
||||
import qualified Git.GCrypt
|
||||
import qualified Git.Credential as Git
|
||||
import Config
|
||||
|
|
@ -31,8 +33,10 @@ import Crypto
|
|||
import Backend.Hash
|
||||
import Utility.Hash
|
||||
import Utility.SshHost
|
||||
import Logs.Remote
|
||||
import Logs.RemoteState
|
||||
import qualified Utility.GitLFS as LFS
|
||||
import qualified Git.Config
|
||||
|
||||
import Control.Concurrent.STM
|
||||
import Data.String
|
||||
|
|
@ -145,21 +149,46 @@ mySetup _ mu _ c gc = do
|
|||
, "likely insecure configuration.)"
|
||||
]
|
||||
|
||||
-- The url is not stored in the remote log, because the same
|
||||
-- git-lfs repo can be accessed using different urls by different
|
||||
-- people (eg over ssh or http).
|
||||
--
|
||||
-- Instead, set up remote.name.url to point to the repo,
|
||||
-- Set up remote.name.url to point to the repo,
|
||||
-- (so it's also usable by git as a non-special remote),
|
||||
-- and set remote.name.git-lfs = true
|
||||
let c'' = M.delete "url" c'
|
||||
gitConfigSpecialRemote u c'' [("git-lfs", "true")]
|
||||
-- and set remote.name.annex-git-lfs = true
|
||||
gitConfigSpecialRemote u c' [("git-lfs", "true")]
|
||||
setConfig (ConfigKey ("remote." ++ getRemoteName c ++ ".url")) url
|
||||
return (c'', u)
|
||||
return (c', u)
|
||||
where
|
||||
url = fromMaybe (giveup "Specify url=") (M.lookup "url" c)
|
||||
remotename = fromJust (lookupName c)
|
||||
|
||||
{- Check if a remote's url is one known to belong to a git-lfs repository.
|
||||
- If so, set the necessary configuration to enable using the remote
|
||||
- with git-lfs. -}
|
||||
configKnownUrl :: Git.Repo -> Annex (Maybe Git.Repo)
|
||||
configKnownUrl r
|
||||
| Git.repoIsUrl r = do
|
||||
l <- readRemoteLog
|
||||
g <- Annex.gitRepo
|
||||
case Annex.SpecialRemote.Config.findByRemoteConfig (match g) l of
|
||||
((u, _, mcu):[]) -> Just <$> go u mcu
|
||||
_ -> return Nothing
|
||||
| otherwise = return Nothing
|
||||
where
|
||||
match g c = fromMaybe False $ do
|
||||
t <- M.lookup Annex.SpecialRemote.Config.typeField c
|
||||
u <- M.lookup "url" c
|
||||
let u' = Git.Remote.parseRemoteLocation u g
|
||||
return $ Git.Remote.RemoteUrl (Git.repoLocation r) == u'
|
||||
&& t == typename remote
|
||||
go u mcu = do
|
||||
r' <- set "uuid" (fromUUID u) =<< set "git-lfs" "true" r
|
||||
case mcu of
|
||||
Just (Annex.SpecialRemote.Config.ConfigFrom cu) ->
|
||||
set "config-uuid" (fromUUID cu) r'
|
||||
Nothing -> return r'
|
||||
set k v r' = do
|
||||
let ck@(ConfigKey k') = remoteConfig r' k
|
||||
setConfig ck v
|
||||
return $ Git.Config.store' k' v r'
|
||||
|
||||
data LFSHandle = LFSHandle
|
||||
{ downloadEndpoint :: Maybe LFS.Endpoint
|
||||
, uploadEndpoint :: Maybe LFS.Endpoint
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue