With Log4SCM scheme programs can log messages to log files.


This implementation of logging is a derivative of a C log server that has been written to provide high speed logging possibilities in a production messaging environment.

A description of the log server

A number of (different) programs can log to a central log server, using SYSV IPC message queuing. Each program can log to a logical log name, for which the log server has a configuration.

The log server processes all messages from the IPC queue and multiplexes them to various log files. By making the log process asynchronous, queueing up messages, the logging process by clients performs very well, while the log server may be processing messages at a lower rate.

Not only does the log server provide an asynchronous logging facility, it also provides logging by day and purging of expired log files. Log files are created for each day. Each log file having an extension in the form of CCYYMMDD. On a per logical log id basis, the number of days that logs need to be preserved can be set.

The log server in this production environment knows of 5 levels of messages:


Log level 'debug' is used for programm debugging purposes. Logging for this level can be turned on and off. Client programs read a flag about this, from shared memory. If the 'debug' level is turned off, clients won't log the message.


Log level 'info' is used for information about steps that a program takes to do a specific task. Logging for this level can also be turned on and off.


Log level 'warn' is used for warnings about the processing that a program does. A warning may eventually turn into an error if the warning persists, or even result in a fatal situation. Logging for this level can also be turned on and off.


Log level 'error' is used for errors that occur during program execution. Errors are severe for a program or module itself, but not for an entire system, application or service. They do not threaten the execution of the whole.


Log level 'fatal' is used for fatal errors. Fatal errors are errors that prevent the working of an entire system, application or service.

Usually monitoring tools monitor log files for messages marked 'fatal'. When a 'fatal' message occures, a signal is given to enterprise wide monitoring tools like HP Openview or Tivoli.

Log 4 Scheme features

Log4SCM is in a way a simplified implementation of the previously mentioned log server. It doesn't do IPC and doesn't provide log functionality for multiple running programs, multiplexing to multiple log files.

What it does provide is an asynchronous logging functionality that can be used in scheme programs. This log facility runs in a separate thread. Communication between the main thread and the log facility is done using a fifo.

The levels of logging are the same as mentioned in the previous section; debug, info, warn, error and fatal are provided.

In this implementation, a callback function can be attached to the log server for fatal messages. This enables the program to do e.g. some cleanup, displaying a messagebox, handling bug exchange information, checking for program version updates, etc. on a fatal error. Handling of fatal messages is therefore synchronous.

Instead of using IPC shared memory to communicate a flag that indicates if to log 'debug', 'info' and 'warn' levels to the 'logging client threads' an other implementation is made: When setting the log level for a thread, the log functions associated with the levels for which no logging is necessary, will be replaced by noop functions.

A noop function will return 'not-logged. A normal log function returns 'logged.

There are two logging modes. The 'reference mode is faster, but if the logged message contains mutable data, like e.g. the elements of a list that can be changed using set-car! or set-cdr!, there's a good change (especially when using log-debug), that the contents of message have changed before they have been written to the log file. Especially when debugging, it's probably best to change the log mode to 'copy, which makes the log function copy the contents of the message to a string before handing them to the logging fifo. The log mode defaults to 'reference.

Configuration is done on a per log file basis, not for all log files together. XML is used for log file behaviour configuration. API Functions are provided to update the configuration.



