- bknr-cvs@common-lisp.net - mailman3.common-lisp.net

[bknr-cvs] edi changed trunk/thirdparty/hunchentoot/
by BKNR Commits 10 Feb '09

10 Feb '09

Revision: 4235 Author: edi URL: http://bknr.net/trac/changeset/4235 Checkpoint U trunk/thirdparty/hunchentoot/acceptor.lisp U trunk/thirdparty/hunchentoot/connection-dispatcher.lisp U trunk/thirdparty/hunchentoot/packages.lisp U trunk/thirdparty/hunchentoot/request.lisp U trunk/thirdparty/hunchentoot/util.lisp Change set too large, please see URL above

1 0

[bknr-cvs] hans changed trunk/thirdparty/hunchentoot/
by BKNR Commits 10 Feb '09

10 Feb '09

Revision: 4234 Author: hans URL: http://bknr.net/trac/changeset/4234 Implement automatic test suite. U trunk/thirdparty/hunchentoot/hunchentoot-test.asd A trunk/thirdparty/hunchentoot/test/script-engine.lisp A trunk/thirdparty/hunchentoot/test/script.lisp A trunk/thirdparty/hunchentoot/test/test-handlers.lisp D trunk/thirdparty/hunchentoot/test/test.lisp Change set too large, please see URL above

1 0

[bknr-cvs] hans changed trunk/thirdparty/drakma/doc/index.html
by BKNR Commits 10 Feb '09

10 Feb '09

Revision: 4233 Author: hans URL: http://bknr.net/trac/changeset/4233 die sprachpolizei, tatue! U trunk/thirdparty/drakma/doc/index.html Modified: trunk/thirdparty/drakma/doc/index.html =================================================================== --- trunk/thirdparty/drakma/doc/index.html 2009-02-10 16:21:06 UTC (rev 4232) +++ trunk/thirdparty/drakma/doc/index.html 2009-02-10 16:22:10 UTC (rev 4233) @@ -805,7 +805,7 @@ the <code>parameters</code> alist can also be pathnames, unary functions, open binary input streams, or lists where the first element is of one of the former types. These values denote files which should -be sent as part of the request body, i.e. if such file designators are +be sent as part of the request body. If such file designators are present in <code>parameters</code>, the content type of the request is always <code>multipart/form-data</code>. If the value denoting a file is a list, the part of the list behind the first

1 0

[bknr-cvs] hans changed trunk/thirdparty/drakma/request.lisp
by BKNR Commits 10 Feb '09

10 Feb '09

Revision: 4232 Author: hans URL: http://bknr.net/trac/changeset/4232 die sprachpolizei, tatue! U trunk/thirdparty/drakma/request.lisp Modified: trunk/thirdparty/drakma/request.lisp =================================================================== --- trunk/thirdparty/drakma/request.lisp 2009-02-10 14:50:32 UTC (rev 4231) +++ trunk/thirdparty/drakma/request.lisp 2009-02-10 16:21:06 UTC (rev 4232) @@ -245,11 +245,11 @@ PARAMETERS alist can also be pathnames, open binary input streams, unary functions, or lists where the first element is of one of the former types. These values denote files which should be sent as part -of the request body, i.e. if files are present in PARAMETERS, the -content type of the request is always `multipart/form-data'. If the -value is a list, the part of the list behind the first element is -treated as a plist which can be used to specify a content type and/or -a filename for the file, i.e. such a value could look like, e.g., +of the request body. If files are present in PARAMETERS, the content +type of the request is always `multipart/form-data'. If the value is +a list, the part of the list behind the first element is treated as a +plist which can be used to specify a content type and/or a filename +for the file, i.e. such a value could look like, e.g., \(#p\"/tmp/my_file.doc\" :content-type \"application/msword\" :filename \"upload.doc\").

1 0

[bknr-cvs] hans changed trunk/thirdparty/
by BKNR Commits 10 Feb '09

10 Feb '09

