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
11 ;;;; *************************************************************************
13 (in-package #:modlisp)
15 (defun modlisp-start (&key (port +default-modlisp-port+)
16 (processor 'demo-modlisp-command-processor)
22 (let* ((server (make-instance 'ml-server
24 :processor-args processor-args
26 (listener (make-instance 'listener :port port
28 :function 'modlisp-command-issuer
29 :function-args (list server)
32 :catch-errors catch-errors
34 :number-fixed-workers number-fixed-workers
35 :remote-host-checker remote-host-checker)))
36 (setf (listener server) listener)
37 (init/listener listener :start)
38 (setf *ml-server* server)
42 (defun modlisp-stop (server)
43 (init/listener (listener server) :stop)
44 (setf (listener server) nil)
47 (defun modlisp-stop-all ()
52 (defun modlisp-command-issuer (*modlisp-socket* server)
53 "generates commands from modlisp, issues commands to processor-fun"
56 (let ((*number-worker-requests* 0)
57 (*close-modlisp-socket* t)
59 (do ((command (read-modlisp-command) (read-modlisp-command)))
61 (apply (processor server) command (processor-args server))
62 (finish-output *modlisp-socket*)
63 (incf *number-worker-requests*)
64 (incf *number-server-requests*)
65 (when *close-modlisp-socket*
67 (close-active-socket *modlisp-socket*)))
69 (defun header-value (header key)
70 "Returns the value of a modlisp header"
71 (cdr (assoc key header :test #'eq)))
73 (defun read-modlisp-command ()
75 (let* ((header (read-modlisp-header))
76 (content-length (header-value header :content-length))
77 (content (when content-length
79 (parse-integer content-length :junk-allowed t)))))
81 (read-sequence content *modlisp-socket*)
82 (push (cons :posted-content content) header))
86 (defun read-modlisp-line ()
87 (kmrcl:string-right-trim-one-char
89 (read-line *modlisp-socket* nil nil)))
92 (defun read-modlisp-header ()
93 (loop for key = (read-modlisp-line)
94 while (and key (string-not-equal key "end"))
95 for value = (read-modlisp-line)
96 collect (cons (ensure-keyword key) value)))
98 (defun write-header-line (key value)
99 (write-string (string key) *modlisp-socket*)
100 (write-char #\NewLine *modlisp-socket*)
101 (write-string value *modlisp-socket*)
102 (write-char #\NewLine *modlisp-socket*))