diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,15 @@ # ChangeLog +## 0.3.18 + +* The threads of a connection are owned by `time-manager`'s + `ThreadManager`, and counted from before each fork. + [#174](https://github.com/kazu-yamamoto/quic/pull/174) +* A server waits for its connections before returning, instead of giving + them one second and returning while they still use the caller's sockets. + [#174](https://github.com/kazu-yamamoto/quic/pull/174) +* Requires `time-manager` 0.5. + ## 0.3.17 * Security fix: bound what an unauthenticated packet can take. 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 @@ -244,5 +244,5 @@ when connected $ connect newSock peersa oldSock <- setSocket conn newSock let reader = readerClient newSock conn - forkManaged conn reader + forkManaged conn "QUIC reader" reader fire conn microseconds $ close oldSock 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 @@ -59,7 +59,7 @@ runClient :: ClientConfig -> (Connection -> IO a) -> Bool -> VersionInfo -> IO a runClient conf client0 isICVN verInfo = do E.bracket open clse $ \(ConnRes conn myAuthCIDs reader) -> do - forkManaged conn reader + forkManaged conn "QUIC reader" reader let conf' = conf { ccParameters = @@ -107,18 +107,22 @@ labelMe "concurrently5" >> concurrently (c4 `E.catch` \(_ :: InternalControl) -> return ()) s6 runThreads = snd <$> c5 - when (ccWatchDog conf) $ forkManaged conn $ watchDog conn + when (ccWatchDog conf) $ forkManaged conn "QUIC watchDog" $ watchDog conn ex <- E.try runThreads sendFinal conn setConnectionClosed conn closure conn ldcc ex where open = createClientConnection conf verInfo + -- Stopping the readers and seeing them out before the buffers they use + -- are freed. This used to free first and stop after, which left every + -- reader a window in which to use a buffer that had been handed back. clse connRes = do let conn = connResConnection connRes setDead conn - freeResources conn killReaders conn + waitManaged conn + freeResources conn createClientConnection :: ClientConfig -> VersionInfo -> IO ConnRes createClientConnection conf@ClientConfig{..} verInfo = do 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 @@ -24,6 +24,7 @@ resetDealyedAck, setMaxPacketSize, forkManaged, + waitManaged, killReaders, addResource, freeResources, @@ -34,11 +35,9 @@ abortConnection, ) where -import Control.Concurrent import qualified Control.Exception as E -import qualified Data.Map.Strict as Map import Network.Socket (SockAddr, Socket) -import System.Mem.Weak +import qualified System.ThreadManager as T import Network.QUIC.Connection.Queue import Network.QUIC.Connection.Timeout @@ -191,35 +190,24 @@ ---------------------------------------------------------------- -addReader :: Connection -> ThreadId -> IO () -addReader Connection{..} tid = do - wtid <- mkWeakThreadId tid - let n = fromThreadId tid - atomicModifyIORef'' readers $ Map.insert n wtid - -delReader :: Connection -> ThreadId -> IO () -delReader Connection{..} tid = do - let n = fromThreadId tid - atomicModifyIORef'' readers $ Map.delete n +forkManaged :: Connection -> String -> IO () -> IO () +forkManaged Connection{..} = T.forkManaged readers -forkManaged :: Connection -> IO () -> IO () -forkManaged conn action = void $ forkIO $ do - E.bracket setup clean $ \_ -> action - where - setup = do - tid <- myThreadId - addReader conn tid - return tid - clean = delReader conn +-- | Waiting until this connection's 'forkManaged' threads are all done. +-- +-- What they are done with is the connection's buffers, so this has to come +-- between stopping them and 'freeResources'. +-- +-- No cap on the wait: these are all this library's own threads and they +-- end on the exception 'killReaders' throws. What http2 and http3 cap is +-- a wait that includes the application's handler. +waitManaged :: Connection -> IO () +waitManaged Connection{..} = T.waitUntilAllGone readers +-- | Killing the threads of 'forkManaged'. One forked after this is +-- refused rather than run. killReaders :: Connection -> IO () -killReaders Connection{..} = do - wtids <- readIORef readers - forM_ wtids $ \wtid -> do - mtid <- deRefWeak wtid - case mtid of - Nothing -> return () - Just tid -> killThread tid +killReaders Connection{..} = T.stopAfter readers (return ()) $ \_ -> return () ---------------------------------------------------------------- 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 @@ -28,7 +28,7 @@ ) import Network.Socket (SockAddr, Socket) import Network.TLS.QUIC -import System.Mem.Weak (Weak) +import qualified System.ThreadManager as T import Network.QUIC.Config import Network.QUIC.Connector @@ -264,7 +264,7 @@ , connRecvDatagramQ :: DatagramQ , connSocket :: IORef Socket , genStatelessResetToken :: CID -> StatelessResetToken - , readers :: IORef (Map Word64 (Weak ThreadId)) + , readers :: T.ThreadManager , mainThreadId :: ThreadId , controlRate :: Rate , -- Info @@ -380,7 +380,7 @@ newConnection rl myParameters origVersionInfo myAuthCIDs peerAuthCIDs connDebugLog connQLog connHooks connSocket peerInfo connRecvQ connRecvDatagramQ ~connSend ~connRecv genStatelessResetToken = do connState <- newConnState rl -- Manage - readers <- newIORef Map.empty + readers <- T.newThreadManager mainThreadId <- myThreadId controlRate <- newRate -- Info 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,7 +7,7 @@ clearDispatch, runDispatcher, liveConnections, - withConnectionCount, + spawnConnection, waitNoConnection, tokenMgr, genStatelessReset, @@ -26,7 +26,6 @@ import Control.Concurrent import Control.Concurrent.STM import qualified Control.Exception as E -import qualified Control.Monad.STM as STM import qualified Crypto.Token as CT import qualified Data.ByteString as BS import Data.Map.Strict (Map) @@ -45,6 +44,7 @@ import qualified Network.Socket.ByteString as NSB import qualified System.IO.Error as E import System.Log.FastLogger +import qualified System.ThreadManager as T import Network.QUIC.Common import Network.QUIC.Config @@ -66,7 +66,7 @@ , srcTable :: RecvQDict , genStatelessReset :: CID -> StatelessResetToken , statelessResetRate :: Rate - , connectionCount :: TVar Int + , connectionThreads :: T.ThreadManager , stopServerNow :: IO () -- ^ Stopping this server: what the shutdown handler is handed, and -- what a connection's 'stop' reaches it by. @@ -83,7 +83,7 @@ <*> newRecvQDict <*> makeGenStatelessReset <*> newRate - <*> newTVarIO 0 + <*> T.newThreadManager <*> pure stopNow where conf = @@ -123,19 +123,16 @@ -- the elements repeat. Its main thread is what it has one of. return $ M.elems $ M.fromList [(mainThreadId conn, conn) | conn <- M.elems tbl] --- | Running a connection, counted while it runs. 'dstTable' cannot say --- when the last of them is done: a connection leaves it a second after it --- ends, and it is in there under several keys. -withConnectionCount :: Dispatch -> IO a -> IO a -withConnectionCount Dispatch{..} = E.bracket_ (bump 1) (bump (-1)) - where - bump n = atomically $ modifyTVar' connectionCount (+ n) +-- | Running a connection on a thread of its own, counted from before the +-- fork. 'dstTable' cannot say when the last of them is done: a +-- connection leaves it a second after it ends, and it is in there under +-- several keys. +spawnConnection :: Dispatch -> IO () -> IO () +spawnConnection Dispatch{..} = T.forkManaged connectionThreads "QUIC connection" -- | Waiting until no connection is running. waitNoConnection :: Dispatch -> IO () -waitNoConnection Dispatch{..} = atomically $ do - n <- readTVar connectionCount - STM.check $ n == 0 +waitNoConnection Dispatch{..} = T.waitUntilAllGone connectionThreads ---------------------------------------------------------------- @@ -530,7 +527,7 @@ -- yet. claimed <- claimMigration conn when claimed $ - forkManaged conn $ + forkManaged conn "QUIC migration" $ onClientMigration conn dCID peersa cidChanged _ -> return () writeRecvQ (connRecvQ conn) $ mkReceivedPacket cpkt tim siz lvl 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 @@ -71,10 +71,8 @@ setup stvar stopNow wakeRef = do dispatch <- newDispatch conf stopNow let forkConn acc = - void $ - forkIO $ - withConnectionCount dispatch $ - runServer conf server dispatch acc + spawnConnection dispatch $ + runServer conf server dispatch acc flip E.onException (clearDispatch dispatch) $ do ssas <- openAll $ scAddresses conf writeIORef wakeRef $ mapM_ wakeDispatcher ssas @@ -127,10 +125,8 @@ setup stvar stopNow = do dispatch <- newDispatch conf stopNow let forkConn acc = - void $ - forkIO $ - withConnectionCount dispatch $ - runServer conf server dispatch acc + spawnConnection dispatch $ + runServer conf server dispatch acc flip E.onException (clearDispatch dispatch) $ do tids <- runAll dispatch conf stvar forkConn ssas return (dispatch, tids) @@ -189,18 +185,42 @@ -- -- Each is ended from a thread of its own, because 'throwTo' waits for the -- exception to be taken and a connection whose application is slow to --- unwind would hold up the rest. The wait that follows is what they are --- all given, and it is bounded: a connection that will not end is not worth --- the sockets. +-- unwind would hold up the rest. + +-- | Telling every connection to stop, and waiting until none is left. +-- +-- Waiting matters because the caller owns the sockets. Returning while a +-- connection still runs leaves it using a socket the caller is about to +-- close, and what that costs is not theoretical: the connection's last +-- CONNECTION_CLOSE went out on a closed descriptor and was lost, so the +-- peer heard nothing and sat until its idle timeout. It is also a thread +-- reading a descriptor number that the kernel may hand to someone else. +-- +-- Each connection is told once. Telling it again a second later cannot +-- hurry a connection that is already closing down under 'mask', and what it +-- does reach is the CONNECTION_CLOSE being sent -- which it then interrupts +-- and loses, which is the thing this is here to prevent. The second pass +-- is only to tell connections that were not yet in the table when the first +-- one looked. +-- +-- There is no cap on the wait. An application that never finishes with a +-- connection therefore keeps the server from returning, which is a +-- deliberate choice: the alternative is returning while it runs, which is +-- what this changed. http3 caps the wait it does of its own, so an H3 +-- connection comes back within that cap however its handler behaves. shutdownConnections :: ServerConfig -> Dispatch -> IO () -shutdownConnections conf dispatch = do - conns <- liveConnections dispatch - unless (null conns) $ do - mapM_ (void . forkIO . shut) conns - void $ T.timeout 1000000 $ waitNoConnection dispatch +shutdownConnections conf dispatch = loop [] where (err, reason) = scCloseReason conf shut conn = abortConnection conn err reason + loop told = do + conns <- liveConnections dispatch + let unTold = [conn | conn <- conns, mainThreadId conn `notElem` told] + mapM_ (void . forkIO . shut) unTold + done <- T.timeout 1000000 $ waitNoConnection dispatch + case done of + Just () -> return () + Nothing -> loop $ map mainThreadId unTold ++ told -- | Running a dispatcher on each socket, killing the ones already running if -- a later one cannot be started. @@ -305,9 +325,15 @@ closure conn ldcc ex where open = createServerConnection conf dispatch acc + -- Stop this connection's own threads and see them out before the + -- buffers they use are freed. Nothing stopped them here at all: a path + -- validation outlived the connection it was validating a path for, and + -- went on reading and writing buffers that had been handed back. clse connRes = do let conn = connResConnection connRes setDead conn + killReaders conn + waitManaged conn freeResources conn -- Say why the connection ended. This used to discard it, so a server -- connection that died of anything 'closure' does not turn into a diff --git a/quic.cabal b/quic.cabal --- a/quic.cabal +++ b/quic.cabal @@ -1,6 +1,6 @@ cabal-version: 2.0 name: quic -version: 0.3.17 +version: 0.3.18 license: BSD3 license-file: LICENSE maintainer: kazu@iij.ad.jp @@ -147,6 +147,7 @@ random >=1.2 && <1.4, serialise, stm >=2.5 && <2.6, + time-manager >=0.5 && <0.6, tls >=2.4.0 && <2.5, unix-time >=0.4.12 && <0.6 diff --git a/test/ShutdownSpec.hs b/test/ShutdownSpec.hs --- a/test/ShutdownSpec.hs +++ b/test/ShutdownSpec.hs @@ -62,6 +62,35 @@ told <- T.timeout 5000000 $ waitCatch peer told `shouldSatisfy` wasToldTheServerIsClosing + -- The caller owns the socket and closes it once this returns, so + -- returning while a connection still runs hands that connection a + -- closed descriptor. What it loses is the CONNECTION_CLOSE it was in + -- the middle of sending, and the peer then waits out its idle timeout + -- hearing nothing. + it "waits for a connection whose application is still finishing" $ + withServerSocket $ \sock -> do + (sc, ready, stopVar) <- shutdownServerConfig + let forever' = threadDelay 30000000 + serving <- newEmptyMVar + finished <- newEmptyMVar + -- An application that takes its time on the way out, and says + -- when it is done. + let slowApp _ = + (putMVar serving () >> forever') + `E.finally` (threadDelay 1500000 >> putMVar finished ()) + withAsync (runWithSockets [sock] sc slowApp) $ \server -> do + takeMVar ready + stopNow <- takeMVar stopVar + withAsync (C.run clientConfig (\_ -> forever')) $ \_ -> do + takeMVar serving + stopNow + ended <- T.timeout 10000000 $ wait server + ended `shouldBe` Just () + -- Already finished by the time the server returned, + -- which is the whole point: a take that has to wait + -- here is a server that returned too early. + tryTakeMVar finished `shouldReturn` Just () + -- | Whether the client ended because the server said so, rather than -- because it waited out its idle timeout on a connection that had stopped -- answering.