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, getGitConfig,
changeGitConfig, changeGitConfig,
changeGitRepo, changeGitRepo,
getRemoteGitConfig,
withCurrentState, withCurrentState,
) where ) where
@ -267,6 +268,13 @@ changeGitRepo r = changeState $ \s -> s
, gitconfig = extractGitConfig r , 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 {- Converts an Annex action into an IO action, that runs with a copy
- of the current Annex state. - of the current Annex state.
- -

View file

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

View file

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

View file

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

View file

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

View file

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