finished adding support for annex.ssh-options
This commit is contained in:
parent
0bd7ebbf35
commit
99c522edef
4 changed files with 17 additions and 11 deletions
2
Annex.hs
2
Annex.hs
|
@ -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 -}
|
||||||
|
|
17
GitRepo.hs
17
GitRepo.hs
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
2
UUID.hs
2
UUID.hs
|
@ -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. -}
|
||||||
|
|
Loading…
Reference in a new issue