factor out getRemoteGitConfig

This commit is contained in:
Joey Hess 2014-05-16 16:08:20 -04:00
parent dd6b32e9a2
commit c34b5e09f8
6 changed files with 22 additions and 21 deletions

View file

@ -28,6 +28,7 @@ module Annex (
getGitConfig,
changeGitConfig,
changeGitRepo,
getRemoteGitConfig,
withCurrentState,
) where
@ -267,6 +268,13 @@ changeGitRepo r = changeState $ \s -> s
, gitconfig = extractGitConfig r
}
{- Gets the RemoteGitConfig from a remote, given the Git.Repo for that
- remote. -}
getRemoteGitConfig :: Git.Repo -> Annex RemoteGitConfig
getRemoteGitConfig r = do
g <- gitRepo
return $ extractRemoteGitConfig g (Git.repoDescribe r)
{- Converts an Annex action into an IO action, that runs with a copy
- of the current Annex state.
-

View file

@ -22,7 +22,6 @@ import Logs.UUID
import Logs.Trust
import qualified Remote.Helper.Ssh as Ssh
import qualified Utility.Dot as Dot
import Types.GitConfig
-- a link from the first repository to the second (its remote)
data Link = Link Git.Repo Git.Repo
@ -204,9 +203,8 @@ tryScan r
configlist = Ssh.onRemote r (pipedconfig, Nothing) "configlist" [] []
manualconfiglist = do
g <- fromRepo id
let c = extractRemoteGitConfig g (Git.repoDescribe r)
sshparams <- Ssh.toRepo r c [Param sshcmd]
gc <- Annex.getRemoteGitConfig r
sshparams <- Ssh.toRepo r gc [Param sshcmd]
liftIO $ pipedconfig "ssh" sshparams
where
sshcmd = cddir ++ " && " ++

View file

@ -13,7 +13,7 @@ import System.Process
import Data.ByteString.Lazy.UTF8 (fromString)
import Common.Annex
import Types.GitConfig
import qualified Annex
import Types.Remote
import Types.Key
import Types.Creds
@ -224,8 +224,7 @@ storeBupUUID u buprepo = do
onBupRemote :: Git.Repo -> (FilePath -> [CommandParam] -> IO a) -> FilePath -> [CommandParam] -> Annex a
onBupRemote r a command params = do
g <- fromRepo id
let c = extractRemoteGitConfig g (Git.repoDescribe r)
c <- Annex.getRemoteGitConfig r
sshparams <- Ssh.toRepo r c [Param $
"cd " ++ dir ++ " && " ++ unwords (command : toCommand params)]
liftIO $ a "ssh" sshparams

View file

@ -87,10 +87,9 @@ list = do
- cached UUID value. -}
configRead :: Git.Repo -> Annex Git.Repo
configRead r = do
g <- fromRepo id
let c = extractRemoteGitConfig g (Git.repoDescribe r)
gc <- Annex.getRemoteGitConfig r
u <- getRepoUUID r
case (repoCheap r, remoteAnnexIgnore c, u) of
case (repoCheap r, remoteAnnexIgnore gc, u) of
(_, True, _) -> return r
(True, _, _) -> tryGitConfigRead r
(False, _, NoUUID) -> tryGitConfigRead r

View file

@ -8,13 +8,13 @@
module Remote.Helper.Ssh where
import Common.Annex
import qualified Annex
import qualified Git
import qualified Git.Url
import Annex.UUID
import Annex.Ssh
import CmdLine.GitAnnexShell.Fields (Field, fieldName)
import qualified CmdLine.GitAnnexShell.Fields as Fields
import Types.GitConfig
import Types.Key
import Remote.Helper.Messages
import Utility.Metered
@ -27,8 +27,8 @@ import Config
- Caller is responsible for doing any neccessary shellEscaping of the
- passed command. -}
toRepo :: Git.Repo -> RemoteGitConfig -> [CommandParam] -> Annex [CommandParam]
toRepo r c sshcmd = do
let opts = map Param $ remoteAnnexSshOptions c
toRepo r gc sshcmd = do
let opts = map Param $ remoteAnnexSshOptions gc
let host = fromMaybe (error "bad ssh url") $ Git.Url.hostuser r
params <- sshCachingOptions (host, Git.Url.port r) opts
return $ params ++ Param host : sshcmd
@ -39,18 +39,17 @@ git_annex_shell :: Git.Repo -> String -> [CommandParam] -> [(Field, String)] ->
git_annex_shell r command params fields
| not $ Git.repoIsUrl r = return $ Just (shellcmd, shellopts ++ fieldopts)
| Git.repoIsSsh r = do
g <- fromRepo id
let c = extractRemoteGitConfig g (Git.repoDescribe r)
gc <- Annex.getRemoteGitConfig r
u <- getRepoUUID r
sshparams <- toRepo r c [Param $ sshcmd u c]
sshparams <- toRepo r gc [Param $ sshcmd u gc]
return $ Just ("ssh", sshparams)
| otherwise = return Nothing
where
dir = Git.repoPath r
shellcmd = "git-annex-shell"
shellopts = Param command : File dir : params
sshcmd u c = unwords $
fromMaybe shellcmd (remoteAnnexShell c)
sshcmd u gc = unwords $
fromMaybe shellcmd (remoteAnnexShell gc)
: map shellEscape (toCommand shellopts) ++
uuidcheck u ++
map shellEscape (toCommand fieldopts)

View file

@ -15,7 +15,6 @@ import Common.Annex
import qualified Annex
import Logs.Remote
import Types.Remote
import Types.GitConfig
import Annex.UUID
import Remote.Helper.Hooks
import Remote.Helper.ReadOnly
@ -94,8 +93,7 @@ remoteListRefresh = do
remoteGen :: M.Map UUID RemoteConfig -> RemoteType -> Git.Repo -> Annex (Maybe Remote)
remoteGen m t r = do
u <- getRepoUUID r
g <- fromRepo id
let gc = extractRemoteGitConfig g (Git.repoDescribe r)
gc <- Annex.getRemoteGitConfig r
let c = fromMaybe M.empty $ M.lookup u m
mrmt <- generate t r u c gc
return $ adjustReadOnly . addHooks <$> mrmt