git-annex-shell: block relay requests

connRepo is only used when relaying git upload-pack and receive-pack.
That's only supposed to be used when git-annex-remotedaemon is serving
git-remote-tor-annex connections over tor. But, it was always set, and
so could be used in other places possibly.

Fixed by making connRepo optional in the P2P protocol interface.

In Command.EnableTor, it's not needed, because it only speaks the
protocol in order to check that it's able to connect back to itself via
the hidden service. So changed that to pass Nothing rather than the git
repo.

In Remote.Helper.Ssh, it's connecting to git-annex-shell p2pstdio,
so is making the requests, so will never need connRepo.

In git-annex-shell p2pstdio, it was accepting git upload-pack and
receive-pack requests over the P2P protocol, even though nothing sent
them. This is arguably a security hole, particularly if the user has
set environment variables like GIT_ANNEX_SHELL_LIMITED to prevent
git push/pull via git-annex-shell.

CmdLine/GitRemoteTorAnnex.hs

@@ -58,7 +58,7 @@ connectService address port service = do
 			<$> loadP2PRemoteAuthToken (TorAnnex address port)
 		myuuid <- getUUID
 		g <- Annex.gitRepo
-		conn <- liftIO $ connectPeer g (TorAnnex address port)
+		conn <- liftIO $ connectPeer (Just g) (TorAnnex address port)
 		runst <- liftIO $ mkRunState Client
 		r <- liftIO $ runNetProto runst conn $ auth myuuid authtoken noop >>= \case
 			Just _theiruuid -> connect service stdin stdout

Command/EnableTor.hs

@@ -105,11 +105,10 @@ checkHiddenService = bracket setup cleanup go
 
 	check 0 _ = giveup "Still unable to connect to hidden service. It might not yet be usable by others. Please check Tor's logs for details."
 	check _ [] = giveup "Somehow didn't get an onion address."
-	check n addrs@(addr:_) = do
-		g <- Annex.gitRepo
+	check n addrs@(addr:_) =
 		-- Connect but don't bother trying to auth,
 		-- we just want to know if the tor circuit works.
-		liftIO (tryNonAsync $ connectPeer g addr) >>= \case
+		liftIO (tryNonAsync $ connectPeer Nothing addr) >>= \case
 			Left e -> do
 				warning $ UnquotedString $ "Unable to connect to hidden service. It may not yet have propagated to the Tor network. (" ++ show e ++ ") Will retry.."
 				liftIO $ threadDelaySeconds (Seconds 2)
@@ -123,19 +122,18 @@ checkHiddenService = bracket setup cleanup go
 	-- service's socket, start a listener. This is only run during the
 	-- check, and it refuses all auth attempts.
 	startlistener = do
-		r <- Annex.gitRepo
 		u <- getUUID
 		msock <- torSocketFile
 		case msock of
 			Just sockfile -> ifM (liftIO $ haslistener sockfile)
 				( liftIO $ async $ return ()
-				, liftIO $ async $ runlistener sockfile u r
+				, liftIO $ async $ runlistener sockfile u
 				)
 			Nothing -> giveup "Could not find socket file in Tor configuration!"
 	
-	runlistener sockfile u r = serveUnixSocket sockfile $ \h -> do
+	runlistener sockfile u = serveUnixSocket sockfile $ \h -> do
 		let conn = P2PConnection
