/usr/share/common-lisp/source/modlisp/utils.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 | ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: modlisp -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Name: utils.lisp
;;;; Purpose: Utility functions for modlisp package
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Dec 2002
;;;;
;;;; $Id: utils.lisp 8022 2003-10-22 00:43:53Z kevin $
;;;; *************************************************************************
(in-package #:modlisp)
(defun format-string (fmt headers)
`(("Content-Type" .
,(case fmt
(:html "text/html")
(:xml "text/xml")
(:text "text/plain")
(otherwise fmt)))
. ,headers))
(defmacro write-response ((&key headers len (status "200 OK")) &body body)
(let ((result (gensym "RES-")))
`(progn
(write-header-line "Status" ,status)
(dolist (hdr ,headers)
(write-header-line (car hdr) (cdr hdr)))
,@(and len
`((write-header-line "Content-Length" ,len)
(write-header-line "Keep-Socket" "1")
(write-header-line "Connection" "Keep-Alive")))
(write-string "end" *modlisp-socket*)
(write-char #\NewLine *modlisp-socket*)
(let ((,result (progn ,@body)))
(,(if len 'force-output 'finish-output) *modlisp-socket*)
(setq *close-modlisp-socket* ,(not len))
,result))))
(defmacro with-ml-page ((&key (format :html) (precompute t) headers)
&body body)
(if precompute
`(output-ml-page ,format (with-output-to-string (*modlisp-socket*) ,@body) :headers ,headers)
`(write-response (:headers (format-string ,format ,headers)) ,@body)))
(defun redirect-to-location (url)
(write-response (:status "307 Temporary Redirect" :headers `(("Location" . ,url)))))
(defmacro output-ml-page (format html &key headers)
(let ((str (gensym "STR-")))
`(let ((,str ,html))
(write-response (:len (format nil "~d" (length ,str))
:headers (format-string ,format ,headers))
(write-string ,str *modlisp-socket*)))))
(defun output-html-page (str &key headers)
(output-ml-page :html str :headers headers))
(defun output-xml-page (str &key headers)
(output-ml-page :xml str :headers headers))
;; Utility functions for library users
(defun query-to-alist (posted-string &key (keyword t))
"Converts a posted string to an assoc list of keyword names and values,
\"a=1&bc=demo\" => ((:a . \"1\") (:bc . \"demo\"))"
(when posted-string
(let ((alist '()))
(dolist (name=val (kmrcl:delimited-string-to-list posted-string #\&)
(nreverse alist))
(let ((name-val-list (kmrcl:delimited-string-to-list name=val #\=)))
(if (= 2 (length name-val-list))
(destructuring-bind (name val) name-val-list
(push (cons (if keyword
(kmrcl:ensure-keyword name)
name)
(kmrcl:decode-uri-query-string val))
alist))
(cmsg-c :debug "Invalid number of #\= in ~S" name-val-list)))))))
|