author | unc0rr |
Mon, 13 Apr 2009 09:36:25 +0000 | |
changeset 1979 | 912e450d4db2 |
parent 1970 | 130e7805d49c |
child 2116 | dec7ead2d178 |
permissions | -rw-r--r-- |
1979 | 1 |
{-# LANGUAGE CPP #-} |
1804 | 2 |
module OfficialServer.DBInteraction |
3 |
( |
|
1839
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
4 |
startDBConnection |
1804 | 5 |
) where |
6 |
||
1979 | 7 |
#if defined(OFFICIAL_SERVER) |
1804 | 8 |
import Database.HDBC |
9 |
import Database.HDBC.MySQL |
|
1979 | 10 |
#endif |
11 |
||
12 |
import Prelude hiding (catch); |
|
1804 | 13 |
import System.IO |
14 |
import Control.Concurrent |
|
15 |
import Control.Exception |
|
1833 | 16 |
import Monad |
1834 | 17 |
import Maybe |
1839
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
18 |
import System.Log.Logger |
1833 | 19 |
------------------------ |
20 |
import CoreTypes |
|
1804 | 21 |
|
1921 | 22 |
localAddressList = ["127.0.0.1", "0:0:0:0:0:0:0:1", "0:0:0:0:0:ffff:7f00:1"] |
1839
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
23 |
|
1857
b835395659e2
Fake database connection with routine which marks all users as guests, when no database host was specified
unc0rr
parents:
1847
diff
changeset
|
24 |
fakeDbConnection serverInfo = do |
b835395659e2
Fake database connection with routine which marks all users as guests, when no database host was specified
unc0rr
parents:
1847
diff
changeset
|
25 |
q <- readChan $ dbQueries serverInfo |
b835395659e2
Fake database connection with routine which marks all users as guests, when no database host was specified
unc0rr
parents:
1847
diff
changeset
|
26 |
case q of |
1921 | 27 |
CheckAccount client -> do |
28 |
writeChan (coreChan serverInfo) $ ClientAccountInfo (clientUID client) $ |
|
29 |
if host client `elem` localAddressList then Admin else Guest |
|
1857
b835395659e2
Fake database connection with routine which marks all users as guests, when no database host was specified
unc0rr
parents:
1847
diff
changeset
|
30 |
|
b835395659e2
Fake database connection with routine which marks all users as guests, when no database host was specified
unc0rr
parents:
1847
diff
changeset
|
31 |
fakeDbConnection serverInfo |
b835395659e2
Fake database connection with routine which marks all users as guests, when no database host was specified
unc0rr
parents:
1847
diff
changeset
|
32 |
|
b835395659e2
Fake database connection with routine which marks all users as guests, when no database host was specified
unc0rr
parents:
1847
diff
changeset
|
33 |
|
1839
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
34 |
------------------------------------------------------------------- |
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
35 |
-- borrowed from base 4.0.0 --------------------------------------- |
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
36 |
onException :: IO a -> IO b -> IO a -- |
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
37 |
onException io what = io `catch` \e -> do what -- |
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
38 |
throw (e :: Exception) -- |
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
39 |
-- to be deleted -------------------------------------------------- |
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
40 |
------------------------------------------------------------------- |
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
41 |
|
1979 | 42 |
#if defined(OFFICIAL_SERVER) |
1847
2178c0fc838c
Set admin flag and send admin notification to users with rid equal to 3
unc0rr
parents:
1841
diff
changeset
|
43 |
dbQueryString = |
1963 | 44 |
"select users.pass, users_roles.rid from users left join users_roles on users.uid = users_roles.uid where users.name = ?" |
1839
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
45 |
|
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
46 |
dbInteractionLoop queries coreChan dbConn = do |
1833 | 47 |
q <- readChan queries |
1804 | 48 |
case q of |
1921 | 49 |
CheckAccount client -> do |
1847
2178c0fc838c
Set admin flag and send admin notification to users with rid equal to 3
unc0rr
parents:
1841
diff
changeset
|
50 |
statement <- prepare dbConn dbQueryString |
1921 | 51 |
execute statement [SqlString $ nick client] |
1847
2178c0fc838c
Set admin flag and send admin notification to users with rid equal to 3
unc0rr
parents:
1841
diff
changeset
|
52 |
passAndRole <- fetchRow statement |
1839
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
53 |
finish statement |
1847
2178c0fc838c
Set admin flag and send admin notification to users with rid equal to 3
unc0rr
parents:
1841
diff
changeset
|
54 |
if isJust passAndRole then |
2178c0fc838c
Set admin flag and send admin notification to users with rid equal to 3
unc0rr
parents:
1841
diff
changeset
|
55 |
writeChan coreChan $ |
1921 | 56 |
ClientAccountInfo (clientUID client) $ |
1847
2178c0fc838c
Set admin flag and send admin notification to users with rid equal to 3
unc0rr
parents:
1841
diff
changeset
|
57 |
HasAccount |
2178c0fc838c
Set admin flag and send admin notification to users with rid equal to 3
unc0rr
parents:
1841
diff
changeset
|
58 |
(fromSql $ head $ fromJust $ passAndRole) |
1970
130e7805d49c
Prevent server from crashing when get SqlNull value
unc0rr
parents:
1963
diff
changeset
|
59 |
((fromSql $ last $ fromJust $ passAndRole) == (Just (3 :: Int))) |
1839
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
60 |
else |
1921 | 61 |
writeChan coreChan $ ClientAccountInfo (clientUID client) Guest |
1839
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
62 |
`onException` |
1921 | 63 |
(unGetChan queries q) |
1804 | 64 |
|
1839
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
65 |
dbInteractionLoop queries coreChan dbConn |
1804 | 66 |
|
1833 | 67 |
dbConnectionLoop serverInfo = do |
1839
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
68 |
Control.Exception.handle (\e -> infoM "Database" $ show e) $ handleSqlError $ |
1804 | 69 |
bracket |
1833 | 70 |
(connectMySQL defaultMySQLConnectInfo {mysqlHost = dbHost serverInfo, mysqlDatabase = "hedge_main", mysqlUser = dbLogin serverInfo, mysqlPassword = dbPassword serverInfo }) |
1804 | 71 |
(disconnect) |
1839
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
72 |
(dbInteractionLoop (dbQueries serverInfo) (coreChan serverInfo)) |
1804 | 73 |
|
1839
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
74 |
threadDelay (5 * 10^6) |
1833 | 75 |
dbConnectionLoop serverInfo |
1979 | 76 |
#else |
77 |
dbConnectionLoop = fakeDbConnection |
|
78 |
#endif |
|
1804 | 79 |
|
1833 | 80 |
startDBConnection serverInfo = |
1857
b835395659e2
Fake database connection with routine which marks all users as guests, when no database host was specified
unc0rr
parents:
1847
diff
changeset
|
81 |
if (not . null $ dbHost serverInfo) then |
b835395659e2
Fake database connection with routine which marks all users as guests, when no database host was specified
unc0rr
parents:
1847
diff
changeset
|
82 |
forkIO $ dbConnectionLoop serverInfo |
b835395659e2
Fake database connection with routine which marks all users as guests, when no database host was specified
unc0rr
parents:
1847
diff
changeset
|
83 |
else |
b835395659e2
Fake database connection with routine which marks all users as guests, when no database host was specified
unc0rr
parents:
1847
diff
changeset
|
84 |
forkIO $ fakeDbConnection serverInfo |