18 |
;;;; GNU Anubis is released under the GPL with the additional exemption that |
;;;; GNU Anubis is released under the GPL with the additional exemption that |
19 |
;;;; compiling, linking, and/or using OpenSSL is allowed. |
;;;; compiling, linking, and/or using OpenSSL is allowed. |
20 |
|
|
21 |
(define (rot-13 text) |
(define (rot-13-text input) |
22 |
"Encode the text using ROT-13 method" |
"Encode the text using ROT-13 method" |
23 |
(let ((length (string-length text))) |
(let* ((text (string-append "" input)) |
24 |
|
(length (string-length text))) |
25 |
(do ((i 0 (1+ i))) |
(do ((i 0 (1+ i))) |
26 |
((>= i length) text) |
((>= i length) text) |
27 |
(let ((c (string-ref text i))) |
(let ((c (string-ref text i))) |
35 |
(integer->char |
(integer->char |
36 |
(+ 65 (modulo (+ (- (char->integer c) 65) 13) 26)))))))))) |
(+ 65 (modulo (+ (- (char->integer c) 65) 13) 26)))))))))) |
37 |
|
|
38 |
|
(define (rot-13 hdr body . rest) |
39 |
|
(let ((rs (lambda (h) |
40 |
|
(map (lambda (x) |
41 |
|
(if (string-ci=? (car x) "subject") |
42 |
|
(cons (car x) (rot-13-text (cdr x))) |
43 |
|
x)) |
44 |
|
h)))) |
45 |
|
(if (null? rest) |
46 |
|
(cons (rs hdr) (rot-13-text body)) |
47 |
|
(cons (if (member #:subject rest) |
48 |
|
(rs hdr) |
49 |
|
#t) |
50 |
|
(if (member #:body rest) |
51 |
|
(rot-13-text body) |
52 |
|
#t))))) |