aboutsummaryrefslogtreecommitdiff
path: root/guile
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org.ua>2003-03-06 19:03:06 +0000
committerSergey Poznyakoff <gray@gnu.org.ua>2003-03-06 19:03:06 +0000
commitff161ee0c0d3c220be2083461830c7a8f358fede (patch)
treec2f0fab53d6e692f029aaa1e3dd6383508e1c91d /guile
parentcade150bf8160685c58048c5a429a80232f9350c (diff)
downloadanubis-ff161ee0c0d3c220be2083461830c7a8f358fede.tar.gz
anubis-ff161ee0c0d3c220be2083461830c7a8f358fede.tar.bz2
Added to the repository
Diffstat (limited to 'guile')
-rw-r--r--guile/Makefile.am30
-rw-r--r--guile/remailer.scm67
-rw-r--r--guile/rot-13.scm36
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
25GUILE_SCM = rot-13.scm remailer.scm
26pkgdata_DATA = @GUILE_SCRIPTS@
27EXTRA_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.
31Keyword 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

Return to:

Send suggestions and report system problems to the System administrator.