Update of /project/lisppaste/cvsroot/lisppaste2 In directory clnet:/tmp/cvs-serv4784

Modified Files: lisppaste.asd package.lisp system-server.lisp variable.lisp web-server.lisp Log Message: Major change: use webutils and XML mixed mode. Add captchas.

--- /project/lisppaste/cvsroot/lisppaste2/lisppaste.asd 2006/06/29 13:50:23 1.21 +++ /project/lisppaste/cvsroot/lisppaste2/lisppaste.asd 2007/01/16 00:56:30 1.22 @@ -1,5 +1,5 @@ ;;;; Silly emacs, this is -*- Lisp -*- -;;;; $Id: lisppaste.asd,v 1.21 2006/06/29 13:50:23 lisppaste Exp $ +;;;; $Id: lisppaste.asd,v 1.22 2007/01/16 00:56:30 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/lisppaste.asd,v $

;;;; See the LICENSE file for licensing information. @@ -22,19 +22,19 @@ pre-configured IRC channel about the paste and where it can be located." :depends-on (:araneida #-lisppaste-no-irc :cl-irc - :split-sequence :s-xml :s-xml-rpc :cl-ppcre) - :components ((:file "encode-for-pre") - (:file "package" :depends-on ("encode-for-pre")) + :split-sequence :s-xml :s-xml-rpc :cl-ppcre + :html-encode :webutils) + :components ((:file "package") (:file "variable" :depends-on ("package")) (:file "colorize-package") (:file "coloring-css" :depends-on ("colorize-package")) - (:file "colorize" :depends-on ("colorize-package" "coloring-css" "encode-for-pre")) + (:file "colorize" :depends-on ("colorize-package" "coloring-css")) (:file "abbrev") - (:file "clhs-lookup" :depends-on ("encode-for-pre" "abbrev")) - (:file "r5rs-lookup" :depends-on ("encode-for-pre")) - (:file "cocoa-lookup" :depends-on ("encode-for-pre")) - (:file "elisp-lookup" :depends-on ("encode-for-pre")) + (:file "clhs-lookup" :depends-on ("abbrev")) + (:file "r5rs-lookup") + (:file "cocoa-lookup") + (:file "elisp-lookup") #-lisppaste-no-irc (:file "irc-notification" :depends-on ("variable" "package")) (:file "lisppaste" :depends-on ("variable" "clhs-lookup" @@ -46,13 +46,12 @@ (:file "coloring-types" :depends-on ("colorize" "clhs-lookup")) (:file "web-server" - :depends-on ("encode-for-pre" "lisppaste" - "colorize-package" - "colorize" - "coloring-css")) + :depends-on ("lisppaste" + "colorize-package" + "colorize" + "coloring-css")) (:file "system-server" - :depends-on ("variable" "encode-for-pre" - "colorize-package" + :depends-on ("variable" "colorize-package" "coloring-css")) (:file "xml-paste" :depends-on ("variable" "lisppaste")) --- /project/lisppaste/cvsroot/lisppaste2/package.lisp 2004/11/07 21:01:43 1.10 +++ /project/lisppaste/cvsroot/lisppaste2/package.lisp 2007/01/16 00:56:30 1.11 @@ -1,4 +1,4 @@ -;;;; $Id: package.lisp,v 1.10 2004/11/07 21:01:43 bmastenbrook Exp $ +;;;; $Id: package.lisp,v 1.11 2007/01/16 00:56:30 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/package.lisp,v $

;;;; See the LICENSE file for licensing information. @@ -7,7 +7,7 @@

