diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2003-03-07 13:08:46 +0000 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2003-03-07 13:08:46 +0000 |
commit | 7910549a2676dfb8d8efb88386e4f406fca2bd0e (patch) | |
tree | 6053bc79259ac0d33f38e3188d342bb7a3c7d605 /examples | |
parent | 507f036c2d7695750afeeda41eff10986241bd0a (diff) | |
download | anubis-7910549a2676dfb8d8efb88386e4f406fca2bd0e.tar.gz anubis-7910549a2676dfb8d8efb88386e4f406fca2bd0e.tar.bz2 |
Major changes.
Diffstat (limited to 'examples')
-rw-r--r-- | examples/anubis.scm | 90 |
1 files changed, 22 insertions, 68 deletions
diff --git a/examples/anubis.scm b/examples/anubis.scm index a88f7d3..7f6968b 100644 --- a/examples/anubis.scm +++ b/examples/anubis.scm @@ -33,57 +33,19 @@ rest) (newline))))) -;;; A couple of auxiliary functions - -(define (isspace? c) - "Return #t if the character is a whitespace one" - (case c - ((#\space #\tab) #t) - (else #f))) - -(define (header->pair x) - "Convert RFC822 header string into cons (HEADER-NAME . VALUE), -where HEADER-NAME is a Scheme internal symbol representing the header name -(all downcase) and VALUE is the string containing the header value" - (let ((pos (string-index x #\:))) - (if pos - (cons - (string->symbol (string-downcase (substring x 0 pos))) - (let ((len (string-length x))) - (do ((i (1+ pos) (1+ i))) - ((or (= i len) - (not (isspace? (string-ref x i)))) - (substring x i))))) - #f))) - -(define (rewrite-subject subj) - "Rewrite the subject line. If the value of the subject line begins -with \"ODP:\", replace it with \"Re:\". The original value of the subject -is preserved in X-Anubis-Preserved-Header header" - (DEBUG 1 "rewrite-subject called with " subj) - (let ((hdr (header->pair subj))) - (cond - ((eq? (car hdr) 'subject) - (let ((val (header->pair (cdr hdr)))) - (cond - ((not val) - #t) - ((eq? (car val) 'odp) - (list - (string-append "Subject: Re: " (cdr val) "\n") - (string-append "X-Anubis-Preserved-Header: " (cdr hdr)))) - (else #t)))) - (else #t)))) - -;;; The three functions below illustrate the concept of Anubis message +;;; The function below illustrates the concept of Anubis message ;;; processing functions. -;;; A processing function takes two arguments: +;;; 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) @@ -96,35 +58,27 @@ is preserved in X-Anubis-Preserved-Header header" ;;; #f -- delete entire body. ;;; #t -- preserve the body as is. -(define (anubis-rot-13-all hdr body) - "Encode the \"Subject\" header and the body using ROT-13. Add -X-Processed-By header." - (DEBUG 1 "anubis-rot-13-all called with hdr=" hdr " and body=\"" body "\"") +(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 (string-ci=? (car x) "subject") - (cons (car x) (rot-13 (cdr 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"))) - (rot-13 body))) - -(define (anubis-rot-13-header hdr body . rest) - "Encode the \"Subject\" header using ROT-13." - (DEBUG 1 "anubis-rot-13-header called with hdr=" hdr - " and body=\"" body "\" and rest=" rest ";") - (cons (map (lambda (x) - (if (string-ci=? (car x) "subject") - (cons (car x) (rot-13 (cdr x))) - x)) - hdr) - #t)) - -(define (anubis-rot-13-body hdr body) - "Encode the message body using ROT-13." - (DEBUG 1 "anubis-rot-13-body called with hdr=" hdr " and body=\"" body "\"") - (cons #t - (rot-13 body))) + (if (null? rest) + #t + (string-append body "\n" (car rest))))) ;; To test your output redirection: (DEBUG 1 "LOADED anubis.scm") |