diff options
author | Joe Crayne <joe@jerkface.net> | 2020-01-11 12:27:39 -0500 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2020-01-11 12:27:39 -0500 |
commit | 0e3c922142177b093d90cba81d0b6712172e1f57 (patch) | |
tree | f0e0c1346c8a01c48c95334e199c348f847ff664 | |
parent | f45bf9ee967e61553229dcad5225b61120c6a63d (diff) |
Renamed streamServer to forkStreamServer.
-rw-r--r-- | dht/examples/dhtd.hs | 2 | ||||
-rw-r--r-- | server/src/Connection/Tcp.hs | 2 | ||||
-rw-r--r-- | server/src/Network/StreamServer.hs | 30 | ||||
-rw-r--r-- | test/resourceExhausted.hs | 2 |
4 files changed, 22 insertions, 14 deletions
diff --git a/dht/examples/dhtd.hs b/dht/examples/dhtd.hs index ed0feacb..984afeed 100644 --- a/dht/examples/dhtd.hs +++ b/dht/examples/dhtd.hs | |||
@@ -1909,7 +1909,7 @@ main = do | |||
1909 | , mbTox = mbtox | 1909 | , mbTox = mbtox |
1910 | , sessionsVar = ssvar | 1910 | , sessionsVar = ssvar |
1911 | } | 1911 | } |
1912 | srv <- streamServer (withSession session) [SockAddrUnix "dht.sock"] | 1912 | srv <- forkStreamServer (withSession session) [SockAddrUnix "dht.sock"] |
1913 | return ( do atomically $ readTVar signalQuit >>= check | 1913 | return ( do atomically $ readTVar signalQuit >>= check |
1914 | quitListening srv | 1914 | quitListening srv |
1915 | , readTVar signalQuit >>= check | 1915 | , readTVar signalQuit >>= check |
diff --git a/server/src/Connection/Tcp.hs b/server/src/Connection/Tcp.hs index 7d93e7de..72b51191 100644 --- a/server/src/Connection/Tcp.hs +++ b/server/src/Connection/Tcp.hs | |||
@@ -300,7 +300,7 @@ server allocate sessionConduits = do | |||
300 | 300 | ||
301 | dput XMisc $ "Started listening on "++show port | 301 | dput XMisc $ "Started listening on "++show port |
302 | 302 | ||
303 | sserv <- flip streamServer [port] ServerConfig | 303 | sserv <- flip forkStreamServer [port] ServerConfig |
304 | { serverWarn = dput XMisc | 304 | { serverWarn = dput XMisc |
305 | , serverSession = \sock _ h -> do | 305 | , serverSession = \sock _ h -> do |
306 | (conkey,u) <- makeConnKey params sock | 306 | (conkey,u) <- makeConnKey params sock |
diff --git a/server/src/Network/StreamServer.hs b/server/src/Network/StreamServer.hs index 4fc477c5..c60ba99d 100644 --- a/server/src/Network/StreamServer.hs +++ b/server/src/Network/StreamServer.hs | |||
@@ -5,7 +5,7 @@ | |||
5 | {-# LANGUAGE OverloadedStrings #-} | 5 | {-# LANGUAGE OverloadedStrings #-} |
6 | {-# LANGUAGE RankNTypes #-} | 6 | {-# LANGUAGE RankNTypes #-} |
7 | module Network.StreamServer | 7 | module Network.StreamServer |
8 | ( streamServer | 8 | ( forkStreamServer |
9 | , ServerHandle | 9 | , ServerHandle |
10 | , getAcceptLoopThreadId | 10 | , getAcceptLoopThreadId |
11 | , ServerConfig(..) | 11 | , ServerConfig(..) |
@@ -71,8 +71,9 @@ dummyServerHandle = do | |||
71 | -} | 71 | -} |
72 | 72 | ||
73 | removeSocketFile :: SockAddr -> IO () | 73 | removeSocketFile :: SockAddr -> IO () |
74 | removeSocketFile (SockAddrUnix fname) = removeFile fname | 74 | removeSocketFile (SockAddrUnix ('\0':_)) = return () |
75 | removeSocketFile _ = return () | 75 | removeSocketFile (SockAddrUnix fname) = removeFile fname |
76 | removeSocketFile _ = return () | ||
76 | 77 | ||
77 | -- | Terminate the server accept-loop. Call this to shut down the server. | 78 | -- | Terminate the server accept-loop. Call this to shut down the server. |
78 | quitListening :: ServerHandle -> IO () | 79 | quitListening :: ServerHandle -> IO () |
@@ -106,15 +107,22 @@ data ServerConfig = ServerConfig | |||
106 | withSession :: ((RestrictedSocket,(Local SockAddr,Remote SockAddr)) -> Int -> Handle -> IO ()) -> ServerConfig | 107 | withSession :: ((RestrictedSocket,(Local SockAddr,Remote SockAddr)) -> Int -> Handle -> IO ()) -> ServerConfig |
107 | withSession session = ServerConfig warnStderr session | 108 | withSession session = ServerConfig warnStderr session |
108 | 109 | ||
109 | -- | Launch a thread to listen at the given bind address and dispatch | 110 | -- | Launch a thread to listen at the given bind address and dispatch to |
110 | -- to session handler threads on every incoming connection. Supports | 111 | -- session handler threads on every incoming connection. Supports IPv4 and |
111 | -- IPv4 and IPv6, TCP and unix sockets. | 112 | -- IPv6, TCP and unix sockets. |
112 | -- | 113 | -- |
113 | -- The returned handle can be used with 'quitListening' to terminate the | 114 | -- Arguments: |
114 | -- thread and prevent any new sessions from starting. Currently active | 115 | -- |
115 | -- session threads will not be terminated or signaled in any way. | 116 | -- [cfg] Functions for handling incomming sessions and logging prints. |
116 | streamServer :: ServerConfig -> [SockAddr] -> IO ServerHandle | 117 | -- |
117 | streamServer cfg addrs0 = do | 118 | -- [addrs] A list of bind addresses that will be tried one after another |
119 | -- until a successful listening socket is created. | ||
120 | -- | ||
121 | -- The returned handle can be used with 'quitListening' to terminate the thread | ||
122 | -- and prevent any new sessions from starting. Currently active session | ||
123 | -- threads will not be terminated or signaled in any way. | ||
124 | forkStreamServer :: ServerConfig -> [SockAddr] -> IO ServerHandle | ||
125 | forkStreamServer cfg addrs0 = do | ||
118 | let warn = serverWarn cfg | 126 | let warn = serverWarn cfg |
119 | family = case addrs0 of | 127 | family = case addrs0 of |
120 | SockAddrInet {}:_ -> AF_INET | 128 | SockAddrInet {}:_ -> AF_INET |
diff --git a/test/resourceExhausted.hs b/test/resourceExhausted.hs index 4cdef98e..c38784a5 100644 --- a/test/resourceExhausted.hs +++ b/test/resourceExhausted.hs | |||
@@ -15,7 +15,7 @@ sesh sock n h = do | |||
15 | main = do | 15 | main = do |
16 | setVerbose XMisc | 16 | setVerbose XMisc |
17 | bind <- getBindAddress "8889" True | 17 | bind <- getBindAddress "8889" True |
18 | serv <- streamServer (withSession sesh) [bind] | 18 | serv <- forkStreamServer (withSession sesh) [bind] |
19 | 19 | ||
20 | wtid <- getAcceptLoopThreadId serv | 20 | wtid <- getAcceptLoopThreadId serv |
21 | mtid <- deRefWeak wtid | 21 | mtid <- deRefWeak wtid |