1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59

(define-module (plugin captcha-plaintext)
  #:use-module (utils)
  #:use-module (crypto)
  #:use-module (webserver-utils)
  #:use-module (plugin captcha-interface)
  #:export (captcha-plaintext
            captcha-plaintext-with-wordlist
            make-captcha-plaintext-with-wordlist))

(define (input-field-name challenge)
  (string-append "plaintext-captcha-"
                 (assoc-ref challenge 'id)))

(define (generate-challenge)
  `((string . ,(random-string-in-collection 15 char-collection-alpha-numeric))
    (id . ,(random-string-in-collection 15 char-collection-alpha-numeric))))


(define (generate-challenge-with-wordvector wordvector)
  `((string . ,(vector-pick-random wordvector))
    (id . ,(random-string-in-collection 15 char-collection-alpha-numeric))))
(define (generate-challenge-with-wordlist wordlist)
  (generate-challenge-with-wordvector (list->vector wordlist)))

(define (render-challenge challenge)
  `(div (@ (class "captcha plaintext"))
        (span ,(string-append
                "Please copy the following string into the form below"
                " to proof your minimal intelligence: "
                (assoc-ref challenge 'string)))
        (label (@ (style ("display: block;")))
               (span (@ (class "text")) "Captcha:")
               (input (@ (name ,(input-field-name challenge))
                         (type "text")))
               (input (@ (type "submit")
                         (value "Verify"))))))

(define (validate-input challenge get-form-field)
  (define input (get-form-field (input-field-name challenge)))
  (and (string? input)
       (string=? (assoc-ref challenge 'string) input)))

(define default-wordlist
  '("mislead" "distort" "abuse" "irritate" "frustrate" "invade" "violate"))

(define* (make-captcha-plaintext-with-wordlist #:optional (wordlist default-wordlist))
  (make-captcha-plugin 'captcha-plaintext-with-wordlist
                       (lambda () (generate-challenge-with-wordlist wordlist))
                       render-challenge
                       validate-input))

(define captcha-plaintext-with-wordlist
  (make-captcha-plaintext-with-wordlist))

(define captcha-plaintext
  (make-captcha-plugin 'captcha-plaintext
                       generate-challenge
                       render-challenge
                       validate-input))