loshadka 0.1 → 0.2
raw patch · 11 files changed
+303/−36 lines, 11 filesdep ~base
Dependency ranges changed: base
Files
- Main.hs +30/−0
- Network/Loshadka/Jar.hs +16/−0
- Network/Loshadka/Message.hs +11/−0
- Network/Loshadka/Properties.hs +47/−0
- Network/Loshadka/Protocol.hs +32/−0
- Network/Loshadka/Server.hs +43/−0
- Network/Loshadka/Settings.hs +44/−0
- Network/Loshadka/Version.hs +31/−0
- Network/Loshadka/WhiteList.hs +22/−0
- loshadka.cabal +27/−6
- src/Main.hs +0/−30
+ Main.hs view
@@ -0,0 +1,30 @@+module Main where++import Network.Loshadka.Server (serve)+import Network.Loshadka.Settings (readSettings)++import System.Environment (getArgs)+import System.Exit (exitFailure)+import Data.List (isInfixOf)++main :: IO()+main = do+ as <- getArgs+ if null as+ then initialize "." as+ else let a = head as in+ if "help" `isInfixOf` a || "-h" == a+ then help+ else case last a of+ '/' -> initialize (init a) as+ _ -> initialize a as++initialize :: String -> [String] -> IO()+initialize path args = do+ settings <- readSettings path args+ serve settings++help :: IO()+help = do+ putStrLn "Usage: loshadka <server_directory> [jar_flags]"+ exitFailure
+ Network/Loshadka/Jar.hs view
@@ -0,0 +1,16 @@+module Network.Loshadka.Jar where++import Prelude hiding (readFile)+import System.Directory (getDirectoryContents)+import Data.ByteString.Lazy.Char8 (ByteString, readFile)+import Data.List (isSuffixOf)++findJar :: String -> IO String+findJar path = do+ dir <- getDirectoryContents path+ return $ head $ filter (\x -> ".jar" `isSuffixOf` x) dir++readJar :: String -> IO ByteString+readJar path = do+ jar <- findJar path+ readFile jar
+ Network/Loshadka/Message.hs view
@@ -0,0 +1,11 @@+module Network.Loshadka.Message (pack) where++import Prelude hiding (length)+import Data.ByteString.Lazy.Char8 (ByteString, append, cons, length)+import Data.Binary (encode)+import Data.Int (Int8)++pack :: ByteString -> ByteString+pack m = packData $ cons '\NUL' (packData m)+ where packData d = append (packInt $ length d) d+ packInt i = encode (fromIntegral i :: Int8)
+ Network/Loshadka/Properties.hs view
@@ -0,0 +1,47 @@+-- This module parses server.properties file,+-- the Minecraft configuration file+module Network.Loshadka.Properties+ (Properties, readProps) where++import Network (PortNumber)+import Data.Maybe+import Data.List.Split (splitOn)++data Property = MOTD String | ServerPort PortNumber | MaxPlayers Int | WhiteList Bool deriving (Eq)+type Properties = (String, PortNumber, Int, Bool)+type Key = (String, Maybe Property)++readProps :: String -> IO Properties+readProps path = do+ props <- readFile (path ++ "/server.properties")+ return $ parse props++parse :: String -> Properties+parse props = (motd, port, maxPlayers, whiteList)+ where (MOTD motd : ServerPort port : MaxPlayers maxPlayers : WhiteList whiteList : []) = fetchLines props++fetchLines :: String -> [Property]+fetchLines props = fetchProperties $ map parseLine (lines props)++parseLine :: String -> Key+parseLine prop = do+ if (head prop) == '#'+ then ("", Nothing)+ else case splitOn "=" prop of+ ["motd", value] -> ("motd", Just $ MOTD value)+ ["server-port", value] -> ("server-port", Just $ ServerPort $ fromIntegral (read value :: Integer))+ ["max-players", value] -> ("max-players", Just $ MaxPlayers $ read value)+ ["white-list", value] -> ("white-list", Just $ WhiteList $ read value)+ _ -> ("", Nothing)++fetchProperties :: [Key] -> [Property]+fetchProperties ps = [motd, serverPort, maxPlayers, whiteList]+ where+ ns = filter (/= ("", Nothing)) ps+ motd = fetchProperty "motd" ns+ serverPort = fetchProperty "server-port" ns+ maxPlayers = fetchProperty "max-players" ns+ whiteList = fetchProperty "white-list" ns++fetchProperty :: String -> [Key] -> Property+fetchProperty k ps = fromJust $ fromJust $ lookup k ps
+ Network/Loshadka/Protocol.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE DeriveGeneric #-}++module Network.Loshadka.Protocol where++import Data.ByteString.Lazy.Char8 (ByteString)+import Data.Aeson hiding (encode)+import GHC.Generics (Generic)++-- Attention: Minecraft clients check for compatability+-- using protocol number, not name of the version+data Version = Version { name :: String, protocol :: Int } deriving (Generic)+data Players = Players { max :: Int, online :: Int } deriving (Generic)+data Description = Description { text :: String } deriving (Generic)++-- Data record which is passed to the server.+-- It includes all possible responses to the client,+-- in a prepacked state+data Responses = Responses { ping :: ByteString+ , start :: ByteString+ , denied :: ByteString }++-- Forms JSON object that is sent when somebody pings+-- your server. See an example here:+-- http://wiki.vg/Server_List_Ping+data Ping = Ping { version :: Version+ , players :: Players+ , description :: Description } deriving (Generic)++instance ToJSON Version+instance ToJSON Players+instance ToJSON Description+instance ToJSON Ping
+ Network/Loshadka/Server.hs view
@@ -0,0 +1,43 @@+module Network.Loshadka.Server (serve) where++import Network.Loshadka.Protocol+import Network.Loshadka.Settings++import qualified Data.ByteString.Lazy.Char8 as B+import System.Cmd (system)++import Network (Socket, PortID(PortNumber), listenOn, sClose)+import Network.Socket (accept)+import Network.Socket.ByteString.Lazy (sendAll, recv)+import Control.Concurrent (forkIO)++serve :: Settings -> IO()+serve settings = do+ sock <- listenOn $ PortNumber (port settings)+ loop sock settings++loop :: Socket -> Settings -> IO()+loop sock ss = do+ (conn, _) <- accept sock+ _ <- forkIO $ handleRequest sock conn ss+ loop sock ss++handleRequest :: Socket -> Socket -> Settings -> IO()+handleRequest sock conn ss = do+ handshake <- recv conn 256+ respond sock conn ss $ B.last handshake+ sClose conn++respond :: Socket -> Socket -> Settings -> Char -> IO()+respond _ conn ss '\x01' = do+ _ <- recv conn 2+ sendAll conn (ping $ responses ss)++respond sock conn ss '\x02' = do+--username <- recv conn 64+ sendAll conn (start $ responses ss)+ sClose sock+ _ <- system $ command ss+ sClose conn++respond _ conn ss _ = sendAll conn (denied $ responses ss)
+ Network/Loshadka/Settings.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.Loshadka.Settings+ (Settings, port, responses, command, readSettings) where++import Network.Loshadka.Jar+import Network.Loshadka.Message (pack)+import Network.Loshadka.Protocol+import Network.Loshadka.Properties+import Network.Loshadka.Version+import Network.Loshadka.WhiteList++import Prelude hiding (max)+import Network (PortNumber)+import Data.Aeson (encode)+import Data.List (intercalate)++data Settings = Settings { command :: String+ , port :: PortNumber+ , responses :: Responses }++readSettings :: String -> [String] -> IO Settings+readSettings path args = do+ j <- findJar path+ p <- readProps path+ v <- readVersion path+ w <- readWhiteList path++ let c = formCommand j args in+ return $ parse p v w c++formCommand :: String -> [String] -> String+formCommand jar args = "java " ++ intercalate " " (tail args) ++ " -jar " ++ jar ++ " nogui"++parse :: Properties -> Version -> [Player] -> String -> Settings+parse (m, p, m', _) v _ c =+ Settings { command = c+ , port = p+ , responses = Responses { ping = pack $ encode p'+ , start = pack "Restarting..."+ , denied = pack "Access denied" } }+ where p' = Ping { version = v+ , players = Players { max = m', online = 0 }+ , description = Description { text = m } }
+ Network/Loshadka/Version.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.Loshadka.Version (readVersion) where++import Network.Loshadka.Jar+import Network.Loshadka.Protocol++import Data.ByteString.Lazy.Char8 (ByteString)+import Crypto.Hash.MD5 (hashlazy)+import Data.Hex++readVersion :: String -> IO Version+readVersion path = do+ jar <- readJar path+ return $ parse jar++parse :: ByteString -> Version+parse jar =+ case lookup (hex $ hashlazy jar) hashes of+ Nothing -> snd $ last hashes+ Just v -> v+ where hashes = [("583B44478C6867677049697FEDEB6831", Version "1.7" 4),+ ("16BA7DEC941D4CFDE848DEB874E2A6DE", Version "1.7.1" 4),+ ("C48168F463E935262EA65B702F175153", Version "1.7.2" 4),+ ("C1D5BE48E90BA0CF296F3D1C5CBF02B8", Version "1.7.3" 4),+ ("5B379A73717DA01FA232174F8B360F12", Version "1.7.4" 4),+ ("1B4580BDCA94BC07050EACADFD7E6606", Version "1.7.5" 4),+ ("7C34FEB800DF7B2AEB5A4D590A064C5A", Version "1.7.6" 5),+ ("129357C1C8FE45485BD4A4F0138C20FE", Version "1.7.7" 5),+ ("3F5ED8A73422E8B6E3003A5D2F5F667A", Version "1.7.8" 5),+ ("94FDD4AB02703B6E105A0C5986B9897C", Version "1.7.9" 5)]
+ Network/Loshadka/WhiteList.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE DeriveGeneric #-}++module Network.Loshadka.WhiteList+ (Player, name, uuid, readWhiteList) where++import Prelude hiding (readFile)++import Data.Aeson (decode, FromJSON)+import Data.ByteString.Lazy.Char8 (ByteString, readFile)+import GHC.Generics (Generic)+import Data.Maybe (fromJust)++data Player = Player { name :: String, uuid :: String } deriving (Generic)+instance FromJSON Player++readWhiteList :: String -> IO [Player]+readWhiteList path = do+ file <- readFile $ path ++ "/whitelist.json"+ return $ parse file++parse :: ByteString -> [Player]+parse list = fromJust $ decode list
loshadka.cabal view
@@ -1,7 +1,8 @@ name: loshadka-version: 0.1+version: 0.2 synopsis: Minecraft 1.7 server proxy that answers to queries when the server is offline homepage: https://github.com/tvorcesky/loshadka+bug-reports: https://github.com/tvorcesky/loshadka/issues license: MIT license-file: LICENSE author: George Timoschenko@@ -13,11 +14,31 @@ source-repository this type: git location: https://github.com/tvorcesky/loshadka.git- tag: v0.1+ tag: v0.2 executable loshadka- build-depends: base ==4.6.*, directory ==1.2.*, bytestring ==0.10.*,- binary ==0.7.*, network ==2.4.*, split ==0.2.*,- aeson ==0.7.*, process ==1.1.*, cryptohash ==0.11.*, hex ==0.1.*- hs-source-dirs: src+ build-depends:+ base ==4.*,+ directory ==1.2.*,+ bytestring ==0.10.*,+ binary ==0.7.*,+ network ==2.4.*,+ split ==0.2.*,+ aeson ==0.7.*,+ process ==1.1.*,+ cryptohash ==0.11.*,+ hex ==0.1.*++ other-modules:+ Network.Loshadka.Jar+ Network.Loshadka.Message+ Network.Loshadka.Properties+ Network.Loshadka.Protocol+ Network.Loshadka.Server+ Network.Loshadka.Settings+ Network.Loshadka.Version+ Network.Loshadka.WhiteList++ other-extensions: OverloadedStrings main-is: Main.hs+ ghc-options: -O2 -Wall
− src/Main.hs
@@ -1,30 +0,0 @@-module Main where--import Network.Loshadka.Server (serve)-import Network.Loshadka.Settings (readSettings)--import System.Environment (getArgs)-import System.Exit (exitFailure)-import Data.List (null, isInfixOf)--main :: IO()-main = do- as <- getArgs- if null as- then initialize "." as- else let a = head as in- if "help" `isInfixOf` a || "-h" == a- then help- else case last a of- '/' -> initialize (init a) as- _ -> initialize a as--initialize :: String -> [String] -> IO()-initialize path args = do- settings <- readSettings path args- serve settings--help :: IO()-help = do- putStrLn "Usage: loshadka <server_directory> [jar_flags]"- exitFailure