X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=utils.lisp;h=387fa7396c706497a05308637ed4c40eaec900bc;hb=ea50229269c428ed82edcda11fa056786469cac7;hp=04376fdd43dcb018ebb66e3c30d1078e2c259414;hpb=118ee93d69e2b09d12eb317f6db3fbda113be82f;p=cl-modlisp.git diff --git a/utils.lisp b/utils.lisp index 04376fd..387fa73 100644 --- a/utils.lisp +++ b/utils.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Dec 2002 ;;;; -;;;; $Id: utils.lisp,v 1.1 2003/07/04 19:52:32 kevin Exp $ +;;;; $Id: utils.lisp,v 1.6 2003/07/11 02:38:00 kevin Exp $ ;;;; ************************************************************************* (in-package #:modlisp) @@ -31,42 +31,48 @@ (write-header-line "Status" "200 OK") (write-header-line "Content-Type" (format-string ,fmt)) (unless ,precomp - (write-string "end" *apache-socket*) - (write-char #\NewLine *apache-socket*)) + (write-string "end" *modlisp-socket*) + (write-char #\NewLine *modlisp-socket*)) (setq ,outstr (with-output-to-string (,stream) - (let ((*apache-socket* (if ,precomp + (let ((*modlisp-socket* (if ,precomp ,stream - *apache-socket*))) + *modlisp-socket*))) (setq ,result (progn ,@body))))) (cond (,precomp - (write-header-line "Content-Length" (write-to-string (length ,outstr))) + (write-header-line "Content-Length" + (write-to-string (length ,outstr))) (write-header-line "Keep-Socket" "1") - (write-string "end" *apache-socket*) - (write-char #\NewLine *apache-socket*) - (write-string ,outstr *apache-socket*) - (setq *close-apache-socket* nil)) + (write-header-line "Keep-Alive" "timeout=15, max=99") + (write-header-line "Connection" "Keep-Alive") + (write-string "end" *modlisp-socket*) + (write-char #\NewLine *modlisp-socket*) + (write-string ,outstr *modlisp-socket*) + (finish-output *modlisp-socket*) + (setq *close-modlisp-socket* nil)) (t - (finish-output *apache-socket*) - (setq *close-apache-socket* t))) + (setq *close-modlisp-socket* t) + (finish-output *modlisp-socket*))) ,result))) (defun redirect-to-location (url) (write-header-line "Status" "302 Redirect") (write-header-line "Location" url) - (write-char #\NewLine *apache-socket*) - (setq *close-apache-socket* t)) + (write-char #\NewLine *modlisp-socket*) + (setq *close-modlisp-socket* t)) (defun output-ml-page (format html) (write-header-line "Status" "200 OK") (write-header-line "Content-Type" (format-string format)) (write-header-line "Content-Length" (format nil "~d" (length html))) (write-header-line "Keep-Socket" "1") - (write-string "end" *apache-socket*) - (write-char #\NewLine *apache-socket*) - (write-string html *apache-socket*) - (setq *close-apache-socket* nil)) + (write-header-line "Keep-Alive" "timeout=15, max=99") + (write-header-line "Connection" "Keep-Alive") + (write-string "end" *modlisp-socket*) + (write-char #\NewLine *modlisp-socket*) + (write-string html *modlisp-socket*) + (setq *close-modlisp-socket* nil)) (defun output-html-page (str) (output-ml-page :html str)) @@ -74,16 +80,19 @@ (defun output-xml-page (str) (output-ml-page :xml str)) +;; Utility functions for library users + (defun posted-to-alist (posted-string) - "Converts a posted string to an assoc list of variable names and values" + "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 #\=))) - (when (= 2 (length name-val-list)) + (if (= 2 (length name-val-list)) (destructuring-bind (name val) name-val-list (push (cons (kmrcl:ensure-keyword name) - (decode-uri-query-string val)) - alist)))))))) - + (kmrcl:decode-uri-query-string val)) + alist)) + (cmsg-c :debug "Invalid number of #\= in ~S" name-val-list)))))))