cl-modlisp-0.6/0042755000175000017500000000000007745351332012453 5ustar kevinkevincl-modlisp-0.6/base.lisp0100644000175000017500000000617207726561375014270 0ustar kevinkevin;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: modlisp -*- ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; ;;;; Name: base.lisp ;;;; Purpose: Utility functions for modlisp package ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Dec 2002 ;;;; ;;;; $Id: base.lisp 7061 2003-09-07 06:34:45Z kevin $ ;;;; ************************************************************************* (in-package #:modlisp) (defun modlisp-start (&key (port +default-modlisp-port+) (processor 'demo-modlisp-command-processor) (processor-args nil) (catch-errors t) timeout number-fixed-workers remote-host-checker) (let* ((server (make-instance 'ml-server :processor processor :processor-args processor-args :port port)) (listener (make-instance 'listener :port port :base-name "modlisp" :function 'modlisp-command-issuer :function-args (list server) :format :text :wait nil :catch-errors catch-errors :timeout timeout :number-fixed-workers number-fixed-workers :remote-host-checker remote-host-checker))) (setf (listener server) listener) (init/listener listener :start) (setf *ml-server* server) server)) (defun modlisp-stop (server) (init/listener (listener server) :stop) (setf (listener server) nil) server) (defun modlisp-stop-all () (stop-all/listener)) ;; Internal functions (defun modlisp-command-issuer (*modlisp-socket* server) "generates commands from modlisp, issues commands to processor-fun" (unwind-protect (progn (let ((*number-worker-requests* 0) (*close-modlisp-socket* t) (*ml-server* server)) (do ((command (read-modlisp-command) (read-modlisp-command))) ((null command)) (apply (processor server) command (processor-args server)) (finish-output *modlisp-socket*) (incf *number-worker-requests*) (incf *number-server-requests*) (when *close-modlisp-socket* (return))))) (close-active-socket *modlisp-socket*))) (defun header-value (header key) "Returns the value of a modlisp header" (cdr (assoc key header :test #'eq))) (defun read-modlisp-command () (ignore-errors (let* ((header (read-modlisp-header)) (content-length (header-value header :content-length)) (content (when content-length (make-string (parse-integer content-length :junk-allowed t))))) (when content (read-sequence content *modlisp-socket*) (push (cons :posted-content content) header)) header))) (defun read-modlisp-line () (kmrcl:string-right-trim-one-char #\return (read-line *modlisp-socket* nil nil))) (defun read-modlisp-header () (loop for key = (read-modlisp-line) while (and key (string-not-equal key "end")) for value = (read-modlisp-line) collect (cons (ensure-keyword key) value))) (defun write-header-line (key value) (write-string (string key) *modlisp-socket*) (write-char #\NewLine *modlisp-socket*) (write-string value *modlisp-socket*) (write-char #\NewLine *modlisp-socket*)) cl-modlisp-0.6/package.lisp0100644000175000017500000000202307726561375014740 0ustar kevinkevin;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: modlisp; -*- ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; ;;;; Name: package.lisp ;;;; Purpose: Package definition for modlisp package ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Dec 2002 ;;;; ;;;; $Id: package.lisp 7061 2003-09-07 06:34:45Z kevin $ ;;;; ************************************************************************* (in-package #:cl-user) (defpackage #:modlisp (:nicknames #:ml) (:use #:cl #:kmrcl) (:export ;; variables.lisp #:*modlisp-socket* #:*number-worker-requests* #:*number-server-requests* #:*ml-server* #:*close-modlisp-socket* ;; base.lisp #:modlisp-start #:modlisp-stop #:modlisp-stop-all #:header-value #:write-header-line #:set-close-modlisp-socket ;; utils.lisp #:output-ml-page #:output-html-page #:output-xml-page #:with-ml-page #:query-to-alist #:redirect-to-location )) cl-modlisp-0.6/doc/0042755000175000017500000000000007745351332013220 5ustar kevinkevincl-modlisp-0.6/doc/readme.lml0100644000175000017500000002012607726561376015171 0ustar kevinkevin;;; -*- Mode: Lisp -*- (in-package #:lml2) (html-file-page ("readme") (html (:head (:title "cl-modlisp readme") ((:meta :http-equiv "Content-Type" :content "text/html; charset=iso-8859-1")) ((:meta :name "Copyright" :content "Kevin Rosenberg 2002 ")) ((:meta :name "description" :content "cl-modlisp documentation")) ((:meta :name "author" :content "Kevin Rosenberg")) ((:meta :name "keywords" :content "Common Lisp, mod_lisp, cl-modlisp, apache"))) (:body (:h1 "cl-modlisp Documentation") (:h2 "Overview") (:p "cl-modlisp provides the Lisp side of the interface to Marc Battyani's mod_lisp apache module (" ((:a :href "http://www.fractalconcept.com") "http://www.fractalconcept.com") ").") (:h2 "Features") (:ul (:li "support for AllegroCL, CMUCL, SBCL with sb-thread, and Lispworks.") (:li "listener and worker socket/process management so that shutting down the listener closes all related open sockets and terminates all related proceses.") (:li "support for running multiple command processors on multiple ports.") (:li "transparent support for precomputing the HTML or XML response to take advantage of HTTP/1.1's Keep-Alive feature. This is switchable with a single keyword argument to the macro " (:tt "with-ml-page") ".") (:li "Optional timeout of worker processes") (:li "Two process models for flexibility") (:li "Demonstration processor included")) (:h2 "Prerequisites") (:ul (:li "Apache 1.3.x") (:li "mod_lisp apache module (" ((:a :href "http://www.fractalconcept.com") "http://www.fractalconcept.com") ").") (:li "kmrcl library (" ((:a :href "http://files.b9.com/kmrcl") "http://files.b9.com/kmrcl") ").") (:li "asdf (" ((:a :href "http://www.sf.net/projects/cclan") "http://www.sf.net/projects/cclan") ").")) (:h2 "Supported Platforms") (:ul (:li "Allegro v6.2") (:li "CMUCL 18e") (:li "Lispworks v4.2") (:li "SBCL 0.8.1 with sb-thread (multi-threading)")) (:h2 "Quickstart") (:ul (:li "The easiest way to install is to use the Debian GNU/Linux operating system. Using the testing or unstable distributions, you can give the command:" (:div (:tt "apt-get install libapache-mod-lisp cl-modlisp cl-kmrcl")) (:div "If you are not using Debian, you will need to download and install mod_lisp, cl-modlisp, and cl-kmrcl manually.")) (:li "Add something like the below to httpd.conf and then restart apache" (:div (:tt "LispServer 127.0.0.1 20123 \"localhost\"")) (:div (:tt "AddHandler lisp-handler .lsp"))) (:li "Start your Lisp implementation and load cl-modlisp with" (:div (:tt "(asdf:operate 'asdf:load-op 'modlisp)"))) (:li "Start the server with" (:div (:tt "(ml:modlisp-start :port 20123)"))) (:li "Try some demostration pages" (:div (:tt "links http://localhost/fixed.lsp")) (:div (:tt "links http://localhost/debug.lsp"))) (:li "Shutdown the all cl-modlisp servers with" (:div (:tt "(ml:modlisp-stop-all)")))) (:h2 "Process Models") (:p "There are two process models") (:ul (:li (:div (:b "Each connection spawns a new thread")) (:div "This is the default model. Each new connection to listener socket spawns a new connection. This allows for an arbitrary number of concurrent connections. This has advantages if the workers require a long execution time.")) (:li (:div (:b "Fixed pool of workers")) (:div "This model is selected by passing the number of worker processes to " (:tt "init/listener") " with the keyword " (:tt "number-fixed-workers") ". This model has a lower overhead since new processes are not created and destroyed with each connection. It has advantages when the workers have a short execution time."))) (:h2 "Usage") (:p "The demo.lisp file for examples of using cl-modlisp.") ) (:ul) (:li (:div (:strong "Overview")) (:div "cl-modlisp is a multi-threaded handler for HTTP requests forwarded by Marc Battyani's (http://www.fractalconcept.com) mod_lisp Apache module.")) (:li (:div (:strong "Design Goals")) (:div "cl-modlisp is designed as a thin layer to dispatch a mod_lisp request with multi-platform compatibility. Currently, cl-modlisp supports SBCL [multithreaded], CMUCL, AllegroCL, and Lispworks.")) (:li (:div (:strong "Dispatch model")) (:div "Extremely simple: All requests are forwarded to a single processor that is passed as a parameter to cl-modlisp's start-up function.")) (:li (:div (:strong "Configuration")) (:div "All configuration is set by passing keyword arguments to modlisp-start") (:ul (:li "port number - a number") (:li "processor - function designator which will receive all requests") (:li "processor-args - list of extra arguments to be passed to processor") (:li "timeout - NIL means never timeout otherwise number of seconds") (:li "catch-errors - non-NIL means to catch errors") (:li "number-fixed-workers - NIL means to spawn a new worker process for each request") (:li "remote-host-checker - optional function designator to check the remote host IP address. Used for filtering requests."))) (:li (:div (:strong "Processor function")) (:div "This function receives an argument of the 'command' alist and any other arguments passed to modlisp-start as the :processor-args. The 'command' alist is an associative list of keys and values received from modlisp. No preprocessing is done except that keys are converted from strings to keywords forced to the default implementation case.")) (:li (:div (:strong "Default Processor")) (:div "The default processor is a simple demo command processor not intended for end-user.")) (:li (:div "URI Processing") (:div "None. The raw URL is the value of the :url key in the command alist.")) (:li (:div "Responses") (:div "Responses are written to modlisp:*modlisp-socket*. The raw HTTP/1.1 header needs to be generated by the application.")) (:li (:div "Utility functions") (:div "A few utility functions are provided") (:ul (:li (:div "with-ml-page") (:div "Outputs the body of the macro along with the HTTP/1.1 headers. Supports both precomputing responses with keep-alive connections and also outputing response to socket as it is generated. The latter is useful for lengthye reponses in time or length. Also support setting the content-type (default \"text/html\") and arbitrary list of headers.")) (:li (:div "query-to-alist") (:div "Converts posted query to an alist. Doesn't handle multipart forms.")) (:li (:div "redirect-to-location")))) (:li (:div (:strong "Known issues")) (:ul (:li "This application has been most tested on AllegroCL.") (:li (:p "By design, is not practical an application platform. It is should have an API package wrapped around this library which supports useful features like processing URIs, dispatches, cookies, and querys [URI and single/multipart POSTs]") (:p "Rather than adding these features to cl-modlisp, I've been working on a library which uses a session-id and dispatch model based on Franz's webactions library. It also integrates my portable version of Franz's URI module and adds query processing similar on AllegroServer's request-query functions. This library can used with both cl-modlisp and AllegroServe as connectors. However, as this library has grown, it looks more and more like AllegroServe, I've begun to question the value of using this library compared to just using Portable AllegroServe with just my webactions-like session-id and dispatch processors. In my mind, the greatest advantage of using this library is that it is a much smaller task maintaining cross-implementation compatibility with the cl-modlisp connector version maintaining such compatibility with paserve. The disadvantage of this library is that I dislike cloning AllegroServe's query and cookie processing. I do so, though, because I think their API is quite reasonable. This library is currently driving http://umlisp.b9.com/") ))))) cl-modlisp-0.6/doc/readme.html0100644000175000017500000001745007745351330015343 0ustar kevinkevin cl-modlisp readme

cl-modlisp Documentation

Overview

cl-modlisp provides the Lisp side of the interface to Marc Battyani's mod_lisp apache module (http://www.fractalconcept.com).

Features

Prerequisites

Supported Platforms

Quickstart

Process Models

There are two process models

Usage

The demo.lisp file for examples of using cl-modlisp.

  • Overview
    cl-modlisp is a multi-threaded handler for HTTP requests forwarded by Marc Battyani's (http://www.fractalconcept.com) mod_lisp Apache module.
  • Design Goals
    cl-modlisp is designed as a thin layer to dispatch a mod_lisp request with multi-platform compatibility. Currently, cl-modlisp supports SBCL [multithreaded], CMUCL, AllegroCL, and Lispworks.
  • Dispatch model
    Extremely simple: All requests are forwarded to a single processor that is passed as a parameter to cl-modlisp's start-up function.
  • Configuration
    All configuration is set by passing keyword arguments to modlisp-start
  • Processor function
    This function receives an argument of the 'command' alist and any other arguments passed to modlisp-start as the :processor-args. The 'command' alist is an associative list of keys and values received from modlisp. No preprocessing is done except that keys are converted from strings to keywords forced to the default implementation case.
  • Default Processor
    The default processor is a simple demo command processor not intended for end-user.
  • URI Processing
    None. The raw URL is the value of the :url key in the command alist.
  • Responses
    Responses are written to modlisp:*modlisp-socket*. The raw HTTP/1.1 header needs to be generated by the application.
  • Utility functions
    A few utility functions are provided
  • Known issues
    • cl-modlisp-0.6/doc/make.lisp0100644000175000017500000000022007726561376015025 0ustar kevinkevin#+cmu (setq ext:*gc-verbose* nil) (require :lml2) (in-package :lml2) (let ((cwd (parse-namestring (lml-cwd)))) (process-dir cwd)) (lml-quit) cl-modlisp-0.6/doc/Makefile0100644000175000017500000000016207726561376014664 0ustar kevinkevin.PHONY: site all clean all: site site: sbcl --userinit `pwd`/make.lisp clean: @rm -f *~ \#*\# .\#* memdump cl-modlisp-0.6/LICENSE0100644000175000017500000000271207726230602013450 0ustar kevinkevinCopyright (c) 2003 Kevin Rosenberg All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * The name of the author may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. cl-modlisp-0.6/variables.lisp0100644000175000017500000000240407726561376015321 0ustar kevinkevin;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: modlisp -*- ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; ;;;; Name: base.lisp ;;;; Purpose: Base data and functions for modlisp package ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Dec 2002 ;;;; ;;;; $Id: variables.lisp 7061 2003-09-07 06:34:45Z kevin $ ;;;; ************************************************************************* (in-package #:modlisp) (defconstant +default-modlisp-port+ 20123 "Default port for listen") (defvar *modlisp-socket* nil "the socket stream to modlisp") (defvar *number-server-requests* 0 "number of requests for the server") (defvar *number-worker-requests* 0 "number of requests for this worker process") (defvar *close-modlisp-socket* t "whether to close the modlisp socket at the end of this request") (defvar *ml-server* nil "Current ml-server instance") (defclass ml-server () ((listener :initarg :listener :initform nil :accessor listener) (port :initarg :port :initform nil :accessor port) (processor :initarg :processor :initform nil :accessor processor) (processor-args :initarg :processor-args :initform nil :accessor processor-args))) cl-modlisp-0.6/utils.lisp0100644000175000017500000000562707745351312014507 0ustar kevinkevin;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: modlisp -*- ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; ;;;; Name: utils.lisp ;;;; Purpose: Utility functions for modlisp package ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Dec 2002 ;;;; ;;;; $Id: utils.lisp 8022 2003-10-22 00:43:53Z kevin $ ;;;; ************************************************************************* (in-package #:modlisp) (defun format-string (fmt headers) `(("Content-Type" . ,(case fmt (:html "text/html") (:xml "text/xml") (:text "text/plain") (otherwise fmt))) . ,headers)) (defmacro write-response ((&key headers len (status "200 OK")) &body body) (let ((result (gensym "RES-"))) `(progn (write-header-line "Status" ,status) (dolist (hdr ,headers) (write-header-line (car hdr) (cdr hdr))) ,@(and len `((write-header-line "Content-Length" ,len) (write-header-line "Keep-Socket" "1") (write-header-line "Connection" "Keep-Alive"))) (write-string "end" *modlisp-socket*) (write-char #\NewLine *modlisp-socket*) (let ((,result (progn ,@body))) (,(if len 'force-output 'finish-output) *modlisp-socket*) (setq *close-modlisp-socket* ,(not len)) ,result)))) (defmacro with-ml-page ((&key (format :html) (precompute t) headers) &body body) (if precompute `(output-ml-page ,format (with-output-to-string (*modlisp-socket*) ,@body) :headers ,headers) `(write-response (:headers (format-string ,format ,headers)) ,@body))) (defun redirect-to-location (url) (write-response (:status "307 Temporary Redirect" :headers `(("Location" . ,url))))) (defmacro output-ml-page (format html &key headers) (let ((str (gensym "STR-"))) `(let ((,str ,html)) (write-response (:len (format nil "~d" (length ,str)) :headers (format-string ,format ,headers)) (write-string ,str *modlisp-socket*))))) (defun output-html-page (str &key headers) (output-ml-page :html str :headers headers)) (defun output-xml-page (str &key headers) (output-ml-page :xml str :headers headers)) ;; Utility functions for library users (defun query-to-alist (posted-string &key (keyword t)) "Converts a posted string to an assoc list of keyword names and values, \"a=1&bc=demo\" => ((:a . \"1\") (:bc . \"demo\"))" (when posted-string (let ((alist '())) (dolist (name=val (kmrcl:delimited-string-to-list posted-string #\&) (nreverse alist)) (let ((name-val-list (kmrcl:delimited-string-to-list name=val #\=))) (if (= 2 (length name-val-list)) (destructuring-bind (name val) name-val-list (push (cons (if keyword (kmrcl:ensure-keyword name) name) (kmrcl:decode-uri-query-string val)) alist)) (cmsg-c :debug "Invalid number of #\= in ~S" name-val-list))))))) cl-modlisp-0.6/demo.lisp0100644000175000017500000000702407726561376014300 0ustar kevinkevin;;;; -*- 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 "

    mod_lisp debug page

    " *modlisp-socket*) (write-request-counts *modlisp-socket*) (write-string "" *modlisp-socket*) (loop for (key . value) in command do (format *modlisp-socket* "" key value)) (write-string "
    KeyValue
    ~a~a
    " *modlisp-socket*)) (defun fixed-html-string () (with-output-to-string (s) (write-string "

    mod_lisp fixed page

    This is a fixed string sent by mod_lisp

    " s) (write-request-counts s) (write-string "" s))) (defun write-precomputed-page () (write-string "

    mod_lisp precomputed page

    This is a precomputed string sent by mod_lisp

    " *modlisp-socket*) (write-request-counts *modlisp-socket*) (write-string "" *modlisp-socket*)) (defun write-request-counts (s) (format s "

    Number of server requests: ~D

    " *number-server-requests*) (format s "

    Number of worker requests for this socket: ~D

    " *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)) cl-modlisp-0.6/modlisp.asd0100644000175000017500000000160007726561376014615 0ustar kevinkevin;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umweb -*- ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; ;;;; Name: modlisp.asd ;;;; Purpose: ASDF system definition file for modlisp package ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Dec 2002 ;;;; ;;;; $Id: modlisp.asd 7061 2003-09-07 06:34:45Z kevin $ ;;;; ************************************************************************* (in-package #:cl-user) (defpackage #:modlisp-system (:use #:cl #:asdf)) (in-package #:modlisp-system) #+(or allegro cmu lispworks sbcl) (defsystem modlisp :depends-on (:kmrcl) :components ((:file "package") (:file "variables" :depends-on ("package")) (:file "base" :depends-on ("variables")) (:file "utils" :depends-on ("base")) (:file "demo" :depends-on ("utils")))) cl-modlisp-0.6/ChangeLog0100644000175000017500000000017307745351215014221 0ustar kevinkevin2003-10-21 Kevin Rosenberg * utils.lisp: Incorporate improvements from Alejandro Forero Cuervo's contributed patch.