diff options
Diffstat (limited to 'haunt/jakob/dynamic/captcha.scm')
| -rw-r--r-- | haunt/jakob/dynamic/captcha.scm | 23 |
1 files changed, 11 insertions, 12 deletions
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)))) |