log.lisp

   1 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*-
   2 ;;; $Header: /usr/local/cvsrep/hunchentoot/log.lisp,v 1.10 2008/02/13 16:02:17 edi Exp $
   3
   4 ;;; Copyright (c) 2004-2010, Dr. Edmund Weitz.  All rights reserved.
   5
   6 ;;; Redistribution and use in source and binary forms, with or without
   7 ;;; modification, are permitted provided that the following conditions
   8 ;;; are met:
   9
  10 ;;;   * Redistributions of source code must retain the above copyright
  11 ;;;     notice, this list of conditions and the following disclaimer.
  12
  13 ;;;   * Redistributions in binary form must reproduce the above
  14 ;;;     copyright notice, this list of conditions and the following
  15 ;;;     disclaimer in the documentation and/or other materials
  16 ;;;     provided with the distribution.
  17
  18 ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
  19 ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  20 ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  21 ;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
  22 ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  23 ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
  24 ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
  25 ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  26 ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
  27 ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
  28 ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  29
  30 (in-package :hunchentoot)
  31
  32 (defmacro with-log-stream ((stream-var destination lock) &body body)
  33   "Helper macro to write log entries.  STREAM-VAR is a symbol that
  34 will be bound to the logging stream during the execution of BODY.
  35 DESTINATION is the logging destination, which can be either a pathname
  36 designator of the log file, a symbol designating an open stream or NIL
  37 if logging should be done to *ERROR-OUTPUT*.  LOCK refers to the lock
  38 that should be held during the logging operation.  If DESTINATION is a
  39 pathname, a flexi stream with UTF-8 encoding will be created and
  40 bound to STREAM-VAR.  If an error occurs while writing to the log
  41 file, that error will be logged to *ERROR-OUTPUT*.
  42
  43 Note that logging to a file involves opening and closing the log file
  44 for every logging operation, which is overall costly.  Web servers
  45 with high throughput demands should make use of a specialized logging
  46 function rather than relying on Hunchentoot's default logging
  47 facility."
  48   (with-unique-names (binary-stream)
  49     (with-rebinding (destination)
  50       (let ((body body))
  51         `(when ,destination
  52            (with-lock-held (,lock)
  53              (etypecase ,destination
  54                ((or string pathname)
  55                 (with-open-file (,binary-stream ,destination
  56                                                 :direction :output
  57                                                 :element-type 'octet
  58                                                 :if-does-not-exist :create
  59                                                 :if-exists :append
  60                                                 #+:openmcl #+:openmcl
  61                                                 :sharing :lock)
  62                   (let ((,stream-var (make-flexi-stream ,binary-stream :external-format +utf-8+)))
  63                     ,@body)))
  64                (stream
  65                 (let ((,stream-var ,destination))
  66                   (prog1 (progn ,@body)
  67                     (finish-output *error-output*)))))))))))
  68