diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,10 @@ # ChangeLog +## 0.2.9 + +* Don't send Fin if connection is already closed. +* Using clientWantSessionResumeList for multiple tickets. + ## 0.2.8 * Proper handling for stateless reset. Servers generate SRTs based on diff --git a/Network/QUIC/Client/Run.hs b/Network/QUIC/Client/Run.hs --- a/Network/QUIC/Client/Run.hs +++ b/Network/QUIC/Client/Run.hs @@ -40,7 +40,7 @@ run conf client = do let resInfo = ccResumption conf verInfo = case resumptionSession resInfo of - Nothing + [] | resumptionToken resInfo == emptyToken -> let ver = ccVersion conf vers = ccVersions conf diff --git a/Network/QUIC/Connection/Misc.hs b/Network/QUIC/Connection/Misc.hs --- a/Network/QUIC/Connection/Misc.hs +++ b/Network/QUIC/Connection/Misc.hs @@ -40,6 +40,7 @@ import System.Mem.Weak import Network.QUIC.Connection.Queue +import Network.QUIC.Connection.State import Network.QUIC.Connection.Timeout import Network.QUIC.Connection.Types import Network.QUIC.Connector @@ -210,8 +211,10 @@ -- | Closing a connection with/without a transport error. -- Internal threads should use this. -closeConnection :: TransportError -> ReasonPhrase -> IO () -closeConnection err desc = E.throwIO quicexc +closeConnection :: Connection -> TransportError -> ReasonPhrase -> IO () +closeConnection conn err desc = do + setConnectionClosed conn + E.throwIO quicexc where quicexc = TransportErrorIsSent err desc diff --git a/Network/QUIC/Connection/Role.hs b/Network/QUIC/Connection/Role.hs --- a/Network/QUIC/Connection/Role.hs +++ b/Network/QUIC/Connection/Role.hs @@ -84,13 +84,14 @@ setResumptionSession conn@Connection{..} si sd = do ver <- getVersion conn atomicModifyIORef'' roleInfo $ \ci -> - ci - { resumptionInfo = - (resumptionInfo ci) - { resumptionVersion = ver - , resumptionSession = Just (si, sd) - } - } + let resumInfo = resumptionInfo ci + in ci + { resumptionInfo = + resumInfo + { resumptionVersion = ver + , resumptionSession = (si, sd) : resumptionSession resumInfo + } + } return Nothing setNewToken :: Connection -> Token -> IO () diff --git a/Network/QUIC/Connection/State.hs b/Network/QUIC/Connection/State.hs --- a/Network/QUIC/Connection/State.hs +++ b/Network/QUIC/Connection/State.hs @@ -6,6 +6,8 @@ setConnection1RTTReady, isConnectionEstablished, setConnectionEstablished, + isConnectionClosed, + setConnectionClosed, wait0RTTReady, wait1RTTReady, waitEstablished, @@ -49,33 +51,41 @@ setConnectionEstablished :: Connection -> IO () setConnectionEstablished conn = setConnectionState conn Established +setConnectionClosed :: Connection -> IO () +setConnectionClosed conn = setConnectionState conn Closed + ---------------------------------------------------------------- isConnection1RTTReady :: Connection -> IO Bool isConnection1RTTReady Connection{..} = atomically $ do st <- readTVar $ connectionState connState - return (st >= ReadyFor1RTT) + return (st >= ReadyFor1RTT && st /= Closed) +isConnectionClosed :: Connection -> IO Bool +isConnectionClosed Connection{..} = atomically $ do + st <- readTVar $ connectionState connState + return (st == Closed) + ---------------------------------------------------------------- -- | Waiting until 0-RTT data can be sent. wait0RTTReady :: Connection -> IO () wait0RTTReady Connection{..} = atomically $ do cs <- readTVar $ connectionState connState - check (cs >= ReadyFor0RTT) + check (cs >= ReadyFor0RTT && cs /= Closed) -- | Waiting until 1-RTT data can be sent. wait1RTTReady :: Connection -> IO () wait1RTTReady Connection{..} = atomically $ do cs <- readTVar $ connectionState connState - check (cs >= ReadyFor1RTT) + check (cs >= ReadyFor1RTT && cs /= Closed) -- | For clients, waiting until HANDSHAKE_DONE is received. -- For servers, waiting until a TLS stack reports that the handshake is complete. waitEstablished :: Connection -> IO () waitEstablished Connection{..} = atomically $ do cs <- readTVar $ connectionState connState - check (cs >= Established) + check (cs >= Established && cs /= Closed) ---------------------------------------------------------------- diff --git a/Network/QUIC/Connector.hs b/Network/QUIC/Connector.hs --- a/Network/QUIC/Connector.hs +++ b/Network/QUIC/Connector.hs @@ -52,6 +52,7 @@ | ReadyFor0RTT | ReadyFor1RTT | Established + | Closed deriving (Eq, Ord, Show) isConnectionEstablished :: Connector a => a -> IO Bool diff --git a/Network/QUIC/Handshake.hs b/Network/QUIC/Handshake.hs --- a/Network/QUIC/Handshake.hs +++ b/Network/QUIC/Handshake.hs @@ -112,7 +112,8 @@ handshakeClient' conf conn myAuthCIDs ver hsr = handshaker where handshaker = - clientHandshaker qc conf ver myAuthCIDs setter use0RTT `E.catch` sendCCTLSError + clientHandshaker qc conf ver myAuthCIDs setter use0RTT + `E.catch` sendCCTLSError conn qc = QUICCallbacks { quicSend = sendTLS conn hsr @@ -178,7 +179,9 @@ -> IO () handshakeServer' conf conn ver hsRef paramRef = handshaker where - handshaker = serverHandshaker qc conf ver getParams `E.catch` sendCCTLSError + handshaker = + serverHandshaker qc conf ver getParams + `E.catch` sendCCTLSError conn qc = QUICCallbacks { quicSend = sendTLS conn hsRef @@ -235,7 +238,7 @@ tpId <- extensionIDForTtransportParameter <$> getVersion conn case getTP tpId peerExts of Nothing -> - sendCCTLSAlert TLS.MissingExtension "QUIC transport parameters are mssing" + sendCCTLSAlert conn TLS.MissingExtension "QUIC transport parameters are mssing" Just (ExtensionRaw _ bs) -> setPP bs where getTP n = find (\(ExtensionRaw extid _) -> extid == n) @@ -325,17 +328,17 @@ sendCCVNError :: IO () sendCCVNError = E.throwIO WrongVersionInformation -sendCCTLSError :: TLS.TLSException -> IO () -sendCCTLSError (TLS.HandshakeFailed (TLS.Error_Misc "WrongTransportParameter")) = closeConnection TransportParameterError "Transport parameter error" -sendCCTLSError (TLS.HandshakeFailed (TLS.Error_Misc "WrongVersionInformation")) = closeConnection VersionNegotiationError "Version negotiation error" -sendCCTLSError e = closeConnection err msg +sendCCTLSError :: Connection -> TLS.TLSException -> IO () +sendCCTLSError conn (TLS.HandshakeFailed (TLS.Error_Misc "WrongTransportParameter")) = closeConnection conn TransportParameterError "Transport parameter error" +sendCCTLSError conn (TLS.HandshakeFailed (TLS.Error_Misc "WrongVersionInformation")) = closeConnection conn VersionNegotiationError "Version negotiation error" +sendCCTLSError conn e = closeConnection conn err msg where tlserr = getErrorCause e err = cryptoError $ errorToAlertDescription tlserr msg = shortpack $ errorToAlertMessage tlserr -sendCCTLSAlert :: TLS.AlertDescription -> ReasonPhrase -> IO () -sendCCTLSAlert a msg = closeConnection (cryptoError a) msg +sendCCTLSAlert :: Connection -> TLS.AlertDescription -> ReasonPhrase -> IO () +sendCCTLSAlert conn a msg = closeConnection conn (cryptoError a) msg getErrorCause :: TLS.TLSException -> TLS.TLSError getErrorCause (TLS.Terminated _ _ e) = e diff --git a/Network/QUIC/IO.hs b/Network/QUIC/IO.hs --- a/Network/QUIC/IO.hs +++ b/Network/QUIC/IO.hs @@ -140,8 +140,9 @@ closeStream s = do let conn = streamConnection s let sid = streamId s + closed <- isConnectionClosed conn sclosed <- isTxStreamClosed s - unless sclosed $ do + unless (closed || sclosed) $ do setTxStreamClosed s setRxStreamClosed s putSendStreamQ conn $ TxStreamData s [] 0 True diff --git a/Network/QUIC/Receiver.hs b/Network/QUIC/Receiver.hs --- a/Network/QUIC/Receiver.hs +++ b/Network/QUIC/Receiver.hs @@ -148,14 +148,14 @@ Just plain@Plain{..} -> do addRxBytes conn $ rpReceivedBytes rpkt when (isIllegalReservedBits plainMarks || isNoFrames plainMarks) $ - closeConnection ProtocolViolation "Non 0 RR bits or no frames" + closeConnection conn ProtocolViolation "Non 0 RR bits or no frames" when (isUnknownFrame plainMarks) $ - closeConnection FrameEncodingError "Unknown frame" + closeConnection conn FrameEncodingError "Unknown frame" let controlled = checkRate plainFrames when (controlled /= 0) $ do rate <- addRate (controlRate conn) controlled when (rate > rateLimit) $ do - closeConnection QUIC.InternalError "Rate control" + closeConnection conn QUIC.InternalError "Rate control" -- For Ping, record PPN first, then send an ACK. onPacketReceived (connLDCC conn) lvl plainPacketNumber when (lvl == RTT1Level) $ setPeerPacketNumber conn plainPacketNumber @@ -214,7 +214,7 @@ | isInitiated conn sid = do curSid <- getMyStreamId conn when (sid > curSid) $ - closeConnection StreamStateError emsg + closeConnection conn StreamStateError emsg streamNotCreatedYet _ _ _ = return () processFrame :: Connection -> EncryptionLevel -> Frame -> IO () @@ -223,13 +223,13 @@ -- see ackEli above when (lvl /= InitialLevel && lvl /= RTT1Level) $ sendFrames conn lvl [] processFrame conn lvl (Ack ackInfo ackDelay) = do - when (lvl == RTT0Level) $ closeConnection ProtocolViolation "ACK" + when (lvl == RTT0Level) $ closeConnection conn ProtocolViolation "ACK" onAckReceived (connLDCC conn) lvl ackInfo $ milliToMicro ackDelay processFrame conn lvl (ResetStream sid aerr _finlen) = do when (lvl == InitialLevel || lvl == HandshakeLevel) $ - closeConnection ProtocolViolation "RESET_STREAM" + closeConnection conn ProtocolViolation "RESET_STREAM" when (isSendOnly conn sid) $ - closeConnection StreamStateError "Received in a send-only stream" + closeConnection conn StreamStateError "Received in a send-only stream" mstrm <- findStream conn sid case mstrm of Nothing -> return () @@ -240,9 +240,9 @@ delStream conn strm processFrame conn lvl (StopSending sid err) = do when (lvl == InitialLevel || lvl == HandshakeLevel) $ - closeConnection ProtocolViolation "STOP_SENDING" + closeConnection conn ProtocolViolation "STOP_SENDING" when (isReceiveOnly conn sid) $ - closeConnection StreamStateError "Receive-only stream" + closeConnection conn StreamStateError "Receive-only stream" mstrm <- findStream conn sid case mstrm of Nothing -> streamNotCreatedYet conn sid "No such stream for STOP_SENDING" @@ -250,7 +250,7 @@ processFrame _ _ (CryptoF _ "") = return () processFrame conn lvl (CryptoF off cdat) = do when (lvl == RTT0Level) $ - closeConnection ProtocolViolation "CRYPTO in 0-RTT" + closeConnection conn ProtocolViolation "CRYPTO in 0-RTT" let len = BS.length cdat rx = RxStreamData cdat off len False case lvl of @@ -266,18 +266,18 @@ | isClient conn -> void $ putRxCrypto conn lvl rx | otherwise -> - closeConnection (cryptoError UnexpectedMessage) "CRYPTO in 1-RTT" + closeConnection conn (cryptoError UnexpectedMessage) "CRYPTO in 1-RTT" processFrame conn lvl (NewToken token) = do when (isServer conn || lvl /= RTT1Level) $ - closeConnection ProtocolViolation "NEW_TOKEN for server or in 1-RTT" + closeConnection conn ProtocolViolation "NEW_TOKEN for server or in 1-RTT" when (isClient conn) $ setNewToken conn token processFrame conn RTT0Level (StreamF sid off (dat : _) fin) = do when (off == 0) $ updatePeerStreamId conn sid -- FLOW CONTROL: MAX_STREAMS: recv: rejecting if over my limit ok <- checkRxMaxStreams conn sid - unless ok $ closeConnection StreamLimitError "stream id is too large" + unless ok $ closeConnection conn StreamLimitError "stream id is too large" when (isSendOnly conn sid) $ - closeConnection StreamStateError "send-only stream" + closeConnection conn StreamStateError "send-only stream" mstrm <- findStream conn sid guardStream conn sid mstrm strm <- maybe (createStream conn sid) return mstrm @@ -286,28 +286,32 @@ fc <- putRxStreamData strm rx case fc of -- FLOW CONTROL: MAX_STREAM_DATA: recv: rejecting if over my limit - OverLimit -> closeConnection FlowControlError "Flow control error for stream in 0-RTT" + OverLimit -> + closeConnection conn FlowControlError "Flow control error for stream in 0-RTT" Duplicated -> return () Reassembled -> do ok' <- checkRxMaxData conn len -- FLOW CONTROL: MAX_DATA: send: respecting peer's limit unless ok' $ - closeConnection FlowControlError "Flow control error for connection in 0-RTT" + closeConnection + conn + FlowControlError + "Flow control error for connection in 0-RTT" processFrame conn RTT1Level (StreamF sid _ [""] False) = do -- FLOW CONTROL: MAX_STREAMS: recv: rejecting if over my limit ok <- checkRxMaxStreams conn sid - unless ok $ closeConnection StreamLimitError "stream id is too large" + unless ok $ closeConnection conn StreamLimitError "stream id is too large" when (isSendOnly conn sid) $ - closeConnection StreamStateError "send-only stream" + closeConnection conn StreamStateError "send-only stream" mstrm <- findStream conn sid guardStream conn sid mstrm processFrame conn RTT1Level (StreamF sid off (dat : _) fin) = do when (off == 0) $ updatePeerStreamId conn sid -- FLOW CONTROL: MAX_STREAMS: recv: rejecting if over my limit ok <- checkRxMaxStreams conn sid - unless ok $ closeConnection StreamLimitError "stream id is too large" + unless ok $ closeConnection conn StreamLimitError "stream id is too large" when (isSendOnly conn sid) $ - closeConnection StreamStateError "send-only stream" + closeConnection conn StreamStateError "send-only stream" mstrm <- findStream conn sid guardStream conn sid mstrm strm <- maybe (createStream conn sid) return mstrm @@ -316,50 +320,57 @@ fc <- putRxStreamData strm rx case fc of -- FLOW CONTROL: MAX_STREAM_DATA: recv: rejecting if over my limit - OverLimit -> closeConnection FlowControlError "Flow control error for stream in 1-RTT" + OverLimit -> + closeConnection conn FlowControlError "Flow control error for stream in 1-RTT" Duplicated -> return () Reassembled -> do ok' <- checkRxMaxData conn len -- FLOW CONTROL: MAX_DATA: send: respecting peer's limit unless ok' $ - closeConnection FlowControlError "Flow control error for connection in 1-RTT" + closeConnection + conn + FlowControlError + "Flow control error for connection in 1-RTT" processFrame conn lvl (MaxData n) = do when (lvl == InitialLevel || lvl == HandshakeLevel) $ - closeConnection ProtocolViolation "MAX_DATA in Initial or Handshake" + closeConnection conn ProtocolViolation "MAX_DATA in Initial or Handshake" setTxMaxData conn n processFrame conn lvl (MaxStreamData sid n) = do when (lvl == InitialLevel || lvl == HandshakeLevel) $ - closeConnection ProtocolViolation "MAX_STREAM_DATA in Initial or Handshake" + closeConnection conn ProtocolViolation "MAX_STREAM_DATA in Initial or Handshake" when (isReceiveOnly conn sid) $ - closeConnection StreamStateError "Receive-only stream" + closeConnection conn StreamStateError "Receive-only stream" mstrm <- findStream conn sid case mstrm of Nothing -> streamNotCreatedYet conn sid "No such stream for MAX_STREAM_DATA" Just strm -> setTxMaxStreamData strm n processFrame conn lvl (MaxStreams dir n) = do when (lvl == InitialLevel || lvl == HandshakeLevel) $ - closeConnection ProtocolViolation "MAX_STREAMS in Initial or Handshake" + closeConnection conn ProtocolViolation "MAX_STREAMS in Initial or Handshake" when (n > 2 ^ (60 :: Int)) $ - closeConnection FrameEncodingError "Too large MAX_STREAMS" + closeConnection conn FrameEncodingError "Too large MAX_STREAMS" if dir == Bidirectional then setTxMaxStreams conn n else setTxUniMaxStreams conn n processFrame _conn _lvl DataBlocked{} = return () processFrame _conn _lvl (StreamDataBlocked _sid _) = return () -processFrame _conn lvl (StreamsBlocked _dir n) = do +processFrame conn lvl (StreamsBlocked _dir n) = do when (lvl == InitialLevel || lvl == HandshakeLevel) $ - closeConnection ProtocolViolation "STREAMS_BLOCKED in Initial or Handshake" + closeConnection conn ProtocolViolation "STREAMS_BLOCKED in Initial or Handshake" when (n > 2 ^ (60 :: Int)) $ - closeConnection FrameEncodingError "Too large STREAMS_BLOCKED" + closeConnection conn FrameEncodingError "Too large STREAMS_BLOCKED" processFrame conn lvl (NewConnectionID cidInfo rpt) = do when (lvl == InitialLevel || lvl == HandshakeLevel) $ - closeConnection ProtocolViolation "NEW_CONNECTION_ID in Initial or Handshake" + closeConnection + conn + ProtocolViolation + "NEW_CONNECTION_ID in Initial or Handshake" ok <- addPeerCID conn cidInfo unless ok $ - closeConnection ConnectionIdLimitError "NEW_CONNECTION_ID limit error" + closeConnection conn ConnectionIdLimitError "NEW_CONNECTION_ID limit error" let (_, cidlen) = unpackCID $ cidInfoCID cidInfo when (cidlen < 1 || 20 < cidlen || rpt > cidInfoSeq cidInfo) $ - closeConnection FrameEncodingError "NEW_CONNECTION_ID parameter error" + closeConnection conn FrameEncodingError "NEW_CONNECTION_ID parameter error" when (rpt >= 1) $ do seqNums <- setPeerCIDAndRetireCIDs conn rpt sendFramesLim conn RTT1Level $ map RetireConnectionID seqNums @@ -386,7 +397,7 @@ E.throwIO quicexc processFrame conn lvl HandshakeDone = do when (isServer conn || lvl /= RTT1Level) $ - closeConnection ProtocolViolation "HANDSHAKE_DONE for server" + closeConnection conn ProtocolViolation "HANDSHAKE_DONE for server" fire conn (Microseconds 100000) $ do let ldcc = connLDCC conn discarded0 <- getAndSetPacketNumberSpaceDiscarded ldcc RTT0Level @@ -401,7 +412,7 @@ getConnectionInfo conn >>= onConnectionEstablished (connHooks conn) -- to receive NewSessionTicket fire conn (Microseconds 1000000) $ killHandshaker conn lvl -processFrame _ _ _ = closeConnection ProtocolViolation "Frame is not allowed" +processFrame conn _ _ = closeConnection conn ProtocolViolation "Frame is not allowed" -- Return value indicates duplication. putRxCrypto :: Connection -> EncryptionLevel -> RxStreamData -> IO Bool diff --git a/Network/QUIC/TLS.hs b/Network/QUIC/TLS.hs --- a/Network/QUIC/TLS.hs +++ b/Network/QUIC/TLS.hs @@ -37,7 +37,7 @@ , clientHooks = hook , clientSupported = supported , clientDebug = debug - , clientWantSessionResume = resumptionSession ccResumption + , clientWantSessionResumeList = resumptionSession ccResumption , clientUseEarlyData = use0RTT } convTP = onTransportParametersCreated ccHooks diff --git a/Network/QUIC/Types/Resumption.hs b/Network/QUIC/Types/Resumption.hs --- a/Network/QUIC/Types/Resumption.hs +++ b/Network/QUIC/Types/Resumption.hs @@ -8,7 +8,6 @@ import Network.TLS hiding (Version) import Network.TLS.QUIC -import Network.QUIC.Imports import Network.QUIC.Types.Frame import Network.QUIC.Types.Packet @@ -17,7 +16,7 @@ -- | Information about resumption data ResumptionInfo = ResumptionInfo { resumptionVersion :: Version - , resumptionSession :: Maybe (SessionID, SessionData) + , resumptionSession :: [(SessionID, SessionData)] , resumptionToken :: Token , resumptionRetry :: Bool } @@ -29,7 +28,7 @@ defaultResumptionInfo = ResumptionInfo { resumptionVersion = Version1 - , resumptionSession = Nothing + , resumptionSession = [] , resumptionToken = emptyToken , resumptionRetry = False } @@ -39,15 +38,11 @@ is0RTTPossible ResumptionInfo{..} = rtt0OK && (not resumptionRetry || resumptionToken /= emptyToken) where - rtt0OK = case resumptionSession of - Nothing -> False - Just (_, sd) -> sessionMaxEarlyDataSize sd == quicMaxEarlyDataSize + rtt0OK = + any + (\(_, sd) -> sessionMaxEarlyDataSize sd == quicMaxEarlyDataSize) + resumptionSession -- | Is resumption possible? isResumptionPossible :: ResumptionInfo -> Bool -isResumptionPossible ResumptionInfo{..} = isJust resumptionSession - -get0RTTCipher :: ResumptionInfo -> Maybe CipherID -get0RTTCipher ri = case resumptionSession ri of - Nothing -> Nothing - Just (_, sd) -> Just $ sessionCipher sd +isResumptionPossible ResumptionInfo{..} = not $ null resumptionSession diff --git a/quic.cabal b/quic.cabal --- a/quic.cabal +++ b/quic.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: quic -version: 0.2.8 +version: 0.2.9 license: BSD3 license-file: LICENSE maintainer: kazu@iij.ad.jp @@ -128,28 +128,28 @@ ghc-options: -Wall -Wcompat build-depends: base >=4.9 && <5, - async, array >= 0.5 && < 0.6, + async, base16-bytestring >= 1.0 && < 1.1, bytestring >= 0.10, containers, crypto-token >= 0.1.2 && < 0.2, crypton >= 0.34, - memory >= 0.18.0 && < 0.19, crypton-x509 >= 1.7.6 && < 1.8, crypton-x509-system >= 1.6.7 && < 1.7, - filepath, - stm >= 2.5 && < 2.6, data-default, fast-logger >= 3.2.2 && < 3.3, - unix-time >= 0.4.12 && < 0.5, + filepath, iproute >= 1.7.12 && < 1.8, + memory >= 0.18.0 && < 0.19, network >= 3.2.3, network-byte-order >= 0.1.7 && < 0.2, network-control >= 0.1.5 && < 0.2, - random >= 1.2.1 && < 1.4, + random >= 1.3 && < 1.4, serialise, - tls >= 2.1.6 && < 2.2 + stm >= 2.5 && < 2.6, + tls >= 2.1.6 && < 2.2, + unix-time >= 0.4.12 && < 0.5 if os(windows) cc-options: -D_WINDOWS diff --git a/test/TransportError.hs b/test/TransportError.hs --- a/test/TransportError.hs +++ b/test/TransportError.hs @@ -294,6 +294,9 @@ ---------------------------------------------------------------- +-- Stream 0 is not created internally. It is assumed that a server +-- send CC without sending back Stream 0. If the server send back any +-- data for Stream 0, `streamNotCreatedYet` throws an exception, sigh. largeOffset :: EncryptionLevel -> Plain -> Plain largeOffset lvl plain | lvl == RTT1Level = plain{plainFrames = fake : plainFrames plain}