Revision: 4226 Author: edi URL: http://bknr.net/trac/changeset/4226

More lunacy

U trunk/thirdparty/hunchentoot/acceptor.lisp U trunk/thirdparty/hunchentoot/easy-handlers.lisp U trunk/thirdparty/hunchentoot/headers.lisp U trunk/thirdparty/hunchentoot/lispworks.lisp U trunk/thirdparty/hunchentoot/log.lisp U trunk/thirdparty/hunchentoot/packages.lisp U trunk/thirdparty/hunchentoot/specials.lisp U trunk/thirdparty/hunchentoot/ssl.lisp U trunk/thirdparty/hunchentoot/test/test.lisp U trunk/thirdparty/hunchentoot/util.lisp

Modified: trunk/thirdparty/hunchentoot/acceptor.lisp =================================================================== --- trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-10 10:57:06 UTC (rev 4225) +++ trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-10 11:29:08 UTC (rev 4226) @@ -309,7 +309,7 @@ (parameter-error "Hunchentoot SSL support is not compiled in.")) (let ((server (apply #'make-instance #-:hunchentoot-no-ssl - (if ssl-certificate-file 'ssl-server 'server) + (if ssl-certificate-file 'ssl-acceptor 'acceptor) #+:hunchentoot-no-ssl 'server args))) @@ -331,25 +331,25 @@ (:method ((acceptor acceptor)) #+:lispworks (multiple-value-bind (listener-process startup-condition) - (comm:start-up-acceptor :service (acceptor-port acceptor) - :address (acceptor-address acceptor) - :process-name (format nil "Hunchentoot listener (~A:~A)" - (or (acceptor-address acceptor) "*") (acceptor-port acceptor)) - ;; this function is called once on startup - we - ;; use it to check for errors - :announce (lambda (socket &optional condition) - (declare (ignore socket)) - (when condition - (error condition))) - ;; this function is called whenever a connection - ;; is made - :function (lambda (handle) - (unless (acceptor-shutdown-p acceptor) - (handle-incoming-connection - (acceptor-connection-dispatcher acceptor) handle))) - ;; wait until the acceptor was successfully started - ;; or an error condition is returned - :wait t) + (comm:start-up-server :service (acceptor-port acceptor) + :address (acceptor-address acceptor) + :process-name (format nil "Hunchentoot listener (~A:~A)" + (or (acceptor-address acceptor) "*") (acceptor-port acceptor)) + ;; this function is called once on startup - we + ;; use it to check for errors + :announce (lambda (socket &optional condition) + (declare (ignore socket)) + (when condition + (error condition))) + ;; this function is called whenever a connection + ;; is made + :function (lambda (handle) + (unless (acceptor-shutdown-p acceptor) + (handle-incoming-connection + (acceptor-connection-dispatcher acceptor) handle))) + ;; wait until the acceptor was successfully started + ;; or an error condition is returned + :wait t) (when startup-condition (error startup-condition)) (mp:process-stop listener-process) @@ -479,7 +479,7 @@ :content-stream *hunchentoot-stream* :method method :uri url-string - :acceptor-protocol acceptor-protocol)))) + :server-protocol acceptor-protocol)))) (force-output *hunchentoot-stream*) (setq *hunchentoot-stream* (reset-connection-stream *acceptor* *hunchentoot-stream*)) (when *close-hunchentoot-stream* @@ -523,7 +523,7 @@ (dispatch-request *acceptor* *request* *reply*)))) (when error (setf (return-code *reply*) - +http-internal-acceptor-error+)) + +http-internal-server-error+)) (start-output :content (cond (error "An error has occured.") (t body))))

Modified: trunk/thirdparty/hunchentoot/easy-handlers.lisp =================================================================== --- trunk/thirdparty/hunchentoot/easy-handlers.lisp 2009-02-10 10:57:06 UTC (rev 4225) +++ trunk/thirdparty/hunchentoot/easy-handlers.lisp 2009-02-10 11:29:08 UTC (rev 4226) @@ -312,7 +312,7 @@ defined with DEFINE-EASY-HANDLER, if there is one." (loop for (uri server-names easy-handler) in *easy-handler-alist* when (and (or (eq server-names t) - (find (server-name *server*) server-names :test #'eq)) + (find (acceptor-name *acceptor*) server-names :test #'eq)) (cond ((stringp uri) (string= (script-name request) uri)) (t (funcall uri request))))

Modified: trunk/thirdparty/hunchentoot/headers.lisp =================================================================== --- trunk/thirdparty/hunchentoot/headers.lisp 2009-02-10 10:57:06 UTC (rev 4225) +++ trunk/thirdparty/hunchentoot/headers.lisp 2009-02-10 11:29:08 UTC (rev 4226) @@ -84,7 +84,7 @@ ;; Read post data to clear stream - Force binary mode to avoid OCTETS-TO-STRING overhead. (raw-post-data :force-binary t) (let* ((return-code (return-code)) - (chunkedp (and (server-output-chunking-p *server*) + (chunkedp (and (acceptor-output-chunking-p *acceptor*) (eq (server-protocol request) :http/1.1) ;; only turn chunking on if the content ;; length is unknown at this point... @@ -114,7 +114,7 @@ (setf (header-out :transfer-encoding) "chunked")) (cond (keep-alive-p (setf *close-hunchentoot-stream* nil) - (when (and (server-read-timeout *server*) + (when (and (acceptor-read-timeout *acceptor*) (or (not (eq (server-protocol request) :http/1.1)) keep-alive-requested-p)) ;; persistent connections are implicitly assumed for @@ -122,7 +122,7 @@ ;; client has explicitly asked for one (setf (header-out :connection) "Keep-Alive" (header-out :keep-alive) - (format nil "timeout=~D" (server-read-timeout *server*))))) + (format nil "timeout=~D" (acceptor-read-timeout *acceptor*))))) (t (setf (header-out :connection) "Close")))) (unless (and (header-out-set-p :server) (null (header-out :server))) @@ -204,7 +204,7 @@ (write-sequence +crlf+ *hunchentoot-stream*) (maybe-write-to-header-stream "") ;; access log message - (when-let (access-logger (server-access-logger *server*)) + (when-let (access-logger (acceptor-access-logger *acceptor*)) (funcall access-logger :return-code return-code :content content

Modified: trunk/thirdparty/hunchentoot/lispworks.lisp =================================================================== --- trunk/thirdparty/hunchentoot/lispworks.lisp 2009-02-10 10:57:06 UTC (rev 4225) +++ trunk/thirdparty/hunchentoot/lispworks.lisp 2009-02-10 11:29:08 UTC (rev 4226) @@ -79,18 +79,18 @@ (comm:get-socket-peer-address socket) (values (ignore-errors (comm:ip-address-string peer-addr)) peer-port)))

-(defun make-socket-stream (socket server) - "Returns a stream for the socket SOCKET. The SERVER argument is +(defun make-socket-stream (socket acceptor) + "Returns a stream for the socket SOCKET. The ACCEPTOR argument is used to set the timeouts." #-:lispworks5 - (when (server-write-timeout server) + (when (acceptor-write-timeout acceptor) (parameter-error "You need LispWorks 5 or higher for write timeouts.")) (make-instance 'comm:socket-stream :socket socket :direction :io - :read-timeout (server-read-timeout server) + :read-timeout (acceptor-read-timeout acceptor) #+:lispworks5 #+:lispworks5 - :write-timeout (server-write-timeout server) + :write-timeout (acceptor-write-timeout acceptor) :element-type 'octet))

(defun make-lock (name)

Modified: trunk/thirdparty/hunchentoot/log.lisp =================================================================== --- trunk/thirdparty/hunchentoot/log.lisp 2009-02-10 10:57:06 UTC (rev 4225) +++ trunk/thirdparty/hunchentoot/log.lisp 2009-02-10 11:29:08 UTC (rev 4226) @@ -114,7 +114,7 @@ (defun log-message* (log-level format &rest args) "Internal function accepting the same arguments as LOG-MESSAGE and using the message logger of *SERVER* (if there is one)." - (when-let (message-logger (server-message-logger *server*)) + (when-let (message-logger (acceptor-message-logger *acceptor*)) (apply message-logger log-level format args)))

(define-log-file access-log-file *access-log-file* *access-log-pathname*

Modified: trunk/thirdparty/hunchentoot/packages.lisp =================================================================== --- trunk/thirdparty/hunchentoot/packages.lisp 2009-02-10 10:57:06 UTC (rev 4225) +++ trunk/thirdparty/hunchentoot/packages.lisp 2009-02-10 11:29:08 UTC (rev 4226) @@ -62,7 +62,7 @@ "*REPLY*" "*REQUEST*" "*REWRITE-FOR-SESSION-URLS*" - "*SERVER*" + "*ACCEPTOR*" "*SESSION*" "*SESSION-COOKIE-NAME*" "*SESSION-GC-FREQUENCY*" @@ -193,10 +193,10 @@ "SCRIPT-NAME" "SCRIPT-NAME*" "SEND-HEADERS" - "SERVER-ADDRESS" - "SERVER-DISPATCH-TABLE" - "SERVER-NAME" - "SERVER-PORT" + "ACCEPTOR-ADDRESS" + "ACCEPTOR-DISPATCH-TABLE" + "ACCEPTOR-NAME" + "ACCEPTOR-PORT" "SERVER-PROTOCOL" "SERVER-PROTOCOL*" "SESSION-COOKIE-VALUE"

Modified: trunk/thirdparty/hunchentoot/specials.lisp =================================================================== --- trunk/thirdparty/hunchentoot/specials.lisp 2009-02-10 10:57:06 UTC (rev 4225) +++ trunk/thirdparty/hunchentoot/specials.lisp 2009-02-10 11:29:08 UTC (rev 4226) @@ -289,10 +289,6 @@ "During the execution of dispatchers and handlers this variable is bound to the SERVER object which processes the request.")

-(defvar *acceptor-counter* 0 - "Internal counter used to generate meaningful names for -listener threads.") - (defvar *worker-counter* 0 "Internal counter used to generate meaningful names for worker threads.")

Modified: trunk/thirdparty/hunchentoot/ssl.lisp =================================================================== --- trunk/thirdparty/hunchentoot/ssl.lisp 2009-02-10 10:57:06 UTC (rev 4225) +++ trunk/thirdparty/hunchentoot/ssl.lisp 2009-02-10 11:29:08 UTC (rev 4226) @@ -29,30 +29,30 @@

(in-package :hunchentoot)

-(defclass ssl-server (server) +(defclass ssl-acceptor (acceptor) ((ssl-certificate-file :initarg :ssl-certificate-file - :reader server-ssl-certificate-file + :reader acceptor-ssl-certificate-file :documentation "The namestring of a certificate file.") (ssl-privatekey-file :initarg :ssl-privatekey-file - :reader server-ssl-privatekey-file + :reader acceptor-ssl-privatekey-file :documentation "The namestring of a private key file, or NIL if the certificate file contains the private key.") (ssl-privatekey-password #+:lispworks #+:lispworks :initform nil :initarg :ssl-privatekey-password - :reader server-ssl-privatekey-password + :reader acceptor-ssl-privatekey-password :documentation "The password for the private key file or NIL.")) (:default-initargs :port 443 :output-chunking-p nil) (:documentation "This class defines additional slots required to serve requests by SSL"))

-(defmethod initialize-instance :around ((server ssl-server) +(defmethod initialize-instance :around ((acceptor ssl-acceptor) &rest args &key ssl-certificate-file ssl-privatekey-file &allow-other-keys) - (apply #'call-next-method server + (apply #'call-next-method acceptor :ssl-certificate-file (namestring ssl-certificate-file) :ssl-privatekey-file (namestring (or ssl-privatekey-file #+:lispworks @@ -60,8 +60,8 @@ args))

#+lispworks -(defun make-ssl-server-stream (socket-stream &key certificate-file privatekey-file privatekey-password) - "Given the server socket stream SOCKET-STREAM attaches SSL to the +(defun make-ssl-acceptor-stream (socket-stream &key certificate-file privatekey-file privatekey-password) + "Given the acceptor socket stream SOCKET-STREAM attaches SSL to the stream using the certificate file CERTIFICATE-FILE and the private key file PRIVATEKEY-FILE. Both of these values must be namestrings denoting the location of the files. If PRIVATEKEY-PASSWORD is not NIL @@ -81,18 +81,18 @@ socket-stream))

-(defmethod server-ssl-p ((server ssl-server)) +(defmethod acceptor-ssl-p ((acceptor ssl-acceptor)) t)

-(defmethod initialize-connection-stream ((server ssl-server) stream) +(defmethod initialize-connection-stream ((acceptor ssl-acceptor) stream) ;; attach SSL to the stream if necessary - (call-next-method server + (call-next-method acceptor #+:lispworks - (make-ssl-server-stream stream - :certificate-file (server-ssl-certificate-file server) - :privatekey-file (server-ssl-privatekey-file server) - :privatekey-password (server-ssl-privatekey-password server)) + (make-ssl-acceptor-stream stream + :certificate-file (acceptor-ssl-certificate-file acceptor) + :privatekey-file (acceptor-ssl-privatekey-file acceptor) + :privatekey-password (acceptor-ssl-privatekey-password acceptor)) #-:lispworks - (cl+ssl:make-ssl-server-stream stream - :certificate (server-ssl-certificate-file server) - :key (server-ssl-privatekey-file server)))) \ No newline at end of file + (cl+ssl:make-ssl-acceptor-stream stream + :certificate (acceptor-ssl-certificate-file acceptor) + :key (acceptor-ssl-privatekey-file acceptor)))) \ No newline at end of file

Modified: trunk/thirdparty/hunchentoot/test/test.lisp =================================================================== --- trunk/thirdparty/hunchentoot/test/test.lisp 2009-02-10 10:57:06 UTC (rev 4225) +++ trunk/thirdparty/hunchentoot/test/test.lisp 2009-02-10 11:29:08 UTC (rev 4226) @@ -118,8 +118,8 @@ (fmt "~[~;once~;twice~:;~:*~R times~]" (incf count))) " since its handler was compiled.") (info-table (host) - (server-address *server*) - (server-port) + (acceptor-address *acceptor*) + (acceptor-port) (remote-addr*) (remote-port*) (real-remote-addr)

Modified: trunk/thirdparty/hunchentoot/util.lisp =================================================================== --- trunk/thirdparty/hunchentoot/util.lisp 2009-02-10 10:57:06 UTC (rev 4225) +++ trunk/thirdparty/hunchentoot/util.lisp 2009-02-10 11:29:08 UTC (rev 4226) @@ -357,7 +357,7 @@ values of the `Connection' header." (member value connection-values :test #'string-equal))) (let ((keep-alive-requested-p (connection-value-p "keep-alive"))) - (values (and (server-persistent-connections-p *server*) + (values (and (acceptor-persistent-connections-p *acceptor*) (or (and (eq (server-protocol request) :http/1.1) (not (connection-value-p "close"))) (and (eq (server-protocol request) :http/1.0) @@ -372,9 +372,9 @@ +implementation-link+ (escape-for-html (lisp-implementation-type)) (escape-for-html (lisp-implementation-version)) - (or (host *request*) (server-address *server*)) + (or (host *request*) (acceptor-address *acceptor*)) (scan ":\d+$" (or (host *request*) "")) - (server-port))) + (acceptor-port)))

(defun server-name-header () "Returns a string which can be used for 'Server' headers."