Revision: 4231 Author: hans URL: http://bknr.net/trac/changeset/4231 Fix cookie parsing. U trunk/thirdparty/chunga/doc/index.html U trunk/thirdparty/chunga/packages.lisp U trunk/thirdparty/drakma/cookies.lisp U trunk/thirdparty/drakma/read.lisp U trunk/thirdparty/drakma/util.lisp Modified: trunk/thirdparty/chunga/doc/index.html =================================================================== --- trunk/thirdparty/chunga/doc/index.html 2009-02-10 14:46:11 UTC (rev 4230) +++ trunk/thirdparty/chunga/doc/index.html 2009-02-10 14:50:32 UTC (rev 4231) @@ -91,6 +91,7 @@ <li><a href="#assert-char"><code>assert-char</code></a> <li><a href="#skip-whitespace"><code>skip-whitespace</code></a> <li><a href="#read-char*"><code>read-char*</code></a> + <li><a href="#peek-char*"><code>peek-char*</code></a> <li><a href="#trim-whitespace"><code>trim-whitespace</code></a> <li><a href="#*current-error-message*"><code>*current-error-message*</code></a> <li><a href="#*accept-bogus-eols*"><code>*accept-bogus-eols*</code></a> @@ -640,6 +641,25 @@  + + + [Function] <a class=none name='peek-char*'>peek-char* stream <tt>&optional</tt> eof-error-p eof-value => boolean</a> +<blockquote> + +Returns a true value if a character can be read from the binary +stream <code>stream</code>. If <code>eof-error-p</code> +has a true value, an error is signalled if no character remains to be +read. <code>eof-value</code> specifies the value to return +if <code>eof-error-p</code> is false and the end of the file +has been reached. + +See <a href="#with-character-stream-semantics"><code>WITH-CHARACTER-STREAM-SEMANTICS</code></a>. + +</blockquote> + + + +  [Function] <a class=none name='trim-whitespace'>trim-whitespace string => string'</a> Modified: trunk/thirdparty/chunga/packages.lisp =================================================================== --- trunk/thirdparty/chunga/packages.lisp 2009-02-10 14:46:11 UTC (rev 4230) +++ trunk/thirdparty/chunga/packages.lisp 2009-02-10 14:50:32 UTC (rev 4231) @@ -54,6 +54,7 @@ :input-chunking-unexpected-end-of-file :make-chunked-stream :read-http-headers + :peek-char* :read-char* :read-line* :read-name-value-pair Modified: trunk/thirdparty/drakma/cookies.lisp =================================================================== --- trunk/thirdparty/drakma/cookies.lisp 2009-02-10 14:46:11 UTC (rev 4230) +++ trunk/thirdparty/drakma/cookies.lisp 2009-02-10 14:50:32 UTC (rev 4231) @@ -249,7 +249,7 @@ of three-element lists where each one contains the name of the cookie, the value of the cookie, and an attribute/value list for the optional cookie parameters." - (with-input-from-string (stream string) + (with-sequence-from-string (stream string) (loop with *current-error-message* = (format nil "While parsing cookie header ~S:" string) for first = t then nil for next = (and (skip-whitespace stream) Modified: trunk/thirdparty/drakma/read.lisp =================================================================== --- trunk/thirdparty/drakma/read.lisp 2009-02-10 14:46:11 UTC (rev 4230) +++ trunk/thirdparty/drakma/read.lisp 2009-02-10 14:50:32 UTC (rev 4231) @@ -60,7 +60,7 @@ HTTP-REQUEST. Returns NIL if there is no such header amongst HEADERS." (when-let (content-type (header-value :content-type headers)) - (with-input-from-sequence (stream (map 'list 'char-code content-type)) + (with-sequence-from-string (stream content-type) (let* ((*current-error-message* "Corrupted Content-Type header:") (type (read-token stream)) (subtype (and (assert-char stream #\/) @@ -80,8 +80,8 @@ "Reads and consumes from STREAM any number of commas and whitespace. Returns the following character or NIL in case of END-OF-FILE." - (loop while (eql (peek-char nil stream nil) #\,) - do (read-char stream) (skip-whitespace stream)) + (loop while (eql (peek-char* stream nil) #\,) + do (read-char* stream) (skip-whitespace stream)) (skip-whitespace stream)) (defun read-tokens-and-parameters (string &key (value-required-p t)) @@ -94,7 +94,7 @@ \(the attribute/value pairs). If VALUE-REQUIRED-P is NIL, the value part \(including the #\\= character) of each attribute/value pair is optional." - (with-input-from-string (stream string) + (with-sequence-from-string (stream string) (loop with *current-error-message* = (format nil "While parsing ~S:" string) for first = t then nil for next = (and (skip-whitespace stream) Modified: trunk/thirdparty/drakma/util.lisp =================================================================== --- trunk/thirdparty/drakma/util.lisp 2009-02-10 14:46:11 UTC (rev 4230) +++ trunk/thirdparty/drakma/util.lisp 2009-02-10 14:50:32 UTC (rev 4231) @@ -274,3 +274,9 @@ (or (null candidate-subtype) (string-equal subtype candidate-subtype))))) +(defmacro with-sequence-from-string ((stream string) &body body) + "Kludge to make Chunga tokenizing functionality usable. Works like + WITH-INPUT-FROM-STRING, but creates a sequence of octets that works + with CHUNGA::PEEK-CHAR* and friends." + `(flex:with-input-from-sequence (,stream (map 'list #'char-code ,string)) + ,@body)) \ No newline at end of file

