git.iko.soy/distributed-process
on master help sign in
Add more exception handling. Pipes is still failing outright, the listener reads the header of the first message, then attempts to read the payload and gets stuck: 'too few bytes'.
commitcc13eec1839e19821d713447c65c4d39b9ccfa5b authorRyan Newton <rrnewton@gmail.com> dateMon 20 Feb 2012, 14:05 (15 years ago) parent913dacc
3 files changed+24−8
compare with master
unifiedsplit
examples/DemoTransport.hs+5−4 network-transport/src/Network/Transport/Pipes.hs+2 network-transport/src/Network/Transport/TCP.hs+17−4
examples/DemoTransport.hs+5−4
@@ -145,14 +145,14 @@ runWAllTranports demo offset = do
145145 writeIORef cntr (cnt+1)
146146 mkTransport (TCPConfig undefined "127.0.0.1" (show (8080 + offset + cnt)))
147147
148−-- putStrLn "\n PIPES transport:"
149−-- demo Network.Transport.Pipes.mkTransport
148+ putStrLn "\n PIPES transport:"
149+ demo Network.Transport.Pipes.mkTransport
150150 putStrLn "\n"
151151
152152main = do
153153 putStrLn "Demo0:"
154154 runWAllTranports demo0 0
155−
155+{-
156156 putStrLn "Demo1:"
157157 runWAllTranports demo1 10
158158
@@ -164,7 +164,8 @@ main = do
164164
165165 putStrLn "Demo4:"
166166 runWAllTranports demo4 40
167−
167+-}
168+ threadDelay (500 * 1000)
168169 putStrLn "Done with all demos!"
169170
170171-- trans <- mkTransport $ TCPConfig undefined "127.0.0.1" "8080"
network-transport/src/Network/Transport/Pipes.hs+2
@@ -26,6 +26,8 @@ import System.IO (IOMode(ReadMode,AppendMode,WriteMode,ReadWriteMode),
2626import System.Posix.Files (createNamedPipe, unionFileModes, ownerReadMode, ownerWriteMode)
2727import System.Posix.Types (Fd)
2828
29+-- define DEBUG
30+
2931#ifdef USE_UNIX_BYTESTRING
3032import qualified "unix-bytestring" System.Posix.IO.ByteString as PIO
3133import System.Posix.IO as PIO (openFd, defaultFileFlags, OpenMode(ReadWrite, WriteOnly))
network-transport/src/Network/Transport/TCP.hs+17−4
@@ -8,7 +8,8 @@ import Network.Transport
88import Control.Concurrent (forkIO, ThreadId, killThread, myThreadId)
99import Control.Concurrent.Chan
1010import Control.Concurrent.MVar
11−import Control.Exception (SomeException, throwTo, catch)
11+import Control.Exception (SomeException, IOException, AsyncException(ThreadKilled),
12+ fromException, throwTo, throw, catch, handle)
1213import Control.Monad (forever, forM_)
1314import Data.ByteString.Lazy.Char8 (ByteString)
1415import Data.IntMap (IntMap)
@@ -23,6 +24,7 @@ import Safe
2324import System.IO (stderr, hPutStrLn)
2425
2526import qualified Data.Binary as B
27+import qualified Data.ByteString.Char8 as BSS
2628import qualified Data.ByteString.Lazy.Char8 as BS
2729import qualified Data.IntMap as IntMap
2830import qualified Network.Socket as N
@@ -207,7 +209,9 @@ procMessages chans chanId chan sock = do
207209-- indicates success. This hasn't been implemented, since a Transport `receive`
208210-- represents an atomic receipt of a message.
209211recvExact :: Socket -> Int64 -> IO [ByteString]
210−recvExact sock n = go [] sock n
212+recvExact sock n =
213+ interceptAllExn "recvExact" $
214+ go [] sock n
211215 where
212216 go :: [ByteString] -> Socket -> Int64 -> IO [ByteString]
213217 go bss _ 0 = return (reverse bss)
@@ -218,6 +222,10 @@ recvExact sock n = go [] sock n
218222 else go (bs:bss) sock (n - BS.length bs)
219223
220224
225+interceptAllExn msg =
226+ Control.Exception.handle $ \ e -> do
227+ BSS.hPutStrLn stderr $ BSS.pack$ "Exception inside "++msg++": "++show e
228+ throw (e :: SomeException)
221229
222230forkWithExceptions :: (IO () -> IO ThreadId) -> String -> IO () -> IO ThreadId
223231forkWithExceptions forkit descr action = do
@@ -225,7 +233,12 @@ forkWithExceptions forkit descr action = do
225233 forkit $
226234 Control.Exception.catch action
227235 (\ e -> do
228− hPutStrLn stderr $ "Exception inside child thread "++descr++": "++show e
229− throwTo parent (e::SomeException)
236+ case fromException e of
237+ Just ThreadKilled ->
238+-- BSS.hPutStrLn stderr $ BSS.pack$ "Note: Child thread killed: "++descr
239+ return ()
240+ _ -> do
241+ BSS.hPutStrLn stderr $ BSS.pack$ "Exception inside child thread "++descr++": "++show e
242+ throwTo parent (e::SomeException)
230243 )
231244