webapp: When setting up authorized_keys, use GIT_ANNEX_SHELL_DIRECTORY.

Assistant/Pairing/MakeRemote.hs

@@ -18,10 +18,10 @@ import qualified Data.Text as T
 
 {- Authorized keys are set up before pairing is complete, so that the other
  - side can immediately begin syncing. -}
-setupAuthorizedKeys :: PairMsg -> IO ()
+setupAuthorizedKeys :: PairMsg -> FilePath -> IO ()
-setupAuthorizedKeys msg = do
+setupAuthorizedKeys msg repodir = do
 	validateSshPubKey pubkey
-	unlessM (liftIO $ addAuthorizedKeys False pubkey) $
+	unlessM (liftIO $ addAuthorizedKeys False repodir pubkey) $
 		error "failed setting up ssh authorized keys"
   where
 	pubkey = remoteSshPubKey $ pairMsgData msg

Assistant/Ssh.hs

@@ -116,13 +116,13 @@ validateSshPubKey pubkey = either error return $ check $ words pubkey
 		| all (\c -> isAlphaNum c || c == '@' || c == '-' || c == '_') comment = ok
 		| otherwise = err "bad comment in ssh public key"
 
-addAuthorizedKeys :: Bool -> SshPubKey -> IO Bool
+addAuthorizedKeys :: Bool -> FilePath -> SshPubKey -> IO Bool
-addAuthorizedKeys rsynconly pubkey = boolSystem "sh"
+addAuthorizedKeys rsynconly dir pubkey = boolSystem "sh"
-	[ Param "-c" , Param $ addAuthorizedKeysCommand rsynconly pubkey ]
+	[ Param "-c" , Param $ addAuthorizedKeysCommand rsynconly dir pubkey ]
 
-removeAuthorizedKeys :: Bool -> SshPubKey -> IO ()
+removeAuthorizedKeys :: Bool -> FilePath -> SshPubKey -> IO ()
-removeAuthorizedKeys rsynconly pubkey = do
+removeAuthorizedKeys rsynconly dir pubkey = do
-	let keyline = authorizedKeysLine rsynconly pubkey
+	let keyline = authorizedKeysLine rsynconly dir pubkey
 	sshdir <- sshDir
 	let keyfile = sshdir </> ".authorized_keys"
 	ls <- lines <$> readFileStrict keyfile
@@ -134,8 +134,8 @@ removeAuthorizedKeys rsynconly pubkey = do
  - The ~/.ssh/git-annex-shell wrapper script is created if not already
  - present.
  -}
-addAuthorizedKeysCommand :: Bool -> SshPubKey -> String
+addAuthorizedKeysCommand :: Bool -> FilePath -> SshPubKey -> String
-addAuthorizedKeysCommand rsynconly pubkey = join "&&"
+addAuthorizedKeysCommand rsynconly dir pubkey = join "&&"
 	[ "mkdir -p ~/.ssh"
 	, join "; "
 		[ "if [ ! -e " ++ wrapper ++ " ]"
@@ -147,7 +147,7 @@ addAuthorizedKeysCommand rsynconly pubkey = join "&&"
 	, "chmod 600 ~/.ssh/authorized_keys"
 	, unwords
 		[ "echo"
-		, shellEscape $ authorizedKeysLine rsynconly pubkey
+		, shellEscape $ authorizedKeysLine rsynconly dir pubkey
 		, ">>~/.ssh/authorized_keys"
 		]
 	]
@@ -160,14 +160,14 @@ addAuthorizedKeysCommand rsynconly pubkey = join "&&"
 		, "exec git-annex-shell -c \"$SSH_ORIGINAL_COMMAND\""
 		]
 
-authorizedKeysLine :: Bool -> SshPubKey -> String
+authorizedKeysLine :: Bool -> FilePath -> SshPubKey -> String
-authorizedKeysLine rsynconly pubkey
+authorizedKeysLine rsynconly dir pubkey
 	{- TODO: Locking down rsync is difficult, requiring a rather
 	 - long perl script. -}
 	| rsynconly = pubkey
 	| otherwise = limitcommand ++ pubkey
   where