1 0

[bknr-cvs] edi changed trunk/thirdparty/hunchentoot/
by BKNR Commits 10 Feb '09

10 Feb '09

Revision: 4230 Author: edi URL: http://bknr.net/trac/changeset/4230 Checkpoint U trunk/thirdparty/hunchentoot/acceptor.lisp U trunk/thirdparty/hunchentoot/connection-dispatcher.lisp U trunk/thirdparty/hunchentoot/packages.lisp Modified: trunk/thirdparty/hunchentoot/acceptor.lisp =================================================================== --- trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-10 14:25:30 UTC (rev 4229) +++ trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-10 14:46:11 UTC (rev 4230) @@ -32,12 +32,10 @@ (defclass acceptor () ((port :initarg :port :reader acceptor-port - :documentation "The port the acceptor is listening on. -See START-SERVER.") + :documentation "The port the acceptor is listening on.") (address :initarg :address :reader acceptor-address - :documentation "The address the acceptor is listening -on. See START-SERVER.") + :documentation "The address the acceptor is listening on.") (name :initarg :name :accessor acceptor-name :documentation "The optional name of the acceptor, a symbol.") @@ -46,10 +44,10 @@ :documentation "Determines which class of request objects is created when a request comes in and should be \(a symbol naming) a class which inherits from REQUEST.") - (dispatch-table :initarg :dispatch-table - :accessor acceptor-dispatch-table - :documentation "The dispatch-table used by this -acceptor. Can be NIL to denote that *DISPATCH-TABLE* should be used.") + (request-dispatcher :initarg :request-dispatcher + :accessor acceptor-request-dispatcher + :documentation "The dispatcher function used by +this acceptor.") (output-chunking-p :initarg :output-chunking-p :reader acceptor-output-chunking-p :documentation "Whether the acceptor may use output chunking.") @@ -71,28 +69,28 @@ semantics of this parameter is determined by the underlying Lisp's implementation of socket timeouts.") (write-timeout :initarg :write-timeout - :reader acceptor-write-timeout - :documentation "The connection timeout of the acceptor, + :reader acceptor-write-timeout + :documentation "The connection timeout of the acceptor, specified in (fractional) seconds. The precise semantics of this parameter is determined by the underlying Lisp's implementation of socket timeouts.") (connection-dispatcher :initarg :connection-dispatcher - :initform nil - :reader acceptor-connection-dispatcher - :documentation "The connection dispatcher that is + :initform nil + :reader acceptor-connection-dispatcher + :documentation "The connection dispatcher that is responsible for listening to new connections and scheduling them for execution.") #+:lispworks - (acceptor :accessor acceptor-acceptor - :documentation "The Lisp process which accepts incoming + (process :accessor acceptor-process + :documentation "The Lisp process which accepts incoming requests.") #-:lispworks (listen-socket :accessor acceptor-listen-socket :documentation "The listen socket for incoming connections.") (acceptor-shutdown-p :initform nil - :accessor acceptor-shutdown-p - :documentation "Flag that makes the acceptor + :accessor acceptor-shutdown-p + :documentation "Flag that makes the acceptor shutdown itself when set to something other than NIL.") (access-logger :initarg :access-logger :accessor acceptor-access-logger @@ -120,66 +118,12 @@ :request-class 'request :output-chunking-p t :input-chunking-p t - :dispatch-table nil + :request-dispatcher 'dispatch-request :access-logger 'log-access :message-logger 'log-message) (:documentation "An object of this class contains all relevant information about a running Hunchentoot acceptor instance.")) -(defmethod initialize-instance :after ((acceptor acceptor) - &key connection-dispatcher-class - connection-dispatcher-arguments - (threaded *supports-threads-p* threaded-specified-p) - (persistent-connections-p - threaded - persistent-connections-specified-p) - (connection-timeout - *default-connection-timeout* - connection-timeout-provided-p) - (read-timeout nil read-timeout-provided-p) - (write-timeout nil write-timeout-provided-p)) - "The CONNECTION-DISPATCHER-CLASS and CONNECTION-DISPATCHER-ARGUMENTS -arguments to the creation of a acceptor instance determine the -connection dispatcher instance that is created. THREADED is the user -friendly version of the CONNECTION-DISPATCHER-CLASS option. If it is -NIL, an unthreaded connection dispatcher is used. It is an error to -specify both THREADED and a CONNECTION-DISPATCHER-CLASS argument. - -The PERSISTENT-CONNECTIONS-P keyword argument defaults to the value of -the THREADED keyword argument but can be overridden. - -If a neither READ-TIMEOUT nor WRITE-TIMEOUT are specified by the user, -the acceptor's read and write timeouts default to the CONNECTION-TIMEOUT -value. If either of READ-TIMEOUT or WRITE-TIMEOUT is specified, -CONNECTION-TIMEOUT is not used and may not be supplied." - (declare (ignore read-timeout write-timeout)) - (when (and threaded-specified-p connection-dispatcher-class) - (parameter-error "Can't use both THREADED and CONNECTION-DISPATCHER-CLASS arguments.")) - (unless persistent-connections-specified-p - (setf (acceptor-persistent-connections-p acceptor) persistent-connections-p)) - (unless (acceptor-connection-dispatcher acceptor) - (setf (slot-value acceptor 'connection-dispatcher) - (apply #'make-instance - (or connection-dispatcher-class - (if threaded - 'one-thread-per-connection-dispatcher - 'single-threaded-connection-dispatcher)) - :acceptor acceptor - connection-dispatcher-arguments))) - (if (or read-timeout-provided-p write-timeout-provided-p) - (when connection-timeout-provided-p - (parameter-error "Can't have both CONNECTION-TIMEOUT and either of READ-TIMEOUT and WRITE-TIMEOUT.")) - (setf (slot-value acceptor 'read-timeout) connection-timeout - (slot-value acceptor 'write-timeout) connection-timeout))) - -(defgeneric acceptor-ssl-p (acceptor) - (:documentation "Returns a true value if ACCEPTOR is an SSL acceptor.") - (:method ((acceptor t)) - nil)) - -(defun ssl-p (&optional (acceptor *acceptor*)) - (acceptor-ssl-p acceptor)) - (defmethod print-object ((acceptor acceptor) stream) (print-unreadable-object (acceptor stream :type t) (format stream "\(host ~A, port ~A)" @@ -347,7 +291,7 @@ (when startup-condition (error startup-condition)) (mp:process-stop listener-process) - (setf (acceptor-acceptor acceptor) listener-process)) + (setf (acceptor-process acceptor) listener-process)) #-:lispworks (setf (acceptor-listen-socket acceptor) (usocket:socket-listen (or (acceptor-address acceptor) @@ -362,7 +306,7 @@ using HANDLE-INCOMING-CONNECTION.") (:method ((acceptor acceptor)) #+:lispworks - (mp:process-unstop (acceptor-acceptor acceptor)) + (mp:process-unstop (acceptor-process acceptor)) #-:lispworks (usocket:with-acceptor-socket (listener (acceptor-listen-socket acceptor)) (loop @@ -405,6 +349,7 @@ (chunked-stream-stream stream)) (t stream)))) +;;; TODO (defgeneric dispatch-request (acceptor request reply) (:documentation "") (:method (acceptor request reply) Modified: trunk/thirdparty/hunchentoot/connection-dispatcher.lisp =================================================================== --- trunk/thirdparty/hunchentoot/connection-dispatcher.lisp 2009-02-10 14:25:30 UTC (rev 4229) +++ trunk/thirdparty/hunchentoot/connection-dispatcher.lisp 2009-02-10 14:46:11 UTC (rev 4230) @@ -65,13 +65,7 @@ (defgeneric shutdown (connection-dispatcher) (:documentation "Terminate all threads that are currently associated -with the connection dispatcher, if any.") - (:method ((dispatcher t)) - #+:lispworks - (when-let (acceptor (acceptor-acceptor (acceptor dispatcher))) - ;; kill the main acceptor process, see LW documentation for - ;; COMM:START-UP-SERVER - (mp:process-kill acceptor)))) +with the connection dispatcher, if any.")) (defclass single-threaded-connection-dispatcher (connection-dispatcher) () @@ -87,16 +81,27 @@ (defclass one-thread-per-connection-dispatcher (connection-dispatcher) ((acceptor-process :accessor acceptor-process :documentation "Process that accepts incoming - connections and dispatches them to new processes - for request execution.")) +connections and dispatches them to new processes for request +execution.")) (:documentation "Connection Dispatcher that starts one thread for listening to incoming requests and one thread for each incoming connection.")) +;; usocket implementation + +#-:lispworks +(defmethod shutdown ((dispatcher connection-dispatcher))) + +#-:lispworks +(defmethod shutdown ((dispatcher one-thread-per-connection-dispatcher)) + ;; just wait until the acceptor process has finished, then return + (loop + (unless (bt:thread-alive-p (acceptor-process dispatcher)) + (return)) + (sleep 1))) + +#-:lispworks (defmethod execute-acceptor ((dispatcher one-thread-per-connection-dispatcher)) - #+:lispworks - (accept-connections (acceptor dispatcher)) - #-:lispworks (setf (acceptor-process dispatcher) (bt:make-thread (lambda () (accept-connections (acceptor dispatcher))) @@ -105,12 +110,34 @@ (acceptor-port (acceptor dispatcher)))))) #-:lispworks -(defmethod shutdown ((dispatcher one-thread-per-connection-dispatcher)) - (loop - while (bt:thread-alive-p (acceptor-process dispatcher)) - do (sleep 1))) +(defun client-as-string (socket) + (let ((address (usocket:get-peer-address socket)) + (port (usocket:get-peer-port socket))) + (when (and address port) + (format nil "~A:~A" + (usocket:vector-quad-to-dotted-quad address) + port)))) +#-:lispworks +(defmethod handle-incoming-connection ((dispatcher one-thread-per-connection-dispatcher) socket) + (bt:make-thread (lambda () + (process-connection (acceptor dispatcher) socket)) + :name (format nil "Hunchentoot worker \(client: ~A)" (client-as-string socket)))) + +;; LispWorks implementation + #+:lispworks +(defmethod shutdown ((dispatcher connection-dispatcher)) + (when-let (process (acceptor-process (acceptor dispatcher))) + ;; kill the main acceptor process, see LW documentation for + ;; COMM:START-UP-SERVER + (mp:process-kill process))) + +#+:lispworks +(defmethod execute-acceptor ((dispatcher one-thread-per-connection-dispatcher)) + (accept-connections (acceptor dispatcher))) + +#+:lispworks (defmethod handle-incoming-connection ((dispatcher one-thread-per-connection-dispatcher) handle) (incf *worker-counter*) ;; check if we need to perform a global GC @@ -123,18 +150,3 @@ (get-peer-address-and-port handle))) nil #'process-connection (acceptor dispatcher) handle)) - -#-:lispworks -(defun client-as-string (socket) - (let ((address (usocket:get-peer-address socket)) - (port (usocket:get-peer-port socket))) - (when (and address port) - (format nil "~A:~A" - (usocket:vector-quad-to-dotted-quad address) - port)))) - -#-:lispworks -(defmethod handle-incoming-connection ((dispatcher one-thread-per-connection-dispatcher) socket) - (bt:make-thread (lambda () - (process-connection (acceptor dispatcher) socket)) - :name (format nil "Hunchentoot worker \(client: ~A)" (client-as-string socket)))) Modified: trunk/thirdparty/hunchentoot/packages.lisp =================================================================== --- trunk/thirdparty/hunchentoot/packages.lisp 2009-02-10 14:25:30 UTC (rev 4229) +++ trunk/thirdparty/hunchentoot/packages.lisp 2009-02-10 14:46:11 UTC (rev 4230) @@ -143,9 +143,11 @@ "DISPATCH-REQUEST" "DO-SESSIONS" "ESCAPE-FOR-HTML" + "EXECUTE-ACCEPTOR" "GET-PARAMETER" "GET-PARAMETERS" "GET-PARAMETERS*" + "HANDLE-INCOMING-CONNECTION" "HANDLE-IF-MODIFIED-SINCE" "HANDLE-STATIC-FILE" "HANDLER-DONE" @@ -194,7 +196,7 @@ "SCRIPT-NAME*" "SEND-HEADERS" "ACCEPTOR-ADDRESS" - "ACCEPTOR-DISPATCH-TABLE" + "ACCEPTOR-REQUEST-DISPATCHER" "ACCEPTOR-NAME" "ACCEPTOR-PORT" "SERVER-PROTOCOL" @@ -209,10 +211,10 @@ "SESSION-VALUE" "SET-COOKIE" "SET-COOKIE*" - "SSL-P" - "START-SERVER" + "SHUTDOWN" + "START" "START-SESSION" - "STOP-SERVER" + "STOP" "URL-DECODE" "URL-ENCODE" "USER-AGENT"))

