/usr/share/common-lisp/source/modlisp/base.lisp is in cl-modlisp 0.6-7.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 | ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: modlisp -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Name: base.lisp
;;;; Purpose: Utility functions for modlisp package
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Dec 2002
;;;;
;;;; $Id: base.lisp 7061 2003-09-07 06:34:45Z kevin $
;;;; *************************************************************************
(in-package #:modlisp)
(defun modlisp-start (&key (port +default-modlisp-port+)
(processor 'demo-modlisp-command-processor)
(processor-args nil)
(catch-errors t)
timeout
number-fixed-workers
remote-host-checker)
(let* ((server (make-instance 'ml-server
:processor processor
:processor-args processor-args
:port port))
(listener (make-instance 'listener :port port
:base-name "modlisp"
:function 'modlisp-command-issuer
:function-args (list server)
:format :text
:wait nil
:catch-errors catch-errors
:timeout timeout
:number-fixed-workers number-fixed-workers
:remote-host-checker remote-host-checker)))
(setf (listener server) listener)
(init/listener listener :start)
(setf *ml-server* server)
server))
(defun modlisp-stop (server)
(init/listener (listener server) :stop)
(setf (listener server) nil)
server)
(defun modlisp-stop-all ()
(stop-all/listener))
;; Internal functions
(defun modlisp-command-issuer (*modlisp-socket* server)
"generates commands from modlisp, issues commands to processor-fun"
(unwind-protect
(progn
(let ((*number-worker-requests* 0)
(*close-modlisp-socket* t)
(*ml-server* server))
(do ((command (read-modlisp-command) (read-modlisp-command)))
((null command))
(apply (processor server) command (processor-args server))
(finish-output *modlisp-socket*)
(incf *number-worker-requests*)
(incf *number-server-requests*)
(when *close-modlisp-socket*
(return)))))
(close-active-socket *modlisp-socket*)))
(defun header-value (header key)
"Returns the value of a modlisp header"
(cdr (assoc key header :test #'eq)))
(defun read-modlisp-command ()
(ignore-errors
(let* ((header (read-modlisp-header))
(content-length (header-value header :content-length))
(content (when content-length
(make-string
(parse-integer content-length :junk-allowed t)))))
(when content
(read-sequence content *modlisp-socket*)
(push (cons :posted-content content) header))
header)))
(defun read-modlisp-line ()
(kmrcl:string-right-trim-one-char
#\return
(read-line *modlisp-socket* nil nil)))
(defun read-modlisp-header ()
(loop for key = (read-modlisp-line)
while (and key (string-not-equal key "end"))
for value = (read-modlisp-line)
collect (cons (ensure-keyword key) value)))
(defun write-header-line (key value)
(write-string (string key) *modlisp-socket*)
(write-char #\NewLine *modlisp-socket*)
(write-string value *modlisp-socket*)
(write-char #\NewLine *modlisp-socket*))
|