summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--defpackage.lisp10
-rw-r--r--globals.lisp1
-rw-r--r--main.lisp31
-rw-r--r--mulk-journal.asd2
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
diff --git a/main.lisp b/main.lisp
index df03ffe..9b290a4 100644
--- a/main.lisp
+++ b/main.lisp
@@ -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")))