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.6 2003/07/08 06:40:00 kevin Exp $
11 ;;;; *************************************************************************
13 (in-package #:modlisp)
15 (defun modlisp-start (&key (port +default-apache-port+)
16 (processor 'demo-apache-command-processor)
18 (let ((listener (make-instance 'listener :port port
19 :name (next-server-name)
20 :function 'apache-command-issuer
21 :function-args (cons processor processor-args)
25 (make-socket-server listener)
27 (format t "~&Error while trying to start modlisp server~& ~A" e)
28 (decf *listener-count*)
31 (declare (ignore res))
32 (push listener *active-listeners*)
35 (defun modlisp-stop (listener)
37 (cmsg "listener is NIL in modlisp-stop")
38 (return-from modlisp-stop))
39 (dolist (worker (workers listener))
40 (close-active-socket (connection worker))
41 (destroy-process (process worker)))
42 (setf (workers listener) nil)
43 (with-slots (process socket) listener
44 (errorset (close-passive-socket socket) t)
45 (errorset (destroy-process process) t))
46 (setq *active-listeners* (remove listener *active-listeners*)))
48 (defun modlisp-stop-all ()
49 (dolist (listener *active-listeners*)
52 (modlisp-stop listener)
53 (setq *active-listeners* (remove listener *active-listeners*))))))
55 (defun next-server-name ()
56 (format nil "modlisp-socket-server-~d" (incf *listener-count*)))
58 (defun next-worker-name ()
59 (format nil "modlisp-worker-~d" (incf *worker-count*)))
61 (let ((*number-server-requests* 0)
62 (*number-worker-requests* 0)
63 (*close-apache-socket* t))
65 (defun apache-command-issuer (*apache-socket* processor &rest args)
66 "generates commands from apache, issues commands to processor-fun"
69 (setq *number-worker-requests* 0)
70 (do ((command (read-apache-command) (read-apache-command)))
72 (apply processor command args)
73 (force-output *apache-socket*)
74 (incf *number-worker-requests*)
75 (incf *number-server-requests*)
76 (when *close-apache-socket*
78 (close-active-socket *apache-socket*)))
81 (defun get-number-worker-requests ()
82 *number-worker-requests*)
84 (defun get-number-server-requests ()
85 *number-server-requests*)
87 (defun set-close-apache-socket (close?)
88 (setq *close-apache-socket* close?))
92 (defun header-value (header key)
93 (cdr (assoc key header :test #'string=)))
95 (defun read-apache-command ()
97 (let* ((header (read-apache-header))
98 (content-length (header-value header "content-length"))
99 (content (when content-length
101 (parse-integer content-length :junk-allowed t)))))
103 (read-sequence content *apache-socket*)
104 (push (cons "posted-content" content) header))
107 (defun read-apache-line ()
108 (kmrcl:string-left-trim-one-char #\return
109 (read-line *apache-socket* nil nil)))
111 (defun read-apache-header ()
112 (loop for key = (read-apache-line)
114 (string-not-equal key "end")
116 for value = (read-apache-line)
117 collect (cons key value)))
119 (defun write-header-line (key value)
120 (write-string key *apache-socket*)
121 (write-char #\NewLine *apache-socket*)
122 (write-string value *apache-socket*)
123 (write-char #\NewLine *apache-socket*))