;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Dec 2002
;;;;
-;;;; $Id: demo.lisp,v 1.3 2003/07/10 18:58:29 kevin Exp $
+;;;; $Id$
;;;; *************************************************************************
(in-package #:modlisp)
(defun demo-modlisp-command-processor (command)
"Sample function to process an modlisp command"
- (let ((url (header-value command "url")))
+ (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\">
<thead><tr><th>Key</th><th>Value</th></tr></thead>
<tbody>" *modlisp-socket*)
(loop for (key . value) in command do
- (format *modlisp-socket* "<tr><td>~a</td><td>~a</td></tr>" key value))
+ (format *modlisp-socket* "<tr><td>~a</td><td>~a</td></tr>" key value))
(write-string "</tbody></table></body></html>" *modlisp-socket*))
(defun write-request-counts (s)
(format s "<p>Number of server requests: ~D</p>"
- *number-server-requests*)
+ *number-server-requests*)
(format s "<p>Number of worker requests for this socket: ~D</p>"
- *number-worker-requests*))
+ *number-worker-requests*))
-
-;;; A small test bench used to test and time the client/server protocol
+
+;;; 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)
+ 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)
+ 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)
- (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)))
+ (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)))))
+ 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))
projects / cl-modlisp.git / blobdiff