1 0

[bknr-cvs] hans changed trunk/thirdparty/chunga/
by BKNR Commits 10 Feb '09

10 Feb '09

Revision: 4229 Author: hans URL: http://bknr.net/trac/changeset/4229 revert 4228 U trunk/thirdparty/chunga/doc/index.html U trunk/thirdparty/chunga/packages.lisp Modified: trunk/thirdparty/chunga/doc/index.html =================================================================== --- trunk/thirdparty/chunga/doc/index.html 2009-02-10 13:46:48 UTC (rev 4228) +++ trunk/thirdparty/chunga/doc/index.html 2009-02-10 14:25:30 UTC (rev 4229) @@ -89,7 +89,9 @@ <li><a href="#read-name-value-pair"><code>read-name-value-pair</code></a> <li><a href="#read-name-value-pairs"><code>read-name-value-pairs</code></a> <li><a href="#assert-char"><code>assert-char</code></a> + <li><a href="#skip-whitespace"><code>skip-whitespace</code></a> <li><a href="#read-char*"><code>read-char*</code></a> + <li><a href="#trim-whitespace"><code>trim-whitespace</code></a> <li><a href="#*current-error-message*"><code>*current-error-message*</code></a> <li><a href="#*accept-bogus-eols*"><code>*accept-bogus-eols*</code></a> <li><a href="#*treat-semicolon-as-continuation*"><code>*treat-semicolon-as-continuation*</code></a> @@ -605,6 +607,25 @@  + + + [Function] <a class=none name='skip-whitespace'>skip-whitespace stream => char-or-nil</a> +<blockquote> + +Consume characters from the binary stream <code>stream</code> until an <a +href="http://www.lispworks.com/documentation/HyperSpec/Body/e_end_of.htm"><code>END-OF-FILE</code></a> is +encountered or a non-whitespace (according to <a href="http://www.rfc.net/rfc2616.html">RFC 2616</a>) +characters is seen. This character is returned (or <code>NIL</code> in case +of <a +href="http://www.lispworks.com/documentation/HyperSpec/Body/e_end_of.htm"><code>END-OF-FILE</code></a>). + +See <a href="#with-character-stream-semantics"><code>WITH-CHARACTER-STREAM-SEMANTICS</code></a>. + +</blockquote> + + + +  [Function] <a class=none name='read-char*'>read-char* stream => char</a> @@ -619,6 +640,19 @@  + + + [Function] <a class=none name='trim-whitespace'>trim-whitespace string => string'</a> +<blockquote> + +Returns a version of the string <code>string</code> where spaces and tab +characters are trimmed from the start and the end. + +</blockquote> + + + +  [Special variable] <a class=none name='*current-error-message*'>*current-error-message*</a> Modified: trunk/thirdparty/chunga/packages.lisp =================================================================== --- trunk/thirdparty/chunga/packages.lisp 2009-02-10 13:46:48 UTC (rev 4228) +++ trunk/thirdparty/chunga/packages.lisp 2009-02-10 14:25:30 UTC (rev 4229) @@ -59,6 +59,8 @@ :read-name-value-pair :read-name-value-pairs :read-token + :skip-whitespace :syntax-error + :trim-whitespace :with-character-stream-semantics))

