@@ -453,7 +453,7 @@ import qualified Data.ByteString.Lazy as BSL
453453import Data.Typeable (Typeable)
454454import Data.Foldable (forM_)
455455import Control.Applicative ((<$>), (<*>))
456−import Control.Monad (void)
456+import Control.Monad (void, when)
457457import Control.Monad.Reader (MonadReader, ReaderT, runReaderT, ask)
458458import Control.Exception
459459 ( Exception
@@ -764,12 +764,18 @@ localSend x = LocalProcess $ do
764764-- | Wait for a message from the remote process (see 'ProcessPair').
765765-- Note that unlike for the standard Cloud Haskell 'expect' it will result in a
766766-- runtime error if the remote process sends a message of type other than @a@.
767+--
768+-- Since it is relatively easy for the remote process to mess up the
769+-- communication protocol (for instance, by doing a putStr) we ask for the
770+-- length twice, as some sort of sanity check.
767771localExpect :: Serializable a => LocalProcess a
768772localExpect = LocalProcess $ do
769773 ch <- ask
770774 liftIO $ do
771775 isE <- readIntChannel ch
772776 len <- readIntChannel ch
777+ lenAgain <- readIntChannel ch
778+ when (len /= lenAgain) $ throwIO (userError "Protocol violation")
773779 msg <- readSizeChannel ch len
774780 if isE /= 0
775781 then error (decode msg)
@@ -794,6 +800,8 @@ remoteSendFlagged :: Serializable a => Int -> a -> IO ()
794800remoteSendFlagged flags x = do
795801 let enc = encode x
796802 BSS.hPut stdout (encodeInt32 flags)
803+ -- See 'localExpect' for why we send the length twice
804+ BSS.hPut stdout (encodeInt32 (BSL.length enc))
797805 BSS.hPut stdout (encodeInt32 (BSL.length enc))
798806 BSL.hPut stdout enc
799807 hFlush stdout