Sun Nov 19 04:09:49 WET 2006  Luis Oliveira <loliveira@common-lisp.net>
  * Preliminary serve-event support for SBCL and CLISP.

diff -rN -u old-hunchentoot/headers.lisp new-hunchentoot/headers.lisp
--- old-hunchentoot/headers.lisp	2006-11-19 20:56:39.000000000 +0000
+++ new-hunchentoot/headers.lisp	2006-11-19 20:56:39.000000000 +0000
@@ -216,6 +216,10 @@
     ;; now optional content
     (unless (or (null content) head-request-p)
       (ignore-errors
+        #+:clisp
+        (unless (stringp content)
+          (setf (flexi-stream-element-type *hunchentoot-stream*)
+                '(unsigned-byte 8)))
         (write-sequence content *hunchentoot-stream*)))
     (when chunkedp
       ;; turn chunking on after the headers have been sent
diff -rN -u old-hunchentoot/hunchentoot.asd new-hunchentoot/hunchentoot.asd
--- old-hunchentoot/hunchentoot.asd	2006-11-19 20:56:39.000000000 +0000
+++ new-hunchentoot/hunchentoot.asd	2006-11-19 20:56:39.000000000 +0000
@@ -58,6 +58,7 @@
                #+:lispworks (:file "port-lw")
                #+:openmcl (:file "port-mcl")
                #+:sbcl (:file "port-sbcl")
+               #+:clisp (:file "port-clisp")
                (:file "specials")
                (:file "mime-types")
                (:file "util")
@@ -74,4 +75,5 @@
                #+(and :lispworks :unix) (:file "unix-lw")
                #+(and :openmcl :unix) (:file "unix-mcl")
                #+(and :sbcl :unix) (:file "unix-sbcl")
+               #+(and :clisp :unix) (:file "unix-clisp")
                (:file "server")))
\ No newline at end of file
diff -rN -u old-hunchentoot/packages.lisp new-hunchentoot/packages.lisp
--- old-hunchentoot/packages.lisp	2006-11-19 20:56:39.000000000 +0000
+++ new-hunchentoot/packages.lisp	2006-11-19 20:56:39.000000000 +0000
@@ -41,7 +41,8 @@
   (:import-from :hunchentoot-asd :*hunchentoot-version*)
   #+:lispworks
   (:import-from :lw :with-unique-names :when-let)
-  (:export :*catch-errors-p*
+  (:export #+:clisp :clisp-serve-events
+           :*catch-errors-p*
            :*content-types-for-url-rewrite*
            :*default-content-type*
            :*default-handler*
diff -rN -u old-hunchentoot/port-acl.lisp new-hunchentoot/port-acl.lisp
--- old-hunchentoot/port-acl.lisp	2006-11-19 20:56:39.000000000 +0000
+++ new-hunchentoot/port-acl.lisp	2006-11-19 20:56:39.000000000 +0000
@@ -32,6 +32,7 @@
 (eval-when (:compile-toplevel :load-toplevel :execute)
   #-(and :allegro-version>= (version>= 7 0))
   (error "You need at least version 7.0 of AllegroCL.")
+  (pushnew :hunchentoot-threads *features*)
   ;; make sure code for sockets and OS interface is loaded
   (require :sock)
   (require :osi))
diff -rN -u old-hunchentoot/port-clisp.lisp new-hunchentoot/port-clisp.lisp
--- old-hunchentoot/port-clisp.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-hunchentoot/port-clisp.lisp	2006-11-19 20:56:39.000000000 +0000
@@ -0,0 +1,113 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*-
+;;;
+;;; Copyright (c) 2006, Luis Oliveira <loliveira@common-lisp.net>
+;;;   All rights reserved.
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;;
+;;;   * Redistributions of source code must retain the above copyright
+;;;     notice, this list of conditions and the following disclaimer.
+;;;
+;;;   * Redistributions in binary form must reproduce the above
+;;;     copyright notice, this list of conditions and the following
+;;;     disclaimer in the documentation and/or other materials
+;;;     provided with the distribution.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package :hunchentoot)
+
+;;;; Serve-event
+
+(pushnew :hunchentoot-serve-event *features*)
+
+(defvar *fd-handlers* nil)
+
+(defun add-fd-handler (socket handler)
+  (car (push (cons socket handler) *fd-handlers*)))
+
+(defun remove-fd-handler (handler)
+  (setf *fd-handlers* (delete handler *fd-handlers*)))
+
+(defmacro without-other-fd-handlers (&body body)
+  `(progn ,@body))
+
+(defun clisp-serve-events ()
+  "Poor man's serve-event."
+  (let ((sockets (mapcar #'car *fd-handlers*)))
+    (loop
+     (loop for handler in *fd-handlers*
+           for readyp in (socket:socket-status sockets)
+           do (when readyp
+                (funcall (cdr handler) (car handler)))))))
+
+;;;; Sockets
+
+(defun close-socket (socket)
+  (socket:socket-server-close socket))
+
+(defun start-up-server (&key service address mode process-name announce function
+                        &allow-other-keys)
+  "Tries to \(partly) emulate LispWorks' COMM:START-UP-SERVER.  See
+<http://www.lispworks.com/documentation/lw50/LWRM/html/lwref-56.htm>
+for more info."
+  (declare (ignore process-name))
+  (assert (eq mode :serve-event))
+  (cl:ignore-errors
+    (let ((socket (socket:socket-server service :interface address :backlog 5)))
+      (funcall announce socket)
+      (add-fd-handler
+       socket
+       (lambda (sock)
+         (funcall function
+                  (socket:socket-accept
+                   sock :buffered t :element-type '(unsigned-byte 8))))))))
+
+(defun make-socket-stream (socket read-timeout write-timeout)
+  (socket:socket-options socket
+                         :SO-RCVTIMEO read-timeout
+                         :SO-SNDTIMEO write-timeout)
+  (multiple-value-bind (remote-host remote-port)
+      (socket:socket-stream-peer socket)
+    (values socket
+            (nth-value 1 (socket:socket-stream-local socket))
+            remote-host
+            remote-port)))
+
+;;;; Debugging
+
+;;; From swank-clisp.lisp.
+
+(defun format-frame (frame)
+  (string-trim #(#\newline #\space #\tab)
+               (with-output-to-string (s)
+                 (sys::describe-frame s frame))))
+
+(defun function-frame-p (formated-frame)
+  (char= #\< (aref formated-frame 0)))
+
+(defun get-backtrace (error)
+  "This is the function that is used internally by Hunchentoot to
+show or log backtraces."
+  (declare (ignore error))
+  (with-output-to-string (stream)
+    (do ((last nil frame)
+         (frame (sys::the-frame) (sys::frame-up-1 frame 1)))
+        ((eq frame last))
+      (let ((ff (format-frame frame)))
+        (when (function-frame-p ff)
+          (write-line (subseq ff (+ (position #\> ff) 2)
+                              (position #\newline ff))
+                      stream))))))
diff -rN -u old-hunchentoot/port-cmu.lisp new-hunchentoot/port-cmu.lisp
--- old-hunchentoot/port-cmu.lisp	2006-11-19 20:56:39.000000000 +0000
+++ new-hunchentoot/port-cmu.lisp	2006-11-19 20:56:39.000000000 +0000
@@ -33,6 +33,8 @@
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (error "This library needs a version of CMUCL with MP support."))
 
+(pushnew :hunchentoot-threads *features*)
+
 (defun make-lock (name)
   "See CMUCL documentation for MP:MAKE-LOCK."
   (mp:make-lock name))
diff -rN -u old-hunchentoot/port-lw.lisp new-hunchentoot/port-lw.lisp
--- old-hunchentoot/port-lw.lisp	2006-11-19 20:56:39.000000000 +0000
+++ new-hunchentoot/port-lw.lisp	2006-11-19 20:56:39.000000000 +0000
@@ -38,6 +38,7 @@
           #+:linux "Linux")))
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
+  (pushnew :hunchentoot-threads *features*)
   ;; make sure socket code is loaded
   (require "comm"))
 
diff -rN -u old-hunchentoot/port-mcl.lisp new-hunchentoot/port-mcl.lisp
--- old-hunchentoot/port-mcl.lisp	2006-11-19 20:56:39.000000000 +0000
+++ new-hunchentoot/port-mcl.lisp	2006-11-19 20:56:39.000000000 +0000
@@ -29,6 +29,8 @@
 
 (in-package :hunchentoot)
 
+(pushnew :hunchentoot-threads *features*)
+
 (defun make-lock (name)
   "See OpenMCL documentation for CCL:MAKE-LOCK."
   (ccl:make-lock name))
diff -rN -u old-hunchentoot/port-sbcl.lisp new-hunchentoot/port-sbcl.lisp
--- old-hunchentoot/port-sbcl.lisp	2006-11-19 20:56:39.000000000 +0000
+++ new-hunchentoot/port-sbcl.lisp	2006-11-19 20:56:39.000000000 +0000
@@ -29,15 +29,22 @@
 
 (in-package :hunchentoot)
 
-#-(and :sb-thread :sb-unicode)
+#-:sb-unicode
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (error "This library needs a version of SBCL with Unicode and thread support."))
+  (error "This library needs a version of SBCL with thread support."))
 
 (defmacro defconstant (name value &optional doc)
   "Make sure VALUE is evaluated only once \(to appease SBCL)."
   `(cl:defconstant ,name (if (boundp ',name) (symbol-value ',name) ,value)
      ,@(when doc (list doc))))
 
+;;;; Threading
+
+#+:sb-threads
+(progn
+
+(pushnew :hunchentoot-threads *features*)
+
 (defun make-lock (name)
   "See SBCL documentation for SB-THREAD:MAKE-MUTEX."
   (sb-thread:make-mutex :name name))
@@ -59,7 +66,7 @@
 form but stops execution after SECONDS seconds and then instead
 executes the code in TIMEOUT-FORMS."
   `(cl:handler-case
-     (sb-ext:with-timeout ,seconds ,@body)
+       (sb-ext:with-timeout ,seconds ,@body)
      (sb-ext:timeout () ,@timeout-forms)))
 
 (defun process-run-function (name function &rest args)
@@ -80,6 +87,46 @@
 which can be found in most other Lisps."
   (sleep .1))
 
+) ; :sb-threads
+
+;;;; Serve-event
+
+(pushnew :hunchentoot-serve-event *features*)
+
+(defvar *hunchentoot-fd-handlers* nil)
+
+(defun add-fd-handler (socket handler)
+  (let ((handler-obj (sb-sys:add-fd-handler
+                      (sb-bsd-sockets:socket-file-descriptor socket)
+                      :input handler)))
+    (push handler-obj *hunchentoot-fd-handlers*)
+    handler-obj))
+
+(defun remove-fd-handler (handler)
+  (setq *hunchentoot-fd-handlers*
+        (delete handler *hunchentoot-fd-handlers* :test #'eq))
+  (sb-sys:remove-fd-handler handler))
+
+(defmacro without-other-fd-handlers (&body body)
+  "Run BODY without hunchentoot's handlers therefore ensuring
+only one request is handled at a time. Other handlers are present
+and may be removed/added within BODY."
+  (let ((h (gensym)))
+    `(let ((,h nil))
+       (unwind-protect
+            (let ((sb-impl::*descriptor-handlers*
+                   (remove-if (lambda (x)
+                                (member x *hunchentoot-fd-handlers* :test #'eq))
+                              sb-impl::*descriptor-handlers*)))
+              (unwind-protect
+                   (progn
+                     ,@body)
+                (setq ,h sb-impl::*descriptor-handlers*)))
+         (setq sb-impl::*descriptor-handlers*
+               (append ,h *hunchentoot-fd-handlers*))))))
+
+;;;; Sockets
+
 (defun resolve-hostname (name)
   "Converts from different types to represent an IP address to
 the canonical representation which is an array with four
@@ -94,36 +141,37 @@
                                                    (logand name #xFF))))
     (t name)))
 
-(defun start-up-server (&key service address process-name announce function &allow-other-keys)
+(defun close-socket (socket)
+  (sb-bsd-sockets:socket-close socket))
+
+(defun open-socket (service address)
+  (let ((socket (make-instance 'sb-bsd-sockets:inet-socket
+                               :type :stream :protocol :tcp)))
+    (setf (sb-bsd-sockets:sockopt-reuse-address socket) t)
+    (sb-bsd-sockets:socket-bind socket (resolve-hostname address) service)
+    (sb-bsd-sockets:socket-listen socket 5)
+    socket))
+
+(defun start-up-server (&key service address mode process-name announce function
+                        &allow-other-keys)
   "Tries to \(partly) emulate LispWorks' COMM:START-UP-SERVER.  See
 <http://www.lispworks.com/documentation/lw50/LWRM/html/lwref-56.htm>
 for more info."
-  (let (done)
-    (flet ((open-socket-and-accept ()
-             (handler-bind ((error (lambda (condition)
-                                     (funcall announce nil condition)
-                                     (setq done condition)
-                                     (return-from open-socket-and-accept))))
-               (let (socket)
-                 (unwind-protect
-                     (progn
-                       (setf socket (make-instance 'sb-bsd-sockets:inet-socket
-                                       :type :stream
-                                       :protocol :tcp)
-                             (sb-bsd-sockets:sockopt-reuse-address socket) t)
-                       (sb-bsd-sockets:socket-bind socket (resolve-hostname address) service)
-                       (sb-bsd-sockets:socket-listen socket 5)
-                       (funcall announce socket)
-                       (setq done socket)
-                       (loop (funcall function (sb-bsd-sockets:socket-accept socket))))
-                   (when socket
-                     (cl:ignore-errors
-                       (sb-bsd-sockets:socket-close socket))))))))
-      (let ((listener-thread (process-run-function process-name #'open-socket-and-accept)))
-        (loop until done do (sleep .1))
-        (typecase done
-          (sb-bsd-sockets:inet-socket listener-thread)
-          (t (values nil done)))))))
+  #-:sb-threads
+  (declare (ignore process-name))
+  (cl:ignore-errors
+    (let ((socket (open-socket service address)))
+      (funcall announce socket)
+      (flet ((accept-one-request ()
+               (funcall function (sb-bsd-sockets:socket-accept socket))))
+        (ecase mode
+          (:serve-event
+           (add-fd-handler
+            socket (lambda (fd) (declare (ignore fd)) (accept-one-request))))
+          #+:sb-threads
+          (:threaded
+           (process-run-function
+            process-name (lambda () (loop (accept-one-request))))))))))
 
 (defun format-address (address)
   "Converts an array of four integers denoting an IP address into
@@ -149,6 +197,8 @@
               (format-address remote-host)
               remote-port))))
 
+;;;; Debugging
+
 ;; determine how we're going to access the backtrace in the next
 ;; function
 (eval-when (:compile-toplevel :load-toplevel :execute)
@@ -171,4 +221,3 @@
     (let ((sb-debug:*debug-print-level* nil)
           (sb-debug:*debug-print-length* nil))
       (sb-debug:backtrace most-positive-fixnum s))))
-
diff -rN -u old-hunchentoot/server.lisp new-hunchentoot/server.lisp
--- old-hunchentoot/server.lisp	2006-11-19 20:56:39.000000000 +0000
+++ new-hunchentoot/server.lisp	2006-11-19 20:56:39.000000000 +0000
@@ -52,7 +52,7 @@
    (listener :accessor server-listener
              :documentation "The Lisp process which listens for
 incoming requests and starts new worker threads for each new
-connection.")
+connection. For serve-event mode, it holds the FD handler.")
    (workers :initform nil
             :accessor server-workers
             :documentation "A list of currently active worker threads.")
@@ -77,16 +77,50 @@
                             :reader server-ssl-privatekey-password
                             :documentation "The password for the
 private key file or NIL.")
+   #+:hunchentoot-threads
    (lock :initform (make-lock (format nil "hunchentoot-lock-~A"
                                       *server-counter*))
          :reader server-lock
          :documentation "A lock which is used to make sure that
-we can shutdown the server cleanly."))
+we can shutdown the server cleanly.")
+   (mode :initarg :mode
+         :reader server-mode
+         :documentation "One of :THREADED or :SERVER-EVENT."))
   (:documentation "An object of this class contains all relevant
 information about a running Hunchentoot server instance."))
 
+(defun make-handler-function (server)
+  "This function is called whenever a connection is made. See the
+START-SERVER below."
+  (ecase (server-mode server)
+    #+:hunchentoot-serve-event
+    (:serve-event
+     (lambda (handle)
+       (without-other-fd-handlers
+         (process-connection server handle))))
+    (:threaded
+     #+:hunchentoot-threads
+     (lambda (handle)
+       (with-lock ((server-lock server))
+         (incf *worker-counter*)
+         ;; check if we need to perform a global GC
+         (when (and *cleanup-interval*
+                    (zerop (mod *worker-counter* *cleanup-interval*)))
+           (when *cleanup-function*
+             (funcall *cleanup-function*)))
+         ;; start a worker thread for this connection and remember it
+         (push (process-run-function (format nil "hunchentoot-worker-~A"
+                                             *worker-counter*)
+                                     #'process-connection
+                                     server handle)
+               (server-workers server))))
+     #-:hunchentoot-threads
+     (error "This Lisp does not support threads."))))
+
 (defun start-server (&key (port 80 port-provided-p)
                           address
+                          (mode #+:hunchentoot-threads :threaded
+                                #-:hunchentoot-threads :serve-event)
                           (mod-lisp-p nil)
                           (use-apache-log-p mod-lisp-p)
                           (read-timeout *default-read-timeout*)
@@ -151,6 +185,7 @@
     (let ((server (make-instance 'server
                                  :port port
                                  :address address
+                                 :mode mode
                                  :chunkingp (and chunkingp (not mod-lisp-p))
                                  :ssl-certificate-file (and ssl-certificate-file
                                                             (namestring ssl-certificate-file))
@@ -161,10 +196,11 @@
                                  :use-apache-log-p (and mod-lisp-p use-apache-log-p)
                                  :read-timeout read-timeout
                                  :write-timeout write-timeout)))
-      (multiple-value-bind (process condition)
+      (multiple-value-bind (listener condition)
           ;; start up the actual server
           (start-up-server :service port
                            :address address
+                           :mode mode
                            :process-name (format nil "hunchentoot-listener-~A" *server-counter*)
                            ;; this function is called once on
                            ;; startup - we use it to record the
@@ -176,30 +212,14 @@
                                               (error condition))))
                            ;; this function is called whenever a
                            ;; connection is made
-                           :function (lambda (handle)
-                                       (with-lock ((server-lock server))
-                                         (incf *worker-counter*)
-                                         ;; check if we need to
-                                         ;; perform a global GC
-                                         (when (and *cleanup-interval*
-                                                    (zerop (mod *worker-counter* *cleanup-interval*)))
-                                           (when *cleanup-function*
-                                             (funcall *cleanup-function*)))
-                                         ;; start a worker thread
-                                         ;; for this connection
-                                         ;; and remember it
-                                         (push (process-run-function (format nil "hunchentoot-worker-~A"
-                                                                             *worker-counter*)
-                                                                     #'process-connection
-                                                                     server handle)
-                                               (server-workers server))))
+                           :function (make-handler-function server)
                            ;; wait until the server was
                            ;; successfully started or an error
                            ;; condition is returned
                            :wait t)
-        (cond (process
+        (cond (listener
                ;; remember the listener so we can kill it later
-               (setf (server-listener server) process))
+               (setf (server-listener server) listener))
               (condition
                (error condition))))
       #+:unix
@@ -218,15 +238,22 @@
 
 (defun stop-server (server)
   "Stops the Hunchentoot server SERVER."
-  ;; use lock so that the listener can't start new workers
-  (with-lock ((server-lock server))
-    ;; kill all worker threads
-    (dolist (worker (server-workers server))
-      (ignore-errors (process-kill worker))
-      (process-allow-scheduling))
-    ;; finally, kill main listener
-    (when-let (listener (server-listener server))
-      (process-kill listener)))
+  (ecase (server-mode server)
+    #+:hunchentoot-serve-event
+    (:serve-event
+     (remove-fd-handler (server-listener server))
+     (close-socket (server-socket server)))
+    #+:hunchentoot-threads
+    (:threaded
+     ;; use lock so that the listener can't start new workers
+     (with-lock ((server-lock server))
+       ;; kill all worker threads
+       (dolist (worker (server-workers server))
+         (ignore-errors (process-kill worker))
+         (process-allow-scheduling))
+       ;; finally, kill main listener
+       (when-let (listener (server-listener server))
+         (process-kill listener)))))
   (values))
 
 (defun process-connection (server handle)
@@ -265,9 +292,9 @@
                                         :privatekey-password (server-ssl-privatekey-password server))
                 #-:lispworks
                 (setq *hunchentoot-stream*
-                        (cl+ssl:make-ssl-server-stream *hunchentoot-stream*
-                                                       :certificate (server-ssl-certificate-file server)
-                                                       :key (server-ssl-privatekey-file server))))
+                      (cl+ssl:make-ssl-server-stream *hunchentoot-stream*
+                                                     :certificate (server-ssl-certificate-file server)
+                                                     :key (server-ssl-privatekey-file server))))
               ;; wrap with chunking-enabled stream if we're not behind mod_lisp
               (unless (server-mod-lisp-p server)
                 (setq *hunchentoot-stream* (make-chunked-stream *hunchentoot-stream*)))
@@ -302,6 +329,7 @@
                 (ignore-errors (force-output* *hunchentoot-stream*))))
           (when *hunchentoot-stream*
             (ignore-errors (close *hunchentoot-stream* :abort t)))
+          #+:hunchentoot-threads
           (ignore-errors
             (with-lock ((server-lock server))
               ;; remove this worker from the list of all workers
@@ -377,7 +405,7 @@
                       (dispatch-request *dispatch-table*)))))
             (when error
               (setf (return-code *reply*)
-                      +http-internal-server-error+))
+                    +http-internal-server-error+))
             (start-output (cond ((and error *show-lisp-errors-p*)
                                  (format nil "<pre>~A~:[~*~;~%~%~A~]</pre>"
                                          (escape-for-html (format nil "~A" error))
diff -rN -u old-hunchentoot/specials.lisp new-hunchentoot/specials.lisp
--- old-hunchentoot/specials.lisp	2006-11-19 20:56:39.000000000 +0000
+++ new-hunchentoot/specials.lisp	2006-11-19 20:56:39.000000000 +0000
@@ -209,6 +209,7 @@
 (defvar *log-file-stream* nil
   "The stream corresponding to the log file.")
 
+#+:hunchentoot-threads
 (defvar *log-file-lock* (make-lock "log-file-lock")
   "A lock to prevent two threads from writing to the log file at
 same time.")
@@ -253,6 +254,7 @@
 (defvar *default-log-level* nil
   "The default log level for LOG-MESSAGE*.")
 
+#+:hunchentoot-threads
 (defvar *session-data-lock* (make-lock "session-data-lock")
   "A lock to prevent two threads from modifying *SESSION-DATA* at the
 same time.")
@@ -302,6 +304,7 @@
   "Internal counter used to generate meaningful names for
 listener threads.")
 
+#+:hunchentoot-threads
 (defvar *worker-counter* 0
   "Internal counter used to generate meaningful names for worker
 threads.")
diff -rN -u old-hunchentoot/unix-clisp.lisp new-hunchentoot/unix-clisp.lisp
--- old-hunchentoot/unix-clisp.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-hunchentoot/unix-clisp.lisp	2006-11-19 20:56:39.000000000 +0000
@@ -0,0 +1,48 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*-
+;;;
+;;; Copyright (c) 2006, Luis Oliveira <loliveira@common-lisp.net>
+;;;   All rights reserved.
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;;
+;;;   * Redistributions of source code must retain the above copyright
+;;;     notice, this list of conditions and the following disclaimer.
+;;;
+;;;   * Redistributions in binary form must reproduce the above
+;;;     copyright notice, this list of conditions and the following
+;;;     disclaimer in the documentation and/or other materials
+;;;     provided with the distribution.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package :hunchentoot)
+
+(defun setuid (uid)
+  "Sets the effective user ID of the current process to UID - see
+setuid\(2)."
+  (setf (posix:getuid) uid))
+
+(defun setgid (gid)
+  "Sets the effective group ID of the current process to GID -
+see setgid\(2)."
+  (setf (posix:getgid) gid))
+
+(defun get-uid-from-name (name)
+  "Returns the UID for the user named NAME."
+  (posix:user-info-uid (posix:user-info name)))
+
+(defun get-gid-from-name (name)
+  "Returns the GID for the group named NAME."
+  (posix:user-info-gid (posix:user-info name)))
diff -rN -u old-hunchentoot/util.lisp new-hunchentoot/util.lisp
--- old-hunchentoot/util.lisp	2006-11-19 20:56:39.000000000 +0000
+++ new-hunchentoot/util.lisp	2006-11-19 20:56:39.000000000 +0000
@@ -200,6 +200,7 @@
   "Interns the upcased version of STRING into the KEYWORD package.
 Uses NSTRING-UPCASE if DESTRUCTIVEP is true.  Returns NIL if STRING is
 not a string."
+  #+:clisp (setq destructivep nil)
   (and (stringp string)
        (intern (if destructivep
                  (nstring-upcase string)
@@ -370,10 +371,13 @@
 (defun force-output* (stream)
   "Like FORCE-OUTPUT but aborts execution after
 *FORCE-OUTPUT-TIMEOUT* seconds."
+  #+:hunchentoot-threads
   (with-timeout (*force-output-timeout*
                  (warn "FORCE-OUTPUT didn't return after ~A seconds."
                        *force-output-timeout*))
-    (force-output stream)))
+    (force-output stream))
+  #-:hunchentoot-threads
+  (force-output stream))
 
 (defun parse-content-type (content-type-header)
   "Reads and parses a `Content-Type' header and returns it as three
@@ -445,4 +449,15 @@
   "The default for *CLEANUP-FUNCTION*.  Invokes a GC on LispWorks and
 does nothing on other Lisps."
   #+:lispworks
-  (hcl:mark-and-sweep 2))
\ No newline at end of file
+  (hcl:mark-and-sweep 2))
+
+#-:hunchentoot-threads
+(defmacro with-lock ((lock) &body body)
+  "Dummy WITH-LOCK macro for Lisps that don't support threads."
+  (declare (ignore lock))
+  `(progn ,@body))
+
+#-:hunchentoot-threads
+(defmacro atomic-incf (place &optional (delta 1))
+  "Dummy ATOMIC-INCF macro for Lisps that don't support threads."
+  `(incf ,place ,delta))

