cl-http cmucl18e patch

diff -ru cl-http-70-159-devo.orig/cmucl/client/sysdcl.lisp cl-http-70-159-devo/cmucl/client/sysdcl.lisp
--- cl-http-70-159-devo.orig/cmucl/client/sysdcl.lisp	Wed Jul 16 14:57:20 2003
+++ cl-http-70-159-devo/cmucl/client/sysdcl.lisp	Wed Jul 16 15:01:05 2003
@@ -12,7 +12,7 @@
 
 (in-package "CL-USER")
 
-(defsystem cl-http-client
+(mk:defsystem cl-http-client
 	   :source-pathname "HTTP:"
 	   :components
 	   ("client;variables"			; Client variables
Only in cl-http-70-159-devo/cmucl: defsystem.lbytef
diff -ru cl-http-70-159-devo.orig/cmucl/html-parser/sysdcl.lisp cl-http-70-159-devo/cmucl/html-parser/sysdcl.lisp
--- cl-http-70-159-devo.orig/cmucl/html-parser/sysdcl.lisp	Wed Jul 16 14:57:20 2003
+++ cl-http-70-159-devo/cmucl/html-parser/sysdcl.lisp	Wed Jul 16 18:39:12 2003
@@ -53,7 +53,7 @@
 	`(("*.*.*" ,(namestring (merge-pathnames "html-parser/v10/*.*.*"
 						 *http-directory*))))))
 
-(defsystem html-parser
+(mk:defsystem html-parser
   :source-pathname "HTML-PARSER:"
   :components
   ("packages"
diff -ru cl-http-70-159-devo.orig/cmucl/lambda-ir/sysdcl.lisp cl-http-70-159-devo/cmucl/lambda-ir/sysdcl.lisp
--- cl-http-70-159-devo.orig/cmucl/lambda-ir/sysdcl.lisp	Wed Jul 16 14:57:20 2003
+++ cl-http-70-159-devo/cmucl/lambda-ir/sysdcl.lisp	Wed Jul 16 15:01:23 2003
@@ -1,6 +1,6 @@
 
 ;;;
-(defsystem lambda-ir
+(mk:defsystem lambda-ir
     :source-pathname "HTTP:"
     :components
     ("lambda-ir;package"
diff -ru cl-http-70-159-devo.orig/cmucl/proxy/sysdcl.lisp cl-http-70-159-devo/cmucl/proxy/sysdcl.lisp
--- cl-http-70-159-devo.orig/cmucl/proxy/sysdcl.lisp	Wed Jul 16 14:57:20 2003
+++ cl-http-70-159-devo/cmucl/proxy/sysdcl.lisp	Wed Jul 16 15:01:26 2003
@@ -5,7 +5,7 @@
 
 (in-package :cl-user)
 
-(defsystem cl-http-proxy
+(mk:defsystem cl-http-proxy
     :source-pathname "HTTP:"
     :components
     (;; Proxy layer
diff -ru cl-http-70-159-devo.orig/cmucl/server/sysdcl.lisp cl-http-70-159-devo/cmucl/server/sysdcl.lisp
--- cl-http-70-159-devo.orig/cmucl/server/sysdcl.lisp	Wed Jul 16 14:57:20 2003
+++ cl-http-70-159-devo/cmucl/server/sysdcl.lisp	Wed Jul 16 15:01:30 2003
@@ -2,7 +2,7 @@
 
 (in-package "CL-USER")
 
-(defsystem cl-http                          
+(mk:defsystem cl-http                          
   :source-pathname "HTTP:"
   :components
   ("cmucl;server;cmucl-patch"	; CMU CL patches.
@@ -99,7 +99,7 @@
       :source-pathname "cmucl;server;"
       :components ("precom"))))
 
-(defsystem cl-http-examples
+(mk:defsystem cl-http-examples
     :source-pathname "HTTP:examples;"
     :components
     ("configuration"	; server configuration file
diff -ru cl-http-70-159-devo.orig/cmucl/server/tcp-interface-mp.lisp cl-http-70-159-devo/cmucl/server/tcp-interface-mp.lisp
--- cl-http-70-159-devo.orig/cmucl/server/tcp-interface-mp.lisp	Wed Jul 16 14:57:20 2003
+++ cl-http-70-159-devo/cmucl/server/tcp-interface-mp.lisp	Wed Jul 16 18:28:04 2003
@@ -63,10 +63,10 @@
 		      (handler-case
 		       (setf fd (ext:create-inet-listener port :stream
 							  :reuse-address t))
-		       (error ()
+		       (error (condition)
 		         (format t "~&Warning: unable to create listner on ~
-				    port ~d; retry in ~d seconds.~%"
-				 port retry-wait)
+				    port ~d; retry in ~d seconds (~a).~%"
+				 port retry-wait condition)
 			 (sleep retry-wait))))
 		    (loop
 		     ;; Wait until input ready.
@@ -81,7 +81,6 @@
 				    new-fd=~s port-~s~%" fd new-fd port))
 		       (let ((stream (www-utils::make-tcp-stream new-fd port)))
 			 ;; Make it non-blocking.
-			 #+nil
 			 (unix:unix-fcntl new-fd unix:f-setfl unix:fndelay)
 			 (listen-for-connection stream port)))))
 	       ;; Close the listener stream.
@@ -187,12 +186,16 @@
   (disable-http-service on-ports)
   ;; before starting a new batch
   (dolist (port (setf (listening-on-http-ports) (ensure-list on-ports)))
-    (%start-listening-for-connections port 0)
+    (ensure-http-protocol-on-port port)
     ;; Advise the user.
     (expose-log-window)
     (notify-log-window "HTTP service enabled for: http://~A:~D/"
                        (www-utils:local-host-domain-name) port))
   on-ports)
+
+(defun ensure-http-protocol-on-port (port)
+  (unless (assoc port *listener-processes*)
+    (%start-listening-for-connections port 0)))
 
 (defun disable-http-service (&optional ports)
   ;; Disable all listeners.
diff -ru cl-http-70-159-devo.orig/cmucl/server/tcp-interface.lisp cl-http-70-159-devo/cmucl/server/tcp-interface.lisp
--- cl-http-70-159-devo.orig/cmucl/server/tcp-interface.lisp	Wed Jul 16 14:57:20 2003
+++ cl-http-70-159-devo/cmucl/server/tcp-interface.lisp	Wed Jul 16 18:25:05 2003
@@ -50,7 +50,7 @@
   timeout, TIMEOUT."
   (let ((fd (handler-case
 	     (ext:create-inet-listener port :stream :reuse-address t)
-	     (error ()
+	     (error (condition)
 	       (format t "~&Warning: unable to create listner on port ~d~%"
 		       port)
 	       nil))))
diff -ru cl-http-70-159-devo.orig/cmucl/server/unix.lisp cl-http-70-159-devo/cmucl/server/unix.lisp
--- cl-http-70-159-devo.orig/cmucl/server/unix.lisp	Wed Jul 16 14:57:20 2003
+++ cl-http-70-159-devo/cmucl/server/unix.lisp	Wed Jul 16 15:12:28 2003
@@ -753,7 +753,9 @@
 
 (defun http-user-email-address ()
   "Return the login name of the user running the server."
-  (lisp::lookup-login-name (unix:unix-getuid)))
+;;  (lisp::lookup-login-name (unix:unix-getuid)))
+    (unix:user-info-name (unix:unix-getpwuid (unix:unix-getuid))))
+
 
 (define tcp-service-port-number (protocol &optional error-p)
   "Returns the service port number for the TCP protocol denoted by protocol.
diff -ru cl-http-70-159-devo.orig/cmucl/start.lisp cl-http-70-159-devo/cmucl/start.lisp
--- cl-http-70-159-devo.orig/cmucl/start.lisp	Wed Jul 16 14:57:20 2003
+++ cl-http-70-159-devo/cmucl/start.lisp	Wed Jul 16 17:30:20 2003
@@ -23,7 +23,7 @@
   #+nil (pushnew 'compile pcl::*defclass-times*)
   #+nil (pushnew 'compile pcl::*defgeneric-times*))
 
-#+cmu17
+#+cmu
 (setf c:*suppress-values-declaration* t)
 
 (defvar *cl-http-options*
@@ -45,7 +45,9 @@
 
 (defvar *http-directory*
   ;; The default; compiling from within the cl-http/ directory.
-  (ext:default-directory)
+  ;; (ext:default-directory)
+  "/usr/home/dov/cl-http-70-159-devo/")
+
   ;; Can override the above which is necessary if not loading from the
   ;; cl-http source root directory.
   #+nil "/<cl-http source root directory>/")
@@ -96,52 +98,52 @@
 	   ((:and :external :macro)
 	    (declare (optimize (safety 2))))
 	   (:macro (declare (optimize (speed 0))))))
-	(compile-system 'cl-http)
+	(mk:compile-system 'cl-http)
 	(when (member :cl-http-client *cl-http-options*)
-	  (compile-system 'cl-http-client))
+	  (mk:compile-system 'cl-http-client))
 	(when (member :cl-http-proxy *cl-http-options*)
-	  (compile-system 'cl-http-proxy))
+	  (mk:compile-system 'cl-http-proxy))
 	(when (member :w4-web-walker *cl-http-options*)
-	  (compile-system 'w4-web-walker))
+	  (mk:compile-system 'w4-web-walker))
 	(when (member :lambda-ir *cl-http-options*)
-	  (compile-system 'lambda-ir))
+	  (mk:compile-system 'lambda-ir))
 	(when (member :cl-http-examples *cl-http-options*)
-	  (compile-system 'cl-http-examples))
+	  (mk:compile-system 'cl-http-examples))
 	(when (member :w4-web-walker-demo *cl-http-options*)
-	  (compile-system 'w4-web-walker-demo))))
+	  (mk:compile-system 'w4-web-walker-demo))))
       (t
-       (load-system 'cl-http
+       (mk:load-system 'cl-http
 		    :compile-during-load ()
 		    :load-source-if-no-binary t
 		    :bother-user-if-no-binary ())
        (when (member :cl-http-client *cl-http-options*)
-	 (load-system 'cl-http-client
+	 (mk:load-system 'cl-http-client
 		      :compile-during-load ()
 		      :load-source-if-no-binary t
 		      :bother-user-if-no-binary ()))
        (when (member :cl-http-proxy *cl-http-options*)
-	 (load-system 'cl-http-proxy
+	 (mk:load-system 'cl-http-proxy
 		      :compile-during-load ()
 		      :load-source-if-no-binary t
 		      :bother-user-if-no-binary ()))
        (when (member :w4-web-walker *cl-http-options*)
-	 (load-system 'w4-web-walker
+	 (mk:load-system 'w4-web-walker
 		      :compile-during-load ()
 		      :load-source-if-no-binary t
 		      :bother-user-if-no-binary ()))
        (when (member :lambda-ir *cl-http-options*)
-	 (load-system 'lambda-ir
+	 (mk:load-system 'lambda-ir
 		      :compile-during-load ()
 		      :load-source-if-no-binary t
 		      :bother-user-if-no-binary ()))
        (when (member :cl-http-examples *cl-http-options*)
-	 (load-system 'cl-http-examples
+	 (mk:load-system 'cl-http-examples
 		      :compile-during-load ()
 		      :load-source-if-no-binary t
 		      :bother-user-if-no-binary ()))
        (when (and (member :cl-http-examples *cl-http-options*)
 		  (member :w4-web-walker-demo *cl-http-options*))
-	 (load-system 'w4-web-walker-demo
+	 (mk:load-system 'w4-web-walker-demo
 		      :compile-during-load ()
 		      :load-source-if-no-binary t
 		      :bother-user-if-no-binary ()))))
@@ -149,8 +151,8 @@
 ;;; Compile and load the HTML parser which may be loaded stand-alone.
 (when (member :html-parser *cl-http-options*)
   (load "HTTP:html-parser;v10;sysdcl.lisp")
-  (compile-system 'html-parser)
-  (load-system 'html-parser
+  (mk:compile-system 'html-parser)
+  (mk:load-system 'html-parser
 	       :compile-during-load ()
 	       :load-source-if-no-binary t
 	       :bother-user-if-no-binary ()))
@@ -164,7 +166,8 @@
   (http:enable-http-service))
 
 ;;; Example multi-processing setup.
-#+(and MP nil)
+;; #+(and MP nil)
+#+MP
 (progn
   ;; Setup the event server timeout so that an interactive process can
   ;; act as the idle loop.
diff -ru cl-http-70-159-devo.orig/cmucl/w4/sysdcl.lisp cl-http-70-159-devo/cmucl/w4/sysdcl.lisp
--- cl-http-70-159-devo.orig/cmucl/w4/sysdcl.lisp	Wed Jul 16 14:57:20 2003
+++ cl-http-70-159-devo/cmucl/w4/sysdcl.lisp	Wed Jul 16 15:01:33 2003
@@ -4,7 +4,7 @@
 
 (in-package "CL-USER")
 
-(defsystem w4-web-walker
+(mk:defsystem w4-web-walker
   :source-pathname "HTTP:"
   :components
   ("client;w4-client"			; W4 client support methods
@@ -18,7 +18,7 @@
    "w4;actions"				; Action definitions
    "w4;activity"))			; Activity definitions
 
-(defsystem w4-web-walker-demo
+(mk:defsystem w4-web-walker-demo
   :source-pathname "HTTP:"
   :components
   ("examples;configuration"             ; Standard configuration
Only in cl-http-70-159-devo: log
diff -ru cl-http-70-159-devo.orig/mcl/server/www-utils.lisp cl-http-70-159-devo/mcl/server/www-utils.lisp
--- cl-http-70-159-devo.orig/mcl/server/www-utils.lisp	Wed Jul 16 14:57:26 2003
+++ cl-http-70-159-devo/mcl/server/www-utils.lisp	Wed Jul 16 18:36:13 2003
@@ -20,16 +20,15 @@
 ;; This value should be set by the port after loading http:mac;www-utils.lisp
 (defvar cl-user::*cl-http-server-version*)
 
-(declaim (inline %server-version))
+;; (declaim (inline %server-version))
 
 ;; Set this for each port by setting cl-user::*cl-http-server-version*
 ;; to a '(major minor port-major port-minor &optional port-patch-level)
 (defun %server-version-info ()
   "Returns the version numbers for the server and the port."
-  (declare (values major minor port-major port-minor port-patch-level))
+;;  (declare (values major minor port-major port-minor port-patch-level))
   cl-user::*cl-http-server-version*)
 
-#+ignore
 (define server-version ()
   "Returns the server version,
 for example \"CL-HTTP/41.4/MCL/1.7.1\""
diff -ru cl-http-70-159-devo.orig/server/http-conditions.lisp cl-http-70-159-devo/server/http-conditions.lisp
--- cl-http-70-159-devo.orig/server/http-conditions.lisp	Wed Jul 16 14:57:27 2003
+++ cl-http-70-159-devo/server/http-conditions.lisp	Wed Jul 16 15:15:27 2003
@@ -423,7 +423,7 @@
 
 (define-condition redirection (reportable-condition) ())
 
-(define-condition temporary-redirection (redirection) ())
+;; (define-condition temporary-redirection (redirection) ())
 
 (define-condition http/1.1-redirection-downgrade-mixin () ())
 
diff -ru cl-http-70-159-devo.orig/server/utils.lisp cl-http-70-159-devo/server/utils.lisp
--- cl-http-70-159-devo.orig/server/utils.lisp	Wed Jul 16 14:57:27 2003
+++ cl-http-70-159-devo/server/utils.lisp	Wed Jul 16 18:20:08 2003
@@ -694,6 +694,7 @@
 
 ;; Initialize the idle http process scavenger
 ;; This is a key feature for production servers and a security feature.
+#+(or Genera MCL)
 (add-initialization
   "Synchronize Idle Connection Scavenger"
   '(www-utils::synchronize-idle-http-process-scavenger)