core: enforce allowRemoteCommand on the host (#7370)

src/Simplex/Chat/Controller.hs

@@ -695,6 +695,11 @@ planResolveModeP =
     "never" -> pure PRMNever
     _ -> fail "bad PlanResolveMode"
 
+data CommandSource
+  = CSLocal -- entered on this device
+  | CSRemoteHost RemoteHostId -- forwarded to a paired remote host
+  | CSRemoteCtrl -- received from a paired remote controller
+
 allowRemoteCommand :: ChatCommand -> Bool -- XXX: consider using Relay/Block/ForceLocal
 allowRemoteCommand = \case
   StartChat {} -> False

src/Simplex/Chat/Core.hs

@@ -97,7 +97,7 @@ runSimplexChat ChatConfig {testView} ChatOpts {coreOptions = CoreChatOpts {chatR
       waitEither_ a1 a2
 
 sendChatCmdStr :: ChatController -> String -> IO (Either ChatError ChatResponse)
-sendChatCmdStr cc s = runReaderT (execChatCommand Nothing (encodeUtf8 $ T.pack s) 0) cc
+sendChatCmdStr cc s = runReaderT (execChatCommand CSLocal (encodeUtf8 $ T.pack s) 0) cc
 
 sendChatCmd :: ChatController -> ChatCommand -> IO (Either ChatError ChatResponse)
 sendChatCmd cc cmd = runReaderT (execChatCommand' cmd 0) cc

src/Simplex/Chat/Library/Commands.hs

@@ -378,19 +378,24 @@ useServers as opDomains uss =
       xftp' = useServerCfgs SPXFTP as opDomains $ concatMap (servers' SPXFTP) uss
    in (smp', xftp')
 
-execChatCommand :: Maybe RemoteHostId -> ByteString -> Int -> CM' (Either ChatError ChatResponse)
-execChatCommand rh s retryNum =
+execChatCommand :: CommandSource -> ByteString -> Int -> CM' (Either ChatError ChatResponse)
+execChatCommand src s retryNum =
   case parseChatCommand s of
     Left e -> pure $ chatCmdError e
-    Right cmd -> case rh of
-      Just rhId
+    Right cmd -> case src of
+      CSRemoteHost rhId
         | allowRemoteCommand cmd -> execRemoteCommand rhId cmd s retryNum
         | otherwise -> pure $ Left $ ChatErrorRemoteHost (RHId rhId) $ RHELocalCommand
-      _ -> do
-        cc@ChatController {config = ChatConfig {chatHooks}} <- ask
-        case preCmdHook chatHooks of
-          Just hook -> liftIO (hook cc cmd) >>= either pure (`execChatCommand'` retryNum)
-          Nothing -> execChatCommand' cmd retryNum
+      CSRemoteCtrl
+        | allowRemoteCommand cmd -> execLocal cmd
+        | otherwise -> pure $ Left $ ChatErrorRemoteCtrl $ RCEProtocolError $ RPEInvalidBody "prohibited command"
+      CSLocal -> execLocal cmd
+  where
+    execLocal cmd = do
+      cc@ChatController {config = ChatConfig {chatHooks}} <- ask
+      case preCmdHook chatHooks of
+        Just hook -> liftIO (hook cc cmd) >>= either pure (`execChatCommand'` retryNum)
+        Nothing -> execChatCommand' cmd retryNum
 
 execChatCommand' :: ChatCommand -> Int -> CM' (Either ChatError ChatResponse)
 execChatCommand' cmd retryNum = handleCommandError $ do
@@ -3603,7 +3608,7 @@ processChatCommand cxt nm = \case
   ConfirmRemoteCtrl rcId -> withUser_ $ do
     (rc, ctrlAppInfo) <- confirmRemoteCtrl rcId
     pure CRRemoteCtrlConnecting {remoteCtrl_ = Just rc, ctrlAppInfo, appVersion = currentAppVersion}
-  VerifyRemoteCtrlSession sessId -> withUser_ $ verifyRemoteCtrlSession (execChatCommand Nothing) sessId
+  VerifyRemoteCtrlSession sessId -> withUser_ $ verifyRemoteCtrlSession (execChatCommand CSRemoteCtrl) sessId
   StopRemoteCtrl -> withUser_ $ stopRemoteCtrl >> ok_
   ListRemoteCtrls -> withUser_ $ CRRemoteCtrlList <$> listRemoteCtrls
   DeleteRemoteCtrl rc -> withUser_ $ deleteRemoteCtrl rc >> ok_

src/Simplex/Chat/Mobile.hs

@@ -352,7 +352,7 @@ chatSendCmd cc cmd = chatSendRemoteCmdRetry cc Nothing cmd 0
 {-# INLINE chatSendCmd #-}
 
 chatSendRemoteCmdRetry :: ChatController -> Maybe RemoteHostId -> B.ByteString -> Int -> IO JSONByteString
-chatSendRemoteCmdRetry cc rh s retryNum = J.encode . eitherToResult rh <$> runReaderT (execChatCommand rh s retryNum) cc
+chatSendRemoteCmdRetry cc rh s retryNum = J.encode . eitherToResult rh <$> runReaderT (execChatCommand (maybe CSLocal CSRemoteHost rh) s retryNum) cc
 
 chatRecvMsg :: ChatController -> IO JSONByteString
 chatRecvMsg ChatController {outputQ} = J.encode . uncurry eitherToResult <$> readChatResponse

src/Simplex/Chat/Remote.hs

@@ -553,7 +553,7 @@ liftRC = liftError (ChatErrorRemoteCtrl . RCEProtocolError)
 handleSend :: (ByteString -> Int -> CM' (Either ChatError ChatResponse)) -> Text -> Int -> CM' RemoteResponse
 handleSend execCC command retryNum = do
   logDebug $ "Send: " <> tshow command
-  -- execCC checks for remote-allowed commands
+  -- execCC is execChatCommand CSRemoteCtrl, which checks allowRemoteCommand
   -- convert errors thrown in execCC into error responses to prevent aborting the protocol wrapper
   RRChatResponse . eitherToResult <$> execCC (encodeUtf8 command) retryNum
 

src/Simplex/Chat/Terminal/Input.hs

@@ -62,7 +62,7 @@ runInputLoop ct@ChatTerminal {termState, liveMessageState} cc = forever $ do
       cmd = parseChatCommand bs
       rh' = if either (const False) allowRemoteCommand cmd then rh else Nothing
   unless (isMessage cmd) $ echo s
-  r <- execChatCommand rh' bs 0 `runReaderT` cc
+  r <- execChatCommand (maybe CSLocal CSRemoteHost rh') bs 0 `runReaderT` cc
   case r of
     Right r' -> processResp cmd rh r'
     Left _ -> when (isMessage cmd) $ echo s

src/Simplex/Chat/Terminal/Output.hs

@@ -167,7 +167,7 @@ runTerminalOutput ct cc@ChatController {outputQ, showLiveItems, logFilePath} Cha
         _ -> pure ()
     logResponse path s = withFile path AppendMode $ \h -> mapM_ (hPutStrLn h . unStyle) s
     getRemoteUser rhId =
-      runReaderT (execChatCommand (Just rhId) "/user" 0) cc >>= \case
+      runReaderT (execChatCommand (CSRemoteHost rhId) "/user" 0) cc >>= \case
         Right CRActiveUser {user} -> updateRemoteUser ct user rhId
         cr -> logError $ "Unexpected reply while getting remote user: " <> tshow cr
     removeRemoteUser rhId = atomically $ TM.delete rhId (currentRemoteUsers ct)