summaryrefslogtreecommitdiffabout
path: root/guile
authorSergey Poznyakoff <gray@gnu.org.ua>2003-03-06 19:03:06 (GMT)
committer Sergey Poznyakoff <gray@gnu.org.ua>2003-03-06 19:03:06 (GMT)
commitff161ee0c0d3c220be2083461830c7a8f358fede (patch) (side-by-side diff)
treec2f0fab53d6e692f029aaa1e3dd6383508e1c91d /guile
parentcade150bf8160685c58048c5a429a80232f9350c (diff)
downloadanubis-ff161ee0c0d3c220be2083461830c7a8f358fede.tar.gz
anubis-ff161ee0c0d3c220be2083461830c7a8f358fede.tar.bz2
Added to the repository
Diffstat (limited to 'guile') (more/less context) (ignore whitespace changes)
-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
--- a/dev/null
+++ b/guile/Makefile.am
@@ -0,0 +1,30 @@
+##
+## guile/Makefile.am
+##
+## This file is part of GNU Anubis.
+## Copyright (C) 2003 The Anubis Team.
+##
+## GNU Anubis 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 2 of the License, or
+## (at your option) any later version.
+##
+## GNU Anubis 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 GNU Anubis; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+##
+## GNU Anubis is released under the GPL with the additional exemption that
+## compiling, linking, and/or using OpenSSL is allowed.
+##
+
+GUILE_SCM = rot-13.scm remailer.scm
+pkgdata_DATA = @GUILE_SCRIPTS@
+EXTRA_DIST = rot-13.scm remailer.scm
+
+## EOF
+
diff --git a/guile/remailer.scm b/guile/remailer.scm
new file mode 100644
index 0000000..a31512c
--- a/dev/null
+++ b/guile/remailer.scm
@@ -0,0 +1,67 @@
+;;;; GNU Anubis -- an outgoing mail processor and the SMTP tunnel.
+;;;; Copyright (C) 2003 The Anubis Team.
+;;;;
+;;;; GNU Anubis 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 2 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; GNU Anubis 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 GNU Anubis; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+;;;;
+;;;; GNU Anubis is released under the GPL with the additional exemption that
+;;;; compiling, linking, and/or using OpenSSL is allowed.
+
+(define (get-opt-arg opt-args tag)
+ (cond
+ ((member tag opt-args) =>
+ (lambda (x)
+ (car (cdr x))))
+ (else
+ #f)))
+
+(define (remailer-I hdr body . rest)
+ "Reformat the body of the message so it can be used with type-I remailers.
+Keyword arguments are:
+ #:rrt address -- Add Anon-To: header
+ #:post address -- Add Anon-Post-To: header
+ #:latent time -- Add Latent-Time: header
+ #:random -- Add random suffix to the latent time.
+ #:header header -- Add remailer header"
+ (let* ((pfx (string-append
+ (cond
+ ((get-opt-arg rest #:rrt) =>
+ (lambda (x)
+ (string-append "Anon-To: " x "\n")))
+ (else
+ ""))
+ (cond
+ ((get-opt-arg rest #:post) =>
+ (lambda (x)
+ (string-append "Anon-Post-To: " x "\n")))
+ (else
+ ""))
+ (cond
+ ((get-opt-arg rest #:latent) =>
+ (lambda (x)
+ (string-append "Latent-Time: +" x
+ (if (member #:random rest) "r" "") "\n")))
+ (else
+ ""))
+ (cond
+ ((get-opt-arg rest #:header) =>
+ (lambda (x)
+ (string-append "##\n" x "\n")))
+ (else
+ "")))))
+ (if (string-null? pfx)
+ (cons #t #t)
+ (cons #t (string-append "::\n" pfx "\n" body)))))
+
+;;;; 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
--- a/dev/null
+++ b/guile/rot-13.scm
@@ -0,0 +1,36 @@
+;;;; GNU Anubis -- an outgoing mail processor and the SMTP tunnel.
+;;;; Copyright (C) 2003 The Anubis Team.
+;;;;
+;;;; GNU Anubis 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 2 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; GNU Anubis 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 GNU Anubis; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+;;;;
+;;;; GNU Anubis is released under the GPL with the additional exemption that
+;;;; compiling, linking, and/or using OpenSSL is allowed.
+
+(define (rot-13 text)
+ "Encode the text using ROT-13 method"
+ (let ((length (string-length text)))
+ (do ((i 0 (1+ i)))
+ ((>= i length) text)
+ (let ((c (string-ref text i)))
+ (cond
+ ((char-lower-case? c)
+ (string-set! text i
+ (integer->char
+ (+ 97 (modulo (+ (- (char->integer c) 97) 13) 26)))))
+ ((char-upper-case? c)
+ (string-set! text i
+ (integer->char
+ (+ 65 (modulo (+ (- (char->integer c) 65) 13) 26))))))))))
+

Return to:

Send suggestions and report system problems to the System administrator.