diff options
| -rw-r--r-- | haunt/jakob/dynamic/capabilities/comment-form.scm | 13 | ||||
| -rw-r--r-- | haunt/jakob/dynamic/capabilities/comments.scm | 8 | ||||
| -rw-r--r-- | haunt/jakob/dynamic/captcha.scm | 23 | ||||
| -rw-r--r-- | haunt/static/css/style.css | 18 |
4 files changed, 36 insertions, 26 deletions
diff --git a/haunt/jakob/dynamic/capabilities/comment-form.scm b/haunt/jakob/dynamic/capabilities/comment-form.scm index 70e5303..1754dfd 100644 --- a/haunt/jakob/dynamic/capabilities/comment-form.scm +++ b/haunt/jakob/dynamic/capabilities/comment-form.scm @@ -30,14 +30,13 @@ #:export (get-comment-form)) (define (render-comment-form slug) - (let-values (((mac solution captcha-image) (new-captcha))) + (let-values (((captcha-id captcha-image) (new-captcha!))) `((div (@ (id "comment-form")) (h1 "Comment form") (form (@ (id "comment-input") (action "/api/comment") (method "post")) (input (@ (type "text") (name "slug") (hidden #t) (value ,slug))) - (input (@ (type "text") (name "solution") (hidden #t) (value ,solution))) - (input (@ (type "text") (name "solution-mac") (hidden #t) (value ,mac))) - (fieldset + (input (@ (type "text") (name "captcha-id") (hidden #t) (value ,captcha-id))) + (fieldset (@ (id "commenter-info")) (legend "Commenter Info") (label (@ (for "name")) "Name:") (input (@ (type "text") (id "name") (name "name") (required #t) (size 24))) @@ -45,15 +44,15 @@ (input (@ (type "text") (id "email") (name "email") (size 24))) (label (@ (for "url")) "Webpage URL (optional):") (input (@ (type "text") (id "url") (name "url") (size 24)))) - (fieldset + (fieldset (@ (id "comment-content")) (legend "Comment") (label (@ (for "subject")) "Subject (optional):") (input (@ (type "text") (id "subject") (name "subject") (size 24))) (label (@ (for "comment")) "Comment :") (textarea (@ (id "coment") (name "comment") (rows 4) (cols 50)))) - (fieldset + (fieldset (@ (id "comment-captcha")) (legend "Captcha") - (label (@ (for "captcha")) "Captcha:") + (label (@ (for "captcha")) "Please evaluate the following definite integral:") (img (@ (src ,(format #f "data:image/jpeg;charset=utf-8;base64,~a" (base64-encode captcha-image))))) (input (@ (type "text") (id "captcha") (name "captcha") (size 24))) diff --git a/haunt/jakob/dynamic/capabilities/comments.scm b/haunt/jakob/dynamic/capabilities/comments.scm index 3e873a6..72067b4 100644 --- a/haunt/jakob/dynamic/capabilities/comments.scm +++ b/haunt/jakob/dynamic/capabilities/comments.scm @@ -81,12 +81,10 @@ This is a wrapper around `get-comments-by-slug'." (assoc "name" form-data) (assoc "comment" form-data) (assoc "captcha" form-data) - (assoc "solution" form-data) - (assoc "solution-mac" form-data) - (validate-captcha + (assoc "captcha-id" form-data) + (validate-captcha! (assoc-value form-data "captcha") - (assoc-value form-data "solution") - (assoc-value form-data "solution-mac")))) + (string->number (assoc-value form-data "captcha-id"))))) (define (insert-comment form-data) (exec-query conn "INSERT INTO comments (submitted, slug, name, subject, diff --git a/haunt/jakob/dynamic/captcha.scm b/haunt/jakob/dynamic/captcha.scm index 61f1d33..4cb62d3 100644 --- a/haunt/jakob/dynamic/captcha.scm +++ b/haunt/jakob/dynamic/captcha.scm @@ -38,8 +38,8 @@ release-id! dequeue-id! - new-captcha - validate-captcha)) + new-captcha! + validate-captcha!)) (define-record-type <id-queue> (make-id-queue mutex min-free-threshold free-ids allocated-ids) @@ -121,11 +121,9 @@ internally-defined `time-to-live-seconds'." -(define max-challenges 1024) (define proc-mutex (make-mutex)) -(define tex-challenge-id-queue (iota max-challenges)) -(define tex-challenge-allocated-id-queue (list)) -(define tex-challenges (make-hash-table max-challenges)) +(define tex-challenge-id-queue (make-queue 1024)) +(define tex-challenges (make-hash-table 1024)) (define (random-term) (match (random 5) @@ -210,7 +208,7 @@ internally-defined `time-to-live-seconds'." (latex-src (sexp->latex (simplify-sexp (differentiate-sexp expression)))) (solution (- (local-eval expression (let ((x upper-bound)) (the-environment))) (local-eval expression (let ((x lower-bound)) (the-environment))))) - (id (dequeue-id! tex-challenge-id-queue tex-challenge-allocated-id-queue))) + (id (dequeue-id! tex-challenge-id-queue))) (hash-set! tex-challenges id solution) (values id (latex->image (format #f "\\int_{~a}^{~a} ~a \\, dx" @@ -218,13 +216,14 @@ internally-defined `time-to-live-seconds'." upper-bound latex-src))))) -(define (validate-captcha! answer id) +(define (validate-captcha! user-answer id) (define epsilon 0.1) - (let ((solution (hash-ref tex-challenges id))) - (when solution - (release-id! id tex-challenge-id-queue tex-challenge-allocated-id-queue)) + (let ((solution (hash-ref tex-challenges id)) + (id-allocated (not (member id (id-queue-free tex-challenge-id-queue))))) + (when solution (release-id! id tex-challenge-id-queue)) (and solution - (<= (abs (- solution (string->number answer))) + id-allocated + (<= (abs (- solution (string->number user-answer))) epsilon)))) diff --git a/haunt/static/css/style.css b/haunt/static/css/style.css index 4f6def3..215a08c 100644 --- a/haunt/static/css/style.css +++ b/haunt/static/css/style.css @@ -249,18 +249,32 @@ ul#webmention-container .comment .comment-source-identifier { /* Comment form. */ -#comment-form label { +#comment-form #commenter-info label, +#comment-form #comment-content label { display: block; width: 20em; float: left; clear: left; } -#comment-form input { +#comment-form label, #comment-form input { + margin-top: 1em; +} + +#comment-form #commenter-info input, +#comment-form #comment-content input { width: 20em; float: left; } +#comment-form #comment-captcha input { + display: block; +} + +#comment-form img { + max-width: 100%; +} + /* Source code. */ pre { |