summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthias Benkard <code@mail.matthias.benkard.de>2007-05-28 16:52:54 +0200
committerMatthias Benkard <code@mail.matthias.benkard.de>2007-05-28 16:52:54 +0200
commit8ea9fc44fb76060010356324d3bb94ca2e365cc5 (patch)
treeb2ee951183564acfa971d605405f1dacd97ee671
Beginnings of a CGI web journal.
darcs-hash:69ce37acf510a840750e060433eaa72e64dfc6a1
-rwxr-xr-xjournal.cgi3
-rwxr-xr-xjournal.lisp77
-rwxr-xr-xmake-core-image.sh12
3 files changed, 92 insertions, 0 deletions
diff --git a/journal.cgi b/journal.cgi
new file mode 100755
index 0000000..96e46d9
--- /dev/null
+++ b/journal.cgi
@@ -0,0 +1,3 @@
+#! /bin/sh
+DIR=`dirname "$0"`
+exec clisp -M "$DIR/lispinit.mem.gz" "$DIR/journal.lisp" "$@"
diff --git a/journal.lisp b/journal.lisp
new file mode 100755
index 0000000..9bc71e6
--- /dev/null
+++ b/journal.lisp
@@ -0,0 +1,77 @@
+#! /usr/bin/env clisp
+;;;; -*- coding: utf-8; mode: lisp -*-
+;;;; Copyright 2007, Matthias Andreas Benkard.
+
+
+;;; TAKE NOTICE: If you want to run this script from the command line or
+;;; from a web server, be sure to use a core image including the systems
+;;; this script depends upon. The DEFSYSTEM form below has mainly been
+;;; written for purposes of documentation.
+(asdf:defsystem #:mulk.journal
+ :description "Matthias Benkard's simple web journal engine"
+ :licence "Affero General Public License, version 1 or higher"
+ :depends-on (#:cl-ppcre #:cl-fad #:iterate #:cl-markdown #:parenscript
+ #:yaclml #:lisp-cgi-utils))
+
+
+;;; The following does not generally work in a CGI setting because of
+;;; security restrictions. Loading all the dependencies individually
+;;; rather than using a core image would certainly be too slow for any
+;;; serious CGI usage, anyway, so what the heck.
+#+nil (asdf:oos 'asdf:load-op '#:mulk.journal)
+
+
+(defpackage #:mulk.journal
+ (:nicknames #:journal)
+ (:use #:cl #:fad #:iterate #:markdown #:yaclml #:http))
+
+(in-package #:mulk.journal)
+
+
+(defun keywordify (thing)
+ (if (null thing)
+ thing
+ (intern (etypecase thing
+ (string (string-upcase thing))
+ (symbol (symbol-name thing)))
+ '#:keyword)))
+
+
+(defparameter *query*
+ (mapcan #'(lambda (param)
+ (list (keywordify param)
+ (http-query-parameter param)))
+ (http-query-parameter-list))
+ "The HTTP query string transformed into a property list.")
+
+(defparameter *action*
+ (keywordify (getf *query* :action))
+ "One of NIL, :INDEX, :VIEW, :POST, :EDIT, and :PREVIEW.")
+
+(defparameter *entry-number*
+ (parse-integer (getf *query* :entry "")
+ :junk-allowed t #|| :radix 12 ||#)
+ "The identification number of the blog entry to be acted upon.
+ May be NIL.")
+
+(defparameter *method*
+ (keywordify (gethash "REQUEST_METHOD" (http-get-env-vars)))
+ "One of :GET, :POST, :PUT, and :DELETE.")
+
+
+(http-add-header "Content-type" "text/html; charset=UTF-8")
+(http-send-headers)
+
+
+(<:html
+ (<:body
+ (loop for (x . y) in `(("Action" . ,*action*)
+ ("Request method" . ,*method*)
+ ("Query" . ,*query*)
+ ("Query string" . ,(http-get-query-string))
+ ("Environment" . ,(http-get-env-vars)))
+ do (<:p
+ (<:hr)
+ (<:h2 (<:as-html x))
+ (<:p "Type " (<:em (<:as-html (type-of y))) ".")
+ (<:pre (<:as-html (prin1-to-string y)))))))
diff --git a/make-core-image.sh b/make-core-image.sh
new file mode 100755
index 0000000..d396b48
--- /dev/null
+++ b/make-core-image.sh
@@ -0,0 +1,12 @@
+#! /bin/sh
+clisp -q -q -on-error exit <<EOF
+(dolist (system '(:cl-ppcre :cl-fad :iterate :cl-markdown :parenscript
+ :yaclml :lisp-cgi-utils))
+ (clc:clc-require system))
+(saveinitmem "lispinit.mem")
+(quit)
+EOF
+
+if [ x$? = x0 ]; then
+ gzip -f lispinit.mem
+fi