diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2003-03-06 19:03:06 +0000 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2003-03-06 19:03:06 +0000 |
commit | ff161ee0c0d3c220be2083461830c7a8f358fede (patch) | |
tree | c2f0fab53d6e692f029aaa1e3dd6383508e1c91d /guile | |
parent | cade150bf8160685c58048c5a429a80232f9350c (diff) | |
download | anubis-ff161ee0c0d3c220be2083461830c7a8f358fede.tar.gz anubis-ff161ee0c0d3c220be2083461830c7a8f358fede.tar.bz2 |
Added to the repository
Diffstat (limited to 'guile')
-rw-r--r-- | guile/Makefile.am | 30 | ||||
-rw-r--r-- | guile/remailer.scm | 67 | ||||
-rw-r--r-- | guile/rot-13.scm | 36 |
3 files changed, 133 insertions, 0 deletions
diff --git a/guile/Makefile.am b/guile/Makefile.am new file mode 100644 index 0000000..5910e8c --- /dev/null +++ b/guile/Makefile.am | |||
@@ -0,0 +1,30 @@ | |||
1 | ## | ||
2 | ## guile/Makefile.am | ||
3 | ## | ||
4 | ## This file is part of GNU Anubis. | ||
5 | ## Copyright (C) 2003 The Anubis Team. | ||
6 | ## | ||
7 | ## GNU Anubis is free software; you can redistribute it and/or modify | ||
8 | ## it under the terms of the GNU General Public License as published by | ||
9 | ## the Free Software Foundation; either version 2 of the License, or | ||
10 | ## (at your option) any later version. | ||
11 | ## | ||
12 | ## GNU Anubis is distributed in the hope that it will be useful, | ||
13 | ## but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
14 | ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
15 | ## GNU General Public License for more details. | ||
16 | ## | ||
17 | ## You should have received a copy of the GNU General Public License | ||
18 | ## along with GNU Anubis; if not, write to the Free Software | ||
19 | ## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA | ||
20 | ## | ||
21 | ## GNU Anubis is released under the GPL with the additional exemption that | ||
22 | ## compiling, linking, and/or using OpenSSL is allowed. | ||
23 | ## | ||
24 | |||
25 | GUILE_SCM = rot-13.scm remailer.scm | ||
26 | pkgdata_DATA = @GUILE_SCRIPTS@ | ||
27 | EXTRA_DIST = rot-13.scm remailer.scm | ||
28 | |||
29 | ## EOF | ||
30 | |||
diff --git a/guile/remailer.scm b/guile/remailer.scm new file mode 100644 index 0000000..a31512c --- /dev/null +++ b/guile/remailer.scm | |||
@@ -0,0 +1,67 @@ | |||
1 | ;;;; GNU Anubis -- an outgoing mail processor and the SMTP tunnel. | ||
2 | ;;;; Copyright (C) 2003 The Anubis Team. | ||
3 | ;;;; | ||
4 | ;;;; GNU Anubis is free software; you can redistribute it and/or modify | ||
5 | ;;;; it under the terms of the GNU General Public License as published by | ||
6 | ;;;; the Free Software Foundation; either version 2 of the License, or | ||
7 | ;;;; (at your option) any later version. | ||
8 | ;;;; | ||
9 | ;;;; GNU Anubis is distributed in the hope that it will be useful, | ||
10 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
11 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
12 | ;;;; GNU General Public License for more details. | ||
13 | ;;;; | ||
14 | ;;;; You should have received a copy of the GNU General Public License | ||
15 | ;;;; along with GNU Anubis; if not, write to the Free Software | ||
16 | ;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA | ||
17 | ;;;; | ||
18 | ;;;; GNU Anubis is released under the GPL with the additional exemption that | ||
19 | ;;;; compiling, linking, and/or using OpenSSL is allowed. | ||
20 | |||
21 | (define (get-opt-arg opt-args tag) | ||
22 | (cond | ||
23 | ((member tag opt-args) => | ||
24 | (lambda (x) | ||
25 | (car (cdr x)))) | ||
26 | (else | ||
27 | #f))) | ||
28 | |||
29 | (define (remailer-I hdr body . rest) | ||
30 | "Reformat the body of the message so it can be used with type-I remailers. | ||
31 | Keyword arguments are: | ||
32 | #:rrt address -- Add Anon-To: header | ||
33 | #:post address -- Add Anon-Post-To: header | ||
34 | #:latent time -- Add Latent-Time: header | ||
35 | #:random -- Add random suffix to the latent time. | ||
36 | #:header header -- Add remailer header" | ||
37 | (let* ((pfx (string-append | ||
38 | (cond | ||
39 | ((get-opt-arg rest #:rrt) => | ||
40 | (lambda (x) | ||
41 | (string-append "Anon-To: " x "\n"))) | ||
42 | (else | ||
43 | "")) | ||
44 | (cond | ||
45 | ((get-opt-arg rest #:post) => | ||
46 | (lambda (x) | ||
47 | (string-append "Anon-Post-To: " x "\n"))) | ||
48 | (else | ||
49 | "")) | ||
50 | (cond | ||
51 | ((get-opt-arg rest #:latent) => | ||
52 | (lambda (x) | ||
53 | (string-append "Latent-Time: +" x | ||
54 | (if (member #:random rest) "r" "") "\n"))) | ||
55 | (else | ||
56 | "")) | ||
57 | (cond | ||
58 | ((get-opt-arg rest #:header) => | ||
59 | (lambda (x) | ||
60 | (string-append "##\n" x "\n"))) | ||
61 | (else | ||
62 | ""))))) | ||
63 | (if (string-null? pfx) | ||
64 | (cons #t #t) | ||
65 | (cons #t (string-append "::\n" pfx "\n" body))))) | ||
66 | |||
67 | ;;;; End of remailer.scm \ No newline at end of file | ||
diff --git a/guile/rot-13.scm b/guile/rot-13.scm new file mode 100644 index 0000000..1a32e50 --- /dev/null +++ b/guile/rot-13.scm | |||
@@ -0,0 +1,36 @@ | |||
1 | ;;;; GNU Anubis -- an outgoing mail processor and the SMTP tunnel. | ||
2 | ;;;; Copyright (C) 2003 The Anubis Team. | ||
3 | ;;;; | ||
4 | ;;;; GNU Anubis is free software; you can redistribute it and/or modify | ||
5 | ;;;; it under the terms of the GNU General Public License as published by | ||
6 | ;;;; the Free Software Foundation; either version 2 of the License, or | ||
7 | ;;;; (at your option) any later version. | ||
8 | ;;;; | ||
9 | ;;;; GNU Anubis is distributed in the hope that it will be useful, | ||
10 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
11 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
12 | ;;;; GNU General Public License for more details. | ||
13 | ;;;; | ||
14 | ;;;; You should have received a copy of the GNU General Public License | ||
15 | ;;;; along with GNU Anubis; if not, write to the Free Software | ||
16 | ;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA | ||
17 | ;;;; | ||
18 | ;;;; GNU Anubis is released under the GPL with the additional exemption that | ||
19 | ;;;; compiling, linking, and/or using OpenSSL is allowed. | ||
20 | |||
21 | (define (rot-13 text) | ||
22 | "Encode the text using ROT-13 method" | ||
23 | (let ((length (string-length text))) | ||
24 | (do ((i 0 (1+ i))) | ||
25 | ((>= i length) text) | ||
26 | (let ((c (string-ref text i))) | ||
27 | (cond | ||
28 | ((char-lower-case? c) | ||
29 | (string-set! text i | ||
30 | (integer->char | ||
31 | (+ 97 (modulo (+ (- (char->integer c) 97) 13) 26))))) | ||
32 | ((char-upper-case? c) | ||
33 | (string-set! text i | ||
34 | (integer->char | ||
35 | (+ 65 (modulo (+ (- (char->integer c) 65) 13) 26)))))))))) | ||
36 | |||