/usr/share/common-lisp/source/modlisp/demo.lisp is in cl-modlisp 0.6-7.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 | ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: modlisp -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Name: demo.lisp
;;;; Purpose: Demonstration command processor
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Dec 2002
;;;;
;;;; $Id: demo.lisp 7061 2003-09-07 06:34:45Z kevin $
;;;; *************************************************************************
(in-package #:modlisp)
(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)))
(t
(with-ml-page (:precompute nil)
(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>" *modlisp-socket*)
(write-request-counts *modlisp-socket*)
(write-string "<table>
<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))
(write-string "</tbody></table></body></html>" *modlisp-socket*))
(defun fixed-html-string ()
(with-output-to-string (s)
(write-string
"<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">
<html><head></head><body><h1>mod_lisp fixed page</h1>
<p>This is a fixed string sent by mod_lisp</p>" s)
(write-request-counts s)
(write-string "</body></html>" s)))
(defun write-precomputed-page ()
(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>" *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>"
*number-server-requests*)
(format s "<p>Number of worker requests for this socket: ~D</p>"
*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))
|