1;;;
2;;; remailer.scm
3;;;
4;;; This file is part of GNU Anubis.
5;;; Copyright (C) 2003-2014 The Anubis Team.
6;;;
7;;; GNU Anubis is free software; you can redistribute it and/or modify it
8;;; under the terms of the GNU General Public License as published by the
9;;; Free Software Foundation; either version 3 of the License, or (at your
10;;; 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 along
18;;; with GNU Anubis.  If not, see <http://www.gnu.org/licenses/>.
19
20(define (get-opt-arg opt-args tag)
21  (cond
22   ((member tag opt-args) =>
23    (lambda (x)
24      (car (cdr x))))
25   (else
26    #f)))
27
28(define (remailer-I hdr body . rest)
29  "Reformat the body of the message so it can be used with type-I remailers.
30Keyword arguments are:
31	#:rrt address	--	Add Anon-To: header
32	#:post address	--	Add Anon-Post-To: header
33	#:latent time	--	Add Latent-Time: header
34	#:random	--	Add random suffix to the latent time.
35	#:header header	--	Add remailer header"
36  (let* ((pfx (string-append
37	      (cond
38	       ((get-opt-arg rest #:rrt) =>
39		(lambda (x)
40		  (string-append "Anon-To: " x "\n")))
41	       (else
42		""))
43	      (cond
44	       ((get-opt-arg rest #:post) =>
45		(lambda (x)
46		  (string-append "Anon-Post-To: " x "\n")))
47	       (else
48		""))
49	      (cond
50	       ((get-opt-arg rest #:latent) =>
51		(lambda (x)
52		  (string-append "Latent-Time: +" x
53				 (if (member #:random rest) "r" "") "\n")))
54	       (else
55		""))
56	      (cond
57	       ((get-opt-arg rest #:header) =>
58		(lambda (x)
59		  (string-append "##\n" x "\n")))
60	       (else
61		"")))))
62    (if (string-null? pfx)
63	(cons #t #t)
64	(cons #t (string-append "::\n" pfx "\n" body)))))
65
66;;;; End of remailer.scm
67