Welcome to the CHICKEN Scheme pasting service
GET and POST for /paste added by mario-goulart on Mon Oct 3 19:03:15 2011
diff --git a/pastiche.scm b/pastiche.scm
index 2900823..4ebd957 100644
--- a/pastiche.scm
+++ b/pastiche.scm
@@ -263,65 +263,66 @@
(navigation-links)))
title: "Pastiche: the Chicken Scheme pasting service")
- (define-page "paste"
- (lambda ()
- (let ((paste-title "Untitled paste"))
- (with-request-variables ((nick (nonempty as-string))
- (title (nonempty as-string))
- paste
- id)
- (html-page
+ (define (handle-pastes)
+ (let ((paste-title "Untitled paste"))
+ (with-request-variables ((nick (nonempty as-string))
+ (title (nonempty as-string))
+ paste
+ id)
+ (html-page
+ (++
+ ( id: "content"
+ (or (and-let* ((nick (or (and nick (htmlize nick)) "anonymous"))
+ (title (or (and title (htmlize title)) "no title"))
+ (time (current-seconds))
+ (paste (and (not (equal? "" paste)) paste))
+ (hashsum (string->sha1sum
+ (++ nick title (->string time) paste)))
+ (url '())
+ (snippet (map
+ (lambda (i)
+ (if (and (string? i) (string-null? i))
+ "anonymous"
+ i))
+ (list nick title time paste))))
+ (if (and use-captcha?
+ (not (equal? ($ 'captcha-user-answer)
+ (and-let* ((hash ($ 'captcha-hash))
+ (captcha (alist-ref hash captchas equal?)))
+ (captcha-string captcha)))))
+ (bail-out "Wrong captcha answer.")
+ (if (string-null? paste)
+ (bail-out "I am not storing empty pastes.")
+ (begin (cond ((fetch-paste id)
+ => (lambda (p)
+ (let ((count (+ 1 (length (cdr p)))))
+ (update-paste id snippet)
+ (set! url (make-pathname
+ base-path
+ (++ "paste?id=" id "#a" (->string count)))))))
+ (else (insert-paste hashsum snippet)
+ (set! url (make-pathname base-path (++ "paste?id=" hashsum)))))
+ (set! paste-title title)
+ (when ($ 'notify-irc) (notify nick title url))
+ (++ ( align: "center" "Thanks for your paste!")
+ (
"Hi " nick ", thanks for pasting: " ( title) (
))
+ ( align: "center") "Your paste can be reached with this url: " (link url url))))))
+ (cond ((fetch-paste id)
+ => (lambda (p)
+ (set! paste-title (third (last p)))
(++
- (
id: "content"
- (or (and-let* ((nick (or (and nick (htmlize nick)) "anonymous"))
- (title (or (and title (htmlize title)) "no title"))
- (time (current-seconds))
- (paste (and (not (equal? "" paste)) paste))
- (hashsum (string->sha1sum
- (++ nick title (->string time) paste)))
- (url '())
- (snippet (map
- (lambda (i)
- (if (and (string? i) (string-null? i))
- "anonymous"
- i))
- (list nick title time paste))))
- (if (and use-captcha?
- (not (equal? ($ 'captcha-user-answer)
- (and-let* ((hash ($ 'captcha-hash))
- (captcha (alist-ref hash captchas equal?)))
- (captcha-string captcha)))))
- (bail-out "Wrong captcha answer.")
- (if (string-null? paste)
- (bail-out "I am not storing empty pastes.")
- (begin (cond ((fetch-paste id)
- => (lambda (p)
- (let ((count (+ 1 (length (cdr p)))))
- (update-paste id snippet)
- (set! url (make-pathname
- base-path
- (++ "paste?id=" id "#a" (->string count)))))))
- (else (insert-paste hashsum snippet)
- (set! url (make-pathname base-path (++ "paste?id=" hashsum)))))
- (set! paste-title title)
- (when ($ 'notify-irc) (notify nick title url))
- (++ ( align: "center" "Thanks for your paste!")
- (
"Hi " nick ", thanks for pasting: " ( title) (
))
- ( align: "center") "Your paste can be reached with this url: " (link url url))))))
- (cond ((fetch-paste id)
- => (lambda (p)
- (set! paste-title (third (last p)))
- (++
- (format-all-snippets p)
- (
id: "paste-footer"
- ( align: "center"
- (link (++ base-path "?id=" id
- ";annotate=t") "Annotate this paste!"))))))
- (else (bail-out "Could not find a paste with this id:" id)))))
- (navigation-links))
- css: (page-css)
- title: paste-title))))
- no-template: #t)
+ (format-all-snippets p)
+ ( id: "paste-footer"
+ ( align: "center"
+ (link (++ base-path "?id=" id
+ ";annotate=t") "Annotate this paste!"))))))
+ (else (bail-out "Could not find a paste with this id:" id)))))
+ (navigation-links))
+ css: (page-css)
+ title: paste-title))))
+
+ (define-page "paste" handle-pastes method: 'GET)
+ (define-page "paste" handle-pastes method: 'POST)
(define-page "raw"
(lambda ()
Your annotation:
Enter a new annotation: