outlog - Taking care of log rotations automagically

I am currently involved in the development of a number of communicating Tcl processes that have to keep running all the time. One of the problems that I have faced is simply the one of log rotation. Log files can typically grow too big and log rotation has been the solution of choice for many years. While it is possible to rotate from outside Tcl, why not doing it directly from your program? I discovered lately that my code did a lot of what cronolog [L1 ] does, and there is perhaps more inspiration to take from there.

The code below offers an open/puts/close interface to log files, while taking automatically care of log rotation at given points in time. Additionally, it attempts to provide protection against logging to NFS mounted files that might "disappear" for a little while. This very code is much less tested and a later attempt to solve recurrent problems in my own setup.

The code below does not make use of a namespace, but translation to such cleaner code should really be easy (I was mostly lazy here).

Emmanuel Frecon

ak: Notes. Tclhttpd has IIRC code for doing the same thing. Maybe not as complex. Also, would the integration of this code into the Tcllib packages log and logger make sense to you ?

EF: I'll look into the HTTPd code. Yes integration into tcllib makes sense, I just don't have the time right now. The question really is how to integrate it though: as a separate package or as something that integrates with log or logger (or both)? As far as I remember both packages provides ways to send the log output to files, via "callbacks". Then perhaps is the best solution to actually create a separate package that implementations of these callbacks would be able to use.

Emmanuel Frecon notes on his page that "you'd better off picking up the (more up to date) implementation in the TIL."


##################
## Module Name     --  outlog.tcl
## Original Author --  Emmanuel Frecon - [email protected]
## Description:
##
##    This module contains commands to dump output to log files in a manner
##    as safe as possible.  The module also handles log rotation.
##
## Commands Exported:
##        outlog_open
##        outlog_puts
##        outlog_close
##################
 
array set __OutLog {
     id_generator    0
     logs            ""
}
 
# Command Name     -- outlog_open
# Original Author  --  Emmanuel Frecon - [email protected]
#
# Create a new log creation object and return a reference to it.
#
# Arguments:
#    logfile        - Name of log file to handle (empty or stdout understood)
#    rotate        - Number of hours before rotating, -1 to switch off
#    keep        - Number of log rotation files to keep
proc outlog_open { logfile { rotate -1 } { keep 4 } } {
     global __OutLog
 
     # Look if there is not an already existing log rotator 
     # for that file.
     foreach id $__OutLog(logs) {
         set varname "__outlog_$id"
         upvar \#0 $varname Log
 
         if { $Log(logfile) == $logfile } {
             set Log(rotate) $rotate
             set Log(keep) $keep
             return  $id
         }
     }
 
     # There is none, initialise an outlog object for that file
     set id [incr __OutLog(id_generator)]
     set varname "__outlog_$id"
     upvar \#0 $varname Log
 
     set Log(logfile) $logfile
     set Log(accumulator) ""
     if { $logfile == "" || $logfile == "stdout" || $logfile == "-" } {
         set Log(fd) "stdout"
         set Log(start) [clock seconds]
     } else {
         if { [file exists $Log(logfile)] } {
             file stat $Log(logfile) fdata
             set Log(start) $fdata(atime)
         } else {
             set Log(start) [clock seconds]
         }
         set Log(fd) ""
     }
     set Log(rotate) $rotate
     set Log(keep) $keep
 
     lappend __OutLog(logs) $id
     return $id
}

