From 22b2bf1abd62cb3aeaa6398dfb486457e5d431fa Mon Sep 17 00:00:00 2001
From: "Pierre R. Mai" <pmai@pmsf.de>
Date: Sat, 22 Jul 2000 00:18:59 +0000
Subject: [PATCH] Changes that bring CLASH up to extended HTTP/1.0 support:

Moved some of the common parsing and rendering subroutines to a new
file.  Many other functions should probably be moved over here, so
watch this space as clean up progresses further.
---
 src/main/parsing.cl | 64 +++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 64 insertions(+)
 create mode 100644 src/main/parsing.cl

diff --git a/src/main/parsing.cl b/src/main/parsing.cl
new file mode 100644
index 0000000..8c512e0
--- /dev/null
+++ b/src/main/parsing.cl
@@ -0,0 +1,64 @@
+;;;; CLASH --- The Common Lisp Adaptable Simple HTTP server
+;;;; This is copyrighted software.  See documentation for terms.
+;;;; 
+;;;; parsing.cl --- General HTTP parsing routines
+;;;; 
+;;;; Checkout Tag: $Name$
+;;;; $Id$
+
+(in-package :CLASH)
+
+;;;; %File Description:
+;;;; 
+;;;; This file implements various parsing routines useful in dealing
+;;;; with HTTP component constructs, based on the HTTP grammar.
+;;;; 
+
+(defconstant +HTTP-LWS-CHARACTER-BAG+ '(#\Space #\Tab)
+  "HTTP LWS characters.")
+
+(defun string-trim-lws (string)
+  "Trim HTTP LWS from string."
+  (string-trim +HTTP-LWS-CHARACTER-BAG+ string))
+
+(defun parse-simple-list (string &key (list-delimiter #\,))
+  "Parse a simple HTTP list from the string, returning a list of strings."
+  (mapcar #'string-trim-lws
+	  (partition list-delimiter string :remove-empty-subseqs t)))
+
+(defun parse-key-value-list
+    (string &key (list-delimiter #\,) (pair-delimiter #\=))
+  "Parse a list of key-value pairs from the string, returning an alist."
+  (mapcar #'(lambda (elem)
+	      (let* ((pos (position pair-delimiter elem))
+		     (key (subseq elem 0 pos))
+		     (value (subseq elem (1+ pos))))
+		(cons key value)))
+	  (parse-simple-list string :list-delimiter list-delimiter)))
+
+(defun rfc1123-format-time (universal-time)
+  (multiple-value-bind (second minute hour date month year day daylight-p zone)
+      (decode-universal-time universal-time 0)
+    (declare (ignore daylight-p zone))
+    (let ((wkday (aref #("Mon" "Tue" "Wed" "Thu" "Fri" "Sat" "Sun") day))
+	  (full-month (aref #("Jan" "Feb" "Mar" "Apr" "May" "Jun"
+			      "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")
+			    (1- month))))
+      (format nil "~A, ~2,'0D ~A ~4,'0D ~2,'0D:~2,'0D:~2,'0D GMT"
+	      wkday date full-month year hour minute second))))
+
+(defun merge-multiple-keys (a-list &key (test #'eql))
+  "Merge multiple entries in an a-list into one entry which contains
+the list of values.  All other entries are kept."
+  (do* ((result nil)
+	(rest a-list (rest rest))
+	(key (caar rest) (caar rest))
+	(entry (assoc key result :test test) (assoc key result :test test))
+	(value (cdar rest) (cdar rest)))
+       ((null rest) result)
+    (if entry
+	(setf (cdr entry)
+	      (if (consp (cdr entry))
+		  (cons value (cdr entry))
+		  (list value (cdr entry))))
+	(push (cons key value) result))))