hedgewars-draft: gameServer/OfficialServer/DBInteraction.hs@dec7ead2d178 (annotated)

1979 912e450d4db2 - Add gameServer to build system unc0rr parents: 1970 diff changeset	1	{-# LANGUAGE CPP #-}
1804 4e78ad846fb6 New game server: unc0rr parents: diff changeset	2	module OfficialServer.DBInteraction
4e78ad846fb6 New game server: unc0rr parents: diff changeset	3	(
1839 5dd4cb7fd7e5 Server now send ASKPASSWORD command to frontend when user has web account unc0rr parents: 1834 diff changeset	4	startDBConnection
1804 4e78ad846fb6 New game server: unc0rr parents: diff changeset	5	) where
4e78ad846fb6 New game server: unc0rr parents: diff changeset	6
1979 912e450d4db2 - Add gameServer to build system unc0rr parents: 1970 diff changeset	7	import Prelude hiding (catch);
2116 dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction unc0rr parents: 1979 diff changeset	8	import System.Process
1804 4e78ad846fb6 New game server: unc0rr parents: diff changeset	9	import System.IO
4e78ad846fb6 New game server: unc0rr parents: diff changeset	10	import Control.Concurrent
4e78ad846fb6 New game server: unc0rr parents: diff changeset	11	import Control.Exception
2116 dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction unc0rr parents: 1979 diff changeset	12	import Control.Monad
1833 e901ec5644b4 Add options for configuring database access unc0rr parents: 1804 diff changeset	13	import Monad
1834 71cb978dc85f Add working check for www account existance unc0rr parents: 1833 diff changeset	14	import Maybe
1839 5dd4cb7fd7e5 Server now send ASKPASSWORD command to frontend when user has web account unc0rr parents: 1834 diff changeset	15	import System.Log.Logger
1833 e901ec5644b4 Add options for configuring database access unc0rr parents: 1804 diff changeset	16	------------------------
e901ec5644b4 Add options for configuring database access unc0rr parents: 1804 diff changeset	17	import CoreTypes
2116 dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction unc0rr parents: 1979 diff changeset	18	import Utils
1804 4e78ad846fb6 New game server: unc0rr parents: diff changeset	19
1921 2a09f7f786a0 - User from localhost is server admin unc0rr parents: 1857 diff changeset	20	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	21
1857 b835395659e2 Fake database connection with routine which marks all users as guests, when no database host was specified unc0rr parents: 1847 diff changeset	22	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	23	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	24	case q of
2116 dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction unc0rr parents: 1979 diff changeset	25	CheckAccount clUid _ clHost -> do
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction unc0rr parents: 1979 diff changeset	26	writeChan (coreChan serverInfo) $ ClientAccountInfo (clUid,
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction unc0rr parents: 1979 diff changeset	27	if clHost `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	28
b835395659e2 Fake database connection with routine which marks all users as guests, when no database host was specified unc0rr parents: 1847 diff changeset	29	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	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
2116 dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction unc0rr parents: 1979 diff changeset	32	#if defined(OFFICIAL_SERVER)
1839 5dd4cb7fd7e5 Server now send ASKPASSWORD command to frontend when user has web account unc0rr parents: 1834 diff changeset	33	-------------------------------------------------------------------
5dd4cb7fd7e5 Server now send ASKPASSWORD command to frontend when user has web account unc0rr parents: 1834 diff changeset	34	-- borrowed from base 4.0.0 ---------------------------------------
5dd4cb7fd7e5 Server now send ASKPASSWORD command to frontend when user has web account unc0rr parents: 1834 diff changeset	35	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	36	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	37	throw (e :: Exception) --
5dd4cb7fd7e5 Server now send ASKPASSWORD command to frontend when user has web account unc0rr parents: 1834 diff changeset	38	-- to be deleted --------------------------------------------------
5dd4cb7fd7e5 Server now send ASKPASSWORD command to frontend when user has web account unc0rr parents: 1834 diff changeset	39	-------------------------------------------------------------------
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
2116 dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction unc0rr parents: 1979 diff changeset	42	pipeDbConnectionLoop queries coreChan hIn hOut = do
1833 e901ec5644b4 Add options for configuring database access unc0rr parents: 1804 diff changeset	43	q <- readChan queries
2116 dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction unc0rr parents: 1979 diff changeset	44	do
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction unc0rr parents: 1979 diff changeset	45	hPutStrLn hIn $ show q
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction unc0rr parents: 1979 diff changeset	46	hFlush hIn
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction unc0rr parents: 1979 diff changeset	47
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction unc0rr parents: 1979 diff changeset	48	response <- hGetLine hOut >>= (maybeException . maybeRead)
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction unc0rr parents: 1979 diff changeset	49
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction unc0rr parents: 1979 diff changeset	50	writeChan coreChan $ ClientAccountInfo response
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction unc0rr parents: 1979 diff changeset	51	`onException`
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction unc0rr parents: 1979 diff changeset	52	(unGetChan queries q)
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction unc0rr parents: 1979 diff changeset	53	where
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction unc0rr parents: 1979 diff changeset	54	maybeException (Just a) = return a
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction unc0rr parents: 1979 diff changeset	55	maybeException Nothing = ioError (userError "Can't read")
1804 4e78ad846fb6 New game server: unc0rr parents: diff changeset	56
2116 dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction unc0rr parents: 1979 diff changeset	57
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction unc0rr parents: 1979 diff changeset	58	pipeDbConnection serverInfo = forever $ do
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction unc0rr parents: 1979 diff changeset	59	Control.Exception.handle (\e -> warningM "Database" $ show e) $ do
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction unc0rr parents: 1979 diff changeset	60	(Just hIn, Just hOut, _, _) <-
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction unc0rr parents: 1979 diff changeset	61	createProcess (proc "./OfficialServer/extdbinterface" []) {std_in = CreatePipe, std_out = CreatePipe }
1804 4e78ad846fb6 New game server: unc0rr parents: diff changeset	62
2116 dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction unc0rr parents: 1979 diff changeset	63	hSetBuffering hIn LineBuffering
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction unc0rr parents: 1979 diff changeset	64	hSetBuffering hOut LineBuffering
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction unc0rr parents: 1979 diff changeset	65
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction unc0rr parents: 1979 diff changeset	66	hPutStrLn hIn $ dbHost serverInfo
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction unc0rr parents: 1979 diff changeset	67	hPutStrLn hIn $ dbLogin serverInfo
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction unc0rr parents: 1979 diff changeset	68	hPutStrLn hIn $ dbPassword serverInfo
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction unc0rr parents: 1979 diff changeset	69	pipeDbConnectionLoop (dbQueries serverInfo) (coreChan serverInfo) hIn hOut
1804 4e78ad846fb6 New game server: unc0rr parents: diff changeset	70
1839 5dd4cb7fd7e5 Server now send ASKPASSWORD command to frontend when user has web account unc0rr parents: 1834 diff changeset	71	threadDelay (5 * 10^6)
2116 dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction unc0rr parents: 1979 diff changeset	72
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction unc0rr parents: 1979 diff changeset	73
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction unc0rr parents: 1979 diff changeset	74	dbConnectionLoop = pipeDbConnection
1979 912e450d4db2 - Add gameServer to build system unc0rr parents: 1970 diff changeset	75	#else
912e450d4db2 - Add gameServer to build system unc0rr parents: 1970 diff changeset	76	dbConnectionLoop = fakeDbConnection
912e450d4db2 - Add gameServer to build system unc0rr parents: 1970 diff changeset	77	#endif
1804 4e78ad846fb6 New game server: unc0rr parents: diff changeset	78
1833 e901ec5644b4 Add options for configuring database access unc0rr parents: 1804 diff changeset	79	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	80	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	81	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	82	else
2116 dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction unc0rr parents: 1979 diff changeset	83	--forkIO $ fakeDbConnection serverInfo
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction unc0rr parents: 1979 diff changeset	84	forkIO $ pipeDbConnection serverInfo

author	unc0rr
	Mon, 25 May 2009 15:24:27 +0000
changeset 2116	dec7ead2d178
parent 1979	912e450d4db2
child 2117	1ac0e10e546f
permissions	-rw-r--r--