summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Command/Map.hs2
-rw-r--r--Remote/Git.hs35
-rw-r--r--Remote/Helper/Ssh.hs23
-rw-r--r--debian/changelog1
4 files changed, 38 insertions, 23 deletions
diff --git a/Command/Map.hs b/Command/Map.hs
index 86e9609a7..65e28945f 100644
--- a/Command/Map.hs
+++ b/Command/Map.hs
@@ -203,7 +203,7 @@ tryScan r
Git.Config.hRead r
configlist =
- onRemote r (pipedconfig, Nothing) "configlist" []
+ onRemote r (pipedconfig, Nothing) "configlist" [] []
manualconfiglist = do
sshparams <- sshToRepo r [Param sshcmd]
liftIO $ pipedconfig "ssh" sshparams
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 0b839c9a5..d80f580fc 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -31,6 +31,7 @@ import Utility.TempFile
import Config
import Init
import Types.Key
+import qualified Fields
remote :: RemoteType
remote = RemoteType {
@@ -111,7 +112,7 @@ guardUsable r onerr a
tryGitConfigRead :: Git.Repo -> Annex Git.Repo
tryGitConfigRead r
| not $ M.null $ Git.config r = return r -- already read
- | Git.repoIsSsh r = store $ onRemote r (pipedconfig, r) "configlist" []
+ | Git.repoIsSsh r = store $ onRemote r (pipedconfig, r) "configlist" [] []
| Git.repoIsHttp r = do
headers <- getHttpHeaders
store $ safely $ geturlconfig headers
@@ -171,7 +172,7 @@ inAnnex r key
v -> return v
checkremote = do
showAction $ "checking " ++ Git.repoDescribe r
- onRemote r (check, unknown) "inannex" [Param (show key)]
+ onRemote r (check, unknown) "inannex" [Param (show key)] []
where
check c p = dispatch <$> safeSystem c p
dispatch ExitSuccess = Right True
@@ -218,6 +219,7 @@ dropKey r key
[ Params "--quiet --force"
, Param $ show key
]
+ []
{- Tries to copy a key's content from a remote's annex to a file. -}
copyFromRemote :: Git.Repo -> Key -> AssociatedFile -> FilePath -> Annex Bool
@@ -231,7 +233,7 @@ copyFromRemote r key file dest
loc <- inRepo $ gitAnnexLocation key
upload u key file $
rsyncOrCopyFile params loc dest
- | Git.repoIsSsh r = rsyncHelper =<< rsyncParamsRemote r True key dest
+ | Git.repoIsSsh r = rsyncHelper =<< rsyncParamsRemote r True key dest file
| Git.repoIsHttp r = Annex.Content.downloadUrl (keyUrls r key) dest
| otherwise = error "copying from non-ssh, non-http repo not supported"
@@ -263,7 +265,7 @@ copyToRemote r key file
(rsyncOrCopyFile params keysrc)
| Git.repoIsSsh r = commitOnCleanup r $ do
keysrc <- inRepo $ gitAnnexLocation key
- rsyncHelper =<< rsyncParamsRemote r False key keysrc
+ rsyncHelper =<< rsyncParamsRemote r False key keysrc file
| otherwise = error "copying to non-ssh repo not supported"
rsyncHelper :: [CommandParam] -> Annex Bool
@@ -290,23 +292,26 @@ rsyncOrCopyFile rsyncparams src dest =
{- Generates rsync parameters that ssh to the remote and asks it
- to either receive or send the key's content. -}
-rsyncParamsRemote :: Git.Repo -> Bool -> Key -> FilePath -> Annex [CommandParam]
-rsyncParamsRemote r sending key file = do
+rsyncParamsRemote :: Git.Repo -> Bool -> Key -> FilePath -> AssociatedFile -> Annex [CommandParam]
+rsyncParamsRemote r sending key file afile = do
+ u <- getUUID
+ let fields = (Fields.remoteUUID, fromUUID u)
+ : maybe [] (\f -> [(Fields.associatedFile, f)]) afile
Just (shellcmd, shellparams) <- git_annex_shell r
(if sending then "sendkey" else "recvkey")
- [ Param $ show key
- -- Command is terminated with "--", because
- -- rsync will tack on its own options afterwards,
- -- and they need to be ignored.
- , Param "--"
- ]
+ [ Param $ show key ]
+ fields
-- Convert the ssh command into rsync command line.
let eparam = rsyncShell (Param shellcmd:shellparams)
o <- rsyncParams r
if sending
- then return $ o ++ eparam ++ [dummy, File file]
- else return $ o ++ eparam ++ [File file, dummy]
+ then return $ o ++ rsyncopts eparam dummy (File file)
+ else return $ o ++ rsyncopts eparam (File file) dummy
where
+ rsyncopts ps source dest
+ | end ps == [dashdash] = ps ++ [source, dest]
+ | otherwise = ps ++ [dashdash, source, dest]
+ dashdash = Param "--"
-- The rsync shell parameter controls where rsync
-- goes, so the source/dest parameter can be a dummy value,
-- that just enables remote rsync mode.
@@ -333,7 +338,7 @@ commitOnCleanup r a = go `after` a
Annex.Branch.commit "update"
| otherwise = void $ do
Just (shellcmd, shellparams) <-
- git_annex_shell r "commit" []
+ git_annex_shell r "commit" [] []
-- Throw away stderr, since the remote may not
-- have a new enough git-annex shell to
-- support committing.
diff --git a/Remote/Helper/Ssh.hs b/Remote/Helper/Ssh.hs
index f6742b89f..4434bc65d 100644
--- a/Remote/Helper/Ssh.hs
+++ b/Remote/Helper/Ssh.hs
@@ -1,6 +1,6 @@
{- git-annex remote access with ssh
-
- - Copyright 2011 Joey Hess <joey@kitenet.net>
+ - Copyright 2011.2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -13,6 +13,7 @@ import qualified Git.Url
import Config
import Annex.UUID
import Annex.Ssh
+import Fields
{- Generates parameters to ssh to a repository's host and run a command.
- Caller is responsible for doing any neccessary shellEscaping of the
@@ -25,9 +26,9 @@ sshToRepo repo sshcmd = do
{- Generates parameters to run a git-annex-shell command on a remote
- repository. -}
-git_annex_shell :: Git.Repo -> String -> [CommandParam] -> Annex (Maybe (FilePath, [CommandParam]))
-git_annex_shell r command params
- | not $ Git.repoIsUrl r = return $ Just (shellcmd, shellopts)
+git_annex_shell :: Git.Repo -> String -> [CommandParam] -> [(Field, String)] -> Annex (Maybe (FilePath, [CommandParam]))
+git_annex_shell r command params fields
+ | not $ Git.repoIsUrl r = return $ Just (shellcmd, shellopts ++ fieldopts)
| Git.repoIsSsh r = do
uuid <- getRepoUUID r
sshparams <- sshToRepo r [Param $ sshcmd uuid ]
@@ -39,9 +40,16 @@ git_annex_shell r command params
shellopts = Param command : File dir : params
sshcmd uuid = unwords $
shellcmd : map shellEscape (toCommand shellopts) ++
- uuidcheck uuid
+ uuidcheck uuid ++
+ map shellEscape (toCommand fieldopts)
uuidcheck NoUUID = []
uuidcheck (UUID u) = ["--uuid", u]
+ fieldopts
+ | null fields = []
+ | otherwise = fieldsep : map fieldopt fields ++ [fieldsep]
+ fieldsep = Param "--"
+ fieldopt (field, value) = Param $
+ fieldName field ++ "=" ++ value
{- Uses a supplied function (such as boolSystem) to run a git-annex-shell
- command on a remote.
@@ -53,9 +61,10 @@ onRemote
-> (FilePath -> [CommandParam] -> IO a, a)
-> String
-> [CommandParam]
+ -> [(Field, String)]
-> Annex a
-onRemote r (with, errorval) command params = do
- s <- git_annex_shell r command params
+onRemote r (with, errorval) command params fields = do
+ s <- git_annex_shell r command params fields
case s of
Just (c, ps) -> liftIO $ with c ps
Nothing -> return errorval
diff --git a/debian/changelog b/debian/changelog
index c279614ca..33c850861 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -3,6 +3,7 @@ git-annex (3.20120630) UNRELEASED; urgency=low
* get, move, copy: Now refuse to do anything when the requested file
transfer is already in progress by another process.
* status: Lists transfers that are currently in progress.
+ * Fix passing --uuid to git-annex-shell.
-- Joey Hess <joeyh@debian.org> Sun, 01 Jul 2012 15:04:37 -0400
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-06 07:24:55 +0000