author | unc0rr |
Sun, 26 Jan 2014 02:17:04 +0400 (2014-01-25) | |
changeset 10076 | b235e520ea21 |
parent 9528 | 9351e96990ae |
child 10078 | 8572d1f8b2f0 |
permissions | -rw-r--r-- |
{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-} module NetRoutines where import Network.Socket import Control.Concurrent.Chan import Data.Time import Control.Monad import Data.Unique import qualified Codec.Binary.Base64 as Base64 import qualified Data.ByteString as BW import qualified Data.ByteString.Char8 as B import qualified Control.Exception as E import System.Entropy ----------------------------- import CoreTypes import Utils acceptLoop :: Socket -> Chan CoreMessage -> IO () acceptLoop servSock chan = E.bracket openHandle closeHandle f where f ch = forever $ do (sock, sockAddr) <- Network.Socket.accept servSock clientHost <- sockAddr2String sockAddr currentTime <- getCurrentTime sendChan' <- newChan uid <- newUnique salt <- liftM (B.pack . Base64.encode . BW.unpack) $ hGetEntropy ch 16 let newClient = (ClientInfo uid sendChan' sock clientHost currentTime "" "" salt False False 0 0 False False False False False False False False Nothing Nothing 0 ) writeChan chan $ Accept newClient return ()