unfinished switch to using git-annex-shell

This commit is contained in:
Joey Hess 2010-12-30 20:31:52 -04:00
parent a5a302b77d
commit f38aa3e83a
4 changed files with 23 additions and 25 deletions

View file

@ -134,8 +134,8 @@ fromPerform move key = do
else return Nothing -- fail else return Nothing -- fail
fromCleanup :: Bool -> Git.Repo -> Key -> CommandCleanup fromCleanup :: Bool -> Git.Repo -> Key -> CommandCleanup
fromCleanup True remote key = do fromCleanup True remote key = do
ok <- Remotes.runCmd remote "git-annex" ok <- Remotes.onRemote remote "dropkey"
["dropkey", "--quiet", "--force", ["--quiet", "--force",
"--backend=" ++ backendName key, "--backend=" ++ backendName key,
keyName key] keyName key]
remoteHasKey remote key False remoteHasKey remote key False

View file

@ -15,7 +15,8 @@ module Remotes (
byName, byName,
copyFromRemote, copyFromRemote,
copyToRemote, copyToRemote,
runCmd runCmd,
onRemote
) where ) where
import Control.Exception.Extensible import Control.Exception.Extensible
@ -37,7 +38,6 @@ import Utility
import qualified Core import qualified Core
import Messages import Messages
import CopyFile import CopyFile
import qualified SysConfig
{- Human visible list of remotes. -} {- Human visible list of remotes. -}
list :: [Git.Repo] -> String list :: [Git.Repo] -> String
@ -118,7 +118,8 @@ inAnnex r key = if Git.repoIsUrl r
Annex.eval a (Core.inAnnex key) Annex.eval a (Core.inAnnex key)
checkremote = do checkremote = do
showNote ("checking " ++ Git.repoDescribe r ++ "...") 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 -- XXX Note that ssh failing and the file not existing
-- are not currently differentiated. -- are not currently differentiated.
return $ Right inannex return $ Right inannex
@ -231,7 +232,7 @@ copyFromRemote r key file
where where
keyloc = annexLocation r key keyloc = annexLocation r key
getlocal = liftIO $ copyFile keyloc file 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. -} {- Tries to copy a key's content to a file on a remote. -}
copyToRemote :: Git.Repo -> Key -> FilePath -> Annex Bool 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" else error "copying to non-ssh repo not supported"
where where
putlocal src = liftIO $ copyFile src file 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 :: Git.Repo -> FilePath -> FilePath
sshLocation r file = Git.urlHost r ++ ":" ++ shellEscape file sshLocation r file = Git.urlHost r ++ ":" ++ shellEscape file
{- Copys a file from or to a remote, using rsync (when available) or scp. -} {- Copies a file from or to a remote, using rsync (when available) or scp. -}
remoteCopyFile :: Git.Repo -> String -> String -> Annex Bool remoteCopyFile :: Bool -> Git.Repo -> String -> String -> Annex Bool
remoteCopyFile r src dest = do remoteCopyFile recv r src dest = do
showProgress -- make way for progress bar showProgress -- make way for progress bar
o <- repoConfig r configopt "" o <- repoConfig r configopt ""
res <- liftIO $ boolSystem cmd $ options ++ words o ++ [src, dest] res <- liftIO $ boolSystem cmd $ options ++ words o ++ [src, dest]
if res if res
then return res then return res
else do 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 return res
where where
cmd cmd = "rsync"
| rsync = "rsync" configopt= "rsync-options"
| otherwise = "scp" -- inplace makes rsync resume partial files
configopt options = ["-p", "--progress", "--inplace"]
| rsync = "rsync-options"
| otherwise = "scp-options" onRemote :: Git.Repo -> String -> [String] -> Annex Bool
options onRemote r command params = runCmd r "git-annex-shell" (command:dir:params)
-- inplace makes rsync resume partial files where
| rsync = ["-p", "--progress", "--inplace"] dir = Git.workTree r
| otherwise = ["-p"]
rsync = SysConfig.rsync
{- Runs a command in a remote, using ssh if necessary. {- Runs a command in a remote, using ssh if necessary.
- (Honors annex-ssh-options.) -} - (Honors annex-ssh-options.) -}

View file

@ -22,7 +22,7 @@ tests = [
, TestCase "cp --reflink=auto" "cp_reflink_auto" $ testCp "--reflink=auto" , TestCase "cp --reflink=auto" "cp_reflink_auto" $ testCp "--reflink=auto"
, TestCase "uuid" "uuid" $ requireCmd "uuid" "uuid" , TestCase "uuid" "uuid" $ requireCmd "uuid" "uuid"
, TestCase "xargs -0" "xargs_0" $ requireCmd "xargs -0" "xargs -0 </dev/null" , 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 tmpDir :: String

View file

@ -6,7 +6,7 @@ To build and use git-annex, you will need:
* pcre-light: <http://hackage.haskell.org/package/pcre-light> * pcre-light: <http://hackage.haskell.org/package/pcre-light>
* `uuid`: <http://www.ossp.org/pkg/lib/uuid/> * `uuid`: <http://www.ossp.org/pkg/lib/uuid/>
* `xargs`: <http://savannah.gnu.org/projects/findutils/> * `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` * Then just [[download]] git-annex and run: `make; make install`
([Ikiwiki](http://ikiwiki.info) is needed to build the documentation, ([Ikiwiki](http://ikiwiki.info) is needed to build the documentation,