Parasitemia/Logger/FileWriter.fs

   1 namespace Logger
   2
   3 open System
   4 open System.Collections.Generic
   5 open System.IO
   6 open System.Reflection
   7 open System.Threading
   8
   9 open Logger.Constants
  10 open Logger.Types
  11
  12 type internal FileWriter (logDir : string) =
  13     let mutable maxSizeFile = DEFAULT_MAX_SIZE_FILE
  14     let mutable stream : StreamWriter = null
  15     let mutable filename : string = null
  16
  17     let mutable avoidRepeatingIdenticalMessages : bool = false
  18     let lastMessageHashes = Queue<int * DateTime> ()
  19
  20     do
  21         try
  22             if not <| Directory.Exists logDir then
  23                 Directory.CreateDirectory logDir |> ignore
  24         with
  25         | _ -> Console.Error.WriteLine ("Unable to create the log directory: {0}", logDir)
  26
  27     // Open a file to log into. Each file has a number ('entryNumber').
  28     let openLogFile (entryNumber : int64) =
  29         if not (isNull logDir) then
  30             try
  31                 if isNull stream || (entryNumber % (int64 NB_ENTRIES_CHECK_SIZE) = 0L) && stream.BaseStream.Length > maxSizeFile then
  32                     if not (isNull stream) then
  33                         stream.Close ()
  34                         if COMPRESS_ARCHIVED_FILES then
  35                             Utils.compress filename
  36                             File.Delete filename
  37
  38                     // Search the last id among the log files.
  39                     let mutable n = 1
  40                     for existingFile in Directory.GetFiles logDir do
  41                         match Utils.extractNumberFromLogfilepath existingFile with
  42                         | Some n' when n' > n -> n <- n'
  43                         | _ -> ()
  44
  45                     filename <- Path.Combine (logDir, String.Format (FILENAME_FORMAT, n))
  46                     try
  47                         if File.Exists (filename + COMPRESSED_FILE_POSTFIX) || (FileInfo filename).Length > maxSizeFile then
  48                             filename <- Path.Combine (logDir, String.Format (FILENAME_FORMAT, n + 1))
  49                     with
  50                     | :? FileNotFoundException -> () // The file may not exist.
  51
  52                     let fileStream = File.Open (filename, FileMode.Append, FileAccess.Write, FileShare.Read)
  53                     stream <- new StreamWriter (fileStream, encoding)
  54             with
  55             | ex -> Console.Error.WriteLine ("Can't open the file log: {0}", ex)
  56
  57     let write (msg : Message) (entryNumber : int64) =
  58         openLogFile entryNumber
  59
  60         let header = Utils.formatHeader msg
  61
  62         if not <| isNull stream then
  63             try
  64                 let writeAndFlush (header : string) (message : string) =
  65                     stream.WriteLine (Utils.formatMessage header message)
  66                     stream.Flush ()
  67
  68                 if avoidRepeatingIdenticalMessages && msg.Message.Length > Constants.MIN_MESSAGE_LENGTH_TO_NOT_BE_REPEATED then
  69                     let newMessageHash = hash msg.Message
  70                     match lastMessageHashes |> Seq.tryPick (fun (hash, dateTime) -> if hash = newMessageHash then Some dateTime else None) with
  71                     | Some dateTime ->
  72                         writeAndFlush header (String.Format ("<Same as {0:yyyy-MM-dd HH:mm:ss.fff}>", dateTime))
  73                     | None ->
  74                         lastMessageHashes.Enqueue (hash msg.Message, msg.DateTime)
  75                         if lastMessageHashes.Count > Constants.MAX_NB_OF_MESSAGE_HASHES_WHEN_AVOIDING_REPEATING_IDENTICAL_MESSAGES then
  76                             lastMessageHashes.Dequeue () |> ignore
  77                         writeAndFlush header msg.Message
  78                 else
  79                     writeAndFlush header msg.Message
  80             with
  81             | :? IOException as ex -> Console.Error.WriteLine ("Unable to write to the log file: {0}", ex)
  82
  83     let closeCurrentStream () =
  84         if not <| isNull stream then
  85             stream.Dispose ()
  86             stream <- null
  87
  88     let logFiles () =
  89         Directory.EnumerateFiles logDir
  90         |> Seq.filter (fun file -> FILENAME_PATTERN.IsMatch file || FILENAME_PATTERN_COMPRESSED.IsMatch file)
  91         |> Seq.sort
  92
  93     let clearLogFiles (timeOld : TimeSpan) =
  94         closeCurrentStream ()
  95
  96         for file in logFiles () do
  97             let fileInfo = FileInfo file
  98             if fileInfo.LastWriteTime.Add timeOld <= DateTime.Now then
  99                 // Special case for 0001.log to keep the file opened in text editor (developer convenience)
 100                 if fileInfo.Name = String.Format (FILENAME_FORMAT, 1) then
 101                     File.WriteAllText (file, "")
 102                 else
 103                     fileInfo.Delete ()
 104
 105     let logInternalErrorMessage (message : string) (entryNumber : int64) =
 106         write
 107             {
 108                 Message = sprintf "Logger internal error: %s" message
 109                 ThreadName = Thread.CurrentThread.Name
 110                 ThreadId = Thread.CurrentThread.ManagedThreadId
 111                 ModuleCaller = Assembly.GetExecutingAssembly().GetName().Name
 112                 Severity = Severity.ERROR
 113                 DateTime = TimeZone.CurrentTimeZone.ToLocalTime DateTime.UtcNow
 114             }
 115             entryNumber
 116
 117     let mailbox =
 118         new MailboxProcessor<Command> (
 119             fun inbox ->
 120                 let rec loop (nbEntries : int64) =
 121                     async {
 122                         try
 123                             let! command = inbox.Receive ()
 124                             match command with
 125                             | Write message ->
 126                                 write message nbEntries
 127                                 return! loop (nbEntries + 1L)
 128
 129                             | Flush replyChannel ->
 130                                 replyChannel.Reply ()
 131                                 return! loop nbEntries
 132
 133                             | Shutdown replyChannel ->
 134                                 closeCurrentStream ()
 135                                 replyChannel.Reply ()
 136
 137                             | ClearLogFilesOlderThan timeOld ->
 138                                 clearLogFiles timeOld
 139                                 return! loop 1L
 140
 141                             | SetAvoidRepeatingIdenticalMessage enabled ->
 142                                 avoidRepeatingIdenticalMessages <- enabled
 143                                 if not avoidRepeatingIdenticalMessages then
 144                                     lastMessageHashes.Clear ()
 145                                 return! loop nbEntries
 146                         with
 147                         | ex ->
 148                             logInternalErrorMessage (string ex) nbEntries
 149                             return! loop (nbEntries + 1L)
 150                     }
 151                 loop 1L
 152         )
 153
 154     do
 155         mailbox.Start ()
 156
 157     interface IWriter with
 158         member val DebugLoggingEnabled = false with get, set
 159
 160         member this.AvoidRepeatingIdenticalMessages
 161             with get () = avoidRepeatingIdenticalMessages
 162             and set value = mailbox.Post (SetAvoidRepeatingIdenticalMessage value)
 163
 164         member this.LogDir = logDir
 165
 166         member this.MaxSizeFile
 167             with get () = maxSizeFile
 168             and set value = maxSizeFile <- value
 169
 170         member this.LogFiles = logFiles ()
 171
 172         member this.Write (message : Message) =
 173             mailbox.Post (Write message)
 174
 175         member this.Flush () =
 176             mailbox.PostAndReply (fun replyChannel -> Flush replyChannel)
 177
 178         member this.ClearLogFilesOlderThan (timeOld : TimeSpan) =
 179             mailbox.Post (ClearLogFilesOlderThan timeOld)
 180
 181     interface IDisposable with
 182         member this.Dispose () =
 183             mailbox.PostAndReply (
 184                 fun replyChannel ->
 185                     Shutdown replyChannel
 186             )
 187             (mailbox :> IDisposable).Dispose()