diff options
-rw-r--r-- | defpackage.lisp | 10 | ||||
-rw-r--r-- | globals.lisp | 1 | ||||
-rw-r--r-- | main.lisp | 31 | ||||
-rw-r--r-- | mulk-journal.asd | 2 |
4 files changed, 33 insertions, 11 deletions
diff --git a/defpackage.lisp b/defpackage.lisp index 3911d1b..9f4ffd9 100644 --- a/defpackage.lisp +++ b/defpackage.lisp @@ -1,5 +1,5 @@ ;;;; -*- coding: utf-8; mode: lisp -*- -;;;; Copyright 2007, Matthias Andreas Benkard. +;;;; Copyright 2007-2009, Matthias Andreas Benkard. ;;;------------------------------------------------------------------------ ;;; This file is part of The Mulkblog Project. @@ -23,5 +23,11 @@ (defpackage #:mulk.journal (:nicknames #:journal) (:use #:cl #:fad #:iterate #:markdown #:yaclml #:http #:alexandria - #:xml-emitter #:split-sequence #:clsql #:drakma) + #:xml-emitter #:split-sequence #:clsql #:drakma #:s-xml-rpc) (:shadow #:copy-file #:copy-stream #:format-date)) + +(defpackage #:mulk.journal.xml-rpc + (:nicknames #:journal-xml-rpc) + ;; Do not :USE anything here, not even #:COMMON-LISP! + (:use) + (:import-from #:s-xml-rpc-exports #:system.getCapabilities #:system.listMethods #:system.methodHelp #:system.methodSignature #:system.multicall)) diff --git a/globals.lisp b/globals.lisp index e1b9567..b796b0a 100644 --- a/globals.lisp +++ b/globals.lisp @@ -81,6 +81,7 @@ (defparameter *if-modified-since* nil) (defparameter *wsse* nil) (defparameter *wsse-key* nil) +(defparameter *xml-rpc-key* nil) (defparameter *mode* :http ;either :HTTP or :FILE "Whether we are serving stuff dynamically over HTTP or storing it into @@ -77,9 +77,13 @@ "wordpress-api-key.key" *data-dir*)) (read-line file))) - (*wsse-key* (with-open-file (file (merge-pathnames - "wsse.key" - *data-dir*)) + (*wsse-key* (with-open-file (file (merge-pathnames + "wsse.key" + *data-dir*)) + (read-line file))) + (*xml-rpc-key* (with-open-file (file (merge-pathnames + "xml-rpc.key" + *data-dir*)) (read-line file))) (database-file (merge-pathnames #p"journal.sqlite3" *data-dir*)) (sqlite-library (merge-pathnames #p"libsqlite3.so" @@ -299,10 +303,7 @@ (flet ((tag-equal (tag1 tag2) (equal (if (consp tag1) (car tag1) tag1) (if (consp tag2) (car tag2) tag2)))) - (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)))) + (let* ((post-data (slurp-post-data)) (xml (xmls:parse post-data)) (entry-elements (cddr xml)) (content-element (find "content" entry-elements :key 'car :test #'tag-equal)) @@ -327,10 +328,24 @@ (:view-atom-feed (show-atom-feed)) (:view-comment-feed (show-comment-feed)) (:view-debugging-page (show-debugging-page)) - (otherwise (show-web-journal))) + (:xml-rpc (when (eq *method* :post) + (let ((xml-data (slurp-post-data))) + (http-add-header "Content-Language" "de") + (http-send-headers "text/xml; charset=UTF-8") + (write (let ((*xml-rpc-package* + (find-package '#:mulk.journal.xml-rpc))) + (s-xml-rpc::handle-xml-rpc-call xml-data 0)) + :stream *standard-output*)))) + (otherwise (show-web-journal))) #.(restore-sql-reader-syntax-state)) +(defun slurp-post-data () + (with-output-to-string (out) + (loop for line = (read-line *standard-input* nil nil nil) + while line + do (write-line line out)))) + #+clisp (defun journal-main (&key admin-mode) (let ((encoding (ext:make-encoding :charset charset:utf-8))) diff --git a/mulk-journal.asd b/mulk-journal.asd index 9dc15df..50bbaf0 100644 --- a/mulk-journal.asd +++ b/mulk-journal.asd @@ -26,7 +26,7 @@ :depends-on (#:cl-ppcre #:cl-fad #:iterate #:cl-markdown #:parenscript #:yaclml #:lisp-cgi-utils #:alexandria #:xml-emitter #:split-sequence #:clsql #:clsql-uffi #:clsql-sqlite3 - #:drakma #:cybertiggyr-time) + #:drakma #:cybertiggyr-time #:s-xml-rpc) :components ((:module "cybertiggyr-time" :components ((:file "time"))) (:module "xmls" :components ((:file "xmls"))) |