diff --git a/changelog.md b/changelog.md new file mode 100644 --- /dev/null +++ b/changelog.md @@ -0,0 +1,7 @@ + + +- 0.5.3.2 : + * Added this changelog. + * Fixed the lower limit for the time package. + * Enforce first frame being a settings frame when receiving. + * Added a couple of tests. diff --git a/hs-src/SecondTransfer/Http2/Framer.hs b/hs-src/SecondTransfer/Http2/Framer.hs --- a/hs-src/SecondTransfer/Http2/Framer.hs +++ b/hs-src/SecondTransfer/Http2/Framer.hs @@ -44,7 +44,7 @@ PullAction, PushAction) import SecondTransfer.Utils (Word24, word24ToInt) import SecondTransfer.Exception - +import SecondTransfer.MainLoop.Logging (logWithExclusivity) #include "Logging.cpphs" @@ -161,11 +161,11 @@ exc_handler :: Int -> SessionsContext -> FramerException -> IO () exc_handler x y e = do modifyMVar_ output_is_forbidden (\ _ -> return True) - errorM "HTTP2.Framer" "Exception went up" + INSTRUMENTATION( errorM "HTTP2.Framer" "Exception went up" ) sessionExceptionHandler Framer_HTTP2SessionComponent x y e io_exc_handler :: Int -> SessionsContext -> IOProblem -> IO () - io_exc_handler x y e = do + io_exc_handler _x _y _e = do modifyMVar_ output_is_forbidden (\ _ -> return True) -- !!! These exceptions are way too common for we to care.... -- errorM "HTTP2.Framer" "Exception went up" @@ -183,12 +183,13 @@ http2FrameLength :: F.LengthCallback -http2FrameLength bs | (B.length bs) >= 3 = let - word24 = decode input_as_lbs :: Word24 - input_as_lbs = LB.fromStrict bs - in - Just $ (word24ToInt word24) + 9 -- Nine bytes that the frame header always uses -http2FrameLength _ = Nothing +http2FrameLength bs + | (B.length bs) >= 3 = let + word24 = decode input_as_lbs :: Word24 + input_as_lbs = LB.fromStrict bs + in + Just $ (word24ToInt word24) + 9 -- Nine bytes that the frame header always uses + | otherwise = Nothing addCapacity :: @@ -236,20 +237,27 @@ liftIO $ do -- We just the the GoAway frame, although this is awfully early -- and probably wrong - INSTRUMENTATION( errorM "HTTP2.Framer" "Invalid prologue") throwIO BadPrefaceException else - INSTRUMENTATION( liftIO $ debugM "HTTP2.Framer" "Prologue validated" ) + INSTRUMENTATION( debugM "HTTP2.Framer" "Prologue validated" ) let source::Source FramerSession B.ByteString source = transPipe liftIO $ F.readNextChunk http2FrameLength remaining pull_action - ( source $$ consume) + ( source $$ consume True) where - consume :: Sink B.ByteString FramerSession () - consume = do + sendToSession :: Bool -> InputFrame -> IO () + sendToSession starting frame = if starting + then do + sendFirstFrameToSession session_input frame + else do + sendMiddleFrameToSession session_input frame + + consume_continue = consume False + + consume :: Bool -> Sink B.ByteString FramerSession () + consume starting = do maybe_bytes <- await - -- Deserialize case maybe_bytes of @@ -265,7 +273,7 @@ -- Got an error from the decoder... meaning that a frame could -- not be decoded.... in this case we send a cancel session command -- to the session. - liftIO $ errorM "HTTP2.Framer" "CouldNotDecodeFrame" + INSTRUMENTATION( errorM "HTTP2.Framer" "CouldNotDecodeFrame" ) -- Send frames like GoAway and such... lift $ sendGoAwayFrame NH2.ProtocolError -- Inform the session that it can tear down itself @@ -312,7 +320,7 @@ -- And send the frame down to the session, so that session specific settings -- can be applied. - liftIO $ sendFrameToSession session_input frame + liftIO $ sendToSession starting frame a_frame@(NH2.Frame (NH2.FrameHeader _ _ stream_id) _ ) -> do @@ -320,9 +328,10 @@ lift $ updateLastStream $ NH2.fromStreamIdentifier stream_id -- Send frame to the session - liftIO $ sendFrameToSession session_input a_frame + liftIO $ sendToSession starting a_frame + -- tail recursion: go again... - consume + consume_continue Nothing -> -- We may as well exit this thread @@ -348,14 +357,12 @@ loopPart :: FramerSession () loopPart = do - command_or_frame <- liftIO $ getFrameFromSession session_output - case command_or_frame of Left CancelSession_SOC -> do -- The session wants to cancel things - INSTRUMENTATION( liftIO $ debugM "HTTP2.Framer" "CancelSession_SOC processed") + INSTRUMENTATION( debugM "HTTP2.Framer" "CancelSession_SOC processed") releaseFramer Right ( p1@(NH2.EncodeInfo _ stream_idii _), p2@(NH2.DataFrame _) ) -> do diff --git a/hs-src/SecondTransfer/Http2/Session.hs b/hs-src/SecondTransfer/Http2/Session.hs --- a/hs-src/SecondTransfer/Http2/Session.hs +++ b/hs-src/SecondTransfer/Http2/Session.hs @@ -6,7 +6,8 @@ module SecondTransfer.Http2.Session( http2Session ,getFrameFromSession - ,sendFrameToSession + ,sendFirstFrameToSession + ,sendMiddleFrameToSession ,sendCommandToSession ,CoherentSession @@ -65,6 +66,7 @@ import SecondTransfer.Utils (unfoldChannelAndSource) import SecondTransfer.Exception import qualified SecondTransfer.Utils.HTTPHeaders as He +import SecondTransfer.MainLoop.Logging (logWithExclusivity) -- Unfortunately the frame encoding API of Network.HTTP2 is a bit difficult to -- use :-( @@ -112,12 +114,15 @@ -- From outside, one can only write to this one ... the newtype is to enforce -- this. -newtype SessionInput = SessionInput ( Chan (Either SessionInputCommand InputFrame) ) -sendFrameToSession :: SessionInput -> InputFrame -> IO () -sendFrameToSession (SessionInput chan) frame = writeChan chan $ Right frame +newtype SessionInput = SessionInput ( Chan SessionInputCommand ) +sendMiddleFrameToSession :: SessionInput -> InputFrame -> IO () +sendMiddleFrameToSession (SessionInput chan) frame = writeChan chan $ MiddleFrame_SIC frame +sendFirstFrameToSession :: SessionInput -> InputFrame -> IO () +sendFirstFrameToSession (SessionInput chan) frame = writeChan chan $ FirstFrame_SIC frame + sendCommandToSession :: SessionInput -> SessionInputCommand -> IO () -sendCommandToSession (SessionInput chan) command = writeChan chan $ Left command +sendCommandToSession (SessionInput chan) command = writeChan chan command -- From outside, one can only read from this one newtype SessionOutput = SessionOutput ( Chan (Either SessionOutputCommand OutputFrame) ) @@ -137,7 +142,9 @@ -- Have to figure out which are these...but I would expect to have things -- like unexpected aborts here in this type. data SessionInputCommand = - CancelSession_SIC + FirstFrame_SIC InputFrame -- This frame is special + |MiddleFrame_SIC InputFrame -- Ordinary frame + |CancelSession_SIC deriving Show @@ -170,7 +177,7 @@ -- ATTENTION: Ignore the warning coming from here for now _sessionsContext :: SessionsContext - ,_sessionInput :: Chan (Either SessionInputCommand InputFrame) + ,_sessionInput :: Chan SessionInputCommand -- We need to lock this channel occassionally so that we can order multiple -- header frames properly.... @@ -265,7 +272,7 @@ let session_data = SessionData { _sessionsContext = sessions_context - ,_sessionInput = session_input + ,_sessionInput = session_input ,_sessionOutput = session_output_mvar ,_toDecodeHeaders = decode_headers_table_mvar ,_toEncodeHeaders = encode_headers_table_mvar @@ -316,7 +323,7 @@ --- more robust. sessionInputThread :: ReaderT SessionData IO () sessionInputThread = do - INSTRUMENTATION( liftIO $ debugM "HTTP2.Session" "Entering sessionInputThread" ) + INSTRUMENTATION( debugM "HTTP2.Session" "Entering sessionInputThread" ) -- This is an introductory and declarative block... all of this is tail-executed -- every time that a packet needs to be processed. It may be a good idea to abstract @@ -335,11 +342,29 @@ input <- liftIO $ readChan session_input - -- INSTRUMENTATION( liftIO $ infoM "HTTP2.Session" $ "Got a frame or a command: " ++ (show input) ) - case input of - Left CancelSession_SIC -> do + FirstFrame_SIC (NH2.Frame + (NH2.FrameHeader _ 1 null_stream_id ) _ )| NH2.toStreamIdentifier 0 == null_stream_id -> do + -- This is a SETTINGS ACK frame, which is okej to have, + -- do nothing here + continue + + FirstFrame_SIC + (NH2.Frame + (NH2.FrameHeader _ 0 null_stream_id ) + (NH2.SettingsFrame settings_list) + ) | NH2.toStreamIdentifier 0 == null_stream_id -> do + -- Good, handle + handleSettingsFrame settings_list + continue + + FirstFrame_SIC _ -> do + -- Bad, incorrect id or god knows only what .... + closeConnectionBecauseIsInvalid NH2.ProtocolError + return () + + CancelSession_SIC -> do -- Good place to tear down worker threads... Let the rest of the finalization -- to the framer liftIO $ do @@ -357,7 +382,7 @@ -- TODO: As it stands now, the server will happily start a new stream with -- a CONTINUATION frame instead of a HEADERS frame. That's against the -- protocol. - Right frame | Just (stream_id, bytes) <- isAboutHeaders frame -> do + MiddleFrame_SIC frame | Just (stream_id, bytes) <- isAboutHeaders frame -> do -- Just append the frames to streamRequestHeaders opens_stream <- appendHeaderFragmentBlock stream_id bytes @@ -366,7 +391,6 @@ maybe_rcv_headers_of <- liftIO $ takeMVar receiving_headers_mvar case maybe_rcv_headers_of of Just _ -> do - -- INSTRUMENTATION( liftIO $ errorM "HTTP2.Session" "headers being received") -- Bad client, it is already sending headers -- and trying to open another one closeConnectionBecauseIsInvalid NH2.ProtocolError @@ -383,7 +407,7 @@ liftIO $ putMVar last_good_stream_mvar (stream_id) else do -- We are not golden - INSTRUMENTATION( liftIO $ errorM "HTTP2.Session" "Protocol error: bad stream id") + INSTRUMENTATION( errorM "HTTP2.Session" "Protocol error: bad stream id") closeConnectionBecauseIsInvalid NH2.ProtocolError else do maybe_rcv_headers_of <- liftIO $ takeMVar receiving_headers_mvar @@ -456,7 +480,7 @@ continue - Right frame@(NH2.Frame _ (NH2.RSTStreamFrame _error_code_id)) -> do + MiddleFrame_SIC frame@(NH2.Frame _ (NH2.RSTStreamFrame _error_code_id)) -> do let stream_id = streamIdFromFrame frame liftIO $ do INSTRUMENTATION( infoM "HTTP2.Session" $ "Stream reset: " ++ (show _error_code_id) ) @@ -467,7 +491,7 @@ case maybe_thread_id of Nothing -> -- This is actually more like an internal error, when this - -- happend, cancell the session + -- happend, cancel the session error "InterruptingUnexistentStream" Just thread_id -> do @@ -476,7 +500,7 @@ continue - Right frame@(NH2.Frame (NH2.FrameHeader _ _ nh2_stream_id) (NH2.DataFrame somebytes)) + MiddleFrame_SIC frame@(NH2.Frame (NH2.FrameHeader _ _ nh2_stream_id) (NH2.DataFrame somebytes)) -> unlessReceivingHeaders $ do -- So I got data to process -- TODO: Handle end of stream @@ -522,13 +546,13 @@ continue - Right (NH2.Frame (NH2.FrameHeader _ flags _) (NH2.PingFrame _)) | NH2.testAck flags-> do + MiddleFrame_SIC (NH2.Frame (NH2.FrameHeader _ flags _) (NH2.PingFrame _)) | NH2.testAck flags-> do -- Deal with pings: this is an Ack, so do nothing continue - Right (NH2.Frame (NH2.FrameHeader _ _ _) (NH2.PingFrame somebytes)) -> do + MiddleFrame_SIC (NH2.Frame (NH2.FrameHeader _ _ _) (NH2.PingFrame somebytes)) -> do -- Deal with pings: NOT an Ack, so answer - INSTRUMENTATION( liftIO $ debugM "HTTP2.Session" "Ping processed" ) + INSTRUMENTATION( debugM "HTTP2.Session" "Ping processed" ) sendOutFrame (NH2.EncodeInfo (NH2.setAck NH2.defaultFlags) @@ -539,35 +563,40 @@ continue - Right (NH2.Frame frame_header (NH2.SettingsFrame _)) | isSettingsAck frame_header -> do + MiddleFrame_SIC (NH2.Frame frame_header (NH2.SettingsFrame _)) | isSettingsAck frame_header -> do -- Frame was received by the peer, do nothing here... continue -- TODO: Do something with these settings!! - Right (NH2.Frame _ (NH2.SettingsFrame settings_list)) -> do - INSTRUMENTATION( liftIO $ debugM "HTTP2.Session" $ "Received settings: " ++ (show settings_list) ) + MiddleFrame_SIC (NH2.Frame _ (NH2.SettingsFrame settings_list)) -> do + INSTRUMENTATION( debugM "HTTP2.Session" $ "Received settings: " ++ (show settings_list) ) -- Just acknowledge the frame.... for now - sendOutFrame - (NH2.EncodeInfo - (NH2.setAck NH2.defaultFlags) - (NH2.toStreamIdentifier 0) - Nothing ) - (NH2.SettingsFrame []) - + handleSettingsFrame settings_list continue - - Right somethingelse -> unlessReceivingHeaders $ do + MiddleFrame_SIC somethingelse -> unlessReceivingHeaders $ do -- An undhandled case here.... - INSTRUMENTATION( liftIO $ errorM "HTTP2.Session" $ "Received problematic frame: " ) - liftIO $ errorM "HTTP2.Session" $ ".. " ++ (show somethingelse) + INSTRUMENTATION( errorM "HTTP2.Session" $ "Received problematic frame: " ) + INSTRUMENTATION( errorM "HTTP2.Session" $ ".. " ++ (show somethingelse) ) continue where continue = sessionInputThread + -- TODO: Do use the settings!!! + handleSettingsFrame :: NH2.SettingsList -> ReaderT SessionData IO () + handleSettingsFrame _settings_list = + sendOutFrame + (NH2.EncodeInfo + (NH2.setAck NH2.defaultFlags) + (NH2.toStreamIdentifier 0) + Nothing ) + (NH2.SettingsFrame []) + + + sendOutFrame :: NH2.EncodeInfo -> NH2.FramePayload -> ReaderT SessionData IO () sendOutFrame encode_info payload = do session_output_mvar <- view sessionOutput @@ -635,7 +664,7 @@ -- thread of the session. closeConnectionBecauseIsInvalid :: NH2.ErrorCodeId -> ReaderT SessionData IO a closeConnectionBecauseIsInvalid error_code = do - liftIO $ errorM "HTTP2.Session" "closeConnectionBecauseIsInvalid called!" + -- liftIO $ errorM "HTTP2.Session" "closeConnectionBecauseIsInvalid called!" last_good_stream_mvar <- view lastGoodStream last_good_stream <- liftIO $ takeMVar last_good_stream_mvar session_output_mvar <- view sessionOutput @@ -785,7 +814,7 @@ -- liftIO ( data_and_conclussion $$ (_sendDataOfStream stream_id) ) -- -- This threadlet should block here waiting for the headers to finish going - (maybe_footers, _) <- runConduit $ + (_maybe_footers, _) <- runConduit $ (transPipe liftIO data_and_conclussion) `fuseBothMaybe` (sendDataOfStream stream_id headers_sent) @@ -823,7 +852,6 @@ Nothing -> do -- TODO: Make the commented message below more informative - -- INSTRUMENTATION( liftIO $ debugM "HTTP2.Session" $ "Starting stream " ++ (show global_stream_id) ) return $ (Bu.byteString bytes, True) Just something -> diff --git a/hs-src/SecondTransfer/MainLoop/Framer.hs b/hs-src/SecondTransfer/MainLoop/Framer.hs --- a/hs-src/SecondTransfer/MainLoop/Framer.hs +++ b/hs-src/SecondTransfer/MainLoop/Framer.hs @@ -11,12 +11,13 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.IO.Class (MonadIO - -- , liftIO + -- , liftIO ) import qualified Data.ByteString as B import qualified Data.ByteString.Builder as Bu import qualified Data.ByteString.Lazy as LB import Data.Conduit +-- import Debug.Trace (trace) #ifndef IMPLICIT_MONOID import Data.Monoid diff --git a/hs-src/SecondTransfer/MainLoop/Logging.hs b/hs-src/SecondTransfer/MainLoop/Logging.hs --- a/hs-src/SecondTransfer/MainLoop/Logging.hs +++ b/hs-src/SecondTransfer/MainLoop/Logging.hs @@ -2,6 +2,7 @@ module SecondTransfer.MainLoop.Logging ( -- | Simple, no fuss enable logging enableConsoleLogging + ,logWithExclusivity ) where import System.IO (stderr) @@ -13,11 +14,27 @@ import System.Log.Handler.Simple -- import System.Log.Handler.Syslog (Facility (..), Option (..), openlog) import System.Log.Logger +import System.IO.Unsafe (unsafePerformIO) +import Control.Concurrent.MVar + -- | Activates logging to terminal enableConsoleLogging :: IO () enableConsoleLogging = configureLoggingToConsole + + +-- | Protect logging with a mutex... that is to say, +-- this is a horrible hack and you should try to log +-- as little as possible or nothing at all. This just +-- works for instrumentation locks... +globallyLogWell :: MVar () +{-# NOINLINE globallyLogWell #-} +globallyLogWell = unsafePerformIO (newMVar () ) + +-- | Used internally to avoid garbled logs +logWithExclusivity :: IO () -> IO () +logWithExclusivity a = withMVar globallyLogWell (\_ -> a ) configureLoggingToConsole :: IO () diff --git a/macros/Logging.cpphs b/macros/Logging.cpphs --- a/macros/Logging.cpphs +++ b/macros/Logging.cpphs @@ -2,7 +2,7 @@ #ifdef ENABLE_DEBUG -#define INSTRUMENTATION(x) (x) +#define INSTRUMENTATION(x) (liftIO $ logWithExclusivity (x)) #else diff --git a/second-transfer.cabal b/second-transfer.cabal --- a/second-transfer.cabal +++ b/second-transfer.cabal @@ -7,7 +7,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version : 0.5.3.1 +version : 0.5.3.2 synopsis : Second Transfer HTTP/2 web server @@ -35,7 +35,7 @@ -- Extra files to be distributed with the package-- such as examples or a -- README. -extra-source-files: README.md +extra-source-files: README.md changelog.md -- Constraint on the version of Cabal needed to build this package. cabal-version: >=1.10 @@ -53,7 +53,7 @@ source-repository this type: git location: git@github.com:alcidesv/second-transfer.git - tag: 0.5.3.1 + tag: 0.5.3.2 library @@ -125,7 +125,7 @@ hslogger >= 1.2.6, hashable >= 1.2, attoparsec >= 0.12, - time >= 1.4.0 + time >= 1.5.0 && < 1.8 -- Directories containing source files. hs-source-dirs: hs-src diff --git a/tests/tests-hs-src/SecondTransfer/Test/DecoySession.hs b/tests/tests-hs-src/SecondTransfer/Test/DecoySession.hs --- a/tests/tests-hs-src/SecondTransfer/Test/DecoySession.hs +++ b/tests/tests-hs-src/SecondTransfer/Test/DecoySession.hs @@ -28,6 +28,7 @@ ,_remainingOutputBit:: MVar B.ByteString ,_nh2Settings :: NH2.Settings ,_sessionThrowed :: MVar Bool + ,_waiting :: MVar ThreadId } @@ -40,16 +41,28 @@ input_data_channel <- newChan output_data_channel <- newChan let - push_action :: PushAction + push_action :: PushAction push_action = writeChan output_data_channel - pull_action :: PullAction + pull_action :: PullAction pull_action = readChan input_data_channel close_action :: CloseAction close_action = do return () + + + waiting_mvar <- newEmptyMVar - thread_id <- forkIO $ do - attendant push_action pull_action close_action + thread_id <- forkIO $ catch + (do + attendant push_action pull_action close_action + ) + ((\ e -> do + putStrLn $ "Exception: " ++ (show e) + maybe_waiting <- tryTakeMVar waiting_mvar + case maybe_waiting of + Just thread_id -> throwTo thread_id e + Nothing -> return () + ):: SomeException -> IO ()) remaining_output_bit <- newMVar "" let session = DecoySession { @@ -57,12 +70,14 @@ _outputDataChannel = output_data_channel, _sessionThread = thread_id, _remainingOutputBit= remaining_output_bit, - _nh2Settings = NH2.defaultSettings + _nh2Settings = NH2.defaultSettings, + _waiting = waiting_mvar + } return session --- Tell when we are done with a dession +-- Tell when we are done with a decision sessionIsUndone :: DecoySession -> IO Bool sessionIsUndone session = error "NotImplemented" @@ -73,6 +88,7 @@ let bs_list = NH2.encodeFrameChunks encode_info frame_payload input_data_channel = session ^. inputDataChannel + mapM_ (\ x -> writeChan input_data_channel x ) bs_list @@ -86,9 +102,13 @@ remaining_output_bit_mvar = decoy_session ^. remainingOutputBit pull_action = fmap LB.toStrict $ readChan output_data_channel settings = decoy_session ^. nh2Settings + waiting_for_read = decoy_session ^. waiting + my_thread_id <- myThreadId + putMVar waiting_for_read my_thread_id remaining_output_bit <- takeMVar remaining_output_bit_mvar (packet, rest) <- readNextChunkAndContinue http2FrameLength remaining_output_bit pull_action putMVar remaining_output_bit_mvar rest + takeMVar waiting_for_read let error_or_frame = NH2.decodeFrame settings packet case error_or_frame of @@ -101,7 +121,13 @@ sendRawDataToSession decoy_session data_to_send = do let input_data_channel = decoy_session ^. inputDataChannel + waiting_for_write = decoy_session ^. waiting + + thread_id <- myThreadId + putMVar waiting_for_write thread_id writeChan input_data_channel data_to_send + takeMVar waiting_for_write + return () -- Read raw data from a session. Normally blocks until data be available. diff --git a/tests/tests-hs-src/hunit_tests.hs b/tests/tests-hs-src/hunit_tests.hs --- a/tests/tests-hs-src/hunit_tests.hs +++ b/tests/tests-hs-src/hunit_tests.hs @@ -6,6 +6,7 @@ import Test.HUnit import SecondTransfer.Test.DecoySession +import SecondTransfer import Tests.HTTP2Session import Tests.Utils @@ -19,7 +20,10 @@ TestLabel "testCRLFLocate" testCRLFLocate, TestLabel "testHTTP1Parse" testParse, TestLabel "testGenerate" testGenerate, - TestLabel "testReplaceHostByAuthority" testReplaceHostByAuthority + TestLabel "testReplaceHostByAuthority" testReplaceHostByAuthority, + TestLabel "testFirstFrameIsSettings" testFirstFrameMustBeSettings, + TestLabel "testFirstFrameIsSettings2" testFirstFrameMustBeSettings2, + TestLabel "testFirstFrameIsSettings3" testFirstFrameMustBeSettings3 ]