suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix encoding after abbreviations expanded

Browse Source 
svn: r11167
This commit is contained in:
Matthew Flatt 2008-08-09 12:04:37 +00:00
parent 08d948e60e
commit cb777014b0
1 changed files with 10 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
collects/sirmail/sendr.ss
View File

@ -733,23 +733,21 @@
(let ([re (regexp (format "~a\n" SEPARATOR))]) (let ([re (regexp (format "~a\n" SEPARATOR))])
(let ([m (regexp-match-positions re message-str)]) (let ([m (regexp-match-positions re message-str)])
(if m (if m
(let ([header (re-encode-fields (let ([header (string-append
'("To" "CC" "BCC" "Subject") (string-lf->crlf (substring message-str 0 (caar m)))
(string-append (build-uptime-field message-count)
(string-lf->crlf (substring message-str 0 (caar m))) "\r\n"
(build-uptime-field message-count) empty-header)]
"\r\n"
empty-header))]
[body-lines (regexp-split [body-lines (regexp-split
#rx"\n" #rx"\n"
(substring message-str (cdar m) (string-length message-str)))]) (substring message-str (cdar m) (string-length message-str)))])
(validate-header header) (validate-header header)
(let* ([to* (sm-extract-addresses (extract-field "To" header))] (let* ([to* (sm-extract-addresses (extract-field "To" header))]
[to (map car to*)] [to (map encode-for-header (map car to*))]
[cc* (sm-extract-addresses (extract-field "CC" header))] [cc* (sm-extract-addresses (extract-field "CC" header))]
[cc (map car cc*)] [cc (map encode-for-header (map car cc*))]
[bcc* (sm-extract-addresses (extract-field "BCC" header))] [bcc* (sm-extract-addresses (extract-field "BCC" header))]
[bcc (map car bcc*)] [bcc (map encode-for-header (map car bcc*))]
[from (let ([l (extract-addresses (MAIL-FROM) 'full)]) [from (let ([l (extract-addresses (MAIL-FROM) 'full)])
(unless (= 1 (length l)) (unless (= 1 (length l))
(error 'send "bad mail-from configuration: ~a" (MAIL-FROM))) (error 'send "bad mail-from configuration: ~a" (MAIL-FROM)))
@ -758,12 +756,12 @@
(unless (= 1 (length l)) (unless (= 1 (length l))
(error 'send "bad mail-from configuration: ~a" (MAIL-FROM))) (error 'send "bad mail-from configuration: ~a" (MAIL-FROM)))
(car l))] (car l))]
[subject (extract-field "Subject" header)] [subject (encode-for-header (extract-field "Subject" header))]
[prop-header (remove-fields '("To" "CC" "BCC" "Subject") header)] [prop-header (remove-fields '("To" "CC" "BCC" "Subject") header)]
[std-header (standard-message-header from to cc bcc subject)] [std-header (standard-message-header from to cc bcc subject)]
[new-header (append-headers std-header prop-header)] [new-header (append-headers std-header prop-header)]
[tos (map cdr (append to* cc* bcc*))]) [tos (map cdr (append to* cc* bcc*))])
(as-background (as-background
enable enable
(lambda (break-bad break-ok) (lambda (break-bad break-ok)
@ -811,19 +809,6 @@
(message-box (message-box
"Error" "Error"
(format "Lost \"~a\" separator" SEPARATOR)))))) (format "Lost \"~a\" separator" SEPARATOR))))))
(define (re-encode-fields l header)
(cond
[(null? l) header]
[(extract-field (car l) header)
=> (lambda (v)
(re-encode-fields
(cdr l)
(replace-field
(car l)
(encode-for-header v)
header)))]
[else (re-encode-fields (cdr l) header)]))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Meta-Q Reflowing ;; ;; Meta-Q Reflowing ;;