# HG changeset patch # User unc0rr # Date 1275838173 0 # Node ID af8390d807d67af1d7fcec8b06687881178edac0 # Parent 66eba4e41b91468ba4a3940fb57631f84f475415 Use sockets instead of handles, use bytestrings instead of strings diff -r 66eba4e41b91 -r af8390d807d6 gameServer/Actions.hs --- a/gameServer/Actions.hs Sat Jun 05 20:49:51 2010 +0000 +++ b/gameServer/Actions.hs Sun Jun 06 15:29:33 2010 +0000 @@ -1,4 +1,4 @@ - +{-# LANGUAGE OverloadedStrings #-} module Actions where import Control.Concurrent @@ -11,7 +11,7 @@ import Maybe import Control.Monad.Reader import Control.Monad.State - +import Data.ByteString.Char8 as B ----------------------------- import CoreTypes import Utils @@ -19,27 +19,27 @@ import ServerState data Action = - AnswerClients [ClientChan] [String] + AnswerClients [ClientChan] [ByteString] | SendServerMessage | SendServerVars | RoomAddThisClient RoomIndex -- roomID - | RoomRemoveThisClient String - | RemoveTeam String + | RoomRemoveThisClient ByteString + | RemoveTeam ByteString | RemoveRoom | UnreadyRoomClients | MoveToLobby - | ProtocolError String - | Warning String - | ByeClient String + | ProtocolError ByteString + | Warning ByteString + | ByeClient ByteString | KickClient ClientIndex -- clID | KickRoomClient ClientIndex -- clID - | BanClient String -- nick + | BanClient ByteString -- nick | RemoveClientTeams ClientIndex -- clID | ModifyClient (ClientInfo -> ClientInfo) | ModifyClient2 ClientIndex (ClientInfo -> ClientInfo) | ModifyRoom (RoomInfo -> RoomInfo) | ModifyServerInfo (ServerInfo -> ServerInfo) - | AddRoom String String + | AddRoom ByteString ByteString | CheckRegistered | ClearAccountsCache | ProcessAccountInfo AccountInfo @@ -48,7 +48,7 @@ | PingAll | StatsAction -type CmdHandler = [String] -> Reader (ClientIndex, IRnC) [Action] +type CmdHandler = [ByteString] -> Reader (ClientIndex, IRnC) [Action] processAction :: Action -> StateT ServerState IO () @@ -96,13 +96,13 @@ rnc <- gets roomsClients ri <- clientRoomA when (ri /= lobbyId) $ do - processAction $ RoomRemoveThisClient ("quit: " ++ msg) + processAction $ RoomRemoveThisClient ("quit: " `B.append` msg) return () chan <- clients sendChan liftIO $ do - infoM "Clients" (show ci ++ " quits: " ++ msg) + infoM "Clients" (show ci ++ " quits: " ++ (B.unpack msg)) --mapM_ (processAction (ci, serverInfo, rnc)) $ answerOthersQuit ++ answerInformRoom @@ -370,8 +370,8 @@ si <- gets serverInfo liftIO $ do ci <- addClient rnc client - forkIO $ clientRecvLoop (clientHandle client) (coreChan si) ci - forkIO $ clientSendLoop (clientHandle client) (coreChan si) (sendChan client) ci + forkIO $ clientRecvLoop (clientSocket client) (coreChan si) ci + forkIO $ clientSendLoop (clientSocket client) (coreChan si) (sendChan client) ci infoM "Clients" (show ci ++ ": New client. Time: " ++ show (connectTime client)) writeChan (sendChan client) ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"] diff -r 66eba4e41b91 -r af8390d807d6 gameServer/ClientIO.hs --- a/gameServer/ClientIO.hs Sat Jun 05 20:49:51 2010 +0000 +++ b/gameServer/ClientIO.hs Sun Jun 06 15:29:33 2010 +0000 @@ -1,4 +1,4 @@ -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-} module ClientIO where import qualified Control.Exception as Exception @@ -6,53 +6,71 @@ import Control.Concurrent import Control.Monad import System.IO -import qualified Data.ByteString.UTF8 as BUTF8 -import qualified Data.ByteString as B +import Network +import Network.Socket.ByteString +import qualified Data.ByteString.Char8 as B ---------------- import CoreTypes import RoomsAndClients - -listenLoop :: Handle -> Int -> [String] -> Chan CoreMessage -> ClientIndex -> IO () -listenLoop handle linesNumber buf chan clientID = do - putStrLn $ show handle ++ show buf ++ show clientID - str <- liftM BUTF8.toString $ B.hGetLine handle - if (linesNumber > 50) || (length str > 450) then - protocolViolationMsg >> freeClient - else - if str == "" then do - writeChan chan $ ClientMessage (clientID, reverse buf) - yield - listenLoop handle 0 [] chan clientID - else - listenLoop handle (linesNumber + 1) (str : buf) chan clientID - where - protocolViolationMsg = writeChan chan $ ClientMessage (clientID, ["QUIT", "Protocol violation"]) - freeClient = writeChan chan $ FreeClient clientID +import Utils -clientRecvLoop :: Handle -> Chan CoreMessage -> ClientIndex -> IO () -clientRecvLoop handle chan clientID = - listenLoop handle 0 [] chan clientID - `catch` (\e -> clientOff (show e) >> freeClient >> return ()) +pDelim :: B.ByteString +pDelim = B.pack "\n\n" + +bs2Packets :: B.ByteString -> ([[B.ByteString]], B.ByteString) +bs2Packets buf = unfoldrE extractPackets buf + where + extractPackets :: B.ByteString -> Either B.ByteString ([B.ByteString], B.ByteString) + extractPackets buf = + let buf' = until (not . B.isPrefixOf pDelim) (B.drop 2) buf in + let (bsPacket, bufTail) = B.breakSubstring pDelim buf' in + if B.null bufTail then + Left bsPacket + else + if B.null bsPacket then + Left bufTail + else + Right (B.splitWith (== '\n') bsPacket, bufTail) + + +listenLoop :: Socket -> Chan CoreMessage -> ClientIndex -> IO () +listenLoop sock chan ci = recieveWithBufferLoop B.empty + where + recieveWithBufferLoop recvBuf = do + recvBS <- recv sock 4096 + putStrLn $ show sock ++ " got smth: " ++ (show $ B.length recvBS) + unless (B.null recvBS) $ do + let (packets, newrecvBuf) = bs2Packets $ B.append recvBuf recvBS + forM_ packets sendPacket + recieveWithBufferLoop newrecvBuf + + sendPacket packet = writeChan chan $ ClientMessage (ci, packet) + + +clientRecvLoop :: Socket -> Chan CoreMessage -> ClientIndex -> IO () +clientRecvLoop s chan ci = do + msg <- (listenLoop s chan ci >> return "Connection closed") `catch` (return . B.pack . show) + clientOff msg where - clientOff msg = writeChan chan $ ClientMessage (clientID, ["QUIT", msg]) -- if the client disconnects, we perform as if it sent QUIT message - freeClient = writeChan chan $ FreeClient clientID + clientOff msg = writeChan chan $ ClientMessage (ci, ["QUIT", msg]) + -clientSendLoop :: Handle -> Chan CoreMessage -> Chan [String] -> ClientIndex -> IO() -clientSendLoop handle coreChan chan clientID = do + +clientSendLoop :: Socket -> Chan CoreMessage -> Chan [B.ByteString] -> ClientIndex -> IO() +clientSendLoop s coreChan chan ci = do answer <- readChan chan doClose <- Exception.handle (\(e :: Exception.IOException) -> if isQuit answer then return True else sendQuit e >> return False) $ do - B.hPutStrLn handle $ BUTF8.fromString $ unlines answer - hFlush handle + sendAll s $ (B.unlines answer) `B.append` (B.singleton '\n') return $ isQuit answer if doClose then - Exception.handle (\(_ :: Exception.IOException) -> putStrLn "error on hClose") $ hClose handle + Exception.handle (\(_ :: Exception.IOException) -> putStrLn "error on sClose") $ sClose s else - clientSendLoop handle coreChan chan clientID + clientSendLoop s coreChan chan ci where - sendQuit e = writeChan coreChan $ ClientMessage (clientID, ["QUIT", show e]) + sendQuit e = writeChan coreChan $ ClientMessage (ci, ["QUIT", B.pack $ show e]) isQuit ("BYE":xs) = True isQuit _ = False diff -r 66eba4e41b91 -r af8390d807d6 gameServer/CoreTypes.hs --- a/gameServer/CoreTypes.hs Sat Jun 05 20:49:51 2010 +0000 +++ b/gameServer/CoreTypes.hs Sun Jun 06 15:29:33 2010 +0000 @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} module CoreTypes where import System.IO @@ -10,20 +11,21 @@ import Data.Time import Network import Data.Function +import Data.ByteString.Char8 as B import RoomsAndClients -type ClientChan = Chan [String] +type ClientChan = Chan [B.ByteString] data ClientInfo = ClientInfo { sendChan :: ClientChan, - clientHandle :: Handle, - host :: String, + clientSocket :: Socket, + host :: B.ByteString, connectTime :: UTCTime, - nick :: String, - webPassword :: String, + nick :: B.ByteString, + webPassword :: B.ByteString, logonPassed :: Bool, clientProto :: !Word16, roomID :: !Int, @@ -31,46 +33,46 @@ isMaster :: Bool, isReady :: Bool, isAdministrator :: Bool, - clientClan :: String, + clientClan :: B.ByteString, teamsInGame :: Word } instance Show ClientInfo where - show ci = " nick: " ++ (nick ci) ++ " host: " ++ (host ci) + show ci = " nick: " ++ (unpack $ nick ci) ++ " host: " ++ (unpack $ host ci) instance Eq ClientInfo where - (==) = (==) `on` clientHandle + (==) = (==) `on` clientSocket data HedgehogInfo = - HedgehogInfo String String + HedgehogInfo B.ByteString B.ByteString data TeamInfo = TeamInfo { teamownerId :: !Int, - teamowner :: String, - teamname :: String, - teamcolor :: String, - teamgrave :: String, - teamfort :: String, - teamvoicepack :: String, - teamflag :: String, + teamowner :: B.ByteString, + teamname :: B.ByteString, + teamcolor :: B.ByteString, + teamgrave :: B.ByteString, + teamfort :: B.ByteString, + teamvoicepack :: B.ByteString, + teamflag :: B.ByteString, difficulty :: Int, hhnum :: Int, hedgehogs :: [HedgehogInfo] } instance Show TeamInfo where - show ti = "owner: " ++ (teamowner ti) - ++ "name: " ++ (teamname ti) - ++ "color: " ++ (teamcolor ti) + show ti = "owner: " ++ (unpack $ teamowner ti) + ++ "name: " ++ (unpack $ teamname ti) + ++ "color: " ++ (unpack $ teamcolor ti) data RoomInfo = RoomInfo { masterID :: !Int, - name :: String, - password :: String, + name :: B.ByteString, + password :: B.ByteString, roomProto :: Word16, teams :: [TeamInfo], gameinprogress :: Bool, @@ -79,10 +81,10 @@ playersIDs :: IntSet.IntSet, isRestrictedJoins :: Bool, isRestrictedTeams :: Bool, - roundMsgs :: Seq String, - leftTeams :: [String], + roundMsgs :: Seq B.ByteString, + leftTeams :: [B.ByteString], teamsAtStart :: [TeamInfo], - params :: Map.Map String [String] + params :: Map.Map B.ByteString [B.ByteString] } instance Show RoomInfo where @@ -123,14 +125,14 @@ { isDedicated :: Bool, serverMessage :: String, - serverMessageForOldVersions :: String, + serverMessageForOldVersions :: B.ByteString, latestReleaseVersion :: Word16, listenPort :: PortNumber, nextRoomID :: Int, - dbHost :: String, - dbLogin :: String, - dbPassword :: String, - lastLogins :: [(String, UTCTime)], + dbHost :: B.ByteString, + dbLogin :: B.ByteString, + dbPassword :: B.ByteString, + lastLogins :: [(B.ByteString, UTCTime)], stats :: TMVar StatisticsInfo, coreChan :: Chan CoreMessage, dbQueries :: Chan DBQuery @@ -155,20 +157,20 @@ ) data AccountInfo = - HasAccount String Bool + HasAccount B.ByteString Bool | Guest | Admin deriving (Show, Read) data DBQuery = - CheckAccount ClientIndex String String + CheckAccount ClientIndex B.ByteString B.ByteString | ClearCache | SendStats Int Int deriving (Show, Read) data CoreMessage = Accept ClientInfo - | ClientMessage (ClientIndex, [String]) + | ClientMessage (ClientIndex, [B.ByteString]) | ClientAccountInfo (ClientIndex, AccountInfo) | TimerAction Int | FreeClient ClientIndex diff -r 66eba4e41b91 -r af8390d807d6 gameServer/HWProtoCore.hs --- a/gameServer/HWProtoCore.hs Sat Jun 05 20:49:51 2010 +0000 +++ b/gameServer/HWProtoCore.hs Sun Jun 06 15:29:33 2010 +0000 @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} module HWProtoCore where import qualified Data.IntMap as IntMap diff -r 66eba4e41b91 -r af8390d807d6 gameServer/HWProtoInRoomState.hs --- a/gameServer/HWProtoInRoomState.hs Sat Jun 05 20:49:51 2010 +0000 +++ b/gameServer/HWProtoInRoomState.hs Sun Jun 06 15:29:33 2010 +0000 @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} module HWProtoInRoomState where import qualified Data.Foldable as Foldable diff -r 66eba4e41b91 -r af8390d807d6 gameServer/HWProtoLobbyState.hs --- a/gameServer/HWProtoLobbyState.hs Sat Jun 05 20:49:51 2010 +0000 +++ b/gameServer/HWProtoLobbyState.hs Sun Jun 06 15:29:33 2010 +0000 @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} module HWProtoLobbyState where import qualified Data.Map as Map diff -r 66eba4e41b91 -r af8390d807d6 gameServer/HWProtoNEState.hs --- a/gameServer/HWProtoNEState.hs Sat Jun 05 20:49:51 2010 +0000 +++ b/gameServer/HWProtoNEState.hs Sun Jun 06 15:29:33 2010 +0000 @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} module HWProtoNEState where import qualified Data.IntMap as IntMap @@ -5,6 +6,7 @@ import Data.List import Data.Word import Control.Monad.Reader +import qualified Data.ByteString.Char8 as B -------------------------------------- import CoreTypes import Actions @@ -16,7 +18,7 @@ handleCmd_NotEntered ["NICK", newNick] = do (ci, irnc) <- ask let cl = irnc `client` ci - if not . null $ nick cl then return [ProtocolError "Nickname already chosen"] + if not . B.null $ nick cl then return [ProtocolError "Nickname already chosen"] else if haveSameNick irnc then return [AnswerClients [sendChan cl] ["WARNING", "Nickname already in use"], ByeClient ""] else @@ -38,10 +40,12 @@ else return $ ModifyClient (\c -> c{clientProto = parsedProto}) : - AnswerClients [sendChan cl] ["PROTO", show parsedProto] : - [CheckRegistered | (not . null) (nick cl)] + AnswerClients [sendChan cl] ["PROTO", B.pack $ show parsedProto] : + [CheckRegistered | not . B.null $ nick cl] where - parsedProto = fromMaybe 0 (maybeRead protoNum :: Maybe Word16) + parsedProto = case B.readInt protoNum of + Just (i, t) | B.null t -> fromIntegral i + otherwise -> 0 {- diff -r 66eba4e41b91 -r af8390d807d6 gameServer/HandlerUtils.hs --- a/gameServer/HandlerUtils.hs Sat Jun 05 20:49:51 2010 +0000 +++ b/gameServer/HandlerUtils.hs Sun Jun 06 15:29:33 2010 +0000 @@ -1,6 +1,7 @@ module HandlerUtils where import Control.Monad.Reader +import qualified Data.ByteString.Char8 as B import RoomsAndClients import CoreTypes @@ -11,7 +12,7 @@ (ci, rnc) <- ask return $ rnc `client` ci -clientNick :: Reader (ClientIndex, IRnC) String +clientNick :: Reader (ClientIndex, IRnC) B.ByteString clientNick = liftM nick thisClient roomOthersChans :: Reader (ClientIndex, IRnC) [ClientChan] @@ -25,5 +26,5 @@ (ci, rnc) <- ask return $ [sendChan (rnc `client` ci)] -answerClient :: [String] -> Reader (ClientIndex, IRnC) [Action] +answerClient :: [B.ByteString] -> Reader (ClientIndex, IRnC) [Action] answerClient msg = thisClientChans >>= return . (: []) . flip AnswerClients msg diff -r 66eba4e41b91 -r af8390d807d6 gameServer/NetRoutines.hs --- a/gameServer/NetRoutines.hs Sat Jun 05 20:49:51 2010 +0000 +++ b/gameServer/NetRoutines.hs Sun Jun 06 15:29:33 2010 +0000 @@ -1,4 +1,4 @@ -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-} module NetRoutines where import Network.Socket @@ -18,8 +18,6 @@ do (sock, sockAddr) <- Network.Socket.accept servSock - cHandle <- socketToHandle sock ReadWriteMode - hSetBuffering cHandle LineBuffering clientHost <- sockAddr2String sockAddr currentTime <- getCurrentTime @@ -29,7 +27,7 @@ let newClient = (ClientInfo sendChan' - cHandle + sock clientHost currentTime "" diff -r 66eba4e41b91 -r af8390d807d6 gameServer/OfficialServer/DBInteraction.hs --- a/gameServer/OfficialServer/DBInteraction.hs Sat Jun 05 20:49:51 2010 +0000 +++ b/gameServer/OfficialServer/DBInteraction.hs Sun Jun 06 15:29:33 2010 +0000 @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, ScopedTypeVariables #-} +{-# LANGUAGE CPP, ScopedTypeVariables, OverloadedStrings #-} module OfficialServer.DBInteraction ( startDBConnection diff -r 66eba4e41b91 -r af8390d807d6 gameServer/Opts.hs --- a/gameServer/Opts.hs Sat Jun 05 20:49:51 2010 +0000 +++ b/gameServer/Opts.hs Sun Jun 06 15:29:33 2010 +0000 @@ -7,6 +7,8 @@ import System.Console.GetOpt import Network import Data.Maybe ( fromMaybe ) +import qualified Data.ByteString.Char8 as B + import CoreTypes import Utils @@ -30,9 +32,9 @@ where readDedicated = fromMaybe True (maybeRead str :: Maybe Bool) -readDbLogin str opts = opts{dbLogin = str} -readDbPassword str opts = opts{dbPassword = str} -readDbHost str opts = opts{dbHost = str} +readDbLogin str opts = opts{dbLogin = B.pack str} +readDbPassword str opts = opts{dbPassword = B.pack str} +readDbHost str opts = opts{dbHost = B.pack str} getOpts :: ServerInfo -> IO ServerInfo getOpts opts = do diff -r 66eba4e41b91 -r af8390d807d6 gameServer/ServerCore.hs --- a/gameServer/ServerCore.hs Sat Jun 05 20:49:51 2010 +0000 +++ b/gameServer/ServerCore.hs Sun Jun 06 15:29:33 2010 +0000 @@ -8,6 +8,7 @@ import System.Log.Logger import Control.Monad.Reader import Control.Monad.State +import qualified Data.ByteString.Char8 as B -------------------------------------- import CoreTypes import NetRoutines @@ -21,7 +22,7 @@ timerLoop tick messagesChan = threadDelay (30 * 10^6) >> writeChan messagesChan (TimerAction tick) >> timerLoop (tick + 1) messagesChan -reactCmd :: [String] -> StateT ServerState IO () +reactCmd :: [B.ByteString] -> StateT ServerState IO () reactCmd cmd = do (Just ci) <- gets clientIndex rnc <- gets roomsClients diff -r 66eba4e41b91 -r af8390d807d6 gameServer/Utils.hs --- a/gameServer/Utils.hs Sat Jun 05 20:49:51 2010 +0000 +++ b/gameServer/Utils.hs Sun Jun 06 15:29:33 2010 +0000 @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} module Utils where import Control.Concurrent @@ -16,33 +17,30 @@ import Maybe ------------------------------------------------- import qualified Codec.Binary.Base64 as Base64 -import qualified Data.ByteString.UTF8 as BUTF8 -import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as B +import qualified Data.ByteString as BW import CoreTypes -sockAddr2String :: SockAddr -> IO String -sockAddr2String (SockAddrInet _ hostAddr) = inet_ntoa hostAddr +sockAddr2String :: SockAddr -> IO B.ByteString +sockAddr2String (SockAddrInet _ hostAddr) = liftM B.pack $ inet_ntoa hostAddr sockAddr2String (SockAddrInet6 _ _ (a, b, c, d) _) = - return $ (foldr1 (.) + return $ B.pack $ (foldr1 (.) $ List.intersperse (\a -> ':':a) $ concatMap (\n -> (\(a, b) -> [showHex a, showHex b]) $ divMod n 65536) [a, b, c, d]) [] -toEngineMsg :: String -> String -toEngineMsg msg = Base64.encode (fromIntegral (B.length encodedMsg) : (B.unpack encodedMsg)) - where - encodedMsg = BUTF8.fromString msg +toEngineMsg :: B.ByteString -> B.ByteString +toEngineMsg msg = B.pack $ Base64.encode (fromIntegral (BW.length msg) : (BW.unpack msg)) -fromEngineMsg :: String -> Maybe String -fromEngineMsg msg = liftM (map w2c) (Base64.decode msg >>= removeLength) +fromEngineMsg :: B.ByteString -> Maybe B.ByteString +fromEngineMsg msg = Base64.decode (B.unpack msg) >>= removeLength >>= return . BW.pack where removeLength (x:xs) = if length xs == fromIntegral x then Just xs else Nothing removeLength _ = Nothing -checkNetCmd :: String -> (Bool, Bool) -checkNetCmd msg = check decoded +checkNetCmd :: B.ByteString -> (Bool, Bool) +checkNetCmd = check . liftM B.unpack . fromEngineMsg where - decoded = fromEngineMsg msg check Nothing = (False, False) check (Just (m:ms)) = (m `Set.member` legalMessages, m == '+') check _ = (False, False) @@ -54,29 +52,27 @@ [(x, rest)] | all isSpace rest -> Just x _ -> Nothing -teamToNet :: Word16 -> TeamInfo -> [String] +teamToNet :: Word16 -> TeamInfo -> [B.ByteString] teamToNet protocol team - | protocol < 30 = [ - "ADD_TEAM", - teamname team, - teamgrave team, - teamfort team, - teamvoicepack team, - teamowner team, - show $ difficulty team - ] - ++ hhsInfo - | otherwise = [ - "ADD_TEAM", - teamname team, - teamgrave team, - teamfort team, - teamvoicepack team, - teamflag team, - teamowner team, - show $ difficulty team - ] - ++ hhsInfo + | protocol < 30 = + "ADD_TEAM" + : teamname team + : teamgrave team + : teamfort team + : teamvoicepack team + : teamowner team + : (B.pack $ show $ difficulty team) + : hhsInfo + | otherwise = + "ADD_TEAM" + : teamname team + : teamgrave team + : teamfort team + : teamvoicepack team + : teamflag team + : teamowner team + : (B.pack $ show $ difficulty team) + : hhsInfo where hhsInfo = concatMap (\(HedgehogInfo name hat) -> [name, hat]) $ hedgehogs team @@ -90,10 +86,10 @@ else t : replaceTeam team teams -illegalName :: String -> Bool -illegalName = all isSpace +illegalName :: B.ByteString -> Bool +illegalName = all isSpace . B.unpack -protoNumber2ver :: Word16 -> String +protoNumber2ver :: Word16 -> B.ByteString protoNumber2ver 17 = "0.9.7-dev" protoNumber2ver 19 = "0.9.7" protoNumber2ver 20 = "0.9.8-dev" @@ -116,3 +112,10 @@ putStr msg hFlush stdout getLine + + +unfoldrE :: (b -> Either b (a, b)) -> b -> ([a], b) +unfoldrE f b = + case f b of + Right (a, new_b) -> let (a', b') = unfoldrE f new_b in (a : a', b') + Left new_b -> ([], new_b) diff -r 66eba4e41b91 -r af8390d807d6 gameServer/hedgewars-server.hs --- a/gameServer/hedgewars-server.hs Sat Jun 05 20:49:51 2010 +0000 +++ b/gameServer/hedgewars-server.hs Sun Jun 06 15:29:33 2010 +0000 @@ -5,11 +5,7 @@ import Network import Control.Concurrent.STM import Control.Concurrent.Chan -#if defined(NEW_EXCEPTIONS) -import qualified Control.OldException as Exception -#else import qualified Control.Exception as Exception -#endif import System.Log.Logger ----------------------------------- import Opts