enableremote: Can now be used to explicitly enable git-annex to use git remotes. Using the command this way prevents other git-annex commands from probing new git remotes to auto-enable them.
This commit is contained in:
parent
afb332a142
commit
b33a649a25
3 changed files with 71 additions and 38 deletions
|
@ -1,6 +1,6 @@
|
|||
{- git-annex command
|
||||
-
|
||||
- Copyright 2013 Joey Hess <id@joeyh.name>
|
||||
- Copyright 2013-2016 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
@ -8,18 +8,22 @@
|
|||
module Command.EnableRemote where
|
||||
|
||||
import Command
|
||||
import qualified Annex
|
||||
import qualified Logs.Remote
|
||||
import qualified Types.Remote as R
|
||||
import qualified Git.Types as Git
|
||||
import qualified Annex.SpecialRemote
|
||||
import qualified Remote
|
||||
import qualified Types.Remote as Remote
|
||||
import qualified Remote.Git
|
||||
import Logs.UUID
|
||||
import Annex.UUID
|
||||
|
||||
import qualified Data.Map as M
|
||||
|
||||
cmd :: Command
|
||||
cmd = command "enableremote" SectionSetup
|
||||
"enables use of an existing special remote"
|
||||
"enables git-annex to use a remote"
|
||||
(paramPair paramName $ paramOptional $ paramRepeating paramKeyValue)
|
||||
(withParams seek)
|
||||
|
||||
|
@ -27,43 +31,62 @@ seek :: CmdParams -> CommandSeek
|
|||
seek = withWords start
|
||||
|
||||
start :: [String] -> CommandStart
|
||||
start [] = unknownNameError "Specify the special remote to enable."
|
||||
start (name:ws) = go =<< Annex.SpecialRemote.findExisting name
|
||||
start [] = unknownNameError "Specify the remote to enable."
|
||||
start (name:rest) = go =<< filter matchingname <$> Annex.fromRepo Git.remotes
|
||||
where
|
||||
config = Logs.Remote.keyValToConfig ws
|
||||
|
||||
go Nothing = do
|
||||
m <- Annex.SpecialRemote.specialRemoteMap
|
||||
confm <- Logs.Remote.readRemoteLog
|
||||
v <- Remote.nameToUUID' name
|
||||
case v of
|
||||
Right u | u `M.member` m ->
|
||||
go (Just (u, fromMaybe M.empty (M.lookup u confm)))
|
||||
_ -> unknownNameError "Unknown special remote."
|
||||
go (Just (u, c)) = do
|
||||
let fullconfig = config `M.union` c
|
||||
t <- either error return (Annex.SpecialRemote.findType fullconfig)
|
||||
showStart "enableremote" name
|
||||
gc <- maybe def Remote.gitconfig <$> Remote.byUUID u
|
||||
next $ perform t u fullconfig gc
|
||||
matchingname r = Git.remoteName r == Just name
|
||||
go [] = startSpecialRemote name (Logs.Remote.keyValToConfig rest)
|
||||
=<< Annex.SpecialRemote.findExisting name
|
||||
go (r:_) = startNormalRemote name r
|
||||
|
||||
type RemoteName = String
|
||||
|
||||
startNormalRemote :: RemoteName -> Git.Repo -> CommandStart
|
||||
startNormalRemote name r = do
|
||||
showStart "enableremote" name
|
||||
next $ next $ do
|
||||
r' <- Remote.Git.configRead False r
|
||||
u <- getRepoUUID r'
|
||||
return (u /= NoUUID)
|
||||
|
||||
startSpecialRemote :: RemoteName -> Remote.RemoteConfig -> Maybe (UUID, Remote.RemoteConfig) -> CommandStart
|
||||
startSpecialRemote name config Nothing = do
|
||||
m <- Annex.SpecialRemote.specialRemoteMap
|
||||
confm <- Logs.Remote.readRemoteLog
|
||||
v <- Remote.nameToUUID' name
|
||||
case v of
|
||||
Right u | u `M.member` m ->
|
||||
startSpecialRemote name config $
|
||||
Just (u, fromMaybe M.empty (M.lookup u confm))
|
||||
_ -> unknownNameError "Unknown remote name."
|
||||
startSpecialRemote name config (Just (u, c)) = do
|
||||
let fullconfig = config `M.union` c
|
||||
t <- either error return (Annex.SpecialRemote.findType fullconfig)
|
||||
showStart "enableremote" name
|
||||
gc <- maybe def Remote.gitconfig <$> Remote.byUUID u
|
||||
next $ performSpecialRemote t u fullconfig gc
|
||||
|
||||
performSpecialRemote :: RemoteType -> UUID -> R.RemoteConfig -> RemoteGitConfig -> CommandPerform
|
||||
performSpecialRemote t u c gc = do
|
||||
(c', u') <- R.setup t (Just u) Nothing c gc
|
||||
next $ cleanupSpecialRemote u' c'
|
||||
|
||||
cleanupSpecialRemote :: UUID -> R.RemoteConfig -> CommandCleanup
|
||||
cleanupSpecialRemote u c = do
|
||||
Logs.Remote.configSet u c
|
||||
return True
|
||||
|
||||
unknownNameError :: String -> Annex a
|
||||
unknownNameError prefix = do
|
||||
m <- Annex.SpecialRemote.specialRemoteMap
|
||||
descm <- M.unionWith Remote.addName <$> uuidMap <*> pure m
|
||||
msg <- if M.null m
|
||||
specialmsg <- if M.null m
|
||||
then pure "(No special remotes are currently known; perhaps use initremote instead?)"
|
||||
else Remote.prettyPrintUUIDsDescs
|
||||
"known special remotes"
|
||||
descm (M.keys m)
|
||||
error $ prefix ++ "\n" ++ msg
|
||||
|
||||
perform :: RemoteType -> UUID -> R.RemoteConfig -> RemoteGitConfig -> CommandPerform
|
||||
perform t u c gc = do
|
||||
(c', u') <- R.setup t (Just u) Nothing c gc
|
||||
next $ cleanup u' c'
|
||||
|
||||
cleanup :: UUID -> R.RemoteConfig -> CommandCleanup
|
||||
cleanup u c = do
|
||||
Logs.Remote.configSet u c
|
||||
return True
|
||||
nouuids <- filterM (\r -> (==) NoUUID <$> getRepoUUID r)
|
||||
=<< Annex.fromRepo Git.remotes
|
||||
let nouuidmsg = unlines $ map ("\t" ++) $
|
||||
mapMaybe Git.remoteName nouuids
|
||||
error $ concat $ filter (not . null) [prefix ++ "\n", nouuidmsg, specialmsg]
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue