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.7 2003/07/08 14:00:53 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
20 :name (next-server-name)
21 :function 'apache-command-issuer
22 :function-args (cons processor processor-args)
25 :catch-errors catch-errors)))
27 (make-socket-server listener)
29 (format t "~&Error while trying to start modlisp server~& ~A" e)
30 (decf *listener-count*)
33 (declare (ignore res))
34 (push listener *active-listeners*)
37 (defun modlisp-stop (listener)
39 (cmsg "listener is NIL in modlisp-stop")
40 (return-from modlisp-stop))
41 (dolist (worker (workers listener))
42 (close-active-socket (connection worker))
43 (destroy-process (process worker)))
44 (setf (workers listener) nil)
45 (with-slots (process socket) listener
46 (errorset (close-passive-socket socket) t)
47 (errorset (destroy-process process) t))
48 (setq *active-listeners* (remove listener *active-listeners*)))
50 (defun modlisp-stop-all ()
51 (dolist (listener *active-listeners*)
54 (modlisp-stop listener)
55 (setq *active-listeners* (remove listener *active-listeners*))))))
57 (defun next-server-name ()
58 (format nil "modlisp-socket-server-~d" (incf *listener-count*)))
60 (defun next-worker-name ()
61 (format nil "modlisp-worker-~d" (incf *worker-count*)))
63 (let ((*number-server-requests* 0)
64 (*number-worker-requests* 0)
65 (*close-apache-socket* t))
67 (defun apache-command-issuer (*apache-socket* processor &rest args)
68 "generates commands from apache, issues commands to processor-fun"
71 (setq *number-worker-requests* 0)
72 (do ((command (read-apache-command) (read-apache-command)))
74 (apply processor command args)
75 (force-output *apache-socket*)
76 (incf *number-worker-requests*)
77 (incf *number-server-requests*)
78 (when *close-apache-socket*
80 (close-active-socket *apache-socket*)))
83 (defun get-number-worker-requests ()
84 *number-worker-requests*)
86 (defun get-number-server-requests ()
87 *number-server-requests*)
89 (defun set-close-apache-socket (close?)
90 (setq *close-apache-socket* close?))
94 (defun header-value (header key)
95 (cdr (assoc key header :test #'string=)))
97 (defun read-apache-command ()
99 (let* ((header (read-apache-header))
100 (content-length (header-value header "content-length"))
101 (content (when content-length
103 (parse-integer content-length :junk-allowed t)))))
105 (read-sequence content *apache-socket*)
106 (push (cons "posted-content" content) header))
109 (defun read-apache-line ()
110 (kmrcl:string-left-trim-one-char #\return
111 (read-line *apache-socket* nil nil)))
113 (defun read-apache-header ()
114 (loop for key = (read-apache-line)
116 (string-not-equal key "end")
118 for value = (read-apache-line)
119 collect (cons key value)))
121 (defun write-header-line (key value)
122 (write-string key *apache-socket*)
123 (write-char #\NewLine *apache-socket*)
124 (write-string value *apache-socket*)
125 (write-char #\NewLine *apache-socket*))