3d07ccb · distributed-process

git.iko.soy/distributed-process

Check for bounds when using toEnum

commit3d07ccb6cc243304e6e8c53a50b38ae1ee43fc06 authorEdsko de Vries <edsko@edsko.net> dateFri 4 May 2012, 16:51 (14 years ago) parentde72d52

5 files changed+39−28

compare with master

unifiedsplit

network-transport-2/network-transport.cabal+4−4 network-transport-2/src/Network/Transport/Internal.hs+10−5 network-transport-2/src/Network/Transport/Internal/TCP.hs+1−1 network-transport-2/src/Network/Transport/TCP.hs+17−12 network-transport-2/tests/TestTCP.hs+7−6

network-transport-2/network-transport.cabal+4−4

@@ -20,7 +20,7 @@ Library

2020 Network.Transport.Chan,

2121 Network.Transport.TCP,

2222 Network.Transport.Util

23− extensions: EmptyDataDecls, OverloadedStrings, ForeignFunctionInterface, FlexibleContexts, BangPatterns

23+ extensions: EmptyDataDecls, OverloadedStrings, ForeignFunctionInterface, FlexibleContexts, BangPatterns, ScopedTypeVariables

2424 ghc-options: -Wall -fno-warn-unused-do-bind

2525 HS-Source-Dirs: src

2626

@@ -36,7 +36,7 @@ Test-Suite TestTCP

3636 mtl,

3737 transformers,

3838 ansi-terminal

39− extensions: EmptyDataDecls, OverloadedStrings, ForeignFunctionInterface, FlexibleContexts, BangPatterns

39+ extensions: EmptyDataDecls, OverloadedStrings, ForeignFunctionInterface, FlexibleContexts, BangPatterns, ScopedTypeVariables

4040 ghc-options: -Wall -fno-warn-unused-do-bind

4141 HS-Source-Dirs: tests src

4242

@@ -50,7 +50,7 @@ Test-Suite TestMulticastInMemory

5050 mtl,

5151 transformers,

5252 ansi-terminal

53− extensions: EmptyDataDecls, OverloadedStrings, ForeignFunctionInterface, FlexibleContexts, BangPatterns

53+ extensions: EmptyDataDecls, OverloadedStrings, ForeignFunctionInterface, FlexibleContexts, BangPatterns, ScopedTypeVariables

5454 ghc-options: -Wall -fno-warn-unused-do-bind

5555 HS-Source-Dirs: tests src

5656

@@ -64,6 +64,6 @@ Test-Suite TestInMemory

6464 mtl,

6565 transformers,

6666 ansi-terminal

67− extensions: EmptyDataDecls, OverloadedStrings, ForeignFunctionInterface, FlexibleContexts, BangPatterns

67+ extensions: EmptyDataDecls, OverloadedStrings, ForeignFunctionInterface, FlexibleContexts, BangPatterns, ScopedTypeVariables

6868 ghc-options: -Wall -fno-warn-unused-do-bind

6969 HS-Source-Dirs: tests src

network-transport-2/src/Network/Transport/Internal.hs+10−5

@@ -10,6 +10,7 @@ module Network.Transport.Internal ( -- * Encoders/decoders

1010 , failWithIO

1111 , tryIO

1212 , whileM

13+ , tryToEnum

1314 -- * Debugging

1415 , tlog

1516 , loopInvariant

@@ -41,28 +42,28 @@ encodeInt32 i32 =

4142 pokeByteOff p 0 (htonl . fromIntegral . fromEnum $ i32)

4243

4344-- | Deserialize 32-bit from network byte order

44−decodeInt32 :: Enum a => ByteString -> Maybe a

45+decodeInt32 :: Num a => ByteString -> Maybe a

4546decodeInt32 bs | BS.length bs /= 4 = Nothing

4647decodeInt32 bs = Just . BSI.inlinePerformIO $ do

4748 let (fp, _, _) = BSI.toForeignPtr bs

4849 withForeignPtr fp $ \p -> do

4950 w32 <- peekByteOff p 0

50− return (toEnum . fromIntegral . ntohl $ w32)

51+ return (fromIntegral . ntohl $ w32)

5152

5253-- | Serialize 16-bit to network byte order

5354encodeInt16 :: Enum a => a -> ByteString

5455encodeInt16 i16 =

5556 BSI.unsafeCreate 2 $ \p ->

56− pokeByteOff p 0 (htons .fromIntegral . fromEnum $ i16)

57+ pokeByteOff p 0 (htons . fromIntegral . fromEnum $ i16)

5758

5859-- | Deserialize 16-bit from network byte order

59−decodeInt16 :: Enum a => ByteString -> Maybe a

60+decodeInt16 :: Num a => ByteString -> Maybe a

6061decodeInt16 bs | BS.length bs /= 2 = Nothing

6162decodeInt16 bs = Just . BSI.inlinePerformIO $ do

6263 let (fp, _, _) = BSI.toForeignPtr bs

6364 withForeignPtr fp $ \p -> do

6465 w16 <- peekByteOff p 0

65− return (toEnum . fromIntegral . ntohs $ w16)

66+ return (fromIntegral . ntohs $ w16)

6667

6768-- | Prepend a list of bytestrings with their total length

6869prependLength :: [ByteString] -> [ByteString]

@@ -98,6 +99,10 @@ tlog msg = liftIO $ do

9899 putStrLn $ show tid ++ ": " ++ msg

99100-}

