[bknr-cvs] edi changed trunk/thirdparty/hunchentoot/
BKNR Commits
bknr at bknr.net
Thu Feb 12 21:18:29 UTC 2009
Revision: 4247
Author: edi
URL: http://bknr.net/trac/changeset/4247
Checkpoint
U trunk/thirdparty/hunchentoot/acceptor.lisp
U trunk/thirdparty/hunchentoot/hunchentoot.asd
U trunk/thirdparty/hunchentoot/log.lisp
U trunk/thirdparty/hunchentoot/packages.lisp
U trunk/thirdparty/hunchentoot/ssl.lisp
Modified: trunk/thirdparty/hunchentoot/acceptor.lisp
===================================================================
--- trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-12 20:54:43 UTC (rev 4246)
+++ trunk/thirdparty/hunchentoot/acceptor.lisp 2009-02-12 21:18:29 UTC (rev 4247)
@@ -268,6 +268,7 @@
(multiple-value-bind (remote-addr remote-port)
(get-peer-address-and-port socket)
(process-request (make-instance (acceptor-request-class *acceptor*)
+ :acceptor *acceptor*
:remote-addr remote-addr
:remote-port remote-port
:headers-in headers-in
@@ -319,7 +320,10 @@
(when error
(setf (return-code *reply*)
+http-internal-server-error+))
- (start-output :content (cond (error
+ (start-output :content (cond ((and error *show-lisp-errors-p*)
+ (format nil "<pre>~A</pre>"
+ (escape-for-html (format nil "~A" error))))
+ (error
"An error has occured.")
(t body))))
t)
Modified: trunk/thirdparty/hunchentoot/hunchentoot.asd
===================================================================
--- trunk/thirdparty/hunchentoot/hunchentoot.asd 2009-02-12 20:54:43 UTC (rev 4246)
+++ trunk/thirdparty/hunchentoot/hunchentoot.asd 2009-02-12 21:18:29 UTC (rev 4247)
@@ -61,10 +61,8 @@
(:file "util")
(:file "url-rewrite")))
(:file "packages")
- #+:lispworks
- (:file "lispworks")
- #-:lispworks
- (:file "compat")
+ #+:lispworks (:file "lispworks")
+ #-:lispworks (:file "compat")
(:file "specials")
(:file "conditions")
(:file "mime-types")
@@ -80,5 +78,4 @@
(:file "set-timeouts")
(:file "connection-dispatcher")
(:file "acceptor")
- #-:hunchentoot-no-ssl
- (:file "ssl")))
+ #-:hunchentoot-no-ssl (:file "ssl")))
Modified: trunk/thirdparty/hunchentoot/log.lisp
===================================================================
--- trunk/thirdparty/hunchentoot/log.lisp 2009-02-12 20:54:43 UTC (rev 4246)
+++ trunk/thirdparty/hunchentoot/log.lisp 2009-02-12 21:18:29 UTC (rev 4247)
@@ -100,7 +100,7 @@
(setf (log-file-pathname ,special-variable) pathname)))))
(define-log-file log-file *log-file* *log-pathname*
- "file to use to log general messages.")
+ "File to use to log general messages.")
(defmethod log-message (log-level format &rest args)
"Sends a formatted message to the file denoted by *LOG-FILE*.
@@ -113,7 +113,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)."
+using the message logger of *ACCEPTOR* \(if there is one)."
(when-let (message-logger (acceptor-message-logger *acceptor*))
(apply message-logger log-level format args)))
Modified: trunk/thirdparty/hunchentoot/packages.lisp
===================================================================
--- trunk/thirdparty/hunchentoot/packages.lisp 2009-02-12 20:54:43 UTC (rev 4246)
+++ trunk/thirdparty/hunchentoot/packages.lisp 2009-02-12 21:18:29 UTC (rev 4247)
@@ -127,6 +127,9 @@
"ACCEPTOR-REQUEST-CLASS"
"ACCEPTOR-REQUEST-DISPATCHER"
"ACCEPTOR-SSL-P"
+ "ACCEPTOR-SSL-CERTIFICATE-FILE"
+ "ACCEPTOR-SSL-PRIVATEKEY-FILE"
+ "ACCEPTOR-SSL-PRIVATEKEY-PASSWORD"
"ACCEPTOR-WRITE-TIMEOUT"
"ACCESS-LOG-FILE"
"AUTHORIZATION"
@@ -231,6 +234,7 @@
"SET-COOKIE"
"SET-COOKIE*"
"SHUTDOWN"
+ "SSL-ACCEPTOR"
"SSL-P"
"START"
"START-LISTENING"
Modified: trunk/thirdparty/hunchentoot/ssl.lisp
===================================================================
--- trunk/thirdparty/hunchentoot/ssl.lisp 2009-02-12 20:54:43 UTC (rev 4246)
+++ trunk/thirdparty/hunchentoot/ssl.lisp 2009-02-12 21:18:29 UTC (rev 4247)
@@ -44,21 +44,38 @@
:reader acceptor-ssl-privatekey-password
:documentation "The password for the
private key file or NIL."))
- (:default-initargs :port 443 :output-chunking-p nil)
+ (:default-initargs
+ :port 443
+ :input-chunking-p nil
+ :output-chunking-p nil)
(:documentation "This class defines additional slots required to
-serve requests by SSL"))
+serve requests via SSL."))
-(defmethod initialize-instance :around ((acceptor ssl-acceptor)
- &rest args
- &key ssl-certificate-file ssl-privatekey-file
- &allow-other-keys)
- (apply #'call-next-method acceptor
- :ssl-certificate-file (namestring ssl-certificate-file)
- :ssl-privatekey-file (namestring (or ssl-privatekey-file
- #+:lispworks
- ssl-certificate-file))
- args))
+;; general implementation
+(defmethod acceptor-ssl-p ((acceptor ssl-acceptor))
+ t)
+
+;; usocket implementation
+
+#-:lispworks
+(defmethod initialize-connection-stream ((acceptor ssl-acceptor) stream)
+ ;; attach SSL to the stream if necessary
+ (call-next-method acceptor
+ (cl+ssl:make-ssl-server-stream stream
+ :certificate (acceptor-ssl-certificate-file acceptor)
+ :key (acceptor-ssl-privatekey-file acceptor))))
+
+;; LispWorks implementation
+
+#+:lispworks
+(defmethod initialize-instance :after ((acceptor ssl-acceptor) &rest initargs)
+ (declare (ignore initargs))
+ ;; LispWorks can read both from the same file, so we can default one
+ (unless (slot-boundp acceptor 'ssl-privatekey-file)
+ (setf (slot-value acceptor 'ssl-privatekey-file)
+ (acceptor-ssl-certificate-file acceptor))))
+
#+lispworks
(defun make-ssl-server-stream (socket-stream &key certificate-file privatekey-file privatekey-password)
"Given the acceptor socket stream SOCKET-STREAM attaches SSL to the
@@ -80,19 +97,11 @@
:ctx-configure-callback #'ctx-configure-callback)
socket-stream))
-
-(defmethod acceptor-ssl-p ((acceptor ssl-acceptor))
- t)
-
+#+:lispworks
(defmethod initialize-connection-stream ((acceptor ssl-acceptor) stream)
;; attach SSL to the stream if necessary
(call-next-method acceptor
- #+:lispworks
(make-ssl-server-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 (acceptor-ssl-certificate-file acceptor)
- :key (acceptor-ssl-privatekey-file acceptor))))
\ No newline at end of file
+ :privatekey-password (acceptor-ssl-privatekey-password acceptor))))
\ No newline at end of file
More information about the Bknr-cvs
mailing list