-	limitcommand = "command=\"~/.ssh/git-annex-shell\",no-agent-forwarding,no-port-forwarding,no-X11-forwarding "
+	limitcommand = "command=\"GIT_ANNEX_SHELL_DIRECTORY="++shellEscape dir++" ~/.ssh/git-annex-shell\",no-agent-forwarding,no-port-forwarding,no-X11-forwarding "
 
 {- Generates a ssh key pair. -}
 genSshKeyPair :: IO SshKeyPair

Assistant/Threads/PairListener.hs

@@ -16,6 +16,7 @@ import Assistant.WebApp.Types
 import Assistant.Alert
 import Assistant.DaemonStatus
 import Utility.ThreadScheduler
+import Git
 
 import Network.Multicast
 import Network.Socket
@@ -120,7 +121,8 @@ pairReqReceived False urlrenderer msg = do
 pairAckReceived :: Bool -> Maybe PairingInProgress -> PairMsg -> [PairingInProgress] -> Assistant [PairingInProgress]
 pairAckReceived True (Just pip) msg cache = do
 	stopSending pip
-	liftIO $ setupAuthorizedKeys msg
+	repodir <- repoPath <$> liftAnnex gitRepo
+	liftIO $ setupAuthorizedKeys msg repodir
 	finishedPairing msg (inProgressSshKeyPair pip)
 	startSending pip PairDone $ multicastPairMsg
 		(Just 1) (inProgressSecret pip) (inProgressPairData pip)

Assistant/WebApp/Configurators/Pairing.hs

@@ -37,6 +37,7 @@ import Assistant.Types.NetMessager
 import Assistant.NetMessager
 #endif
 import Utility.UserInfo
+import Git
 
 import Yesod
 import Data.Text (Text)
@@ -125,12 +126,13 @@ noLocalPairing = noPairing "local"
 getFinishLocalPairR :: PairMsg -> Handler RepHtml
 #ifdef WITH_PAIRING
 getFinishLocalPairR msg = promptSecret (Just msg) $ \_ secret -> do
-	liftIO $ setup
+	repodir <- lift $ repoPath <$> runAnnex undefined gitRepo
-	startLocalPairing PairAck cleanup alert uuid "" secret
+	liftIO $ setup repodir
+	startLocalPairing PairAck (cleanup repodir) alert uuid "" secret
   where
 	alert = pairRequestAcknowledgedAlert (pairRepo msg) . Just
-	setup  = setupAuthorizedKeys msg
+	setup repodir = setupAuthorizedKeys msg repodir
-	cleanup = removeAuthorizedKeys False $
+	cleanup repodir = removeAuthorizedKeys False repodir $
 		remoteSshPubKey $ pairMsgData msg
 	uuid = Just $ pairUUID $ pairMsgData msg
 #else

Assistant/WebApp/Configurators/Ssh.hs

@@ -276,7 +276,7 @@ makeSsh' rsync setup sshdata keypair =
 		, if rsync then Nothing else Just "git init --bare --shared"
 		, if rsync then Nothing else Just "git annex init"
 		, if needsPubKey sshdata
-			then addAuthorizedKeysCommand (rsyncOnly sshdata) . sshPubKey <$> keypair
+			then addAuthorizedKeysCommand (rsyncOnly sshdata) remotedir . sshPubKey <$> keypair
 			else Nothing
 		]
 

debian/changelog

@@ -42,6 +42,7 @@ git-annex (3.20121018) UNRELEASED; urgency=low
     name they were originally created using.
   * git-annex-shell: GIT_ANNEX_SHELL_DIRECTORY can be set to limit it
     to operating on a specified directory.
+  * webapp: When setting up authorized_keys, use GIT_ANNEX_SHELL_DIRECTORY.
 
  -- Joey Hess <joeyh@debian.org>  Wed, 17 Oct 2012 14:24:10 -0400