(eval-when (:execute :load-toplevel :compile-toplevel) (defpackage :lisppaste - (:use :cl #+sbcl :sb-bsd-sockets :html-encode) + (:use :cl #+sbcl :sb-bsd-sockets :html-encode :araneida :webutils) (:export :start-lisppaste :join-new-irc-channel :start-irc-notification :hup-irc-connection :quit-all-connections :hup-all-connections --- /project/lisppaste/cvsroot/lisppaste2/system-server.lisp 2004/07/15 12:37:35 1.1 +++ /project/lisppaste/cvsroot/lisppaste2/system-server.lisp 2007/01/16 00:56:30 1.2 @@ -14,25 +14,28 @@ (find-component-from-string (subseq string start-of-rest) :root new-root) new-root)))))

-(defclass main-system-server-handler (araneida:handler) ()) +(defclass main-system-server-handler (handler) ())

-(defclass show-component-handler (araneida:handler) ()) +(defclass show-component-handler (handler) ())

-(defmethod araneida:handle-request-response ((handler main-system-server-handler) method request) - (araneida:request-send-headers request :expires 0) - (araneida:html-stream - (araneida:request-stream request) +(defmethod handle-request-response ((handler main-system-server-handler) method request) + (request-send-headers request :expires 0) + (xml-output-to-stream + (request-stream request) (lisppaste-wrap-page "Select a System" - `((div :class "controls") - (ul - ,@(loop for i in (all-system-names) - for system = (asdf:find-system i) - collect `(li ((a :href ,(araneida:urlstring (araneida:merge-url *show-component-url* - i))) - ,i) " - " ,(or (ignore-errors (asdf:system-description system)) - (ignore-errors (asdf:system-long-description system)) - "No Description")))))))) + (<div class="controls"> + (<ul> + (loop for i in (all-system-names) + for system = (asdf:find-system i) + collect (<li> + (<a href=?(urlstring (merge-url *show-component-url* + i))> + i) + " - " + (or (ignore-errors (asdf:system-description system)) + (ignore-errors (asdf:system-long-description system)) + "No Description"))))))))

