- lisppaste-cvs@common-lisp.net - mailman3.common-lisp.net

[Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp
by Brian Mastenbrook 24 Jun '04

24 Jun '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/home/bmastenbrook/lisppaste2 Modified Files: web-server.lisp Log Message: Bit-o-refactoring, "main page" Date: Thu Jun 24 08:02:58 2004 Author: bmastenbrook Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.57 lisppaste2/web-server.lisp:1.58 --- lisppaste2/web-server.lisp:1.57 Thu Jun 17 05:46:59 2004 +++ lisppaste2/web-server.lisp Thu Jun 24 08:02:58 2004 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.57 2004/06/17 12:46:59 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.58 2004/06/24 15:02:58 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -21,6 +21,8 @@ `(progn (funcall 'make-instance 'paste ,@arguments))) +(defclass main-handler (araneida:handler) ()) + (defclass new-paste-handler (araneida:handler) ()) (defclass list-paste-handler (araneida:handler) ()) @@ -37,6 +39,43 @@ (defclass stats-handler (araneida:handler) ()) +(defun lisppaste-wrap-page (title &rest forms) + (let ((colorize:*css-background-class* "paste")) + `(html + (head (title ,title) + ((style :type "text/css") + ,(format nil "~A~%~A~%" + (colorize:make-background-css "#F4F4F4") + colorize:*coloring-css*)) + ,(rss-link-header)) + (body + (h2 ,title) + ,@forms + ,@(bottom-links))))) + +(defun paste-display-url (paste) + (araneida:urlstring (araneida:merge-url *display-paste-url* (prin1-to-string (paste-number paste))))) + +(defmethod araneida:handle-request-response ((handler main-handler) method request) + (araneida:request-send-headers request :expires 0) + (araneida:html-stream + (araneida:request-stream request) + (lisppaste-wrap-page + "Lisppaste" + `((table :width "100%" :border 0 :cellpadding 2) + (tr (td (b "Recent pastes")) + (td (center (b "Make a new paste")))) + (tr + ((td :valign top) + ,@(loop for i from 1 to 10 + for j in *pastes* + appending `( + ((a :href ,(paste-display-url j)) + ,(encode-for-pre (paste-title j))) + " by " ,(encode-for-pre (paste-user j)) (br)))) + ((td :valign top) + ,(generate-new-paste-form :width 40))))))) + (defmethod araneida:handle-request-response :around ((handler submit-paste-handler) method request) (let ((forwarded-for (car (araneida:request-header request :x-forwarded-for)))) @@ -95,22 +134,17 @@ (t (araneida:request-send-headers request :expires 0) (araneida:html-stream (araneida:request-stream request) - `(html - (head - (title "Select a channel") - ,(rss-link-header)) - (body - (h2 "Select a channel") - ((form :method post :action ,(araneida:urlstring *new-paste-url*)) - ((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"))) - ,@(bottom-links)))))))) + (lisppaste-wrap-page + "Select a channel" + `((form :method post :action ,(araneida:urlstring *new-paste-url*)) + ((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 () `((hr) @@ -180,74 +214,70 @@ (format (araneida:request-stream request) "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">") (araneida:html-stream (araneida:request-stream request) - `(html - (head (title "Syndication options") - ,(rss-link-header)) - (body - (h2 "Syndication options") - "Lisppaste can be syndicated in a variety of RSS formats for use + (lisppaste-wrap-page + "Syndication options" + "Lisppaste can be syndicated in a variety of RSS formats for use with your favorite RSS reader." - (p) - (table - (tr - ((th :align left) "All channels") - ((td :width 30)) - (td ((a :href ,(araneida:urlstring *rss-url*)) "Basic")) - ((td :width 10)) - (td ((a :href ,(araneida:urlstring *rss-full-url*)) "Full"))) - ,@(if *no-channel-pastes* - `((tr - ((th :align left) "None") - ((td :width 30)) - (td ((a :href ,(concatenate 'string - (araneida:urlstring *rss-url*) - "?none")) "Basic")) - ((td :width 10)) - (td ((a :href ,(concatenate 'string - (araneida:urlstring *rss-full-url*) - "?none")) "Full"))))) - ,@(mapcar #'(lambda (channel) - `(tr - ((th :align left) ,channel) - ((td :width 30)) - (td ((a :href ,(concatenate 'string - (araneida:urlstring *rss-url*) - (substitute #\? #\# channel))) "Basic")) - ((td :width 10)) - (td ((a :href ,(concatenate 'string - (araneida:urlstring *rss-full-url*) - (substitute #\? #\# channel))) "Full")))) - *channels*)) - ,@(bottom-links))))) + `(p) + `(table + (tr + ((th :align left) "All channels") + ((td :width 30)) + (td ((a :href ,(araneida:urlstring *rss-url*)) "Basic")) + ((td :width 10)) + (td ((a :href ,(araneida:urlstring *rss-full-url*)) "Full"))) + ,@(if *no-channel-pastes* + `((tr + ((th :align left) "None") + ((td :width 30)) + (td ((a :href ,(concatenate 'string + (araneida:urlstring *rss-url*) + "?none")) "Basic")) + ((td :width 10)) + (td ((a :href ,(concatenate 'string + (araneida:urlstring *rss-full-url*) + "?none")) "Full"))))) + ,@(mapcar #'(lambda (channel) + `(tr + ((th :align left) ,channel) + ((td :width 30)) + (td ((a :href ,(concatenate 'string + (araneida:urlstring *rss-url*) + (substitute #\? #\# channel))) "Basic")) + ((td :width 10)) + (td ((a :href ,(concatenate 'string + (araneida:urlstring *rss-full-url*) + (substitute #\? #\# channel))) "Full")))) + *channels*))))) (defmethod araneida:handle-request-response ((handler stats-handler) method request) (araneida:request-send-headers request :expires 0) (format (araneida:request-stream request) "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">") (araneida:html-stream (araneida:request-stream request) - `(html - (head (title "Statistics") - ,(rss-link-header)) - (body - (h2 "Statistics") - (b "Uptime: ") ,(time-delta *boot-time* :ago-p nil :level 3) + (lisppaste-wrap-page + "Statistics" + `(div + (b "Uptime: ") + ,(time-delta *boot-time* :ago-p nil :level 3) (p) - (b "Most popular channels:") (br) + (b "Most popular channels:") + (br) ((table :border 0) ,@(mapcar #'(lambda (pair) - `(tr - ((td :valign top) - ,(car pair)) + `(tr + ((td :valign top) + ,(car pair)) ((td) " ") ((td :valign top) - ,(cdr pair)))) + ,(cdr pair)))) (sort - (loop for i in *channels* - collect (cons i (count i *pastes* - :key #'paste-channel - :test #'string=))) - #'> :key #'cdr))) + (loop for i in *channels* + collect (cons i (count i *pastes* + :key #'paste-channel + :test #'string=))) + #'> :key #'cdr))) (p) (b "Average rates of pasting:") (br) ((table :border 0) @@ -300,7 +330,7 @@ (- (paste-universal-time (first p)) (paste-universal-time (car (last p))))))) #'> :key #'(lambda (e) (length (second e))))))) - ,@(bottom-links))))) + )))) (defmethod araneida:handle-request-response ((handler list-paste-handler) method request) (araneida:request-send-headers request :expires 0) @@ -360,75 +390,73 @@ "> Older")))))) (araneida:html-stream (araneida:request-stream request) - `(html - (head (title "All pastes") - ,(rss-link-header)) - (body - (center (h2 ,(if discriminate-channel - (format nil "All pastes in channel ~A" discriminate-channel) - "All pastes in system"))) + (lisppaste-wrap-page + (if discriminate-channel + (format nil "All pastes in channel ~A" discriminate-channel) + "All pastes in system") + `(div ,@(if discriminate-channel (if (not (member discriminate-channel *channels* :test #'string-equal)) `(((h2) ((font :color "red") ,(format nil "Warning: no channel named ~A found!" - discriminate-channel)))))) - (center - ((form :method post :action ,(araneida:urlstring *list-paste-url*)) - (table - (tr ((td :align left) "View only: ") - ((td :valign top :align center) - ((select :name "channel") - ((option :value "allchannels") "All channels") - ,@(mapcar #'(lambda (e) - `((option :value ,e ,@(if (and discriminate-channel - (string-equal e discriminate-channel)) - '(:selected))) - ,(encode-for-pre e))) *channels*)) - ((input :type submit :value "Submit"))) - ) - (tr ((td :align left) - ,(if discriminate-channel "Syndicate this channel: " "Syndicate all channels: ")) - ((td :align center) - ((a :href ,(concatenate 'string - (araneida:urlstring *rss-url*) - (if discriminate-channel - (or (and *no-channel-pastes* - (string-equal discriminate-channel "none") - "?none") - (substitute #\? #\# discriminate-channel)) ""))) "Basic") - " | " - ((a :href ,(concatenate 'string - (araneida:urlstring *rss-full-url*) - (if discriminate-channel - (or (and *no-channel-pastes* - (string-equal discriminate-channel "none") - "?none") - (substitute #\? #\# discriminate-channel)) - ""))) "Full")) - ) - (tr ((td :align left) - "Page: ") - ((td :align center) - ,@page-links)) - ))) - (p) - ((table :width "100%" :cellpadding 2) - (tr (td) (td "By") (td "Where") (td "When") (td "Titled") (td "Ann.")) - ,@(mapcar #'(lambda (paste) - `(tr ((td :nowrap "nowrap") ((a :href ,(araneida:urlstring (araneida:merge-url *display-paste-url* (prin1-to-string (paste-number paste))))) - ,(concatenate 'string "#" (prin1-to-string (paste-number paste))))) - ((td :nowrap "nowrap") ,(encode-for-pre (max-length (paste-user paste) 12))) - ((td :nowrap "nowrap") ,(encode-for-pre (paste-channel paste))) - ((td :nowrap "nowrap") ,(time-delta (paste-universal-time paste) :level 1 :ago-p nil)) - ((td :width "100%" :bgcolor "#F6F6F6" :nowrap "nowrap") ,(encode-for-pre (max-length (paste-title paste) 50))) - ((td :nowrap "nowrap") ,(length (paste-annotations paste))))) - (loop for i from 0 - to (- (* (1+ page) *pastes-per-page*) 1) - for j in discriminated-pastes - if (>= i (* page *pastes-per-page*)) - collect j))) - (center - "Page: " ,@page-links) - ,@(bottom-links)))))))) + discriminate-channel))))))) + `(center + ((form :method post :action ,(araneida:urlstring *list-paste-url*)) + (table + (tr ((td :align left) "View only: ") + ((td :valign top :align center) + ((select :name "channel") + ((option :value "allchannels") "All channels") + ,@(mapcar #'(lambda (e) + `((option :value ,e ,@(if (and discriminate-channel + (string-equal e discriminate-channel)) + '(:selected))) + ,(encode-for-pre e))) *channels*)) + ((input :type submit :value "Submit"))) + ) + (tr ((td :align left) + ,(if discriminate-channel "Syndicate this channel: " "Syndicate all channels: ")) + ((td :align center) + ((a :href ,(concatenate 'string + (araneida:urlstring *rss-url*) + (if discriminate-channel + (or (and *no-channel-pastes* + (string-equal discriminate-channel "none") + "?none") + (substitute #\? #\# discriminate-channel)) ""))) "Basic") + " | " + ((a :href ,(concatenate 'string + (araneida:urlstring *rss-full-url*) + (if discriminate-channel + (or (and *no-channel-pastes* + (string-equal discriminate-channel "none") + "?none") + (substitute #\? #\# discriminate-channel)) + ""))) "Full")) + ) + (tr ((td :align left) + "Page: ") + ((td :align center) + ,@page-links)) + ))) + `(p) + `((table :width "100%" :cellpadding 2) + (tr (td) (td "By") (td "Where") (td "When") (td "Titled") (td "Ann.")) + ,@(mapcar #'(lambda (paste) + `(tr ((td :nowrap "nowrap") ((a :href ,(paste-display-url paste)) + ,(concatenate 'string "#" (prin1-to-string (paste-number paste))))) + ((td :nowrap "nowrap") ,(encode-for-pre (max-length (paste-user paste) 12))) + ((td :nowrap "nowrap") ,(encode-for-pre (paste-channel paste))) + ((td :nowrap "nowrap") ,(time-delta (paste-universal-time paste) :level 1 :ago-p nil)) + ((td :width "100%" :bgcolor "#F6F6F6" :nowrap "nowrap") ,(encode-for-pre (max-length (paste-title paste) 50))) + ((td :nowrap "nowrap") ,(length (paste-annotations paste))))) + (loop for i from 0 + to (- (* (1+ page) *pastes-per-page*) 1) + for j in discriminated-pastes + if (>= i (* page *pastes-per-page*)) + collect j))) + `(center + "Page: " ,@page-links) + )))))) (defun handle-rss-request (request &key full) (araneida:request-send-headers request :expires 0 :content-type "application/rss+xml") @@ -486,32 +514,11 @@ (defmethod araneida:handle-request-response ((handler rss-full-handler) method request) (handle-rss-request request :full t)) -(defun new-paste-form (request &key (message "") (annotate nil) (default-channel "") (default-user "") (default-title "") (default-contents "")) - (format (araneida:request-stream request) "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">") - (araneida:html-stream - (araneida:request-stream request) - `(html - (head (title ,(if annotate "Annotate" "Paste")) - ,(rss-link-header)) - (body - (h2 ,(if annotate "Enter your annotation" "Enter your paste")) - ((font :color red) (h2 ,message)) - ((form :method post :action ,(araneida:urlstring *submit-paste-url*)) - (p "Enter a username, title, and paste contents into the fields below." - ,@(unless (and annotate - *no-channel-pastes* - (string-equal (paste-channel annotate) "None")) - `("The paste will be announced on the selected channel @ " ,(irc:server-name *connection*) "."))) - ,@(if annotate - `((p "This paste will be used to annotate " - ((a :href ,(araneida:urlstring (araneida:merge-url *display-paste-url* (prin1-to-string (paste-number annotate))))) ,(concatenate 'string (paste-title annotate) "."))) - ((input :type hidden :name "annotate" :value ,(prin1-to-string (paste-number annotate)))) - ((input :type hidden :name "channel" :value ,(paste-channel annotate))))) - (hr) - (table +(defun generate-new-paste-form (&key annotate (default-channel "None") (default-user "") (default-title "") (default-contents "") (width 80)) + `(table ,@(if (not annotate) `((tr - (th "Select a channel:") + ((th :align left) "Select a channel:") (td ((select :name "channel") ((option :value "")) ,@(mapcar #'(lambda (e) @@ -519,16 +526,16 @@ '(:selected "SELECTED"))) ,(encode-for-pre e))) *channels*)))))) (tr - (th "Enter your username:") + ((th :align left) "Enter your username:") (td ((input :type text :name "username" :value ,(encode-for-pre default-user))))) (tr - (th "Enter a title:") + ((th :align left) "Enter a title:") (td ((input :type text :name "title" :value ,(encode-for-pre default-title))))) ,@(if (not annotate) `((tr - (th (i "(Optional) Colorize as: ")) + ((th :align left) (i "(Optional) Colorize as: ")) (td ((select :name "colorize") ((option :value "" :selected "SELECTED") "Default for this channel") ((option :value "None") "None") @@ -537,13 +544,33 @@ ,(cdr pair))) (colorize:coloring-types))))))) (tr - ((th :valign top) "Enter your paste:") - (td ((textarea :rows 24 :cols 80 :name "text") + ((th :align left :valign top) "Enter your paste:") + (td ((textarea :rows 24 :cols ,width :name "text") ,(encode-for-pre default-contents)))) (tr - ((th) "Submit your paste:") + ((th :align left) "Submit your paste:") ((td) ((input :type submit :value "Submit paste")) " " ((input :type reset :value "Clear paste")))))) - ,@(bottom-links))))) + +(defun new-paste-form (request &key (message "") (annotate nil) (default-channel "") (default-user "") (default-title "") (default-contents "")) + (format (araneida:request-stream request) "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">") + (araneida:html-stream + (araneida:request-stream request) + (lisppaste-wrap-page + (if annotate "Enter your annotation" "Enter your paste") + `((font :color red) (h2 ,message)) + `((form :method post :action ,(araneida:urlstring *submit-paste-url*)) + (p "Enter a username, title, and paste contents into the fields below." + ,@(unless (and annotate + *no-channel-pastes* + (string-equal (paste-channel annotate) "None")) + `("The paste will be announced on the selected channel @ " ,(irc:server-name *connection*) "."))) + ,@(if annotate + `((p "This paste will be used to annotate " + ((a :href ,(araneida:urlstring (araneida:merge-url *display-paste-url* (prin1-to-string (paste-number annotate))))) ,(concatenate 'string (paste-title annotate) "."))) + ((input :type hidden :name "annotate" :value ,(prin1-to-string (paste-number annotate)))) + ((input :type hidden :name "channel" :value ,(paste-channel annotate))))) + (hr) + ,(generate-new-paste-form :annotate annotate :default-channel default-channel :default-user default-user :default-title default-title :default-contents default-contents))))) (defmethod araneida:handle-request-response ((handler submit-paste-handler) method request) (let* ((username (araneida:body-param "username" (araneida:request-body request))) @@ -608,20 +635,17 @@ (format (araneida:request-stream request) "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">") (araneida:html-stream (araneida:request-stream request) - `(html - (head (title "Paste number " ,paste-number) - ,(rss-link-header)) - (body - (h2 "Pasted!") - (p ,(if annotate "Your annotation should be available at " "Your paste should be available at ") ((a :href ,url) ,url) - ,@(unless (and *no-channel-pastes* - (string-equal channel "none")) - `(", and was also sent to " ,channel " @ " ,(irc:server-name *connection*))) ".") - (h3 "Don't paste more junk; annotate!") - ((form :method post :action ,(araneida:urlstring *new-paste-url*)) - ((input :type hidden :name "annotate" :value ,(prin1-to-string paste-number))) - (center ((input :type submit :value "Annotate this paste")))) - ,@(bottom-links)))))))))) + (lisppaste-wrap-page + (format nil "Paste number ~A pasted!" paste-number) + `(p ,(if annotate "Your annotation should be available at " "Your paste should be available at ") ((a :href ,url) ,url) + ,@(unless (and *no-channel-pastes* + (string-equal channel "none")) + `(", and was also sent to " ,channel " @ " ,(irc:server-name *connection*))) ".") + `(h3 "Don't paste more junk; annotate!") + `((form :method post :action ,(araneida:urlstring *new-paste-url*)) + ((input :type hidden :name "annotate" :value ,(prin1-to-string paste-number))) + (center ((input :type submit :value "Annotate this paste")))) + )))))))) (defun ends-with (str end) (let ((l1 (length str)) @@ -630,17 +654,21 @@ (string= (subseq str (- l1 l2) l1) end)))) (defun format-paste (paste this-url paste-number &optional annotation colorize-as line-numbers) - (let ((n 0)) + (let ((n 0) (next-first-char-nbsp nil)) (labels ((line-number () (format nil "~A" (encode-for-tt (format nil "~4D: " (incf n)) :first-char-nbsp t))) (encode (str) - (encode-for-tt str - :with-line-numbers - (if line-numbers - #'line-number)))) + (multiple-value-bind (encoded last) + (encode-for-tt str + :with-line-numbers + (if line-numbers + #'line-number) + :first-char-nbsp next-first-char-nbsp) + (prog1 encoded + (setf next-first-char-nbsp last))))) `((table :width "100%" :cellpadding 2) (tr ((td :align "left" :width "0%" :nowrap "nowrap") ,(if annotation @@ -701,9 +729,10 @@ (colorize:*css-background-class* "paste")) (and paste (log-event - (format nil "Serving paste number ~S to ~S.~%" + (format nil "Serving paste number ~S to ~S (referred by ~S).~%" (paste-number paste) - (car (araneida:request-header request :x-forwarded-for))))) + (car (araneida:request-header request :x-forwarded-for)) + (car (araneida:request-header request :referer))))) (if paste (if raw (let ((p (position #\, (araneida::request-unhandled-part request) :test #'char=))) @@ -725,16 +754,9 @@ (format (araneida:request-stream request) "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">") (araneida:html-stream (araneida:request-stream request) - `(html - (head - (title "Paste number " ,paste-number) - ((style :type "text/css") - ,(format nil "~A~%~A~%" - (colorize:make-background-css "#F4F4F4") - colorize:*coloring-css*)) - ,(rss-link-header)) - (body - + (lisppaste-wrap-page + (format nil "Paste number ~A" paste-number) + `(div ,@(if (paste-annotations paste) `("Index of paste annotations: " ,@(loop for ann in (reverse (paste-annotations paste)) @@ -749,17 +771,17 @@ ,(format-paste paste (araneida:urlstring (araneida:request-url request)) paste-number nil colorize-as linenumbers) ,@(if (paste-annotations paste) - `((p) - "Annotations for this paste: " - ,@(reduce #'append - (mapcar #'(lambda (a) - `((hr) - ,(format-paste a - (format nil "~A,~A" - (araneida:urlstring (araneida:request-url request)) - (paste-number a)) (paste-number a) t colorize-as linenumbers))) - (reverse (paste-annotations paste))))) - `((p) "This paste has no annotations.")) + `((p) + "Annotations for this paste: " + ,@(reduce #'append + (mapcar #'(lambda (a) + `((hr) + ,(format-paste a + (format nil "~A,~A" + (araneida:urlstring (araneida:request-url request)) + (paste-number a)) (paste-number a) t colorize-as linenumbers))) + (reverse (paste-annotations paste))))) + `((p) "This paste has no annotations.")) (p) ((form :method post :action ,(araneida:urlstring (araneida:merge-url @@ -785,19 +807,15 @@ ((form :method post :action ,(araneida:urlstring *new-paste-url*)) ((input :type hidden :name "annotate" :value ,(prin1-to-string (paste-number paste)))) (center ((input :type submit :value "Annotate this paste")))) - ,@(bottom-links)))))) - (progn - (araneida:request-send-headers request :expires 0) - (format (araneida:request-stream request) "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">") - (araneida:html-stream - (araneida:request-stream request) - `(html - (head - (title "Invalid paste number" ,paste-number) - ,(rss-link-header)) - (body - (h3 "No paste numbered " ,paste-number " could be found.") - ,@(bottom-links)))))))) + ))))) + (progn + (araneida:request-send-headers request :expires 0) + (format (araneida:request-stream request) "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">") + (araneida:html-stream + (araneida:request-stream request) + (lisppaste-wrap-page + (format nil "Invalid paste number ~A!" paste-number) + )))))) (araneida:install-handler (araneida:http-listener-handler *paste-listener*) @@ -838,3 +856,8 @@ (araneida:http-listener-handler *paste-listener*) (make-instance 'stats-handler) (araneida:urlstring *stats-url*) nil) + +(araneida:install-handler + (araneida:http-listener-handler *paste-listener*) + (make-instance 'main-handler) + (araneida:urlstring *paste-external-url*) t)

1 0

[Lisppaste-cvs] CVS update: public_html/index.html
by Brian Mastenbrook 17 Jun '04

17 Jun '04

Update of /project/lisppaste/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv8105 Modified Files: index.html Log Message: release 2.3 Date: Thu Jun 17 07:15:35 2004 Author: bmastenbrook Index: public_html/index.html diff -u public_html/index.html:1.8 public_html/index.html:1.9 --- public_html/index.html:1.8 Mon Mar 8 22:48:14 2004 +++ public_html/index.html Thu Jun 17 07:15:35 2004 @@ -28,8 +28,13 @@ as that sounds. Lisppaste 2 can be downloaded from here: <a - href="ftp://common-lisp.net/pub/project/lisppaste/lisppaste2-latest.tar.gz">lisppaste2-latest.tar.gz</a>. The - latest version is 2.2, released March 9, 2004. + href="ftp://common-lisp.net/pub/project/lisppaste/lisppaste2.3.tar.gz">lisppaste2.3.tar.gz</a>. The + latest version is 2.3, released June 17, 2004. + + New in lisppaste 2.3 is a whole slew of improvements, including + pagination for the paste list page, colorization for many + languages, portability to other lisps (when run with CVS araneida) + and support for pastes without a channel announcement. New in lisppaste 2.2 is greater RSS flexibility, channel-specific URLs for new pastes and paste listing, much @@ -39,10 +44,11 @@ context at <a href="http://meme.b9.com/">meme.b9.com</a>. The code in CVS (<a href="/faq.shtml">checkout - instructions</a>) is also considered fairly usable. You'll also - need <a href="http://araneida.telent.net">araneida</a> and <a - href="http://www.sbcl.org"> SBCL</a>. If you do install it, read - the <a + instructions</a>) mirrors what is currently running on freenode + and should be fairly usable. You'll also need <a + href="http://www.cliki.net/araneida">araneida</a> and + href="http://www.cliki.net/cl-irc">CL-IRC</a>. If you do install + it, read the <a href="/cgi-bin/viewcvs.cgi/lisppaste2/README.lisp?rev=HEAD&cvsroot=lisppaste&content-type=text/vnd.viewcvs-markup">README.lisp</a> file which contains all the information you need to run a lisppaste on your own. @@ -64,7 +70,7 @@ <address><a href="http://www.cs.indiana.edu/~bmastenb/">Brian Mastenbrook</a></address>   -Last modified: Tue Mar 9 01:48:05 2004 EST +Last modified: Thu Jun 17 09:15:17 2004 CDT  </body> </html>

1 0

[Lisppaste-cvs] CVS update: lisppaste2/variable.lisp
by Brian Mastenbrook 17 Jun '04

17 Jun '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv16551 Modified Files: variable.lisp Log Message: MORE DOCUMENTATION Date: Thu Jun 17 06:42:32 2004 Author: bmastenbrook Index: lisppaste2/variable.lisp diff -u lisppaste2/variable.lisp:1.22 lisppaste2/variable.lisp:1.23 --- lisppaste2/variable.lisp:1.22 Thu Jun 17 06:26:12 2004 +++ lisppaste2/variable.lisp Thu Jun 17 06:42:32 2004 @@ -1,8 +1,26 @@ -;;;; $Id: variable.lisp,v 1.22 2004/06/17 13:26:12 bmastenbrook Exp $ +;;;; $Id: variable.lisp,v 1.23 2004/06/17 13:42:32 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/variable.lisp,v $ ;;;; See the LICENSE file for licensing information. +;;; This is the main file to edit to customize lisppaste to your +;;; site. In particular, the main variables are at the top, which +;;; define how lisppaste knows which site it is running on, and how to +;;; generate links to itself. There are two ways to run lisppaste: +;;; naked, and behind a proxying apache. When running naked, you can +;;; leave much of this file as-is, and change *internal-http-port* and +;;; *external-http-port* to the port you want it to run on, and +;;; *paste-site-name* to the hostname it is running on. + +;;; When running behind a proxy, set *internal-http-port* to the port +;;; it will listen for requests from Apache, but set +;;; *external-http-port* to 80. Set *paste-site-name* to a hostname +;;; that lisppaste is running on, and comment out the line in +;;; *paste-external-url* as indicated. + +;;; There are a few other options below, but the defaults should work +;;; well. + (in-package :lisppaste) (defparameter *internal-http-port* 8000 @@ -23,25 +41,32 @@ (araneida:merge-url (araneida:make-url :scheme "http" :host *paste-site-name* + ;;; comment out this next line when running + ;;; behind a proxying apache :port *external-http-port* ) "/paste/")) -(defvar *meme-links* nil) ; whether to link to meme IRC logs +(defvar *meme-links* nil) ; whether to link to meme IRC logs, probably + ; only useful for freenode's lisppaste -(defvar *paste-maximum-size* 51200) +(defvar *paste-maximum-size* 51200) ; in bytes -(defvar *pastes-per-page* 50) +(defvar *pastes-per-page* 50) ; for the paste list (defparameter *banned-ips* - '("69.11.238.252" "168.143.113.138")) + '("69.11.238.252" "168.143.113.138")) ; two examples of + ; troublemakers affecting + ; freenode's lisppaste (defparameter *ban-log-file* - "ban-log") + "ban-log") ; where logs of attempts by banned users to paste go (defparameter *event-log-file* - "event-log") + "event-log") ; where normal events are logged -(defparameter *no-channel-pastes* nil) +(defparameter *no-channel-pastes* nil) ; whether to allow pastes that + ; don't get announced on a + ; channel ;; You shouldn't need to edit below this line. ;; LINE

1 0

[Lisppaste-cvs] CVS update: lisppaste2/variable.lisp
by Brian Mastenbrook 17 Jun '04

17 Jun '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv23892 Modified Files: variable.lisp Log Message: A somewhat sane starting configuration Date: Thu Jun 17 06:26:12 2004 Author: bmastenbrook Index: lisppaste2/variable.lisp diff -u lisppaste2/variable.lisp:1.21 lisppaste2/variable.lisp:1.22 --- lisppaste2/variable.lisp:1.21 Wed Jun 9 12:48:46 2004 +++ lisppaste2/variable.lisp Thu Jun 17 06:26:12 2004 @@ -1,13 +1,13 @@ -;;;; $Id: variable.lisp,v 1.21 2004/06/09 19:48:46 bmastenbrook Exp $ +;;;; $Id: variable.lisp,v 1.22 2004/06/17 13:26:12 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/variable.lisp,v $ ;;;; See the LICENSE file for licensing information. (in-package :lisppaste) -(defparameter *internal-http-port* 8081 +(defparameter *internal-http-port* 8000 "Port lisppaste's araneida will listen on for requests from Apache.") -(defparameter *external-http-port* 80 +(defparameter *external-http-port* 8000 "Port lisppaste's araneida will listen on for requests from remote clients.") (defparameter *paste-site-name* "localhost" @@ -23,7 +23,7 @@ (araneida:merge-url (araneida:make-url :scheme "http" :host *paste-site-name* - #|:port *external-http-port*|# + :port *external-http-port* ) "/paste/")) (defvar *meme-links* nil) ; whether to link to meme IRC logs

1 0

[Lisppaste-cvs] CVS update: lisppaste2/lisppaste.asd
by Brian Mastenbrook 17 Jun '04

17 Jun '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv1487 Modified Files: lisppaste.asd Log Message: Oops. forgot the colorize-package dependency in web-server Date: Thu Jun 17 06:10:04 2004 Author: bmastenbrook Index: lisppaste2/lisppaste.asd diff -u lisppaste2/lisppaste.asd:1.12 lisppaste2/lisppaste.asd:1.13 --- lisppaste2/lisppaste.asd:1.12 Fri Jun 4 17:14:31 2004 +++ lisppaste2/lisppaste.asd Thu Jun 17 06:10:04 2004 @@ -1,5 +1,5 @@ ;;;; Silly emacs, this is -*- Lisp -*- -;;;; $Id: lisppaste.asd,v 1.12 2004/06/05 00:14:31 bmastenbrook Exp $ +;;;; $Id: lisppaste.asd,v 1.13 2004/06/17 13:10:04 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/lisppaste.asd,v $ ;;;; See the LICENSE file for licensing information. @@ -39,6 +39,6 @@ (:file "coloring-types" :depends-on ("colorize" "clhs-lookup")) (:file "web-server" - :depends-on ("encode-for-pre" "lisppaste")) + :depends-on ("encode-for-pre" "lisppaste" "colorize-package")) (:file "persistent-pastes" :depends-on ("web-server"))))

1 0

[Lisppaste-cvs] CVS update: lisppaste2/clhs-lookup.lisp
by Brian Mastenbrook 17 Jun '04

17 Jun '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv13571 Modified Files: clhs-lookup.lisp Log Message: Slightly less aggressive warning behavior Date: Thu Jun 17 05:59:17 2004 Author: bmastenbrook Index: lisppaste2/clhs-lookup.lisp diff -u lisppaste2/clhs-lookup.lisp:1.5 lisppaste2/clhs-lookup.lisp:1.6 --- lisppaste2/clhs-lookup.lisp:1.5 Thu Jun 17 05:53:17 2004 +++ lisppaste2/clhs-lookup.lisp Thu Jun 17 05:59:17 2004 @@ -30,6 +30,8 @@ (defun valid-target (&rest numbers) (probe-file (format nil "Body/~2,'0d_~(~{~36r~}~).htm" (car numbers) (mapcar #'(lambda (x) (+ x 9)) (cdr numbers))))) +(defvar *last-warn-time* 0) + (defun populate-table () (unless *populated-p* ;; Hyperspec @@ -37,7 +39,9 @@ ;; populate the table with the symbols from the Map file ;; this bit is easy and portable. (unless s - (format *trace-output* "Warning: could not find hyperspec map file. Adjust the path at the top of clhs-lookup.lisp to get links to the HyperSpec.~%") + (when (> (- (get-universal-time) *last-warn-time*) 10) + (format *trace-output* "Warning: could not find hyperspec map file. Adjust the path at the top of clhs-lookup.lisp to get links to the HyperSpec.~%") + (setf *last-warn-time* (get-universal-time))) (return-from populate-table nil)) (do ((symbol-name (read-line s nil s) (read-line s nil s)) (url (read-line s nil s) (read-line s nil s)))

1 0

[Lisppaste-cvs] CVS update: lisppaste2/clhs-lookup.lisp
by Brian Mastenbrook 17 Jun '04

17 Jun '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv6048 Modified Files: clhs-lookup.lisp Log Message: Warn when the hyperspec map isn't found Date: Thu Jun 17 05:53:17 2004 Author: bmastenbrook Index: lisppaste2/clhs-lookup.lisp diff -u lisppaste2/clhs-lookup.lisp:1.4 lisppaste2/clhs-lookup.lisp:1.5 --- lisppaste2/clhs-lookup.lisp:1.4 Wed Jun 9 12:47:13 2004 +++ lisppaste2/clhs-lookup.lisp Thu Jun 17 05:53:17 2004 @@ -33,9 +33,12 @@ (defun populate-table () (unless *populated-p* ;; Hyperspec - (with-open-file (s *hyperspec-map-file*) + (with-open-file (s *hyperspec-map-file* :if-does-not-exist nil) ;; populate the table with the symbols from the Map file ;; this bit is easy and portable. + (unless s + (format *trace-output* "Warning: could not find hyperspec map file. Adjust the path at the top of clhs-lookup.lisp to get links to the HyperSpec.~%") + (return-from populate-table nil)) (do ((symbol-name (read-line s nil s) (read-line s nil s)) (url (read-line s nil s) (read-line s nil s))) ((eq url s) 'done)

1 0

[Lisppaste-cvs] CVS update: lisppaste2/coloring-types.lisp lisppaste2/coloring-css.lisp lisppaste2/web-server.lisp
by Brian Mastenbrook 17 Jun '04

17 Jun '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/home/bmastenbrook/lisppaste2 Modified Files: coloring-types.lisp coloring-css.lisp web-server.lisp Log Message: Index of paste annotations; adjust Lisp coloring to find less english and MORE CODE; tweak to CSS to not underline links to specifications. Date: Thu Jun 17 05:46:59 2004 Author: bmastenbrook Index: lisppaste2/coloring-types.lisp diff -u lisppaste2/coloring-types.lisp:1.7 lisppaste2/coloring-types.lisp:1.8 --- lisppaste2/coloring-types.lisp:1.7 Tue Jun 15 06:52:52 2004 +++ lisppaste2/coloring-types.lisp Thu Jun 17 05:46:59 2004 @@ -22,10 +22,10 @@ (defparameter *close-parens* '(#\))) (define-coloring-type :lisp "Basic Lisp" - :modes (:normal :symbol :escaped-symbol :keyword :string :comment + :modes (:first-char-on-line :normal :symbol :escaped-symbol :keyword :string :comment :multiline :character :single-escaped :in-list :syntax-error) - :default-mode :normal + :default-mode :first-char-on-line :transitions (((:in-list) ((or @@ -59,10 +59,20 @@ ((scan #$) (set-mode :in-list :until (scan #$)))) - (:normal + ((:normal :first-char-on-line) ((scan #$) (set-mode :in-list :until (scan #$)))) + (:first-char-on-line + ((scan #\;) + (set-mode :comment + :until (scan #\newline))) + ((scan "#|") + (set-mode :multiline + :until (scan "|#"))) + ((advance 1) + (set-mode :normal + :until (scan #\newline)))) (:multiline ((scan "#|") (set-mode :multiline @@ -81,9 +91,10 @@ (loop for i from paren-counter downto 1 collect ""))) :formatters - ((:normal (lambda (type s) - (declare (ignore type)) - s)) + (((:normal :first-char-on-line) + (lambda (type s) + (declare (ignore type)) + s)) ((:in-list) (lambda (type s) (declare (ignore type)) Index: lisppaste2/coloring-css.lisp diff -u lisppaste2/coloring-css.lisp:1.2 lisppaste2/coloring-css.lisp:1.3 --- lisppaste2/coloring-css.lisp:1.2 Tue Jun 8 08:23:04 2004 +++ lisppaste2/coloring-css.lisp Thu Jun 17 05:46:59 2004 @@ -4,10 +4,10 @@ (defparameter *coloring-css* ".symbol { color : #770055; background-color : inherit; } -a.symbol:link { color : #229955; background-color : inherit; text-decoration: underline; } -a.symbol:active { color : #229955; background-color : inherit; text-decoration: underline; } -a.symbol:visited { color : #229955; background-color : inherit; text-decoration: underline; } -a.symbol:hover { color : #229955; background-color : inherit; text-decoration: underline; } +a.symbol:link { color : #229955; background-color : inherit; text-decoration: none; } +a.symbol:active { color : #229955; background-color : inherit; text-decoration: none; } +a.symbol:visited { color : #229955; background-color : inherit; text-decoration: none; } +a.symbol:hover { color : #229955; background-color : inherit; text-decoration: none; } .special { color : #FF5000; background-color : inherit; } .keyword { color : #770000; background-color : inherit; } .comment { color : #007777; background-color : inherit; } Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.56 lisppaste2/web-server.lisp:1.57 --- lisppaste2/web-server.lisp:1.56 Fri Jun 11 10:35:33 2004 +++ lisppaste2/web-server.lisp Thu Jun 17 05:46:59 2004 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.56 2004/06/11 17:35:33 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.57 2004/06/17 12:46:59 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -18,7 +18,8 @@ (colorization-mode :initarg :colorization-mode :initform "" :accessor paste-colorization-mode))) (defmacro make-paste (&rest arguments) - `(make-instance 'paste ,@arguments)) + `(progn + (funcall 'make-instance 'paste ,@arguments))) (defclass new-paste-handler (araneida:handler) ()) @@ -135,7 +136,7 @@ (t (format nil "~A~A" (time-delta-primitive delta level) (if ago-p " ago" "")))))) (defun irc-log-link (utime channel) - (format nil "http://meme.b9.com/now?utime=~A&channel=~A" + (format nil "http://meme.b9.com/now.html?utime=~A&channel=~A" utime (string-left-trim "#" channel))) @@ -654,12 +655,11 @@ `((tr (td) ((td :align "left" :width "100%") ,@(if (not annotation) - `((,(encode-for-pre (paste-channel paste)) ,(if *meme-links* - " | " "")))) + `((,(encode-for-pre (paste-channel paste))))) ,@(if (and *meme-links* (not (and *no-channel-pastes* (string-equal (paste-channel paste) "None")))) - `(((a :href ,(irc-log-link (paste-universal-time paste) (paste-channel paste))) "Context in IRC logs"))))))) + `(" | " ((a :href ,(irc-log-link (paste-universal-time paste) (paste-channel paste))) "Context in IRC logs"))))))) (tr ((td :align "left" :valign "top" :nowrap "nowrap") "Paste contents:") ,@(if this-url `(((td :width "100%") ((a :href ,(concatenate 'string this-url "/raw")) "(raw source)"))))) @@ -734,6 +734,18 @@ colorize:*coloring-css*)) ,(rss-link-header)) (body + + ,@(if (paste-annotations paste) + `("Index of paste annotations: " + ,@(loop for ann in (reverse (paste-annotations paste)) + for test from (length (paste-annotations paste)) downto 1 + appending + `(((a :href ,(format nil "#~A" + (paste-number ann))) + ,(prin1-to-string (paste-number ann)))) + if (not (eql test 1)) + appending '(" | ")) + (p))) ,(format-paste paste (araneida:urlstring (araneida:request-url request)) paste-number nil colorize-as linenumbers) ,@(if (paste-annotations paste)

1 0

[Lisppaste-cvs] CVS update: lisppaste/READ-ME-WHERE-IS-THE-SOURCE lisppaste/README.lisp lisppaste/apache.conf.include lisppaste/encode-for-pre.lisp lisppaste/irc-protocol.lisp lisppaste/web-server.lisp
by Brian Mastenbrook 17 Jun '04

17 Jun '04

Update of /project/lisppaste/cvsroot/lisppaste In directory common-lisp.net:/home/bmastenbrook/lisppaste Added Files: READ-ME-WHERE-IS-THE-SOURCE Removed Files: README.lisp apache.conf.include encode-for-pre.lisp irc-protocol.lisp web-server.lisp Log Message: Avoid confusion - remove old source, add readme Date: Thu Jun 17 05:45:52 2004 Author: bmastenbrook

1 0

[Lisppaste-cvs] CVS update: lisppaste2/coloring-types.lisp
by Brian Mastenbrook 15 Jun '04

15 Jun '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/home/bmastenbrook/lisppaste2 Modified Files: coloring-types.lisp Log Message: Only colorize in parens in lisp mode Date: Tue Jun 15 06:52:52 2004 Author: bmastenbrook Index: lisppaste2/coloring-types.lisp diff -u lisppaste2/coloring-types.lisp:1.6 lisppaste2/coloring-types.lisp:1.7 --- lisppaste2/coloring-types.lisp:1.6 Fri Jun 11 07:34:34 2004 +++ lisppaste2/coloring-types.lisp Tue Jun 15 06:52:52 2004 @@ -27,7 +27,7 @@ :single-escaped :in-list :syntax-error) :default-mode :normal :transitions - (((:normal :in-list) + (((:in-list) ((or (scan-any *symbol-characters*) (and (scan #\.) (scan-any *symbol-characters*)) @@ -56,6 +56,10 @@ ((scan "#|") (set-mode :multiline :until (scan "|#"))) + ((scan #$) + (set-mode :in-list + :until (scan #$)))) + (:normal ((scan #$) (set-mode :in-list :until (scan #$))))

1 0