From 5be7ba7ee56a07841bc82ed2f031c051cc68ecbc Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 12 Feb 2015 15:44:10 -0400 Subject: [PATCH] The ssh-options git config is now used by gcrypt, rsync, and ddar special remotes that use ssh as a transport. --- Annex/Ssh.hs | 24 +++++++++++++++--------- Remote/Ddar.hs | 33 +++++++++++++++++---------------- Remote/GCrypt.hs | 34 +++++++++++++++++----------------- Remote/Helper/Ssh.hs | 2 +- Remote/Rsync.hs | 4 ++-- Types/GitConfig.hs | 3 +++ debian/changelog | 2 ++ 7 files changed, 57 insertions(+), 45 deletions(-) diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs index 84637fd3de..1be735c8fa 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 + - Copyright 2012-2015 Joey Hess - - 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 7815607fae..7495fcd427 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 aed54d20fc..54c90536fa 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 5d39f3bc84..3addf23848 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 f5d4c85c44..f39081299a 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 ef8f2f2bdb..c0043ec04b 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 92c702b415..59c2440c27 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 Fri, 06 Feb 2015 13:57:08 -0400