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