25 #endif |
25 #endif |
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 c)-> IO b |
30 fakeDbConnection :: forall b c. ServerInfo c -> IO b |
31 fakeDbConnection si = forever $ do |
31 fakeDbConnection si = forever $ do |
32 q <- readChan $ dbQueries si |
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 si) $ 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) |
87 pipeDbConnectionLoop queries cChan hIn hOut updatedCache newReq |
87 pipeDbConnectionLoop queries cChan hIn hOut updatedCache newReq |
88 where |
88 where |
89 maybeException (Just a) = return a |
89 maybeException (Just a) = return a |
90 maybeException Nothing = ioError (userError "Can't read") |
90 maybeException Nothing = ioError (userError "Can't read") |
91 |
91 |
92 --pipeDbConnection :: forall b. Map.Map ByteString (UTCTime, AccountInfo) -> (ServerInfo c) -> Int -> IO b |
92 pipeDbConnection :: forall a c b. |
|
93 (Num a, Ord a) => |
|
94 Map.Map ByteString (UTCTime, AccountInfo) |
|
95 -> ServerInfo c |
|
96 -> a |
|
97 -> IO b |
|
98 |
93 pipeDbConnection accountsCache si errNum = do |
99 pipeDbConnection accountsCache si errNum = do |
94 (updatedCache, newErrNum) <- |
100 (updatedCache, newErrNum) <- |
95 Exception.handle (\(e :: Exception.IOException) -> warningM "Database" (show e) >> return (accountsCache, errNum + 1)) $ do |
101 Exception.handle (\(e :: Exception.IOException) -> warningM "Database" (show e) >> return (accountsCache, errNum + 1)) $ do |
96 (Just hIn, Just hOut, _, _) <- createProcess (proc "./OfficialServer/extdbinterface" []) |
102 (Just hIn, Just hOut, _, _) <- createProcess (proc "./OfficialServer/extdbinterface" []) |
97 {std_in = CreatePipe, |
103 {std_in = CreatePipe, |
98 std_out = CreatePipe} |
104 std_out = CreatePipe} |
99 hSetBuffering hIn LineBuffering |
105 hSetBuffering hIn LineBuffering |
100 hSetBuffering hOut LineBuffering |
106 hSetBuffering hOut LineBuffering |
101 |
107 |
102 B.hPutStrLn hIn $ dbHost si |
108 B.hPutStrLn hIn $ dbHost si |
|
109 B.hPutStrLn hIn $ dbName si |
103 B.hPutStrLn hIn $ dbLogin si |
110 B.hPutStrLn hIn $ dbLogin si |
104 B.hPutStrLn hIn $ dbPassword si |
111 B.hPutStrLn hIn $ dbPassword si |
105 (c, r) <- pipeDbConnectionLoop (dbQueries si) (coreChan si) hIn hOut accountsCache 0 |
112 (c, r) <- pipeDbConnectionLoop (dbQueries si) (coreChan si) hIn hOut accountsCache 0 |
106 return (c, if r > 0 then 0 else errNum + 1) |
113 return (c, if r > 0 then 0 else errNum + 1) |
107 |
114 |
108 when (newErrNum > 1) $ flushRequests si |
115 when (newErrNum > 1) $ flushRequests si |
109 threadDelay (3000000) |
116 threadDelay (3000000) |
110 pipeDbConnection updatedCache si newErrNum |
117 pipeDbConnection updatedCache si newErrNum |
111 |
118 |
|
119 dbConnectionLoop :: forall c b. ServerInfo c -> IO b |
112 dbConnectionLoop si = |
120 dbConnectionLoop si = |
113 if (not . B.null $ dbHost si) then |
121 if (not . B.null $ dbHost si) then |
114 pipeDbConnection Map.empty si 0 |
122 pipeDbConnection Map.empty si 0 |
115 else |
123 else |
116 fakeDbConnection si |
124 fakeDbConnection si |