November 2003 - lisppaste-cvs@common-lisp.net

[Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp
by Brian Mastenbrook 12 Nov '03

12 Nov '03

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv14643 Modified Files: web-server.lisp Log Message: Better time-delta function Date: Tue Nov 11 23:38:12 2003 Author: bmastenbrook Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.9 lisppaste2/web-server.lisp:1.10 --- lisppaste2/web-server.lisp:1.9 Tue Nov 11 23:19:38 2003 +++ lisppaste2/web-server.lisp Tue Nov 11 23:38:11 2003 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.9 2003/11/12 04:19:38 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.10 2003/11/12 04:38:11 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -42,13 +42,35 @@ (let ((delta (- (get-universal-time) time))) (cond ((< delta 1) "<Doc Brown>From the <i>future</i>...</Doc Brown>") - ((< delta 60) (format nil "~D seconds ago" delta)) - ((< delta (* 60 60)) (format nil "~D minutes ago" (floor delta 60))) - ((< delta (* 60 60 24)) (format nil "~D hours ago" (floor delta (* 60 60)))) - ((< delta (* 60 60 24 7)) (format nil "~D days ago" (floor delta (* 60 60 24)))) - ((< delta (* 60 60 24 7 487/16)) (format nil "~D weeks ago" (floor delta (* 60 60 24 7)))) - ((< delta (* 60 60 24 7 487/16 12)) (format nil "~D months ago" (floor delta (* 60 60 24 7 487/16)))) - (t (format nil "~D years ago" (floor delta (* 60 60 24 7 (+ 365 1/4)))))))) + ((< delta (* 60 60)) (format nil "~A ago" (time-delta-primitive delta 1))) + (t (format nil "~A ago" (time-delta-primitive delta)))))) + +(defun first-<-mod (n &rest nums) + (some #'(lambda (n2) + (if (< n2 n) (mod n n2) nil)) nums)) + +(defun time-delta-primitive (delta &optional (level 2)) + (let* ((seconds 60) + (minutes (* seconds 60)) + (hours (* minutes 24)) + (days (* hours 7)) + (weeks (* days 487/16)) + (months (* weeks 12)) + (years (* hours (+ 365 1/4)))) + (let ((primitive + (cond + ((< delta seconds) (format nil "~D second~:P" delta)) + ((< delta minutes) (format nil "~D minute~:P" (floor delta seconds))) + ((< delta hours) (format nil "~D hour~:P" (floor delta minutes))) + ((< delta days) (format nil "~D day~:P" (floor delta hours))) + ((< delta weeks) (format nil "~D week~:P" (floor delta days))) + ((< delta months) (format nil "~D month~:P" (floor delta weeks))) + (t (format nil "~D years" (floor delta years)))))) + (if (eql level 1) primitive + (format nil "~A, ~A" primitive + (time-delta-primitive + (first-<-mod delta years months weeks days hours minutes seconds) + (1- level))))))) (defmethod araneida:handle-request-response ((handler list-paste-handler) method request) (araneida:request-send-headers request :expires 0)

1 0

[Lisppaste-cvs] CVS update: lisppaste2/variable.lisp lisppaste2/web-server.lisp
by Brian Mastenbrook 12 Nov '03

12 Nov '03

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv6666 Modified Files: variable.lisp web-server.lisp Log Message: Added paste annotations and paste lister. Prettified HTML output for paste display and list. Added line of links to the bottom of all pages. Date: Tue Nov 11 23:19:38 2003 Author: bmastenbrook Index: lisppaste2/variable.lisp diff -u lisppaste2/variable.lisp:1.3 lisppaste2/variable.lisp:1.4 --- lisppaste2/variable.lisp:1.3 Mon Nov 10 11:18:39 2003 +++ lisppaste2/variable.lisp Tue Nov 11 23:19:38 2003 @@ -1,4 +1,4 @@ -;;;; $Id: variable.lisp,v 1.3 2003/11/10 16:18:39 eenge Exp $ +;;;; $Id: variable.lisp,v 1.4 2003/11/12 04:19:38 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/variable.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -6,9 +6,9 @@ (in-package :lisppaste) (defparameter *internal-http-port* 8081 - "Port lisppaste will listen on for WWW requests.") -(defparameter *external-http-port* 80 - "Port lisppaste will listen on for WWW requests.") + "Port lisppaste's araneida will listen on for requests from Apache.") +(defparameter *external-http-port* 8081 + "Port lisppaste's araneida will listen on for requests from remote clients.") (defparameter *paste-site-name* "localhost" "Website we are running on (used for creating links).") @@ -17,18 +17,22 @@ (araneida:merge-url (araneida:make-url :scheme "http" :host *paste-site-name* - :port *external-http-port*) "/paste/")) + :port *internal-http-port*) "/paste/")) (defparameter *paste-external-url* (araneida:merge-url (araneida:make-url :scheme "http" - :host *paste-site-name*) "/paste/")) + :host *paste-site-name* + :port *external-http-port*) "/paste/")) (defparameter *display-paste-url* (araneida:merge-url *paste-external-url* "display/")) (defparameter *new-paste-url* (araneida:merge-url *paste-external-url* "new")) + +(defparameter *list-paste-url* + (araneida:merge-url *paste-external-url* "list")) (defparameter *submit-paste-url* (araneida:merge-url *paste-external-url* "submit")) Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.8 lisppaste2/web-server.lisp:1.9 --- lisppaste2/web-server.lisp:1.8 Tue Nov 11 09:55:37 2003 +++ lisppaste2/web-server.lisp Tue Nov 11 23:19:38 2003 @@ -1,47 +1,90 @@ -;;;; $Id: web-server.lisp,v 1.8 2003/11/11 14:55:37 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.9 2003/11/12 04:19:38 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. (in-package :lisppaste) -(defstruct (paste (:conc-name paste-)) +(defstruct paste (number nil :type integer) (user nil :type string) (title nil :type string) (contents nil :type string) - (universal-time nil :type integer)) + (universal-time nil :type integer) + (is-annotation nil :type boolean) + (annotations nil :type list) + (annotation-counter 0 :type integer)) (defclass new-paste-handler (araneida:handler) ()) -(defclass submit-paste-handler (araneida:handler) - ((username - :accessor username - :initform "") - (title - :accessor title - :initform "") - (text - :accessor text - :initform ""))) +(defclass list-paste-handler (araneida:handler) ()) + +(defclass submit-paste-handler (araneida:handler) ()) (defclass display-paste-handler (araneida:handler) ()) (defmethod araneida:handle-request-response ((handler new-paste-handler) method request) (araneida:request-send-headers request :expires 0) - (new-paste-form request)) + (let* ((annotate-string (araneida:body-param "annotate" (araneida: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)))) + (new-paste-form request :annotate annotate))) + +(defun bottom-links () + `((hr) + ((a :href ,(araneida:urlstring *new-paste-url*)) "New paste") + " | " + ((a :href ,(araneida:urlstring *list-paste-url*)) "List all pastes") + " | " + ((a :href "http://common-lisp.net/project/lisppaste") "lisppaste home page"))) + +(defun time-delta (time) + (let ((delta (- (get-universal-time) time))) + (cond + ((< delta 1) "<Doc Brown>From the <i>future</i>...</Doc Brown>") + ((< delta 60) (format nil "~D seconds ago" delta)) + ((< delta (* 60 60)) (format nil "~D minutes ago" (floor delta 60))) + ((< delta (* 60 60 24)) (format nil "~D hours ago" (floor delta (* 60 60)))) + ((< delta (* 60 60 24 7)) (format nil "~D days ago" (floor delta (* 60 60 24)))) + ((< delta (* 60 60 24 7 487/16)) (format nil "~D weeks ago" (floor delta (* 60 60 24 7)))) + ((< delta (* 60 60 24 7 487/16 12)) (format nil "~D months ago" (floor delta (* 60 60 24 7 487/16)))) + (t (format nil "~D years ago" (floor delta (* 60 60 24 7 (+ 365 1/4)))))))) -(defun new-paste-form (request &optional (message "")) +(defmethod araneida:handle-request-response ((handler list-paste-handler) method request) + (araneida:request-send-headers request :expires 0) (araneida:html-stream (araneida:request-stream request) `(html - (head (title "Paste")) + (head (title "All pastes")) (body - (h1 "Enter your paste") + (center (h2 "All pastes in system")) + ((table :width "100%" :cellpadding 2) + (tr (td) (td "By") (td "When") (td "Titled") (td "Ann.")) + ,@(reverse (mapcar #'(lambda (paste) + `(tr ((td :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) ,(encode-for-pre (paste-user paste))) + ((td :nowrap) ,(time-delta (paste-universal-time paste))) + ((td :width "100%" :bgcolor "#F4F4F4" :nowrap) ,(encode-for-pre (paste-title paste))) + ((td :nowrap) ,(length (paste-annotations paste))))) + *pastes*))) + ,@(bottom-links))))) + +(defun new-paste-form (request &key (message "") (annotate nil)) + (araneida:html-stream + (araneida:request-stream request) + `(html + (head (title ,(if annotate "Annotate" "Paste"))) + (body + (h1 ,(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. The -paste will appear on " ,*channel* " @ " ,(irc:server-name *connection*) ".") +paste will be announced on " ,*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)))))) (hr) (table (tr @@ -55,47 +98,57 @@ (td ((textarea :rows 24 :cols 80 :name "text")))) (tr ((th) "Submit your paste:") - ((td) ((input :type submit :value "Submit paste")) " " ((input :type reset :value "Clear paste")))))))))) + ((td) ((input :type submit :value "Submit paste")) " " ((input :type reset :value "Clear paste")))))) + ,@(bottom-links))))) (defmethod araneida:handle-request-response ((handler submit-paste-handler) method request) - (setf (username handler) (araneida:body-param "username" (araneida:request-body request)) - (title handler) (araneida:body-param "title" (araneida:request-body request)) - (text handler) (araneida:body-param "text" (araneida:request-body request))) - (araneida:request-send-headers request) - - (with-slots (username title text) handler + (let ((username (araneida:body-param "username" (araneida:request-body request))) + (title (araneida:body-param "title" (araneida:request-body request))) + (text (araneida:body-param "text" (araneida:request-body request))) + (annotate (araneida:body-param "annotate" (araneida:request-body request)))) + (araneida:request-send-headers request) + (cond - ((zerop (length username)) - (new-paste-form request "Please enter your username.")) - ((zerop (length title)) - (new-paste-form request "Please enter a title.")) - ((zerop (length text)) - (new-paste-form request "Please enter your paste.")) - (t - (progn - (incf *paste-counter*) - (let ((url (araneida:urlstring - (araneida:merge-url *display-paste-url* - (prin1-to-string *paste-counter*)))) - (external-url (araneida:urlstring - (araneida:merge-url *display-paste-url* - (prin1-to-string *paste-counter*)))) - (paste (make-paste :number *paste-counter* - :user username - :title title - :contents text - :universal-time (get-universal-time)))) - (irc:privmsg *connection* *channel* - (format nil "~A pasted ~A at ~A" username title external-url)) - (push paste *pastes*) - (araneida:html-stream - (araneida:request-stream request) - `(html - (head (title "Paste number " ,*paste-counter*)) - (body - (h1 "Pasted!") - (p "Your paste should be available at " ((a :href ,url) ,url) ", and -was also sent to " ,*channel* " @ " ,(irc:server-name *connection*))))))))))) + ((zerop (length username)) + (new-paste-form request :message "Please enter your username.")) + ((zerop (length title)) + (new-paste-form request :message "Please enter a title.")) + ((zerop (length text)) + (new-paste-form request :message "Please enter your paste.")) + ((and annotate (not (parse-integer annotate :junk-allowed t))) + (new-paste-form request :message "Malformed annotation request.")) + (t + + (let* ((paste-number (if annotate (parse-integer annotate :junk-allowed t) (incf *paste-counter*))) + (paste-to-annotate (if annotate (find paste-number *pastes* :key #'paste-number))) + (annotation-number (if annotate (incf (paste-annotation-counter paste-to-annotate))))) + (let ((url (araneida:urlstring + (araneida:merge-url *display-paste-url* + (if annotate + (concatenate 'string (prin1-to-string paste-number) + "#" + (prin1-to-string annotation-number)) + (prin1-to-string paste-number))))) + (paste (make-paste :number (if annotate annotation-number paste-number) + :user username + :title title + :contents text + :universal-time (get-universal-time)))) + (irc:privmsg *connection* *channel* + (if annotate + (format nil "~A annotated #~A with ~A at ~A" username paste-number title url) + (format nil "~A pasted ~A at ~A" username title url))) + (if annotate + (push paste (paste-annotations paste-to-annotate)) + (push paste *pastes*)) + (araneida:html-stream + (araneida:request-stream request) + `(html + (head (title "Paste number " ,*paste-counter*)) + (body + (h1 "Pasted!") + (p ,(if annotate "Your annotation should be available at " "Your paste should be available at ") ((a :href ,url) ,url) ", and was also sent to " ,*channel* " @ " ,(irc:server-name *connection*)) + ,@(bottom-links)))))))))) (defmethod araneida:handle-request-response ((handler display-paste-handler) method request) (araneida:request-send-headers request :expires 0) @@ -113,22 +166,61 @@ (head (title "Paste number " ,paste-number)) (body - (h2 "Paste number " ,paste-number ": " ,(encode-for-pre (paste-title paste))) - (p "Pasted by: " ,(encode-for-pre (paste-user paste))) - (hr) - (pre ,(encode-for-pre (paste-contents paste)))))) + ((table :width "100%" :cellpadding 2) + (tr ((td :align "left" :nowrap) "Paste number " ,paste-number ": ") + ((td :width "100%") (b ,(encode-for-pre (paste-title paste))))) + (tr ((td :align "left" :nowrap) "Pasted by: ") + ((td :width "100%") ,(encode-for-pre (paste-user paste)))) + (tr (td) + ((td :width "100%") ,(time-delta (paste-universal-time paste)))) + (tr ((td :align "left" :valign "top" :nowrap) "Paste contents:") + (td)) + (tr (td (p))) + (tr ((td :bgcolor "#F4F4F4" :colspan 2 :width "100%") (pre ,(encode-for-pre (paste-contents paste))))) + ,@(if (paste-annotations paste) + `((tr (td (p)) (td)) + (tr ((th :align "left" :colspan 2) "Annotations for this paste: ")) + ,@(reduce #'append + (mapcar #'(lambda (a) + `((tr (td (p)) (td)) + (tr + (td ((a :name ,(prin1-to-string (paste-number a)))"Annotation title:")) + (td ,(encode-for-pre (paste-title a)))) + (tr + (td "Annotated by:") + (td ,(encode-for-pre (paste-user a)))) + (tr + (td) + (td ,(time-delta (paste-universal-time a)))) + (tr + ((td :valign "top" :nowrap) "Annotation contents:") + ((td :bgcolor "#F4F4F4" :width "100%") (pre ,(encode-for-pre (paste-contents a))))))) + (paste-annotations paste)))) + `((tr (td (p)) (td)) + (tr ((td :align "left" :colspan 2 :nowrap) "This paste has no annotations."))))) + (p) + ((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)))) (araneida:html-stream (araneida:request-stream request) `(html (head (title "Invalid paste number" ,paste-number)) (body - (h3 "No paste numbered " ,paste-number " could be found."))))))) + (h3 "No paste numbered " ,paste-number " could be found.") + ,@(bottom-links))))))) (araneida:install-handler (araneida:http-listener-handler *paste-listener*) (make-instance 'new-paste-handler) (araneida:urlstring *new-paste-url*) t) + +(araneida:install-handler + (araneida:http-listener-handler *paste-listener*) + (make-instance 'list-paste-handler) + (araneida:urlstring *list-paste-url*) t) (araneida:install-handler (araneida:http-listener-handler *paste-listener*)

1 0

[Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp
by Brian Mastenbrook 11 Nov '03

11 Nov '03

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv15474 Modified Files: web-server.lisp Log Message: Cosmetic changes, and fix to use *display-paste-url* Date: Tue Nov 11 09:55:37 2003 Author: bmastenbrook Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.7 lisppaste2/web-server.lisp:1.8 --- lisppaste2/web-server.lisp:1.7 Tue Nov 11 09:42:03 2003 +++ lisppaste2/web-server.lisp Tue Nov 11 09:55:37 2003 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.7 2003/11/11 14:42:03 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.8 2003/11/11 14:55:37 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -54,9 +54,8 @@ ((th :valign top) "Enter your paste:") (td ((textarea :rows 24 :cols 80 :name "text")))) (tr - ((td :colspan 2) ((input :type submit)))) - (tr - ((td :colspan 2) ((input :type reset)))))))))) + ((th) "Submit your paste:") + ((td) ((input :type submit :value "Submit paste")) " " ((input :type reset :value "Clear paste")))))))))) (defmethod araneida:handle-request-response ((handler submit-paste-handler) method request) (setf (username handler) (araneida:body-param "username" (araneida:request-body request)) @@ -79,7 +78,7 @@ (araneida:merge-url *display-paste-url* (prin1-to-string *paste-counter*)))) (external-url (araneida:urlstring - (araneida:merge-url *paste-external-url* + (araneida:merge-url *display-paste-url* (prin1-to-string *paste-counter*)))) (paste (make-paste :number *paste-counter* :user username @@ -114,8 +113,8 @@ (head (title "Paste number " ,paste-number)) (body - (h2 "Paste number " ,paste-number ,(encode-for-pre (paste-title paste))) - (p "Pasted by " ,(encode-for-pre (paste-user paste))) + (h2 "Paste number " ,paste-number ": " ,(encode-for-pre (paste-title paste))) + (p "Pasted by: " ,(encode-for-pre (paste-user paste))) (hr) (pre ,(encode-for-pre (paste-contents paste)))))) (araneida:html-stream

1 0

[Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp
by Brian Mastenbrook 11 Nov '03

11 Nov '03

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv9594 Modified Files: web-server.lisp Log Message: Use strings instead of symbols for names of form fields, and use with-slots Date: Tue Nov 11 09:42:04 2003 Author: bmastenbrook Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.6 lisppaste2/web-server.lisp:1.7 --- lisppaste2/web-server.lisp:1.6 Tue Nov 11 09:39:24 2003 +++ lisppaste2/web-server.lisp Tue Nov 11 09:42:03 2003 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.6 2003/11/11 14:39:24 eenge Exp $ +;;;; $Id: web-server.lisp,v 1.7 2003/11/11 14:42:03 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -46,27 +46,25 @@ (table (tr (th "Enter your username:") - (td ((input :type text :name username)))) + (td ((input :type text :name "username")))) (tr (th "Enter a title:") - (td ((input :type text :name title)))) + (td ((input :type text :name "title")))) (tr ((th :valign top) "Enter your paste:") - (td ((textarea :rows 24 :cols 80 :name text)))) + (td ((textarea :rows 24 :cols 80 :name "text")))) (tr ((td :colspan 2) ((input :type submit)))) (tr ((td :colspan 2) ((input :type reset)))))))))) (defmethod araneida:handle-request-response ((handler submit-paste-handler) method request) - (setf (username handler) (araneida:body-param "USERNAME" (araneida:request-body request)) - (title handler) (araneida:body-param "TITLE" (araneida:request-body request)) - (text handler) (araneida:body-param "TEXT" (araneida:request-body request))) + (setf (username handler) (araneida:body-param "username" (araneida:request-body request)) + (title handler) (araneida:body-param "title" (araneida:request-body request)) + (text handler) (araneida:body-param "text" (araneida:request-body request))) (araneida:request-send-headers request) - (let ((username (username handler)) - (title (title handler)) - (text (text handler))) + (with-slots (username title text) handler (cond ((zerop (length username)) (new-paste-form request "Please enter your username."))

1 0

[Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp
by Erik Enge 11 Nov '03

11 Nov '03

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv8954 Modified Files: web-server.lisp Log Message: fix parenthesis mismatch bug Date: Tue Nov 11 09:39:24 2003 Author: eenge Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.5 lisppaste2/web-server.lisp:1.6 --- lisppaste2/web-server.lisp:1.5 Mon Nov 10 15:07:48 2003 +++ lisppaste2/web-server.lisp Tue Nov 11 09:39:24 2003 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.5 2003/11/10 20:07:48 eenge Exp $ +;;;; $Id: web-server.lisp,v 1.6 2003/11/11 14:39:24 eenge Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -82,22 +82,22 @@ (prin1-to-string *paste-counter*)))) (external-url (araneida:urlstring (araneida:merge-url *paste-external-url* - (prin1-to-string *paste-counter*))))) + (prin1-to-string *paste-counter*)))) (paste (make-paste :number *paste-counter* :user username :title title :contents text :universal-time (get-universal-time)))) - (irc:privmsg *connection* *channel* - (format nil "~A pasted ~A at ~A" username title external-url)) - (push paste *pastes*) - (araneida:html-stream - (araneida:request-stream request) - `(html - (head (title "Paste number " ,*paste-counter*)) - (body - (h1 "Pasted!") - (p "Your paste should be available at " ((a :href ,url) ,url) ", and + (irc:privmsg *connection* *channel* + (format nil "~A pasted ~A at ~A" username title external-url)) + (push paste *pastes*) + (araneida:html-stream + (araneida:request-stream request) + `(html + (head (title "Paste number " ,*paste-counter*)) + (body + (h1 "Pasted!") + (p "Your paste should be available at " ((a :href ,url) ,url) ", and was also sent to " ,*channel* " @ " ,(irc:server-name *connection*))))))))))) (defmethod araneida:handle-request-response ((handler display-paste-handler) method request)

1 0

[Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp
by Erik Enge 10 Nov '03

10 Nov '03

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv9860 Modified Files: web-server.lisp Log Message: setf takes plenty forms; no need for three calls. Date: Mon Nov 10 15:07:48 2003 Author: eenge Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.4 lisppaste2/web-server.lisp:1.5 --- lisppaste2/web-server.lisp:1.4 Mon Nov 10 15:04:36 2003 +++ lisppaste2/web-server.lisp Mon Nov 10 15:07:48 2003 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.4 2003/11/10 20:04:36 eenge Exp $ +;;;; $Id: web-server.lisp,v 1.5 2003/11/10 20:07:48 eenge Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -59,9 +59,9 @@ ((td :colspan 2) ((input :type reset)))))))))) (defmethod araneida:handle-request-response ((handler submit-paste-handler) method request) - (setf (username handler) (araneida:body-param "USERNAME" (araneida:request-body request))) - (setf (title handler) (araneida:body-param "TITLE" (araneida:request-body request))) - (setf (text handler) (araneida:body-param "TEXT" (araneida:request-body request))) + (setf (username handler) (araneida:body-param "USERNAME" (araneida:request-body request)) + (title handler) (araneida:body-param "TITLE" (araneida:request-body request)) + (text handler) (araneida:body-param "TEXT" (araneida:request-body request))) (araneida:request-send-headers request) (let ((username (username handler))

1 0

[Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp
by Erik Enge 10 Nov '03

10 Nov '03

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv9034 Modified Files: web-server.lisp Log Message: need to tell the IRC channel about the external (rather than internal) URL for the paste Date: Mon Nov 10 15:04:37 2003 Author: eenge Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.3 lisppaste2/web-server.lisp:1.4 --- lisppaste2/web-server.lisp:1.3 Mon Nov 10 11:28:43 2003 +++ lisppaste2/web-server.lisp Mon Nov 10 15:04:36 2003 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.3 2003/11/10 16:28:43 eenge Exp $ +;;;; $Id: web-server.lisp,v 1.4 2003/11/10 20:04:36 eenge Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -77,15 +77,19 @@ (t (progn (incf *paste-counter*) - (let ((url (araneida:urlstring (araneida:merge-url *display-paste-url* - (prin1-to-string *paste-counter*)))) + (let ((url (araneida:urlstring + (araneida:merge-url *display-paste-url* + (prin1-to-string *paste-counter*)))) + (external-url (araneida:urlstring + (araneida:merge-url *paste-external-url* + (prin1-to-string *paste-counter*))))) (paste (make-paste :number *paste-counter* :user username :title title :contents text :universal-time (get-universal-time)))) (irc:privmsg *connection* *channel* - (format nil "~A pasted ~A at ~A" username title url)) + (format nil "~A pasted ~A at ~A" username title external-url)) (push paste *pastes*) (araneida:html-stream (araneida:request-stream request)

1 0

[Lisppaste-cvs] CVS update: lisppaste2/apache.conf.include lisppaste2/lisppaste.lisp lisppaste2/web-server.lisp
by Erik Enge 10 Nov '03

10 Nov '03

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv9846 Modified Files: apache.conf.include lisppaste.lisp web-server.lisp Log Message: minor typo corrections Date: Mon Nov 10 11:28:43 2003 Author: eenge Index: lisppaste2/apache.conf.include diff -u lisppaste2/apache.conf.include:1.3 lisppaste2/apache.conf.include:1.4 --- lisppaste2/apache.conf.include:1.3 Mon Nov 3 12:57:02 2003 +++ lisppaste2/apache.conf.include Mon Nov 10 11:28:43 2003 @@ -1,4 +1,4 @@ -#### $Id: apache.conf.include,v 1.3 2003/11/03 17:57:02 eenge Exp $ +#### $Id: apache.conf.include,v 1.4 2003/11/10 16:28:43 eenge Exp $ #### $Source: /project/lisppaste/cvsroot/lisppaste2/apache.conf.include,v $ # To include this file, simply add: @@ -9,7 +9,7 @@ <VirtualHost localhost:80> ServerName localhost - ProxyPass /paste/ http://localhost:8081/paste/ + Proxypass /paste/ http://localhost:8081/paste/ ProxyPassReverse /paste/ http://localhost:8081/paste/ SetEnvIf User-Agent ".*MSIE.*" nokeepalive ssl-unclean-shutdown </VirtualHost> Index: lisppaste2/lisppaste.lisp diff -u lisppaste2/lisppaste.lisp:1.1.1.1 lisppaste2/lisppaste.lisp:1.2 --- lisppaste2/lisppaste.lisp:1.1.1.1 Mon Nov 3 12:17:54 2003 +++ lisppaste2/lisppaste.lisp Mon Nov 10 11:28:43 2003 @@ -1,4 +1,4 @@ -;;;; $Id: lisppaste.lisp,v 1.1.1.1 2003/11/03 17:17:54 eenge Exp $ +;;;; $Id: lisppaste.lisp,v 1.2 2003/11/10 16:28:43 eenge Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/lisppaste.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -15,7 +15,8 @@ :server server :port port))) (setf *connection* connection) + (setf *channel* channel) (irc:join connection channel) - (araneida:install-serve-event-handlers) + (araneida:start-listening *paste-listener*) (irc:read-message-loop connection))) Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.2 lisppaste2/web-server.lisp:1.3 --- lisppaste2/web-server.lisp:1.2 Mon Nov 10 11:18:23 2003 +++ lisppaste2/web-server.lisp Mon Nov 10 11:28:43 2003 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.2 2003/11/10 16:18:23 eenge Exp $ +;;;; $Id: web-server.lisp,v 1.3 2003/11/10 16:28:43 eenge Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -77,7 +77,7 @@ (t (progn (incf *paste-counter*) - (let ((url (araneida:urlstring (araneida:merge-url *display-url* + (let ((url (araneida:urlstring (araneida:merge-url *display-paste-url* (prin1-to-string *paste-counter*)))) (paste (make-paste :number *paste-counter* :user username @@ -122,7 +122,7 @@ (head (title "Invalid paste number" ,paste-number)) (body - (h1 "No paste numberd " ,paste-number "could be found."))))))) + (h3 "No paste numbered " ,paste-number " could be found."))))))) (araneida:install-handler (araneida:http-listener-handler *paste-listener*)

1 0

[Lisppaste-cvs] CVS update: lisppaste2/variable.lisp
by Erik Enge 10 Nov '03

10 Nov '03

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv5713 Modified Files: variable.lisp Log Message: renaming and removing some urls Date: Mon Nov 10 11:18:39 2003 Author: eenge Index: lisppaste2/variable.lisp diff -u lisppaste2/variable.lisp:1.2 lisppaste2/variable.lisp:1.3 --- lisppaste2/variable.lisp:1.2 Mon Nov 3 12:35:51 2003 +++ lisppaste2/variable.lisp Mon Nov 10 11:18:39 2003 @@ -1,4 +1,4 @@ -;;;; $Id: variable.lisp,v 1.2 2003/11/03 17:35:51 eenge Exp $ +;;;; $Id: variable.lisp,v 1.3 2003/11/10 16:18:39 eenge Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/variable.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -7,23 +7,22 @@ (defparameter *internal-http-port* 8081 "Port lisppaste will listen on for WWW requests.") +(defparameter *external-http-port* 80 + "Port lisppaste will listen on for WWW requests.") (defparameter *paste-site-name* "localhost" "Website we are running on (used for creating links).") (defparameter *paste-url* (araneida:merge-url - (make-instance 'araneida:http-url - :host *paste-site-name* - :port *internal-http-port*) "/paste/")) + (araneida:make-url :scheme "http" + :host *paste-site-name* + :port *external-http-port*) "/paste/")) (defparameter *paste-external-url* (araneida:merge-url - (make-instance 'araneida:http-url - :host *paste-site-name*) "/paste/")) - -(defparameter *say-url* - (araneida:merge-url *paste-external-url* "say/")) + (araneida:make-url :scheme "http" + :host *paste-site-name*) "/paste/")) (defparameter *display-paste-url* (araneida:merge-url *paste-external-url* "display/")) @@ -31,11 +30,18 @@ (defparameter *new-paste-url* (araneida:merge-url *paste-external-url* "new")) -(defparameter *paste-server* - (make-instance 'araneida:server - :name *paste-site-name* - :base-url *paste-url* - :port *internal-http-port*)) +(defparameter *submit-paste-url* + (araneida:merge-url *paste-external-url* "submit")) + +(defparameter *paste-listener* + (let ((fwd-url (araneida:copy-url *paste-url*))) + (setf (araneida:url-port fwd-url) *internal-http-port*) + (make-instance 'araneida:serve-event-reverse-proxy-listener + :translations + `((,(araneida:urlstring *paste-url*) + ,(araneida:urlstring fwd-url))) + :address #(0 0 0 0) + :port (araneida:url-port fwd-url)))) (defvar *default-nickname* "devpaste") (defvar *default-irc-server* "irc.freenode.net") @@ -43,7 +49,6 @@ (defvar *default-channel* "#lisppaste") (defvar *pastes* nil) - (defvar *paste-counter* 0) - -(defvar *connection* nil) \ No newline at end of file +(defvar *connection* nil) +(defvar *channel* "") \ No newline at end of file

1 0

[Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp
by Erik Enge 10 Nov '03

10 Nov '03

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv5661 Modified Files: web-server.lisp Log Message: updating for araneida 0.80. Date: Mon Nov 10 11:18:23 2003 Author: eenge Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.1.1.1 lisppaste2/web-server.lisp:1.2 --- lisppaste2/web-server.lisp:1.1.1.1 Mon Nov 3 12:17:53 2003 +++ lisppaste2/web-server.lisp Mon Nov 10 11:18:23 2003 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.1.1.1 2003/11/03 17:17:53 eenge Exp $ +;;;; $Id: web-server.lisp,v 1.2 2003/11/10 16:18:23 eenge Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -12,122 +12,130 @@ (contents nil :type string) (universal-time nil :type integer)) -(defun say-handler (request rest) - (araneida:request-send-headers request) - (irc:send-irc-message *connection* :privmsg rest (channel *connection*)) - (princ - (html - `(html - (head - (title "Sent!")) - (body - ,(format nil "Your text was sent to ~A!" (channel *connection*))))))) +(defclass new-paste-handler (araneida:handler) ()) + +(defclass submit-paste-handler (araneida:handler) + ((username + :accessor username + :initform "") + (title + :accessor title + :initform "") + (text + :accessor text + :initform ""))) -(defun display-handler (request rest) +(defclass display-paste-handler (araneida:handler) ()) + +(defmethod araneida:handle-request-response ((handler new-paste-handler) method request) (araneida:request-send-headers request :expires 0) - (write-sequence - (let ((pnumber (parse-integer rest :junk-allowed t))) - (if (not pnumber) - (html - `(html (head (title "Invalid paste number!")) - (body (h1 ,(format nil "The supplied paste number is not an integer."))))) - (let ((thepaste (some #'(lambda (e) (and (eql pnumber (paste-number e)) e)) *pastes*))) - (if (not thepaste) - (html - `(html (head (title "Invalid paste number!")) - (body (h1 ,(format nil "No paste numbered ~A could be found." pnumber))))) - (html - `(html (head (title ,(format nil "Paste number ~A" pnumber))) - (body (h3 ,(format nil "Paste number ~A: ~A" pnumber (encode-for-pre (paste-title thepaste)))) - ,(format nil "Pasted by ~A" (encode-for-pre (paste-user thepaste))) - (hr) - ((pre) ,(encode-for-pre (paste-contents thepaste)))))))))) - (araneida:request-stream request))) - -(defun new-paste-form () - `((form :method post :action ,(araneida:urlstring *new-paste-url*)) - "Enter a username, title, and paste contents into the fields below. If you choose a unique username for your pastes then other users will be able to search for your pastes (not now)." - (hr) - "Enter your username: " ((input :type text :name username)) (br) - "Enter a title: " ((input :type text :name title)) (br) - "Enter your paste: " (br) ((textarea :rows 24 :cols 80 :name text)) - (br) - ((input :type submit)) - ((input :type reset)))) - -#|(defun search-paste-handler (request rest) - (request-send-headers request :expires 0) - (write-sequence - (html - `(html - (head (title "Search Pastes")) - (body - ,@(let ((username-param (body-param "USERNAME" (request-body request))) - (title-param (body-param "TITLE" (request-body request))) - (text-param (body-param "TEXT" (request-body request)))) - (if (not (or username-param title-param text-param)) - `((h1 "Search for pastes") - `((form :method post :action ,(urlstring *search-paste-url*)) - "Enter one or more of a username, title, or paste contents to search for. The searches are exact substring searches." - (hr) - "Search for a username: " ((input :type text :name username)) (br) - "Search for a title: " ((input :type text :name title)) (br) - "Search for a paste: " ((input :type text :name text)) (br) - ((input :type submit)) - ((input :type reset)))))))))))|# + (new-paste-form request)) -(defun new-paste-handler (request rest) +(defun new-paste-form (request &optional (message "")) + (araneida:html-stream + (araneida:request-stream request) + `(html + (head (title "Paste")) + (body + (h1 "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. The +paste will appear on " ,*channel* " @ " ,(irc:server-name *connection*) ".") + (hr) + (table + (tr + (th "Enter your username:") + (td ((input :type text :name username)))) + (tr + (th "Enter a title:") + (td ((input :type text :name title)))) + (tr + ((th :valign top) "Enter your paste:") + (td ((textarea :rows 24 :cols 80 :name text)))) + (tr + ((td :colspan 2) ((input :type submit)))) + (tr + ((td :colspan 2) ((input :type reset)))))))))) + +(defmethod araneida:handle-request-response ((handler submit-paste-handler) method request) + (setf (username handler) (araneida:body-param "USERNAME" (araneida:request-body request))) + (setf (title handler) (araneida:body-param "TITLE" (araneida:request-body request))) + (setf (text handler) (araneida:body-param "TEXT" (araneida:request-body request))) + (araneida:request-send-headers request) + + (let ((username (username handler)) + (title (title handler)) + (text (text handler))) + (cond + ((zerop (length username)) + (new-paste-form request "Please enter your username.")) + ((zerop (length title)) + (new-paste-form request "Please enter a title.")) + ((zerop (length text)) + (new-paste-form request "Please enter your paste.")) + (t + (progn + (incf *paste-counter*) + (let ((url (araneida:urlstring (araneida:merge-url *display-url* + (prin1-to-string *paste-counter*)))) + (paste (make-paste :number *paste-counter* + :user username + :title title + :contents text + :universal-time (get-universal-time)))) + (irc:privmsg *connection* *channel* + (format nil "~A pasted ~A at ~A" username title url)) + (push paste *pastes*) + (araneida:html-stream + (araneida:request-stream request) + `(html + (head (title "Paste number " ,*paste-counter*)) + (body + (h1 "Pasted!") + (p "Your paste should be available at " ((a :href ,url) ,url) ", and +was also sent to " ,*channel* " @ " ,(irc:server-name *connection*))))))))))) + +(defmethod araneida:handle-request-response ((handler display-paste-handler) method request) (araneida:request-send-headers request :expires 0) - (write-sequence - (html - `(html - (head (title "Paste")) - (body - ,@(let ((username-param (body-param "USERNAME" (araneida:request-body request))) - (title-param (body-param "TITLE" (araneida:request-body request))) - (text-param (body-param "TEXT" (araneida:request-body request)))) - (print 'hi) - (if (not username-param) ;;; We weren't supplied a paste - `((h1 "Enter your paste") - ,(new-paste-form)) - (if (string= username-param "") - `(((font :color red) "Please enter a valid username!") - (br) - (h1 "Enter your paste") - ,(new-paste-form)) - (if (or (not title-param) (string= title-param "")) - `(((font :color red) "Please enter a valid title!") - (h1 "Enter your paste") - ,(new-paste-form)) - (if (or (not text-param) (string= text-param "")) - `(((font :color red) "Please enter some text for your paste!") - (h1 "Enter your paste") - ,(new-paste-form)) - (progn - (incf *paste-counter*) - (push (make-paste :number *paste-counter* - :user username-param - :title title-param - :contents text-param - :universal-time (get-universal-time)) *pastes*) - (let ((theurl (urlstring (merge-url *display-paste-url* (prin1-to-string *paste-counter*))))) - (irc:send-irc-message connection - :privmsg (format nil "~A pasted ~A at ~A" username-param title-param theurl) - (channel connection)) - `((h1 "Pasted!") - "Your paste should be available at " ((a :href ,theurl) ,theurl)))))))))))) - (araneida:request-stream request))) - -(araneida:export-server *paste-server*) - -(araneida:export-handler *new-paste-url* - #'new-paste-handler - :method t :stage :response) - -(araneida:export-handler *say-url* - #'say-handler - :match :prefix :method t :stage :response) - -(araneida:export-handler *display-paste-url* - #'display-handler - :match :prefix :method t :stage :response) + ; XXX request-unhandled-part will be exported in 0.81 + (let* ((paste-number (parse-integer + (araneida::request-unhandled-part request) + :junk-allowed t)) + (paste (some #'(lambda (element) + (and (eql paste-number (paste-number element)) + element)) *pastes*))) + (if paste + (araneida:html-stream + (araneida:request-stream request) + `(html + (head + (title "Paste number " ,paste-number)) + (body + (h2 "Paste number " ,paste-number ,(encode-for-pre (paste-title paste))) + (p "Pasted by " ,(encode-for-pre (paste-user paste))) + (hr) + (pre ,(encode-for-pre (paste-contents paste)))))) + (araneida:html-stream + (araneida:request-stream request) + `(html + (head + (title "Invalid paste number" ,paste-number)) + (body + (h1 "No paste numberd " ,paste-number "could be found."))))))) + +(araneida:install-handler + (araneida:http-listener-handler *paste-listener*) + (make-instance 'new-paste-handler) + (araneida:urlstring *new-paste-url*) t) + +(araneida:install-handler + (araneida:http-listener-handler *paste-listener*) + (make-instance 'submit-paste-handler) + (araneida:urlstring *submit-paste-url*) t) + +(araneida:install-handler + (araneida:http-listener-handler *paste-listener*) + (make-instance 'display-paste-handler) + (araneida:urlstring *display-paste-url*) nil) +

1 0