1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: modlisp -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
6 ;;;; Purpose: Utility functions for modlisp package
7 ;;;; Programmer: Kevin M. Rosenberg
8 ;;;; Date Started: Dec 2002
10 ;;;; $Id: base.lisp,v 1.10 2003/07/10 18:58:29 kevin Exp $
11 ;;;; *************************************************************************
13 (in-package #:modlisp)
15 (defun modlisp-start (&key (port +default-modlisp-port+)
16 (processor 'demo-modlisp-command-processor)
19 (let ((listener (make-instance 'listener :port port
21 :function 'modlisp-command-issuer
22 :function-args (cons processor processor-args)
25 :catch-errors catch-errors)))
26 (init/listener listener :start)))
29 (defun modlisp-stop (listener)
30 (init/listener listener :stop))
32 (defun modlisp-stop-all ()
37 (defun modlisp-command-issuer (*modlisp-socket* processor &rest args)
38 "generates commands from modlisp, issues commands to processor-fun"
41 (let ((*number-worker-requests* 0)
42 (*close-modlisp-socket* t))
43 (do ((command (read-modlisp-command) (read-modlisp-command)))
45 (apply processor command args)
46 (force-output *modlisp-socket*)
47 (incf *number-worker-requests*)
48 (incf *number-server-requests*)
49 (when *close-modlisp-socket*
51 (close-active-socket *modlisp-socket*)))
53 (defun header-value (header key)
54 "Returns the value of a modlisp header"
55 (cdr (assoc key header :test #'string=)))
57 (defun read-modlisp-command ()
59 (let* ((header (read-modlisp-header))
60 (content-length (header-value header "content-length"))
61 (content (when content-length
63 (parse-integer content-length :junk-allowed t)))))
65 (read-sequence content *modlisp-socket*)
66 (push (cons "posted-content" content) header))
69 (defun read-modlisp-line ()
70 (kmrcl:string-right-trim-one-char
72 (read-line *modlisp-socket* nil nil)))
74 (defun read-modlisp-header ()
75 (loop for key = (read-modlisp-line)
77 (string-not-equal key "end")
79 for value = (read-modlisp-line)
80 collect (cons key value)))
82 (defun write-header-line (key value)
83 (write-string key *modlisp-socket*)
84 (write-char #\NewLine *modlisp-socket*)
85 (write-string value *modlisp-socket*)
86 (write-char #\NewLine *modlisp-socket*))