diff options
author | Matthias Benkard <code@mail.matthias.benkard.de> | 2009-10-08 22:18:50 +0200 |
---|---|---|
committer | Matthias Benkard <code@mail.matthias.benkard.de> | 2009-10-08 22:18:50 +0200 |
commit | e90cc72980014bb8e113033c38058ae26a6ed1b8 (patch) | |
tree | b10df8f85ab3e946d424c42d7e71aa27f237e233 /main.lisp | |
parent | 2d574face5edc74d932df5317cbd9b0b672c5cfe (diff) |
Enable WSSE authentication.
Ignore-this: a6ac88e1116f63a79ef8ccb4598b6280
darcs-hash:cc2c4916527d57c382cf2c342da04a7fd2b475ed
Diffstat (limited to 'main.lisp')
-rw-r--r-- | main.lisp | 87 |
1 files changed, 47 insertions, 40 deletions
@@ -59,6 +59,8 @@ (*method* (keywordify (gethash "REQUEST_METHOD" *http-env*))) (*if-modified-since* #+clisp (ext:getenv "HTTP_IF_MODIFIED_SINCE") #-clisp nil) + (*wsse* #+clisp (ext:getenv "HTTP_X_WSSE") + #-clisp nil) (*script-filename* (pathname-as-file (or (gethash "SCRIPT_FILENAME" *http-env*) "/home/mulk/Dokumente/Projekte/Mulkblog/journal.cgi"))) @@ -78,6 +80,10 @@ "wordpress-api-key.key" *data-dir*)) (read-line file))) + (*wsse-key* (with-open-file (file (merge-pathnames + "wsse.key" + *data-dir*)) + (read-line file))) (database-file (merge-pathnames #p"journal.sqlite3" *data-dir*)) (sqlite-library (merge-pathnames #p"libsqlite3.so" (ecase *site* @@ -145,46 +151,6 @@ :where [= [id] id] :av-pairs `((spam_p "t"))))) (show-moderation-page))) - (:view-atom-entry - (cond ((string= *method* "GET") - (if *post-number* - (show-atom-entry) - (show-atom-feed :include-edit-links t :full-content t))) - ((member *method* '("POST" "PUT") :test 'equal) - (with-transaction () - (let* ((entry (if (string= *method* "PUT") - (find-entry *post-number*) - (make-instance 'journal-entry - :id (make-journal-entry-id) - :uuid (make-uuid) - :date (get-universal-time) - :last-modification nil - :categories () - :comments ())))) - (when (string= *method* "PUT") - (setf (last-modification-of entry) - (get-universal-time))) - (let* ((post-data (with-output-to-string (out) - (loop for line = (read-line *standard-input* nil nil nil) - while line - do (write-line line out)))) - (xml (xmls:parse post-data)) - (entry-elements (cddr xml)) - (content-element (find "content" entry-elements :key 'car :test 'equal)) - (content (caddr content-element)) - (title-element (find "title" entry-elements :key 'cat :test 'equal)) - (content-type (cadr (assoc "type" (cadr content-element)))) - (content-mode (cadr (assoc "type" (cadr content-element))))) - (when content-element - (setf (body-of entry) (etypecase content - (null "") - (cons (xmls:toxml content :indent t)) - (string content)))) - (when title-element - (setf (title-of entry) (or (caddr title-element) ""))) - (setf (entry-type-of entry) "html")) - (update-records-from-instance entry))) - (show-atom-entry)))) (otherwise (show-web-journal))) #.(restore-sql-reader-syntax-state)) @@ -282,6 +248,47 @@ (format t "<?xml version=\"1.0\" encoding=\"utf-8\"?>~&<response>~&<error>0</error>~&</response>")) (t (format t "<?xml version=\"1.0\" encoding=\"utf-8\"?>~&<response>~&<error>1</error>~&<message>No URI was provided.</message>~&</response>")))))) + (:view-atom-entry + (with-wsse-authentication () + (cond ((string= *method* "GET") + (if *post-number* + (show-atom-entry) + (show-atom-feed :include-edit-links t :full-content t))) + ((member *method* '("POST" "PUT") :test 'equal) + (with-transaction () + (let* ((entry (if (string= *method* "PUT") + (find-entry *post-number*) + (make-instance 'journal-entry + :id (make-journal-entry-id) + :uuid (make-uuid) + :date (get-universal-time) + :last-modification nil + :categories () + :comments ())))) + (when (string= *method* "PUT") + (setf (last-modification-of entry) + (get-universal-time))) + (let* ((post-data (with-output-to-string (out) + (loop for line = (read-line *standard-input* nil nil nil) + while line + do (write-line line out)))) + (xml (xmls:parse post-data)) + (entry-elements (cddr xml)) + (content-element (find "content" entry-elements :key 'car :test 'equal)) + (content (caddr content-element)) + (title-element (find "title" entry-elements :key 'cat :test 'equal)) + (content-type (cadr (assoc "type" (cadr content-element)))) + (content-mode (cadr (assoc "type" (cadr content-element))))) + (when content-element + (setf (body-of entry) (etypecase content + (null "") + (cons (xmls:toxml content :indent t)) + (string content)))) + (when title-element + (setf (title-of entry) (or (caddr title-element) ""))) + (setf (entry-type-of entry) "html")) + (update-records-from-instance entry))) + (show-atom-entry))))) (:view-atom-feed (show-atom-feed)) (:view-comment-feed (show-comment-feed)) (:view-debugging-page (show-debugging-page)) |