author | unc0rr |
Tue, 10 Mar 2009 21:57:33 +0000 | |
changeset 1883 | 7c7476f56114 |
parent 1847 | 2178c0fc838c |
child 1917 | c94045b70142 |
permissions | -rw-r--r-- |
1804 | 1 |
{-# LANGUAGE PatternSignatures #-} |
2 |
module NetRoutines where |
|
3 |
||
4 |
import Network |
|
5 |
import Network.Socket |
|
6 |
import System.IO |
|
7 |
import Control.Concurrent |
|
8 |
import Control.Concurrent.Chan |
|
9 |
import Control.Concurrent.STM |
|
10 |
import Control.Exception |
|
11 |
import Data.Time |
|
12 |
----------------------------- |
|
13 |
import CoreTypes |
|
14 |
import ClientIO |
|
15 |
||
16 |
sockAddr2String :: SockAddr -> IO String |
|
17 |
sockAddr2String (SockAddrInet _ hostAddr) = inet_ntoa hostAddr |
|
18 |
sockAddr2String (SockAddrInet6 _ _ (a, b, c, d) _) = return (foldr1 (\a b -> a ++ ":" ++ b) [show a, show b, show c, show d]) |
|
19 |
||
20 |
acceptLoop :: Socket -> Chan CoreMessage -> Int -> IO () |
|
21 |
acceptLoop servSock coreChan clientCounter = do |
|
22 |
Control.Exception.handle |
|
23 |
(\(_ :: Exception) -> putStrLn "exception on connect") $ |
|
24 |
do |
|
25 |
(socket, sockAddr) <- Network.Socket.accept servSock |
|
26 |
||
27 |
cHandle <- socketToHandle socket ReadWriteMode |
|
28 |
hSetBuffering cHandle LineBuffering |
|
29 |
clientHost <- sockAddr2String sockAddr |
|
30 |
||
31 |
currentTime <- getCurrentTime |
|
1839
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1804
diff
changeset
|
32 |
--putStrLn $ (show currentTime) ++ " new client id: " ++ (show nextID) |
1804 | 33 |
|
34 |
sendChan <- newChan |
|
35 |
||
36 |
let newClient = |
|
37 |
(ClientInfo |
|
38 |
nextID |
|
39 |
sendChan |
|
40 |
cHandle |
|
41 |
clientHost |
|
42 |
--currentTime |
|
43 |
"" |
|
1841
fba7210b438b
Retrieve client password from web database and ask for it
unc0rr
parents:
1839
diff
changeset
|
44 |
"" |
fba7210b438b
Retrieve client password from web database and ask for it
unc0rr
parents:
1839
diff
changeset
|
45 |
False |
1804 | 46 |
0 |
47 |
0 |
|
48 |
False |
|
49 |
False |
|
50 |
False |
|
1847
2178c0fc838c
Set admin flag and send admin notification to users with rid equal to 3
unc0rr
parents:
1841
diff
changeset
|
51 |
False |
2178c0fc838c
Set admin flag and send admin notification to users with rid equal to 3
unc0rr
parents:
1841
diff
changeset
|
52 |
False |
2178c0fc838c
Set admin flag and send admin notification to users with rid equal to 3
unc0rr
parents:
1841
diff
changeset
|
53 |
) |
1804 | 54 |
|
55 |
writeChan coreChan $ Accept newClient |
|
56 |
||
57 |
forkIO $ clientRecvLoop cHandle coreChan nextID |
|
58 |
forkIO $ clientSendLoop cHandle coreChan sendChan nextID |
|
59 |
return () |
|
60 |
||
61 |
yield -- hm? |
|
62 |
acceptLoop servSock coreChan nextID |
|
63 |
where |
|
64 |
nextID = clientCounter + 1 |