summaryrefslogtreecommitdiff
path: root/Remotes.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2010-12-02 16:55:21 -0400
committerGravatar Joey Hess <joey@kitenet.net>2010-12-02 16:55:21 -0400
commit37941184f99896a459fd889071e47ed2fa5ceaa6 (patch)
tree94912fc9a9e25469cdcd1b7e306da5158d91d202 /Remotes.hs
parentade43d8fab2b42846a06201f03e4a03255ef8fce (diff)
Rsync will now be used to resume interrupted/failed partial file transfers from a remote.
Diffstat (limited to 'Remotes.hs')
-rw-r--r--Remotes.hs20
1 files changed, 17 insertions, 3 deletions
diff --git a/Remotes.hs b/Remotes.hs
index cb8081d74..6bb67216b 100644
--- a/Remotes.hs
+++ b/Remotes.hs
@@ -36,6 +36,7 @@ import Utility
import qualified Core
import Messages
import CopyFile
+import qualified SysConfig
{- Human visible list of remotes. -}
list :: [Git.Repo] -> String
@@ -199,9 +200,13 @@ copyFromRemote r key file
| Git.repoIsSsh r = getssh
| otherwise = error "copying from non-ssh repo not supported"
where
- getlocal = liftIO $ copyFile keyloc file
- getssh = scp r [sshLocation r keyloc, file]
keyloc = annexLocation r key
+ getlocal = liftIO $ copyFile keyloc file
+ getssh = do
+ exists <- liftIO $ doesFileExist file
+ if exists && SysConfig.rsync
+ then rsync r [sshLocation r keyloc, file]
+ else scp r [sshLocation r keyloc, file]
{- Tries to copy a key's content to a file on a remote. -}
copyToRemote :: Git.Repo -> Key -> FilePath -> Annex Bool
@@ -224,9 +229,18 @@ sshLocation r file = Git.urlHost r ++ ":" ++ shellEscape file
scp :: Git.Repo -> [String] -> Annex Bool
scp r params = do
scpoptions <- repoConfig r "scp-options" ""
- showProgress -- make way for scp progress bar
+ showProgress -- make way for progress bar
liftIO $ boolSystem "scp" $ "-p":(words scpoptions) ++ params
+{- Runs rsync against a specified remote, resuming any interrupted file
+ - transfer. (Honors annex-rsync-options.) -}
+rsync :: Git.Repo -> [String] -> Annex Bool
+rsync r params = do
+ rsyncoptions <- repoConfig r "rsync-options" ""
+ showProgress -- make way for progress bar
+ liftIO $ boolSystem "rsync" $ ["--progress", "-a", "--inplace"] ++
+ words rsyncoptions ++ params
+
{- Runs a command in a remote, using ssh if necessary.
- (Honors annex-ssh-options.) -}
runCmd :: Git.Repo -> String -> [String] -> Annex Bool