[bknr-cvs] edi changed trunk/thirdparty/hunchentoot/
BKNR Commits
bknr at bknr.net
Tue Feb 10 11:29:08 UTC 2009
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."
More information about the Bknr-cvs
mailing list