{-# LANGUAGE BangPatterns #-}{-# LANGUAGE OverloadedStrings #-}{-# LANGUAGE ScopedTypeVariables #-}moduleSystem.FastLogger(Logger,timestampedLogEntry,combinedLogEntry,newLogger,logMsg,stopLogger)whereimportControl.ConcurrentimportControl.ExceptionimportControl.MonadimportData.ByteString.Char8(ByteString)importqualifiedData.ByteString.Char8asSimportqualifiedData.ByteString.Lazy.Char8asLimportData.ByteString.Internal(c2w)importData.DList(DList)importqualifiedData.DListasDimportData.IntimportData.IORefimportData.MaybeimportData.Serialize.PutimportPreludehiding(catch,show)importqualifiedPreludeimportSystem.IOimportText.Show.ByteStringhiding(runPut)importSnap.Internal.Http.Server.Date-- | Holds the state for a logger.dataLogger=Logger{_queuedMessages::!(IORef(DListByteString)),_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<-newIORefD.emptydw<-newEmptyMVarth<-newEmptyMVarletlg=Loggerqdwfpthtid<-forkIO$loggingThreadlgputMVarthtidreturnlg-- | Prepares a log message with the time prepended.timestampedLogEntry::ByteString->IOByteStringtimestampedLogEntrymsg=dotimeStr<-getLogDateStringreturn$!runPut$!doputWord8$c2w'['putByteStringtimeStrputByteString"] "putByteStringmsg-- | 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!userAgent=doletuser=fromMaybe"-"mbUserletnumBytes=maybe"-"(\s->strict$shows)mbNumBytesletreferer=maybe"-"(\s->S.concat["\"",s,"\""])mbReferertimeStr<-getLogDateStringlet!p=[host," - ",user," [",timeStr,"] \"",req,"\" ",strict$showstatus," ",numBytes," ",referer," \"",userAgent,"\""]let!output=S.concatpreturn$!outputwherestrict=S.concat.L.toChunks-- | 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'=S.snocs'\n'atomicModifyIORef(_queuedMessageslg)$\d->(D.snocds',())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->(D.empty,x)let!msgs=D.toListdllet!s=L.fromChunksmsgsh<-readIORefhrefL.hPuthshFlushh-- 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