Parasitemia/Logger/Logger.fs

   1 namespace Logger
   2
   3 open System
   4 open System.Text
   5 open System.IO
   6 open System.IO.Compression
   7 open System.Diagnostics
   8 open System.Threading
   9 open System.Collections.Generic
  10
  11 type Severity = DEBUG = 1 | INFO = 2 | WARNING = 3 | ERROR = 4 | FATAL = 5
  12
  13 type IListener =
  14     abstract NewEntry : severity : Severity -> header : string -> message : string -> unit
  15
  16 type private Message =
  17     {
  18         Message : string
  19         ThreadName : string
  20         ThreadId : int
  21         ModuleCaller : string
  22         Severity : Severity
  23     }
  24
  25 type private Command =
  26     | Write of Message
  27     | Stop of AsyncReplyChannel<unit>
  28
  29 [<Sealed>]
  30 type Log () =
  31
  32     let extractNumberFromLogfilepath (path : string) : int option =
  33         if isNull path then
  34             None
  35         else
  36             let filename = path.Substring (path.LastIndexOf Path.DirectorySeparatorChar + 1)
  37             let filenameWithoutExtension = filename.Remove (filename.IndexOf '.')
  38             match Int32.TryParse filenameWithoutExtension with
  39             | (true, n) -> Some n
  40             | _ -> None
  41
  42     let [<Literal>] MAX_SIZE_FILE = 52428800L // [byte] (50 MB).
  43     let [<Literal>] NB_ENTRIES_CHECK_SIZE = 100; // Each 100 entries added we check the size of the log file to test if it is greater than 'MAX_SIZE_FILE'.
  44     let [<Literal>] COMPRESS_ARCHIVED_FILES = true
  45     let [<Literal>] FILENAME_FORMAT = "{0:D4}.log"
  46     let [<Literal>] COMPRESSED_FILE_POSTFIX = ".gzip"
  47     let encoding = Encoding.GetEncoding "UTF-8"
  48
  49     let compress (filename : string) =
  50         use inputStream = new FileStream (filename, FileMode.Open, FileAccess.Read)
  51         let filenameCompressed = filename + COMPRESSED_FILE_POSTFIX
  52         use compressedStream = new GZipStream (new FileStream (filenameCompressed, FileMode.Create, FileAccess.Write), CompressionLevel.Optimal)
  53         inputStream.CopyTo compressedStream
  54
  55     let moduleName = System.Diagnostics.StackFrame(1).GetMethod().Module.Name
  56
  57     let mutable stream : StreamWriter = null
  58     let mutable filename : string = null
  59
  60     let mutable logDir : string = null
  61
  62     let monitor = Object ()
  63
  64     let listeners = List<IListener> ()
  65
  66     let debug =
  67 #if DEBUG
  68         true
  69 #else
  70         false
  71 #endif
  72
  73     static let instance = new Log ()
  74
  75     let openLogFile (entryNumber : int64) =
  76         if not (isNull logDir) then
  77             try
  78                 if isNull stream || (entryNumber % (int64 NB_ENTRIES_CHECK_SIZE) = 0L) && stream.BaseStream.Length > MAX_SIZE_FILE
  79                 then
  80                     if not (isNull stream)
  81                     then
  82                         stream.Close ()
  83                         if COMPRESS_ARCHIVED_FILES then
  84                             compress filename
  85                             File.Delete filename
  86
  87                     // Search the last id among the log files.
  88                     let mutable n = 1
  89                     for existingFile in Directory.GetFiles logDir do
  90                         match extractNumberFromLogfilepath existingFile with
  91                         | Some n' when n' > n -> n <- n'
  92                         | _ -> ()
  93
  94                     filename <- Path.Combine (logDir, String.Format (FILENAME_FORMAT, n))
  95                     try
  96                         if File.Exists (filename + COMPRESSED_FILE_POSTFIX) || FileInfo(filename).Length > MAX_SIZE_FILE
  97                         then
  98                             filename <- Path.Combine (logDir, String.Format (FILENAME_FORMAT, n + 1))
  99                     with
 100                     | :? FileNotFoundException -> () // The file may not exist.
 101
 102                     stream <- new StreamWriter (filename, true, encoding)
 103             with
 104             | ex -> Console.Error.WriteLine ("Can't open the file log: {0}", ex)
 105
 106     let write (msg : Message) (entryNumber : int64) =
 107         openLogFile entryNumber
 108
 109         let header =
 110             String.Format (
 111                 "{0:yyyy-MM-dd HH:mm:ss.fff} [{1}] {{{2}}} ({3})",
 112                 TimeZone.CurrentTimeZone.ToLocalTime DateTime.UtcNow,
 113                 string msg.Severity,
 114                 msg.ModuleCaller,
 115                 (if String.IsNullOrEmpty msg.ThreadName then string msg.ThreadId else sprintf "%s-%i" msg.ThreadName msg.ThreadId)
 116             )
 117
 118         for listener in listeners do
 119             listener.NewEntry msg.Severity header msg.Message
 120
 121         if not (isNull stream)
 122         then
 123             try
 124                 stream.WriteLine ("{0} : {1}", header, msg.Message)
 125                 stream.Flush ()
 126             with
 127             | :? IOException as ex -> Console.Error.WriteLine ("Unable to write to the log file: {0}", ex)
 128
 129     let writeAgent =
 130         new MailboxProcessor<Command> (
 131             fun inbox ->
 132                 let rec loop (nbEntries : int64) =
 133                     async {
 134                         let! command = inbox.Receive ()
 135                         match command with
 136                         | Write message ->
 137                             write message nbEntries
 138                             return! loop (nbEntries + 1L)
 139                         | Stop replyChannel ->
 140                             replyChannel.Reply ()
 141                     }
 142                 loop 1L
 143         )
 144
 145     do
 146         writeAgent.Start ()
 147
 148     let setLogDirectory (dir : string) =
 149         lock monitor (
 150             fun () ->
 151                 logDir <- dir
 152
 153                 if not <| isNull stream then
 154                     stream.Close ()
 155                     stream <- null
 156
 157                 try
 158                     if not <| Directory.Exists logDir
 159                     then
 160                         Directory.CreateDirectory logDir |> ignore
 161                 with
 162                 | _ -> Console.Error.WriteLine ("Unable to create the log directory: {0}", logDir)
 163        )
 164
 165     interface IDisposable with
 166         member this.Dispose () =
 167             if not (isNull stream)
 168             then
 169                 stream.Dispose ()
 170             (writeAgent :> IDisposable).Dispose ()
 171
 172     member private this.Write (message : string) (severity : Severity) =
 173         let moduleNameCaller =
 174             match StackTrace().GetFrames() |> Array.tryPick (fun frame -> let name = frame.GetMethod().Module.Name
 175                                                                           if name <> moduleName then Some name else None) with
 176             | Some name -> name
 177             | _ -> moduleName
 178
 179         let command =
 180             Write
 181                 {
 182                     Message = message
 183                     ThreadName = Thread.CurrentThread.Name
 184                     ThreadId = Thread.CurrentThread.ManagedThreadId
 185                     ModuleCaller = moduleNameCaller
 186                     Severity = severity
 187                 }
 188
 189         writeAgent.Post command
 190
 191     /// <summary>
 192     /// Will stop and wait a reply. Used to flush the remaining messages.
 193     /// </summary>
 194     member private this.Stop () =
 195         writeAgent.PostAndReply (
 196             fun replyChannel ->
 197                 Stop replyChannel
 198         )
 199
 200     member this.LogDirectory
 201         with get () = logDir
 202         and set value = setLogDirectory value
 203
 204     static member SetLogDirectory (dir : string) =
 205         instance.LogDirectory <- dir
 206
 207     member this.AddListener (listener : IListener) =
 208         lock monitor (
 209             fun () ->
 210                 if not <| listeners.Contains listener
 211                 then
 212                     listeners.Add listener
 213         )
 214
 215     member this.RmListener (listener : IListener) =
 216         lock monitor (fun () -> listeners.Remove listener |> ignore)
 217
 218     static member AddListener (listener : IListener) = instance.AddListener listener
 219     static member RmListener (listener : IListener) = instance.RmListener listener
 220
 221     static member LogWithTime (severity : Severity) (f : unit -> 'a) (format : Printf.StringFormat<'b, 'a>) : 'b =
 222         let sw = Stopwatch ()
 223         sw.Start ()
 224         let res = f ()
 225         sw.Stop ()
 226         Printf.kprintf (fun s -> instance.Write (s + sprintf " (time: %d ms)" sw.ElapsedMilliseconds) severity; res) format
 227
 228     static member Debug format =
 229 #if DEBUG
 230         Printf.kprintf (fun s -> instance.Write s Severity.DEBUG) format
 231 #else
 232         Printf.kprintf (fun _ -> ()) format // TODO: can it be simplify?
 233 #endif
 234
 235     static member Info format =
 236         Printf.kprintf (fun s -> instance.Write s Severity.INFO) format
 237
 238     static member Warning format =
 239         Printf.kprintf (fun s -> instance.Write s Severity.WARNING) format
 240
 241     static member Error format =
 242         Printf.kprintf (fun s -> instance.Write s Severity.ERROR) format
 243
 244     static member Fatal format =
 245         Printf.kprintf (fun s -> instance.Write s Severity.FATAL) format
 246
 247     static member Shutdown () =
 248         instance.Stop ()