git-annex-shell uuid verification

* git-annex now asks git-annex-shell to verify that it's operating in
  the expected repository.
* Note that this git-annex will not interoperate with remotes using
  older versions of git-annex-shell.

The reason for this check is to avoid git-annex getting confused about
what remote repository actually contains a value. It's a prerequisite for
supporting git insteadOf aliases.

Command.hs

@@ -189,6 +189,8 @@ paramGlob :: String
 paramGlob = "GLOB"
 paramName :: String
 paramName = "NAME"
+paramUUID :: String
+paramUUID = "UUID"
 paramType :: String
 paramType = "TYPE"
 paramKeyValue :: String

Utility/Ssh.hs

@@ -13,6 +13,7 @@ import qualified Git
 import Utility.SafeCommand
 import Types
 import Config
+import UUID
 
 {- Generates parameters to ssh to a repository's host and run a command.
  - Caller is responsible for doing any neccessary shellEscaping of the
@@ -33,15 +34,20 @@ git_annex_shell :: Git.Repo -> String -> [CommandParam] -> Annex (Maybe (FilePat
 git_annex_shell r command params
 	| not $ Git.repoIsUrl r = return $ Just (shellcmd, shellopts)
 	| Git.repoIsSsh r = do
-		sshparams <- sshToRepo r [Param sshcmd]
+		uuid <- getUUID r
+		sshparams <- sshToRepo r [Param $ sshcmd uuid ]
 		return $ Just ("ssh", sshparams)
 	| otherwise = return Nothing
 	where
 		dir = Git.workTree r
 		shellcmd = "git-annex-shell"
 		shellopts = Param command : File dir : params
-		sshcmd = shellcmd ++ " " ++ 
-			unwords (map shellEscape $ toCommand shellopts)
+		sshcmd uuid = unwords $
+			shellcmd : (map shellEscape $ toCommand shellopts) ++
+			uuidcheck uuid
+		uuidcheck uuid
+			| null uuid = []
+			| otherwise = ["--uuid", uuid]
 
 {- Uses a supplied function (such as boolSystem) to run a git-annex-shell
  - command on a remote.

debian/changelog

@@ -13,6 +13,11 @@ git-annex (3.20110929) UNRELEASED; urgency=low
   * Note that older versions of git-annex will display the timestamp as part
     of the repository description, which is ugly but otherwise harmless.
   * Add timestamps to trust.log and remote.log too.
+  * git-annex-shell: Added the --uuid option.
+  * git-annex now asks git-annex-shell to verify that it's operating in 
+    the expected repository.
+  * Note that this git-annex will not interoperate with remotes using 
+    older versions of git-annex-shell.
 
  -- Joey Hess <joeyh@debian.org>  Thu, 29 Sep 2011 18:58:53 -0400
 

git-annex-shell.hs

@@ -6,12 +6,14 @@
  -}
 
 import System.Environment
+import System.Console.GetOpt
 
 import Common.Annex
 import qualified Git
 import CmdLine
 import Command
 import Options
+import UUID
 
 import qualified Command.ConfigList
 import qualified Command.InAnnex
@@ -30,6 +32,16 @@ cmds = map adddirparam $ concat
 	where
 		adddirparam c = c { cmdparams = "DIRECTORY " ++ cmdparams c }
 
+options :: [OptDescr (Annex ())]
+options = uuid : commonOptions
+	where
+		uuid = Option [] ["uuid"] (ReqArg check paramUUID) "repository uuid"
+		check expected = do
+			u <- getUUID =<< gitRepo
+			when (u /= expected) $ error $
+				"expected repository UUID " ++ expected
+					++ " but found UUID " ++ u
+
 header :: String
 header = "Usage: git-annex-shell [-c] command [parameters ...] [option ..]"
 
@@ -57,7 +69,7 @@ builtins = map cmdname cmds
 builtin :: String -> String -> [String] -> IO ()
 builtin cmd dir params =
 	Git.repoAbsPath dir >>= Git.repoFromAbsPath >>=
-		dispatch (cmd : filterparams params) cmds commonOptions header
+		dispatch (cmd : filterparams params) cmds options header
 
 external :: [String] -> IO ()
 external params =
@@ -72,4 +84,4 @@ filterparams ("--":_) = []
 filterparams (a:as) = a:filterparams as
 
 failure :: IO ()
-failure = error $ "bad parameters\n\n" ++ usage header cmds commonOptions
+failure = error $ "bad parameters\n\n" ++ usage header cmds options