diff options
-rw-r--r-- | mumi/web/controller.scm | 40 |
1 files changed, 40 insertions, 0 deletions
diff --git a/mumi/web/controller.scm b/mumi/web/controller.scm index 62a9b00..b787539 100644 --- a/mumi/web/controller.scm +++ b/mumi/web/controller.scm @@ -27,6 +27,7 @@ #:use-module (gcrypt base64) #:use-module (gcrypt mac) #:use-module (mumi config) + #:use-module (mumi jobs) #:use-module (mumi messages) #:use-module (mumi web render) #:use-module (mumi web download) @@ -115,6 +116,45 @@ (render-html (issue-page bug message) #:extra-headers headers)) (render-html (unknown id))))) + (('POST "issue" (? string->number id) "comment") + (if (mailer-enabled?) + (let ((headers (request-headers request)) + (form-data (parse-form-submission request body)) + (cookie (or (session-data %session-manager request) + '()))) + (if (and + ;; The encrypted cookie must be fresh and contain the + ;; current issue id. + (and=> (assoc-ref cookie 'issue-id) + (cut string=? id <>)) + ;; The request must come with a local referer + (and=> (assoc-ref headers 'referer) + (lambda (referer) + (equal? (uri-host referer) + (and=> (assoc-ref headers 'host) first)))) + ;; The honeypot field "validation" must remain empty + (let ((val (assoc-ref form-data 'validation))) + (and val (string-null? (string-trim-both val)))) + ;; Submission may not have happened too quickly + (let ((time (assoc-ref form-data 'timestamp))) + (and time (reasonable-timestamp? time))) + ;; Message must not be too short + (and=> (assoc-ref form-data 'text) + (lambda (text) + (> (string-length (string-trim-both text)) 10))) + ;; Message must have sender + (and=> (assoc-ref form-data 'from) + (compose (negate string-null?) string-trim-both))) + (begin + ;; Send comment to list + (enqueue 'mail + `((from . ,(string-trim-both (assoc-ref form-data 'from))) + (to . ,(format #f "~a@~a" + id (%config 'debbugs-domain))) + (text . ,(assoc-ref form-data 'text)))) + (redirect (list "issue" id) "comment-ok")) + (redirect (list "issue" id) "comment-error"))) + (redirect (list "issue" id) "comment-error"))) (('GET "issue" (? string->number id) "attachment" (? string->number msg-num) (? string->number path) ...) |