# Command Name     --  outlog_puts
# Original Author  --  Emmanuel Frecon - [email protected]
#
# Log a line to the file associated to an outlog object.  
# Performs log rotation if necessary, applicable and requested.  
# Handle files that might have been lost through NFS restarts...
#
# Arguments:
#    id         - Identifier of outlog object
#    line        - Line to dump to file
#    norotation        - Do not rotate right now if set 
proc outlog_puts { id line { norotation 0 } } {
     global __OutLog
 
     # Check that this is one of our outlog objects.
     set idx [lsearch $__OutLog(logs) $id]
     if { $idx < 0 } {
         return
     }
     
     # Get to the global that contains all necessary information
     set varname "__outlog_$id"
     upvar \#0 $varname Log
 
     # Record current time.
     set now [clock seconds]
     set dt [clock format $now]
 
     # If the file descriptor is empty (i.e. at start up or after an
     # NFS failure was discovered), try to reopen the file.
     if { $Log(fd) == "" } {
         if { [catch "open $Log(logfile) a+" fd] == 0 } {
             set Log(fd) $fd
         }
     }
 
     # If we have an opened file descriptor to output to, do that,
     # otherwise accumulate until we get back to normal.
     if { $Log(fd) != "" } {
 
         # The accumulator wasn't empty, which means that we have just
         # recovered back to normal.  Dump back the content of the
         # accumulator to the file, together with some recovery
         # message.
         if { $Log(accumulator) != "" } {
             puts $Log(fd) \
                 "RECOVERED at $dt: Reopened $Log(logfile), dumping accumulator"
             foreach l $Log(accumulator) {
                 puts $Log(fd) $l
             }
             set Log(accumulator) ""
         }
 
         # Output the line to the file.
         puts $Log(fd) $line
 
         # Flush output at once.  We catch this and it may fail.  
         # If it fails, enter output accumulation mode.
         if { [catch "flush $Log(fd)"] != 0 } {
             catch "close $Log(fd)"
             set Log(fd) ""
             lappend Log(accumulator) \
                 "ERROR at $dt: Lost connection to $Log(logfile), accumulating"
             lappend Log(accumulator) $line
         }
     } else {
         lappend Log(accumulator) $line
     }
 
 
     # Now takes care of rotations when possible and requested.
     if { $Log(fd) != "" && $Log(fd) != "stdout" && $Log(rotate) >= 0 \
          && ! $norotation } {
         # We need to rotate, enough time has elapsed since start.
         if { [expr $now - $Log(start)] >= [expr int($Log(rotate) * 3600)] } {
             if { [catch "close $Log(fd)"] == 0 } {
                 # Set the file descriptor to be empty, it will be
                 # reopened next time.
                 set Log(fd) ""
 
                 # And performs rotation through renaming the old
                 # existing files.
                 # This assumes that we can access them.
                 if { $Log(keep) > 2 } {
                     for { set i [expr $Log(keep) - 1]} { $i > 0 } \
                         { incr i -1 } {
                             if { [file exists "$Log(logfile).$i"] } {
                                 file rename -force -- \
                                     "$Log(logfile).$i" \
                                     "$Log(logfile).[expr $i + 1]"
                             }
                         }
                 }
 
                 # Finally move or delete the current log file.
                 # It takes position 1 in the ordered list of logs,
                 # alternatively, if we did not wish to keep logs, it
                 # is removed.
                 if { $Log(keep) >= 1 } {
                     file rename -force -- "$Log(logfile)" "$Log(logfile).1"
                 } else {
                     file delete -force -- "$Log(logfile)"
                 }
 
                 # Do not forget to remember that we have rotated and
                 # reinitialise the timer.
                 set Log(start) $now
             } else {
                 # We could not close, write an information to the
                 # file, there is probably something wrong, so we
                 # recurse to benefit from the NFS protection measures.
                 outlog_puts $id \
                     "ERROR at $dt: Cannot close $Log(logfile) for rotation" \
                     1
             }
         }
     }
}
 
# Command Name     --  outlog_close
# Original Author  --  Emmanuel Frecon - [email protected]
#
# Close an outlog object.  Return 0 if the file could not correctly be
# closed.
#
# Arguments:
#    arg1        -
#    arg2        -
proc outlog_close { id } {
     global __OutLog
 
     # Check that this is one of our outlog objects.
     set idx [lsearch $__OutLog(logs) $id]
     if { $idx < 0 } {
         return
     }
     
     # Get to the global that contains all necessary information
     set varname "__outlog_$id"
     upvar \#0 $varname Log
 
     # Close file and clean up
     set res 0
     if { $Log(fd) != "stdout" } {
         # If the file is an empty string close will fail as we wish it
         # will
         set res [catch "close $Log(fd)"]
     }
     set __OutLog(logs) [lreplace $__OutLog(logs) $idx $idx]
     unset __OutLog
 
     return [expr ! $res]
}