[Lisppaste-cvs] CVS lisppaste2
bmastenbrook
bmastenbrook at common-lisp.net
Tue Jan 16 00:56:31 UTC 2007
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 at 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 , at 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)
- , at 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]
More information about the Lisppaste-cvs
mailing list