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

.

Browse Source 
original commit: fe4e22b161029d786b5231fc42d8bf5c0396381a
This commit is contained in:
Matthew Flatt 2005-05-06 21:20:13 +00:00
parent 6d327e00cb
commit 662aebd744
1 changed files with 25 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

63
collects/net/mime-unit.ss
View File

@ -197,19 +197,6 @@
(lambda () (lambda ()
(make-message 1.0 (make-default-entity) null))) (make-message 1.0 (make-default-entity) null)))
;; Convert CRLF in input stream to LF
(define (convert-crlf input)
(let-values ([(f-input o) (make-pipe 4096)])
(thread (lambda ()
(let loop ()
(when (regexp-match #"\r\n" input
0 #f o)
(newline o)
(loop)))
(close-output-port o)))
f-input))
(define mime-decode (define mime-decode
(lambda (entity input) (lambda (entity input)
(set-entity-body! (set-entity-body!
@ -217,16 +204,13 @@
(case (entity-encoding entity) (case (entity-encoding entity)
((quoted-printable) ((quoted-printable)
(lambda (output) (lambda (output)
;; Convert CRLF in input stream to LF, since (qp-decode-stream input output)))
;; the qp decoder will keep the newline
;; convention intact
(qp-decode-stream (convert-crlf input) output)))
((base64) ((base64)
(lambda (output) (lambda (output)
(base64-decode-stream input output))) (base64-decode-stream input output)))
(else ;; 7bit, 8bit, binary (else ;; 7bit, 8bit, binary
(lambda (output) (lambda (output)
(copy-port (convert-crlf input) output))))))) (copy-port input output)))))))
(define mime-analyze (define mime-analyze
(opt-lambda (input (part #f)) (opt-lambda (input (part #f))
@ -280,28 +264,31 @@
;; Returns a list of input ports, each one containing the correspongind part. ;; Returns a list of input ports, each one containing the correspongind part.
(define multipart-body (define multipart-body
(lambda (input boundary) (lambda (input boundary)
(let ([re:done (regexp (string-append "^--" (regexp-quote boundary) "--"))] (let* ([make-re (lambda (prefix)
[re:sep (regexp (string-append "^--" (regexp-quote boundary)))]) (regexp (string-append prefix "--" (regexp-quote boundary) "(--)?\r\n")))]
[re (make-re "\r\n")])
(letrec ((eat-part (lambda () (letrec ((eat-part (lambda ()
(let-values ([(pin pout) (make-pipe)]) (let-values ([(pin pout) (make-pipe)])
(let loop ((ln (read-bytes-line input))) (let ([m (regexp-match re input 0 #f pout)])
(cond ((eof-object? ln) (cond
(close-output-port pout) [(not m)
(values pin;; part (close-output-port pout)
#f;; close-delimiter? (values pin;; part
#t;; eof reached? #f;; close-delimiter?
)) #t;; eof reached?
((regexp-match-positions re:done ln) )]
(close-output-port pout) [(cadr m)
(values pin #t #f)) (close-output-port pout)
((regexp-match-positions re:sep ln) (values pin #t #f)]
(close-output-port pout) [else
(values pin #f #f)) (close-output-port pout)
(else (values pin #f #f)]))))))
(write-bytes ln pout) ;; pre-amble is allowed to be completely empty:
(newline pout) (if (regexp-match-peek (make-re "^") input)
(loop (read-bytes-line input))))))))) ;; No \r\f before first separator:
(eat-part) ;; preamble (read-line input)
;; non-empty preamble:
(eat-part))
(let loop () (let loop ()
(let-values ([(part close? eof?) (eat-part)]) (let-values ([(part close? eof?) (eat-part)])
(cond (close? (list part)) (cond (close? (list part))