{-# LANGUAGE BangPatterns #-}{-# LANGUAGE OverloadedStrings #-}{-# LANGUAGE ScopedTypeVariables #-}moduleSystem.FastLogger(Logger,timestampedLogEntry,combinedLogEntry,newLogger,logMsg,stopLogger)where------------------------------------------------------------------------------importBlaze.ByteString.BuilderimportBlaze.ByteString.Builder.Char.Utf8importControl.ConcurrentimportControl.ExceptionimportData.ByteString.Char8(ByteString)importqualifiedData.ByteString.Lazy.Char8asLimportData.ByteString.Internal(c2w)importData.IntimportData.IORefimportData.MonoidimportSystem.IOimportSnap.Internal.Http.Server.Date-------------------------------------------------------------------------------- | Holds the state for a logger.dataLogger=Logger{_queuedMessages::!(IORefBuilder),_dataWaiting::!(MVar()),_loggerPath::!(FilePath),_loggingThread::!(MVarThreadId)}-------------------------------------------------------------------------------- | Creates a new logger, logging to the given file. If the file argument is-- \"-\", then log to stdout; if it's \"stderr\" then we log to stderr,-- otherwise we log to a regular file in append mode. The file is closed and-- re-opened every 15 minutes to facilitate external log rotation.newLogger::FilePath->IOLoggernewLoggerfp=doq<-newIORefmemptydw<-newEmptyMVarth<-newEmptyMVarletlg=Loggerqdwfpthtid<-forkIO$loggingThreadlgputMVarthtidreturnlg-------------------------------------------------------------------------------- | Prepares a log message with the time prepended.timestampedLogEntry::ByteString->IOByteStringtimestampedLogEntrymsg=dotimeStr<-getLogDateStringreturn$!toByteString$!mconcat[fromWord8$c2w'[',fromByteStringtimeStr,fromByteString"] ",fromByteStringmsg]-------------------------------------------------------------------------------- | Prepares a log message in \"combined\" format.combinedLogEntry::ByteString-- ^ remote host->MaybeByteString-- ^ remote user->ByteString-- ^ request line (up to you to ensure-- there are no quotes in here)->Int-- ^ status code->MaybeInt64-- ^ num bytes sent->MaybeByteString-- ^ referer (up to you to ensure-- there are no quotes in here)->ByteString-- ^ user agent (up to you to ensure-- there are no quotes in here)->IOByteStringcombinedLogEntry!host!mbUser!req!status!mbNumBytes!mbReferer!ua=dotimeStr<-getLogDateStringlet!l=[fromByteStringhost,fromByteString" - ",user,fromByteString" [",fromByteStringtimeStr,fromByteString"] \"",fromByteStringreq,fromByteString"\" ",fromShowstatus,space,numBytes,space,referer,fromByteString" \"",fromByteStringua,quote]let!output=toByteString$mconcatlreturn$!outputwheredash=fromWord8$c2w'-'quote=fromWord8$c2w'\"'space=fromWord8$c2w' 'user=maybedashfromByteStringmbUsernumBytes=maybedashfromShowmbNumBytesreferer=maybedash(\s->mconcat[quote,fromByteStrings,quote])mbReferer-------------------------------------------------------------------------------- | Sends out a log message verbatim with a newline appended. Note:-- if you want a fancy log message you'll have to format it yourself-- (or use 'combinedLogEntry').logMsg::Logger->ByteString->IO()logMsg!lg!s=dolet!s'=fromByteStrings`mappend`(fromWord8$c2w'\n')atomicModifyIORef(_queuedMessageslg)$\d->(d`mappend`s',())tryPutMVar(_dataWaitinglg)()>>return()------------------------------------------------------------------------------loggingThread::Logger->IO()loggingThread(LoggerqueuenotifierfilePath_)=doinitialize>>=gowhereopenIt=iffilePath=="-"thenreturnstdoutelseiffilePath=="stderr"thenreturnstderrelseopenFilefilePathAppendModecloseIth=iffilePath=="-"||filePath=="stderr"thenreturn()elsehClosehgo(href,lastOpened)=(loop(href,lastOpened))`catches`[Handler$\(_::AsyncException)->killit(href,lastOpened),Handler$\(e::SomeException)->dohPutStrLnstderr$"logger got exception: "++Prelude.showethreadDelay20000000go(href,lastOpened)]initialize=dolh<-openIthref<-newIOReflht<-getCurrentDateTimetref<-newIOReftreturn(href,tref)killit(href,lastOpened)=doflushIt(href,lastOpened)h<-readIORefhrefcloseIthflushIt(!href,!lastOpened)=dodl<-atomicModifyIORefqueue$\x->(mempty,x)let!msgs=toLazyByteStringdlh<-readIORefhrefL.hPuthmsgshFlushh-- close the file every 15 minutes (for log rotation)t<-getCurrentDateTimeold<-readIOReflastOpenedift-old>900thendocloseIthopenIt>>=writeIORefhrefwriteIOReflastOpenedtelsereturn()loop!d=do-- wait on the notification mvar_<-takeMVarnotifier-- grab the queued messages and write them outflushItd-- at least five seconds between log dumpsthreadDelay5000000loopd-------------------------------------------------------------------------------- | Kills a logger thread, causing any unwritten contents to be-- flushed out to diskstopLogger::Logger->IO()stopLoggerlg=withMVar(_loggingThreadlg)killThread