summaryrefslogtreecommitdiff
path: root/Remote
diff options
context:
space:
mode:
authorGravatar guilhem <guilhem@fripost.org>2013-04-14 00:10:49 +0200
committerGravatar Joey Hess <joey@kitenet.net>2013-04-13 19:26:24 -0400
commit0957b771da4c58f593f3ecaf194ffdd5c6d335a5 (patch)
tree02043c5c8bd88ccae712cc84ccdae96175facd53 /Remote
parent371dfdfbebd7b7e5142f147324f67fce3ed9cce0 (diff)
Allow rsync to use other remote shells.
Introduced a new per-remote option 'annex-rsync-transport' to specify the remote shell that it to be used with rsync. In case the value is 'ssh', connections are cached unless 'sshcaching' is unset.
Diffstat (limited to 'Remote')
-rw-r--r--Remote/Helper/Ssh.hs7
-rw-r--r--Remote/Rsync.hs29
2 files changed, 30 insertions, 6 deletions
diff --git a/Remote/Helper/Ssh.hs b/Remote/Helper/Ssh.hs
index 135b5c144..2e6b6d57c 100644
--- a/Remote/Helper/Ssh.hs
+++ b/Remote/Helper/Ssh.hs
@@ -22,9 +22,10 @@ sshToRepo :: Git.Repo -> [CommandParam] -> Annex [CommandParam]
sshToRepo repo sshcmd = do
g <- fromRepo id
let c = extractRemoteGitConfig g (Git.repoDescribe repo)
- let opts = map Param $ remoteAnnexSshOptions c
- params <- sshParams (Git.Url.hostuser repo, Git.Url.port repo) opts
- return $ params ++ sshcmd
+ opts = map Param $ remoteAnnexSshOptions c
+ host = Git.Url.hostuser repo
+ params <- sshCachingOptions (host, Git.Url.port repo) opts
+ return $ params ++ Param host : sshcmd
{- Generates parameters to run a git-annex-shell command on a remote
- repository. -}
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index deaf4de46..88540a34b 100644
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -17,6 +17,7 @@ import qualified Git
import Config
import Config.Cost
import Annex.Content
+import Annex.Ssh
import Remote.Helper.Special
import Remote.Helper.Encryptable
import Crypto
@@ -44,6 +45,9 @@ remote = RemoteType {
gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
gen r u c gc = do
cst <- remoteCost gc expensiveRemoteCost
+ (transport, url) <- rsyncTransport
+ let o = RsyncOpts url (transport ++ opts) escape
+ islocal = rsyncUrlIsPath $ rsyncUrl o
return $ encryptableRemote c
(storeEncrypted o $ getGpgOpts gc)
(retrieveEncrypted o)
@@ -69,9 +73,6 @@ gen r u c gc = do
, remotetype = remote
}
where
- o = RsyncOpts url opts escape
- islocal = rsyncUrlIsPath $ rsyncUrl o
- url = fromMaybe (error "missing rsyncurl") $ remoteAnnexRsyncUrl gc
opts = map Param $ filter safe $ remoteAnnexRsyncOptions gc
escape = M.lookup "shellescape" c /= Just "no"
safe opt
@@ -81,6 +82,28 @@ gen r u c gc = do
| opt == "--delete" = False
| opt == "--delete-excluded" = False
| otherwise = True
+ rawurl = fromMaybe (error "missing rsyncurl") $ remoteAnnexRsyncUrl gc
+ (login,resturl) = case separate (=='@') rawurl of
+ (h, "") -> (Nothing, h)
+ (l, h) -> (Just l, h)
+ loginopt = maybe [] (\l -> ["-l",l]) login
+ fromNull as xs | null xs = as
+ | otherwise = xs
+ rsyncTransport = if rsyncUrlIsShell rawurl
+ then (\rsh -> return (rsyncShell rsh, resturl)) =<<
+ case fromNull ["ssh"] (remoteAnnexRsyncTransport gc) of
+ "ssh":sshopts -> do
+ let (port, sshopts') = sshReadPort sshopts
+ host = takeWhile (/=':') resturl
+ -- Connection caching
+ (Param "ssh":) <$> sshCachingOptions
+ (host, port)
+ (map Param $ loginopt ++ sshopts')
+ "rsh":rshopts -> return $ map Param $ "rsh" :
+ loginopt ++ rshopts
+ rsh -> error $ "Unknown Rsync transport: "
+ ++ unwords rsh
+ else return ([], rawurl)
rsyncSetup :: UUID -> RemoteConfig -> Annex RemoteConfig
rsyncSetup u c = do