diff options
-rw-r--r-- | Command/Move.hs | 4 | ||||
-rw-r--r-- | Remotes.hs | 40 | ||||
-rw-r--r-- | configure.hs | 2 | ||||
-rw-r--r-- | doc/install.mdwn | 2 |
4 files changed, 23 insertions, 25 deletions
diff --git a/Command/Move.hs b/Command/Move.hs index addeeae8a..e872d86fe 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -134,8 +134,8 @@ fromPerform move key = do else return Nothing -- fail fromCleanup :: Bool -> Git.Repo -> Key -> CommandCleanup fromCleanup True remote key = do - ok <- Remotes.runCmd remote "git-annex" - ["dropkey", "--quiet", "--force", + ok <- Remotes.onRemote remote "dropkey" + ["--quiet", "--force", "--backend=" ++ backendName key, keyName key] remoteHasKey remote key False diff --git a/Remotes.hs b/Remotes.hs index 78ab010ce..a775f71d4 100644 --- a/Remotes.hs +++ b/Remotes.hs @@ -15,7 +15,8 @@ module Remotes ( byName, copyFromRemote, copyToRemote, - runCmd + runCmd, + onRemote ) where import Control.Exception.Extensible @@ -37,7 +38,6 @@ import Utility import qualified Core import Messages import CopyFile -import qualified SysConfig {- Human visible list of remotes. -} list :: [Git.Repo] -> String @@ -118,7 +118,8 @@ inAnnex r key = if Git.repoIsUrl r Annex.eval a (Core.inAnnex key) checkremote = do showNote ("checking " ++ Git.repoDescribe r ++ "...") - inannex <- runCmd r "test" ["-e", annexLocation r key] + inannex <- onRemote r "inannex" + ["--backend=" ++ backendName key, keyName key] -- XXX Note that ssh failing and the file not existing -- are not currently differentiated. return $ Right inannex @@ -231,7 +232,7 @@ copyFromRemote r key file where keyloc = annexLocation r key getlocal = liftIO $ copyFile keyloc file - getssh = remoteCopyFile r (sshLocation r keyloc) file + getssh = remoteCopyFile True 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 @@ -245,35 +246,32 @@ copyToRemote r key file = do else error "copying to non-ssh repo not supported" where putlocal src = liftIO $ copyFile src file - putssh src = remoteCopyFile r src (sshLocation r file) + putssh src = remoteCopyFile False r src (sshLocation r file) sshLocation :: Git.Repo -> FilePath -> FilePath sshLocation r file = Git.urlHost r ++ ":" ++ shellEscape file -{- Copys a file from or to a remote, using rsync (when available) or scp. -} -remoteCopyFile :: Git.Repo -> String -> String -> Annex Bool -remoteCopyFile r src dest = do +{- Copies a file from or to a remote, using rsync (when available) or scp. -} +remoteCopyFile :: Bool -> Git.Repo -> String -> String -> Annex Bool +remoteCopyFile recv r src dest = do showProgress -- make way for progress bar o <- repoConfig r configopt "" res <- liftIO $ boolSystem cmd $ options ++ words o ++ [src, dest] if res then return res else do - when rsync $ - showLongNote "rsync failed -- run git annex again to resume file transfer" + showLongNote "rsync failed -- run git annex again to resume file transfer" return res where - cmd - | rsync = "rsync" - | otherwise = "scp" - configopt - | rsync = "rsync-options" - | otherwise = "scp-options" - options - -- inplace makes rsync resume partial files - | rsync = ["-p", "--progress", "--inplace"] - | otherwise = ["-p"] - rsync = SysConfig.rsync + cmd = "rsync" + configopt= "rsync-options" + -- inplace makes rsync resume partial files + options = ["-p", "--progress", "--inplace"] + +onRemote :: Git.Repo -> String -> [String] -> Annex Bool +onRemote r command params = runCmd r "git-annex-shell" (command:dir:params) + where + dir = Git.workTree r {- Runs a command in a remote, using ssh if necessary. - (Honors annex-ssh-options.) -} diff --git a/configure.hs b/configure.hs index 2334385a3..1abdc8914 100644 --- a/configure.hs +++ b/configure.hs @@ -22,7 +22,7 @@ tests = [ , TestCase "cp --reflink=auto" "cp_reflink_auto" $ testCp "--reflink=auto" , TestCase "uuid" "uuid" $ requireCmd "uuid" "uuid" , TestCase "xargs -0" "xargs_0" $ requireCmd "xargs -0" "xargs -0 </dev/null" - , TestCase "rsync" "rsync" $ testCmd "rsync --version >/dev/null" + , TestCase "rsync" "rsync" $ requireCmd "rsync" "rsync --version >/dev/null" ] tmpDir :: String diff --git a/doc/install.mdwn b/doc/install.mdwn index 1cff4462e..bad1d9f25 100644 --- a/doc/install.mdwn +++ b/doc/install.mdwn @@ -6,7 +6,7 @@ To build and use git-annex, you will need: * pcre-light: <http://hackage.haskell.org/package/pcre-light> * `uuid`: <http://www.ossp.org/pkg/lib/uuid/> * `xargs`: <http://savannah.gnu.org/projects/findutils/> -* `rsync`: <http://rsync.samba.org/> (optional but recommended) +* `rsync`: <http://rsync.samba.org/> * Then just [[download]] git-annex and run: `make; make install` ([Ikiwiki](http://ikiwiki.info) is needed to build the documentation, |