finished adding support for annex.ssh-options

This commit is contained in:
Joey Hess 2010-11-01 00:04:53 -04:00
parent 0bd7ebbf35
commit 99c522edef
4 changed files with 17 additions and 11 deletions

View file

@ -45,7 +45,7 @@ new gitrepo allbackends = do
where where
prep = do prep = do
-- read git config and update state -- read git config and update state
gitrepo' <- liftIO $ Git.configRead gitrepo gitrepo' <- liftIO $ Git.configRead gitrepo Nothing
Annex.gitRepoChange gitrepo' Annex.gitRepoChange gitrepo'
{- performs an action in the Annex monad -} {- performs an action in the Annex monad -}

View file

@ -246,9 +246,11 @@ pipeNullSplit repo params = do
where where
split0 s = filter (not . null) $ split "\0" s split0 s = filter (not . null) $ split "\0" s
{- Runs git config and populates a repo with its config. -} {- Runs git config and populates a repo with its config.
configRead :: Repo -> IO Repo -
configRead repo@(Repo { location = Dir d }) = do - For a ssh repository, a list of ssh options may optionally be specified. -}
configRead :: Repo -> Maybe [String] -> IO Repo
configRead repo@(Repo { location = Dir d }) _ = do
{- Cannot use pipeRead because it relies on the config having {- Cannot use pipeRead because it relies on the config having
been already read. Instead, chdir to the repo. -} been already read. Instead, chdir to the repo. -}
cwd <- getCurrentDirectory cwd <- getCurrentDirectory
@ -256,10 +258,13 @@ configRead repo@(Repo { location = Dir d }) = do
(\_ -> changeWorkingDirectory cwd) $ (\_ -> changeWorkingDirectory cwd) $
pOpen ReadFromPipe "git" ["config", "--list"] $ pOpen ReadFromPipe "git" ["config", "--list"] $
hConfigRead repo hConfigRead repo
configRead repo = assertSsh repo $ do configRead repo sshopts = assertSsh repo $ do
pOpen ReadFromPipe "ssh" [urlHost repo, sshcommand] $ hConfigRead repo pOpen ReadFromPipe "ssh" params $ hConfigRead repo
where where
sshcommand = "cd " ++ (shellEscape $ urlPath repo) ++ params = case sshopts of
Nothing -> [urlHost repo, command]
Just l -> l ++ [urlHost repo, command]
command = "cd " ++ (shellEscape $ urlPath repo) ++
" && git config --list" " && git config --list"
hConfigRead :: Repo -> Handle -> IO Repo hConfigRead :: Repo -> Handle -> IO Repo
hConfigRead repo h = do hConfigRead repo h = do

View file

@ -94,8 +94,8 @@ inAnnex r key = do
Annex.eval a (Core.inAnnex key) Annex.eval a (Core.inAnnex key)
checkremote = do checkremote = do
Core.showNote ("checking " ++ Git.repoDescribe r ++ "...") Core.showNote ("checking " ++ Git.repoDescribe r ++ "...")
inannex <- runCmd r ("test -e " ++ inannex <- runCmd r "test"
(shellEscape $ annexLocation r key)) [] [ "-e", (shellEscape $ annexLocation r key)]
-- XXX Note that ssh failing and the file not existing -- XXX Note that ssh failing and the file not existing
-- are not currently differentiated. -- are not currently differentiated.
return $ Right inannex return $ Right inannex
@ -172,11 +172,12 @@ commandLineRemote = do
- returns the updated git repo. -} - returns the updated git repo. -}
tryGitConfigRead :: Git.Repo -> Annex (Either Git.Repo Git.Repo) tryGitConfigRead :: Git.Repo -> Annex (Either Git.Repo Git.Repo)
tryGitConfigRead r = do tryGitConfigRead r = do
sshoptions <- repoConfig r "annex-ssh-options" ""
if (Map.null $ Git.configMap r) if (Map.null $ Git.configMap r)
then do then do
-- configRead can fail due to IO error or -- configRead can fail due to IO error or
-- for other reasons; catch all possible exceptions -- for other reasons; catch all possible exceptions
result <- liftIO $ (try (Git.configRead r)::IO (Either SomeException (Git.Repo))) result <- liftIO $ (try (Git.configRead r $ Just $ words sshoptions)::IO (Either SomeException (Git.Repo)))
case (result) of case (result) of
Left _ -> return $ Left r Left _ -> return $ Left r
Right r' -> do Right r' -> do

View file

@ -83,7 +83,7 @@ setConfig key value = do
g <- Annex.gitRepo g <- Annex.gitRepo
liftIO $ Git.run g ["config", key, value] liftIO $ Git.run g ["config", key, value]
-- re-read git config and update the repo's state -- re-read git config and update the repo's state
g' <- liftIO $ Git.configRead g g' <- liftIO $ Git.configRead g Nothing
Annex.gitRepoChange g' Annex.gitRepoChange g'
{- Filters a list of repos to ones that have listed UUIDs. -} {- Filters a list of repos to ones that have listed UUIDs. -}