1 0

[bknr-cvs] hans changed trunk/thirdparty/chunga/
by BKNR Commits 10 Feb '09

10 Feb '09

Revision: 4228 Author: hans URL: http://bknr.net/trac/changeset/4228 Unexport SKIP-WHITESPACE and TRIM-WHITESPACE U trunk/thirdparty/chunga/doc/index.html U trunk/thirdparty/chunga/packages.lisp Modified: trunk/thirdparty/chunga/doc/index.html =================================================================== --- trunk/thirdparty/chunga/doc/index.html 2009-02-10 11:48:19 UTC (rev 4227) +++ trunk/thirdparty/chunga/doc/index.html 2009-02-10 13:46:48 UTC (rev 4228) @@ -89,9 +89,7 @@ <li><a href="#read-name-value-pair"><code>read-name-value-pair</code></a> <li><a href="#read-name-value-pairs"><code>read-name-value-pairs</code></a> <li><a href="#assert-char"><code>assert-char</code></a> - <li><a href="#skip-whitespace"><code>skip-whitespace</code></a> <li><a href="#read-char*"><code>read-char*</code></a> - <li><a href="#trim-whitespace"><code>trim-whitespace</code></a> <li><a href="#*current-error-message*"><code>*current-error-message*</code></a> <li><a href="#*accept-bogus-eols*"><code>*accept-bogus-eols*</code></a> <li><a href="#*treat-semicolon-as-continuation*"><code>*treat-semicolon-as-continuation*</code></a> @@ -607,25 +605,6 @@  - - - [Function] <a class=none name='skip-whitespace'>skip-whitespace stream => char-or-nil</a> -<blockquote> - -Consume characters from the binary stream <code>stream</code> until an <a -href="http://www.lispworks.com/documentation/HyperSpec/Body/e_end_of.htm"><code>END-OF-FILE</code></a> is -encountered or a non-whitespace (according to <a href="http://www.rfc.net/rfc2616.html">RFC 2616</a>) -characters is seen. This character is returned (or <code>NIL</code> in case -of <a -href="http://www.lispworks.com/documentation/HyperSpec/Body/e_end_of.htm"><code>END-OF-FILE</code></a>). - -See <a href="#with-character-stream-semantics"><code>WITH-CHARACTER-STREAM-SEMANTICS</code></a>. - -</blockquote> - - - -  [Function] <a class=none name='read-char*'>read-char* stream => char</a> @@ -640,19 +619,6 @@  - - - [Function] <a class=none name='trim-whitespace'>trim-whitespace string => string'</a> -<blockquote> - -Returns a version of the string <code>string</code> where spaces and tab -characters are trimmed from the start and the end. - -</blockquote> - - - -  [Special variable] <a class=none name='*current-error-message*'>*current-error-message*</a> Modified: trunk/thirdparty/chunga/packages.lisp =================================================================== --- trunk/thirdparty/chunga/packages.lisp 2009-02-10 11:48:19 UTC (rev 4227) +++ trunk/thirdparty/chunga/packages.lisp 2009-02-10 13:46:48 UTC (rev 4228) @@ -59,8 +59,6 @@ :read-name-value-pair :read-name-value-pairs :read-token - :skip-whitespace :syntax-error - :trim-whitespace :with-character-stream-semantics))