(defun memoize-colorize-file (component type) (let ((ent (list (asdf:component-pathname component) @@ -56,97 +59,98 @@ (string< (asdf:component-name c1) (asdf:component-name c2)))))

(defun module-div (component url) - `(div - ,@(if (typep component 'asdf:system) - `(((div :class "info-text") - ((span :class "small-header") ,(format nil "About system "~A"" (asdf:component-name component))) - (p) - (table - (tr - (td (b "Name")) - (td ,(asdf:component-name component))) - (tr - (td (b "Version")) - (td ,(or (ignore-errors (asdf:component-version component)) "None"))) - (tr - (td (b "Author")) - (td ,(or (ignore-errors (asdf:system-author component)) "None"))) - (tr - (td (b "License")) - (td ,(or (ignore-errors (asdf::system-licence component)) "None"))) - (tr - (td (b "Description")) - (td ,(or (ignore-errors (asdf:system-description component)) "None"))) - (tr - (td (b "Long Description")) - (td ,(or (ignore-errors (asdf:system-long-description component)) "None"))))) - (p))) - ((div :class "controls") - ((span :class "small-header") "Select a component:") - (ul - ,@(loop for i in (sort (copy-list (asdf:module-components component)) #'component-sorter) - for link = `((a :href ,(concatenate 'string + (<div> + (when (typep component 'asdf:system) + (<div class="info-text"> + (<span class="small-header"> + (format nil "About system "~A"" + (asdf:component-name component))) + <p/> + (<table> + (<tr> + (<td> (<b> "Name")) + (<td> (asdf:component-name component))) + (<tr> + (<td> (<b> "Version")) + (<td> (or (ignore-errors (asdf:component-version component)) "None"))) + (<tr> + (<td> (<b> "Author")) + (<td> (or (ignore-errors (asdf:system-author component)) "None"))) + (<tr> + (<td> (<b> "License")) + (<td> (or (ignore-errors (asdf:system-license component)) "None"))) + (<tr> + (<td> (<b> "Description")) + (<td> (or (ignore-errors (asdf:system-description component)) "None"))) + (<tr> + (<td> (<b> "Long Description")) + (<td> (or (ignore-errors (asdf:system-long-description component)) "None")))))) + (<div class="controls"> + (<span class="small-header"> "Select a component:") + (<ul> + (loop for i in (sort (copy-list (asdf:module-components component)) #'component-sorter) + for link = (<a href=?(concatenate 'string url "/" - (asdf:component-name i))) - ,(asdf:component-name i)) - if (typep i 'asdf:module) collect `(li (b ,link)) - else collect `(li ,link)))))) + (asdf:component-name i))> + (asdf:component-name i)) + if (typep i 'asdf:module) collect (<li> (<b> link)) + else collect (<li> link))))))

(defun file-div (component type) - `((table :width "100%" :class "paste-area") - (tr - ((td :bgcolor "#F4F4F4") - (tt - ,(if (eql type :none) - (html-encode:encode-for-tt - (with-output-to-string (s) - (with-open-file (f (asdf:component-pathname component) :direction :input) - (loop for line = (read-line f nil nil) - while line - do (progn (write-string line s) - (terpri s)))))) - (memoize-colorize-file component type))))))) + (<table width="100%" class="paste-area"> + (<tr> + (<td bgcolor="#F4F4F4"> + (if (eql type :none) + (<pre> + (with-output-to-string (s) + (with-open-file (f (asdf:component-pathname component) :direction :input) + (loop for line = (read-line f nil nil) + while line + do (progn (write-string line s) + (terpri s)))))) + (<tt> + (make-unescaped-string + (memoize-colorize-file component type))))))))

-(defmethod araneida:handle-request-response ((handler show-component-handler) method request) - (let ((component (find-component-from-string (araneida:request-unhandled-part request)))) +(defmethod handle-request-response ((handler show-component-handler) method request) + (let ((component (find-component-from-string (request-unhandled-part request)))) (and component (progn - (araneida:request-send-headers request :expires 0) - (araneida:html-stream - (araneida:request-stream request) + (request-send-headers request :expires 0) + (xml-output-to-stream + (request-stream request) (lisppaste-wrap-page (format nil "Component ~A" (asdf:component-name component)) - `(div - ((div :class "controls") - "You are here: " - ((a :href ,(araneida:urlstring *main-system-server-url*)) - "All Systems") - ,@(loop for i in (reverse (maplist #'reverse (nreverse (split-sequence:split-sequence #/ (araneida:request-unhandled-part request))))) - appending `(" / " - ((a :href ,(araneida:urlstring - (araneida:merge-url *show-component-url* + (<div> + (<div class="controls"> + "You are here: " + (<a href=?(urlstring *main-system-server-url*)> + "All Systems") + (loop for i in (reverse (maplist #'reverse (nreverse (split-sequence:split-sequence #/ (request-unhandled-part request))))) + collect " / " + collect (<a href=?(urlstring (merge-url *show-component-url* (format nil "~{~A~^/~}" - i)))) - ,(car (last i)))))) - (p) - ,(typecase component - (asdf:module (module-div component (araneida:urlstring (araneida:request-url request)))) - (asdf:cl-source-file (file-div component :common-lisp-file)) - (asdf:static-file - (file-div component (if (equalp (pathname-type (asdf:component-pathname component)) "lisp") - :common-lisp-file - :none))) - (t `((div :class "paste-area") - "I don't know what to do with this component.")))))))))) + i)))> + (car (last i))))) + <p/> + (typecase component + (asdf:module (module-div component (urlstring (request-url request)))) + (asdf:cl-source-file (file-div component :common-lisp-file)) + (asdf:static-file + (file-div component (if (equalp (pathname-type (asdf:component-pathname component)) "lisp") + :common-lisp-file + :none))) + (t (<div class="paste-area"> + "I'm afraid I don't quite know what to do with this file.")))))))))))))

(when *serve-source* - (araneida:install-handler - (araneida:http-listener-handler *paste-listener*) + (install-handler + (http-listener-handler *paste-listener*) (make-instance 'main-system-server-handler) - (araneida:urlstring *main-system-server-url*) t) + (urlstring *main-system-server-url*) t)

- (araneida:install-handler - (araneida:http-listener-handler *paste-listener*) + (install-handler + (http-listener-handler *paste-listener*) (make-instance 'show-component-handler) - (araneida:urlstring *show-component-url*) nil)) + (urlstring *show-component-url*) nil)) --- /project/lisppaste/cvsroot/lisppaste2/variable.lisp 2006/12/02 00:06:04 1.46 +++ /project/lisppaste/cvsroot/lisppaste2/variable.lisp 2007/01/16 00:56:30 1.47 @@ -1,4 +1,4 @@ -;;;; $Id: variable.lisp,v 1.46 2006/12/02 00:06:04 lisppaste Exp $ +;;;; $Id: variable.lisp,v 1.47 2007/01/16 00:56:30 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/variable.lisp,v $

;;;; See the LICENSE file for licensing information. @@ -25,23 +25,24 @@

(defparameter *internal-http-port* 8080 "Port lisppaste's araneida will listen on for requests from Apache.") -(defparameter *external-http-port* 80 +(defparameter *external-http-port* 8080 "Port lisppaste's araneida will listen on for requests from remote clients.")

-(defparameter *paste-site-name* "paste.lisp.org" +(defparameter *paste-site-name* "distral.local" "Website we are running on (used for creating links).")

(defparameter *paste-external-url* - (araneida:merge-url - (araneida:make-url :scheme "http" + (merge-url + (make-url :scheme "http" :host *paste-site-name* ;;; comment out this next line when running ;;; behind a proxying apache + :port *external-http-port* #| :port *external-http-port* |# ) "/"))

-(defparameter *old-url* (araneida:merge-url - (araneida:make-url :scheme "http" +(defparameter *old-url* (merge-url + (make-url :scheme "http" :host "www.common-lisp.net") "/paste/"))

@@ -56,11 +57,9 @@ (defparameter *owner-email* "lisppaste-requests@common-lisp.net") ; the owner of this lisppaste

(defparameter *ads* - '(ul -(li ((a :href "http://planet.lisp.org") - "Planet Lisp")) - (li ((a :href "http://www.gigamonkeys.com/book/") - "Practical Common Lisp - learn Lisp!")))) ; gratuitous promotions + (<ul> (<li> (<a href="http://planet.lisp.org/"> "Planet Lisp")) + (<li> (<a href="http://www.gigamonkeys.com/book/"> + "Practical Common Lisp - learn Lisp!")))) ; gratuitous promotions

(defvar *paste-maximum-size* 51200) ; in bytes

@@ -111,71 +110,74 @@

(defparameter *serve-source* t)

+;; once every this often, clear out the "used" captchas +(defparameter *used-captcha-release-time* (* 60 60 24)) + ;; You shouldn't need to edit below this line. ;; LINE

(defparameter *display-paste-url* - (araneida:merge-url *paste-external-url* "display/")) + (merge-url *paste-external-url* "display/"))

(defparameter *new-paste-url* - (araneida:merge-url *paste-external-url* "new")) + (merge-url *paste-external-url* "new"))

(defparameter *list-paste-url* - (araneida:merge-url *paste-external-url* "list")) + (merge-url *paste-external-url* "list"))

(defparameter *submit-paste-url* - (araneida:merge-url *paste-external-url* "submit")) + (merge-url *paste-external-url* "submit"))

(defparameter *rss-url* - (araneida:merge-url *paste-external-url* "list.rss")) + (merge-url *paste-external-url* "list.rss"))

(defparameter *rss-full-url* - (araneida:merge-url *paste-external-url* "list-full.rss")) + (merge-url *paste-external-url* "list-full.rss"))

(defparameter *syndication-url* - (araneida:merge-url *paste-external-url* "syndication")) + (merge-url *paste-external-url* "syndication"))

(defparameter *stats-url* - (araneida:merge-url *paste-external-url* "stats")) + (merge-url *paste-external-url* "stats"))

(defparameter *css-url* - (araneida:merge-url *paste-external-url* "lisppaste.css")) + (merge-url *paste-external-url* "lisppaste.css"))

(defparameter *recent-url* - (araneida:merge-url *paste-external-url* "recent")) + (merge-url *paste-external-url* "recent"))

(defparameter *email-redirect-url* - (araneida:merge-url *paste-external-url* "email")) + (merge-url *paste-external-url* "email"))

(defparameter *channel-select-url* - (araneida:merge-url *paste-external-url* "channels")) + (merge-url *paste-external-url* "channels"))

(defparameter *404-urls* - (list (araneida:merge-url *paste-external-url* "favicon.ico") - (araneida:merge-url *paste-external-url* "robots.txt"))) + (list (merge-url *paste-external-url* "favicon.ico") + (merge-url *paste-external-url* "robots.txt")))

-(defparameter *main-system-server-url* (araneida:merge-url *paste-external-url* +(defparameter *main-system-server-url* (merge-url *paste-external-url* "system-server/"))

-(defparameter *show-component-url* (araneida:merge-url *paste-external-url* +(defparameter *show-component-url* (merge-url *paste-external-url* "system-server/show/"))

(defvar *paste-listener* - (let ((fwd-url (araneida:copy-url *paste-external-url*)) - (fwd-old-url (araneida:copy-url *old-url*))) - (setf (araneida:url-port fwd-url) *internal-http-port*) + (let ((fwd-url (copy-url *paste-external-url*)) + (fwd-old-url (copy-url *old-url*))) + (setf (url-port fwd-url) *internal-http-port*) ;; temporary fix! - (setf (araneida:url-host fwd-url) "127.0.0.1") - (setf (araneida:url-port fwd-old-url) *internal-http-port*) - (make-instance #+sbcl 'araneida:serve-event-reverse-proxy-listener - #-sbcl 'araneida:threaded-reverse-proxy-listener + (setf (url-host fwd-url) "127.0.0.1") + (setf (url-port fwd-old-url) *internal-http-port*) + (make-instance #+sbcl 'serve-event-reverse-proxy-listener + #-sbcl 'threaded-reverse-proxy-listener :translations - `((,(araneida:urlstring *paste-external-url*) - ,(araneida:urlstring fwd-url)) - (,(araneida:urlstring *old-url*) - ,(araneida:urlstring fwd-old-url))) - :address #(127 0 0 1) - :port (araneida:url-port fwd-url)))) + `((,(urlstring *paste-external-url*) + ,(urlstring fwd-url)) + (,(urlstring *old-url*) + ,(urlstring fwd-old-url))) + :address #(0 0 0 0) + :port (url-port fwd-url))))

(defvar *default-nickname* "devpaste") (defvar *default-irc-server* "irc.freenode.net") --- /project/lisppaste/cvsroot/lisppaste2/web-server.lisp 2007/01/16 00:36:32 1.87 +++ /project/lisppaste/cvsroot/lisppaste2/web-server.lisp 2007/01/16 00:56:31 1.88 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.87 2007/01/16 00:36:32 lisppaste Exp $ +;;;; $Id: web-server.lisp,v 1.88 2007/01/16 00:56:31 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $

;;;; See the LICENSE file for licensing information. @@ -17,7 +17,7 @@ (colorization-mode :initarg :colorization-mode :initform "" :accessor paste-colorization-mode)))

(defun paste-display-url (paste) - (araneida:urlstring (araneida:merge-url *display-paste-url* (prin1-to-string (paste-number paste))))) + (urlstring (merge-url *display-paste-url* (prin1-to-string (paste-number paste)))))

(defun find-paste (number) (find number *pastes* :key #'paste-number)) @@ -26,7 +26,7 @@ `(progn (funcall 'make-instance 'paste ,@arguments)))

-(defclass lisppaste-basic-handler (araneida:handler) ()) +(defclass lisppaste-basic-handler (handler) ())

(defclass main-handler (lisppaste-basic-handler) ())

@@ -54,7 +54,7 @@

(defclass channel-select-handler (lisppaste-basic-handler) ())

-(defclass 404-handler (araneida:handler) ()) +(defclass 404-handler (handler) ())

(defvar *referer-hash* (make-hash-table :test #'equalp))

@@ -86,39 +86,12 @@ (remhash host *referer-hash*) (incf (gethash "Google" *referer-hash* 0) count)))))

-(defmethod araneida:handle-request-response :around ((handler lisppaste-basic-handler) method request) +(defmethod handle-request-response :around ((handler lisppaste-basic-handler) method request) (with-open-file (*trace-output* (times-file-for-class handler) :direction :output :if-exists :append :if-does-not-exist :create) (unwind-protect - (progn - (let ((referer (car (araneida:request-header request :referer))) - (araneida::*default-url-defaults* (araneida:request-url request))) - (when (stringp referer) - (when (string= referer ": " :end1 2) - ;; Some maniac is sending ": http://paste.lisp.org/" - ;; as a referer. We need to strip that leading colon. - (format t "bogus referer ~S~%" referer) - (setf referer (subseq referer 2))) - (let ((url (ignore-errors (araneida:parse-urlstring referer nil)))) - (when url - (let ((real-host (araneida:url-host url)) - (split-host (split-sequence:split-sequence #. (araneida:url-host url)))) - (if (or - (and (eql (length split-host) 3) - (string-equal (first split-host) "www") - (string-equal (second split-host) "google")) - (and (eql (length split-host) 4) - (string-equal (first split-host) "www") - (string-equal (second split-host) "google") - (or - (string-equal (third split-host) "co") - (string-equal (third split-host) "com")) - (eql (length (fourth split-host)) 2))) - (setf real-host "Google")) - (incf (gethash real-host *referer-hash* 0)) - (setf (gethash real-host *referer-example-hash*) url)))))) - (call-next-method)) + (call-next-method) (force-output *trace-output*))))

(defun make-css () @@ -157,131 +130,149 @@ (colorize:make-background-css "#F4F4F4") colorize:*coloring-css*)))

-(defmethod araneida:handle-request-response ((handler css-handler) method request) - (araneida:request-send-headers request :expires 0 :content-type "text/css") - (araneida:html-stream - (araneida:request-stream request) +(defmethod handle-request-response ((handler css-handler) method request) + (request-send-headers request :expires 0 :content-type "text/css") + (html-stream + (request-stream request) (make-css)))

+(defun rss-link-header () + <link rel="alternate" type="application/rss+xml" title="Lisppaste RSS" href=?(urlstring *rss-url*)/>) + (defun lisppaste-wrap-page (title &rest forms) - `(html - (head (title ,title) - #-nil - ((link :type "text/css" :rel "stylesheet" :href ,(araneida:url-path *css-url*))) - #+nil - ((style :type "text/css") - ,(make-css)) - ,(rss-link-header)) - (body - ((div :class "top-header") - ,title) - (p) - ,@forms - ,@(bottom-links)))) + (<html> + (<head> (<title> title) + <link type="text/css" rel="stylesheet" href=?(url-path *css-url*)/> + (rss-link-header)) + (<body> + (<div class="top-header"> title) + <p/> + forms + (bottom-links)))) + +(defun bottom-links () + (list + <p/> + (<div class="bottom-links"> + (<table width="100%"> + (<tr> + (<td id="main-link"> + (<a href=?(urlstring *paste-external-url*)> "Main page")) + (<td id="other-links"> + (<a href=?(urlstring *new-paste-url*)> "New paste") + " | " + (<a href=?(urlstring *list-paste-url*)> "List all pastes") + " | " + (<a href=?(urlstring *syndication-url*)> "Syndication") + " | " + (<a href="http://common-lisp.net/project/lisppaste/xml-rpc.html"> "XML-RPC") + (when *serve-source* + (list " | " + (<a href=?(urlstring (merge-url *show-component-url* "lisppaste"))> + "Source"))) + " | " + (<a href=?(urlstring *email-redirect-url*)> "Requests Email") + " | " + (<a href="http://www.common-lisp.net/project/lisppaste"> "Project home"))))) + (<i> "Lisppaste pastes can be made by anyone at any time. Imagine a fearsomely comprehensive disclaimer of liability. Now fear, comprehensively.")))

(defun recent-paste-list-div (&key (count 10)) - `((div :class "simple-paste-list") - (table - ,@(loop for i from 1 to count - for j in *pastes* - collect `(tr - ((td :valign center) ((a :href ,(paste-display-url j)) - ,(encode-for-pre (paste-title j)))) - ((td :valign bottom) " by " ,(encode-for-pre (paste-user j))) - ((td :valign bottom) ,(encode-for-pre (paste-channel j))))) - (tr - ((td :colspan 3) - (center - (b - ((a :href ,(araneida:urlstring *list-paste-url*)) - "More recent pastes...")))))))) - -(defmethod araneida:handle-request-response ((handler recent-handler) method request) - (araneida:request-send-headers request :expires 0) - (araneida:html-stream - (araneida:request-stream request) + (<div class="simple-paste-list"> + (<table> + (loop for i from 1 to count + for j in *pastes* + collect (<tr> + (<td valign="center"> (<a href=?(paste-display-url j)> + (paste-title j))) + (<td valign="bottom"> " by " (paste-user j)) + (<td valign="bottom"> (paste-channel j)))) + (<tr> (<td colspan="3"> + (<center> (<b> (<a href=?(urlstring *list-paste-url*)> + "More recent pastes...")))))))) + +(defmethod handle-request-response ((handler recent-handler) method request) + (request-send-headers request :expires 0) + (xml-output-to-stream + (request-stream request) (lisppaste-wrap-page "Recent Pastes" (recent-paste-list-div :count 20))))

-(defmethod araneida:handle-request-response ((handler main-handler) method request) - (araneida:request-send-headers request :expires 0) - (araneida:html-stream - (araneida:request-stream request) +(defmethod handle-request-response ((handler main-handler) method request) + (request-send-headers request :expires 0) + (xml-output-to-stream + (request-stream request) (lisppaste-wrap-page (format nil "~A pastebin" *paste-site-name*) - `((table :width "100%" :border 0 :cellpadding 2) - (tr (td ((div :class "small-header") "Recent pastes")) - ((td :align right) ((div :class "small-header") "Make a new paste"))) - (tr - ((td :valign top :width "40%") - ,(recent-paste-list-div) - (p) - ((div :class "small-header") "About lisppaste") - ((div :class "info-text") - "Lisppaste is a pastebot / pastebin / nopaste service with syntax highlighting, XML-RPC support, annotations, and more." - (p) - "Many times when working via IRC, people want to share a + (<table width="100%" border="0" cellpadding="2"> + (<tr> (<td> (<div class="small-header"> "Recent Pastes")) + (<td align="right"> (<div class="small-header"> "Make a new paste"))) + (<tr> (<td valign="top" width="40%"> + (recent-paste-list-div) + <p/> + (<div class="small-header"> "About lisppaste") + (<div class="info-text"> + "Lisppaste is a pastebot / pastebin / nopaste service with syntax highlighting, XML-RPC support, annotations, and more.") + <p/> + "Many times when working via IRC, people want to share a snippet of code with somebody else. However, just pasting the code into IRC creates a flood of text which is hard to read and scrolls by as discussion progresses." - (p) - "Thus, the pastebot was invented, which has a web form where + <p/> + "Thus, the pastebot was invented, which has a web form where users can paste code, and the URL of the paste is announced on the desired channel. Lisppaste is an advanced pastebot running on the IRC server " - ,(encode-for-pre *irc-network-name*) - " which has many unique features." - ,@(if *no-channel-pastes* - '((p) " It also allows pastes which are not announced on any channel, which + *irc-network-name* + " which has many unique features." + (when *no-channel-pastes* + (list + <p/> + "It also allows pastes which are not announced on any channel, which is useful for sections of code which need to be sent to a mailing list or are discussed in ways other than IRC.")) - (p) - "Lisppaste is graciously hosted by " - (b ((a :href "http://www.common-lisp.net/") "common-lisp.net")) - " - a hosting service for projects written in Common Lisp (like this one)." - (p) - "Questions? Comments? Want lisppaste in your channel? " ((a :href ,(araneida:urlstring *email-redirect-url*)) "Email me") "." - )) - ((td :valign top :align right) - ((form :method post :action ,(araneida:urlstring *submit-paste-url*)) - ,(generate-new-paste-form :width 60)) - (p) - ((div :class "small-header") "Ads absolutely not by Google") - ((div :class "ads-text") - ,*ads*))) - - )))) + <p/> + "Lisppaste is graciously hosted by " + (<b> (<a href="http://www.common-lisp.net/"> "common-lisp.net")) + " - a hosting service for projects written in Common Lisp (like this one)." + <p/> + "Questions? Comments? Want lisppaste in your channel? " + (<a href=?(urlstring *email-redirect-url*)> "Email me") + ".") + (<td valign="top" align="right"> + (<form method="post" action=?(urlstring *submit-paste-url*)> + (generate-new-paste-form :width 60)) + <p/> + (<div class="small-header"> "Ads absolutely not by Google") + (<div class="ads-text"> *ads*)))))))

(defun ban-log (user request) (log-event (format nil "Blocked attempt by ~S, IP ~S, (referred by ~S) to submit a paste.~%Request headers are: ~S.~%Request body is: ~S.~%" user - (car (araneida:request-header request :x-forwarded-for)) - (car (araneida:request-header request :referer)) - (araneida:request-headers request) - (araneida:request-body request)) + (car (request-header request :x-forwarded-for)) + (car (request-header request :referer)) + (request-headers request) + (request-body request)) :log-file *ban-log-file*))

-(defmethod araneida:handle-request-response :around +(defmethod handle-request-response :around ((handler submit-paste-handler) method request) - (let ((forwarded-for (car (araneida:request-header request :x-forwarded-for)))) + (let ((forwarded-for (car (request-header request :x-forwarded-for)))) (if (and forwarded-for (member forwarded-for *banned-ips* :test #'string-equal)) (progn (ban-log forwarded-for request) - (araneida:request-send-headers request :expires 0) - (araneida:html-stream - (araneida:request-stream request) - `(html - (head - (title "No cookie for you!")) - (body (h1 ((font :color "red") "Naughty boy!")))))) + (request-send-headers request :expires 0) + (xml-output-to-stream + (request-stream request) + (<html> (<head> <title> "No cookie for you!") + (<body> (<h1> (<font color="red"> "Naughty boy!")))))) (call-next-method))))

-(defmethod araneida:handle-request-response ((handler new-paste-handler) method request) - (let* ((annotate-string (araneida:body-param "annotate" (araneida:request-body request))) +(defmethod handle-request-response ((handler new-paste-handler) method request) + (let* ((annotate-string (body-param "annotate" (request-body request))) (annotate-number (if annotate-string (parse-integer annotate-string :junk-allowed t))) (annotate (if annotate-number (find annotate-number *pastes* :key #'paste-number))) (default-channel @@ -289,10 +280,10 @@ (find-if #'(lambda (e) (> (length e) 1)) (list (and (eql method :post) - (araneida:body-param "channel" - (araneida:request-body request))) - (substitute ## #/ (araneida:urlstring-unescape (araneida::request-unhandled-part request)) :test #'char=) - (concatenate 'string "#" (araneida:request-cookie request "CHANNEL")) + (body-param "channel" + (request-body request))) + (substitute ## #/ (urlstring-unescape (request-unhandled-part request)) :test #'char=) + (concatenate 'string "#" (request-cookie request "CHANNEL")) (and *no-channel-pastes* "None") ))))) @@ -300,55 +291,28 @@ ((and default-channel (or (and *no-channel-pastes* (string-equal default-channel "None")) (find default-channel *channels* :test #'string-equal))) - (araneida:request-send-headers request :expires 0 :set-cookie + (request-send-headers request :expires 0 :set-cookie (format nil "CHANNEL=~A; path=/" (or (and *no-channel-pastes* (string-equal default-channel "none") "None") (subseq default-channel 1)))) (new-paste-form request :annotate annotate :default-channel default-channel)) - (t (araneida:request-send-headers request :expires 0) - (araneida:html-stream - (araneida:request-stream request) + (t (request-send-headers request :expires 0) + (xml-output-to-stream + (request-stream request) (lisppaste-wrap-page "Select a channel" - `((form :method post :action ,(araneida:urlstring *new-paste-url*)) - ((div :class "controls") - ((input :type "hidden" :name "annotate" :value ,annotate-string)) - "Please select a channel to lisppaste to: " - ((select :name "channel") - ((option :value "")) - ,@(mapcar #'(lambda (e) - `((option :value ,e) - ,(encode-for-pre e))) *channels*)) - ((input :type submit :value "Submit")))))))))) - -(defun bottom-links () - `((p) - ((div :class "bottom-links") - ((table :width "100%") - (tr - ((td :id "main-link") - ((a :href ,(araneida:urlstring *paste-external-url*)) - "Main page") - ) - ((td :id "other-links") - ((a :href ,(araneida:urlstring *new-paste-url*)) "New paste") - " | " - ((a :href ,(araneida:urlstring *list-paste-url*)) "List all pastes") - " | " - ((a :href ,(araneida:urlstring *syndication-url*)) "Syndication") - " | " - ((a :href "http://common-lisp.net/project/lisppaste/xml-rpc.html") "XML-RPC") - ,@(if *serve-source* - `(" | " - ((a :href ,(araneida:urlstring (araneida:merge-url - *show-component-url* "lisppaste"))) "Source"))) - " | " - ((a :href ,(araneida:urlstring *email-redirect-url*)) "Requests Email") - " | " - ((a :href "http://common-lisp.net/project/lisppaste") "Project home"))))) - (i "Lisppaste pastes can be made by anyone at any time. Imagine a fearsomely comprehensive disclaimer of liability. Now fear, comprehensively."))) + (<form method="post" action=?(urlstring *new-paste-url*)> + (<div class="controls"> + <input type="hidden" name="annotate" value=?annotate-string /> + "Please select a channel to lisppaste to: " + (<select name="channel"> + (<option value=""> "") + (mapcar (lambda (e) + (<option value=?e> e)) + *channels*)) + <input type="submit" value="Submit"/>))))))))

[1497 lines skipped]