[Portableaserve-discuss] Versions, and missing functions

[Alain P. <Ala...@me...>]

Following a suggestion by Simon Andr=E1s, I checked out and
build the current CVS sources of portableaserve.  These
seem to have the publish-prefix function, but still have
the buggy behaviour I described earlier.

I patched this behaviour, and include all my current local
patches in case anyone wants to fold them into CVS
(I could do it if someone will give me write access to the
CVS repository).

I have a question about the fix to process-connection;
I had to wrap a couple of (force-output-noblock sock) inside
ignore-errors, but some calls already _have_ ignore-errors
around them.  I'm not sure if I'm missing something important
and introducing a file descriptor leak.

But it definitely fixes my current problem.

=09=09=09--ap


=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
;;;;   -*- Mode: lisp; Package: ; Syntax: Common-lisp -*-
;;
;; Copyright (C) 2002 Memetrics Pty. Ltd.
;; All rights reserved.
;;
;; Author:  $Author: kooks $
;; Version: $Id: aserve-patches.lisp,v 1.7 2003/04/17 00:16:58 kooks Ex=
p $
;;
;;;; Commentary:
;;
;;
;;
;;;; Code:

(defconstant +aserve-patches-version+ "$Revision: 1.7 $"
  "$Id: aserve-patches.lisp,v 1.7 2003/04/17 00:16:58 kooks Exp $
   Report bugs to: bu...@me...")

(in-package :net.aserve)

;; 1. Fixes nil in query - e.g. ((foo . nil)) -> "FOO-BAR=3DNIL"
;; 2. Fixes APPLY limitation
(defun query-to-form-urlencoded (query &key (external-format
=09=09=09=09=09     *default-aserve-external-format*))
  (loop for (key . val) in query
=09collect (encode-form-urlencoded key :external-format external-format=
) into result
=09collect (encode-form-urlencoded val :external-format external-format=
) into result
=09finally return (format nil "~{~A=3D~A~^&~}" result)))

(defmethod log-request ((req http-request))
  ;; after the request has been processed, write out log line
  (when *enable-logging*
    (let ((ipaddr (socket:remote-host (request-socket req))))
      ;; After handle-request calling, this may not valid req
      ;; So, check if the address is still valid first.
      (when ipaddr
=09(let* ((time   (request-reply-date req))
=09       (code   (let ((obj (request-reply-code req)))
=09=09=09 (if obj
=09=09=09     (response-number obj)
=09=09=09     999)))
=09       (length  (or (request-reply-content-length req)
=09=09=09    #+(and allegro (version>=3D 6))
=09=09=09    (excl::socket-bytes-written (request-socket req))))
=09       (stream (vhost-log-stream (request-vhost req)))
=09       (lock #+allegro (and (streamp stream)
=09=09=09=09    (getf (excl::stream-property-list stream)
=09=09=09=09=09  :lock))
=09=09     #-allegro nil))

=09  (macrolet ((do-log ()
=09=09       '(progn (format stream
=09=09=09=09"~a - - [~a] ~s ~s ~s~%"
=09=09=09=09(socket:ipaddr-to-dotted ipaddr)
=09=09=09=09(maybe-universal-time-to-date time)
=09=09=09=09(request-raw-request req)
=09=09=09=09code
=09=09=09=09(or length -1))
=09=09=09 (force-output stream))))

=09    (if lock
=09=09(acl-mp:with-process-lock (lock)
=09=09  ;; in case stream switched out while we weren't busy
=09=09  ;; get the stream again
=09=09  (setq stream (vhost-log-stream (request-vhost req)))
=09=09  (do-log))
=09=09(do-log))))))))



;;; This one has a bug in which the whole thread can die if the user
;;; clicks so fast as to close the socket before aserve has finished wr=
iting to it.
;;;
(defun process-connection (sock)
  ;; read an http request from the socket and process
  ;; it.
  ;; If the response indicates 'keep alive' then loop around for
  ;; another request.
  ;; When this function returns the given socket has been closed.
  ;;

  ; run the accept hook on the socket if there is one
  (let ((ahook (wserver-accept-hook *wserver*)))
    (if* ahook then (setq sock (funcall ahook sock))))


  (unwind-protect
      (let ((req))
=09;; get first command
=09(loop
=09  (with-timeout-local (*read-request-timeout*
=09=09=09       (debug-format :info "request timed out on read~%")
=09=09=09       ; this is too common to log, it happens with
=09=09=09       ; every keep alive socket when the user stops
=09=09=09       ; clicking
=09=09=09       ;;(log-timed-out-request-read sock)
=09=09=09       (return-from process-connection nil))
=09    (setq req (read-http-request sock)))
=09  (if* (null req)
=09     then ; end of file, means do nothing
=09=09  ; (logmess "eof when reading request")
=09=09  ; end this connection by closing socket
=09=09  (return-from process-connection nil)
=09     else ;; got a request
=09=09  (setq *worker-request* req)

=09=09  (handle-request req)

=09=09  (ignore-errors ;ap -- testing
=09=09    (force-output-noblock (request-socket req)))

=09=09  (log-request req)

=09=09  (setq *worker-request* nil)
=09=09  (free-req-header-block req)

=09=09  (let ((sock (request-socket req)))
=09=09    (if* (member :keep-alive
=09=09=09=09 (request-reply-strategy req)
=09=09=09=09 :test #'eq)
=09=09       then ; continue to use it
=09=09=09    (debug-format :info "request over, keep socket alive~%")
=09=09=09    (ignore-errors ; ap -- testing
=09=09=09      (force-output-noblock sock))
=09=09       else (return))))))
    ;; do it in two stages since each one could error and both have
    ;; to be attempted
    (ignore-errors (force-output-noblock sock))
    (ignore-errors (close sock :abort t))))


(in-package :acl-compat-mp)

;;; This one fixes an insidious race condition between unwinding
;;; and unscheduling the timer.
(defun invoke-with-timeout (timeout bodyfn timeoutfn)
  (block timeout
    (let* ((process mp:*current-process*)
           (unsheduled? nil)
           (timer (mp:make-timer
                   #'(lambda ()
                       (mp:process-interrupt process
                                             #'(lambda ()
                                                 (unless unsheduled?
                                                   (return-from timeout=

                                                     (funcall timeoutfn=
)))))))))
      (mp:schedule-timer-relative timer timeout)
      (unwind-protect (funcall bodyfn)
        (without-interrupts
         (mp:unschedule-timer timer)
         (setf unsheduled? t))))))




;;; ASERVE-PATCHES.LISP ends here
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
--
			Alain Picard
			Memetrics