-			{ connRepo = r
+			{ connRepo = Nothing
 			, connCheckAuth = const False
 			, connIhdl = h
 			, connOhdl = h

Command/P2P.hs

@@ -291,7 +291,7 @@ data LinkResult
 setupLink :: RemoteName -> P2PAddressAuth -> Annex LinkResult
 setupLink remotename (P2PAddressAuth addr authtoken) = do
 	g <- Annex.gitRepo
-	cv <- liftIO $ tryNonAsync $ connectPeer g addr
+	cv <- liftIO $ tryNonAsync $ connectPeer (Just g) addr
 	case cv of
 		Left e -> return $ ConnectionError $ "Unable to connect with peer. Please check that the peer is connected to the network, and try again. ("  ++ show e ++ ")"
 		Right conn -> do

Command/P2PStdIO.hs

@@ -36,7 +36,7 @@ start theiruuid = startingCustomOutput (ActionItemOther Nothing) $ do
 			(False, True) -> P2P.ServeAppendOnly
 			(False, False) -> P2P.ServeReadWrite
 	myuuid <- getUUID
-	conn <- stdioP2PConnection <$> Annex.gitRepo
+	let conn = stdioP2PConnection Nothing
 	let server = do
 		P2P.net $ P2P.sendMessage (P2P.AUTH_SUCCESS myuuid)
 		P2P.serveAuthed servermode myuuid

P2P/IO.hs

@@ -75,7 +75,7 @@ mkRunState mk = do
 	return (mk tvar)
 
 data P2PConnection = P2PConnection
-	{ connRepo :: Repo
+	{ connRepo :: Maybe Repo
 	, connCheckAuth :: (AuthToken -> Bool)
 	, connIhdl :: Handle
 	, connOhdl :: Handle
@@ -90,7 +90,7 @@ data ClosableConnection conn
 	| ClosedConnection
 
 -- P2PConnection using stdio.
-stdioP2PConnection :: Git.Repo -> P2PConnection
+stdioP2PConnection :: Maybe Git.Repo -> P2PConnection
 stdioP2PConnection g = P2PConnection
 	{ connRepo = g
 	, connCheckAuth = const False
@@ -100,7 +100,7 @@ stdioP2PConnection g = P2PConnection
 	}
 
 -- Opens a connection to a peer. Does not authenticate with it.
-connectPeer :: Git.Repo -> P2PAddress -> IO P2PConnection
+connectPeer :: Maybe Git.Repo -> P2PAddress -> IO P2PConnection
 connectPeer g (TorAnnex onionaddress onionport) = do
 	h <- setupHandle =<< connectHiddenService onionaddress onionport
 	return $ P2PConnection
@@ -154,8 +154,7 @@ setupHandle s = do
 -- Purposefully incomplete interpreter of Proto.
 --
 -- This only runs Net actions. No Local actions will be run
--- (those need the Annex monad) -- if the interpreter reaches any,
--- it returns Nothing.
+-- (those need the Annex monad).
 runNetProto :: RunState -> P2PConnection -> Proto a -> IO (Either ProtoFailure a)
 runNetProto runst conn = go
   where
@@ -286,19 +285,21 @@ runRelay runner (RelayHandle hout) (RelayHandle hin) =
 	go (v, _, _) = relayHelper runner v
 
 runRelayService :: P2PConnection -> RunProto IO -> Service -> IO (Either ProtoFailure ())
-runRelayService conn runner service =
-	withCreateProcess serviceproc' go
+runRelayService conn runner service = case connRepo conn of
+	Just repo -> withCreateProcess (serviceproc' repo) go
 		`catchNonAsync` (return . Left . ProtoFailureException)
+	Nothing -> return $ Left $ ProtoFailureMessage
+		"relaying to git not supported on this connection"
   where
 	cmd = case service of
 		UploadPack -> "upload-pack"
 		ReceivePack -> "receive-pack"
 	
-	serviceproc = gitCreateProcess
+	serviceproc repo = gitCreateProcess
 		[ Param cmd
-		, File (fromRawFilePath (repoPath (connRepo conn)))
-		] (connRepo conn)
-	serviceproc' = serviceproc 
+		, File (fromRawFilePath (repoPath repo))
+		] repo
+	serviceproc' repo = (serviceproc repo)
 		{ std_out = CreatePipe
 		, std_in = CreatePipe
 		}

Remote/Helper/Ssh.hs

@@ -239,9 +239,9 @@ openP2PSshConnection r connpool = do
 		Nothing -> do
 			liftIO $ rememberunsupported
 			return Nothing
-		Just (cmd, params) -> start cmd params =<< getRepo r
+		Just (cmd, params) -> start cmd params
   where
-	start cmd params repo = liftIO $ do
+	start cmd params = liftIO $ do
 		(Just from, Just to, Nothing, pid) <- createProcess $
 			(proc cmd (toCommand params))
 				{ std_in = CreatePipe
@@ -249,7 +249,7 @@ openP2PSshConnection r connpool = do
 				}
 		pidnum <- getPid pid
 		let conn = P2P.P2PConnection
-			{ P2P.connRepo = repo
+			{ P2P.connRepo = Nothing
 			, P2P.connCheckAuth = const False
 			, P2P.connIhdl = to
 			, P2P.connOhdl = from

Remote/P2P.hs

@@ -143,7 +143,7 @@ withConnection u addr connpool a = bracketOnError get cache go
 openConnection :: UUID -> P2PAddress -> Annex Connection
 openConnection u addr = do
 	g <- Annex.gitRepo
-	v <- liftIO $ tryNonAsync $ connectPeer g addr
+	v <- liftIO $ tryNonAsync $ connectPeer (Just g) addr
 	case v of
 		Right conn -> do
 			myuuid <- getUUID

RemoteDaemon/Transport/Tor.hs

@@ -111,7 +111,7 @@ serveClient th@(TransportHandle _ _ rd) u r q = bracket setup cleanup start
 			-- when the allowed set is changed.
 			allowed <- loadP2PAuthTokens
 			let conn = P2PConnection
-				{ connRepo = r
+				{ connRepo = Just r
 				, connCheckAuth = (`isAllowedAuthToken` allowed)
 				, connIhdl = h
 				, connOhdl = h
@@ -146,7 +146,7 @@ transport (RemoteRepo r gc) url@(RemoteURI uri) th ichan ochan =
 		Nothing -> return ()
 		Just addr -> robustConnection 1 $ do
 			g <- liftAnnex th Annex.gitRepo
-			bracket (connectPeer g addr) closeConnection (go addr)
+			bracket (connectPeer (Just g) addr) closeConnection (go addr)
   where
 	go addr conn = do
 		myuuid <- liftAnnex th getUUID