import System.IO
import Text.Printf
+import Control.Concurrent
import Debug.Trace
-responseWriter :: Handle -> InteractionQueue -> IO ()
-responseWriter h tQueue
+responseWriter :: Handle -> InteractionQueue -> ThreadId -> IO ()
+responseWriter h tQueue readerTID
= catch awaitSomethingToWrite $ \ exc ->
case exc of
- IOException _ -> return ()
- _ -> print exc
+ IOException _ -> return ()
+ AsyncException ThreadKilled -> return ()
+ BlockedIndefinitely -> putStrLn "requestWriter: blocked indefinitely"
+ _ -> print exc
where
awaitSomethingToWrite :: IO ()
awaitSomethingToWrite
= do willDiscardBody <- atomically $ readItr itr itrWillDiscardBody id
willChunkBody <- atomically $ readItr itr itrWillChunkBody id
when (not willDiscardBody && willChunkBody)
- $ hPutStr h "0\r\n" >> hFlush h
+ $ hPutStr h "0\r\n\r\n" >> hFlush h
finalize :: Interaction -> IO ()
finalize itr
readItr itr itrWillClose id
if willClose then
- hClose h
+ -- reader は恐らく hWaitForInput してゐる最中なので、
+ -- スレッドを豫め殺して置かないとをかしくなる。
+ do killThread readerTID
+ hClose h
else
awaitSomethingToWrite