Added access authorization framework, added port to ACL 5. ACL 5

seems to need eval-when wrapped around certain defconstant forms when
used in the same file (maybe because of compiler-macros).

CLASH.system

@@ -28,7 +28,9 @@
 			   #+CMU
 			   (:file "cmu-locking" :depends-on ("package"))
 			   #+LISPWORKS4.1
-			   (:file "lwl-locking" :depends-on ("package"))))
+			   (:file "lwl-locking" :depends-on ("package"))
+			   #+ALLEGRO
+			   (:file "acl-locking" :depends-on ("package"))))
      (:module "main"
 	      :source-pathname "main"
 	      :components ((:file "status-codes")
@@ -66,6 +68,8 @@
 				  :depends-on ("messages" "entity" "server"))
 			   (:file "session"
 				  :depends-on ("resource" "entity" "messages"))
+			   (:file "authorization"
+				  :depends-on ("resource" "messages"))
 			   (:file "logging"
 				  :depends-on ("messages" "entity" "server"))
 			   (:file "readtable"
@@ -78,5 +82,7 @@
 	      :components (#+CMU
 	                   (:file "simple-cmu")
 			   #+LISPWORKS4.1
-			   (:file "simple-lwl"))
+			   (:file "simple-lwl")
+			   #+ALLEGRO
+			   (:file "simple-acl"))
 	      :depends-on ("base" "main"))))

src/acl-locking.cl

@@ -0,0 +1,24 @@
+;;;; CLASH --- The Common Lisp Adaptable Simple HTTP server
+;;;; This is copyrighted software.  See documentation for terms.
+;;;; 
+;;;; acl-locking.cl --- Platform independent locking primitives
+;;;; 
+;;;; Checkout Tag: $Name$
+;;;; $Id$
+
+(in-package :CLASH)
+
+;;;; %File Description:
+;;;; 
+;;;; 
+;;;; 
+
+;;; Locking primitives for ACL
+
+(defmacro pop-atomically (place)
+  `(mp:without-scheduling
+    (pop ,place)))
+
+(defmacro push-atomically (value place)
+  `(mp:without-scheduling
+    (push ,value ,place)))

src/drivers/simple-acl.cl

@@ -0,0 +1,54 @@
+;;;; CLASH --- The Common Lisp Adaptable Simple HTTP server
+;;;; This is copyrighted software.  See documentation for terms.
+;;;; 
+;;;; simple-acl.cl --- Simple driver for Allegro Common Lisp
+;;;; 
+;;;; Checkout Tag: $Name$
+;;;; $Id$
+
+(in-package :CLASH)
+
+;;;; %File Description:
+;;;; 
+;;;; 
+;;;; 
+
+(defclass acl-connection (connection)
+  ((stream :initarg :stream :reader connection-stream)))
+
+(defmethod connection-address ((connection acl-connection))
+  (socket:remote-host (connection-stream connection)))
+
+(defmethod connection-hostname ((connection acl-connection))
+  (socket:ipaddr-to-hostname (connection-address connection)))
+  
+(defmethod close-connection ((connection acl-connection))
+  (ignore-errors
+    (let ((stream (connection-stream connection)))
+      (finish-output stream)
+      (close stream))))
+
+(defun start-http-handler (stream server)
+  (let ((connection (make-instance 'acl-connection :stream stream)))
+    (mp:process-run-function (format nil "HTTP connection from ~A"
+				     (connection-address connection))
+			     #'serve-connection
+			     server connection)))
+
+(defun http-listener (socket server)
+  (loop
+      (start-http-handler (socket:accept-connection socket) server)))
+
+(defun start-http-listener (port server)
+  (let ((socket (socket:make-socket :type :stream :format :text
+				    :address-family :internet
+				    :connect :passive
+				    :local-port port)))
+    (mp:process-run-function (format nil
+				     "HTTP connection listener for port ~D"
+				     port)
+			     #'http-listener
+			     socket server)))
+
+(defun initialize-clash ()
+  t)

src/main/parsing.cl

@@ -14,6 +14,8 @@
 ;;;; with HTTP component constructs, based on the HTTP grammar.
 ;;;; 
 
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  
 (defconstant +HTTP-LWS-Character-Bag+ '(#\Space #\Tab)
   "HTTP LWS characters.")
 
@@ -26,6 +28,8 @@
 (defconstant +HTTP-Pair-Delimiter+ #\=
   "HTTP key-value pair delimiter character.")
 
+)
+
 (defun char-lws-p (char)
   (declare (type character char))
   (member char +HTTP-LWS-Character-Bag+ :test #'char=))