mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

The ssh-options git config is now used by gcrypt, rsync, and ddar special remotes that use ssh as a transport.

Browse source
This commit is contained in:
Joey Hess 2015-02-12 15:44:10 -04:00
parent 52e40970c8
commit 5be7ba7ee5
7 changed files with 57 additions and 45 deletions
Download patch file Download diff file Expand all files Collapse all files

24
Annex/Ssh.hs
View file

@ -1,6 +1,6 @@
{- git-annex ssh interface, with connection caching {- 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. - Licensed under the GNU GPL version 3 or higher.
-} -}
@ -8,7 +8,7 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
module Annex.Ssh ( module Annex.Ssh (
sshCachingOptions, sshOptions,
sshCacheDir, sshCacheDir,
sshReadPort, sshReadPort,
forceSshCleanup, forceSshCleanup,
@ -41,20 +41,26 @@ import Utility.LockFile
#endif #endif
{- Generates parameters to ssh to a given host (or user@host) on a given {- Generates parameters to ssh to a given host (or user@host) on a given
- port, with connection caching. -} - port. This includes connection caching parameters, and any ssh-options. -}
sshCachingOptions :: (String, Maybe Integer) -> [CommandParam] -> Annex [CommandParam] sshOptions :: (String, Maybe Integer) -> RemoteGitConfig -> [CommandParam] -> Annex [CommandParam]
sshCachingOptions (host, port) opts = go =<< sshInfo (host, port) sshOptions (host, port) gc opts = go =<< sshCachingInfo (host, port)
where where
go (Nothing, params) = ret params go (Nothing, params) = ret params
go (Just socketfile, params) = do go (Just socketfile, params) = do
prepSocket socketfile prepSocket socketfile
ret params 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 {- Returns a filename to use for a ssh connection caching socket, and
- parameters to enable ssh connection caching. -} - parameters to enable ssh connection caching. -}
sshInfo :: (String, Maybe Integer) -> Annex (Maybe FilePath, [CommandParam]) sshCachingInfo :: (String, Maybe Integer) -> Annex (Maybe FilePath, [CommandParam])
sshInfo (host, port) = go =<< sshCacheDir sshCachingInfo (host, port) = go =<< sshCacheDir
where where
go Nothing = return (Nothing, []) go Nothing = return (Nothing, [])
go (Just dir) = do go (Just dir) = do
@ -256,7 +262,7 @@ sshCachingTo remote g
| otherwise = case Git.Url.hostuser remote of | otherwise = case Git.Url.hostuser remote of
Nothing -> uncached Nothing -> uncached
Just host -> do Just host -> do
(msockfile, _) <- sshInfo (host, Git.Url.port remote) (msockfile, _) <- sshCachingInfo (host, Git.Url.port remote)
case msockfile of case msockfile of
Nothing -> return g Nothing -> return g
Just sockfile -> do Just sockfile -> do

33
Remote/Ddar.hs
View file

@ -23,7 +23,10 @@ import Remote.Helper.Special
import Annex.Ssh import Annex.Ssh
import Annex.UUID import Annex.UUID
type DdarRepo = String data DdarRepo = DdarRepo
{ ddarRepoConfig :: RemoteGitConfig
, ddarRepoLocation :: String
}
remote :: RemoteType remote :: RemoteType
remote = RemoteType { remote = RemoteType {
@ -62,18 +65,18 @@ gen r u c gc = do
, config = c , config = c
, repo = r , repo = r
, gitconfig = gc , gitconfig = gc
, localpath = if ddarLocal ddarrepo && not (null ddarrepo) , localpath = if ddarLocal ddarrepo && not (null $ ddarRepoLocation ddarrepo)
then Just ddarrepo then Just $ ddarRepoLocation ddarrepo
else Nothing else Nothing
, remotetype = remote , remotetype = remote
, availability = if ddarLocal ddarrepo then LocallyAvailable else GloballyAvailable , availability = if ddarLocal ddarrepo then LocallyAvailable else GloballyAvailable
, readonly = False , readonly = False
, mkUnavailable = return Nothing , mkUnavailable = return Nothing
, getInfo = return [("repo", ddarrepo)] , getInfo = return [("repo", ddarRepoLocation ddarrepo)]
, claimUrl = Nothing , claimUrl = Nothing
, checkUrl = Nothing , checkUrl = Nothing
} }
ddarrepo = fromMaybe (error "missing ddarrepo") $ remoteAnnexDdarRepo gc ddarrepo = maybe (error "missing ddarrepo") (DdarRepo gc) (remoteAnnexDdarRepo gc)
specialcfg = (specialRemoteCfg c) specialcfg = (specialRemoteCfg c)
-- chunking would not improve ddar -- chunking would not improve ddar
{ chunkConfig = NoChunks { chunkConfig = NoChunks
@ -100,7 +103,7 @@ store ddarrepo = fileStorer $ \k src _p -> do
[ Param "c" [ Param "c"
, Param "-N" , Param "-N"
, Param $ key2file k , Param $ key2file k
, Param ddarrepo , Param $ ddarRepoLocation ddarrepo
, File src , File src
] ]
liftIO $ boolSystem "ddar" params liftIO $ boolSystem "ddar" params
@ -110,25 +113,23 @@ splitRemoteDdarRepo :: DdarRepo -> (String, String)
splitRemoteDdarRepo ddarrepo = splitRemoteDdarRepo ddarrepo =
(host, ddarrepo') (host, ddarrepo')
where where
(host, remainder) = span (/= ':') ddarrepo (host, remainder) = span (/= ':') (ddarRepoLocation ddarrepo)
ddarrepo' = drop 1 remainder ddarrepo' = drop 1 remainder
{- Return the command and parameters to use for a ddar call that may need to be {- 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. -} - made on a remote repository. This will call ssh if needed. -}
ddarRemoteCall :: DdarRepo -> Char -> [CommandParam] -> Annex (String, [CommandParam]) ddarRemoteCall :: DdarRepo -> Char -> [CommandParam] -> Annex (String, [CommandParam])
ddarRemoteCall ddarrepo cmd params ddarRemoteCall ddarrepo cmd params
| ddarLocal ddarrepo = return ("ddar", localParams) | ddarLocal ddarrepo = return ("ddar", localParams)
| otherwise = do | otherwise = do
remoteCachingParams <- sshCachingOptions (host, Nothing) [] os <- sshOptions (host, Nothing) (ddarRepoConfig ddarrepo) remoteParams
return ("ssh", remoteCachingParams ++ remoteParams) return ("ssh", os)
where where
(host, ddarrepo') = splitRemoteDdarRepo ddarrepo (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 remoteParams = Param host : Param "ddar" : Param [cmd] : Param ddarrepo' : params
{- Specialized ddarRemoteCall that includes extraction command and flags -} {- Specialized ddarRemoteCall that includes extraction command and flags -}
ddarExtractRemoteCall :: DdarRepo -> Key -> Annex (String, [CommandParam]) ddarExtractRemoteCall :: DdarRepo -> Key -> Annex (String, [CommandParam])
ddarExtractRemoteCall ddarrepo k = ddarExtractRemoteCall ddarrepo k =
ddarRemoteCall ddarrepo 'x' [Param "--force-stdout", Param $ key2file 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 -> Annex (Either String Bool)
ddarDirectoryExists ddarrepo ddarDirectoryExists ddarrepo
| ddarLocal ddarrepo = do | ddarLocal ddarrepo = do
maybeStatus <- liftIO $ tryJust (guard . isDoesNotExistError) $ getFileStatus ddarrepo maybeStatus <- liftIO $ tryJust (guard . isDoesNotExistError) $ getFileStatus $ ddarRepoLocation ddarrepo
return $ case maybeStatus of return $ case maybeStatus of
Left _ -> Right False Left _ -> Right False
Right status -> Right $ isDirectory status Right status -> Right $ isDirectory status
| otherwise = do | otherwise = do
sshCachingParams <- sshCachingOptions (host, Nothing) [] ps <- sshOptions (host, Nothing) (ddarRepoConfig ddarrepo) params
exitCode <- liftIO $ safeSystem "ssh" $ sshCachingParams ++ params exitCode <- liftIO $ safeSystem "ssh" ps
case exitCode of case exitCode of
ExitSuccess -> return $ Right True ExitSuccess -> return $ Right True
ExitFailure 1 -> return $ Right False ExitFailure 1 -> return $ Right False
@ -195,4 +196,4 @@ checkKey ddarrepo key = do
Right False -> return False Right False -> return False
ddarLocal :: DdarRepo -> Bool ddarLocal :: DdarRepo -> Bool
ddarLocal = notElem ':' ddarLocal = notElem ':' . ddarRepoLocation

34
Remote/GCrypt.hs
View file

@ -70,7 +70,7 @@ gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remot
gen baser u c gc = do gen baser u c gc = do
-- doublecheck that cache matches underlying repo's gcrypt-id -- doublecheck that cache matches underlying repo's gcrypt-id
-- (which might not be set), only for local repos -- (which might not be set), only for local repos
(mgcryptid, r) <- getGCryptId True baser (mgcryptid, r) <- getGCryptId True baser gc
g <- gitRepo g <- gitRepo
case (mgcryptid, Git.GCrypt.remoteRepoId g (Git.remoteName baser)) of case (mgcryptid, Git.GCrypt.remoteRepoId g (Git.remoteName baser)) of
(Just gcryptid, Just cachedgcryptid) (Just gcryptid, Just cachedgcryptid)
@ -99,7 +99,7 @@ gen' :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remo
gen' r u c gc = do gen' r u c gc = do
cst <- remoteCost gc $ cst <- remoteCost gc $
if repoCheap r then nearlyCheapRemoteCost else expensiveRemoteCost 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 rsyncopts = Remote.Rsync.genRsyncOpts c gc rsynctransport rsyncurl
let this = Remote let this = Remote
{ uuid = u { uuid = u
@ -139,13 +139,13 @@ gen' r u c gc = do
{ displayProgress = False } { displayProgress = False }
| otherwise = specialRemoteCfg c | otherwise = specialRemoteCfg c
rsyncTransportToObjects :: Git.Repo -> Annex ([CommandParam], String) rsyncTransportToObjects :: Git.Repo -> RemoteGitConfig -> Annex ([CommandParam], String)
rsyncTransportToObjects r = do rsyncTransportToObjects r gc = do
(rsynctransport, rsyncurl, _) <- rsyncTransport r (rsynctransport, rsyncurl, _) <- rsyncTransport r gc
return (rsynctransport, rsyncurl ++ "/annex/objects") return (rsynctransport, rsyncurl ++ "/annex/objects")
rsyncTransport :: Git.Repo -> Annex ([CommandParam], String, AccessMethod) rsyncTransport :: Git.Repo -> RemoteGitConfig -> Annex ([CommandParam], String, AccessMethod)
rsyncTransport r rsyncTransport r gc
| "ssh://" `isPrefixOf` loc = sshtransport $ break (== '/') $ drop (length "ssh://") loc | "ssh://" `isPrefixOf` loc = sshtransport $ break (== '/') $ drop (length "ssh://") loc
| "//:" `isInfixOf` loc = othertransport | "//:" `isInfixOf` loc = othertransport
| ":" `isInfixOf` loc = sshtransport $ separate (== ':') loc | ":" `isInfixOf` loc = sshtransport $ separate (== ':') loc
@ -156,7 +156,7 @@ rsyncTransport r
let rsyncpath = if "/~/" `isPrefixOf` path let rsyncpath = if "/~/" `isPrefixOf` path
then drop 3 path then drop 3 path
else path else path
opts <- sshCachingOptions (host, Nothing) [] opts <- sshOptions (host, Nothing) gc []
return (rsyncShell $ Param "ssh" : opts, host ++ ":" ++ rsyncpath, AccessShell) return (rsyncShell $ Param "ssh" : opts, host ++ ":" ++ rsyncpath, AccessShell)
othertransport = return ([], loc, AccessDirect) 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 :: Git.GCrypt.GCryptId -> Git.Repo -> Annex AccessMethod
setupRepo gcryptid r setupRepo gcryptid r
| Git.repoIsUrl r = do | Git.repoIsUrl r = do
(_, _, accessmethod) <- rsyncTransport r (_, _, accessmethod) <- rsyncTransport r def
case accessmethod of case accessmethod of
AccessDirect -> rsyncsetup AccessDirect -> rsyncsetup
AccessShell -> ifM gitannexshellsetup AccessShell -> ifM gitannexshellsetup
@ -240,7 +240,7 @@ setupRepo gcryptid r
-} -}
rsyncsetup = Remote.Rsync.withRsyncScratchDir $ \tmp -> do rsyncsetup = Remote.Rsync.withRsyncScratchDir $ \tmp -> do
liftIO $ createDirectoryIfMissing True $ tmp </> objectDir liftIO $ createDirectoryIfMissing True $ tmp </> objectDir
(rsynctransport, rsyncurl, _) <- rsyncTransport r (rsynctransport, rsyncurl, _) <- rsyncTransport r def
let tmpconfig = tmp </> "config" let tmpconfig = tmp </> "config"
void $ liftIO $ rsync $ rsynctransport ++ void $ liftIO $ rsync $ rsynctransport ++
[ Param $ rsyncurl ++ "/config" [ Param $ rsyncurl ++ "/config"
@ -376,7 +376,7 @@ toAccessMethod _ = AccessDirect
getGCryptUUID :: Bool -> Git.Repo -> Annex (Maybe UUID) getGCryptUUID :: Bool -> Git.Repo -> Annex (Maybe UUID)
getGCryptUUID fast r = (genUUIDInNameSpace gCryptNameSpace <$>) . fst getGCryptUUID fast r = (genUUIDInNameSpace gCryptNameSpace <$>) . fst
<$> getGCryptId fast r <$> getGCryptId fast r def
coreGCryptId :: String coreGCryptId :: String
coreGCryptId = "core.gcrypt-id" coreGCryptId = "core.gcrypt-id"
@ -389,22 +389,22 @@ coreGCryptId = "core.gcrypt-id"
- tries git-annex-shell and direct rsync of the git config file. - tries git-annex-shell and direct rsync of the git config file.
- -
- (Also returns a version of input repo with its config read.) -} - (Also returns a version of input repo with its config read.) -}
getGCryptId :: Bool -> Git.Repo -> Annex (Maybe Git.GCrypt.GCryptId, Git.Repo) getGCryptId :: Bool -> Git.Repo -> RemoteGitConfig -> Annex (Maybe Git.GCrypt.GCryptId, Git.Repo)
getGCryptId fast r getGCryptId fast r gc
| Git.repoIsLocal r || Git.repoIsLocalUnknown r = extract <$> | Git.repoIsLocal r || Git.repoIsLocalUnknown r = extract <$>
liftIO (catchMaybeIO $ Git.Config.read r) liftIO (catchMaybeIO $ Git.Config.read r)
| not fast = extract . liftM fst <$> getM (eitherToMaybe <$>) | not fast = extract . liftM fst <$> getM (eitherToMaybe <$>)
[ Ssh.onRemote r (Git.Config.fromPipe r, return (Left undefined)) "configlist" [] [] [ Ssh.onRemote r (Git.Config.fromPipe r, return (Left undefined)) "configlist" [] []
, getConfigViaRsync r , getConfigViaRsync r gc
] ]
| otherwise = return (Nothing, r) | otherwise = return (Nothing, r)
where where
extract Nothing = (Nothing, r) extract Nothing = (Nothing, r)
extract (Just r') = (Git.Config.getMaybe coreGCryptId r', r') extract (Just r') = (Git.Config.getMaybe coreGCryptId r', r')
getConfigViaRsync :: Git.Repo -> Annex (Either SomeException (Git.Repo, String)) getConfigViaRsync :: Git.Repo -> RemoteGitConfig -> Annex (Either SomeException (Git.Repo, String))
getConfigViaRsync r = do getConfigViaRsync r gc = do
(rsynctransport, rsyncurl, _) <- rsyncTransport r (rsynctransport, rsyncurl, _) <- rsyncTransport r gc
liftIO $ do liftIO $ do
withTmpFile "tmpconfig" $ \tmpconfig _ -> do withTmpFile "tmpconfig" $ \tmpconfig _ -> do
void $ rsync $ rsynctransport ++ void $ rsync $ rsynctransport ++

2
Remote/Helper/Ssh.hs
View file

@ -30,7 +30,7 @@ toRepo :: Git.Repo -> RemoteGitConfig -> [CommandParam] -> Annex [CommandParam]
toRepo r gc sshcmd = do toRepo r gc sshcmd = do
let opts = map Param $ remoteAnnexSshOptions gc 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 <- sshOptions (host, Git.Url.port r) gc opts
return $ params ++ Param host : sshcmd return $ params ++ Param host : sshcmd
{- Generates parameters to run a git-annex-shell command on a remote {- Generates parameters to run a git-annex-shell command on a remote

4
Remote/Rsync.hs
View file

@ -121,8 +121,8 @@ rsyncTransport gc url
let (port, sshopts') = sshReadPort sshopts let (port, sshopts') = sshReadPort sshopts
userhost = takeWhile (/=':') url userhost = takeWhile (/=':') url
-- Connection caching -- Connection caching
(Param "ssh":) <$> sshCachingOptions (Param "ssh":) <$> sshOptions
(userhost, port) (userhost, port) gc
(map Param $ loginopt ++ sshopts') (map Param $ loginopt ++ sshopts')
"rsh":rshopts -> return $ map Param $ "rsh" : "rsh":rshopts -> return $ map Param $ "rsh" :
loginopt ++ rshopts loginopt ++ rshopts

3
Types/GitConfig.hs
View file

@ -15,6 +15,7 @@ module Types.GitConfig (
import Common import Common
import qualified Git import qualified Git
import qualified Git.Config import qualified Git.Config
import qualified Git.Construct
import Utility.DataUnits import Utility.DataUnits
import Config.Cost import Config.Cost
import Types.Distribution import Types.Distribution
@ -193,3 +194,5 @@ notempty Nothing = Nothing
notempty (Just "") = Nothing notempty (Just "") = Nothing
notempty (Just s) = Just s notempty (Just s) = Just s
instance Default RemoteGitConfig where
def = extractRemoteGitConfig Git.Construct.fromUnknown "dummy"

2
debian/changelog vendored
View file

@ -26,6 +26,8 @@ git-annex (5.20150206) UNRELEASED; urgency=medium
default, since that can be surprising behavior and difficult to recover default, since that can be surprising behavior and difficult to recover
from. The old behavior is available by using --force. from. The old behavior is available by using --force.
* sync, assistant: Include repository name in head branch commit message. * 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 -- Joey Hess <id@joeyh.name> Fri, 06 Feb 2015 13:57:08 -0400