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.5 2003/07/05 22:59:56 kevin Exp $
11 ;;;; *************************************************************************
13 (in-package #:modlisp)
15 (defun modlisp-start (&key (port +default-apache-port+)
16 (function 'demo-apache-command-processor)
18 (let ((listener (make-instance 'listener)))
20 (make-socket-server (next-server-name) function port listener
21 :format :text :wait nil
22 :function-args function-args)
24 (format t "~&Error while trying to start modlisp server~& ~A" e)
25 (decf *listener-count*)
27 (:no-error (process socket)
28 (setf (process listener) process)
29 (setf (socket listener) socket)
30 (push listener *active-listeners*)
33 (defun modlisp-stop (listener)
35 (cmsg "listener is NIL in modlisp-stop")
36 (return-from modlisp-stop))
37 (dolist (worker (workers listener))
38 (close-active-socket (socket worker))
39 (destroy-process (process worker)))
40 (setf (workers listener) nil)
41 (with-slots (process socket) listener
43 (destroy-process process)
45 (format t "~&Error while trying to kill modlisp server~& ~A" e)))
47 (ignore-errors (close-passive-socket socket))))
48 (setq *active-listeners* (remove listener *active-listeners*)))
50 (defun next-server-name ()
51 (format nil "modlisp-socket-server-~d" (incf *listener-count*)))
53 (defun next-worker-name ()
54 (format nil "modlisp-worker-~d" (incf *worker-count*)))
56 (let ((*number-server-requests* 0)
57 (*number-worker-requests* 0)
58 (*close-apache-socket* t))
60 (defun apache-command-issuer (*apache-socket* processor-fun &rest args)
61 "generates commands from apache, issues commands to processor-fun"
64 (setq *number-worker-requests* 0)
65 (do ((command (read-apache-command) (read-apache-command)))
66 ((null command) 'done)
67 (apply processor-fun command args)
68 (force-output *apache-socket*)
69 (incf *number-worker-requests*)
70 (incf *number-server-requests*)
71 (when *close-apache-socket*
73 (close *apache-socket*)))
75 (defun get-number-worker-requests ()
76 *number-worker-requests*)
78 (defun get-number-server-requests ()
79 *number-server-requests*)
81 (defun set-close-apache-socket (close?)
82 (setq *close-apache-socket* close?))
86 (defun read-apache-command ()
88 (let* ((header (read-apache-header))
89 (content-length (cdr (assoc "content-length" header :test #'equal)))
90 (content (when content-length
92 (parse-integer content-length :junk-allowed t)))))
94 (read-sequence content *apache-socket*)
95 (push (cons "posted-content" content) header))
98 (defun read-apache-header ()
99 (loop for key = (read-line *apache-socket* nil nil)
101 (string-not-equal key "end")
103 for value = (read-line *apache-socket* nil nil)
104 collect (cons key value)))
106 (defun write-header-line (key value)
107 (write-string key *apache-socket*)
108 (write-char #\NewLine *apache-socket*)
109 (write-string value *apache-socket*)
110 (write-char #\NewLine *apache-socket*))
112 (defun header-value (command key)
113 (cdr (assoc key command :test #'string=)))