100101

102+-- | Safe version of 'toEnum'

103+tryToEnum :: forall a. (Enum a, Bounded a) => Int -> Maybe a

104+tryToEnum n = if fromEnum (minBound :: a) <= n && n <= fromEnum (maxBound :: a) then Just (toEnum n) else Nothing

105+

101106-- | Loop invariant (like 'guard')

102107loopInvariant :: MonadPlus m => m Bool -> m ()

103108loopInvariant = (>>= guard)

network-transport-2/src/Network/Transport/Internal/TCP.hs+1−1

@@ -50,7 +50,7 @@ recvWithLength :: N.Socket -> IO [ByteString]

5050recvWithLength sock = recvInt32 sock >>= recvExact sock

5151

5252-- | Receive a 32-bit integer

53−recvInt32 :: Enum a => N.Socket -> IO a

53+recvInt32 :: Num a => N.Socket -> IO a

5454recvInt32 sock = do

5555 mi <- liftM (decodeInt32 . BS.concat) $ recvExact sock 4

5656 case mi of

network-transport-2/src/Network/Transport/TCP.hs+17−12

@@ -29,6 +29,7 @@ import Network.Transport.Internal ( encodeInt32

2929 , failWith

3030 , failWithIO

3131 , tryIO

32+ , tryToEnum

3233 )

3334import qualified Network.Socket as N ( HostName

3435 , ServiceName

@@ -61,7 +62,7 @@ import Data.IORef (IORef, newIORef, writeIORef, readIORef, modifyIORef)

6162import Control.Category ((>>>))

6263import Control.Applicative ((<*>), (*>), (<$>))

6364import Control.Monad (forM_, void, when)

64−import Control.Monad.Error (ErrorT(ErrorT), runErrorT)

65+import Control.Monad.Error (ErrorT(ErrorT), runErrorT, throwError)

6566import Control.Monad.IO.Class (liftIO)

6667import Control.Exception (IOException)

6768import Data.ByteString (ByteString)

@@ -250,14 +251,14 @@ data ControlHeader =

250251 | CloseConnection -- ^ Tell the remote endpoint we will no longer be using a connection

251252 | ControlResponse -- ^ Respond to a control request _from_ the remote endpoint

252253 | CloseSocket -- ^ Request to close the connection (see module description)

253− deriving Enum

254+ deriving (Enum, Bounded)

254255

255256-- Response sent by /B/ to /A/ when /A/ tries to connect

256257data ConnectionRequestResponse =

257258 ConnectionRequestAccepted -- ^ /B/ accepts the connection

258259 | ConnectionRequestEndPointInvalid -- ^ /A/ requested an invalid endpoint

259260 | ConnectionRequestCrossed -- ^ /A/s request crossed with a request from /B/ (see protocols)

260− deriving Enum

261+ deriving (Enum, Bounded)

261262

262263--------------------------------------------------------------------------------

263264-- Top-level functionality --

@@ -527,13 +528,14 @@ connectToRemoteEndPoint (ourEndPoint, theirEndPoint) = do

527528 N.getAddrInfo Nothing (Just host) (Just port)

528529 sock <- failWithIO (insufficientResources . show) $

529530 N.socket (N.addrFamily addr) N.Stream N.defaultProtocol

530− failWithIO (failed . show) $ do

531+ response <- failWithIO (failed . show) $ do

531532 N.setSocketOption sock N.ReuseAddr 1

532533 N.connect sock (N.addrAddress addr)

533534 sendMany sock (encodeInt32 theirEndPointId : prependLength [ourAddress])

534− -- TODO: what happens when the server sends an int outside the range of ConnectionRequestResponse?

535− response <- recvInt32 sock

536− return (response, sock)

535+ recvInt32 sock

536+ case tryToEnum response of

537+ Nothing -> throwError (failed "Unexpected response")

538+ Just r -> return (r, sock)

537539

538540 invalidAddress, insufficientResources, failed :: String -> FailedWith ConnectErrorCode

539541 invalidAddress = FailedWith ConnectInvalidAddress

@@ -667,19 +669,22 @@ handleIncomingMessages (ourEndPoint, theirEndPoint) = do

667669 readMessage sock connId

668670 go sock openConnections

669671 else do

670− case toEnum (fromIntegral connId) of

671− RequestConnectionId -> do

672+ case tryToEnum (fromIntegral connId) of

673+ Just RequestConnectionId -> do

672674 recvInt32 sock >>= createNewConnection openConnections

673675 go sock openConnections

674− ControlResponse -> do

676+ Just ControlResponse -> do

675677 recvInt32 sock >>= readControlResponse sock

676678 go sock openConnections

677− CloseConnection -> do

679+ Just CloseConnection -> do

678680 recvInt32 sock >>= closeConnection openConnections

679681 go sock openConnections

680− CloseSocket -> do

682+ Just CloseSocket -> do

681683 closeSocket sock

682684 go sock openConnections

685+ Nothing ->

686+ -- Invalid control request, exit

687+ putStrLn "Warning: invalid control request"

683688

684689 -- Create a new connection

685690 createNewConnection :: IORef IntSet -> ControlRequestId -> IO ()

network-transport-2/tests/TestTCP.hs+7−6

@@ -10,6 +10,7 @@ import Data.Maybe (fromJust)

1010import Control.Concurrent (threadDelay)

1111import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar, readMVar, isEmptyMVar)

