20 import Utils |
20 import Utils |
21 |
21 |
22 localAddressList = ["127.0.0.1", "0:0:0:0:0:0:0:1", "0:0:0:0:0:ffff:7f00:1"] |
22 localAddressList = ["127.0.0.1", "0:0:0:0:0:0:0:1", "0:0:0:0:0:ffff:7f00:1"] |
23 |
23 |
24 fakeDbConnection serverInfo = do |
24 fakeDbConnection serverInfo = do |
25 q <- readChan $ dbQueries serverInfo |
25 q <- readChan $ dbQueries serverInfo |
26 case q of |
26 case q of |
27 CheckAccount clUid _ clHost -> do |
27 CheckAccount clUid _ clHost -> do |
28 writeChan (coreChan serverInfo) $ ClientAccountInfo (clUid, |
28 writeChan (coreChan serverInfo) $ ClientAccountInfo (clUid, |
29 if clHost `elem` localAddressList then Admin else Guest) |
29 if clHost `elem` localAddressList then Admin else Guest) |
30 ClearCache -> return () |
30 ClearCache -> return () |
31 SendStats {} -> return () |
31 SendStats {} -> return () |
32 |
32 |
33 fakeDbConnection serverInfo |
33 fakeDbConnection serverInfo |
34 |
34 |
35 |
35 |
36 #if defined(OFFICIAL_SERVER) |
36 #if defined(OFFICIAL_SERVER) |
37 pipeDbConnectionLoop queries coreChan hIn hOut accountsCache = |
37 pipeDbConnectionLoop queries coreChan hIn hOut accountsCache = |
38 Exception.handle (\(e :: Exception.IOException) -> warningM "Database" (show e) >> return accountsCache) $ |
38 Exception.handle (\(e :: Exception.IOException) -> warningM "Database" (show e) >> return accountsCache) $ |
39 do |
39 do |
40 q <- readChan queries |
40 q <- readChan queries |
41 updatedCache <- case q of |
41 updatedCache <- case q of |
42 CheckAccount clUid clNick _ -> do |
42 CheckAccount clUid clNick _ -> do |
43 let cacheEntry = clNick `Map.lookup` accountsCache |
43 let cacheEntry = clNick `Map.lookup` accountsCache |
44 currentTime <- getCurrentTime |
44 currentTime <- getCurrentTime |
45 if (isNothing cacheEntry) || (currentTime `diffUTCTime` (fst . fromJust) cacheEntry > 2 * 24 * 60 * 60) then |
45 if (isNothing cacheEntry) || (currentTime `diffUTCTime` (fst . fromJust) cacheEntry > 2 * 24 * 60 * 60) then |
46 do |
46 do |
47 hPutStrLn hIn $ show q |
47 hPutStrLn hIn $ show q |
48 hFlush hIn |
48 hFlush hIn |
49 |
49 |
50 (clId, accountInfo) <- hGetLine hOut >>= (maybeException . maybeRead) |
50 (clId, accountInfo) <- hGetLine hOut >>= (maybeException . maybeRead) |
51 |
51 |
52 writeChan coreChan $ ClientAccountInfo (clId, accountInfo) |
52 writeChan coreChan $ ClientAccountInfo (clId, accountInfo) |
53 |
53 |
54 return $ Map.insert clNick (currentTime, accountInfo) accountsCache |
54 return $ Map.insert clNick (currentTime, accountInfo) accountsCache |
55 `Exception.onException` |
55 `Exception.onException` |
56 (unGetChan queries q) |
56 (unGetChan queries q) |
57 else |
57 else |
58 do |
58 do |
59 writeChan coreChan $ ClientAccountInfo (clUid, snd $ fromJust cacheEntry) |
59 writeChan coreChan $ ClientAccountInfo (clUid, snd $ fromJust cacheEntry) |
60 return accountsCache |
60 return accountsCache |
61 |
61 |
62 ClearCache -> return Map.empty |
62 ClearCache -> return Map.empty |
63 SendStats {} -> ( |
63 SendStats {} -> ( |
64 (hPutStrLn hIn $ show q) >> |
64 (hPutStrLn hIn $ show q) >> |
65 hFlush hIn >> |
65 hFlush hIn >> |
66 return accountsCache) |
66 return accountsCache) |
67 `Exception.onException` |
67 `Exception.onException` |
68 (unGetChan queries q) |
68 (unGetChan queries q) |
69 |
69 |
70 pipeDbConnectionLoop queries coreChan hIn hOut updatedCache |
70 pipeDbConnectionLoop queries coreChan hIn hOut updatedCache |
71 where |
71 where |
72 maybeException (Just a) = return a |
72 maybeException (Just a) = return a |
73 maybeException Nothing = ioError (userError "Can't read") |
73 maybeException Nothing = ioError (userError "Can't read") |
74 |
74 |
75 |
75 |
76 pipeDbConnection accountsCache serverInfo = do |
76 pipeDbConnection accountsCache serverInfo = do |
77 updatedCache <- |
77 updatedCache <- |
78 Exception.handle (\(e :: Exception.IOException) -> warningM "Database" (show e) >> return accountsCache) $ do |
78 Exception.handle (\(e :: Exception.IOException) -> warningM "Database" (show e) >> return accountsCache) $ do |
79 (Just hIn, Just hOut, _, _) <- createProcess (proc "./OfficialServer/extdbinterface" []) |
79 (Just hIn, Just hOut, _, _) <- createProcess (proc "./OfficialServer/extdbinterface" []) |
80 {std_in = CreatePipe, |
80 {std_in = CreatePipe, |
81 std_out = CreatePipe} |
81 std_out = CreatePipe} |
82 hSetBuffering hIn LineBuffering |
82 hSetBuffering hIn LineBuffering |
83 hSetBuffering hOut LineBuffering |
83 hSetBuffering hOut LineBuffering |
84 |
84 |
85 hPutStrLn hIn $ dbHost serverInfo |
85 hPutStrLn hIn $ dbHost serverInfo |
86 hPutStrLn hIn $ dbLogin serverInfo |
86 hPutStrLn hIn $ dbLogin serverInfo |
87 hPutStrLn hIn $ dbPassword serverInfo |
87 hPutStrLn hIn $ dbPassword serverInfo |
88 pipeDbConnectionLoop (dbQueries serverInfo) (coreChan serverInfo) hIn hOut accountsCache |
88 pipeDbConnectionLoop (dbQueries serverInfo) (coreChan serverInfo) hIn hOut accountsCache |
89 |
89 |
90 threadDelay (3 * 10^6) |
90 threadDelay (3 * 10^6) |
91 pipeDbConnection updatedCache serverInfo |
91 pipeDbConnection updatedCache serverInfo |
92 |
92 |
93 dbConnectionLoop serverInfo = |
93 dbConnectionLoop serverInfo = |
94 if (not . null $ dbHost serverInfo) then |
94 if (not . null $ dbHost serverInfo) then |
95 pipeDbConnection Map.empty serverInfo |
95 pipeDbConnection Map.empty serverInfo |
96 else |
96 else |
97 fakeDbConnection serverInfo |
97 fakeDbConnection serverInfo |
98 #else |
98 #else |
99 dbConnectionLoop = fakeDbConnection |
99 dbConnectionLoop = fakeDbConnection |
100 #endif |
100 #endif |
101 |
101 |
102 startDBConnection serverInfo = |
102 startDBConnection serverInfo = |
103 forkIO $ dbConnectionLoop serverInfo |
103 forkIO $ dbConnectionLoop serverInfo |