##################
## Module Name -- outlog.tcl
## Original Author -- Emmanuel Frecon - emmanuel@sics.se
## 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 - emmanuel@sics.se
#
# 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 - emmanuel@sics.se
#
# 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 - emmanuel@sics.se
#
# 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]
}Category Deployment - Category File