26 |
26 |
27 localAddressList :: [B.ByteString] |
27 localAddressList :: [B.ByteString] |
28 localAddressList = ["127.0.0.1", "0:0:0:0:0:0:0:1", "0:0:0:0:0:ffff:7f00:1"] |
28 localAddressList = ["127.0.0.1", "0:0:0:0:0:0:0:1", "0:0:0:0:0:ffff:7f00:1"] |
29 |
29 |
30 fakeDbConnection :: forall b. ServerInfo -> IO b |
30 fakeDbConnection :: forall b. ServerInfo -> IO b |
31 fakeDbConnection serverInfo = forever $ do |
31 fakeDbConnection si = forever $ do |
32 q <- readChan $ dbQueries serverInfo |
32 q <- readChan $ dbQueries si |
33 case q of |
33 case q of |
34 CheckAccount clId clUid _ clHost -> |
34 CheckAccount clId clUid _ clHost -> |
35 writeChan (coreChan serverInfo) $ ClientAccountInfo clId clUid (if clHost `L.elem` localAddressList then Admin else Guest) |
35 writeChan (coreChan si) $ ClientAccountInfo clId clUid (if clHost `L.elem` localAddressList then Admin else Guest) |
36 ClearCache -> return () |
36 ClearCache -> return () |
37 SendStats {} -> return () |
37 SendStats {} -> return () |
38 |
38 |
39 dbConnectionLoop :: forall b. ServerInfo -> IO b |
39 dbConnectionLoop :: forall b. ServerInfo -> IO b |
40 #if defined(OFFICIAL_SERVER) |
40 #if defined(OFFICIAL_SERVER) |
41 pipeDbConnectionLoop queries coreChan hIn hOut accountsCache = |
41 flushRequests :: ServerInfo -> IO () |
|
42 flushRequests si = do |
|
43 e <- isEmptyChan $ dbQueries si |
|
44 unless e $ do |
|
45 q <- readChan $ dbQueries si |
|
46 case q of |
|
47 CheckAccount clId clUid _ clHost -> |
|
48 writeChan (coreChan si) $ ClientAccountInfo clId clUid (if clHost `L.elem` localAddressList then Admin else Guest) |
|
49 ClearCache -> return () |
|
50 SendStats {} -> return () |
|
51 flushRequests si |
|
52 |
|
53 pipeDbConnectionLoop :: Chan DBQuery -> Chan CoreMessage -> Handle -> Handle -> Map.Map ByteString (UTCTime, AccountInfo) -> IO (Map.Map ByteString (UTCTime, AccountInfo)) |
|
54 pipeDbConnectionLoop queries cChan hIn hOut accountsCache = |
42 Exception.handle (\(e :: Exception.IOException) -> warningM "Database" (show e) >> return accountsCache) $ |
55 Exception.handle (\(e :: Exception.IOException) -> warningM "Database" (show e) >> return accountsCache) $ |
43 do |
56 do |
44 q <- readChan queries |
57 q <- readChan queries |
45 updatedCache <- case q of |
58 updatedCache <- case q of |
46 CheckAccount clId clUid clNick _ -> do |
59 CheckAccount clId clUid clNick _ -> do |
51 SIO.hPutStrLn hIn $ show q |
64 SIO.hPutStrLn hIn $ show q |
52 hFlush hIn |
65 hFlush hIn |
53 |
66 |
54 (clId', clUid', accountInfo) <- SIO.hGetLine hOut >>= (maybeException . maybeRead) |
67 (clId', clUid', accountInfo) <- SIO.hGetLine hOut >>= (maybeException . maybeRead) |
55 |
68 |
56 writeChan coreChan $ ClientAccountInfo clId' clUid' accountInfo |
69 writeChan cChan $ ClientAccountInfo clId' clUid' accountInfo |
57 |
70 |
58 return $ Map.insert clNick (currentTime, accountInfo) accountsCache |
71 return $ Map.insert clNick (currentTime, accountInfo) accountsCache |
59 `Exception.onException` |
72 `Exception.onException` |
60 (unGetChan queries q) |
73 (unGetChan queries q |
|
74 >> writeChan cChan (ClientAccountInfo clId clUid Guest) |
|
75 ) |
61 else |
76 else |
62 do |
77 do |
63 writeChan coreChan $ ClientAccountInfo clId clUid (snd $ fromJust cacheEntry) |
78 writeChan cChan $ ClientAccountInfo clId clUid (snd $ fromJust cacheEntry) |
64 return accountsCache |
79 return accountsCache |
65 |
80 |
66 ClearCache -> return Map.empty |
81 ClearCache -> return Map.empty |
67 SendStats {} -> ( |
82 SendStats {} -> ( |
68 (SIO.hPutStrLn hIn $ show q) >> |
83 (SIO.hPutStrLn hIn $ show q) >> |
69 hFlush hIn >> |
84 hFlush hIn >> |
70 return accountsCache) |
85 return accountsCache) |
71 `Exception.onException` |
86 `Exception.onException` |
72 (unGetChan queries q) |
87 (unGetChan queries q) |
73 |
88 |
74 pipeDbConnectionLoop queries coreChan hIn hOut updatedCache |
89 pipeDbConnectionLoop queries cChan hIn hOut updatedCache |
75 where |
90 where |
76 maybeException (Just a) = return a |
91 maybeException (Just a) = return a |
77 maybeException Nothing = ioError (userError "Can't read") |
92 maybeException Nothing = ioError (userError "Can't read") |
78 |
93 |
79 |
94 pipeDbConnection :: forall b. Map.Map ByteString (UTCTime, AccountInfo) -> ServerInfo -> Int -> IO b |
80 pipeDbConnection accountsCache si = do |
95 pipeDbConnection accountsCache si errNum = do |
81 updatedCache <- |
96 (updatedCache, newErrNum) <- |
82 Exception.handle (\(e :: Exception.IOException) -> warningM "Database" (show e) >> return accountsCache) $ do |
97 Exception.handle (\(e :: Exception.IOException) -> warningM "Database" (show e) >> return (accountsCache, errNum + 1)) $ do |
83 (Just hIn, Just hOut, _, _) <- createProcess (proc "./OfficialServer/extdbinterface" []) |
98 (Just hIn, Just hOut, _, _) <- createProcess (proc "./OfficialServer/extdbinterface" []) |
84 {std_in = CreatePipe, |
99 {std_in = CreatePipe, |
85 std_out = CreatePipe} |
100 std_out = CreatePipe} |
86 hSetBuffering hIn LineBuffering |
101 hSetBuffering hIn LineBuffering |
87 hSetBuffering hOut LineBuffering |
102 hSetBuffering hOut LineBuffering |
88 |
103 |
89 B.hPutStrLn hIn $ dbHost si |
104 B.hPutStrLn hIn $ dbHost si |
90 B.hPutStrLn hIn $ dbLogin si |
105 B.hPutStrLn hIn $ dbLogin si |
91 B.hPutStrLn hIn $ dbPassword si |
106 B.hPutStrLn hIn $ dbPassword si |
92 pipeDbConnectionLoop (dbQueries si) (coreChan si) hIn hOut accountsCache |
107 c <- pipeDbConnectionLoop (dbQueries si) (coreChan si) hIn hOut accountsCache |
|
108 return (c, 0) |
93 |
109 |
94 threadDelay (3 * 10^6) |
110 when (newErrNum > 1) $ flushRequests si |
95 pipeDbConnection updatedCache si |
111 threadDelay (3000000) |
|
112 pipeDbConnection updatedCache si newErrNum |
96 |
113 |
97 dbConnectionLoop si = |
114 dbConnectionLoop si = |
98 if (not . B.null $ dbHost si) then |
115 if (not . B.null $ dbHost si) then |
99 pipeDbConnection Map.empty si |
116 pipeDbConnection Map.empty si 0 |
100 else |
117 else |
101 fakeDbConnection si |
118 fakeDbConnection si |
102 #else |
119 #else |
103 dbConnectionLoop = fakeDbConnection |
120 dbConnectionLoop = fakeDbConnection |
104 #endif |
121 #endif |