;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
;;; $Header: src/server.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-as)

;;------------------------------------------------------------------------------------------
(defgeneric error-renderer (claw-server &key error-code)
  (:documentation "Method for rendering http errors. This method should be overridden."))

(defgeneric claw-server-host (claw-server)
  (:documentation "
Returns the value of the incoming Host http header. \(This corresponds to the environment variable HTTP_HOST in CGI scripts.)"))

(defgeneric claw-server-request-method (claw-server)
  (:documentation "Returns the request method as a keyword, i.e. something like :POST. \(This corresponds to the environment variable REQUEST_METHOD in CGI scripts.)"))

(defgeneric claw-server-request-uri (claw-server)
  (:documentation "Returns the URI for request.
Note that this not the full URI but only the part behind the scheme and authority components, so that if the user has typed http://user:password@www.domain.com/xxx/frob.html?foo=bar into his browser, this function will return \"/xxx/frob.html?foo=bar\". \(This corresponds to the environment variable REQUEST_URI in CGI scripts."))

(defgeneric claw-server-script-name (connector)
  (:documentation "Returns the file name \(or path) component of the URI for request, i.e. the part of the string returned by REQUEST-URI in front of the first question mark \(if any).
\(This corresponds to the environment variable SCRIPT_NAME in CGI scripts.)"))

(defgeneric claw-server-query-string (claw-server)
  (:documentation "Returns the query component of the URI for request, i.e. the part of the string returned by REQUEST-URI behind the first question mark \(if any).
\(This corresponds to the environment variable QUERY_STRING in CGI scripts.) See also claw-server-GET-PARAMETER and claw-server-GET-PARAMETERS."))

(defgeneric claw-server-get-parameter (claw-server name)
  (:documentation "Returns the value of the GET parameter \(as provided via the request URI) named by the string name as a string \(or NIL if there ain't no GET parameter with this name).
Note that only the first value will be returned if the client provided more than one GET parameter with the name name. See also claw-server-GET-PARAMETERS"))

(defgeneric claw-server-get-parameters (claw-server)
  (:documentation "Returns an alist of all GET parameters \(as provided via the request URI). The car of each element of this list is the parameter's name while the cdr is its value \(as a string).
The elements of this list are in the same order as they were within the request URI. See also claw-server-GET-PARAMETER."))

(defgeneric claw-server-post-parameter (claw-server name)
  (:documentation "Returns the value of the POST parameter \(as provided in the request's body) named by the string name.
Note that only the first value will be returned if the client provided more than one POST parameter with the name name.
This value will usually be a string \(or NIL if there ain't no POST parameter with this name).
If, however, the browser sent a file through a multipart/form-data form, the value of this function is a three-element list

\(path file-name content-type)

where path is a pathname denoting the place were the uploaded file was stored, file-name \(a string) is the file name sent by the browser, and content-type \(also a string) is the content type sent by the browser.
The file denoted by path will be deleted after the request has been handled - you have to move or copy it somewhere else if you want to keep it."))

(defgeneric claw-server-post-parameters (claw-server)
  (:documentation "Returns an alist of all POST parameters (as provided via the request's body). The car of each element of this list is the parameter's name while the cdr is its value. The elements of this list are in the same order as they were within the request's body.
See also claw-server-POST-PARAMETER."))

(defgeneric claw-server-parameter (claw-server name)
  (:documentation "Returns the value of the GET or POST parameter named by the string name as a string \(or NIL if there ain't no parameter with this name).
If both a GET and a POST parameter with the name name exist, the GET parameter will be returned. See also claw-server-GET-PARAMETER and claw-server-POST-PARAMETER."))

(defgeneric claw-server-header-in (claw-server name)
  (:documentation "Returns the incoming header named by the keyword name as a string \(or NIL if there ain't no header with this name).
Note that this queries the headers sent to Hunchentoot by the client or by mod_lisp. In the latter case this may not only include the incoming http headers but also some headers sent by mod_lisp.
For backwards compatibility, name can also be a string which is matched case-insensitively. See also claw-server-HEADERS-IN."))

(defgeneric claw-server-headers-in (claw-server)
  (:documentation "Returns an alist of all incoming headers.
The car of each element of this list is the headers's name \(a Lisp keyword) while the cdr is its value (as a string).
There's no guarantee about the order of this list. See also claw-server-HEADER-IN and the remark about incoming headers there."))

(defgeneric claw-server-authorization (claw-server)
  (:documentation "Returns as two values the user and password \(if any) from the incoming Authorization http header.
Returns NIL if there is no such header."))

(defgeneric claw-server-remote-addr (claw-server)
  (:documentation "Returns the IP address \(as a string) of the client which sent the request. \(This corresponds to the environment variable REMOTE_ADDR in CGI scripts.) See also claw-server-REAL-REMOTE-ADDR."))

(defgeneric claw-server-remote-port (claw-server)
  (:documentation "Returns the IP port (as a number) of the client which sent the request."))

(defgeneric claw-server-real-remote-addr (claw-server)
  (:documentation "Returns the value of the incoming X-Forwarded-For http header as the second value in the form of a list of IP addresses and the first element of this list as the first value if this header exists.
Otherwise returns the value of claw-server-REMOTE-ADDR as the only value."))

(defgeneric claw-server-server-addr (claw-server)
  (:documentation "Returns the IP address \(as a string) where the request came in.
\(This corresponds to the environment variable SERVER_ADDR in CGI scripts.)"))

(defgeneric claw-server-server-port (claw-server)
  (:documentation "Returns the IP port \(as a number) where the request came in."))

(defgeneric claw-server-server-protocol (claw-server)
  (:documentation "Returns the version of the http protocol which is used by the client as a Lisp keyword - this is usually either :HTTP/1.0 or :HTTP/1.1.
\(This corresponds to the environment variable SERVER_PROTOCOL in CGI scripts."))

(defgeneric claw-server-user-agent (claw-server)
  (:documentation "Returns the value of the incoming User-Agent http header.
\(This corresponds to the environment variable HTTP_USER_AGENT in CGI scripts.)"))


(defgeneric claw-server-referer (claw-server)
  (:documentation "Returns the value of the incoming Referer \(sic!) http header. \(This corresponds to the environment variable HTTP_REFERER in CGI scripts.)"))

(defgeneric claw-server-cookie-in (claw-server name)
  (:documentation "Returns the value of the incoming cookie named by the string name \(or NIL if there ain't no cookie with this name).
See also claw-server-COOKIES-IN"))

(defgeneric claw-server-cookies-in (claw-server)
  (:documentation "Returns an alist of all incoming cookies.
The car of each element of this list is the cookie's name while the cdr is the cookie's value. See also claw-server-COOKIE-IN"))

(defgeneric claw-server-aux-request-value (claw-server symbol)
  (:documentation "This accessor can be used to associate arbitrary data with the the symbol symbol in the REQUEST object request. present-p is true if such data was found, otherwise NIL"))

(defgeneric (setf claw-server-aux-request-value) (value claw-server symbol)
  (:documentation "This accessor can be used to associate arbitrary data with the the symbol symbol in the REQUEST object request. present-p is true if such data was found, otherwise NIL"))

(defgeneric claw-server-delete-aux-request-value (claw-server symbol)
  (:documentation "Completely removes any data associated with the symbol symbol from the REQUEST object request. Note that this is different from using AUX-REQUEST-VALUE to set the data to NIL"))

(defgeneric claw-server-header-out (claw-server name)
  (:documentation "Returns the outgoing http header named by the keyword name if there is one, otherwise NIL \(name parameter must be a symbol).
Note that the headers Set-Cookie, Content-Length, and Content-Type cannot be queried by HEADER-OUT.
See also claw-server-HEADERS-OUT, claw-server-CONTENT-TYPE, claw-server-CONTENT-LENGTH, claw-server-COOKIES-OUT, and claw-server-COOKIE-OUT"))

(defgeneric (setf claw-server-header-out) (value claw-server name)
  (:documentation "SETF of HEADER-OUT changes the current value of the header named name \(name parameter must be a symbol).
If no header named name exists it is created.
Note that the headers Set-Cookie, Content-Length, and Content-Type must not be set by SETF of HEADER-OUT.
Also, there are a couple of \"technical\" headers like Connection or Transfer-Encoding that you're not supposed to set yourself.
See also claw-server-HEADERS-OUT, claw-server-CONTENT-TYPE, claw-server-CONTENT-LENGTH, claw-server-COOKIES-OUT, and claw-server-COOKIE-OUT"))

(defgeneric claw-server-headers-out (claw-server)
  (:documentation "Returns an alist of all outgoing http parameters \(except for Set-Cookie, Content-Length, and Content-Type).
The car of each element of this list is the headers's name while the cdr is its value.
This alist should not be manipulated directly, use SETF of claw-server-HEADER-OUT instead"))

(defgeneric claw-server-cookie-out (claw-server name)
  (:documentation "Returns the outgoing cookie named by the string name \(or NIL if there ain't no cookie with this name).
See also claw-server-COOKIES-OUT and the CLAW-COOKIE class definition."))

(defgeneric (setf claw-server-cookie-out) (cookie-instance claw-server name)
  (:documentation "Creates a CLAW-COOKIE object from the parameters provided to this function and adds it to the outgoing cookies of the REPLY object reply.
If a cookie with the same name \(case-sensitive) already exists, it is replaced.
 The default for value is the empty string."))

(defgeneric claw-server-cookies-out (claw-server)
  (:documentation "Returns the outgoing cookie named by the string name \(or NIL if there ain't no cookie with this name).
See also claw-server-COOKIES-OUT and the CLAW-COOKIE class definition."))

(defgeneric claw-server-return-code (claw-server)
  (:documentation "claw-server-RETURN-CODE returns the http return code of the reply. The return code of each REPLY object is initially set to 200 \(OK)"))

(defgeneric (setf claw-server-return-code) (value claw-server)
  (:documentation "Setf claw-server-RETURN-CODE sets the http return code of the reply."))

(defgeneric claw-server-content-type (claw-server)
  (:documentation "claw-server-CONTENT-TYPE returns the outgoing Content-Type http header \(such as: \"text/html; charset=utf-8\")."))

(defgeneric (setf claw-server-content-type) (value claw-server)
  (:documentation "SETF claw-server-CONTENT-TYPE sets the outgoing Content-Type http header \(such as: \"text/html; charset=utf-8\")."))

(defgeneric claw-server-content-length (claw-server)
  (:documentation "Returns the outgoing Content-Length http header"))

(defgeneric (setf claw-server-content-length) (value claw-server)
  (:documentation "Sets the outgoing Content-Length http header"))

(defgeneric claw-server-reply-external-format-encoding (claw-server)
  (:documentation "claw-server-REPLY-EXTERNAL-FORMAT-ENCODING returns the symbol of the reply charset encoding \(Such as UTF-8)."))

(defgeneric (setf claw-server-reply-external-format-encoding) (value claw-server)
  (:documentation "SETF claw-server-REPLY-EXTERNAL-FORMAT-ENCODING sets the symbol of the reply charset encoding \(Such as UTF-8)."))

(defgeneric claw-server-writer (claw-server)
  (:documentation "Returns the output stream writer to generate replies. It's default to *standard-output*"))

(defgeneric claw-server-redirect (claw-server target &key host port protocol add-session-id code)
  (:documentation "Sends back appropriate headers to redirect the client to target \(a string).
If target is a full URL starting with a scheme, host, port, and protocol are ignored.
Otherwise, target should denote the path part of a URL, protocol must be one of the keywords :HTTP or :HTTPS, and the URL to redirect to will be constructed from host, port, protocol, and target.
If code is a 3xx redirection code, it will be sent as status code.
In case of NIL, a 302 status code will be sent to the client. If host is not provided, the current host \(see claw-server-HOST) will be used.
If protocol is the keyword :HTTPS, the client will be redirected to a https URL, if it's :HTTP it'll be sent to a http URL. If both host and protocol aren't provided, then the value of protocol will match the current request."))
;;------------------------------------------------------------------------------------------


(defgeneric claw-server-dispatch-request (claw-server)
  (:documentation "Dispatches http requests through registered dispatchers"))

(defgeneric claw-server-dispatch-method (claw-server)
  (:documentation "Uses claw-server-DISPATCH-REQUEST to perform dispatching"))

(defgeneric claw-server-start (claw-server)
  (:documentation "Starts the server"))

(defgeneric claw-server-stop (claw-server)
  (:documentation "Stops the server"))

(defgeneric (setf claw-server-port) (port claw-server)
  (:documentation "Sets the claw server http port. When server is started an error will be signaled."))

(defgeneric (setf claw-server-sslport) (sslport claw-server)
  (:documentation "Sets the claw server https port. When server is started an error will be signaled."))

(defgeneric claw-server-address (claw-server)
  (:documentation "Binds the claw server to a specific address.  When server is started an error will be signaled."))

;;-----------------------------------------------------------------------------------------------
(defgeneric (setf claw-server-read-timeout) (read-timeout claw-server)
  (:documentation "Sets the read timeout in seconds. When server is started an error will be signaled."))

(defgeneric (setf claw-server-write-timeout) (write-timeout claw-server)
  (:documentation "Sets the write timeout in seconds. When server is started an error will be signaled."))

(defgeneric claw-server-add-service (claw-server service)
  (:documentation "Registers a service for the given claw-server object with the given SERVICE name.
A service may be added if the claw-server object is not running."))

;;------------------------------------------------------------

(defgeneric claw-server-register-configuration(claw-server realm configuration)
  (:documentation "Registers a configuration object for the given realm symbol into the server. The configuration
will perform the authentication logic."))

(defclass claw-server ()
  ((base-path :initarg :base-path
	      :accessor claw-server-base-path
	      :documentation "This slot is used to keep all server resources under a common URL")
   (proxy-http-port :initarg :proxy-http-port
                    :accessor claw-server-proxy-http-port
                    :documentation "The port eventually used to proxify http requests")
   (proxy-https-port :initarg :proxy-https-port
                     :accessor claw-server-proxy-https-port
                     :documentation "The port eventually used to proxify https requests")
   (reverse-proxy-path :initarg :reverse-proxy-path
                       :accessor claw-server-reverse-proxy-path
                       :documentation "When request is sent via proxy, use this value to build absolute paths")
   (connector :initarg :connector
              :accessor claw-server-connector
              :documentation "Reads or sets the server connector that dispatches requests and processes replies from the remote host.")
   (log-manager :initarg :log-manager
                :accessor claw-server-log-manager
                :documentation "Required log meanager used to log application messages when no lisplet one is provided")
   (session-manager :initarg :session-manager
                    :accessor claw-server-session-manager
                    :documentation "Accessor for the session manager. See the definition of the SESSION-MANAGER class.")
   (services :initarg :services
             :accessor claw-server-services
             :documentation "A hash map of services handled by the current server")
   (login-config :initform (make-hash-table :test 'equal)
		 :accessor claw-server-login-config
		 :documentation "An hash table holding a pair of realm,
expressed as pairs of symbol-function. 
The function should take two arguments (username and password), and should return a principal instance if the login call succeeds.
")
   (lisplets :initform nil
	     :accessor claw-server-lisplets
	     :documentation "A collection of cons where the car is an url location where a lisplet is registered and the cdr is the lisplet"))
  (:default-initargs :base-path ""
    :proxy-http-port *apache-http-port*
    :proxy-https-port *apache-https-port*
    :reverse-proxy-path nil
    :services (make-hash-table))
  (:documentation "claw-server is built around huncentoot and has the
instructions for lisplet dispatching, so use this class to start and stop
3hunchentoot server."))

;;;-------------------------- WRITERS ----------------------------------------

(defmethod claw-server-add-service ((server claw-server) (service claw-service))
  (setf (gethash (claw-service-name service) (claw-server-services server)) service))


;;;-------------------------- METHODS ----------------------------------------

(defmethod claw-server-register-configuration ((claw-server claw-server) realm (configuration configuration))
  (setf (gethash realm (claw-server-login-config claw-server)) configuration))

(defmethod claw-server-dispatch-request ((claw-server claw-server))
  (let* ((*claw-server* claw-server)
         (*session-manager* (claw-server-session-manager claw-server))
         (connector (claw-server-connector claw-server))
         (base-path (claw-server-base-path claw-server))
         (lisplets (claw-server-lisplets claw-server))
         (script-name (connector-script-name connector))
         (*server-path* (or (when (claw-proxified-p) 
                              (claw-server-reverse-proxy-path claw-server))
                            (claw-server-base-path claw-server)))
         (http-result nil))
    (handler-case 
        (progn
          (unwind-protect
               (catch 'handler-done
                 (progn 
                   (setf (claw-return-code) +http-not-found+)
                   (when (or (string= "" script-name) (starts-with-subseq base-path script-name))
                     (let ((rel-script-name (subseq script-name (length base-path))))
                       (setf http-result (or
                                          (loop for dispatcher in *claw-libraries-resources*
                                             for url = (car dispatcher)
                                             for action = (cdr dispatcher)
                                             do (when (starts-with-subseq url rel-script-name)
                                                  (setf (claw-return-code) +http-ok+)
                                                  (funcall action)))
                                          (loop for lisplet-cons in lisplets
                                             for url = (car lisplet-cons)
                                             for lisplet = (cdr lisplet-cons)
                                             do (when (starts-with-subseq url rel-script-name)
                                                  (setf (claw-return-code) +http-ok+)
                                                  (return (funcall #'lisplet-dispatch-method lisplet)))))))))))
          (or http-result
              (and (>= (claw-return-code) 400)
                   (or
                    (let ((error-handler (and *claw-current-lisplet*
                                              (gethash (or
                                                        (let ((return-code (claw-return-code)))
                                                          (if (= return-code +http-ok+)
                                                              nil
                                                              return-code))
                                                        +http-not-found+)
                                                       (lisplet-error-handlers *claw-current-lisplet*)))))
                      (when error-handler
                        (funcall error-handler)))
                    (with-output-to-string (*standard-output*)
                      (error-renderer claw-server :error-code (or
                                                              (let ((return-code (claw-return-code)))
                                                                (if (= return-code +http-ok+)
                                                                    nil
                                                                    return-code))
                                                              +http-not-found+)))))))
      (error (cond)
        (logger-log (claw-server-log-manager claw-server) :error "~a" cond)
        (with-output-to-string (*standard-output*) (error-renderer claw-server :error-code +http-internal-server-error+))))))


(defmethod claw-server-dispatch-method ((claw-server claw-server))
  #'(lambda () (claw-server-dispatch-request claw-server)))

(defmethod claw-server-start ((claw-server claw-server))
  (let ((*claw-server* claw-server)
        (log-manager (claw-server-log-manager claw-server))
        (connector (claw-server-connector claw-server))
        (sm (claw-server-session-manager claw-server))
        (lisplets (claw-server-lisplets claw-server)))
    (unless (claw-service-running-p log-manager)
      (claw-service-start log-manager))
    (unless (claw-service-running-p connector)
      (claw-service-start connector))
    (claw-service-start sm)
    (when lisplets
      (loop for lisplet-cons in lisplets
         for url = (car lisplet-cons)
         for lisplet = (cdr lisplet-cons)
         do (claw-service-start lisplet)))))

(defmethod claw-server-stop ((claw-server claw-server))
  (let ((*claw-server* claw-server)
        (log-manager (claw-server-log-manager claw-server))
        (connector (claw-server-connector claw-server))
        (sm (claw-server-session-manager claw-server))
        (lisplets (claw-server-lisplets claw-server)))
    (when lisplets
      (loop for lisplet-cons in lisplets
         for url = (car lisplet-cons)
         for lisplet = (cdr lisplet-cons)
         do (claw-service-start lisplet)))
    (when (claw-service-running-p connector)
      (claw-service-stop connector))
    (when (claw-service-running-p log-manager)
      (claw-service-stop log-manager))
    (claw-service-stop sm)))



;;-------------------------------------------------------------------------------------------------------

(defmethod claw-server-host ((claw-server claw-server))
  (connector-host (claw-server-connector claw-server)))

(defmethod claw-server-request-method ((claw-server claw-server))
  (connector-request-method (claw-server-connector claw-server)))

(defmethod claw-server-request-uri ((claw-server claw-server))
  (connector-request-uri (claw-server-connector claw-server)))

(defmethod claw-server-query-string ((claw-server claw-server))
  (connector-query-string (claw-server-connector claw-server)))

(defmethod claw-server-get-parameter ((claw-server claw-server) name)
  (connector-get-parameter (claw-server-connector claw-server) name))

(defmethod claw-server-get-parameters ((claw-server claw-server))
  (connector-get-parameters (claw-server-connector claw-server)))

(defmethod claw-server-post-parameter ((claw-server claw-server) name)
  (connector-post-parameter (claw-server-connector claw-server) name))

(defmethod claw-server-post-parameters ((claw-server claw-server))
  (connector-post-parameters (claw-server-connector claw-server)))

(defmethod claw-server-parameter ((claw-server claw-server) name)
  (connector-parameter (claw-server-connector claw-server) name))

(defmethod claw-server-header-in ((claw-server claw-server) name)
  (connector-header-in (claw-server-connector claw-server) name))

(defmethod claw-server-headers-in ((claw-server claw-server))
  (connector-headers-in (claw-server-connector claw-server)))

(defmethod claw-server-authorization ((claw-server claw-server))
  (connector-authorization (claw-server-connector claw-server)))

(defmethod claw-server-remote-addr ((claw-server claw-server))
  (connector-remote-addr (claw-server-connector claw-server)))

(defmethod claw-server-remote-port ((claw-server claw-server))
  (connector-remote-port (claw-server-connector claw-server)))

(defmethod claw-server-real-remote-addr ((claw-server claw-server))
  (connector-real-remote-addr (claw-server-connector claw-server)))

(defmethod claw-server-server-addr ((claw-server claw-server))
  (connector-server-addr (claw-server-connector claw-server)))

(defmethod claw-server-server-port ((claw-server claw-server))
  (connector-server-port (claw-server-connector claw-server)))

(defmethod claw-server-server-protocol ((claw-server claw-server))
  (connector-server-protocol (claw-server-connector claw-server)))

(defmethod claw-server-user-agent ((claw-server claw-server))
  (connector-user-agent (claw-server-connector claw-server)))

(defmethod claw-server-referer ((claw-server claw-server))
  (connector-referer (claw-server-connector claw-server)))

(defmethod claw-server-cookie-in ((claw-server claw-server) name)
  (connector-cookie-in (claw-server-connector claw-server) name))

(defmethod claw-server-cookies-in ((claw-server claw-server))
  (connector-cookies-in (claw-server-connector claw-server)))

(defmethod claw-server-aux-request-value ((claw-server claw-server) symbol)
  (connector-aux-request-value (claw-server-connector claw-server) symbol))

(defmethod (setf claw-server-aux-request-value) (value (claw-server claw-server) symbol)
  (setf (connector-aux-request-value (claw-server-connector claw-server) symbol) value))

(defmethod claw-server-delete-aux-request-value ((claw-server claw-server) symbol)
  (connector-delete-aux-request-value (claw-server-connector claw-server) symbol))

(defmethod claw-server-header-out ((claw-server claw-server) name)
  (connector-header-out (claw-server-connector claw-server) name))

(defmethod (setf claw-server-header-out) (value (claw-server claw-server) name)
  (setf (connector-header-out (claw-server-connector claw-server) name) value))

(defmethod claw-server-headers-out ((claw-server claw-server))
  (connector-headers-out (claw-server-connector claw-server)))

(defmethod claw-server-cookie-out ((claw-server claw-server) name)
  (connector-cookie-out (claw-server-connector claw-server) name))

(defmethod (setf claw-server-cookie-out) (cookie-instance (claw-server claw-server) name)
  (setf (connector-cookie-out (claw-server-connector claw-server) name) cookie-instance))

(defmethod claw-server-cookies-out ((claw-server claw-server))
  (connector-cookies-out (claw-server-connector claw-server)))

(defmethod claw-server-return-code ((claw-server claw-server))
  (connector-return-code (claw-server-connector claw-server)))

(defmethod (setf claw-server-return-code) (value (claw-server claw-server))
  (setf (connector-return-code (claw-server-connector claw-server)) value))

(defmethod claw-server-content-type ((claw-server claw-server))
  (connector-content-type (claw-server-connector claw-server)))

(defmethod (setf claw-server-content-type) (value (claw-server claw-server))
  (setf (connector-content-type (claw-server-connector claw-server)) value))

(defmethod claw-server-content-length ((claw-server claw-server))
  (connector-content-length (claw-server-connector claw-server)))

(defmethod (setf claw-server-content-length) (value (claw-server claw-server))
  (setf (connector-content-length (claw-server-connector claw-server)) value))

(defmethod claw-server-reply-external-format-encoding ((claw-server claw-server))
  (connector-reply-external-format-encoding (claw-server-connector claw-server)))

(defmethod (setf claw-server-reply-external-format-encoding) (value (claw-server claw-server))
  (setf (connector-reply-external-format-encoding (claw-server-connector claw-server)) value))

(defmethod claw-server-writer ((claw-server claw-server))
  (connector-writer (claw-server-connector claw-server)))

(defmethod claw-server-redirect (claw-server target &key host port protocol add-session-id code)
  (connector-redirect (claw-server-connector claw-server) target :host host :port port :protocol protocol :add-session-id add-session-id :code code))

(defmethod claw-server-script-name ((claw-server claw-server))
  (connector-script-name (claw-server-connector claw-server)))

(defmethod claw-server-address ((claw-server claw-server))
  (connector-address (claw-server-connector claw-server)))

(defmethod error-renderer ((claw-server claw-server) &key (error-code 404))
  (let ((request-uri (claw-script-name))
        (connector (claw-server-connector claw-server))
        (style "body {
  font-family: arial, elvetica;
  font-size: 7pt;
}
span.blue {
  padding: 0 3px;
  background-color: #525D76;
  color: white;
  font-weight: bolder;
  margin-right: .25em;
}
p.h1, p.h2 {
  padding: 0 3px;
  background-color: #525D76;
  color: white;
  font-weight: bolder;
  font-size: 2em;
  margin: 0;
  margin-bottom: .5em;
}
p.h2 {font-size: 1.5em;}"))
    (setf (connector-return-code connector) error-code)
    (format t "<html>
<head>
  <title>Error ~a</title>
  <style>~a</style>
</head>
<body>
  <p>
    <p class='h1'>
      HTTP Status ~a - ~a
    </p>
    <hr noshade='noshade'>
    <p>
      <span class='blue'>type</span>
      Status report
    </p>
    <p>
      <span class='blue'>url</span>
      ~a
    </p>
    <p>
      <span class='blue'>description</span>
      ~a
    </p>
    <hr noshade='noshade'>
    <p class='h2'>
      CLAW server
    </p>
  </p>
</body>
</html>" 
            error-code ;title
            style ;tyle
            error-code request-uri
            request-uri
            (gethash error-code *http-reason-phrase-map*))))