mohws-0.1: src/ConfigParser.hs
-- -----------------------------------------------------------------------------
-- Copyright 2002, Simon Marlow.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are
-- met:
--
-- * Redistributions of source code must retain the above copyright notice,
-- this list of conditions and the following disclaimer.
--
-- * Redistributions in binary form must reproduce the above copyright
-- notice, this list of conditions and the following disclaimer in the
-- documentation and/or other materials provided with the distribution.
--
-- * Neither the name of the copyright holder(s) nor the names of
-- contributors may be used to endorse or promote products derived from
-- this software without specific prior written permission.
--
-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
-- OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
-- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
-- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
-- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-- -----------------------------------------------------------------------------
module ConfigParser (parseConfig) where
import Config
import Parse
import Util
import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Language
import Text.ParserCombinators.Parsec.Token
type ConfigBuilder = Config -> Config
p :: TokenParser st
p = makeTokenParser tokenDef
tokenDef :: LanguageDef st
tokenDef = emptyDef {
commentLine = "#",
nestedComments = False,
reservedOpNames = [],
reservedNames = [],
caseSensitive = False
}
parseConfig :: String -> IO (Either ParseError ConfigBuilder)
parseConfig fname
= parseFromFile configParser fname
configParser :: Parser ConfigBuilder
configParser = do
whiteSpace p
cs <- many configLine
eof
return (fixConfig . foldr (.) id cs)
fixConfig :: Config -> Config
fixConfig conf = conf { listen = f (listen conf) }
where f xs | length xs > 1 = init xs
| otherwise = xs
configLine :: Parser ConfigBuilder
configLine
= do (reserved p "user" >> p_user)
<|> (reserved p "group" >> p_group)
<|> (reserved p "timeout" >> p_timeout)
<|> (reserved p "keepalivetimeout" >> p_keepAliveTimeout)
<|> (reserved p "maxclients" >> p_maxClients)
<|> (reserved p "listen" >> p_listen)
<|> (reserved p "serveradmin" >> p_serverAdmin)
<|> (reserved p "servername" >> p_serverName)
<|> (reserved p "serveralias" >> p_serverAlias)
<|> (reserved p "usecanonicalname" >> p_useCanonicalName)
<|> (reserved p "documentroot" >> p_documentRoot)
<|> (reserved p "userdir" >> p_userDir)
<|> (reserved p "directoryindex" >> p_directoryIndex)
<|> (reserved p "accessfilename" >> p_accessFileName)
<|> (reserved p "typesconfig" >> p_typesConfig)
<|> (reserved p "defaulttype" >> p_defaultType)
<|> (reserved p "hostnamelookups" >> p_hostnameLookups)
<|> (reserved p "errorlog" >> p_errorLog)
<|> (reserved p "loglevel" >> p_logLevel)
<|> (reserved p "customlog" >> p_customLog)
<|> (reserved p "listen" >> p_listen)
<|> (reserved p "addlanguage" >> p_addlanguage)
<|> (reserved p "languagepriority" >> p_languagepriority)
p_user :: GenParser Char st (Config -> Config)
p_user = do str <- stringLiteral p; return (\c -> c{user = str})
p_group :: GenParser Char st (Config -> Config)
p_group = do str <- stringLiteral p; return (\c -> c{group = str})
p_timeout :: GenParser Char () (Config -> Config)
p_timeout = do i <- int; return (\c -> c{requestTimeout = i})
p_keepAliveTimeout :: GenParser
Char () (Config -> Config)
p_keepAliveTimeout = do i <- int; return (\c -> c{keepAliveTimeout = i})
p_maxClients :: GenParser Char () (Config -> Config)
p_maxClients = do i <- int; return (\c -> c{maxClients = i})
p_serverAdmin :: GenParser Char st (Config -> Config)
p_serverAdmin = do str <- stringLiteral p; return (\c -> c{serverAdmin = str})
p_serverName :: GenParser Char st (Config -> Config)
p_serverName = do str <- stringLiteral p; return (\c -> c{serverName = str})
p_serverAlias :: GenParser Char st (Config -> Config)
p_serverAlias = do str <- stringLiteral p
return (\c -> c{serverAlias = str : serverAlias c})
p_useCanonicalName :: GenParser Char st (Config -> Config)
p_useCanonicalName = do b <- bool; return (\c -> c{useCanonicalName = b})
p_documentRoot :: GenParser Char st (Config -> Config)
p_documentRoot = do str <- stringLiteral p; return (\c -> c{documentRoot = str})
p_userDir :: GenParser Char st (Config -> Config)
p_userDir = do str <- stringLiteral p; return (\c -> c{userDir = str})
p_directoryIndex :: GenParser Char st (Config -> Config)
p_directoryIndex = do str <- stringLiteral p; return (\c -> c{directoryIndex = str})
p_accessFileName :: GenParser Char st (Config -> Config)
p_accessFileName = do str <- stringLiteral p; return (\c -> c{accessFileName = str})
p_typesConfig :: GenParser Char st (Config -> Config)
p_typesConfig = do str <- stringLiteral p; return (\c -> c{typesConfig = str})
p_defaultType :: GenParser Char st (Config -> Config)
p_defaultType = do str <- stringLiteral p; return (\c -> c{defaultType = str})
p_hostnameLookups :: GenParser Char st (Config -> Config)
p_hostnameLookups = do b <- bool; return (\c -> c{hostnameLookups = b})
p_errorLog :: GenParser Char st (Config -> Config)
p_errorLog = do str <- stringLiteral p; return (\c -> c{errorLogFile = str})
p_logLevel :: GenParser Char st (Config -> Config)
p_logLevel = do i <- identifier p >>= readM
return (\c -> c{logLevel = i})
p_customLog :: GenParser Char st (Config -> Config)
p_customLog = do file <- stringLiteral p
format <- stringLiteral p
return (\c -> c { customLogs = (file,format) : customLogs c})
p_listen :: GenParser Char () (Config -> Config)
p_listen = do maddr <- p_addr
port <- int
return (\c -> c{ listen = (maddr,port) : listen c})
where
p_addr = option Nothing $ try $ do addr <- p_ip_addr
char ':'
return $ Just addr
p_ip_addr = do b1 <- p_dec_byte
char '.'
b2 <- p_dec_byte
char '.'
b3 <- p_dec_byte
char '.'
b4 <- p_dec_byte
return (b1++"."++b2++"."++b3++"."++b4)
p_dec_byte = countBetween 1 3 digit
p_addlanguage :: GenParser Char st (Config -> Config)
p_addlanguage = do lang <- stringLiteral p; ext <- stringLiteral p; return (\c -> c{addLanguage = (lang,ext) : addLanguage c})
p_languagepriority :: GenParser Char st (Config -> Config)
p_languagepriority = do langs <- many (stringLiteral p); return (\c -> c{languagePriority = langs})
bool :: GenParser Char st Bool
bool = do { reserved p "On"; return True }
<|> do { reserved p "Off"; return False }
int :: Parser Int
int = do i <- integer p; return (fromInteger i)