1212import Control.Monad (replicateM, guard)

13+import Control.Applicative ((<$>))

1314import Network.Transport.TCP ( decodeEndPointAddress

1415 , EndPointId

1516 , ControlHeader(..)

@@ -68,7 +69,7 @@ testEarlyDisconnect = do

6869 sendMany sock (encodeInt32 endPointIx : prependLength [myAddress])

6970

7071 -- Wait for acknowledgement

71− ConnectionRequestAccepted <- recvInt32 sock

72+ ConnectionRequestAccepted <- toEnum <$> recvInt32 sock

7273

7374 -- Request a new connection, but don't wait for the response

7475 let reqId = 0 :: Int32

@@ -163,7 +164,7 @@ testIgnoreCloseSocket = do

163164 sendMany sock (encodeInt32 endPointIx : prependLength [myAddress])

164165

165166 -- Wait for acknowledgement

166− ConnectionRequestAccepted <- recvInt32 sock

167+ ConnectionRequestAccepted <- toEnum <$> recvInt32 sock

167168

168169 -- Request a new connection

169170 tlog "Requesting connection"

@@ -177,7 +178,7 @@ testIgnoreCloseSocket = do

177178

178179 -- Server will now send a CloseSocket request as its refcount reached 0

179180 tlog "Waiting for CloseSocket request"

180− CloseSocket <- recvInt32 sock

181+ CloseSocket <- toEnum <$> recvInt32 sock

181182

182183 -- But we ignore it and request another connection

183184 tlog "Ignoring it, requesting another connection"

@@ -191,7 +192,7 @@ testIgnoreCloseSocket = do

191192

192193 -- We now get a CloseSocket again, and this time we heed it

193194 tlog "Waiting for second CloseSocket request"

194− CloseSocket <- recvInt32 sock

195+ CloseSocket <- toEnum <$> recvInt32 sock

195196

196197 tlog "Closing socket"

197198 sendMany sock [encodeInt32 CloseSocket]

@@ -252,7 +253,7 @@ testBlockAfterCloseSocket = do

252253 sendMany sock (encodeInt32 endPointIx : prependLength [myAddress])

253254

254255 -- Wait for acknowledgement

255− ConnectionRequestAccepted <- recvInt32 sock

256+ ConnectionRequestAccepted <- toEnum <$> recvInt32 sock

256257

257258 -- Request a new connection

258259 tlog "Requesting connection"

@@ -266,7 +267,7 @@ testBlockAfterCloseSocket = do

266267

267268 -- Server will now send a CloseSocket request as its refcount reached 0

268269 tlog "Waiting for CloseSocket request"

269− CloseSocket <- recvInt32 sock

270+ CloseSocket <- toEnum <$> recvInt32 sock

270271

271272 unblocked <- newEmptyMVar

272273