Author: achiumenti Date: Wed Nov 12 07:07:31 2008 New Revision: 135 Log: hunchentoot connector package/system renaming Added: trunk/main/connectors/claw-hunchentoot-connector/ trunk/main/connectors/claw-hunchentoot-connector/claw-hunchentoot-connector.asd trunk/main/connectors/claw-hunchentoot-connector/src/ trunk/main/connectors/claw-hunchentoot-connector/src/hunchentoot.lisp trunk/main/connectors/claw-hunchentoot-connector/src/packages.lisp Added: trunk/main/connectors/claw-hunchentoot-connector/claw-hunchentoot-connector.asd ============================================================================== --- (empty file) +++ trunk/main/connectors/claw-hunchentoot-connector/claw-hunchentoot-connector.asd Wed Nov 12 07:07:31 2008 @@ -0,0 +1,37 @@ +;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- +;;; $Header: claw.asd $ + +;;; Copyright (c) 2008, Andrea Chiumenti. All rights reserved. + +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: + +;;; * Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. + +;;; * Redistributions in binary form must reproduce the above +;;; copyright notice, this list of conditions and the following +;;; disclaimer in the documentation and/or other materials +;;; provided with the distribution. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE +;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +(asdf:defsystem :claw-hunchentoot-connector + :name "claw-hunchentoot-connector" + :author "Andrea Chiumenti" + :description "Hunchentoot connector for CLAW application server" + :depends-on (:hunchentoot :claw-as) + :components ((:module src + :components ((:file "packages") + (:file "hunchentoot" :depends-on ("packages")))))) Added: trunk/main/connectors/claw-hunchentoot-connector/src/hunchentoot.lisp ============================================================================== --- (empty file) +++ trunk/main/connectors/claw-hunchentoot-connector/src/hunchentoot.lisp Wed Nov 12 07:07:31 2008 @@ -0,0 +1,395 @@ +;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- +;;; $Header: src/hunchentoot.lisp $ + +;;; Copyright (c) 2008, Andrea Chiumenti. All rights reserved. + +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: + +;;; * Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. + +;;; * Redistributions in binary form must reproduce the above +;;; copyright notice, this list of conditions and the following +;;; disclaimer in the documentation and/or other materials +;;; provided with the distribution. + +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE +;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +(in-package :claw-hunchentoot-connector) + +(setf hunchentoot:*hunchentoot-default-external-format* (flex:make-external-format :utf-8 :eol-style :lf) + hunchentoot:*default-content-type* "text/html; charset=utf-8" + hunchentoot:*handle-http-errors-p* nil) + +(defgeneric hunchentoot-to-claw-cookie (hunchentoot-cookie) + (:documentation "Returns a claw cookie from a hunchentoot cookie")) + +(defgeneric (setf hunchentoot-connector-mod-lisp-p) (mod-lisp-p hunchentoot-connector) + (:documentation "When not null binds the claw server to apache using mod_lisp2. When server is started an error will be signaled.")) + +(defgeneric (setf hunchentoot-connector-use-apache-log-p) (apache-log-p hunchentoot-connector) + (:documentation "When boud to apache with mod_lisp2 if not nil, uses apache logging. When server is started an error will be signaled.")) + +(defgeneric (setf hunchentoot-connector-input-chunking-p) (input-chunking-p hunchentoot-connector) + (:documentation "Sets input-chunking-p, when true the server will accept request +bodies without a Content-Length header if the client uses chunked transfer encoding. +If you want to use this feature behind mod_lisp, you should make sure that your combination of +Apache and mod_lisp can cope with that. When server is started an error will be signaled.")) + +(defgeneric (setf hunchentoot-connector-read-timeout) (read-timeout hunchentoot-connector) + (:documentation "Sets the read timeout in seconds. When server is started an error will be signaled.")) + +(defgeneric (setf hunchentoot-connector-write-timeout) (write-timeout hunchentoot-connector) + (:documentation "Sets the write timeout in seconds. When server is started an error will be signaled.")) + +#+(and :unix (not :win32)) (defgeneric (setf hunchentoot-connector-setuid) (setuid hunchentoot-connector) + (:documentation "Sets the uid under which the server runs (Only for *NIX). When server is started an error will be signaled.")) + +#+(and :unix (not :win32)) (defgeneric (setf hunchentoot-connector-setgid) (setgid hunchentoot-connector) + (:documentation "Sets the gid under which the server runs (Only for *NIX). When server is started an error will be signaled.")) + +#-:hunchentoot-no-ssl (defgeneric (setf hunchentoot-connector-ssl-certificate-file) (certificate-file hunchentoot-connector) + (:documentation "The ssl certificate file for https connections. When server is started an error will be signaled.")) + +#-:hunchentoot-no-ssl (defgeneric (setf hunchentoot-connector-ssl-privatekey-file) (ssl-privatekey-file hunchentoot-connector) + (:documentation "The ssl private key file for https connections. When server is started an error will be signaled.")) + +#-:hunchentoot-no-ssl (defgeneric (setf hunchentoot-connector-ssl-privatekey-password) (ssl-privatekey-password hunchentoot-connector) + (:documentation "The password for the ssl private key file. When server is started an error will be signaled.")) + +(setf hunchentoot:*http-error-handler* nil) + +(defclass hunchentoot-connector (connector) + ((mod-lisp-p :initarg :mod-lisp-p + :reader hunchentoot-connector-mod-lisp-p + :documentation "Returns not nil when the server is bound to apache through mod_lisp") + (use-apache-log-p :initarg :use-apache-log-p + :reader hunchentoot-connector-use-apache-log-p + :documentation "Returns not nil when the server uses apache logging") + (input-chunking-p :initarg :input-chunking-p + :reader hunchentoot-connector-input-chunking-p + :documentation "When true the server will accept request +bodies without a Content-Length header if the client uses chunked transfer encoding. +If you want to use this feature behind mod_lisp, you should make sure that your combination of +Apache and mod_lisp can cope with that.") + (read-timeout :initarg :read-timeout + :reader hunchentoot-connector-read-timeout + :documentation "Returns the server read timeout in seconds.") + (write-timeout :initarg :write-timeout + :reader hunchentoot-connector-write-timeout + :documentation "Returns the server write timeout in seconds.") + #+(and :unix (not :win32)) (setuid :initarg :setuid + :reader hunchentoot-connector-setuid + :documentation "Returns the uid under which the server runs.") + #+(and :unix (not :win32)) (setgid :initarg :setgid + :reader hunchentoot-connector-setgid + :documentation "Returns the gid under which the server runs.") + #-:hunchentoot-no-ssl (ssl-certificate-file :initarg :ssl-certificate-file + :reader hunchentoot-connector-ssl-certificate-file + :documentation "The ssl certificate file for https connections.") + #-:hunchentoot-no-ssl (ssl-privatekey-file :initarg :ssl-privatekey-file + :reader hunchentoot-connector-ssl-privatekey-file + :documentation "The ssl private key file for https connections") + #-:hunchentoot-no-ssl (ssl-privatekey-password :initarg :ssl-privatekey-password + :reader hunchentoot-connector-ssl-privatekey-password + :documentation "The password for the ssl private key file for https connections") + (server :initform nil + :accessor hunchentoot-connector-server + :documentation "The hunchentoot server dispatching http requests.") + (sslserver :initform nil + :accessor hunchentoot-connector-sslserver + :documentation "The hunchentoot server dispatching https requests.")) + (:default-initargs :mod-lisp-p nil + :use-apache-log-p nil + :input-chunking-p nil + :read-timeout hunchentoot:*default-read-timeout* + :write-timeout hunchentoot:*default-write-timeout* + #+(and :unix (not :win32)) :setuid nil + #+(and :unix (not :win32)) :setgid nil + #-:hunchentoot-no-ssl :ssl-certificate-file nil + #-:hunchentoot-no-ssl :ssl-privatekey-file nil + #-:hunchentoot-no-ssl :ssl-privatekey-password nil) + (:documentation "This is a connector between hunchentoot and the CLAW server CLAWSERVER object")) + +(defmethod claw-service-start :before ((connector hunchentoot-connector)) + (let* ((server *clawserver*) + (port (connector-port connector)) + (sslport (connector-sslport connector)) + (address (connector-address connector)) + (dispatch-table (list #'(lambda (request) + (declare (ignore request)) + (clawserver-dispatch-method server)))) + (mod-lisp-p (hunchentoot-connector-mod-lisp-p connector)) + (use-apache-log-p (hunchentoot-connector-use-apache-log-p connector)) + (input-chunking-p (hunchentoot-connector-input-chunking-p connector)) + (read-timeout (hunchentoot-connector-read-timeout connector)) + (write-timeout (hunchentoot-connector-write-timeout connector)) + (uid (hunchentoot-connector-setuid connector)) + (gid (hunchentoot-connector-setgid connector)) + (ssl-certificate-file (hunchentoot-connector-ssl-certificate-file connector)) + (ssl-privatekey-file (hunchentoot-connector-ssl-privatekey-file connector)) + (ssl-privatekey-password (hunchentoot-connector-ssl-privatekey-password connector))) + (progn + (when port + (setf (hunchentoot-connector-server connector) + (hunchentoot:start-server :port port + :address address + :dispatch-table dispatch-table + :mod-lisp-p mod-lisp-p + :use-apache-log-p use-apache-log-p + :input-chunking-p input-chunking-p + :read-timeout read-timeout + :write-timeout write-timeout + #+(and :unix (not :win32)) :setuid uid + #+(and :unix (not :win32)) :setgid gid))) + (when sslport + (setf (hunchentoot-connector-sslserver connector) + (hunchentoot:start-server :port sslport + :address address + :dispatch-table dispatch-table + :mod-lisp-p mod-lisp-p + :use-apache-log-p use-apache-log-p + :input-chunking-p input-chunking-p + :read-timeout read-timeout + :write-timeout write-timeout + #+(and :unix (not :win32)) :setuid uid + #+(and :unix (not :win32)) :setgid gid + #-:hunchentoot-no-ssl :ssl-certificate-file ssl-certificate-file + #-:hunchentoot-no-ssl :ssl-privatekey-file ssl-privatekey-file + #-:hunchentoot-no-ssl :ssl-privatekey-password ssl-privatekey-password)))))) + +(defmethod claw-service-stop :before ((connector hunchentoot-connector)) + (let ((server (hunchentoot-connector-server connector)) + (sslserver (hunchentoot-connector-sslserver connector))) + (when server + (hunchentoot:stop-server server)) + (when sslserver + (hunchentoot:stop-server sslserver)))) + +(defmethod connector-host ((connector hunchentoot-connector)) + (hunchentoot:host)) + +(defmethod connector-request-method ((connector hunchentoot-connector)) + (hunchentoot:request-method)) + +(defmethod connector-request-uri ((connector hunchentoot-connector)) + (hunchentoot:request-uri)) + +(defmethod connector-script-name ((connector hunchentoot-connector)) + (hunchentoot:script-name)) + +(defmethod connector-query-string ((connector hunchentoot-connector)) + (hunchentoot:query-string)) + +(defmethod connector-get-parameter ((connector hunchentoot-connector) name) + (hunchentoot:get-parameter name)) + +(defmethod connector-get-parameters ((connector hunchentoot-connector)) + (hunchentoot:get-parameters)) + +(defmethod connector-post-parameter ((connector hunchentoot-connector) name) + (hunchentoot:post-parameter name)) + +(defmethod connector-post-parameters ((connector hunchentoot-connector)) + (hunchentoot:post-parameters)) + +(defmethod connector-parameter ((connector hunchentoot-connector) name) + (hunchentoot:parameter name)) + +(defmethod connector-header-in ((connector hunchentoot-connector) name) + (hunchentoot:header-in (if (stringp name) name (symbol-name name)))) + +(defmethod connector-headers-in ((connector hunchentoot-connector)) + (hunchentoot:headers-in)) + +(defmethod connector-authorization ((connector hunchentoot-connector)) + (hunchentoot:authorization)) + +(defmethod connector-remote-addr ((connector hunchentoot-connector)) + (hunchentoot:remote-addr)) + +(defmethod connector-remote-port ((connector hunchentoot-connector)) + (hunchentoot:remote-port)) + +(defmethod connector-real-remote-addr ((connector hunchentoot-connector)) + (hunchentoot:real-remote-addr)) + +(defmethod connector-server-addr ((connector hunchentoot-connector)) + (hunchentoot:server-addr)) + +(defmethod connector-server-port ((connector hunchentoot-connector)) + (hunchentoot:server-port)) + +(defmethod connector-server-protocol ((connector hunchentoot-connector)) + (hunchentoot:server-protocol)) + +(defmethod connector-user-agent ((connector hunchentoot-connector)) + (hunchentoot:user-agent)) + + +(defmethod connector-referer ((connector hunchentoot-connector)) + (hunchentoot:referer)) + +(defmethod connector-cookie-in (connector name) + (hunchentoot:cookie-in name)) + +(defmethod connector-cookies-in ((connector hunchentoot-connector)) + (hunchentoot:cookies-in)) + +(defmethod connector-aux-request-value ((connector hunchentoot-connector) symbol) + (hunchentoot:aux-request-value symbol)) + +(defmethod (setf connector-aux-request-value) (value (connector hunchentoot-connector) symbol) + (setf (hunchentoot:aux-request-value symbol) value)) + +(defmethod connector-delete-aux-request-value ((connector hunchentoot-connector) symbol) + (hunchentoot:delete-aux-request-value symbol)) + + +;;--------------------------- + +(defmethod connector-header-out ((connector hunchentoot-connector) name) + (hunchentoot:header-out name)) + +(defmethod (setf connector-header-out) (value (connector hunchentoot-connector) name) + (setf (hunchentoot:header-out name) value)) + +(defmethod connector-headers-out ((connector hunchentoot-connector)) + (hunchentoot:headers-out)) + +(defmethod connector-cookie-out ((connector hunchentoot-connector) name) + (let ((cookie (hunchentoot:cookie-out name))) + (when cookie + (hunchentoot-to-claw-cookie cookie)))) + +(defmethod (setf connector-cookie-out) (cookie-instance (connector hunchentoot-connector) name) + (hunchentoot:set-cookie name + :value (claw-cookie-value cookie-instance) + :expires (claw-cookie-expires cookie-instance) + :path (claw-cookie-path cookie-instance) + :domain (claw-cookie-domain cookie-instance) + :secure (claw-cookie-secure cookie-instance) + :http-only (claw-cookie-http-only cookie-instance))) + +(defmethod connector-cookies-out ((connector hunchentoot-connector)) + (loop for cookie in (hunchentoot:cookies-out) + collect (hunchentoot-to-claw-cookie cookie))) + +(defmethod connector-return-code ((connector hunchentoot-connector)) + (hunchentoot:return-code)) + +(defmethod (setf connector-return-code) (value (connector hunchentoot-connector)) + (setf (hunchentoot:return-code) value)) + +(defmethod connector-content-type ((connector hunchentoot-connector)) + (hunchentoot:content-type)) + +(defmethod (setf connector-content-type) (value (connector hunchentoot-connector)) + (setf (hunchentoot:content-type) value)) + +(defmethod connector-reply-external-format-encoding ((connector hunchentoot-connector)) + (flexi-streams:external-format-name (hunchentoot:reply-external-format))) + +(defmethod (setf connector-reply-external-format-encoding) (value (connector hunchentoot-connector)) + (let ((encoding (flexi-streams:external-format-name (hunchentoot:reply-external-format)))) + (unless (and (null value) (equal encoding value)) + (setf (hunchentoot:reply-external-format) + (flex:make-external-format value :eol-style :lf))))) + +(defmethod connector-writer ((connector hunchentoot-connector)) + (hunchentoot:send-headers)) + +(defmethod connector-redirect ((connector hunchentoot-connector) target &key host port protocol add-session-id code) + (hunchentoot:redirect target + :host host + :port port + :protocol protocol + :add-session-id add-session-id + :code code)) + +(defmethod (setf hunchentoot-connector-mod-lisp-p) (mod-lisp-p (hunchentoot-connector hunchentoot-connector)) + (unless (null (hunchentoot-connector-server hunchentoot-connector)) + (error "Cannot change mod-lisp property when server is started")) + (setf (slot-value hunchentoot-connector 'mod-lisp-p) mod-lisp-p)) + +(defmethod (setf hunchentoot-connector-use-apache-log-p) (use-apache-log-p (hunchentoot-connector hunchentoot-connector)) + (unless (null (hunchentoot-connector-server hunchentoot-connector)) + (error "Cannot change logging property when server is started")) + (setf (slot-value hunchentoot-connector 'use-apache-log-p) use-apache-log-p)) + +(defmethod (setf hunchentoot-connector-input-chunking-p) (input-chunking-p (hunchentoot-connector hunchentoot-connector)) + (unless (null (hunchentoot-connector-server hunchentoot-connector)) + (error "Cannot change chunking property when server is started")) + (setf (slot-value hunchentoot-connector 'input-chunking-p) input-chunking-p)) + +(defmethod (setf hunchentoot-connector-read-timeout) (read-timeout (hunchentoot-connector hunchentoot-connector)) + (unless (null (hunchentoot-connector-server hunchentoot-connector)) + (error "Cannot change read timeout property when server is started")) + (setf (slot-value hunchentoot-connector 'read-timeout) read-timeout)) + +(defmethod (setf hunchentoot-connector-write-timeout) (write-timeout (hunchentoot-connector hunchentoot-connector)) + (unless (null (hunchentoot-connector-server hunchentoot-connector)) + (error "Cannot change write timeout property when server is started")) + (setf (slot-value hunchentoot-connector 'write-timeout) write-timeout)) + +#+(and :unix (not :win32)) (defmethod (setf hunchentoot-connector-setuid) (setuid (hunchentoot-connector hunchentoot-connector)) + (unless (null (hunchentoot-connector-server hunchentoot-connector)) + (error "Cannot change uid property when server is started")) + (setf (slot-value hunchentoot-connector 'setuid) setuid)) + +#+(and :unix (not :win32)) (defmethod (setf hunchentoot-connector-setgid) (setgid (hunchentoot-connector hunchentoot-connector)) + (unless (null (hunchentoot-connector-server hunchentoot-connector)) + (error "Cannot change gid property when server is started")) + (setf (slot-value hunchentoot-connector 'setgid) setgid)) + +#-:hunchentoot-no-ssl (defmethod (setf hunchentoot-connector-ssl-certificate-file) (ssl-certificate-file (hunchentoot-connector hunchentoot-connector)) + (unless (null (hunchentoot-connector-server hunchentoot-connector)) + (error "Cannot change ssl certificate file property when server is started")) + (setf (slot-value hunchentoot-connector 'ssl-certificate-file) ssl-certificate-file)) + +#-:hunchentoot-no-ssl (defmethod (setf hunchentoot-connector-ssl-privatekey-file) (ssl-privatekey-file (hunchentoot-connector hunchentoot-connector)) + (unless (null (hunchentoot-connector-server hunchentoot-connector)) + (error "Cannot change ssl privatekey file property when server is started")) + (setf (slot-value hunchentoot-connector 'ssl-privatekey-file) ssl-privatekey-file)) + +#-:hunchentoot-no-ssl (defmethod (setf hunchentoot-connector-ssl-privatekey-password) (ssl-privatekey-password (hunchentoot-connector hunchentoot-connector)) + (unless (null (hunchentoot-connector-server hunchentoot-connector)) + (error "Cannot change ssl privatekey password property when server is started")) + (setf (slot-value hunchentoot-connector 'ssl-privatekey-password) ssl-privatekey-password)) + +(defmethod connector-content-length ((connector hunchentoot-connector)) + (hunchentoot:content-length)) + +(defmethod (setf connector-content-length) (value (connector hunchentoot-connector)) + (setf (hunchentoot:content-length) value)) + + +(defmethod hunchentoot-to-claw-cookie ((cookie hunchentoot::cookie)) + (make-instance 'claw-cookie + :name (hunchentoot:cookie-name cookie) + :value (hunchentoot:cookie-value cookie) + :expires (hunchentoot:cookie-expires cookie) + :path (hunchentoot:cookie-path cookie) + :domoain (hunchentoot:cookie-domain cookie) + :secure (hunchentoot:cookie-secure cookie) + :http-only (hunchentoot:cookie-http-only cookie))) + +(defclass hunchentoot-logger (logger) + () + (:documentation "Logger for hunchentoot")) + +(defmethod logger-log ((logger hunchentoot-logger) level control-string &rest rest) + (apply #'hunchentoot:log-message level control-string rest)) + Added: trunk/main/connectors/claw-hunchentoot-connector/src/packages.lisp ============================================================================== --- (empty file) +++ trunk/main/connectors/claw-hunchentoot-connector/src/packages.lisp Wed Nov 12 07:07:31 2008 @@ -0,0 +1,8 @@ +y(in-package :cl-user) + +(defpackage :claw-hunchentoot-connector + (:use :cl :claw-as) + (:documentation "Hunchentoot connector for CLAW server") + (:export #:hunchentoot-connector + #:hunchentoot-logger)) +