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

.

Browse Source 
original commit: c2fa57b5d916546df9f1aacd4ae6ce75a2a18e08
This commit is contained in:
Matthew Flatt 2002-02-14 03:45:08 +00:00
parent c5a1b9e1be
commit b19dd4e482
1 changed files with 30 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -33,7 +33,8 @@
"head-sig.ss" "head-sig.ss"
"mime-util.ss" "mime-util.ss"
(lib "unitsig.ss") (lib "unitsig.ss")
(lib "etc.ss")) (lib "etc.ss")
(lib "string.ss"))
(provide net:mime@) (provide net:mime@)
(define net:mime@ (define net:mime@
@ -69,6 +70,7 @@
(define ietf-extensions '()) (define ietf-extensions '())
(define iana-extensions '(;; text (define iana-extensions '(;; text
("plain" . plain) ("plain" . plain)
("html" . html)
("richtext" . richtext) ("richtext" . richtext)
("tab-separated-values" . tab-separated-values) ("tab-separated-values" . tab-separated-values)
;; Multipart ;; Multipart
@ -279,6 +281,8 @@
;; 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) "--"))]
[re:sep (regexp (string-append "^--" (regexp-quote boundary)))])
(letrec ((eat-part (lambda () (letrec ((eat-part (lambda ()
(let-values ([(pin pout) (make-pipe)]) (let-values ([(pin pout) (make-pipe)])
(let loop ((ln (read-line input))) (let loop ((ln (read-line input)))
@ -288,17 +292,10 @@
#f;; close-delimiter? #f;; close-delimiter?
#t;; eof reached? #t;; eof reached?
)) ))
((regexp-match ((regexp-match re:done ln)
(regexp (string-append "^--"
boundary
"--"
)) ln)
(close-output-port pout) (close-output-port pout)
(values pin #t #f)) (values pin #t #f))
((regexp-match ((regexp-match re:sep ln)
(regexp (string-append "^--"
boundary
)) ln)
(close-output-port pout) (close-output-port pout)
(values pin #f #f)) (values pin #f #f))
(else (else
@ -310,7 +307,7 @@
(cond (close? (list part)) (cond (close? (list part))
(eof? null) (eof? null)
(else (else
(cons part (loop))))))))) (cons part (loop))))))))))
;; MIME-message-headers := entity-headers ;; MIME-message-headers := entity-headers
;; fields ;; fields