(in-package :lisppaste) (defun paste-xml-list (paste &optional contents) ;  (format t "collecting paste number ~A~%" (paste-number paste))  (list* (paste-number paste)          (s-xml-rpc:xml-rpc-time (paste-universal-time paste))          (paste-user paste)          (paste-channel paste)          (paste-title paste)          (length (paste-annotations paste))          (if contents              (list (remove #\return (paste-contents paste)))))) (setf s-xml-rpc:*xml-rpc-call-hook*       (lambda (method-name &rest args)         (format t "Handling XML-RPC request for ~S ~{~S~^ ~}~%" method-name args)         (block hook           (handler-bind               ((condition #'(lambda (c) (return-from hook                                       (format nil "Error encountered: ~S" c)))))             (cond ((string-equal method-name "newpaste")                    (destructuring-bind                          (paste-channel paste-user paste-title paste-contents &optional annotate-or-colorize-as) args                      (if (not (every #'stringp (list paste-channel paste-user paste-title paste-contents)))                          "Error: all arguments must be strings."                          (if (not (every (lambda (s) (> (length s) 0)) (list paste-channel paste-user paste-title paste-contents)))                              "Error: all arguments must be non-empty strings."                              (if (> (length paste-contents)                                     *paste-maximum-size*)                                  "Error: paste too large."                                  (let* ((annotate (if (numberp annotate-or-colorize-as) annotate-or-colorize-as))                                         (colorize-as (if (stringp annotate-or-colorize-as) annotate-or-colorize-as ""))                                         (annotate-this (if annotate (find annotate *pastes* :key #'paste-number)))                                        (paste-contents (remove #\return paste-contents)))                                    (if (and annotate (not annotate-this))                                        "Error: bad annotation number."                                        (if (if annotate-this                                                (not (string-equal paste-channel (paste-channel annotate-this)))                                                (not (member paste-channel *channels* :test #'string-equal)))                                            (format nil "Error: invalid channel ~S." paste-channel)                                            (let* ((number (if annotate                                                               (incf (paste-annotation-counter annotate-this))                                                               (incf *paste-counter*)))                                                   (url (araneida:urlstring                                                         (araneida:merge-url *display-paste-url*                                                                             (if annotate                                                                                 (format nil "~A#~A"                                                                                         (paste-number annotate-this)                                                                                         number)                                                                                 (prin1-to-string number))))))                                              (make-new-paste *pastes* (annotate                                                                        (paste-number annotate-this)                                                                        (paste-annotations annotate-this))                                                              url                                                              :number number                                                              :user paste-user                                                              :title paste-title                                                              :contents paste-contents                                                              :universal-time (get-universal-time)                                                              :channel paste-channel                                                              :colorization-mode colorize-as)                                              (format nil "Your paste has been announced to ~A and is available at ~A ."                                                      paste-channel url))))))))))                   ((string-equal method-name "pasteheaders")                    (destructuring-bind                     (length &optional supplied-start) args                     (let ((start (or supplied-start (paste-number (car *pastes*)))))                       (mapcar #'paste-xml-list                               (loop for i from 1 to length                                     for j in (member start *pastes* :key #'paste-number)                                     collect j)))))                   ((string-equal method-name "pasteheadersbychannel")                    (destructuring-bind                     (channel length &optional supplied-start) args                     (let* ((*pastes* (remove channel *pastes* :test-not #'string-equal :key #'paste-channel))                            (start (or supplied-start (paste-number (car *pastes*)))))                       (mapcar #'paste-xml-list                               (loop for i from 1 to length                                     for j in (member start *pastes* :key #'paste-number)                                     collect j)))))                   ((string-equal method-name "pasteannotationheaders")                    (nreverse                     (mapcar #'paste-xml-list                             (paste-annotations (find (car args) *pastes* :key #'paste-number :test #'eql)))))                   ((string-equal method-name "pastedetails")                    (destructuring-bind                     (paste &optional annotation) args                     (if (not annotation)                         (paste-xml-list (find paste *pastes* :key #'paste-number :test #'eql) t)                       (paste-xml-list                        (find annotation                              (paste-annotations (find paste *pastes* :key #'paste-number :test #'eql))                              :key #'paste-number :test #'eql) t))))                   ((string-equal method-name "listchannels")                    *channels*)                   (t (format nil "Error: unimplemented method ~S." method-name)))))))