<commit_before>;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*-
;;; $Header: /usr/local/cvsrep/hunchentoot/request.lisp,v 1.35 2008/02/13 16:02:18 edi Exp $

;;; Copyright (c) 2004-2008, Dr. <NAME>.  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)

(defclass request ()
  ((headers-in :initarg :headers-in
               :documentation "An alist of the incoming headers."
               :reader headers-in)
   (method :initarg :method
           :documentation "The request method as a keyword."
           :reader request-method)
   (uri :initarg :uri
        :documentation "The request URI as a string."
        :reader request-uri)
   (server-protocol :initarg :server-protocol
                    :documentation "The HTTP protocol as a keyword."
                    :reader server-protocol)
   (remote-addr :initarg :remote-addr
                :documentation "The IP address of the client that
initiated this request."
                :reader remote-addr)
   (remote-port :initarg :remote-port
                :documentation "The TCP port number of the client
socket from which this request originated."
                :reader remote-port)
   (content-stream :initarg :content-stream
                   :reader content-stream
                   :documentation "A stream from which the request
body can be read if there is one.")
   (cookies-in :initform nil
               :documentation "An alist of the cookies sent by the client."
               :reader cookies-in)
   (get-parameters :initform nil
                   :documentation "An alist of the GET parameters sent
by the client."
                   :reader get-parameters)
   (post-parameters :initform nil
                    :documentation "An alist of the POST parameters
sent by the client."
                    :reader post-parameters)
   (script-name :initform nil
                :documentation "The URI requested by the client without
the query string."
                :reader script-name)
   (query-string :initform nil
                 :documentation "The query string of this request."
                 :reader query-string)
   (session :initform nil
            :accessor session
            :documentation "The session object associated with this
request.")
   (aux-data :initform nil
             :accessor aux-data
             :documentation "Used to keep a user-modifiable alist with
arbitrary data during the request.")
   (raw-post-data :initform nil
                  :documentation "The raw string sent as the body of a
POST request, populated only if not a multipart/form-data request."))
  (:documentation "Objects of this class hold all the information
about an incoming request.  They are created automatically by
Hunchentoot and can be accessed by the corresponding handler.

You should not mess with the slots of these objects directly, but you
can subclass REQUEST in order to implement your own behaviour.  See
for example the REQUEST-CLASS keyword argument of START-SERVER and the
function DISPATCH-REQUEST."))

(defun convert-hack (string external-format)
  "The rfc2388 package is buggy in that it operates on a character
stream and thus only accepts encodings which are 8 bit transparent.
In order to support different encodings for parameter values
submitted, we post process whatever string values the rfc2388 package
has returned."
  (let ((octets (make-array (length string) :element-type '(unsigned-byte 8))))
    (dotimes (i (length string))
      (setf (aref octets i) (char-code (aref string i))))
    (flex:octets-to-string octets :external-format external-format)))

(defun parse-rfc2388-form-data (stream content-type-header external-format)
  "Creates an alist of POST parameters from the stream STREAM which is
supposed to be of content type 'multipart/form-data'."
  (let* ((parsed-content-type-header (rfc2388:parse-header content-type-header :value))
	 (boundary (or (cdr (rfc2388:find-parameter
                             "BOUNDARY"
                             (rfc2388:header-parameters parsed-content-type-header)))
		       (return-from parse-rfc2388-form-data))))
    (loop for part in (rfc2388:parse-mime stream boundary)
          for headers = (rfc2388:mime-part-headers part)
          for content-disposition-header = (rfc2388:find-content-disposition-header headers)
          for name = (cdr (rfc2388:find-parameter
                           "NAME"
                           (rfc2388:header-parameters content-disposition-header)))
          when name
          collect (cons name
                        (let ((contents (rfc2388:mime-part-contents part)))
                          (if (pathnamep contents)
                            (list contents
                                  (rfc2388:get-file-name headers)
                                  (rfc2388:content-type part :as-string t))
                            (convert-hack contents external-format)))))))

(defun get-post-data (&key (request *request*) want-stream (already-read 0))<commit_msg>nicer looking drivers<commit_after>;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*-
;;; $Header: /usr/local/cvsrep/hunchentoot/request.lisp,v 1.35 2008/02/13 16:02:18 edi Exp $

;;; Copyright (c) 2004-2008, Dr. <NAME>.  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)

(defclass request ()
  ((headers-in :initarg :headers-in
               :documentation "An alist of the incoming headers."
               :reader headers-in)
   (method :initarg :method
           :documentation "The request method as a keyword."
           :reader request-method)
   (uri :initarg :uri
        :documentation "The request URI as a string."
        :reader request-uri)
   (server-protocol :initarg :server-protocol
                    :documentation "The HTTP protocol as a keyword."
                    :reader server-protocol)
   (remote-addr :initarg :remote-addr
                :documentation "The IP address of the client that
initiated this request."
                :reader remote-addr)
   (remote-port :initarg :remote-port
                :documentation "The TCP port number of the client
socket from which this request originated."
                :reader remote-port)
   (content-stream :initarg :content-stream
                   :reader content-stream
                   :documentation "A stream from which the request
body can be read if there is one.")
   (cookies-in :initform nil
               :documentation "An alist of the cookies sent by the client."
               :reader cookies-in)
   (get-parameters :initform nil
                   :documentation "An alist of the GET parameters sent
by the client."
                   :reader get-parameters)
   (post-parameters :initform nil
                    :documentation "An alist of the POST parameters
sent by the client."
                    :reader post-parameters)
   (script-name :initform nil
                :documentation "The URI requested by the client without
the query string."
                :reader script-name)
   (query-string :initform nil
                 :documentation "The query string of this request."
                 :reader query-string)
   (session :initform nil
            :accessor session
            :documentation "The session object associated with this
request.")
   (aux-data :initform nil
             :accessor aux-data
             :documentation "Used to keep a user-modifiable alist with
arbitrary data during the request.")
   (raw-post-data :initform nil
                  :documentation "The raw string sent as the body of a
POST request, populated only if not a multipart/form-data request."))
  (:documentation "Objects of this class hold all the information
about an incoming request.  They are created automatically by
Hunchentoot and can be accessed by the corresponding handler.

You should not mess with the slots of these objects directly, but you
can subclass REQUEST in order to implement your own behaviour.  See
for example the REQUEST-CLASS keyword argument of START-SERVER and the
function DISPATCH-REQUEST."))

(defun convert-hack (string external-format)
  "The rfc2388 package is buggy in that it operates on a character
stream and thus only accepts encodings which are 8 bit transparent.
In order to support different encodings for parameter values
submitted, we post process whatever string values the rfc2388 package
has returned."
  (flex:octets-to-string (map '(vector (unsigned-byte 8) *) 'char-code string)
                         :external-format external-format))

(defun parse-rfc2388-form-data (stream content-type-header external-format)
  "Creates an alist of POST parameters from the stream STREAM which is
supposed to be of content type 'multipart/form-data'."
  (let* ((parsed-content-type-header (rfc2388:parse-header content-type-header :value))
	 (boundary (or (cdr (rfc2388:find-parameter
                             "BOUNDARY"
                             (rfc2388:header-parameters parsed-content-type-header)))
		       (return-from parse-rfc2388-form-data))))
    (loop for part in (rfc2388:parse-mime stream boundary)
          for headers = (rfc2388:mime-part-headers part)
          for content-disposition-header = (rfc2388:find-content-disposition-header headers)
          for name = (cdr (rfc2388:find-parameter
                           "NAME"
                           (rfc2388:header-parameters content-disposition-header)))
          when name
          collect (cons name
                        (let ((contents (rfc2388:mime-part-contents part)))
                          (if (pathnamep contents)
                            (list contents
                                  (rfc2388:get-file-name headers)
                                  (rfc2388:content-type part :as-string t))
                            (convert-hack contents external-format)))))))

(defun get-post-data (&key (request *request*) want-stream (already-read 0))
{'fraction_non_alphanumeric': 0.08212058212058213, 'fraction_numerical': 0.01439309131616824, 'mean_word_length': 2.6001727115716755, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 5, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 4, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4686531', 'n_tokens_mistral': 3452, 'n_tokens_neox': 3146, 'n_words': 1310}