diff options
| -rwxr-xr-x | journal.lisp | 105 | ||||
| -rwxr-xr-x | make-clisp-package.sh | 4 | ||||
| -rwxr-xr-x | make-core-image.sh | 3 |
3 files changed, 76 insertions, 36 deletions
diff --git a/journal.lisp b/journal.lisp index 9042b62..9753cf7 100755 --- a/journal.lisp +++ b/journal.lisp @@ -30,20 +30,22 @@ :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 #:alexandria #:xml-emitter)) + #:yaclml #:lisp-cgi-utils #:alexandria #:xml-emitter + #:split-sequence)) ;;; 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) +(unless (find-package '#:http) + (asdf:oos 'asdf:load-op '#:mulk.journal)) (defpackage #:mulk.journal (:nicknames #:journal) (:use #:cl #:fad #:iterate #:markdown #:yaclml #:http #:alexandria - #:xml-emitter)) + #:xml-emitter #:split-sequence)) (in-package #:mulk.journal) @@ -57,6 +59,13 @@ '#:keyword))) +(defparameter *site* + (if (file-exists-p #p"/home/mulk") :mst-plus :nfs.net) + "One of :WIRSELKRAUT and :NFS.NET.") + +(defparameter *debugging-p* + (eq *site* :mst-plus)) + (defparameter *query* #+clisp (mapcan #'(lambda (param) @@ -70,17 +79,45 @@ #-clisp '() "The HTTP query string transformed into a property list.") -(defparameter *action* - (keywordify (getf *query* :action)) - "One of NIL, :INDEX, :VIEW-ATOM-FEED, :VIEW, :POST, :EDIT, :PREVIEW, - and :POST-COMMENT.") +(defparameter *http-env* + (http-get-env-vars) + "A hash table of HTTP environment variables.") + +(defparameter *subpath-query* + (subseq (gethash "REQUEST_URI" *http-env*) + (length (if (eq *site* :mst-plus) + (gethash "SCRIPT_NAME" *http-env*) + "/journal"))) + "The query string stripped of the script location.") + +(defparameter *subpath-string* + (subseq *subpath-query* + 0 + (or (position #\? *subpath-query*) + (length *subpath-query*))) + "The query string stripped of the script location and query parameters, + that is, the virtual path below the script.") + +(defparameter *subpath* + (split-sequence #\/ *subpath-string* + :remove-empty-subseqs t) + "*SUBPATH-STRING* parsed into a list of nested directories.") (defparameter *post-number* - (parse-integer (getf *query* :id "") + (parse-integer (or (first *subpath*) + (getf *query* :id "")) :junk-allowed t #|| :radix 12 ||#) "The identification number of the journal entry to be acted upon. May be NIL.") +(defparameter *action* + (or (keywordify (getf *query* :action)) + (cond (*post-number* :view) + ((string= "feed" (first *subpath*)) :view-atom-feed) + (t nil))) + "One of NIL, :INDEX, :VIEW-ATOM-FEED, :VIEW, :POST, :EDIT, :PREVIEW, + and :POST-COMMENT.") + (defparameter *method* (keywordify (gethash "REQUEST_METHOD" (http-get-env-vars))) "One of :GET, :POST, :PUT, and :DELETE.") @@ -89,10 +126,6 @@ '() "A list of JOURNAL-ENTRY objects.") -(defparameter *http-env* - (http-get-env-vars) - "A hash table of HTTP environment variables.") - (defclass journal-entry () ((id :type (integer 0) @@ -344,18 +377,23 @@ after another in any arbitrary order." (defun link-to (action &key post-id (absolute nil)) (with-output-to-string (out) - (format out (if absolute - "http://benkard.nfshost.com/journal/journal.cgi" - "journal.cgi")) - + (format out "~A" (if absolute + "http://matthias.benkard.de/journal" + ;; When testing on the local webserver, don't + ;; use /journal as a relative URI, because it + ;; won't work. + (if (search ".cgi" + (gethash "REQUEST_URI" *http-env* "")) + (gethash "SCRIPT_NAME" *http-env* "") + "/journal"))) (multiple-value-call #'(lambda (&rest args) (apply #'format out args)) (case action (:index "") - (:view-atom-feed (values "?action=view-atom-feed")) - (:view (values "?action=view&id=~D" post-id)) - (:edit (values "?action=edit&id=~D" post-id)) - (:post-comment (values "?action=view&id=~D" post-id)))))) + (:view-atom-feed (values "/feed")) + (:view (values "/~D" post-id)) + (:edit (values "/~D?action=edit" post-id)) + (:post-comment (values "/~D" post-id)))))) (defun show-atom-feed () @@ -410,9 +448,9 @@ after another in any arbitrary order." ("href" ,(link-to :view :post-id id :absolute t))))) - (with-tag ("content" '(("type" "xhtml") + (with-tag ("content" `(("type" "xhtml") ("xml:lang" "de") - ("xml:base" "http://benkard.nfshost.com/journal"))) + ("xml:base" ,(link-to :index :absolute t)))) (with-tag ("div" '(("xmlns" "http://www.w3.org/1999/xhtml"))) (xml-as-is (journal-markup->html (body-of journal-entry)))))))))))) @@ -587,17 +625,18 @@ after another in any arbitrary order." (<:div :id :navigation)) - #+debug - (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))))))) + (when *debugging-p* + (loop for (x . y) in `(("Action" . ,*action*) + ("Request method" . ,*method*) + ("Query" . ,*query*) + ("Query string" . ,(http-get-query-string)) + ("Subpath" . ,*subpath*) + ("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)))))))) (defun write-out-entry (entry) diff --git a/make-clisp-package.sh b/make-clisp-package.sh index b254b62..c3f094e 100755 --- a/make-clisp-package.sh +++ b/make-clisp-package.sh @@ -1,5 +1,5 @@ #! /bin/sh cd ~ -for x in Downloads/Darcs/{metabang-bind,iterate,cl-markdown,cl-containers,defsystem-compatibility,alexandria,lw-compat,moptilities,metatilities,Bese/arnesi_dev,Bese/yaclml,asdf-system-connections,closer-mop,parenscript} .clc/site/{xml-emitter-1.0.2,lisp-cgi-utils-0.9,cl-utilities-1.2.4} /usr/share/common-lisp/source/{asdf,cl-fad,cl-ppcre,slime}; do +for x in Downloads/Darcs/{metabang-bind,iterate,cl-markdown,cl-containers,defsystem-compatibility,alexandria,lw-compat,moptilities,metatilities,Bese/arnesi_dev,Bese/yaclml,asdf-system-connections,closer-mop,parenscript} .clc/site/{xml-emitter-1.0.2,lisp-cgi-utils-0.9,cl-utilities-1.2.4} /usr/share/common-lisp/source/{asdf,cl-fad,cl-ppcre,slime,split-sequence}; do find "$x" -not -regex ".*/_darcs/.*" \( -regex ".*\\.lisp" -or -regex ".*\\.asd" \) -done | tar -T - -cjf - | ssh mulk_benkard@ssh.phx.nearlyfreespeech.net 'mkdir -p /tmp/clisp-stuff && cd /tmp/clisp-stuff && tar xjf - && mkdir -p /tmp/asdf && cd /tmp/asdf && find ../clisp-stuff -name "*.asd" | xargs -I "{}" ln -sf "{}" . && cd ../clisp-stuff && mkdir -p /home/tmp/clisp-stuff/Downloads/Darcs/asdf-system-connections/website/source/images && touch /home/tmp/clisp-stuff/Downloads/Darcs/asdf-system-connections/website/source/index.lml && clisp -x "(load \"usr/share/common-lisp/source/asdf/asdf.lisp\")" -x "(let ((asdf:*central-registry* (quote (#p\"/tmp/asdf/\")))) (dolist (x (list :cl-ppcre :cl-fad :iterate :cl-markdown :parenscript :yaclml :lisp-cgi-utils :alexandria :xml-emitter)) (asdf:oos (quote asdf:load-op) x)) (saveinitmem \"lispinit.mem\"))" && gzip -f lispinit.mem && mv lispinit.mem.gz /home/private/ && rm -rf /tmp/clisp-stuff && rm -rf /tmp/asdf' +done | tar -T - -cjf - | ssh mulk_benkard@ssh.phx.nearlyfreespeech.net 'mkdir -p /tmp/clisp-stuff && cd /tmp/clisp-stuff && tar xjf - && mkdir -p /tmp/asdf && cd /tmp/asdf && find ../clisp-stuff -name "*.asd" | xargs -I "{}" ln -sf "{}" . && cd ../clisp-stuff && mkdir -p /home/tmp/clisp-stuff/Downloads/Darcs/asdf-system-connections/website/source/images && touch /home/tmp/clisp-stuff/Downloads/Darcs/asdf-system-connections/website/source/index.lml && clisp -x "(load \"usr/share/common-lisp/source/asdf/asdf.lisp\")" -x "(let ((asdf:*central-registry* (quote (#p\"/tmp/asdf/\")))) (dolist (x (list :cl-ppcre :cl-fad :iterate :cl-markdown :parenscript :yaclml :lisp-cgi-utils :alexandria :xml-emitter :split-sequence)) (asdf:oos (quote asdf:load-op) x)) (saveinitmem \"lispinit.mem\"))" && gzip -f lispinit.mem && mv lispinit.mem.gz /home/private/ && rm -rf /tmp/clisp-stuff && rm -rf /tmp/asdf' diff --git a/make-core-image.sh b/make-core-image.sh index 1c65f35..28cbb9a 100755 --- a/make-core-image.sh +++ b/make-core-image.sh @@ -1,7 +1,8 @@ #! /bin/sh clisp -q -q -on-error exit <<EOF (dolist (system '(:cl-ppcre :cl-fad :iterate :cl-markdown :parenscript - :yaclml :lisp-cgi-utils :alexandria :xml-emitter)) + :yaclml :lisp-cgi-utils :alexandria :xml-emitter + :split-sequence)) (clc:clc-require system)) (saveinitmem "lispinit.mem") (quit) |