r5233: *** empty log message ***

diff --git a/base.lisp b/base.lisp
index 15ff3e12a450b4b42d3b2cfd136ad3292735b25e..6b63c4d06e1a24330cc690b311677130deb6ac27 100644 (file)
--- a/base.lisp
+++ b/base.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Dec 2002
 ;;;;
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Dec 2002
 ;;;;

-;;;; $Id: base.lisp,v 1.2 2003/07/04 22:41:06 kevin Exp $
+;;;; $Id: base.lisp,v 1.3 2003/07/05 00:51:04 kevin Exp $

 ;;;; *************************************************************************
 
 (in-package #:modlisp)
 ;;;; *************************************************************************
 
 (in-package #:modlisp)


@@ -22,7 +22,7 @@
        (make-socket-server (next-server-name) function port
                            :format :text :wait nil)
       (error (e)
        (make-socket-server (next-server-name) function port
                            :format :text :wait nil)
       (error (e)

-       (format t "Error ~A" e)
+       (format t "~&Error while trying to start modlisp server~&  ~A" e)

        (decf *listener-count*)
        nil)
       (:no-error (process socket)
        (decf *listener-count*)
        nil)
       (:no-error (process socket)


@@ -32,18 +32,24 @@
   
   (defun modlisp-stop ()
     (when *listener-process*
   
   (defun modlisp-stop ()
     (when *listener-process*

-      (format t "~&; killing process ~d~%" *listener-process*)
-      #+sbcl (sb-thread:destory-thread *listener-process*)
-      #+allegro (mp:process-kill *listener-process*)
-      #+allegro (mp:process-allow-schedule)
-      #+lispworks (mp:process-kill *listener-process*)
-      #+cmucl (mp:destroy process *listener-process*)
-      (setq *listener-process* nil))
-    (when *listener-socket* 
+      (format t "~&; killing modlisp server process ~A~%" *listener-process*)
+      (handler-case
+         (progn
+           #+sbcl (sb-thread:destroy-thread *listener-process*)
+           #+cmucl (mp:destroy-process *listener-process*)
+           #+allegro (mp:process-kill *listener-process*)
+           #+allegro (mp:process-allow-schedule)
+           #+lispworks (mp:process-kill *listener-process*))
+       (error (e)
+         (format t "~&Error while trying to kill modlisp server~&  ~A" e))
+       (:no-error (res)
+         (declare (ignore res))
+         (setq *listener-process* nil))))
+    (when *listener-socket*

       (ignore-errors (close *listener-socket*))
       (setq *listener-socket* nil)))
   
       (ignore-errors (close *listener-socket*))
       (setq *listener-socket* nil)))
   

- )
+ ) ;; closure

     
 (defun next-server-name ()
   (format nil "modlisp-socket-server-~d" (incf *listener-count*))) 
     
 (defun next-server-name ()
   (format nil "modlisp-socket-server-~d" (incf *listener-count*))) 


@@ -51,27 +57,39 @@
 (defun next-worker-name ()
   (format nil "modlisp-worker-~d" (incf *worker-count*)))
 
 (defun next-worker-name ()
   (format nil "modlisp-worker-~d" (incf *worker-count*)))
 

-
-(defun apache-command-issuer (*apache-socket* processor-fun)
-  "generates commands from apache, issues commands to processor-fun"
-  (let ((*close-apache-socket* t))
+(let ((*number-server-requests* 0)
+      (*number-worker-requests* 0)
+      (*close-apache-socket* t))
+  
+  (defun apache-command-issuer (*apache-socket* processor-fun)
+    "generates commands from apache, issues commands to processor-fun"

     (unwind-protect
     (unwind-protect

-       (loop for *apache-nb-use-socket* from 0
-           for command = (get-apache-command)
-           while command 
-           do (funcall processor-fun command)
-             (force-output *apache-socket*)
-           until *close-apache-socket*)
-      (close *apache-socket*))))
+        (progn
+          (setq *number-worker-requests* 0)
+          (do ((command (read-apache-command) (read-apache-command)))
+              ((null command) 'done)
+            (funcall processor-fun command)
+            (force-output *apache-socket*)
+            (incf *number-worker-requests*)
+            (incf *number-server-requests*)
+            (when *close-apache-socket*
+              (return))))
+      (close *apache-socket*)))
+
+  (defun get-number-worker-requests ()
+    *number-worker-requests*)
+
+  (defun get-number-server-requests ()
+    *number-server-requests*)
+  
+  (defun set-close-apache-socket (close?)
+    (setq *close-apache-socket* close?))
+  
+  ) ;; closure

 
 

-(defun get-apache-command ()
+(defun read-apache-command ()

   (ignore-errors
   (ignore-errors

-   (let* ((header (loop for key = (read-line *apache-socket* nil nil)
-                       while (and key
-                                  (string-not-equal key "end")
-                                  (> (length key) 1))
-                     for value = (read-line *apache-socket* nil nil)
-                     collect (cons key value)))
+    (let* ((header (read-apache-header))

          (content-length (cdr (assoc "content-length" header :test #'equal)))
          (content (when content-length 
                     (make-string
          (content-length (cdr (assoc "content-length" header :test #'equal)))
          (content (when content-length 
                     (make-string


@@ -81,6 +99,14 @@
        (push (cons "posted-content" content) header))
      header)))
 
        (push (cons "posted-content" content) header))
      header)))
 

+(defun read-apache-header ()
+  (loop for key = (read-line *apache-socket* nil nil)
+                       while (and key
+                                  (string-not-equal key "end")
+                                  (> (length key) 1))
+                     for value = (read-line *apache-socket* nil nil)
+                     collect (cons key value)))
+

 (defun write-header-line (key value)
   (write-string key *apache-socket*)
   (write-char #\NewLine *apache-socket*)
 (defun write-header-line (key value)
   (write-string key *apache-socket*)
   (write-char #\NewLine *apache-socket*)


@@ -90,50 +116,3 @@
 (defun header-value (command key)
   (cdr (assoc key command :test #'string=)))
 
 (defun header-value (command key)
   (cdr (assoc key command :test #'string=)))
 

-
-;;; Default (demo) processor
-
-(defun demo-apache-command-processor (command)
-  "Sample function to process an apache command"
-  (if (equal (header-value command "url") "/asp/fixed")
-      (fixed-request)
-      (debug-request command)))
-
-(defun fixed-request ()
-  (let ((html (fixed-html)))
-    (write-header-line "Status" "200 OK")
-    (write-header-line "Content-Type" "text/html")
-    (write-header-line "Content-Length" (format nil "~d" (length html)))
-    (write-header-line "Keep-Socket" "1")
-    (write-string "end" *apache-socket*)
-    (write-char #\NewLine *apache-socket*)
-    (write-string html *apache-socket*)
-    (setq *close-apache-socket* nil))  )
-
-(defun debug-request (command)
-  (let ((html (debug-table command)))
-    (write-header-line "Status" "200 OK")
-    (write-header-line "Content-Type" "text/html")
-    (write-header-line "Keep-Socket" "0")
-    (write-string "end" *apache-socket*)
-    (write-char #\NewLine *apache-socket*)
-    (write-string html *apache-socket*)
-    (setq *close-apache-socket* t))  )
-
-(defun debug-table (command)
-  (with-output-to-string (s)
-   (write-string "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">
-<html><head></head>
-<body>
-<table><tbody>
-<tr><t colspan=\"2\">mod_lisp debug</th></tr>
-<tr><th>Key</th><th>Value</th></tr>" s)
-   (format s "<TR bgcolor=\"#F0F0c0\"><TD>apache-nb-use-socket</TD><TD>~a</TD></TR>"  *apache-nb-use-socket*)
-   (loop for (key . value) in command do
-        (format s "<tr><td>~a</td><td>~a</td></tr>" key value))
-   (write-string "</tbody></table></body></html>" s)))
-
-(defun fixed-html ()
-  "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">
-<html><head></head><body><h1>mod_lisp</h1>
-<p>This is a constant html string sent by mod_lisp</p></body></html>")

diff --git a/debian/control b/debian/control
index b726ddc37def5ec1ab9bb74b1d52c6d49047035a..32e5585e4631cb7f0fa4179dfd48ccb200907fc9 100644 (file)
--- a/debian/control
+++ b/debian/control
@@ -7,7 +7,7 @@ Standards-Version: 3.5.10.0
 
 Package: cl-modlisp
 Architecture: all
 
 Package: cl-modlisp
 Architecture: all

-Depends: ${shlibs:Depends}, common-lisp-controller (>= 3.37),libapache-mod-lisp,cl-kmrcl 
+Depends: ${shlibs:Depends}, common-lisp-controller (>= 3.37),libapache-mod-lisp,cl-kmrcl

 Description: Common Lisp interface to the Apache mod-lisp module
  cl-modlisp provides a Common Lisp interface to the mod-lisp Apache module.
  The package has support for CMUCL, SBCL, CLISP, AllegroCL, and Lispworks.
 Description: Common Lisp interface to the Apache mod-lisp module
  cl-modlisp provides a Common Lisp interface to the mod-lisp Apache module.
  The package has support for CMUCL, SBCL, CLISP, AllegroCL, and Lispworks.

diff --git a/impl-cmucl.lisp b/impl-cmucl.lisp
index fc45602e6c3ada52e77e56caabf577d6b6193f80..c98a05ea24ef31fba1ef77d374b8785be6a2dcbf 100644 (file)
--- a/impl-cmucl.lisp
+++ b/impl-cmucl.lisp
@@ -4,19 +4,21 @@
 
 
 (defun make-socket-server (name function port &key wait (format :text))
 
 
 (defun make-socket-server (name function port &key wait (format :text))

-  (mp:make-process
-   (lambda () (make-apache-listener port function))
-   :name name))
+  (let ((listener (ext:create-inet-listener port)))
+  (values
+   (mp:make-process
+    (lambda () (start-socket-server listener function))
+    :name name)
+   listener)))

 
 

-(defun make-apache-listener (port function)
-  (let ((socket (ext:create-inet-listener port)))
-    (unwind-protect
-        (loop
-         (mp:process-wait-until-fd-usable socket :input)
-         (multiple-value-bind (new-fd remote-host)
-             (ext:accept-tcp-connection socket)
-           (let ((stream (sys:make-fd-stream new-fd :input t :output t)))
-             (mp:make-process
-              (lambda () (apache-command-issuer stream function))
-              :name (next-worker-name)))))
-      (unix:unix-close socket))))
+(defun start-socket-server (listener function)
+  (unwind-protect
+       (loop
+       (mp:process-wait-until-fd-usable listener :input)
+       (multiple-value-bind (new-fd remote-host)
+           (ext:accept-tcp-connection listener)
+         (let ((stream (sys:make-fd-stream new-fd :input t :output t)))
+           (mp:make-process
+            (lambda () (apache-command-issuer stream function))
+            :name (next-worker-name)))))
+    (unix:unix-close listener)))

diff --git a/impl-lispworks.lisp b/impl-lispworks.lisp
index 351b35f6904703d4f9f9b547f76203ec4a26c1a3..86dfc57d5337b54cc1ab1c9736f8e7592241fc3b 100644 (file)
--- a/impl-lispworks.lisp
+++ b/impl-lispworks.lisp
@@ -4,13 +4,22 @@
 
 (require "comm")
 
 
 (require "comm")
 

-(defun make-socket-server (name port function &key wait (format :text))
-  (comm:start-up-server
-   :function (lambda (handle)
-              (let ((stream (make-instance 'comm:socket-stream :socket handle
-                                           :direction :io
-                                           :element-type 'base-char)))
-                (mp:process-run-function
-                 (next-worker-name) '()
-                 'apache-command-issuer stream function)))
-   :service port :process-name name))
+(defvar *processor*)
+(let ((*processor* nil))
+  
+  (defun make-socket-server (name function port &key wait (format :text))
+    (setq *processor* function)
+    (values
+     (comm:start-up-server
+      :service port
+      :process-name name
+      :function 'socket-worker)
+     nil))
+
+  (defun socket-worker (socket)
+    (let ((stream (make-instance 'comm:socket-stream :socket socket
+                                :direction :io
+                                :element-type 'base-char)))
+      (mp:process-run-function
+     (next-worker-name) '()
+     'apache-command-issuer stream *processor*))))

diff --git a/modlisp.asd b/modlisp.asd
index 95a75b77aacb03dcbf5414e3618e96fb93225502..88d51fbaa8aedc6dd5ccedfb471b783865c4129f 100644 (file)
--- a/modlisp.asd
+++ b/modlisp.asd
@@ -7,15 +7,18 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Dec 2002
 ;;;;
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Dec 2002
 ;;;;

-;;;; $Id: modlisp.asd,v 1.2 2003/07/04 22:41:06 kevin Exp $
+;;;; $Id: modlisp.asd,v 1.3 2003/07/05 00:51:04 kevin Exp $

 ;;;; *************************************************************************
 
 (defpackage #:modlisp-system (:use #:cl #:asdf))
 (in-package #:modlisp-system)
 
 ;;;; *************************************************************************
 
 (defpackage #:modlisp-system (:use #:cl #:asdf))
 (in-package #:modlisp-system)
 

+#+(and sbcl (not sb-thread))
+(error "This package requires the multitasking version of sbcl")
+

 #+(or allegro clisp cmu lispworks sbcl)
 (defsystem modlisp
 #+(or allegro clisp cmu lispworks sbcl)
 (defsystem modlisp

-    :depends-on (:kmrcl #+sbcl :sb-bsd-sockets)
+    :depends-on (#+sbcl :sb-bsd-sockets)

     :components
     ((:file "package")
      (:file "variables" :depends-on ("package"))
     :components
     ((:file "package")
      (:file "variables" :depends-on ("package"))


@@ -31,4 +34,5 @@
                         #+cmu "impl-cmucl"
                         #+lispworks "impl-lispworks"
                         #+sbcl "impl-sbcl"))
                         #+cmu "impl-cmucl"
                         #+lispworks "impl-lispworks"
                         #+sbcl "impl-sbcl"))

-     (:file "utils" :depends-on ("base"))))
+     (:file "utils" :depends-on ("base"))
+     (:file "demo" :depends-on ("utils"))))

diff --git a/package.lisp b/package.lisp
index 931262d3724a73793826262142ae5a59eada5b02..b09c7061e926bb84b68a4fb69b94d7d3396ac5b2 100644 (file)
--- a/package.lisp
+++ b/package.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Dec 2002
 ;;;;
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Dec 2002
 ;;;;

-;;;; $Id: package.lisp,v 1.1 2003/07/04 19:52:32 kevin Exp $
+;;;; $Id: package.lisp,v 1.2 2003/07/05 00:51:04 kevin Exp $

 ;;;; *************************************************************************
 
 (in-package #:cl-user)
 ;;;; *************************************************************************
 
 (in-package #:cl-user)


@@ -17,17 +17,18 @@
   (:use #:cl #:kmrcl)
   (:export
 
   (:use #:cl #:kmrcl)
   (:export
 

-   ;; data-structures.lisp
+   ;; variables.lisp

    #:*apache-socket*
    #:*apache-socket*

-   #:*close-apache-socket*
-   #:*apache-nb-use-socket*

 
    ;; base.lisp
    #:modlisp-start
    #:modlisp-stop
    #:header-value
    #:write-header-line
 
    ;; base.lisp
    #:modlisp-start
    #:modlisp-stop
    #:header-value
    #:write-header-line

-
+   #:get-number-worker-requests
+   #:get-number-server-requests
+   #:set-close-apache-socket
+   

    ;; utils.lisp
    #:output-html-page
    #:output-xml-page
    ;; utils.lisp
    #:output-html-page
    #:output-xml-page

diff --git a/utils.lisp b/utils.lisp
index 04376fdd43dcb018ebb66e3c30d1078e2c259414..064e362e5f1600a3df3403404d90f6fb63ea7eb6 100644 (file)
--- a/utils.lisp
+++ b/utils.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Dec 2002
 ;;;;
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Dec 2002
 ;;;;

-;;;; $Id: utils.lisp,v 1.1 2003/07/04 19:52:32 kevin Exp $
+;;;; $Id: utils.lisp,v 1.2 2003/07/05 00:51:04 kevin Exp $

 ;;;; *************************************************************************
 
 (in-package #:modlisp)
 ;;;; *************************************************************************
 
 (in-package #:modlisp)


@@ -46,17 +46,17 @@
         (write-string "end" *apache-socket*)
         (write-char #\NewLine *apache-socket*)
         (write-string ,outstr *apache-socket*)
         (write-string "end" *apache-socket*)
         (write-char #\NewLine *apache-socket*)
         (write-string ,outstr *apache-socket*)

-        (setq *close-apache-socket* nil))
+        (set-close-apache-socket nil))

        (t
         (finish-output *apache-socket*)
        (t
         (finish-output *apache-socket*)

-        (setq *close-apache-socket* t)))
+        (set-close-apache-socket t)))

        ,result)))
 
 (defun redirect-to-location (url)
   (write-header-line "Status" "302 Redirect")
   (write-header-line "Location" url)
   (write-char #\NewLine *apache-socket*)
        ,result)))
 
 (defun redirect-to-location (url)
   (write-header-line "Status" "302 Redirect")
   (write-header-line "Location" url)
   (write-char #\NewLine *apache-socket*)

-  (setq *close-apache-socket* t))
+  (set-close-apache-socket t))

 
 (defun output-ml-page (format html)
   (write-header-line "Status" "200 OK")
 
 (defun output-ml-page (format html)
   (write-header-line "Status" "200 OK")


@@ -66,7 +66,7 @@
   (write-string "end" *apache-socket*)
   (write-char #\NewLine *apache-socket*)
   (write-string html *apache-socket*)
   (write-string "end" *apache-socket*)
   (write-char #\NewLine *apache-socket*)
   (write-string html *apache-socket*)

-  (setq *close-apache-socket* nil))
+  (set-close-apache-socket nil))

 
 (defun output-html-page (str)
   (output-ml-page :html str))
 
 (defun output-html-page (str)
   (output-ml-page :html str))


@@ -84,6 +84,10 @@
          (when (= 2 (length name-val-list))
            (destructuring-bind (name val) name-val-list
              (push (cons (kmrcl:ensure-keyword name)
          (when (= 2 (length name-val-list))
            (destructuring-bind (name val) name-val-list
              (push (cons (kmrcl:ensure-keyword name)

-                         (decode-uri-query-string val))
+                         (kmrcl:decode-uri-query-string val))

                    alist))))))))
 
                    alist))))))))
 

+
+
+
+

diff --git a/variables.lisp b/variables.lisp
index 2edf38bf0093d234c7f096c88f45efdde03135c9..6c040c0de731659ac6332e9455ecbfcd4d4ecfed 100644 (file)
--- a/variables.lisp
+++ b/variables.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Dec 2002
 ;;;;
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Dec 2002
 ;;;;

-;;;; $Id: variables.lisp,v 1.1 2003/07/04 22:41:06 kevin Exp $
+;;;; $Id: variables.lisp,v 1.2 2003/07/05 00:51:04 kevin Exp $

 ;;;; *************************************************************************
 
 (in-package #:modlisp)
 ;;;; *************************************************************************
 
 (in-package #:modlisp)


@@ -18,22 +18,21 @@
 (defvar *worker-count* 0
   "used to name workers")
 
 (defvar *worker-count* 0
   "used to name workers")
 

-(defvar *listener-socket*
-  "Socket for the listener")
-
-(defvar *listener-proc* nil
-  "Process for the listener")
-

 (defconstant +default-apache-port+ 20123
   "Default port for listen")
 
 (defvar *apache-socket* nil
   "the socket stream to apache")
 
 (defconstant +default-apache-port+ 20123
   "Default port for listen")
 
 (defvar *apache-socket* nil
   "the socket stream to apache")
 

-(defvar *close-apache-socket* nil
-  "set to T if you want to close the socket to apache after
-the current command")
+(defvar *listener-socket*
+  "Socket for the listener")
+
+(defvar *listener-process* nil
+  "Process for the listener")
+
+(defvar *number-server-requests*)
+(defvar *number-worker-requests*)
+(defvar *close-apache-socket*)
+

 
 

-(defvar *apache-nb-use-socket* 0
-  "the number of requests sent in this socket")