1 0

[bknr-cvs] edi changed trunk/thirdparty/hunchentoot/
by BKNR Commits 10 Feb '09

10 Feb '09

Revision: 4227 Author: edi URL: http://bknr.net/trac/changeset/4227 More U trunk/thirdparty/hunchentoot/acceptor.lisp U trunk/thirdparty/hunchentoot/connection-dispatcher.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 11:29:08 UTC (rev 4226) +++ trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-10 11:48:19 UTC (rev 4227) @@ -31,9 +31,11 @@ (defclass acceptor () ((port :initarg :port + :reader acceptor-port :documentation "The port the acceptor is listening on. See START-SERVER.") (address :initarg :address + :reader acceptor-address :documentation "The address the acceptor is listening on. See START-SERVER.") (name :initarg :name @@ -183,14 +185,6 @@ (format stream "\(host ~A, port ~A)" (or (acceptor-address acceptor) "*") (acceptor-port acceptor)))) -(defun acceptor-address (&optional (acceptor *acceptor*)) - "Returns the address at which the current request arrived." - (slot-value acceptor 'address)) - -(defun acceptor-port (&optional (acceptor *acceptor*)) - "Returns the port at which the current request arrived." - (slot-value acceptor 'port)) - (defgeneric start (acceptor) (:documentation "Start the ACCEPTOR so that it begins accepting connections.") Modified: trunk/thirdparty/hunchentoot/connection-dispatcher.lisp =================================================================== --- trunk/thirdparty/hunchentoot/connection-dispatcher.lisp 2009-02-10 11:29:08 UTC (rev 4226) +++ trunk/thirdparty/hunchentoot/connection-dispatcher.lisp 2009-02-10 11:48:19 UTC (rev 4227) @@ -29,13 +29,10 @@ (in-package :hunchentoot) -;;; The connection-dispatcher protocol defines how Hunchentoot schedules -;;; request execution to worker threads or for inline execution. - (defclass connection-dispatcher () ((acceptor :initarg :acceptor - :reader acceptor - :documentation "The Hunchentoot acceptor instance that this + :reader acceptor + :documentation "The acceptor instance that this connection dispatcher works for.")) (:documentation "Base class for all connection dispatchers classes. Its purpose is to carry the back pointer to the acceptor instance.")) @@ -69,9 +66,9 @@ (defgeneric shutdown (connection-dispatcher) (:documentation "Terminate all threads that are currently associated with the connection dispatcher, if any.") - (:method ((manager t)) + (:method ((dispatcher t)) #+:lispworks - (when-let (acceptor (acceptor-acceptor (acceptor manager))) + (when-let (acceptor (acceptor-acceptor (acceptor dispatcher))) ;; kill the main acceptor process, see LW documentation for ;; COMM:START-UP-SERVER (mp:process-kill acceptor)))) @@ -81,11 +78,11 @@ (:documentation "Connection Dispatcher that runs synchronously in the thread that invoked the START-SERVER function.")) -(defmethod execute-acceptor ((manager single-threaded-connection-dispatcher)) - (accept-connections (acceptor manager))) +(defmethod execute-acceptor ((dispatcher single-threaded-connection-dispatcher)) + (accept-connections (acceptor dispatcher))) -(defmethod handle-incoming-connection ((manager single-threaded-connection-dispatcher) socket) - (process-connection (acceptor manager) socket)) +(defmethod handle-incoming-connection ((dispatcher single-threaded-connection-dispatcher) socket) + (process-connection (acceptor dispatcher) socket)) (defclass one-thread-per-connection-dispatcher (connection-dispatcher) ((acceptor-process :accessor acceptor-process @@ -96,25 +93,25 @@ listening to incoming requests and one thread for each incoming connection.")) -(defmethod execute-acceptor ((manager one-thread-per-connection-dispatcher)) +(defmethod execute-acceptor ((dispatcher one-thread-per-connection-dispatcher)) #+:lispworks - (accept-connections (acceptor manager)) + (accept-connections (acceptor dispatcher)) #-:lispworks - (setf (acceptor-process manager) + (setf (acceptor-process dispatcher) (bt:make-thread (lambda () - (accept-connections (acceptor manager))) + (accept-connections (acceptor dispatcher))) :name (format nil "Hunchentoot acceptor \(~A:~A)" - (or (acceptor-address (acceptor manager)) "*") - (acceptor-port (acceptor manager)))))) + (or (acceptor-address (acceptor dispatcher)) "*") + (acceptor-port (acceptor dispatcher)))))) #-:lispworks -(defmethod shutdown ((manager one-thread-per-connection-dispatcher)) +(defmethod shutdown ((dispatcher one-thread-per-connection-dispatcher)) (loop - while (bt:thread-alive-p (acceptor-process manager)) + while (bt:thread-alive-p (acceptor-process dispatcher)) do (sleep 1))) #+:lispworks -(defmethod handle-incoming-connection ((manager one-thread-per-connection-dispatcher) handle) +(defmethod handle-incoming-connection ((dispatcher one-thread-per-connection-dispatcher) handle) (incf *worker-counter*) ;; check if we need to perform a global GC (when (and *cleanup-interval* @@ -125,7 +122,7 @@ (multiple-value-list (get-peer-address-and-port handle))) nil #'process-connection - (acceptor manager) handle)) + (acceptor dispatcher) handle)) #-:lispworks (defun client-as-string (socket) @@ -137,7 +134,7 @@ port)))) #-:lispworks -(defmethod handle-incoming-connection ((manager one-thread-per-connection-dispatcher) socket) +(defmethod handle-incoming-connection ((dispatcher one-thread-per-connection-dispatcher) socket) (bt:make-thread (lambda () - (process-connection (acceptor manager) socket)) + (process-connection (acceptor dispatcher) socket)) :name (format nil "Hunchentoot worker \(client: ~A)" (client-as-string socket)))) Modified: trunk/thirdparty/hunchentoot/test/test.lisp =================================================================== --- trunk/thirdparty/hunchentoot/test/test.lisp 2009-02-10 11:29:08 UTC (rev 4226) +++ trunk/thirdparty/hunchentoot/test/test.lisp 2009-02-10 11:48:19 UTC (rev 4227) @@ -119,7 +119,7 @@ " since its handler was compiled.") (info-table (host) (acceptor-address *acceptor*) - (acceptor-port) + (acceptor-port *acceptor*) (remote-addr*) (remote-port*) (real-remote-addr) Modified: trunk/thirdparty/hunchentoot/util.lisp =================================================================== --- trunk/thirdparty/hunchentoot/util.lisp 2009-02-10 11:29:08 UTC (rev 4226) +++ trunk/thirdparty/hunchentoot/util.lisp 2009-02-10 11:48:19 UTC (rev 4227) @@ -374,7 +374,7 @@ (escape-for-html (lisp-implementation-version)) (or (host *request*) (acceptor-address *acceptor*)) (scan ":\\d+$" (or (host *request*) "")) - (acceptor-port))) + (acceptor-port *acceptor*))) (defun server-name-header () "Returns a string which can be used for 'Server' headers."

1 0

[bknr-cvs] edi changed trunk/thirdparty/hunchentoot/
by BKNR Commits 10 Feb '09

10 Feb '09

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."

1 0