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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
;;; Copyright © 2019 - 2022 Jakob L. Kreuze <zerodaysfordays@sdf.org>
;;;
;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as
;;; published by the Free Software Foundation; either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program. If not, see
;;; <http://www.gnu.org/licenses/>.
(define-module (captcha)
#:use-module (ice-9 binary-ports)
#:use-module (ice-9 local-eval)
#:use-module (ice-9 match)
#:use-module (ice-9 popen)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 threads)
#:use-module (srfi srfi-1)
#:export (new-captcha))
(define proc-mutex (make-mutex))
(define (random-term)
(match (random 5)
(0 `(* ,(+ 1 (random 10)) x))
(1 `(* ,(+ 1 (random 10)) (expt x ,(random 10))))
(2 `(* ,(+ 1 (random 10)) (exp x)))
(3 `(* ,(+ 1 (random 10)) (cos x)))
(4 `(* ,(+ 1 (random 10)) (sin x)))))
(define (sexp->latex sexp)
(match sexp
(('+ rest ...) (string-join (map sexp->latex rest) " + "))
(('* rest ...) (string-join (map sexp->latex rest) " \\cdot "))
(('sin term) (format #f "\\sin(~a)" (sexp->latex term)))
(('cos term) (format #f "\\cos(~a)" (sexp->latex term)))
(('expt term n) (format #f "~a^{~a}" (sexp->latex term) (sexp->latex n)))
(('exp term) (format #f "e^{~a}" (sexp->latex term)))
('x "x")
(n (cond ((and (number? n) (positive? n)) (format #f "~a" n))
((and (number? n) (negative? n)) (format #f "(~a)" n))
((number? n) "0")
(else (error "Do not know how to convert to latex." n))))))
(define (differentiate-sexp sexp)
(match sexp
(('+ rest ...) `(+ ,@(map differentiate-sexp rest)))
(('* coeff term) (if (number? coeff)
`(* ,coeff ,(differentiate-sexp term))
(error "Do not know how to differentiate.")))
(('sin term) `(* ,(differentiate-sexp term) (cos ,term)))
(('cos term) `(* -1 ,(differentiate-sexp term) (sin ,term)))
(('exp term) `(* ,(differentiate-sexp term) (exp ,term)))
(('expt term n) `(* ,n (expt ,term ,(- n 1))))
('x 1)
(n (if (number? n)
0
(error "Do not know how to differentiate.")))))
(define (simplify-sexp sexp)
(match sexp
(('+ rest ...) `(+ ,@(map simplify-sexp rest)))
(('* 1 term) (simplify-sexp term))
(('* 1 rest ...) (simplify-sexp `(* ,@rest)))
(('sin term) `(sin ,(simplify-sexp term)))
(('sin term) `(cos ,(simplify-sexp term)))
(('exp term) `(exp ,(simplify-sexp term)))
(('expt term 1) (simplify-sexp term))
(('expt term n) `(expt ,(simplify-sexp term) ,(simplify-sexp n)))
(term term)))
(define (random-expression)
(let ((n-terms (+ 2 (random 3))))
`(+ ,@(map (lambda (x) (random-term)) (iota n-terms)))))
(define (latex->image src)
(chdir "/tmp")
(with-mutex proc-mutex
(call-with-output-file "formula.tex"
(lambda (port)
(format port "\\def\\formula{~a}
\\documentclass[border=2pt]{standalone}
\\usepackage{amsmath}
\\usepackage{varwidth}
\\begin{document}
\\begin{varwidth}{\\linewidth}
\\[ \\formula \\]
\\end{varwidth}
\\end{document}
" src)))
(unless (eqv? 0 (status:exit-val (system "pdflatex formula.tex")))
(error "Cannot generate PDF"))
(let* ((port (open-input-pipe "convert -density 300 formula.pdf -quality 90 png:-"))
(data (get-bytevector-all port)))
(unless (eqv? 0 (status:exit-val (close-pipe port)))
(error "Cannot generate PNG"))
data)))
(define (new-uuid)
(with-mutex proc-mutex
(let* ((port (open-input-pipe "uuidgen"))
(str (read-line port)))
(close-pipe port)
str)))
(define (new-captcha)
(let* ((lower-bound (random 10))
(upper-bound (+ lower-bound 1 (random 9)))
(expression (random-expression))
(latex-src (sexp->latex (simplify-sexp (differentiate-sexp expression)))))
(values (new-uuid)
(- (local-eval expression (let ((x upper-bound)) (the-environment)))
(local-eval expression (let ((x lower-bound)) (the-environment))))
(latex->image (format #f "\\int_{~a}^{~a} ~a \\, dx"
lower-bound
upper-bound
latex-src)))))
|
