blob: 8b065954d0dde7bdee683363c57661f7ba9fe8d9 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
|
;;;
;;; anubis.scm
;;;
;;; This file is part of GNU Anubis.
;;; Copyright (C) 2003-2024 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 3 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, see <http://www.gnu.org/licenses/>.
(define debug-level 0)
(define (DEBUG level . rest)
(if (>= debug-level level)
(with-output-to-port
(current-error-port)
(lambda ()
(display "DEBUG(")
(display level)
(display "):")
(for-each (lambda (x)
(display x))
rest)
(newline)))))
;;; The function below illustrates the concept of Anubis message
;;; processing functions.
;;; A processing function takes two required and any number of
;;; optional arguments. The required arguments are:
;;;
;;; HDR -- A list of message headers. Each list element is a cons
;;; (NAME . VALUE), where NAME is the name of the header field,
;;; and VALUE is its VALUE with final CRLF stripped off.
;;; BODY -- The message body.
;;;
;;; The rest of arguments are collected from the invocation string in
;;; the configuration file and passed to the function.
;;;
;;; The function is expected to return cons:
;;;
;;; (NEW-HDR . NEW-BODY)
;;;
;;; where
;;; NEW-HDR is the new header list, or #t to indicate that the headers
;;; are not changed.
;;; NEW-BODY is a string representing the new body or a boolean with
;;; the following meaning:
;;; #f -- delete entire body.
;;; #t -- preserve the body as is.
(define (sample-process-message hdr body . rest)
"If the Subject: field starts with characters \"ODP:\", replace
them with \"Re:\".
If REST is not empty, append its car to BODY"
(DEBUG 1 "rewrite-subject called with hdr=" hdr " and body=\"" body "\"")
(DEBUG 2 "optional args=" rest)
(cons (append
(map (lambda (x)
(if (and (string-ci=? (car x) "subject")
(string-ci=? (substring (cdr x) 0 4) "ODP:"))
(cons (car x)
(string-append "Re:"
(substring (cdr x) 4)))
x))
hdr)
(list (cons "X-Processed-By" "GNU Anubis")))
(if (null? rest)
#t
(string-append body "\n" (car rest)))))
;; To test your output redirection:
(DEBUG 1 "LOADED anubis.scm")
|