#
#    Copyright (C) 2010 Alexandros Stergiakis <alsterg@gmail.com>
#
#    This program is free software: you can redistribute it and/or modify
#    it under the terms of the GNU Affero General Public License as
#    published by the Free Software Foundation, either version 3 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 Affero General Public License for more details.
#
#    You should have received a copy of the GNU Affero General Public License
#    along with this program.  If not, see <http://www.gnu.org/licenses/>.
#

#//#
# Library for sending and receiving formatted messages to syslog.
#//#

namespace eval log {
   namespace export severity2str severity2num getLogs clearLogs mqsync \
                    Debug Info Notice Warning Error Critical Alert Emergency
   namespace import ::session::user_sessions

# Handler for the syslog message queue. It will be notified whenever syslogd writes something to syslog.
# It then dispatches the logs to appropriate application-specific handlers, as registered via syslog_monitor.
#
# @param queue The message queue name.
# @param command The command that corresponds to the syslog message queue.
proc syslog_mq_hdlr {queue command} {
   Global BUFFERSIZE_DEF
   global booting
   variable buffer
   
   while {1} {
      set msgs [$command receive]
      foreach msg $msgs {
         set index [string first | $msg]
         set opts [string range $msg 0 $index-2]
         set text [string range $msg $index+2 end]
         unset index
         
         set secs [lindex $opts 0]
         set hostname [lindex $opts 1]
         set opts [lindex $opts 2]
         lassign [split $opts {.}] facility severity
         unset opts
         
         # XXX Ident :
         # XXX Pid []
         
         lappend buffer [dict create Time $secs Facility $facility Hostname $hostname Severity $severity Message $text]
         if {[llength $buffer] > $BUFFERSIZE_DEF} {
            set buffer [lreplace $buffer 0 0] ;# remove first.
         }
         
         # Print to terminal(s).
         if {! $booting} {
            foreach sid [user_sessions] {
               Session $sid LOGTHREAS MONITOR
               if {$MONITOR && [severity2num $severity] >= $LOGTHREAS} {
                  Session $sid SYNCH STDOUT2
                  if {$SYNCH} {
                     thread::send -async $sid [list pushbuf "$severity: $text"]
                  } else {
                     # Note: Since Session's event loop doesn't block, using thread::send -async,
                     # would also do the job. But the following is even better, as it prints directly on
                     # the communication pipe and doesn't go through Session's event loop at all.
                     puts $STDOUT2 "$severity: $text"
                  }
               }
            }
         }
      }
      
      if {[$command queue] == 0} { break }
   }
}
   
proc getLogs {args} {
   variable buffer
   
   set number [llength $buffer]
   
   for {set i 0} {$i < [llength $args]} {incr i} {
      switch -exact -- [lindex $args $i] {
         "-number" {set number [lindex $args [incr i]]}
         "-severity" {#XXX}
         "-facility" {#XXX}
         "-ident" {#XXX}
         "-regexp" {#XXX}
         "-match" {#XXX}
         default { error "unrecognized parameter" }
      }
   }
   
   set result [list]
   foreach e [lreverse $buffer] {
      lappend result $e
      incr number -1
      
      if {$number == 0} { break }
   }
   return $result
}

proc clearLogs {} {
   variable buffer [list]
}

# Register a proc to be called whenever a particular application logs something to syslog.
# Whatever was logged will be passed to the handler in a list (one list item - one line of log)
#
# @param prog The name of the application/daemon/program to match
# @param handler The procedure (handler) to call when a match succeeds
proc syslog_monitor {prog handler} {
   # XXX
   variable Monitors
   set Monitors($prog) $handler
}

# Convert a severity expressed as a number 0-7, to the equivalent string.
#
# @param num The symbolic number for a severity level.
# @return The corresponding string describing the severity level.
# @error
proc severity2str {num} {
   if {! (0 <= $num <= 7)} {
      error "severity number out of bounds"
   }
   return [lindex [list debug info notice warning error critical alert emergency] $num]
}

# Convert a severity expressed as a number 0-7, to the equivalent string.
#
# @param num The symbolic number for a severity level.
# @return The corresponding string describing the severity level.
# @error
proc severity2num {sev} {
   set result [lsearch -exact [list debug info notice warning error critical alert emergency] $sev]
   if {$result == -1} {
      error "unrecognized severity level \"$sev\""
   }
   return $result
}

# It formats a message and logs it to syslog. 
# If debugging is enabled, then together with the message, the originating procedure,
# the namespace and thread id are logged as well to facilitate debugging.
#
# The commands has the following syntax:
#     log severity ?options? message-part1 message-part2 ...
# "severity" must be one of:
#       emergency: system is unusable
#       alert: action must be taken immediately
#       critical: critical conditions
#       error: error conditions
#       warning: warning conditions
#       notice: normal but significant condition
#       info: informational messages
#       debug: debug-level messages
# Case is not significant.
#
# It supports the following options:
#   -error : Generate a Tcl error as well, with message the concatenated message-parts.
#   -exit <errcode> : Exit after logging with specified error code.
#   -stack <errorInfo> : Stack error trace. Like in the ::errorInfo Tcl variable.
#   -code <errorCode> : Error code. Like in the ::errorCode Tcl variable.
#   -return : Cause the calling function to return $msg after log has been executed. Useful in order to avoid having the same message in two different lines.
#   -session <sessionId> : The session from which this log request originated. It can be left unspecified.
#   -category <category> : A string to help categorize messages within the context of MikroConf. It can be left unspecified.
#   -- : Optional. Signifies the end of the arguments and that the following arguments will be the severity, and all the rest will be the message-parts
#
# @param severity See description above.
# @param args See description above.
# @error
proc log {severity args} {
   global booting
   
   # Default values
   array set Param {
      error 0
      exit 0
      exitcode 0
      return 0
      session {Main}
      category {None}
      stack {}
      code {}
   }
   
   # Parse provided switches. They overwrite the above defaults.
   for {set i 0} {$i < [llength $args]} {incr i} {
      switch -exact -- [lindex $args $i] {
         "-session" {set Param(session) [lindex $args [incr i]]}
         "-category" {set Param(category) [lindex $args [incr i]]}
         "-error" {set Param(error) 1}
         "-exit" {
            set Param(exit) 1
            set Param(exitcode) [lindex $args [incr i]]
         }
         "-stack" {set Param(stack) [lindex $args [incr i]]}
         "-code" {set Param(code) [lindex $args [incr i]]}
         "-return" {set Param(return) 1}
         "--" {
            incr i
            break
         }
         default {
            break
         }
      }
   }
   
   set msg [join [lrange $args $i end]]
   syslog -ident "MikroConf" -facility "daemon" $severity $msg
   
   # Print to console.
   if {$booting && $severity ne "debug"} {
      puts "$severity: $msg"
   }
         
   # Print error trace to stderr, along with other info when in Debugging mode.
   if {[tsv::get conf DEBUGGING]} {
      puts ""
      puts "Severity: $severity"
      puts "Message: $msg"
      
      # Determine the originating session
      puts "Session: $Param(session)"
      
      # Determine the originating namespace
      puts "Namespace: [uplevel 2 [list namespace current]]"
      
      # Determine the originating procedure
      if {[info level] > 2} {
         puts "Procedure: [lindex [info level -2] 0]"
      } else {
         puts "Procedure: main()"
      }

      puts "Category: $Param(category)"
      
      if {! [lempty $Param(stack)]} {
         puts stderr "Stack trace:\n$Param(stack)"
      }
      
      if {! [lempty $Param(code)]} {
         puts stderr "Error code:\n$Param(code)"
      }
   }
   
   if {$Param(error)} {
      if {! [lempty $Param(stack)]} {
         return -code error -errorinfo $Param(stack) $msg
      }
      return -code error $msg
   }
   
   if {$Param(return)} {
      return -code return $msg2
   }
   
   if {$Param(exit)} {
      exit $Param(exitcode)
   }
   
   return
}

proc Debug {args} { log debug {*}$args }
proc Info {args} { log info {*}$args }
proc Notice {args} { log notice {*}$args }
proc Warning {args} { log warning {*}$args }
proc Error {args} { log error {*}$args }
proc Critical {args} { log critical {*}$args }
proc Alert {args} { log alert {*}$args }
proc Emergency {args} { log emergency {*}$args }

# Force processing of buffered messages.
proc mqsync {} {
   if {[syslog_mq_cmd queue]} { syslog_mq_hdlr "/syslog" "syslog_mq_cmd" }
}

# /syslog = The hardcoded in busybox mqueue path.
# 777 = Give adequate permissions to /syslog so that syslogd can write on it.
# 640 = MAX_READ*2+128 (See busybox syslogd/syslogd.c sources for rationale)
# 200 = 200 * 640 = 64000 bytes = 64KBs
mq open /syslog ::log::syslog_mq_cmd 200 640 777 ::log::syslog_mq_hdlr ;# (@magic-number)
mqsync

} ;# End of Namespace