{-# LANGUAGE CPP, FlexibleContexts #-}{-
Copyright (C) 2009 John MacFarlane <jgm@berkeley.edu>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-}{- | Functions for parsing command line options and reading the config file.
-}moduleNetwork.Gitit.Config(getConfigFromFile,getDefaultConfig,readMimeTypesFile)whereimportNetwork.Gitit.TypesimportNetwork.Gitit.Server(mimeTypes)importNetwork.Gitit.FrameworkimportNetwork.Gitit.Authentication(formAuthHandlers,httpAuthHandlers)importNetwork.Gitit.Util(parsePageType,readFileUTF8)importSystem.Log.Logger(logM,Priority(..))importqualifiedData.MapasMimportData.ConfigFilehiding(readfile)importControl.Monad.ErrorimportSystem.Log.Logger()importData.List(intercalate)importData.Char(toLower,toUpper,isDigit)importPaths_gitit(getDataFileName)importSystem.FilePath((</>))importText.Pandochiding(MathML,WebTeX)forceEither::Showe=>Eitherea->aforceEither=either(error.show)id-- | Get configuration from config file.getConfigFromFile::FilePath->IOConfiggetConfigFromFilefname=docp<-getDefaultConfigParserreadfilecpfname>>=extractConfig.forceEither-- | A version of readfile that treats the file as UTF-8.readfile::MonadErrorCPErrorm=>ConfigParser->FilePath->IO(mConfigParser)readfilecppath'=docontents<-readFileUTF8path'return$readstringcpcontentsextractConfig::ConfigParser->IOConfigextractConfigcp=doconfig'<-runErrorT$docfRepositoryType<-getcp"DEFAULT""repository-type"cfRepositoryPath<-getcp"DEFAULT""repository-path"cfDefaultPageType<-getcp"DEFAULT""default-page-type"cfMathMethod<-getcp"DEFAULT""math"cfShowLHSBirdTracks<-getcp"DEFAULT""show-lhs-bird-tracks"cfAuthenticationMethod<-getcp"DEFAULT""authentication-method"cfUserFile<-getcp"DEFAULT""user-file"cfSessionTimeout<-getcp"DEFAULT""session-timeout"cfTemplatesDir<-getcp"DEFAULT""templates-dir"cfLogFile<-getcp"DEFAULT""log-file"cfLogLevel<-getcp"DEFAULT""log-level"cfStaticDir<-getcp"DEFAULT""static-dir"cfPlugins<-getcp"DEFAULT""plugins"cfTableOfContents<-getcp"DEFAULT""table-of-contents"cfMaxUploadSize<-getcp"DEFAULT""max-upload-size"cfMaxPageSize<-getcp"DEFAULT""max-page-size"cfPort<-getcp"DEFAULT""port"cfDebugMode<-getcp"DEFAULT""debug-mode"cfFrontPage<-getcp"DEFAULT""front-page"cfNoEdit<-getcp"DEFAULT""no-edit"cfNoDelete<-getcp"DEFAULT""no-delete"cfDefaultSummary<-getcp"DEFAULT""default-summary"cfAccessQuestion<-getcp"DEFAULT""access-question"cfAccessQuestionAnswers<-getcp"DEFAULT""access-question-answers"cfUseRecaptcha<-getcp"DEFAULT""use-recaptcha"cfRecaptchaPublicKey<-getcp"DEFAULT""recaptcha-public-key"cfRecaptchaPrivateKey<-getcp"DEFAULT""recaptcha-private-key"cfCompressResponses<-getcp"DEFAULT""compress-responses"cfUseCache<-getcp"DEFAULT""use-cache"cfCacheDir<-getcp"DEFAULT""cache-dir"cfMimeTypesFile<-getcp"DEFAULT""mime-types-file"cfMailCommand<-getcp"DEFAULT""mail-command"cfResetPasswordMessage<-getcp"DEFAULT""reset-password-message"cfUseFeed<-getcp"DEFAULT""use-feed"cfBaseUrl<-getcp"DEFAULT""base-url"cfWikiTitle<-getcp"DEFAULT""wiki-title"cfFeedDays<-getcp"DEFAULT""feed-days"cfFeedRefreshTime<-getcp"DEFAULT""feed-refresh-time"cfPDFExport<-getcp"DEFAULT""pdf-export"cfPandocUserData<-getcp"DEFAULT""pandoc-user-data"let(pt,lhs)=parsePageTypecfDefaultPageTypeletmarkupHelpFile=showpt++iflhsthen"+LHS"else""markupHelpPath<-liftIO$getDataFileName$"data"</>"markupHelp"</>markupHelpFilemarkupHelpText<-liftM(writeHtmlStringdefaultWriterOptions.readMarkdowndefaultParserState)$liftIO$readFileUTF8markupHelpPathmimeMap'<-liftIO$readMimeTypesFilecfMimeTypesFileletauthMethod=maptoLowercfAuthenticationMethodletstripTrailingSlash=reverse.dropWhile(=='/').reverseletrepotype'=casemaptoLowercfRepositoryTypeof"git"->Git"darcs"->Darcs"mercurial"->Mercurialx->error$"Unknown repository type: "++xreturn$!Config{repositoryPath=cfRepositoryPath,repositoryType=repotype',defaultPageType=pt,mathMethod=casemaptoLowercfMathMethodof"jsmath"->JsMathScript"mathml"->MathML"google"->WebTeX"http://chart.apis.google.com/chart?cht=tx&chl="_->RawTeX,defaultLHS=lhs,showLHSBirdTracks=cfShowLHSBirdTracks,withUser=caseauthMethodof"form"->withUserFromSession"http"->withUserFromHTTPAuth_->id,authHandler=caseauthMethodof"form"->msumformAuthHandlers"http"->msumhttpAuthHandlers_->mzero,userFile=cfUserFile,sessionTimeout=readNumber"session-timeout"cfSessionTimeout*60-- convert minutes -> seconds,templatesDir=cfTemplatesDir,logFile=cfLogFile,logLevel=letlevelString=maptoUppercfLogLevellevels=["DEBUG","INFO","NOTICE","WARNING","ERROR","CRITICAL","ALERT","EMERGENCY"]iniflevelString`elem`levelsthenreadlevelStringelseerror$"Invalid log-level.\nLegal values are: "++intercalate", "levels,staticDir=cfStaticDir,pluginModules=splitCommaListcfPlugins,tableOfContents=cfTableOfContents,maxUploadSize=readSize"max-upload-size"cfMaxUploadSize,maxPageSize=readSize"max-page-size"cfMaxPageSize,portNumber=readNumber"port"cfPort,debugMode=cfDebugMode,frontPage=cfFrontPage,noEdit=splitCommaListcfNoEdit,noDelete=splitCommaListcfNoDelete,defaultSummary=cfDefaultSummary,accessQuestion=ifnullcfAccessQuestionthenNothingelseJust(cfAccessQuestion,splitCommaListcfAccessQuestionAnswers),useRecaptcha=cfUseRecaptcha,recaptchaPublicKey=cfRecaptchaPublicKey,recaptchaPrivateKey=cfRecaptchaPrivateKey,compressResponses=cfCompressResponses,useCache=cfUseCache,cacheDir=cfCacheDir,mimeMap=mimeMap',mailCommand=cfMailCommand,resetPasswordMessage=fromQuotedMultilinecfResetPasswordMessage,markupHelp=markupHelpText,useFeed=cfUseFeed,baseUrl=stripTrailingSlashcfBaseUrl,wikiTitle=cfWikiTitle,feedDays=readNumber"feed-days"cfFeedDays,feedRefreshTime=readNumber"feed-refresh-time"cfFeedRefreshTime,pdfExport=cfPDFExport,pandocUserData=ifnullcfPandocUserDatathenNothingelseJustcfPandocUserData}caseconfig'ofLeft(ParseErrore,e')->error$"Parse error: "++e++"\n"++e'Lefte->error(showe)Rightc->returncfromQuotedMultiline::String->StringfromQuotedMultiline=unlines.mapdoline.lines.dropWhile(`elem`" \t\n")wheredoline=dropWhile(`elem`" \t").dropGtdropGt('>':' ':xs)=xsdropGt('>':xs)=xsdropGtx=xreadNumber::(Numa,Reada)=>String->String->areadNumber_x|allisDigitx=readxreadNumberopt_=error$opt++" must be a number."readSize::(Numa,Reada)=>String->String->areadSizeoptx=casereversexof('K':_)->readNumberopt(initx)*1000('M':_)->readNumberopt(initx)*1000000('G':_)->readNumberopt(initx)*1000000000_->readNumberoptxsplitCommaList::String->[String]splitCommaListl=let(first,rest)=break(==',')lfirst'=lrStripfirstincaserestof[]->ifnullfirst'then[]else[first'](_:rs)->first':splitCommaListrslrStrip::String->StringlrStrip=reverse.dropWhileisWhitespace.reverse.dropWhileisWhitespacewhereisWhitespace=(`elem`" \t\n")getDefaultConfigParser::IOConfigParsergetDefaultConfigParser=docp<-getDataFileName"data/default.conf">>=readfileemptyCPreturn$forceEithercp-- | Returns the default gitit configuration.getDefaultConfig::IOConfiggetDefaultConfig=getDefaultConfigParser>>=extractConfig-- | Read a file associating mime types with extensions, and return a-- map from extensions to types. Each line of the file consists of a-- mime type, followed by space, followed by a list of zero or more-- extensions, separated by spaces. Example: text/plain txt textreadMimeTypesFile::FilePath->IO(M.MapStringString)readMimeTypesFilef=catch(liftM(foldrgoM.empty.mapwords.lines)$readFileUTF8f)handleMimeTypesFileNotFoundwherego[]m=m-- skip blank linesgo(x:xs)m=foldr(\ext->M.insertextx)mxshandleMimeTypesFileNotFounde=dologM"gitit"WARNING$"Could not read mime types file: "++f++"\n"++showe++"\n"++"Using defaults instead."returnmimeTypes{-
-- | Ready collection of common mime types. (Copied from
-- Happstack.Server.HTTP.FileServe.)
mimeTypes :: M.Map String String
mimeTypes = M.fromList
[("xml","application/xml")
,("xsl","application/xml")
,("js","text/javascript")
,("html","text/html")
,("htm","text/html")
,("css","text/css")
,("gif","image/gif")
,("jpg","image/jpeg")
,("png","image/png")
,("txt","text/plain")
,("doc","application/msword")
,("exe","application/octet-stream")
,("pdf","application/pdf")
,("zip","application/zip")
,("gz","application/x-gzip")
,("ps","application/postscript")
,("rtf","application/rtf")
,("wav","application/x-wav")
,("hs","text/plain")]
-}