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.9 2003/07/09 19:19:19 kevin Exp $
11 ;;;; *************************************************************************
13 (in-package #:modlisp)
15 (defun modlisp-start (&key (port +default-apache-port+)
16 (processor 'demo-apache-command-processor)
19 (let ((listener (make-instance 'listener :port port
21 :function 'apache-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 ()
36 (let ((*number-server-requests* 0)
37 (*number-worker-requests* 0)
38 (*close-apache-socket* t))
40 (defun apache-command-issuer (*apache-socket* processor &rest args)
41 "generates commands from apache, issues commands to processor-fun"
44 (setq *number-worker-requests* 0)
45 (do ((command (read-apache-command) (read-apache-command)))
47 (apply processor command args)
48 (force-output *apache-socket*)
49 (incf *number-worker-requests*)
50 (incf *number-server-requests*)
51 (when *close-apache-socket*
53 (close-active-socket *apache-socket*)))
56 (defun get-number-worker-requests ()
57 *number-worker-requests*)
59 (defun get-number-server-requests ()
60 *number-server-requests*)
62 (defun set-close-apache-socket (close?)
63 (setq *close-apache-socket* close?))
67 (defun header-value (header key)
68 (cdr (assoc key header :test #'string=)))
70 (defun read-apache-command ()
72 (let* ((header (read-apache-header))
73 (content-length (header-value header "content-length"))
74 (content (when content-length
76 (parse-integer content-length :junk-allowed t)))))
78 (read-sequence content *apache-socket*)
79 (push (cons "posted-content" content) header))
82 (defun read-apache-line ()
83 (kmrcl:string-right-trim-one-char
85 (read-line *apache-socket* nil nil)))
87 (defun read-apache-header ()
88 (loop for key = (read-apache-line)
90 (string-not-equal key "end")
92 for value = (read-apache-line)
93 collect (cons key value)))
95 (defun write-header-line (key value)
96 (write-string key *apache-socket*)
97 (write-char #\NewLine *apache-socket*)
98 (write-string value *apache-socket*)
99 (write-char #\NewLine *apache-socket*))