[claw-cvs] r56 - in trunk/main/connectors: . hunchentoot hunchentoot/src

achiumenti at common-lisp.net achiumenti at common-lisp.net
Thu Jul 17 13:15:32 UTC 2008


Author: achiumenti
Date: Thu Jul 17 09:15:31 2008
New Revision: 56

Added:
   trunk/main/connectors/
   trunk/main/connectors/hunchentoot/
   trunk/main/connectors/hunchentoot/hunchentoot-connector.asd
   trunk/main/connectors/hunchentoot/src/
   trunk/main/connectors/hunchentoot/src/hunchentoot.lisp
   trunk/main/connectors/hunchentoot/src/packages.lisp
Log:
commit of version 0.1.0 (connectors)

Added: trunk/main/connectors/hunchentoot/hunchentoot-connector.asd
==============================================================================
--- (empty file)
+++ trunk/main/connectors/hunchentoot/hunchentoot-connector.asd	Thu Jul 17 09:15: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 :hunchentoot-connector
+  :name "hunchentoot-connector"
+  :author "Andrea Chiumenti"
+  :description "Hunchentoot connector for CLAW"
+  :depends-on (:closer-mop :hunchentoot :flexi-streams :claw)
+  :components ((:module src
+                        :components ((:file "packages")
+                                     (:file "hunchentoot" :depends-on ("packages"))))))

Added: trunk/main/connectors/hunchentoot/src/hunchentoot.lisp
==============================================================================
--- (empty file)
+++ trunk/main/connectors/hunchentoot/src/hunchentoot.lisp	Thu Jul 17 09:15:31 2008
@@ -0,0 +1,415 @@
+;; -*- 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 :hunchentoot-connector)
+
+(setf hunchentoot:*hunchentoot-default-external-format* (flex:make-external-format :utf-8 :eol-style :lf))
+(setf hunchentoot:*default-content-type* "text/html; charset=utf-8")
+
+(defgeneric claw-to-hunchentoot-cookie (claw-cookie)
+  (:documentation "Returns hunchentoot cookie from a claw cookie"))
+
+(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.")
+   (http-p :initarg :http-p
+           :reader hunchentoot-connector-http-p
+           :documentation "When true the http server is enabled.")
+   (https-p :initarg :https-p
+            :reader hunchentoot-connector-https-p
+            :documentation "When true the https server is enabled if ssl-certificate-file is provided."))
+  (:default-initargs :http-p t :https-p nil
+                     :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 (hunchentoot-connector-http-p connector)
+        (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)))
+      #-:hunchentoot-no-ssl (when (and (hunchentoot-connector-https-p connector) ssl-certificate-file)
+                              (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
+                                                              :ssl-certificate-file ssl-certificate-file
+                                                              :ssl-privatekey-file ssl-privatekey-file
+                                                              :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))))
+    ;(log-message :info "ENCODING: ~a| VALUE: ~a" encoding value)
+    (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))
+  ;*standard-output*)
+
+(defmethod connector-redirect ((connector hunchentoot-connector) target &key host port protocol add-session-id code)
+  (hunchentoot:redirect target
+                        :host (or host (connector-server-addr connector))
+                        :port (or port (connector-server-port connector))
+                        :protocol (or protocol (connector-server-protocol connector))
+                        :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 claw-to-hunchentoot-cookie ((cookie claw-cookie))
+  (make-instance 'hunchentoot::cookie 
+                 :name (claw-cookie-name cookie)
+                 :value (claw-cookie-value cookie)
+                 :expires (claw-cookie-expires cookie)
+                 :path (claw-cookie-path cookie)
+                 :domoain (claw-cookie-domain cookie)
+                 :secure (claw-cookie-secure cookie)
+                 :http-only (claw-cookie-http-only cookie)))
+
+(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/hunchentoot/src/packages.lisp
==============================================================================
--- (empty file)
+++ trunk/main/connectors/hunchentoot/src/packages.lisp	Thu Jul 17 09:15:31 2008
@@ -0,0 +1,8 @@
+(in-package :cl-user)
+
+(defpackage :hunchentoot-connector
+  (:use :cl :claw)
+  (:documentation "Hunchentoot connector for CLAW")
+  (:export #:hunchentoot-connector
+           #:hunchentoot-logger))
+



More information about the Claw-cvs mailing list