diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,12 @@ # ChangeLog +## 0.2.8 + +* Proper handling for stateless reset. Servers generate SRTs based on + their CIDs. Clients check SRTs before dispatching to a Connection. + Note that the CID of stateless reset is random. + Test: `quic-server -o 5` and `quic-client -i`/`p`. + ## 0.2.7 * Introducing `forkManaged` to manage readers of clients properly. diff --git a/Network/QUIC/Client/Reader.hs b/Network/QUIC/Client/Reader.hs --- a/Network/QUIC/Client/Reader.hs +++ b/Network/QUIC/Client/Reader.hs @@ -44,17 +44,16 @@ wait loop = do ito <- readMinIdleTimeout conn - mbs <- - timeout ito "readeClient" $ - NSB.recvMsg s0 2048 2048 0 -- fixme + mbs <- timeout ito "readeClient" $ NSB.recvFrom s0 2048 case mbs of Nothing -> close s0 - Just (peersa, bs, cmsgs, _) -> do - setPeerInfo conn $ PeerInfo peersa cmsgs - now <- getTimeMicrosecond - let quicBit = greaseQuicBit $ getMyParameters conn - pkts <- decodePackets bs (not quicBit) - mapM_ (putQ now) pkts + Just (bs, peersa) -> do + PeerInfo peersa' <- getPeerInfo conn + when (peersa == peersa') $ do + now <- getTimeMicrosecond + let quicBit = greaseQuicBit $ getMyParameters conn + pkts <- decodePackets bs (not quicBit) + mapM_ (putQ now) pkts loop logAction msg = connDebugLog conn ("debug: readerClient: " <> msg) putQ _ (PacketIB BrokenPacket _) = return () @@ -71,7 +70,24 @@ vers@(ver : _) | ok -> VersionInfo ver vers _ -> brokenVersionInfo E.throwTo (mainThreadId conn) $ VerNego nextVerInfo - putQ t (PacketIC pkt lvl siz) = writeRecvQ (connRecvQ conn) $ mkReceivedPacket pkt t siz lvl + putQ t (PacketIC pkt@(CryptPacket hdr crypt) lvl siz) = do + let cid = headerMyCID hdr + included <- myCIDsInclude conn cid + case included of + Just _ -> writeRecvQ (connRecvQ conn) $ mkReceivedPacket pkt t siz lvl + Nothing -> case decodeStatelessResetToken (cryptPacket crypt) of + Just token -> do + isStatelessReset <- isStatelessRestTokenValid conn token + -- Our client does not send a stateless reset: + -- 1) Stateless reset token is not generated for + -- the my first CID. + -- 2) It's unlikely that QUIC packets are delivered + -- to a new UDP port when out client is rebooted. + when isStatelessReset $ do + qlogReceived conn StatelessReset t + connDebugLog conn "debug: connection is reset statelessly" + E.throwTo (mainThreadId conn) ConnectionIsReset + _ -> return () -- really invalid, just ignore putQ t (PacketIR pkt@(RetryPacket ver dCID sCID token ex)) = do qlogReceived conn pkt t ok <- checkCIDs conn dCID ex @@ -122,8 +138,8 @@ mn <- timeout (Microseconds 1000000) "controlConnection' 1" $ waitPeerCID conn -- fixme case mn of Nothing -> return False - Just (CIDInfo n _ _) -> do - sendFrames conn RTT1Level [RetireConnectionID n] + Just cidInfo -> do + sendFrames conn RTT1Level [RetireConnectionID (cidInfoSeq cidInfo)] return True controlConnection' conn ChangeClientCID = do cidInfo <- getNewMyCID conn @@ -144,7 +160,7 @@ rebind :: Connection -> Microseconds -> IO () rebind conn microseconds = do - PeerInfo peersa _ <- getPeerInfo conn + PeerInfo peersa <- getPeerInfo conn newSock <- natRebinding peersa oldSock <- setSocket conn newSock let reader = readerClient newSock conn 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 @@ -37,7 +37,7 @@ -- Use the 'migrate' API for the connected socket. run :: ClientConfig -> (Connection -> IO a) -> IO a -- Don't use handleLogUnit here because of a return value. -run conf client = NS.withSocketsDo $ do +run conf client = do let resInfo = ccResumption conf verInfo = case resumptionSession resInfo of Nothing @@ -50,6 +50,7 @@ ex <- E.try $ runClient conf client False verInfo case ex of Right v -> return v + -- Other exceptions go though. Left (NextVersion nextVerInfo) | verInfo == brokenVersionInfo -> E.throwIO VersionNegotiationFailed | otherwise -> runClient conf client True nextVerInfo @@ -108,11 +109,11 @@ (sock, peersa) <- clientSocket ccServerName ccPortName q <- newRecvQ sref <- newIORef sock - piref <- newIORef $ PeerInfo peersa [] + piref <- newIORef $ PeerInfo peersa let send buf siz = do s <- readIORef sref - PeerInfo sa cmsgs <- readIORef piref - void $ NS.sendBufMsg s sa [(buf, siz)] cmsgs 0 + PeerInfo sa <- readIORef piref + void $ NS.sendBufTo s buf siz sa recv = recvClient q myCID <- newCID peerCID <- newCID @@ -124,6 +125,7 @@ debugLog $ "Original CID: " <> bhow peerCID let myAuthCIDs = defaultAuthCIDs{initSrcCID = Just myCID} peerAuthCIDs = defaultAuthCIDs{initSrcCID = Just peerCID, origDstCID = Just peerCID} + genSRT <- makeGenStatelessReset conn <- clientConnection conf @@ -138,6 +140,7 @@ q send recv + genSRT addResource conn qclean let ver = chosenVersion verInfo initializeCoder conn InitialLevel $ initialSecrets ver peerCID diff --git a/Network/QUIC/Closer.hs b/Network/QUIC/Closer.hs --- a/Network/QUIC/Closer.hs +++ b/Network/QUIC/Closer.hs @@ -40,11 +40,11 @@ closure' :: Connection -> LDCC -> Frame -> IO () closure' conn ldcc frame = do sock <- getSocket conn - PeerInfo peersa cmsgs <- getPeerInfo conn + PeerInfo peersa <- getPeerInfo conn -- send let sbuf@(SizedBuffer sendbuf _) = encryptRes conn siz <- encodeCC conn sbuf frame - let send = void $ NS.sendBufMsg sock peersa [(sendbuf, siz)] cmsgs 0 + let send = void $ NS.sendBufTo sock sendbuf siz peersa -- recv and clos killReaders conn -- client only (recv, freeRecvBuf, clos) <- diff --git a/Network/QUIC/Connection/Migration.hs b/Network/QUIC/Connection/Migration.hs --- a/Network/QUIC/Connection/Migration.hs +++ b/Network/QUIC/Connection/Migration.hs @@ -77,7 +77,7 @@ getNewMyCID :: Connection -> IO CIDInfo getNewMyCID Connection{..} = do cid <- newCID - srt <- newStatelessResetToken + let srt = genStatelessResetToken cid atomicModifyIORef' myCIDDB $ new cid srt ---------------------------------------------------------------- @@ -207,18 +207,18 @@ } add :: CIDInfo -> CIDDB -> CIDDB -add cidInfo@CIDInfo{..} db@CIDDB{..} = db' +add cidInfo db@CIDDB{..} = db' where db' = db - { cidInfos = IntMap.insert cidInfoSeq cidInfo cidInfos - , revInfos = Map.insert cidInfoCID cidInfoSeq revInfos + { cidInfos = IntMap.insert (cidInfoSeq cidInfo) cidInfo cidInfos + , revInfos = Map.insert (cidInfoCID cidInfo) (cidInfoSeq cidInfo) revInfos } new :: CID -> StatelessResetToken -> CIDDB -> (CIDDB, CIDInfo) new cid srt db@CIDDB{..} = (db', cidInfo) where - cidInfo = CIDInfo nextSeqNum cid srt + cidInfo = newCIDInfo nextSeqNum cid srt db' = db { nextSeqNum = nextSeqNum + 1 @@ -268,14 +268,17 @@ , usedCIDInfo = cidinfo' } -isStatelessRestTokenValid :: Connection -> CID -> StatelessResetToken -> IO Bool -isStatelessRestTokenValid Connection{..} cid srt = srtCheck <$> readTVarIO peerCIDDB +-- Used in client only. Stateless reset is independent from +-- Connection because its CID is random. However, client uses only +-- one Connection. So, peerCIDDB can be considered a global variable. +-- This function tries to find the target statless reset token in +-- peerCIDDB. +isStatelessRestTokenValid :: Connection -> StatelessResetToken -> IO Bool +isStatelessRestTokenValid Connection{..} srt = srtCheck <$> readTVarIO peerCIDDB where - srtCheck CIDDB{..} = case Map.lookup cid revInfos of - Nothing -> False - Just n -> case IntMap.lookup n cidInfos of - Nothing -> False - Just (CIDInfo _ _ srt0) -> srt == srt0 + srtCheck CIDDB{..} = foldr chk False cidInfos + chk _ True = True + chk cidInfo _ = cidInfoSRT cidInfo == srt ---------------------------------------------------------------- @@ -285,12 +288,15 @@ setChallenges conn pdat putOutput conn $ OutControl RTT1Level [PathChallenge pdat] $ return () waitResponse conn -validatePath conn (Just (CIDInfo retiredSeqNum _ _)) = do +validatePath conn (Just cidInfo) = do pdat <- newPathData setChallenges conn pdat - putOutput conn $ - OutControl RTT1Level [PathChallenge pdat, RetireConnectionID retiredSeqNum] $ - return () + let retiredSeqNum = cidInfoSeq cidInfo + putOutput conn + $ OutControl + RTT1Level + [PathChallenge pdat, RetireConnectionID retiredSeqNum] + $ return () waitResponse conn retirePeerCID conn retiredSeqNum 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 @@ -71,8 +71,7 @@ getSocket Connection{..} = readIORef connSocket setSocket :: Connection -> Socket -> IO Socket -setSocket Connection{..} sock = atomicModifyIORef' connSocket $ - \sock0 -> (sock, sock0) +setSocket Connection{..} sock = atomicModifyIORef' connSocket (sock,) -- fixme clearSocket :: Connection -> IO Socket diff --git a/Network/QUIC/Connection/Timeout.hs b/Network/QUIC/Connection/Timeout.hs --- a/Network/QUIC/Connection/Timeout.hs +++ b/Network/QUIC/Connection/Timeout.hs @@ -1,6 +1,7 @@ module Network.QUIC.Connection.Timeout ( timeout, fire, + fire', cfire, delay, ) where @@ -26,6 +27,11 @@ action' = do alive <- getAlive conn when alive action `E.catch` ignore + +fire' :: Microseconds -> TimeoutCallback -> IO () +fire' (Microseconds microseconds) action = do + timmgr <- getSystemTimerManager + void $ registerTimeout timmgr microseconds action cfire :: Connection -> Microseconds -> TimeoutCallback -> IO (IO ()) cfire conn (Microseconds microseconds) action = do diff --git a/Network/QUIC/Connection/Types.hs b/Network/QUIC/Connection/Types.hs --- a/Network/QUIC/Connection/Types.hs +++ b/Network/QUIC/Connection/Types.hs @@ -18,7 +18,7 @@ import Foreign.Marshal.Alloc import Foreign.Ptr (nullPtr) import Network.Control (Rate, RxFlow, TxFlow, newRate, newRxFlow, newTxFlow) -import Network.Socket (Cmsg, SockAddr, Socket) +import Network.Socket (SockAddr, Socket) import Network.TLS.QUIC import System.Mem.Weak (Weak) @@ -74,6 +74,8 @@ , certChain = Nothing } +-- cidInfoSRT in CIDInfo is only used in client +-- which accepts stateless reset. data CIDDB = CIDDB { usedCIDInfo :: CIDInfo , cidInfos :: IntMap CIDInfo @@ -93,7 +95,7 @@ , triggeredByMe = False } where - cidInfo = CIDInfo 0 cid (StatelessResetToken "") + cidInfo = newCIDInfo 0 cid $ StatelessResetToken "" ---------------------------------------------------------------- @@ -186,7 +188,7 @@ type Send = Buffer -> Int -> IO () type Recv = IO ReceivedPacket -data PeerInfo = PeerInfo SockAddr [Cmsg] deriving (Eq, Show) +data PeerInfo = PeerInfo SockAddr deriving (Eq, Show) ---------------------------------------------------------------- @@ -203,6 +205,7 @@ -- Manage , connRecvQ :: RecvQ , connSocket :: IORef Socket + , genStatelessResetToken :: CID -> StatelessResetToken , readers :: IORef (Map Word64 (Weak ThreadId)) , mainThreadId :: ThreadId , controlRate :: Rate @@ -296,8 +299,9 @@ -> RecvQ -> Send -> Recv + -> (CID -> StatelessResetToken) -> IO Connection -newConnection rl myparams verInfo myAuthCIDs peerAuthCIDs debugLog qLog hooks sref piref recvQ ~send ~recv = do +newConnection rl myparams verInfo myAuthCIDs peerAuthCIDs debugLog qLog hooks sref piref recvQ ~send ~recv genSRT = do -- ~ for testing outQ <- newTQueueIO let put x = atomically $ writeTQueue outQ $ OutRetrans x @@ -306,7 +310,7 @@ encBuf <- mallocBytes bufsiz ecrptBuf <- mallocBytes bufsiz dcrptBuf <- mallocBytes bufsiz - Connection connstate debugLog qLog hooks send recv recvQ sref + Connection connstate debugLog qLog hooks send recv recvQ sref genSRT <$> newIORef Map.empty <*> myThreadId <*> newRate @@ -392,6 +396,7 @@ -> RecvQ -> Send -> Recv + -> (CID -> StatelessResetToken) -> IO Connection clientConnection ClientConfig{..} verInfo myAuthCIDs peerAuthCIDs = newConnection Client ccParameters verInfo myAuthCIDs peerAuthCIDs @@ -409,6 +414,7 @@ -> RecvQ -> Send -> Recv + -> (CID -> StatelessResetToken) -> IO Connection serverConnection ServerConfig{..} verInfo myAuthCIDs peerAuthCIDs = newConnection Server scParameters verInfo myAuthCIDs peerAuthCIDs diff --git a/Network/QUIC/Crypto/Keys.hs b/Network/QUIC/Crypto/Keys.hs --- a/Network/QUIC/Crypto/Keys.hs +++ b/Network/QUIC/Crypto/Keys.hs @@ -24,7 +24,7 @@ ---------------------------------------------------------------- defaultCipher :: Cipher -defaultCipher = cipher_TLS13_AES128GCM_SHA256 +defaultCipher = cipher13_AES_128_GCM_SHA256 ---------------------------------------------------------------- diff --git a/Network/QUIC/Crypto/Nite.hs b/Network/QUIC/Crypto/Nite.hs --- a/Network/QUIC/Crypto/Nite.hs +++ b/Network/QUIC/Crypto/Nite.hs @@ -40,19 +40,17 @@ cipherEncrypt :: Cipher -> Key -> Nonce -> PlainText -> AssDat -> Maybe (CipherText, CipherText) cipherEncrypt cipher - | cipher == cipher_TLS13_AES128GCM_SHA256 = aes128gcmEncrypt - | cipher == cipher_TLS13_AES128CCM_SHA256 = - error "cipher_TLS13_AES128CCM_SHA256" - | cipher == cipher_TLS13_AES256GCM_SHA384 = aes256gcmEncrypt + | cipher == cipher13_AES_128_GCM_SHA256 = aes128gcmEncrypt + | cipher == cipher13_AES_128_CCM_SHA256 = error "cipher13_AES_128_CCM_SHA256" + | cipher == cipher13_AES_256_GCM_SHA384 = aes256gcmEncrypt | otherwise = error "cipherEncrypt" cipherDecrypt :: Cipher -> Key -> Nonce -> CipherText -> AssDat -> Maybe PlainText cipherDecrypt cipher - | cipher == cipher_TLS13_AES128GCM_SHA256 = aes128gcmDecrypt - | cipher == cipher_TLS13_AES128CCM_SHA256 = - error "cipher_TLS13_AES128CCM_SHA256" - | cipher == cipher_TLS13_AES256GCM_SHA384 = aes256gcmDecrypt + | cipher == cipher13_AES_128_GCM_SHA256 = aes128gcmDecrypt + | cipher == cipher13_AES_128_CCM_SHA256 = error "cipher13_AES_128_CCM_SHA256" + | cipher == cipher13_AES_256_GCM_SHA384 = aes256gcmDecrypt | otherwise = error "cipherDecrypt" -- IMPORTANT: Using 'let' so that parameters can be memorized. @@ -227,10 +225,9 @@ cipherHeaderProtection :: Cipher -> Key -> (Sample -> Mask) cipherHeaderProtection cipher key - | cipher == cipher_TLS13_AES128GCM_SHA256 = aes128ecbEncrypt key - | cipher == cipher_TLS13_AES128CCM_SHA256 = - error "cipher_TLS13_AES128CCM_SHA256" - | cipher == cipher_TLS13_AES256GCM_SHA384 = aes256ecbEncrypt key + | cipher == cipher13_AES_128_GCM_SHA256 = aes128ecbEncrypt key + | cipher == cipher13_AES_128_CCM_SHA256 = error "cipher13_AES_128_CCM_SHA256 " + | cipher == cipher13_AES_256_GCM_SHA384 = aes256ecbEncrypt key | otherwise = error "cipherHeaderProtection" diff --git a/Network/QUIC/Crypto/Utils.hs b/Network/QUIC/Crypto/Utils.hs --- a/Network/QUIC/Crypto/Utils.hs +++ b/Network/QUIC/Crypto/Utils.hs @@ -27,16 +27,16 @@ tagLength :: Cipher -> Int tagLength cipher - | cipher == cipher_TLS13_AES128GCM_SHA256 = 16 - | cipher == cipher_TLS13_AES128CCM_SHA256 = 16 - | cipher == cipher_TLS13_AES256GCM_SHA384 = 16 + | cipher == cipher13_AES_128_GCM_SHA256 = 16 + | cipher == cipher13_AES_128_CCM_SHA256 = 16 + | cipher == cipher13_AES_256_GCM_SHA384 = 16 | otherwise = error "tagLength" sampleLength :: Cipher -> Int sampleLength cipher - | cipher == cipher_TLS13_AES128GCM_SHA256 = 16 - | cipher == cipher_TLS13_AES128CCM_SHA256 = 16 - | cipher == cipher_TLS13_AES256GCM_SHA384 = 16 + | cipher == cipher13_AES_128_GCM_SHA256 = 16 + | cipher == cipher13_AES_128_CCM_SHA256 = 16 + | cipher == cipher13_AES_256_GCM_SHA384 = 16 | otherwise = error "sampleLength" ---------------------------------------------------------------- diff --git a/Network/QUIC/Handshake.hs b/Network/QUIC/Handshake.hs --- a/Network/QUIC/Handshake.hs +++ b/Network/QUIC/Handshake.hs @@ -156,14 +156,18 @@ ---------------------------------------------------------------- -handshakeServer :: ServerConfig -> Connection -> AuthCIDs -> IO (IO ()) -handshakeServer conf conn myAuthCIDs = +handshakeServer + :: ServerConfig -> Connection -> AuthCIDs -> StatelessResetToken -> IO (IO ()) +handshakeServer conf conn myAuthCIDs srt = handshakeServer' conf conn <$> getVersion conn <*> newHndStateRef <*> newIORef params where - params = setCIDsToParameters myAuthCIDs $ scParameters conf + params = + (setCIDsToParameters myAuthCIDs $ scParameters conf) + { statelessResetToken = Just srt + } handshakeServer' :: ServerConfig diff --git a/Network/QUIC/Info.hs b/Network/QUIC/Info.hs --- a/Network/QUIC/Info.hs +++ b/Network/QUIC/Info.hs @@ -14,7 +14,7 @@ sock <- getSocket conn -- fixme: this is undefined mysa <- NS.getSocketName sock - PeerInfo peersa _ <- getPeerInfo conn + PeerInfo peersa <- getPeerInfo conn mycid <- getMyCID conn peercid <- getPeerCID conn c <- getCipher conn RTT1Level diff --git a/Network/QUIC/Packet/Encode.hs b/Network/QUIC/Packet/Encode.hs --- a/Network/QUIC/Packet/Encode.hs +++ b/Network/QUIC/Packet/Encode.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE RecordWildCards #-} - module Network.QUIC.Packet.Encode ( -- encodePacket encodeVersionNegotiationPacket, diff --git a/Network/QUIC/Packet/Frame.hs b/Network/QUIC/Packet/Frame.hs --- a/Network/QUIC/Packet/Frame.hs +++ b/Network/QUIC/Packet/Frame.hs @@ -346,7 +346,7 @@ cidLen <- fromIntegral <$> read8 rbuf cID <- makeCID <$> extractShortByteString rbuf cidLen token <- StatelessResetToken <$> extractShortByteString rbuf 16 - return $ NewConnectionID (CIDInfo seqNum cID token) rpt + return $ NewConnectionID (newCIDInfo seqNum cID token) rpt decodeRetireConnectionID :: ReadBuffer -> IO Frame decodeRetireConnectionID rbuf = do diff --git a/Network/QUIC/Qlog.hs b/Network/QUIC/Qlog.hs --- a/Network/QUIC/Qlog.hs +++ b/Network/QUIC/Qlog.hs @@ -132,11 +132,11 @@ frameExtra DataBlocked{} = "" frameExtra StreamDataBlocked{} = "" frameExtra StreamsBlocked{} = "" -frameExtra (NewConnectionID (CIDInfo sn cid _) rpt) = +frameExtra (NewConnectionID cidinfo rpt) = ",\"sequence_number\":\"" - <> sw sn + <> sw (cidInfoSeq cidinfo) <> "\",\"connection_id:\":\"" - <> sw cid + <> sw (cidInfoCID cidinfo) <> "\",\"retire_prior_to\":\"" <> sw rpt <> "\"" diff --git a/Network/QUIC/Receiver.hs b/Network/QUIC/Receiver.hs --- a/Network/QUIC/Receiver.hs +++ b/Network/QUIC/Receiver.hs @@ -178,21 +178,12 @@ qlogDebug conn $ Debug "ping for speedup" sendFrames conn lvl [Ping] Nothing -> do - statelessReset <- isStatelessReset conn hdr crypt - if statelessReset - then do - qlogReceived conn StatelessReset tim - connDebugLog conn "debug: connection is reset statelessly" - E.throwIO ConnectionIsReset - else do - qlogDropped conn hdr - connDebugLog conn $ - "debug: cannot decrypt: " - <> bhow lvl - <> " size = " - <> bhow (BS.length $ cryptPacket crypt) - --- fixme: sending statelss reset + qlogDropped conn hdr + connDebugLog conn $ + "debug: cannot decrypt: " + <> bhow lvl + <> " size = " + <> bhow (BS.length $ cryptPacket crypt) isSendOnly :: Connection -> StreamId -> Bool isSendOnly conn sid @@ -376,10 +367,10 @@ mcidInfo <- retireMyCID conn sn case mcidInfo of Nothing -> return () - Just (CIDInfo _ cid _) -> do + Just cidInfo -> do when (isServer conn) $ do unregister <- getUnregister conn - unregister cid + unregister $ cidInfoCID cidInfo processFrame conn RTT1Level (PathChallenge dat) = sendFramesLim conn RTT1Level [PathResponse dat] processFrame conn RTT1Level (PathResponse dat) = @@ -411,18 +402,6 @@ -- to receive NewSessionTicket fire conn (Microseconds 1000000) $ killHandshaker conn lvl processFrame _ _ _ = closeConnection ProtocolViolation "Frame is not allowed" - --- QUIC version 1 uses only short packets for stateless reset. --- But we should check other packets, too. -isStatelessReset :: Connection -> Header -> Crypt -> IO Bool -isStatelessReset conn hdr Crypt{..} = do - let cid = headerMyCID hdr - included <- myCIDsInclude conn cid - case included of - Just _ -> return False - _ -> case decodeStatelessResetToken cryptPacket of - Nothing -> return False - Just token -> isStatelessRestTokenValid conn cid token -- Return value indicates duplication. putRxCrypto :: Connection -> EncryptionLevel -> RxStreamData -> IO Bool diff --git a/Network/QUIC/Server/Reader.hs b/Network/QUIC/Server/Reader.hs --- a/Network/QUIC/Server/Reader.hs +++ b/Network/QUIC/Server/Reader.hs @@ -7,6 +7,7 @@ clearDispatch, runDispatcher, tokenMgr, + genStatelessReset, -- * Accepting Accept (..), @@ -26,15 +27,17 @@ import qualified Data.Map.Strict as M import qualified GHC.IO.Exception as E import Network.ByteOrder -import Network.Control (LRUCache) +import Network.Control (LRUCacheRef, Rate, getRate, newRate) import qualified Network.Control as LRUCache import Network.Socket (Socket, waitReadSocketSTM) import qualified Network.Socket.ByteString as NSB import qualified System.IO.Error as E +import System.Random (getStdRandom, randomRIO, uniformByteString) import Network.QUIC.Common import Network.QUIC.Config import Network.QUIC.Connection +import Network.QUIC.Connector import Network.QUIC.Exception import Network.QUIC.Imports import Network.QUIC.Logger @@ -48,15 +51,22 @@ data Dispatch = Dispatch { tokenMgr :: CT.TokenManager , dstTable :: IORef ConnectionDict - , srcTable :: IORef RecvQDict + , srcTable :: RecvQDict + , genStatelessReset :: CID -> StatelessResetToken + , statelessResetRate :: Rate } +statelessResetLimit :: Int +statelessResetLimit = 20 + newDispatch :: ServerConfig -> IO Dispatch newDispatch ServerConfig{..} = Dispatch <$> CT.spawnTokenManager conf <*> newIORef emptyConnectionDict - <*> newIORef emptyRecvQDict + <*> newRecvQDict + <*> makeGenStatelessReset + <*> newRate where conf = CT.defaultConfig @@ -89,26 +99,21 @@ ---------------------------------------------------------------- --- Original destination CID -> RecvQ -newtype RecvQDict = RecvQDict (LRUCache CID RecvQ) +-- Source CID -> RecvQ +-- Initials and RTT0 are queued before Conneciton is created. +newtype RecvQDict = RecvQDict (LRUCacheRef CID RecvQ) recvQDictSize :: Int recvQDictSize = 100 -emptyRecvQDict :: RecvQDict -emptyRecvQDict = RecvQDict $ LRUCache.empty recvQDictSize +newRecvQDict :: IO RecvQDict +newRecvQDict = RecvQDict <$> LRUCache.newLRUCacheRef recvQDictSize -lookupRecvQDict :: IORef RecvQDict -> CID -> IO (Maybe RecvQ) -lookupRecvQDict ref dcid = do - RecvQDict c <- readIORef ref - return $ case LRUCache.lookup dcid c of - Nothing -> Nothing - Just q -> Just q +lookupRecvQDict :: RecvQDict -> CID -> IO (RecvQ, Bool) +lookupRecvQDict (RecvQDict ref) dcid = LRUCache.cached ref dcid newRecvQ -insertRecvQDict :: IORef RecvQDict -> CID -> RecvQ -> IO () -insertRecvQDict ref dcid q = atomicModifyIORef'' ref ins - where - ins (RecvQDict c) = RecvQDict $ LRUCache.insert dcid q c +lookupRecvQDict' :: RecvQDict -> CID -> IO (Maybe RecvQ) +lookupRecvQDict' (RecvQDict ref) dcid = LRUCache.cached' ref dcid ---------------------------------------------------------------- @@ -164,14 +169,14 @@ loop wait = do cont <- checkLoop stvar wait when cont $ do - (peersa, bs, cmsgs, _) <- safeRecv $ NSB.recvMsg mysock 2048 2048 0 + (bs, peersa) <- safeRecv $ NSB.recvFrom mysock 2048 now <- getTimeMicrosecond - let send' b = void $ NSB.sendMsg mysock peersa [b] cmsgs 0 + let send' b = void $ NSB.sendTo mysock b peersa -- cf: greaseQuicBit $ getMyParameters conn quicBit = greaseQuicBit $ scParameters conf cpckts <- decodeCryptPackets bs (not quicBit) let bytes = BS.length bs - peerInfo = PeerInfo peersa cmsgs + peerInfo = PeerInfo peersa switch = dispatch d conf forkConnection logAction mysock peerInfo send' bytes now mapM_ switch cpckts loop wait @@ -255,31 +260,28 @@ Just conn -> writeRecvQ (connRecvQ conn) $ mkReceivedPacket cpkt tim siz lvl where myVersions = scVersions - pushToAcceptQ myAuthCIDs peerAuthCIDs key addrValid = do - mq <- lookupRecvQDict srcTable key - case mq of - Just q -> writeRecvQ q $ mkReceivedPacket cpkt tim siz lvl - Nothing -> do - q <- newRecvQ - insertRecvQDict srcTable key q - writeRecvQ q $ mkReceivedPacket cpkt tim siz lvl - let reg = registerConnectionDict dstTable - unreg = unregisterConnectionDict dstTable - acc = - Accept - { accVersionInfo = VersionInfo peerVer myVersions - , accMyAuthCIDs = myAuthCIDs - , accPeerAuthCIDs = peerAuthCIDs - , accMySocket = mysock - , accPeerInfo = peerInfo - , accRecvQ = q - , accPacketSize = bytes - , accRegister = reg - , accUnregister = unreg - , accAddressValidated = addrValid - , accTime = tim - } - forkConnection acc + pushToAcceptQ myAuthCIDs peerAuthCIDs addrValid = do + (q, exist) <- lookupRecvQDict srcTable sCID + writeRecvQ q $ mkReceivedPacket cpkt tim siz lvl + unless exist $ do + let reg = registerConnectionDict dstTable + unreg cid = + fire' (Microseconds 10000000) $ unregisterConnectionDict dstTable cid + acc = + Accept + { accVersionInfo = VersionInfo peerVer myVersions + , accMyAuthCIDs = myAuthCIDs + , accPeerAuthCIDs = peerAuthCIDs + , accMySocket = mysock + , accPeerInfo = peerInfo + , accRecvQ = q + , accPacketSize = bytes + , accRegister = reg + , accUnregister = unreg + , accAddressValidated = addrValid + , accTime = tim + } + forkConnection acc -- Initial: DCID=S1, SCID=C1 -> -- <- Initial: DCID=C1, SCID=S2 -- ... @@ -300,7 +302,7 @@ defaultAuthCIDs { initSrcCID = Just sCID } - pushToAcceptQ myAuthCIDs peerAuthCIDs dCID addrValid + pushToAcceptQ myAuthCIDs peerAuthCIDs addrValid -- Initial: DCID=S1, SCID=C1 -> -- <- Retry: DCID=C1, SCID=S2 -- Initial: DCID=S2, SCID=C1 -> @@ -323,7 +325,7 @@ defaultAuthCIDs { initSrcCID = Just sCID } - pushToAcceptQ myAuthCIDs peerAuthCIDs o True + pushToAcceptQ myAuthCIDs peerAuthCIDs True pushToAcceptRetried _ = return () isRetryTokenValid (CryptoToken _tver life etim (Just (l, r, _))) = do diff <- getElapsedTimeMicrosecond etim @@ -356,11 +358,44 @@ _ _ tim - (cpkt@(CryptPacket (RTT0 _ dCID _) _), lvl, siz) = do - mq <- lookupRecvQDict srcTable dCID + (cpkt@(CryptPacket (RTT0 _ _dCID sCID) _), lvl, siz) = do + mq <- lookupRecvQDict' srcTable sCID case mq of Just q -> writeRecvQ q $ mkReceivedPacket cpkt tim siz lvl Nothing -> return () +---------------------------------------------------------------- +dispatch + Dispatch{..} + _ + _ + logAction + mysock + peerInfo + send' + bytes + tim + (cpkt@(CryptPacket (Short dCID) _), lvl, siz) = do + mconn <- lookupConnectionDict dstTable dCID + case mconn of + Nothing -> do + -- Three times rule for stateless reset + -- Our packet size is 1280 + when (bytes > 427) $ do + srRate <- getRate statelessResetRate + -- fixme: hard coding + when (srRate < statelessResetLimit) $ do + flag <- randomRIO (0, 127) + body <- getStdRandom $ uniformByteString 1263 + let srt = genStatelessReset dCID + statelessReset = BS.concat [BS.singleton flag, body, fromStatelessResetToken srt] + send' statelessReset + logAction $ "Stateless reset is sent to " <> bhow peerInfo + Just conn -> do + alive <- getAlive conn + when alive $ do + void $ setSocket conn mysock + setPeerInfo conn peerInfo + writeRecvQ (connRecvQ conn) $ mkReceivedPacket cpkt tim siz lvl ---------------------------------------------------------------- dispatch Dispatch{..} diff --git a/Network/QUIC/Server/Run.hs b/Network/QUIC/Server/Run.hs --- a/Network/QUIC/Server/Run.hs +++ b/Network/QUIC/Server/Run.hs @@ -41,7 +41,7 @@ -- The action is executed with a new connection -- in a new lightweight thread. run :: ServerConfig -> (Connection -> IO ()) -> IO () -run conf server = NS.withSocketsDo $ handleLogUnit debugLog $ do +run conf server = handleLogUnit debugLog $ do labelMe "QUIC run" stvar <- newTVarIO Running E.bracket (setup stvar) teardown $ \(_, _, _) -> do @@ -70,7 +70,7 @@ -- The action is executed with a new connection -- in a new lightweight thread. runWithSockets :: [NS.Socket] -> ServerConfig -> (Connection -> IO ()) -> IO () -runWithSockets ssas conf server = NS.withSocketsDo $ handleLogUnit debugLog $ do +runWithSockets ssas conf server = handleLogUnit debugLog $ do labelMe "QUIC runWithSockets" stvar <- newTVarIO Running E.bracket (setup stvar) teardown $ \(_, _) -> do @@ -113,7 +113,8 @@ { versionInformation = Just $ accVersionInfo acc } } - handshaker <- handshakeServer conf' conn myAuthCIDs + let srt = genStatelessReset dispatch $ fromJust $ initSrcCID myAuthCIDs + handshaker <- handshakeServer conf' conn myAuthCIDs srt let server = do wait1RTTReady conn afterHandshakeServer conf conn @@ -158,8 +159,8 @@ piref <- newIORef accPeerInfo let send buf siz = void $ do sock <- readIORef sref - PeerInfo sa cmsgs <- readIORef piref - NS.sendBufMsg sock sa [(buf, siz)] cmsgs 0 + PeerInfo sa <- readIORef piref + NS.sendBufTo sock buf siz sa recv = recvServer accRecvQ let myCID = fromJust $ initSrcCID accMyAuthCIDs ocid = fromJust $ origDstCID accMyAuthCIDs @@ -180,13 +181,14 @@ accRecvQ send recv + (genStatelessReset dispatch) addResource conn qclean addResource conn dclean let cid = fromMaybe ocid $ retrySrcCID accMyAuthCIDs ver = chosenVersion accVersionInfo initializeCoder conn InitialLevel $ initialSecrets ver cid setupCryptoStreams conn -- fixme: cleanup - let PeerInfo peersa _ = accPeerInfo + let PeerInfo peersa = accPeerInfo pktSiz = (defaultPacketSize peersa `max` accPacketSize) `min` maximumPacketSize peersa diff --git a/Network/QUIC/Socket.hs b/Network/QUIC/Socket.hs --- a/Network/QUIC/Socket.hs +++ b/Network/QUIC/Socket.hs @@ -6,6 +6,7 @@ import qualified Control.Exception as E import Data.IP (IP, toSockAddr) +import qualified Data.List.NonEmpty as NE import Network.Socket natRebinding :: SockAddr -> IO Socket @@ -21,7 +22,7 @@ clientSocket :: HostName -> ServiceName -> IO (Socket, SockAddr) clientSocket host port = do - addr <- head <$> getAddrInfo (Just hints) (Just host) (Just port) + addr <- NE.head <$> getAddrInfo (Just hints) (Just host) (Just port) E.bracketOnError (openSocket addr) close $ \s -> return (s, addrAddress addr) where hints = defaultHints{addrSocketType = Datagram, addrFlags = [AI_ADDRCONFIG]} diff --git a/Network/QUIC/Stream/Types.hs b/Network/QUIC/Stream/Types.hs --- a/Network/QUIC/Stream/Types.hs +++ b/Network/QUIC/Stream/Types.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE RecordWildCards #-} - module Network.QUIC.Stream.Types ( Stream (..), newStream, diff --git a/Network/QUIC/Types/CID.hs b/Network/QUIC/Types/CID.hs --- a/Network/QUIC/Types/CID.hs +++ b/Network/QUIC/Types/CID.hs @@ -9,16 +9,23 @@ makeCID, unpackCID, StatelessResetToken (..), - newStatelessResetToken, + fromStatelessResetToken, + makeGenStatelessReset, PathData (..), newPathData, - CIDInfo (..), + CIDInfo, + newCIDInfo, + cidInfoSeq, + cidInfoCID, + cidInfoSRT, ) where -import qualified Data.ByteString.Short as Short - import Codec.Serialise +import Crypto.Hash +import Crypto.KDF.HKDF +import qualified Data.ByteString.Short as Short import GHC.Generics +import System.Random (getStdRandom, uniformByteString) import Network.QUIC.Imports @@ -54,9 +61,17 @@ -- 16 bytes newtype StatelessResetToken = StatelessResetToken Bytes deriving (Eq, Ord, Show) -newStatelessResetToken :: IO StatelessResetToken -newStatelessResetToken = StatelessResetToken <$> getRandomBytes 16 +fromStatelessResetToken :: StatelessResetToken -> ByteString +fromStatelessResetToken (StatelessResetToken srt) = Short.fromShort srt +makeGenStatelessReset :: IO (CID -> StatelessResetToken) +makeGenStatelessReset = do + salt <- getStdRandom $ uniformByteString 20 + ikm <- getStdRandom $ uniformByteString 20 + let prk = extract salt ikm :: PRK SHA256 + makeStatelessReset dcid = StatelessResetToken $ Short.toShort $ expand prk (fromCID dcid) 16 + return makeStatelessReset + -- 8 bytes newtype PathData = PathData Bytes deriving (Eq, Show) @@ -69,3 +84,11 @@ , cidInfoSRT :: StatelessResetToken } deriving (Eq, Ord, Show) + +newCIDInfo :: Int -> CID -> StatelessResetToken -> CIDInfo +newCIDInfo n cid srt = + CIDInfo + { cidInfoSeq = n + , cidInfoCID = cid + , cidInfoSRT = srt + } diff --git a/Network/QUIC/Utils.hs b/Network/QUIC/Utils.hs --- a/Network/QUIC/Utils.hs +++ b/Network/QUIC/Utils.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Network.QUIC.Utils where @@ -11,7 +12,9 @@ import Data.ByteString.Short (ShortByteString) import qualified Data.ByteString.Short as Short import Data.Char (chr) +#if __GLASGOW_HASKELL__ < 910 import Data.List (foldl') +#endif import Data.Word import Foreign.ForeignPtr (withForeignPtr) import Foreign.Ptr (Ptr, plusPtr) 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.7 +version: 0.2.8 license: BSD3 license-file: LICENSE maintainer: kazu@iij.ad.jp @@ -144,12 +144,12 @@ fast-logger >= 3.2.2 && < 3.3, unix-time >= 0.4.12 && < 0.5, iproute >= 1.7.12 && < 1.8, - network >= 3.2.2, + network >= 3.2.3, network-byte-order >= 0.1.7 && < 0.2, - network-control >= 0.1 && < 0.2, - random >= 1.2.1 && < 1.3, + network-control >= 0.1.5 && < 0.2, + random >= 1.2.1 && < 1.4, serialise, - tls >= 2.0 && < 2.2 + tls >= 2.1.6 && < 2.2 if os(windows) cc-options: -D_WINDOWS diff --git a/test/Config.hs b/test/Config.hs --- a/test/Config.hs +++ b/test/Config.hs @@ -18,6 +18,7 @@ import Data.ByteString (ByteString) import Data.IORef import qualified Data.List as L +import qualified Data.List.NonEmpty as NE import Network.Socket import Network.Socket.ByteString import Network.TLS hiding (Version) @@ -137,7 +138,7 @@ , addrFamily = AF_INET } resolve port = - head <$> getAddrInfo (Just hints) (Just "127.0.0.1") (Just port) + NE.head <$> getAddrInfo (Just hints) (Just "127.0.0.1") (Just port) shouldDrop (Randomly n) _ _ = do w <- getRandomOneByte return ((w `mod` fromIntegral n) == 0) diff --git a/test/IOSpec.hs b/test/IOSpec.hs --- a/test/IOSpec.hs +++ b/test/IOSpec.hs @@ -199,10 +199,13 @@ strm <- acceptStream conn void $ forkIO $ do bs <- recvStream strm 1 - let n = fromIntegral $ head $ BS.unpack bs - consumeBytes strm (chunklen * times) - assertEndOfStream strm - putMVar (mvars !! n) () + case BS.uncons bs of + Nothing -> return () + Just (w, _) -> do + let n = fromIntegral w + consumeBytes strm (chunklen * times) + assertEndOfStream strm + putMVar (mvars !! n) () loop conn appErr :: QUICException -> Bool diff --git a/test/PacketSpec.hs b/test/PacketSpec.hs --- a/test/PacketSpec.hs +++ b/test/PacketSpec.hs @@ -49,9 +49,10 @@ (sock, peersa) <- clientSocket "127.0.0.1" "2000" q <- newRecvQ sref <- newIORef sock - piref <- newIORef $ PeerInfo peersa [] + piref <- newIORef $ PeerInfo peersa let ver = v verInfo = VersionInfo ver [ver] + genSRT <- makeGenStatelessReset ---- clientConn <- clientConnection @@ -67,6 +68,7 @@ q undefined undefined + genSRT initializeCoder clientConn InitialLevel $ initialSecrets ver serverCID serverConn <- serverConnection @@ -82,6 +84,7 @@ q undefined undefined + genSRT initializeCoder serverConn InitialLevel $ initialSecrets ver serverCID ---- return (clientConn, serverConn) diff --git a/util/Common.hs b/util/Common.hs --- a/util/Common.hs +++ b/util/Common.hs @@ -36,9 +36,9 @@ split :: Char -> String -> [String] split _ "" = [] split c s = case break (c ==) s of - ("", r) -> split c (tail r) + ("", r) -> split c (drop 1 r) (s', "") -> [s'] - (s', r) -> s' : split c (tail r) + (s', r) -> s' : split c (drop 1 r) getLogger :: Maybe FilePath -> (String -> IO ()) getLogger Nothing = \_ -> return () diff --git a/util/quic-client.hs b/util/quic-client.hs --- a/util/quic-client.hs +++ b/util/quic-client.hs @@ -415,7 +415,10 @@ putStrLn "q -- quit" putStrLn "g -- get" putStrLn "p -- ping" - putStrLn "n -- NAT rebinding" + putStrLn "M -- change server CID" + putStrLn "N -- change client CID" + putStrLn "B -- NAT rebinding" + putStrLn "A -- address mobility" loop where loop = do @@ -433,8 +436,17 @@ putStrLn "Ping" sendFrames conn RTT1Level [Ping] loop - "n" -> do + "M" -> do + controlConnection conn ChangeServerCID >>= print + loop + "N" -> do + controlConnection conn ChangeClientCID >>= print + loop + "B" -> do controlConnection conn NATRebinding >>= print + loop + "A" -> do + controlConnection conn ActiveMigration >>= print loop _ -> do putStrLn "No such command" diff --git a/util/quic-server.hs b/util/quic-server.hs --- a/util/quic-server.hs +++ b/util/quic-server.hs @@ -27,6 +27,7 @@ , optQLogDir :: Maybe FilePath , optKeyLogFile :: Maybe FilePath , optGroups :: Maybe String + , optTimeout :: Maybe Int , optCertFile :: FilePath , optKeyFile :: FilePath , optRetry :: Bool @@ -40,6 +41,7 @@ , optQLogDir = Nothing , optKeyLogFile = Nothing , optGroups = Nothing + , optTimeout = Nothing , optCertFile = "servercert.pem" , optKeyFile = "serverkey.pem" , optRetry = False @@ -82,6 +84,11 @@ ["retry"] (NoArg (\o -> o{optRetry = True})) "require stateless retry" + , Option + ['o'] + ["timeout"] + (ReqArg (\tim o -> o{optTimeout = Just (read tim)}) "") + "RX timeout in seconds" ] usage :: String @@ -140,6 +147,9 @@ , scCredentials = Credentials [cred] } run sc $ \conn -> do + case optTimeout of + Just t -> setMinIdleTimeout conn $ Microseconds $ t * 1000000 + Nothing -> return () info <- getConnectionInfo conn let server = case alpn info of Just proto