summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Annex/Ssh.hs24
-rw-r--r--Remote/Ddar.hs33
-rw-r--r--Remote/GCrypt.hs34
-rw-r--r--Remote/Helper/Ssh.hs2
-rw-r--r--Remote/Rsync.hs4
-rw-r--r--Types/GitConfig.hs3
-rw-r--r--debian/changelog2
7 files changed, 57 insertions, 45 deletions
diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs
index 84637fd3d..1be735c8f 100644
--- a/Annex/Ssh.hs
+++ b/Annex/Ssh.hs
@@ -1,6 +1,6 @@
{- git-annex ssh interface, with connection caching
-
- - Copyright 2012-2014 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2015 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -8,7 +8,7 @@
{-# LANGUAGE CPP #-}
module Annex.Ssh (
- sshCachingOptions,
+ sshOptions,
sshCacheDir,
sshReadPort,
forceSshCleanup,
@@ -41,20 +41,26 @@ import Utility.LockFile
#endif
{- Generates parameters to ssh to a given host (or user@host) on a given
- - port, with connection caching. -}
-sshCachingOptions :: (String, Maybe Integer) -> [CommandParam] -> Annex [CommandParam]
-sshCachingOptions (host, port) opts = go =<< sshInfo (host, port)
+ - port. This includes connection caching parameters, and any ssh-options. -}
+sshOptions :: (String, Maybe Integer) -> RemoteGitConfig -> [CommandParam] -> Annex [CommandParam]
+sshOptions (host, port) gc opts = go =<< sshCachingInfo (host, port)
where
go (Nothing, params) = ret params
go (Just socketfile, params) = do
prepSocket socketfile
ret params
- ret ps = return $ ps ++ opts ++ portParams port ++ [Param "-T"]
+ ret ps = return $ concat
+ [ ps
+ , map Param (remoteAnnexSshOptions gc)
+ , opts
+ , portParams port
+ , [Param "-T"]
+ ]
{- Returns a filename to use for a ssh connection caching socket, and
- parameters to enable ssh connection caching. -}
-sshInfo :: (String, Maybe Integer) -> Annex (Maybe FilePath, [CommandParam])
-sshInfo (host, port) = go =<< sshCacheDir
+sshCachingInfo :: (String, Maybe Integer) -> Annex (Maybe FilePath, [CommandParam])
+sshCachingInfo (host, port) = go =<< sshCacheDir
where
go Nothing = return (Nothing, [])
go (Just dir) = do
@@ -256,7 +262,7 @@ sshCachingTo remote g
| otherwise = case Git.Url.hostuser remote of
Nothing -> uncached
Just host -> do
- (msockfile, _) <- sshInfo (host, Git.Url.port remote)
+ (msockfile, _) <- sshCachingInfo (host, Git.Url.port remote)
case msockfile of
Nothing -> return g
Just sockfile -> do
diff --git a/Remote/Ddar.hs b/Remote/Ddar.hs
index 7815607fa..7495fcd42 100644
--- a/Remote/Ddar.hs
+++ b/Remote/Ddar.hs
@@ -23,7 +23,10 @@ import Remote.Helper.Special
import Annex.Ssh
import Annex.UUID
-type DdarRepo = String
+data DdarRepo = DdarRepo
+ { ddarRepoConfig :: RemoteGitConfig
+ , ddarRepoLocation :: String
+ }
remote :: RemoteType
remote = RemoteType {
@@ -62,18 +65,18 @@ gen r u c gc = do
, config = c
, repo = r
, gitconfig = gc
- , localpath = if ddarLocal ddarrepo && not (null ddarrepo)
- then Just ddarrepo
+ , localpath = if ddarLocal ddarrepo && not (null $ ddarRepoLocation ddarrepo)
+ then Just $ ddarRepoLocation ddarrepo
else Nothing
, remotetype = remote
, availability = if ddarLocal ddarrepo then LocallyAvailable else GloballyAvailable
, readonly = False
, mkUnavailable = return Nothing
- , getInfo = return [("repo", ddarrepo)]
+ , getInfo = return [("repo", ddarRepoLocation ddarrepo)]
, claimUrl = Nothing
, checkUrl = Nothing
}
- ddarrepo = fromMaybe (error "missing ddarrepo") $ remoteAnnexDdarRepo gc
+ ddarrepo = maybe (error "missing ddarrepo") (DdarRepo gc) (remoteAnnexDdarRepo gc)
specialcfg = (specialRemoteCfg c)
-- chunking would not improve ddar
{ chunkConfig = NoChunks
@@ -100,7 +103,7 @@ store ddarrepo = fileStorer $ \k src _p -> do
[ Param "c"
, Param "-N"
, Param $ key2file k
- , Param ddarrepo
+ , Param $ ddarRepoLocation ddarrepo
, File src
]
liftIO $ boolSystem "ddar" params
@@ -110,25 +113,23 @@ splitRemoteDdarRepo :: DdarRepo -> (String, String)
splitRemoteDdarRepo ddarrepo =
(host, ddarrepo')
where
- (host, remainder) = span (/= ':') ddarrepo
+ (host, remainder) = span (/= ':') (ddarRepoLocation ddarrepo)
ddarrepo' = drop 1 remainder
{- Return the command and parameters to use for a ddar call that may need to be
- made on a remote repository. This will call ssh if needed. -}
-
ddarRemoteCall :: DdarRepo -> Char -> [CommandParam] -> Annex (String, [CommandParam])
ddarRemoteCall ddarrepo cmd params
| ddarLocal ddarrepo = return ("ddar", localParams)
| otherwise = do
- remoteCachingParams <- sshCachingOptions (host, Nothing) []
- return ("ssh", remoteCachingParams ++ remoteParams)
+ os <- sshOptions (host, Nothing) (ddarRepoConfig ddarrepo) remoteParams
+ return ("ssh", os)
where
(host, ddarrepo') = splitRemoteDdarRepo ddarrepo
- localParams = Param [cmd] : Param ddarrepo : params
+ localParams = Param [cmd] : Param (ddarRepoLocation ddarrepo) : params
remoteParams = Param host : Param "ddar" : Param [cmd] : Param ddarrepo' : params
{- Specialized ddarRemoteCall that includes extraction command and flags -}
-
ddarExtractRemoteCall :: DdarRepo -> Key -> Annex (String, [CommandParam])
ddarExtractRemoteCall ddarrepo k =
ddarRemoteCall ddarrepo 'x' [Param "--force-stdout", Param $ key2file k]
@@ -152,13 +153,13 @@ remove ddarrepo key = do
ddarDirectoryExists :: DdarRepo -> Annex (Either String Bool)
ddarDirectoryExists ddarrepo
| ddarLocal ddarrepo = do
- maybeStatus <- liftIO $ tryJust (guard . isDoesNotExistError) $ getFileStatus ddarrepo
+ maybeStatus <- liftIO $ tryJust (guard . isDoesNotExistError) $ getFileStatus $ ddarRepoLocation ddarrepo
return $ case maybeStatus of
Left _ -> Right False
Right status -> Right $ isDirectory status
| otherwise = do
- sshCachingParams <- sshCachingOptions (host, Nothing) []
- exitCode <- liftIO $ safeSystem "ssh" $ sshCachingParams ++ params
+ ps <- sshOptions (host, Nothing) (ddarRepoConfig ddarrepo) params
+ exitCode <- liftIO $ safeSystem "ssh" ps
case exitCode of
ExitSuccess -> return $ Right True
ExitFailure 1 -> return $ Right False
@@ -195,4 +196,4 @@ checkKey ddarrepo key = do
Right False -> return False
ddarLocal :: DdarRepo -> Bool
-ddarLocal = notElem ':'
+ddarLocal = notElem ':' . ddarRepoLocation
diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs
index aed54d20f..54c90536f 100644
--- a/Remote/GCrypt.hs
+++ b/Remote/GCrypt.hs
@@ -70,7 +70,7 @@ gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remot
gen baser u c gc = do
-- doublecheck that cache matches underlying repo's gcrypt-id
-- (which might not be set), only for local repos
- (mgcryptid, r) <- getGCryptId True baser
+ (mgcryptid, r) <- getGCryptId True baser gc
g <- gitRepo
case (mgcryptid, Git.GCrypt.remoteRepoId g (Git.remoteName baser)) of
(Just gcryptid, Just cachedgcryptid)
@@ -99,7 +99,7 @@ gen' :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remo
gen' r u c gc = do
cst <- remoteCost gc $
if repoCheap r then nearlyCheapRemoteCost else expensiveRemoteCost
- (rsynctransport, rsyncurl) <- rsyncTransportToObjects r
+ (rsynctransport, rsyncurl) <- rsyncTransportToObjects r gc
let rsyncopts = Remote.Rsync.genRsyncOpts c gc rsynctransport rsyncurl
let this = Remote
{ uuid = u
@@ -139,13 +139,13 @@ gen' r u c gc = do
{ displayProgress = False }
| otherwise = specialRemoteCfg c
-rsyncTransportToObjects :: Git.Repo -> Annex ([CommandParam], String)
-rsyncTransportToObjects r = do
- (rsynctransport, rsyncurl, _) <- rsyncTransport r
+rsyncTransportToObjects :: Git.Repo -> RemoteGitConfig -> Annex ([CommandParam], String)
+rsyncTransportToObjects r gc = do
+ (rsynctransport, rsyncurl, _) <- rsyncTransport r gc
return (rsynctransport, rsyncurl ++ "/annex/objects")
-rsyncTransport :: Git.Repo -> Annex ([CommandParam], String, AccessMethod)
-rsyncTransport r
+rsyncTransport :: Git.Repo -> RemoteGitConfig -> Annex ([CommandParam], String, AccessMethod)
+rsyncTransport r gc
| "ssh://" `isPrefixOf` loc = sshtransport $ break (== '/') $ drop (length "ssh://") loc
| "//:" `isInfixOf` loc = othertransport
| ":" `isInfixOf` loc = sshtransport $ separate (== ':') loc
@@ -156,7 +156,7 @@ rsyncTransport r
let rsyncpath = if "/~/" `isPrefixOf` path
then drop 3 path
else path
- opts <- sshCachingOptions (host, Nothing) []
+ opts <- sshOptions (host, Nothing) gc []
return (rsyncShell $ Param "ssh" : opts, host ++ ":" ++ rsyncpath, AccessShell)
othertransport = return ([], loc, AccessDirect)
@@ -218,7 +218,7 @@ gCryptSetup mu _ c = go $ M.lookup "gitrepo" c
setupRepo :: Git.GCrypt.GCryptId -> Git.Repo -> Annex AccessMethod
setupRepo gcryptid r
| Git.repoIsUrl r = do
- (_, _, accessmethod) <- rsyncTransport r
+ (_, _, accessmethod) <- rsyncTransport r def
case accessmethod of
AccessDirect -> rsyncsetup
AccessShell -> ifM gitannexshellsetup
@@ -240,7 +240,7 @@ setupRepo gcryptid r
-}
rsyncsetup = Remote.Rsync.withRsyncScratchDir $ \tmp -> do
liftIO $ createDirectoryIfMissing True $ tmp </> objectDir
- (rsynctransport, rsyncurl, _) <- rsyncTransport r
+ (rsynctransport, rsyncurl, _) <- rsyncTransport r def
let tmpconfig = tmp </> "config"
void $ liftIO $ rsync $ rsynctransport ++
[ Param $ rsyncurl ++ "/config"
@@ -376,7 +376,7 @@ toAccessMethod _ = AccessDirect
getGCryptUUID :: Bool -> Git.Repo -> Annex (Maybe UUID)
getGCryptUUID fast r = (genUUIDInNameSpace gCryptNameSpace <$>) . fst
- <$> getGCryptId fast r
+ <$> getGCryptId fast r def
coreGCryptId :: String
coreGCryptId = "core.gcrypt-id"
@@ -389,22 +389,22 @@ coreGCryptId = "core.gcrypt-id"
- tries git-annex-shell and direct rsync of the git config file.
-
- (Also returns a version of input repo with its config read.) -}
-getGCryptId :: Bool -> Git.Repo -> Annex (Maybe Git.GCrypt.GCryptId, Git.Repo)
-getGCryptId fast r
+getGCryptId :: Bool -> Git.Repo -> RemoteGitConfig -> Annex (Maybe Git.GCrypt.GCryptId, Git.Repo)
+getGCryptId fast r gc
| Git.repoIsLocal r || Git.repoIsLocalUnknown r = extract <$>
liftIO (catchMaybeIO $ Git.Config.read r)
| not fast = extract . liftM fst <$> getM (eitherToMaybe <$>)
[ Ssh.onRemote r (Git.Config.fromPipe r, return (Left undefined)) "configlist" [] []
- , getConfigViaRsync r
+ , getConfigViaRsync r gc
]
| otherwise = return (Nothing, r)
where
extract Nothing = (Nothing, r)
extract (Just r') = (Git.Config.getMaybe coreGCryptId r', r')
-getConfigViaRsync :: Git.Repo -> Annex (Either SomeException (Git.Repo, String))
-getConfigViaRsync r = do
- (rsynctransport, rsyncurl, _) <- rsyncTransport r
+getConfigViaRsync :: Git.Repo -> RemoteGitConfig -> Annex (Either SomeException (Git.Repo, String))
+getConfigViaRsync r gc = do
+ (rsynctransport, rsyncurl, _) <- rsyncTransport r gc
liftIO $ do
withTmpFile "tmpconfig" $ \tmpconfig _ -> do
void $ rsync $ rsynctransport ++
diff --git a/Remote/Helper/Ssh.hs b/Remote/Helper/Ssh.hs
index 5d39f3bc8..3addf2384 100644
--- a/Remote/Helper/Ssh.hs
+++ b/Remote/Helper/Ssh.hs
@@ -30,7 +30,7 @@ toRepo :: Git.Repo -> RemoteGitConfig -> [CommandParam] -> Annex [CommandParam]
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
+ params <- sshOptions (host, Git.Url.port r) gc opts
return $ params ++ Param host : sshcmd
{- Generates parameters to run a git-annex-shell command on a remote
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index f5d4c85c4..f39081299 100644
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -121,8 +121,8 @@ rsyncTransport gc url
let (port, sshopts') = sshReadPort sshopts
userhost = takeWhile (/=':') url
-- Connection caching
- (Param "ssh":) <$> sshCachingOptions
- (userhost, port)
+ (Param "ssh":) <$> sshOptions
+ (userhost, port) gc
(map Param $ loginopt ++ sshopts')
"rsh":rshopts -> return $ map Param $ "rsh" :
loginopt ++ rshopts
diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs
index ef8f2f2bd..c0043ec04 100644
--- a/Types/GitConfig.hs
+++ b/Types/GitConfig.hs
@@ -15,6 +15,7 @@ module Types.GitConfig (
import Common
import qualified Git
import qualified Git.Config
+import qualified Git.Construct
import Utility.DataUnits
import Config.Cost
import Types.Distribution
@@ -193,3 +194,5 @@ notempty Nothing = Nothing
notempty (Just "") = Nothing
notempty (Just s) = Just s
+instance Default RemoteGitConfig where
+ def = extractRemoteGitConfig Git.Construct.fromUnknown "dummy"
diff --git a/debian/changelog b/debian/changelog
index 92c702b41..59c2440c2 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -26,6 +26,8 @@ git-annex (5.20150206) UNRELEASED; urgency=medium
default, since that can be surprising behavior and difficult to recover
from. The old behavior is available by using --force.
* sync, assistant: Include repository name in head branch commit message.
+ * The ssh-options git config is now used by gcrypt, rsync, and ddar
+ special remotes that use ssh as a transport.
-- Joey Hess <id@joeyh.name> Fri, 06 Feb 2015 13:57:08 -0400
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-01 12:34:23 +0000