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