--- a/netserver/Miscutils.hs Sun Jan 25 18:27:31 2009 +0000
+++ b/netserver/Miscutils.hs Sun Jan 25 18:35:27 2009 +0000
@@ -87,6 +87,13 @@
Map.empty
)
+data StatisticsInfo =
+ StatisticsInfo
+ {
+ playersNumber :: Int,
+ roomsNumber :: Int
+ }
+
data ServerInfo =
ServerInfo
{
@@ -94,7 +101,8 @@
serverMessage :: String,
listenPort :: PortNumber,
loginsNumber :: Int,
- lastHourUsers :: [UTCTime]
+ lastHourUsers :: [UTCTime],
+ stats :: TMVar StatisticsInfo
}
newServerInfo = (
--- a/netserver/hedgewars-server.hs Sun Jan 25 18:27:31 2009 +0000
+++ b/netserver/hedgewars-server.hs Sun Jan 25 18:35:27 2009 +0000
@@ -2,7 +2,8 @@
module Main where
-import Network
+import qualified Network
+import Network.Socket
import IO
import System.IO
import Control.Concurrent
@@ -41,7 +42,7 @@
acceptLoop servSock acceptChan =
Control.Exception.handle (\(_ :: Exception) -> putStrLn "exception on connect" >> acceptLoop servSock acceptChan) $
do
- (cHandle, host, _) <- accept servSock
+ (cHandle, host, _) <- Network.accept servSock
currentTime <- getCurrentTime
putStrLn $ (show currentTime) ++ " new client: " ++ host
@@ -186,6 +187,12 @@
let newServerInfo = serverInfo{
lastHourUsers = filter (\t -> currentTime `diffUTCTime` t < 3600) $ lastHourUsers serverInfo
}
+ atomically $ swapTMVar
+ (stats serverInfo)
+ (StatisticsInfo
+ (length clients)
+ (length rooms)
+ )
mainLoop newServerInfo acceptChan messagesChan clients rooms
startServer :: ServerInfo -> Socket -> IO()
@@ -199,14 +206,31 @@
mainLoop serverInfo acceptChan messagesChan [] []
+socketEcho :: Socket -> TMVar StatisticsInfo -> IO ()
+socketEcho sock stats = do
+ (msg, recv_count, client) <- recvFrom sock 128
+ currStats <- atomically $ readTMVar stats
+ send_count <- sendTo sock (statsMsg1 currStats) client
+ socketEcho sock stats
+ where
+ statsMsg1 currStats = (show $ playersNumber currStats) ++ "," ++ (show $ roomsNumber currStats)
+
+startUDPserver :: TMVar StatisticsInfo -> IO ThreadId
+startUDPserver stats = do
+ sock <- socket AF_INET Datagram 0
+ bindSocket sock (SockAddrInet 46632 iNADDR_ANY)
+ forkIO $ socketEcho sock stats
main = withSocketsDo $ do
#if !defined(mingw32_HOST_OS)
installHandler sigPIPE Ignore Nothing;
#endif
- serverInfo <- getOpts $ newServerInfo
+
+ stats <- atomically $ newTMVar (StatisticsInfo 0 0)
+ serverInfo <- getOpts $ newServerInfo stats
putStrLn $ "Listening on port " ++ show (listenPort serverInfo)
- serverSocket <- listenOn $ PortNumber (listenPort serverInfo)
-
+ serverSocket <- Network.listenOn $ Network.PortNumber (listenPort serverInfo)
+
+ startUDPserver stats
startServer serverInfo serverSocket `finally` sClose serverSocket