;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
;;; $Header: src/connector.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 connector-host (connector)
  (:documentation "
Returns the value of the incoming Host http header. \(This corresponds to the environment variable HTTP_HOST in CGI scripts.)"))

(defgeneric connector-request-method (connector)
  (: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 connector-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 connector-request-uri (connector)
  (: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 connector-query-string (connector)
  (: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 CONNECTOR-GET-PARAMETER and CONNECTOR-GET-PARAMETERS."))

(defgeneric connector-get-parameter (connector 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 CONNECTOR-GET-PARAMETERS"))

(defgeneric connector-get-parameters (connector)
  (: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 CONNECTOR-GET-PARAMETER."))

(defgeneric connector-post-parameter (connector 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 connector-post-parameters (connector)
  (: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 CONNECTOR-POST-PARAMETER."))

(defgeneric connector-parameter (connector 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 CONNECTOR-GET-PARAMETER and CONNECTOR-POST-PARAMETER."))

(defgeneric connector-header-in (connector 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 CONNECTOR-HEADERS-IN."))

(defgeneric connector-headers-in (connector)
  (: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 CONECTOR-HEADER-IN and the remark about incoming headers there."))

(defgeneric connector-authorization (connector)
  (: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 connector-remote-addr (connector)
  (: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 CONNECTOR-REAL-REMOTE-ADDR."))

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

(defgeneric connector-real-remote-addr (connector)
  (: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 CONNECTOR-REMOTE-ADDR as the only value."))

(defgeneric connector-server-addr (connector)
  (: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 connector-server-port (connector)
  (:documentation "Returns the IP port \(as a number) where the request came in."))

(defgeneric connector-server-protocol (connector)
  (: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 connector-user-agent (connector)
  (:documentation "Returns the value of the incoming User-Agent http header.
\(This corresponds to the environment variable HTTP_USER_AGENT in CGI scripts.)"))


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

(defgeneric connector-cookie-in (connector 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 CONNECTOR-COOKIES-IN"))

(defgeneric connector-cookies-in (connector)
  (: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 CONNECTOR-COOKIE-IN"))

(defgeneric connector-aux-request-value (connector symbol)
  (:documentation "Returns values VALUE, PRESENTP.
This accessor associates arbitrary data with the the symbol symbol in the REQUEST object request.
PRESENTP is true if such data was found, otherwise NIL"))

(defgeneric (setf connector-aux-request-value) (value connector symbol)
  (:documentation "This accessor can be used to associate arbitrary data with the the symbol symbol in the REQUEST object request."))

(defgeneric connector-delete-aux-request-value (connector 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 connector-header-out (connector 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 CONNECTOR-HEADERS-OUT, CONNECTOR-CONTENT-TYPE, CONNECTOR-CONTENT-LENGTH, CONNECTOR-COOKIES-OUT, and CONNECTOR-COOKIE-OUT"))

(defgeneric (setf connector-header-out) (value connector 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 CONNECTOR-HEADERS-OUT, CONNECTOR-CONTENT-TYPE, CONNECTOR-CONTENT-LENGTH, CONNECTOR-COOKIES-OUT, and CONNECTOR-COOKIE-OUT"))

(defgeneric connector-headers-out (connector)
  (: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 CONNECTOR-HEADER-OUT instead"))

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

(defgeneric (setf connector-cookie-out) (cookie-instance connector 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 connector-cookies-out (connector)
  (:documentation "Returns the outgoing cookie named by the string name \(or NIL if there ain't no cookie with this name).
See also CONNECTOR-COOKIES-OUT and the CLAW-COOKIE class definition."))

(defgeneric connector-return-code (connector)
  (:documentation "CONNECTOR-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 connector-return-code) (value connector)
  (:documentation "Setf CONNECTOR-RETURN-CODE sets the http return code of the reply."))

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

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

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

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

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

(defgeneric connector-redirect (connector 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 CONNECTOR-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 connector-content-length (connector)
  (:documentation "Returns the outgoing Content-Length http header"))

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

(defclass connector (claw-service)
  ((port :initarg :port
         :accessor connector-port
         :documentation "The port under which normal http requests are handled")
   (sslport :initarg :sslport
            :accessor connector-sslport
            :documentation "The port under which https requests are handled")
   (address :initarg :address
            :accessor connector-address
            :documentation "The address whe the connector is bound to"))
  (:default-initargs :port 4080 :sslport 4443 
                     :address *claw-default-server-address*
                     :name 'connector)
  (:documentation "CONNECTOR is an interface, so you cannot directly use it.
A Connector subclass is a class that helps to decouple CLAW from the web server on which CLAWSERVER resides.
To properly work a CLAWSERVER instance must be provided with a CONNECTOR implementation.
A CONNECTOR implementation to properly work, must implement all the CONNECTOR- methods."))

(defmethod connector-writer ((connector connector)))

(defclass claw-cookie ()
  ((name :initarg :name
         :reader claw-cookie-name
         :type string
         :documentation "The name of the claw-cookie - a string.")
   (value :initarg :value
          :accessor claw-cookie-value
          :initform ""
          :documentation "The value of the claw-cookie. Will be URL-encoded when sent to the browser.")
   (expires :initarg :expires
            :initform nil
            :accessor claw-cookie-expires
            :documentation "The time \(a universal time) when the claw-cookie expires \(or NIL).")
   (path :initarg :path
         :initform nil
         :accessor claw-cookie-path
         :documentation "The path this claw-cookie is valid for \(or NIL).")
   (domain :initarg :domain
           :initform nil
           :accessor claw-cookie-domain
           :documentation "The domain this claw-cookie is valid for \(or NIL).")
   (secure :initarg :secure
           :initform nil
           :accessor claw-cookie-secure
           :documentation "A generalized boolean denoting whether this is a secure claw-cookie.")
   (http-only :initarg :http-only
              :initform nil
              :accessor claw-cookie-http-only
              :documentation "A generalized boolean denoting whether this is a HttpOnly claw-cookie.")))