21 localAddressList = ["127.0.0.1", "0:0:0:0:0:0:0:1", "0:0:0:0:0:ffff:7f00:1"] |
21 localAddressList = ["127.0.0.1", "0:0:0:0:0:0:0:1", "0:0:0:0:0:ffff:7f00:1"] |
22 |
22 |
23 fakeDbConnection serverInfo = forever $ do |
23 fakeDbConnection serverInfo = forever $ do |
24 q <- readChan $ dbQueries serverInfo |
24 q <- readChan $ dbQueries serverInfo |
25 case q of |
25 case q of |
26 CheckAccount clUid _ clHost -> do |
26 CheckAccount clId clUid _ clHost -> do |
27 writeChan (coreChan serverInfo) $ ClientAccountInfo (clUid, |
27 writeChan (coreChan serverInfo) $ ClientAccountInfo clId clUid (if clHost `elem` localAddressList then Admin else Guest) |
28 if clHost `elem` localAddressList then Admin else Guest) |
|
29 ClearCache -> return () |
28 ClearCache -> return () |
30 SendStats {} -> return () |
29 SendStats {} -> return () |
31 |
30 |
32 |
31 |
33 #if defined(OFFICIAL_SERVER) |
32 #if defined(OFFICIAL_SERVER) |
34 pipeDbConnectionLoop queries coreChan hIn hOut accountsCache = |
33 pipeDbConnectionLoop queries coreChan hIn hOut accountsCache = |
35 Exception.handle (\(e :: Exception.IOException) -> warningM "Database" (show e) >> return accountsCache) $ |
34 Exception.handle (\(e :: Exception.IOException) -> warningM "Database" (show e) >> return accountsCache) $ |
36 do |
35 do |
37 q <- readChan queries |
36 q <- readChan queries |
38 updatedCache <- case q of |
37 updatedCache <- case q of |
39 CheckAccount clUid clNick _ -> do |
38 CheckAccount clId clNick _ -> do |
40 let cacheEntry = clNick `Map.lookup` accountsCache |
39 let cacheEntry = clNick `Map.lookup` accountsCache |
41 currentTime <- getCurrentTime |
40 currentTime <- getCurrentTime |
42 if (isNothing cacheEntry) || (currentTime `diffUTCTime` (fst . fromJust) cacheEntry > 2 * 24 * 60 * 60) then |
41 if (isNothing cacheEntry) || (currentTime `diffUTCTime` (fst . fromJust) cacheEntry > 2 * 24 * 60 * 60) then |
43 do |
42 do |
44 hPutStrLn hIn $ show q |
43 hPutStrLn hIn $ show q |
45 hFlush hIn |
44 hFlush hIn |
46 |
45 |
47 (clId, accountInfo) <- hGetLine hOut >>= (maybeException . maybeRead) |
46 (clId', accountInfo) <- hGetLine hOut >>= (maybeException . maybeRead) |
48 |
47 |
49 writeChan coreChan $ ClientAccountInfo (clId, accountInfo) |
48 writeChan coreChan $ ClientAccountInfo (clId', accountInfo) |
50 |
49 |
51 return $ Map.insert clNick (currentTime, accountInfo) accountsCache |
50 return $ Map.insert clNick (currentTime, accountInfo) accountsCache |
52 `Exception.onException` |
51 `Exception.onException` |
53 (unGetChan queries q) |
52 (unGetChan queries q) |
54 else |
53 else |
55 do |
54 do |
56 writeChan coreChan $ ClientAccountInfo (clUid, snd $ fromJust cacheEntry) |
55 writeChan coreChan $ ClientAccountInfo (clId, snd $ fromJust cacheEntry) |
57 return accountsCache |
56 return accountsCache |
58 |
57 |
59 ClearCache -> return Map.empty |
58 ClearCache -> return Map.empty |
60 SendStats {} -> ( |
59 SendStats {} -> ( |
61 (hPutStrLn hIn $ show q) >> |
60 (hPutStrLn hIn $ show q) >> |