;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Dec 2002
;;;;
-;;;; $Id: demo.lisp,v 1.1 2003/07/05 00:59:49 kevin Exp $
+;;;; $Id$
;;;; *************************************************************************
(in-package #:modlisp)
-(defun demo-apache-command-processor (command)
- "Sample function to process an apache command"
- (let ((url (header-value command "url")))
+(defun demo-modlisp-command-processor (command)
+ "Sample function to process an modlisp command"
+ (let ((url (header-value command :url)))
(cond
((equal url "/fixed.lsp")
(output-html-page (fixed-html-string)))
((equal url "/precompute.lsp")
(with-ml-page (:precompute t)
- (write-precomputed-page)))
+ (write-precomputed-page)))
(t
(with-ml-page (:precompute nil)
- (write-debug-table command))))))
+ (write-debug-table command))))))
(defun write-debug-table (command)
(write-string "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">
<html><head></head>
<body>
-<h1>mod_lisp debug page</h1>" *apache-socket*)
- (write-request-counts *apache-socket*)
+<h1>mod_lisp debug page</h1>" *modlisp-socket*)
+ (write-request-counts *modlisp-socket*)
(write-string "<table>
<thead><tr><th>Key</th><th>Value</th></tr></thead>
-<tbody>" *apache-socket*)
+<tbody>" *modlisp-socket*)
(loop for (key . value) in command do
- (format *apache-socket* "<tr><td>~a</td><td>~a</td></tr>" key value))
- (write-string "</tbody></table></body></html>" *apache-socket*))
+ (format *modlisp-socket* "<tr><td>~a</td><td>~a</td></tr>" key value))
+ (write-string "</tbody></table></body></html>" *modlisp-socket*))
(defun fixed-html-string ()
(write-string
"<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">
<html><head></head><body><h1>mod_lisp precomputed page</h1>
-<p>This is a precomputed string sent by mod_lisp</p>" *apache-socket*)
- (write-request-counts *apache-socket*)
- (write-string "</body></html>" *apache-socket*))
+<p>This is a precomputed string sent by mod_lisp</p>" *modlisp-socket*)
+ (write-request-counts *modlisp-socket*)
+ (write-string "</body></html>" *modlisp-socket*))
(defun write-request-counts (s)
(format s "<p>Number of server requests: ~D</p>"
- (get-number-server-requests))
+ *number-server-requests*)
(format s "<p>Number of worker requests for this socket: ~D</p>"
- (get-number-worker-requests)))
+ *number-worker-requests*))
-
+
+;;; A small test bench used to test and time the client/server protocol
+;;; From Marc Battyani
+
+(defun fetch-mod-lisp-url (server url &key (num-fetch 1) (port 20123)
+ close-socket)
+ (loop with server-socket and reply
+ repeat num-fetch
+ do (unless server-socket
+ (setf server-socket (make-active-socket server port)))
+ (write-string "url" server-socket)
+ (write-char #\NewLine server-socket)
+ (write-string url server-socket)
+ (write-char #\NewLine server-socket)
+ (write-string "end" server-socket)
+ (write-char #\NewLine server-socket)
+ (force-output server-socket)
+ (setf reply (read-reply server-socket))
+ (when close-socket
+ (close server-socket)
+ (setf server-socket nil))
+ finally
+ (unless close-socket (close server-socket))
+ (return reply)))
+
+(defun read-reply (socket)
+ (let* ((header (loop for key = (read-line socket nil nil)
+ while (and key (string-not-equal key "end"))
+ for value = (read-line socket nil nil)
+ collect (cons key value)))
+ (content-length (cdr (assoc "Content-Length" header :test #'string=)))
+ (content (when content-length (make-string (parse-integer content-length :junk-allowed t)))))
+ (when content
+ (read-sequence content socket)
+ (push (cons "reply-content" content) header))
+ header))
projects / cl-modlisp.git / blobdiff