module Text.Highlighting.Kate.Syntax.Apache ( highlight, parseExpression, syntaxName, syntaxExtensions ) where
import Text.Highlighting.Kate.Definitions
import Text.Highlighting.Kate.Common
import qualified Text.Highlighting.Kate.Syntax.Alert
import Text.ParserCombinators.Parsec
import Control.Monad (when)
import Data.Map (fromList)
import Data.Maybe (fromMaybe, maybeToList)
import qualified Data.Set as Set
syntaxName :: String
syntaxName = "Apache Configuration"
syntaxExtensions :: String
syntaxExtensions = "httpd.conf;httpd2.conf;apache.conf;apache2.conf;.htaccess*;.htpasswd*"
highlight :: String -> Either String [SourceLine]
highlight input =
case runParser parseSource startingState "source" input of
Left err -> Left $ show err
Right result -> Right result
parseExpression :: GenParser Char SyntaxState LabeledSource
parseExpression = do
st <- getState
let oldLang = synStLanguage st
setState $ st { synStLanguage = "Apache Configuration" }
context <- currentContext <|> (pushContext "apache" >> currentContext)
result <- parseRules context
updateState $ \st -> st { synStLanguage = oldLang }
return result
parseSource = do
lineContents <- lookAhead wholeLine
updateState $ \st -> st { synStCurrentLine = lineContents }
result <- manyTill parseSourceLine eof
return $ map normalizeHighlighting result
startingState = SyntaxState {synStContexts = fromList [("Apache Configuration",["apache"])], synStLanguage = "Apache Configuration", synStCurrentLine = "", synStCharsParsedInLine = 0, synStPrevChar = '\n', synStCaseSensitive = True, synStKeywordCaseSensitive = False, synStCaptures = []}
parseSourceLine = manyTill parseExpressionInternal pEndLine
pEndLine = do
lookAhead $ newline <|> (eof >> return '\n')
context <- currentContext
case context of
"apache" -> return () >> pHandleEndLine
"String Directives" -> (popContext) >> pEndLine
"Integer Directives" -> (popContext) >> pEndLine
"Alternative Directives" -> (popContext) >> pEndLine
"Comment" -> (popContext) >> pEndLine
"Container Open" -> (popContext) >> pEndLine
"Container Close" -> (popContext) >> pEndLine
"Comment Alert" -> (popContext) >> pEndLine
"Alert" -> (popContext) >> pEndLine
_ -> pHandleEndLine
withAttribute attr txt = do
when (null txt) $ fail "Parser matched no text"
let labs = attr : maybeToList (lookup attr styles)
st <- getState
let oldCharsParsed = synStCharsParsedInLine st
let prevchar = if null txt then '\n' else last txt
updateState $ \st -> st { synStCharsParsedInLine = oldCharsParsed + length txt, synStPrevChar = prevchar }
return (labs, txt)
styles = [("Comment","co"),("Directives","ot"),("String","st"),("Float","fl"),("Int","fl"),("Alternates","kw"),("Alert","er"),("Container","fu"),("Attribute","ot"),("Other","ch")]
parseExpressionInternal = do
context <- currentContext
parseRules context <|> (pDefault >>= withAttribute (fromMaybe "" $ lookup context defaultAttributes))
list_String_Directives = Set.fromList $ words $ "acceptfilter accessfilename action addalt addaltbyencoding addaltbytype addcharset adddefaultcharset adddescription addencoding addhandler addicon addiconbyencoding addiconbytype addinputfilter addlanguage addmoduleinfo addoutputfilter addoutputfilterbytype addtype alias aliasmatch allow anonymous authbasicprovider authdbmgroupfile authdbmuserfile authdigestdomain authdigestfile authdigestgroupfile authdigestnonceformat authdigestprovider authgroupfile authldapbinddn authldapbindpassword authldapcharsetconfig authldapgroupattribute authldapurl authname authuserfile browsermatch browsermatchnocase bs2000account cachedisable cacheenable cachefile cachegcclean cachegcunused cacheroot cgimapextension charsetdefault charsetoptions charsetsourceenc cookiedomain cookielog cookiename coredumpdirectory customlog dav davgenericlockdb davlockdb dbdparams dbdpreparesql dbdriver defaulticon defaultlanguage defaulttype deflatefilternote deny directoryindex documentroot errordocument errorlog example expiresbytype expiresdefault extfilterdefine extfilteroptions filterchain filterdeclare filterprotocol filterprovider filtertrace forcetype forensiclog group header headername imapbase include indexignore indexoptions indexstylesheet isapicachefile languagepriority ldapsharedcachefile ldaptrustedca ldaptrustedcatype ldaptrustedclientcert ldaptrustedglobalcert listen loadfile loadmodule lockfile logformat metadir metasuffix mimemagicfile mmapfile namevirtualhost noproxy nwssltrustedcerts nwsslupgradeable passenv pidfile proxyblock proxydomain proxypass proxypassreverse proxypassreversecookiedomain proxypassreversecookiepath proxyremote proxyremotematch readmename redirect redirectmatch redirectpermanent redirecttemp removecharset removeencoding removehandler removeinputfilter removelanguage removeoutputfilter removetype requestheader require rewritebase rewritecond rewritelock rewritelog rewritemap rewriterule scoreboardfile script scriptalias scriptaliasmatch scriptlog scriptsock securelisten serveradmin serveralias servername serverpath serverroot setenv setenvif setenvifnocase sethandler setinputfilter setoutputfilter ssiendtag ssierrormsg ssistarttag ssitimeformat ssiundefinedecho sslcacertificatefile sslcacertificatepath sslcadnrequestfile sslcadnrequestpath sslcarevocationfile sslcarevocationpath sslcertificatechainfile sslcertificatefile sslcertificatekeyfile sslciphersuite sslcryptodevice sslhonorciperorder sslpassphrasedialog sslproxycacertificatefile sslproxycacertificatepath sslproxycarevocationfile sslproxycarevocationpath sslproxyciphersuite sslproxymachinecertificatefile sslproxymachinecertificatepath sslproxyprotocol sslrandomseed sslrequire sslrequiressl sslusername suexecusergroup transferlog typesconfig unsetenv user userdir virtualdocumentroot virtualdocumentrootip virtualscriptalias virtualscriptaliasip win32disableacceptex"
list_Integer_Directives = Set.fromList $ words $ "allowconnect assignuserid authdigestnoncelifetime authdigestshmemsize cachedefaultexpire cachedirlength cachedirlevels cacheforcecompletion cachegcdaily cachegcinterval cachegcmemusage cachelastmodifiedfactor cachemaxexpire cachemaxfilesize cacheminfilesize cachesize cachetimemargin childperuserid cookieexpires davmintimeout dbdexptime dbdkeep dbdmax dbdmin dbdpersist deflatebuffersize deflatecompressionlevel deflatememlevel deflatewindowsize identitychecktimeout isapireadaheadbuffer keepalivetimeout ldapcacheentries ldapcachettl ldapconnectiontimeout ldapopcacheentries ldapopcachettl ldapsharedcachesize limitinternalrecursion limitrequestbody limitrequestfields limitrequestfieldsize limitrequestline limitxmlrequestbody listenbacklog maxclients maxkeepaliverequests maxmemfree maxrequestsperchild maxrequestsperthread maxspareservers maxsparethreads maxthreads maxthreadsperchild mcachemaxobjectcount mcachemaxobjectsize mcachemaxstreamingbuffer mcacheminobjectsize mcachesize minspareservers minsparethreads numservers proxyiobuffersize proxymaxforwards proxyreceivebuffersize proxytimeout rewriteloglevel rlimitcpu rlimitmem rlimitnproc scriptlogbuffer scriptloglength sendbuffersize serverlimit sslproxyverifydepth sslsessioncachetimeout sslverifydepth startservers startthreads threadlimit threadsperchild threadstacksize timeout"
list_Alternative_Directives = Set.fromList $ words $ "acceptmutex acceptpathinfo allowencodedslashes allowoverride anonymous_authoritative anonymous_logemail anonymous_mustgiveemail anonymous_nouserid anonymous_verifyemail authauthoritative authbasicauthoritative authbasicprovider authdbmauthoritative authdbmtype authdefaultauthoritative authdigestalgorithm authdigestnccheck authdigestqop authldapauthoritative authldapcomparednonserver authldapdereferencealiases authldapenabled authldapfrontpagehack authldapgroupattributeisdn authldapremoteuserisdn authtype authzdbmauthoritative authzdbmtype authzdefaultauthoritative authzgroupfileauthoritative authzldapauthoritative authzownerauthoritative authzuserauthoritative bufferedlogs cacheexpirycheck cacheignorecachecontrol cacheignoreheaders cacheignorenolastmod cachenegotiateddocs cachestorenostore cachestoreprivate checkspelling contentdigest cookiestyle cookietracking coredumpdirectory customlog davdepthinfinity directoryslash dumpioinput dumpiooutput enableexceptionhook enablemmap enablesendfile expiresactive extendedstatus fileetag forcelanguagepriority hostnamelookups identitycheck imapdefault imapmenu indexorderdefault isapiappendlogtoerrors isapiappendlogtoquery isapifakeasync isapilognotsupported keepalive ldaptrustedmode ldapverifyservercert loglevel mcacheremovalalgorithm metafiles modmimeusepathinfo multiviewsmatch options order protocolecho proxybadheader proxyerroroverride proxypreservehost proxyrequests proxyvia rewriteengine rewriteoptions satisfy scriptinterpretersource serversignature servertokens sslengine sslmutex ssloptions sslprotocol sslproxyengine sslproxyverify sslsessioncache sslverifyclient usecanonicalname xbithack"
list_Alternates = Set.fromList $ words $ "on off default flock fcntl posixsem pthread sysvsem all none authconfig fileinfo indexes limit options execcgi followsymlinks includes includesnoexec indexes multiviews symlinksifownermatch stdenvvars compatenvvars exportcertdata fakebasicauth strictrequire optrenegotiate sdbm gdbm ndbm db md5 md5-sess auth auth-int never searching finding always basic digest connection keep-alive proxy-authenticate proxy-authorization te trailers transfer-encoding upgrade netscape cookie cookie2 rfc2109 rfc2965 inode mtime size prefer fallback double error nocontent map referer formatted semiformatted unformatted ascending descending name date size description ssl tls starttls emerg alert crit error warn notice info debug lru gdsf any negotiatedonly filters handlers deny,allow allow,deny mutual-failure iserror ignore startbody full block inherit registry registry-strict script email major minor min minimal prod productonly os full optional posixsem sysvsem sem pthread fcntl: flock: file: yes no sslv2 sslv3 tlsv1 require optional_no_ca nonenotnull dbm: shm: dc: dns"
regex_'3c'5cw'2b = compileRegex "<\\w+"
regex_'3c'2f'5cw'2b = compileRegex "</\\w+"
regex_'5b'5e'23'5d'2a = compileRegex "[^#]*"
regex_'5b'5e'23'3e'5d'2a = compileRegex "[^#>]*"
defaultAttributes = [("apache","Normal Text"),("String Directives","Directives"),("Integer Directives","Other"),("Alternative Directives","Other"),("Comment","Comment"),("Container Open","Container"),("Container Close","Container"),("Comment Alert","Normal Text"),("Alert","Alert")]
parseRules "apache" =
do (attr, result) <- (((pKeyword " \n\t.():!+-<=>%&*/;?[]^{|}~\\" list_String_Directives >>= withAttribute "Normal Text") >>~ pushContext "String Directives")
<|>
((pKeyword " \n\t.():!+-<=>%&*/;?[]^{|}~\\" list_Integer_Directives >>= withAttribute "Directives") >>~ pushContext "Integer Directives")
<|>
((pKeyword " \n\t.():!+-<=>%&*/;?[]^{|}~\\" list_Alternative_Directives >>= withAttribute "Directives") >>~ pushContext "Alternative Directives")
<|>
((pRegExpr regex_'3c'5cw'2b >>= withAttribute "Container") >>~ pushContext "Container Open")
<|>
((pRegExpr regex_'3c'2f'5cw'2b >>= withAttribute "Container") >>~ pushContext "Container Close")
<|>
((pFirstNonSpace >> pDetectChar False '#' >>= withAttribute "Comment") >>~ pushContext "Comment"))
return (attr, result)
parseRules "String Directives" =
do (attr, result) <- (((pRegExpr regex_'5b'5e'23'5d'2a >>= withAttribute "String"))
<|>
((parseRules "Comment Alert")))
return (attr, result)
parseRules "Integer Directives" =
do (attr, result) <- (((pFloat >>= withAttribute "Float") >>~ pushContext "Integer Directives")
<|>
((pInt >>= withAttribute "Int") >>~ pushContext "Integer Directives")
<|>
((parseRules "Comment Alert")))
return (attr, result)
parseRules "Alternative Directives" =
do (attr, result) <- (((pKeyword " \n\t.():!+-<=>%&*/;?[]^{|}~\\" list_Alternates >>= withAttribute "Alternates"))
<|>
((pDetectChar False '-' >>= withAttribute "Alternates"))
<|>
((pDetectChar False '+' >>= withAttribute "Alternates"))
<|>
((parseRules "Comment Alert")))
return (attr, result)
parseRules "Comment" =
do (attr, result) <- (((pDetectSpaces >>= withAttribute "Comment"))
<|>
((Text.Highlighting.Kate.Syntax.Alert.parseExpression))
<|>
((pDetectIdentifier >>= withAttribute "Comment")))
return (attr, result)
parseRules "Container Open" =
do (attr, result) <- (((pDetectChar False '>' >>= withAttribute "Container") >>~ pushContext "Alert")
<|>
((pRegExpr regex_'5b'5e'23'3e'5d'2a >>= withAttribute "Attribute"))
<|>
((parseRules "Comment Alert")))
return (attr, result)
parseRules "Container Close" =
do (attr, result) <- ((pDetectChar False '>' >>= withAttribute "Container") >>~ pushContext "Alert")
return (attr, result)
parseRules "Comment Alert" =
do (attr, result) <- ((pDetectChar False '#' >>= withAttribute "Alert") >>~ pushContext "Alert")
return (attr, result)
parseRules "Alert" =
pzero
parseRules x = fail $ "Unknown context" ++ x