webapp: Support using git-annex on a remote server, which was installed from the standalone tarball or OSX app, and so does not have git-annex in PATH (and may also not have git or rsync in PATH).

* webapp: Support using git-annex on a remote server, which was installed
  from the standalone tarball or OSX app, and so does not have
  git-annex in PATH (and may also not have git or rsync in PATH).
* standalone tarball, OSX app: Install a ~/.ssh/git-annex-wrapper, which
  can be used to run git-annex, git, rsync, etc.

Assistant/Install.hs

@@ -30,8 +30,8 @@ standaloneAppBase = getEnv "GIT_ANNEX_APP_BASE"
 
 {- The standalone app does not have an installation process.
  - So when it's run, it needs to set up autostarting of the assistant
- - daemon, as well as writing the programFile, and putting a
+ - daemon, as well as writing the programFile, and putting the
- - git-annex-shell wrapper into ~/.ssh
+ - git-annex-shell and git-annex-wrapper wrapper scripts into ~/.ssh
  -
  - Note that this is done every time it's started, so if the user moves
  - it around, the paths this sets up won't break.
@@ -59,30 +59,35 @@ ensureInstalled = go =<< standaloneAppBase
 #endif
 		installAutoStart program autostartfile
 
-		{- This shim is only updated if it doesn't
-		 - already exist with the right content. -}
 		sshdir <- sshDir
-		let shim = sshdir </> "git-annex-shell"
+		let runshell var = "exec " ++ base </> "runshell " ++ var
-		let runshell var = "exec " ++ base </> "runshell" ++
+		let rungitannexshell var = runshell $ "git-annex-shell -c \"" ++ var ++ "\""
-			" git-annex-shell -c \"" ++ var ++ "\""
+
-		let content = unlines
+		installWrapper (sshdir </> "git-annex-shell") $ unlines
 			[ shebang_local
 			, "set -e"
 			, "if [ \"x$SSH_ORIGINAL_COMMAND\" != \"x\" ]; then"
-			,   runshell "$SSH_ORIGINAL_COMMAND"
+			,   rungitannexshell "$SSH_ORIGINAL_COMMAND"
 			, "else"
-			,   runshell "$@"
+			,   rungitannexshell "$@"
 			, "fi"
 			]
-
+		installWrapper (sshdir </> "git-annex-wrapper") $ unlines
-		curr <- catchDefaultIO "" $ readFileStrict shim
+			[ shebang_local
-		when (curr /= content) $ do
+			, "set -e"
-			createDirectoryIfMissing True (parentDir shim)
+			, runshell "\"$@\""
-			viaTmp writeFile shim content
+			]
-			modifyFileMode shim $ addModes [ownerExecuteMode]
 
 		installNautilus program
 
+installWrapper :: FilePath -> String -> IO ()
+installWrapper file content = do
+	curr <- catchDefaultIO "" $ readFileStrict file
+	when (curr /= content) $ do
+		createDirectoryIfMissing True (parentDir file)
+		viaTmp writeFile file content
+		modifyFileMode file $ addModes [ownerExecuteMode]
+
 installNautilus :: FilePath -> IO ()
 #ifdef linux_HOST_OS
 installNautilus program = do

Assistant/WebApp/Configurators/Ssh.hs

@@ -156,7 +156,7 @@ postEnableSshGCryptR :: UUID -> Handler Html
 postEnableSshGCryptR u = whenGcryptInstalled $
 	enableSpecialSshRemote getsshinput enableRsyncNetGCrypt enablegcrypt u
   where
-  	enablegcrypt sshdata _ = prepSsh True sshdata $ \sshdata' ->
+  	enablegcrypt sshdata _ = prepSsh False sshdata $ \sshdata' ->
 		sshConfigurator $
 			checkExistingGCrypt sshdata' $
 				error "Expected to find an encrypted git repository, but did not."
@@ -195,6 +195,16 @@ enableSpecialSshRemote getsshinput rsyncnetsetup genericsetup u = do
 		description <- liftAnnex $ T.pack <$> prettyUUID u
 		$(widgetFile "configurators/ssh/enable")
 
+{- To deal with git-annex and possibly even git and rsync not being
+ - available in the remote server's PATH, when git-annex was installed
+ - from the standalone tarball etc, look for a ~/.ssh/git-annex-wrapper
+ - and if it's there, use it to run a command. -}
+wrapCommand :: String -> String
+wrapCommand cmd = "if [ -x " ++ commandWrapper ++ " ]; then " ++ commandWrapper ++ " " ++ cmd ++ "; else " ++ cmd ++ "; fi"
+
+commandWrapper :: String
+commandWrapper = "~/.ssh/git-annex-wrapper"
+
 {- Test if we can ssh into the server.
  -
  - Two probe attempts are made. First, try sshing in using the existing
@@ -204,8 +214,11 @@ enableSpecialSshRemote getsshinput rsyncnetsetup genericsetup u = do
  -
  - Once logged into the server, probe to see if git-annex-shell,
  - git, and rsync are available. 
+ -
  - Note that, ~/.ssh/git-annex-shell may be
  - present, while git-annex-shell is not in PATH.
+ - Also, git and rsync may not be in PATH; as long as the commandWrapper
+ - is present, assume it is able to be used to run them.
  -
  - Also probe to see if there is already a git repository at the location
  - with either an annex-uuid or a gcrypt-id set. (If not, returns NoUUID.)
@@ -236,6 +249,7 @@ testServer sshinput@(SshInput { inputHostname = Just hn }) = do
 			, checkcommand "git"
 			, checkcommand "rsync"
 			, checkcommand shim
+			, checkcommand commandWrapper
 			, getgitconfig (T.unpack <$> inputDirectory sshinput)
 			]
 		knownhost <- knownHost hn
@@ -258,6 +272,8 @@ testServer sshinput@(SshInput { inputHostname = Just hn }) = do
 			, (shim, GitAnnexShellCapable)
 			, ("git", GitCapable)
 			, ("rsync", RsyncCapable)
+			, (commandWrapper, GitCapable)
+			, (commandWrapper, RsyncCapable)
 			]
 		    u = fromMaybe NoUUID $ headMaybe $ mapMaybe finduuid $
 			map (separate (== '=')) $ lines s
@@ -276,7 +292,7 @@ testServer sshinput@(SshInput { inputHostname = Just hn }) = do
 	
 	checkcommand c = "if which " ++ c ++ "; then " ++ report c ++ "; fi"
 	token r = "git-annex-probe " ++ r
-	report r = "echo " ++ token r
+	report r = "echo " ++ shellEscape (token r)
 	shim = "~/.ssh/git-annex-shell"
 	getgitconfig (Just d)
 		| not (null d) = "cd " ++ shellEscape d ++ " && git config --list"
@@ -295,7 +311,8 @@ showSshErr :: String -> Handler Html
 showSshErr msg = sshConfigurator $
 	$(widgetFile "configurators/ssh/error")
 
-{- The UUID will be NoUUID when the repository does not already exist. -}
+{- The UUID will be NoUUID when the repository does not already exist,
+ - or was not a git-annex repository before. -}
 getConfirmSshR :: SshData -> UUID -> Handler Html
 getConfirmSshR sshdata u
 	| u == NoUUID = handlenew
@@ -329,8 +346,9 @@ getRetrySshR sshdata = do
 	s <- liftIO $ testServer $ mkSshInput sshdata
 	redirect $ either (const $ ConfirmSshR sshdata NoUUID) (uncurry ConfirmSshR) s
 
+{- Making a new git repository. -}
 getMakeSshGitR :: SshData -> Handler Html
-getMakeSshGitR sshdata = prepSsh False sshdata makeSshRepo
+getMakeSshGitR sshdata = prepSsh True sshdata makeSshRepo
 
 getMakeSshRsyncR :: SshData -> Handler Html
 getMakeSshRsyncR sshdata = prepSsh False (rsyncOnly sshdata) makeSshRepo
@@ -342,7 +360,7 @@ getMakeSshGCryptR :: SshData -> RepoKey -> Handler Html
 getMakeSshGCryptR sshdata NoRepoKey = whenGcryptInstalled $
 	withNewSecretKey $ getMakeSshGCryptR sshdata . RepoKey
 getMakeSshGCryptR sshdata (RepoKey keyid) = whenGcryptInstalled $
-	prepSsh True sshdata $ makeGCryptRepo keyid
+	prepSsh False sshdata $ makeGCryptRepo keyid
 	
 {- Detect if the user entered a location with an existing, known
  - gcrypt repository, and enable it. Otherwise, runs the action. -}
@@ -374,18 +392,18 @@ combineExistingGCrypt sshdata u = do
 
 {- Sets up remote repository for ssh, or directory for rsync. -}
 prepSsh :: Bool -> SshData -> (SshData -> Handler Html) -> Handler Html
-prepSsh newgcrypt sshdata a
+prepSsh needsinit sshdata a
 	| needsPubKey sshdata = do
 		keypair <- liftIO genSshKeyPair
 		sshdata' <- liftIO $ setupSshKeyPair keypair sshdata
-		prepSsh' newgcrypt sshdata sshdata' (Just keypair) a
+		prepSsh' needsinit sshdata sshdata' (Just keypair) a
 	| sshPort sshdata /= 22 = do
 		sshdata' <- liftIO $ setSshConfig sshdata []
-		prepSsh' newgcrypt sshdata sshdata' Nothing a
+		prepSsh' needsinit sshdata sshdata' Nothing a
-	| otherwise = prepSsh' newgcrypt sshdata sshdata Nothing a
+	| otherwise = prepSsh' needsinit sshdata sshdata Nothing a
 
 prepSsh' :: Bool -> SshData -> SshData -> Maybe SshKeyPair -> (SshData -> Handler Html) -> Handler Html
-prepSsh' newgcrypt origsshdata sshdata keypair a = sshSetup
+prepSsh' needsinit origsshdata sshdata keypair a = sshSetup
 	 [ "-p", show (sshPort origsshdata)
 	 , genSshHost (sshHostName origsshdata) (sshUserName origsshdata)
 	 , remoteCommand
@@ -395,8 +413,14 @@ prepSsh' newgcrypt origsshdata sshdata keypair a = sshSetup
 	remoteCommand = shellWrap $ intercalate "&&" $ catMaybes
 		[ Just $ "mkdir -p " ++ shellEscape remotedir
 		, Just $ "cd " ++ shellEscape remotedir
-		, if rsynconly then Nothing else Just "if [ ! -d .git ]; then git init --bare --shared && git config receive.denyNonFastforwards false; fi"
+		, if rsynconly then Nothing else Just $ unwords
-		, if rsynconly || newgcrypt then Nothing else Just "git annex init"
+			[ "if [ ! -d .git ]; then"
+			, wrapCommand "git init --bare --shared"
+		, "&&"
+			, wrapCommand "git config receive.denyNonFastforwards"
+			, ";fi"
+			]
+		, if needsinit then Just (wrapCommand "git annex init") else Nothing
 		, if needsPubKey origsshdata
 			then addAuthorizedKeysCommand (hasCapability origsshdata GitAnnexShellCapable) remotedir . sshPubKey <$> keypair
 			else Nothing

debian/changelog

@@ -32,6 +32,11 @@ git-annex (5.20140413) UNRELEASED; urgency=medium
   * webapp: Fix UI for removing XMPP connection.
   * When init detects that git is not configured to commit, and sets
     user.email to work around the problem, also make it set user.name.
+  * webapp: Support using git-annex on a remote server, which was installed
+    from the standalone tarball or OSX app, and so does not have
+    git-annex in PATH (and may also not have git or rsync in PATH).
+  * standalone tarball, OSX app: Install a ~/.ssh/git-annex-wrapper, which
+    can be used to run git-annex, git, rsync, etc.
 
  -- Joey Hess <joeyh@debian.org>  Fri, 11 Apr 2014 21:33:35 -0400
 

standalone/linux/skel/runshell

@@ -34,11 +34,26 @@ if [ ! -e "$HOME/.ssh/git-annex-shell" ]; then
 	(
 		echo "#!/bin/sh"
 		echo "set -e"
+		echo "if [ \"x\$SSH_ORIGINAL_COMMAND\" != \"x\" ]; then"
 		echo "exec $base/runshell git-annex-shell -c \"\$SSH_ORIGINAL_COMMAND\""
+		echo "else"
+		echo "exec $base/runshell git-annex-shell -c \"\$@\""
+		echo "fi"
 	) > "$HOME/.ssh/git-annex-shell"
 	chmod +x "$HOME/.ssh/git-annex-shell"
 fi
 
+# And this shim is used by the webapp when adding a remote ssh server.
+if [ ! -e "$HOME/.ssh/git-annex-wrapper" ]; then
+	mkdir "$HOME/.ssh" >/dev/null 2>&1 || true
+	(
+		echo "#!/bin/sh"
+		echo "set -e"
+		echo "exec $base/runshell \"\$@\""
+	) > "$HOME/.ssh/git-annex-wrapper"
+	chmod +x "$HOME/.ssh/git-annex-wrapper"
+fi
+
 # Put our binaries first, to avoid issues with out of date or incompatable
 # system binaries.
 ORIG_PATH="$PATH"

standalone/osx/git-annex.app/Contents/MacOS/runshell

@@ -36,11 +36,26 @@ if [ ! -e "$HOME/.ssh/git-annex-shell" ]; then
 	(
 		echo "#!/bin/sh"
 		echo "set -e"
+		echo "if [ \"x\$SSH_ORIGINAL_COMMAND\" != \"x\" ]; then"
 		echo "exec $base/runshell git-annex-shell -c \"\$SSH_ORIGINAL_COMMAND\""
+		echo "else"
+		echo "exec $base/runshell git-annex-shell -c \"\$@\""
+		echo "fi"
 	) > "$HOME/.ssh/git-annex-shell"
 	chmod +x "$HOME/.ssh/git-annex-shell"
 fi
 
+# And this shim is used by the webapp when adding a remote ssh server.
+if [ ! -e "$HOME/.ssh/git-annex-wrapper" ]; then
+	mkdir "$HOME/.ssh" >/dev/null 2>&1 || true
+	(
+		echo "#!/bin/sh"
+		echo "set -e"
+		echo "exec $base/runshell \"\$@\""
+	) > "$HOME/.ssh/git-annex-wrapper"
+	chmod +x "$HOME/.ssh/git-annex-wrapper"
+fi
+
 # Put our binaries first, to avoid issues with out of date or incompatable
 # system binaries.
 ORIG_PATH="$PATH"