This module requires SXML, SSAX, datastructs, from mzlib and srfi 19, both provided with mzscheme.


        (define-syntax thrcell-ref
          (syntax-rules ()
            ((_ a)

        (define-syntax thrcell-set!
          (syntax-rules ()
            ((_ a b)
             (set! a b))))

        (define-syntax make-thrcell
          (syntax-rules ()
            ((_ a b)
        ;Log datastructures are thread specific
        ;Using thrcells, we can get "child"
        ;threads to share the same datastructures
        (define log-fh      (make-thrcell #f #t))
        (define log-name    (make-thrcell #f #t))
        (define log-cfg     (make-thrcell #f #t))
        (define log-lvl     (make-thrcell 'warn #t))
        (define log-keep    (make-thrcell 7 #t))
        (define log-mymode  (make-thrcell 'reference #t))
        (define log-fifo    (make-thrcell #f #t))
        (define log-dt      (make-thrcell #f #t))
        (define log-thread  (make-thrcell #f #t))
        (define  cfg-refresh-thread (make-thrcell #f #t))
        (define log-notify  (make-thrcell (lambda args #f) #t))

        ;Proxy functions
        (define (log-none . msg) 'not-logged)
        (define log-internal-debug (make-thrcell log-none #t))
        (define log-internal-info  (make-thrcell log-none #t))
        (define log-internal-warn  (make-thrcell log-none #t))
        (define log-internal-error (make-thrcell log-none #t))
        (define log-internal-fatal (make-thrcell log-none #t))
        (define MAX-LOG-LINE-LENGTH 120)
;;;=head3 Reading in (and writing out) the configuration

Internal functions for the configuration file

          (let* ((filename (string-append filename-prefix ".scfg")))
            (let ((cfg (log4scm-cfg filename)))
              (thrcell-set! log-keep   (-> cfg keep))
              (thrcell-set! log-lvl    (-> cfg level))
              (thrcell-set! log-mymode (-> cfg mode))
              (thrcell-set! log-cfg    cfg))))

        (define (write-log-config filename-prefix)
          (let* ((filename (string-append filename-prefix ".scfg"))
                 (cfg      (thrcell-ref log-cfg)))
            (if cfg
                  (-> cfg keep (thrcell-ref log-keep))
                  (-> cfg level (thrcell-ref log-lvl))
                  (-> cfg mode (thrcell-ref log-mymode))
                  (-> cfg commit filename)))))

Opening and rotating a log file

The functions here are used to open, close and rotate (cq. expire) log files. These functions are used when starting a log thread and when the date of log messages change. basedir and <basename> are used to get the directory or file component of a full path.

        ;Rotating and opening a log file
        (define (open-new-or-existing-log-and-rotate-logs filename-prefix)
          (let* ((fn-prefix (basename filename-prefix))
                 (fn-len    (string-length fn-prefix))
                 (dt (current-time))
                 (ext (string-append filename-prefix
                                     (date->string (time-utc->date dt) "~Y-~m-~d"))))

            ;First open log for appending
            (let ((fh (open-output-file ext 'append)))
              (thrcell-set! log-fh fh))
            ;And set the current date
            (thrcell-set! log-dt (time-utc->date dt))

            ;Next expire logs
            (let* ((odt (subtract-duration dt (make-time 'time-duration 0
                                                         (* (thrcell-ref log-keep) 24 3600))))
                   (oext (string-append filename-prefix
                                        (date->string (time-utc->date odt) "~Y-~m-~d"))))

              (for-each (lambda (filename)
                          (unlink filename)

                        (let ((files (filter
                                      (lambda (filename)
                                        (string<? (basename filename) oext))
                                      (glob (string-append filename-prefix ".*")))))
                          (if (eq? files #f)

        ;Closing a log file
        (define (close-log)
          (close-output-port (thrcell-ref log-fh)))

log functions

These functions provide the actual log functions, that the 'internal' log function thrcells point to.

Note that these functions pass the given msg message through to the log-fifo, without copying internal references etc. This can result in unexpected behaviour, because the logger thread works asynchronously, and normally slower, because it writes to a file, from the logging thread. Modifying the data given to <msg>, will probably change the messages waiting to be logged.


 (define a (list 2 3))
 (log-info a)
 (set-car! a 8)

May result in "(8 3)" being written to the log file.

;(define (displayp . args)
;  (display args)(newline))

        (define (copy-args arglist)
          (let ((s (open-output-string)))
            (for-each (lambda (arg)
                        (display arg s))
            (let ((str (get-output-string s)))
              (close-output-port s)
        ;log functions
        (define-syntax def-logger
          (syntax-rules ()
            ((_ name level)
             (define (name . msg)
;       (displayp level " - " msg)
               (fifo+ (thrcell-ref log-fifo)
                      (cons level (cons (current-date)
                                        (if (eq? (thrcell-ref log-mymode) 'copy)
                                            (list (list (copy-args (car msg))))

        (def-logger my-debug 'debug)
        (def-logger my-info  'info)
        (def-logger my-warn  'warning)
        (def-logger my-error 'error)

        (define (my-fatal sem . msg)
          (fifo+ (thrcell-ref log-fifo)
                 (cons 'fatal (cons (current-date) (cons sem msg))))

Using the set-log-functions function, the thread cells for the log functions are modified. For log level 'error and above, 'log-internal-[debug,info,warn]' are set to 'log-none'.

        ;setting used log-functions
        (define (set-log-functions level)

          (define (ord level)
             ((eq? level 'debug) 0)
             ((eq? level 'info)  1)
             ((eq? level 'warn)  2)
             ((eq? level 'error) 3)
             (else 4)))

          (let ((lvl (ord level)))
            (if (<= lvl 0)
                (thrcell-set! log-internal-debug my-debug)
                (thrcell-set! log-internal-debug log-none))
            (if (<= lvl 1)
                (thrcell-set! log-internal-info my-info)
                (thrcell-set! log-internal-info log-none))
            (if (<= lvl 2)
                (thrcell-set! log-internal-warn my-warn)
                (thrcell-set! log-internal-warn log-none))
            (thrcell-set! log-internal-error my-error)
            (thrcell-set! log-internal-fatal my-fatal)))

The logger

The logger function is the worker function of the log thread. This function puts all provided messages on the current log-file. It reads log requests or commands from a fifo. The 'stop-logging command is used to stop the logger. The 'log-fatal-notify command is used to change the notify function (callback function) for this log facility. It is communicated over the fifo to the logger, because setting it directly would pose problems as can be seen from the image below.

Threads and callbacks

Threads and callbacks

Suppose in this image, child thread 2 wants to update the callback function for the fatal level notifyer. If it updates it's own callback function** variable, the logger thread won't notice, because variables are local to threads. If the notifyer function variable would be made shared for all threads, only one callback function could be installed for all threads.

So it is made sure, that the new callback function is (asynchronously) communicated over the fifo to the logger thread. The logger thread stores the function in it's local notifyer variable.

If a message with a fatal level is read from the fifo, the callback function is called. A call to the log-fatal function is synchronous. If a lot of messages have been logged, it can take a while for the callback function to be called and for the log-fatal function to end.

        (define (logger)

          (define (log-entry dt level msgs)
            (define (make-msg msgs)
              (if (null? msgs)
                  (string-append (format "~a" (car msgs))
                                 (make-msg (cdr msgs)))))
            (define (log dt level msg-lines count)
              (if (null? msg-lines)
                  (flush-output (thrcell-ref log-fh))
                    (display (format "~a ~a ~a~a~%"
                                     dt level (if (= count 0)
                                                  "+ ")
                                     (substr (car msg-lines) 0 MAX-LOG-LINE-LENGTH)) (thrcell-ref log-fh))
                    (log dt level (cdr msg-lines) (+ count 1)))))
              ;; TODO: seek to the end of the file (concurrent access, and flush)
              (let ((M (make-msg msgs)))
                (let ((lines (splitstr M #\newline)))
                  (log dt level lines 0)))))

          (define (fillout lvl len)
            (let ((l (symbol->string lvl)))
              (string-append l (make-string (- len (string-length l)) #\space))))

          (define (log-fatal-notify? obj)
            (if (list? obj)
                (if (null? obj)
                    (eq? (car obj) 'log-fatal-notify))

          (define (do-log)
            (let ((entry (fifo- (thrcell-ref log-fifo))))
              (if (eq? entry 'stop-logging)
                  (if (eq? entry 'refresh-configuration)
                        (read-log-config (thrcell-ref log-name))
                        (set-log-functions (thrcell-ref log-lvl))
                        (if (log-fatal-notify? entry)
                            (let ((proc (cadr entry)))
                              (log-info 'log-fatal-notify " request, proc: " proc)
                              (thrcell-set! log-notify proc))
                              (let* ((lvl (car entry))
                                     (dt (cadr entry))
                                     (sem (if (eq? lvl 'fatal)
                                              (caddr entry)
                                     (msgs (if (eq? lvl 'fatal)
                                               (cadddr entry)
                                               (caddr entry)))
                                     (mdt (thrcell-ref log-dt)))
                                (if (not (and (= (srfi:date-day dt) (srfi:date-day mdt))
                                              (= (srfi:date-month dt) (srfi:date-month mdt))
                                              (= (srfi:date-year dt) (srfi:date-year mdt))))
                                      (open-new-or-existing-log-and-rotate-logs (thrcell-ref log-name))))
                                (log-entry (date->string dt "~Y-~m-~dT~H:~M:~S~z") (fillout lvl 8) msgs)
                                (if (eq? lvl 'fatal)
                                      ((thrcell-ref log-notify) dt msgs)
                        ;tail recursive call...


        (define (config-file-refresh)
          (sleep 2)
          (fifo+ (thrcell-ref log-fifo) 'refresh-configuration)



The following sample code is illustrative for using log4scm with multiple threads.

 (require "log4scm.scm")


 (define (next-level level)
    ((eq? level 'debug) 'info)
    ((eq? level 'info) 'warn)
    ((eq? level 'warn) 'error)
    ((eq? level 'error) 'fatal)
    ((eq? level 'fatal) 'debug)))

 (define (do-log level . msg)
    ((eq? level 'debug) (log-debug msg))
    ((eq? level 'info) (log-info msg))
    ((eq? level 'warn) (log-warn msg))
    ((eq? level 'error) (log-error msg))
    ((eq? level 'fatal) (log-fatal msg))))


 (define-syntax counter
   (syntax-rules ()
     ((_ inc-op get-op name)
        (define name (let ((cnt 0))
                      (lambda (op)
                         ((eq? op 'inc)
                            (set! cnt (+ cnt 1))))
                         ((eq? op 'get)
                            (let ((v cnt))
        (define (inc-op) (name 'inc))
        (define (get-op) (name 'get))))))

 (counter inc-tt1 get-tt1 TT1)
 (counter inc-tt2 get-tt2 TT2)


 (define (test2 n level)

   (define (t2 n level)
     (if (> n 0)
          (do-log level "T2" n " fatal: " (get-tt2))
          (t2 (- n 1) (next-level level)))

   (log-start "test2")
   (log-level (next-level level))
   (log-fatal-notify (lambda (dt msgs) (inc-tt2)))
   (t2 n level)


 (define (test1 n level)

   (define (t1 n level)
     (if (> n 0)
          (do-log level "T1" n " fatal: " (get-tt1))
          (t1 (- n 1) (next-level level)))

   (log-start "test1")
   (log-level (next-level level))
   (log-fatal-notify (lambda (dt msgs) (inc-tt1)))
   (thread (lambda () (test2 (* n 2) (next-level level))))
   (t1 n level)


 (test1 20 'debug)

(log-start filename-prefix : string) : boolean

Filename-prefix is the prefix of a filename. [filename-prefix].scfg is used for the logfile configuration. [filename-prefix].CCYYMMDD is used for log files. Log files are created per day. Each new day, expired log files will be cleaned.

A call to log-start will start the logging for the current thread and its child threads. New log-start calls can be issued in child threads.

log-start must not be called more than ones in a thread. log-start and log-stop can be called alternating.

        ;Starting a log system for current threading environment
        (define (log-start filename-prefix)
          (thrcell-set! log-name filename-prefix)
          (read-log-config (thrcell-ref log-name))
          (open-new-or-existing-log-and-rotate-logs filename-prefix)
          (thrcell-set! log-fifo (fifo))
          (set-log-functions (thrcell-ref log-lvl))
          (thrcell-set! log-thread (thread logger))
          (thrcell-set! cfg-refresh-thread (thread config-file-refresh))


log-stop will put a 'stop-logging command on the log-fifo and wait until the logger thread stops.

        (define (log-stop)
          (kill-thread (thrcell-ref cfg-refresh-thread))
          (fifo+ (thrcell-ref log-fifo) 'stop-logging)
          (thread-wait (thrcell-ref log-thread))
          (close-output-port (thrcell-ref log-fh)))


log-sync will sync logging, make fifo empty. Wait until the logger thread stops, and restart it.

        (define (log-sync)
          (log-start (thrcell-ref log-name)))

(log-debug . msgs) : '[not-]logged

This function will log debug messages. If the debug level is turned on, it will return 'logged. 'not-logged will be returned otherwise.

        (define (log-debug . msgs)
          ((thrcell-ref log-internal-debug) msgs))

(log-info . msgs) : '[not-]logged

This function will log info messages. If the info level is turned on, it will return 'logged. 'not-logged will be returned otherwise.

        (define (log-info . msgs)
          ((thrcell-ref log-internal-info) msgs))

(log-warn . msgs) : '[not-]logged

This function will log warning messages. If the warn level is turned on, it will return 'logged. 'not-logged will be returned otherwise. Alias for log-warn, is log-warning.

        (define (log-warn . msgs)
          ((thrcell-ref log-internal-warn) msgs))

        (define (log-warning . msgs)
          ((thrcell-ref log-internal-warn) msgs))

(log-error . msgs) : 'logged

This function will log error messages. These messages cannot be turned off.

        (define (log-error . msgs)
          ((thrcell-ref log-internal-error) msgs))

(log-fatal . msgs) : 'logged

This function will log fatal messages. These messages cannot be turned off. If a log-fatal-notifyer is registered, this function will be called. log-fatal will result in a synchronous log call. Normally log-fatal will also result in terminating a program.

        (define (log-fatal . msgs)
          (let ((sem (make-semaphore 0)))
            ((thrcell-ref log-internal-fatal) (lambda () (semaphore-post sem))  msgs)
            (semaphore-wait sem)))

(log-level . level) : current-level

This function will report and/or set the current log level. If 'level' is given as an argument, the current log level will be set to its value. If no arguments are given, only the current log level is returned.

        (define (log-level . arg)
          (if (not (null? arg))
                (thrcell-set! log-lvl (car arg))
                (set-log-functions (car arg))
                (write-log-config (thrcell-ref log-name))))
          (thrcell-ref log-lvl))

(log-keep-days . days) : days

This function will report and/or set the current number of days after which log files will expire and be cleaned by the logger thread. If 'days' is given, the number of days until log files expire is set to 'days'. Otherwise, only the current number of days is returned.

Precondition (not checked): days>=1.

        (define (log-keep-days . arg)
          (if (not (null? arg))
                (thrcell-set! log-keep (car arg))
                (write-log-config (thrcell-ref log-name))))
          (thrcell-ref log-keep))

(log-max-line-length . len) : integer

This function will report and/or set the current log line length. THIS IS A GLOBAL SETTING, NOT IN A CONFIG FILE. Defaults to 120.

        (define (log-max-line-length . arg)
          (if (not (null? arg))
              (set! MAX-LOG-LINE-LENGTH (car arg)))

(log-mode . mode) : mode

This function will report and/or set the current log mode. Possible modes are 'copy and 'reference. 'copy mode is slower, because the log functions will copy all arguments to a string instead of referencing them. But it can be very usefull when logging volatile data.

        (define (log-mode . arg)
          (if (not (null? arg))
                (thrcell-set! log-mymode (car arg))
                (write-log-config (thrcell-ref log-name))))
          (thrcell-ref log-mymode))

(log-fatal-notify procedure) : #t

log-fatal-notify will set a callback function that will be called on a log messages of level fatal. Programs can use this function to cleanup code, report fatal errors in a popup messagebox, or whatever.

Nothing is done with the result of 'proc'. 'proc' is called with two arguments. First, a date (string? date --> #t); and second any data.

        (define (log-fatal-notify proc)
          (fifo+ (thrcell-ref log-fifo) (list 'log-fatal-notify proc))


Log4SCM can be downloaded at sourceforge


Author(s): Hans Oesterholt (hansatelementalprogrammingdotorgextension).
Copyright: (c) 2005.
License  : Elemental Programming Artistic License.
File     : log4scm.scm $Id: log4scm.scm,v 1.28 2007/05/19 23:25:21 HansOesterholt Exp $