From: Chris Hanson Date: Fri, 30 Jun 2000 02:57:24 +0000 (+0000) Subject: Modify RMAIL file reader to handle mixed RMAIL/umail files, as does X-Git-Tag: 20090517-FFI~3422 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=7e05b9afefc0bf77564f3e1c7e887b1104293dcf;p=mit-scheme.git Modify RMAIL file reader to handle mixed RMAIL/umail files, as does the real RMAIL. We don't bother with MMDF format, since that isn't used by any real systems any longer. --- diff --git a/v7/src/imail/imail-rmail.scm b/v7/src/imail/imail-rmail.scm index 15dc4bb90..88dada042 100644 --- a/v7/src/imail/imail-rmail.scm +++ b/v7/src/imail/imail-rmail.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: imail-rmail.scm,v 1.45 2000/06/29 22:01:50 cph Exp $ +;;; $Id: imail-rmail.scm,v 1.46 2000/06/30 02:57:22 cph Exp $ ;;; ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology ;;; @@ -115,25 +115,34 @@ (call-with-binary-input-file pathname (lambda (port) (set-rmail-folder-header-fields! folder (read-rmail-prolog port)) - (let loop () - (let ((message (read-rmail-message port))) - (if message - (begin - (append-message message (folder-url folder)) - (loop)))))))))) + (let loop ((line #f)) + (call-with-values (lambda () (read-rmail-message port line)) + (lambda (message line) + (if message + (begin + (append-message message (folder-url folder)) + (loop line))))))))))) (define (read-rmail-prolog port) - (if (not (string-prefix? "BABYL OPTIONS:" (read-required-line port))) + (if (not (rmail-prolog-start-line? (read-required-line port))) (error "Not an RMAIL file:" port)) (lines->header-fields (read-lines-to-eom port))) -(define (read-rmail-message port) - (let ((line (read-line port))) +(define (read-rmail-message port read-ahead-line) + (let ((line (or read-ahead-line (read-line port)))) (cond ((eof-object? line) - #f) - ((and (fix:= 1 (string-length line)) - (char=? rmail-message:start-char (string-ref line 0))) - (read-rmail-message-1 port)) + (values #f #f)) + ((rmail-prolog-start-line? line) + (discard-to-eom port) + (read-rmail-message port #f)) + ((rmail-message-start-line? line) + (values (read-rmail-message-1 port) #f)) + ((umail-delimiter? line) + (read-umail-message line port + (lambda (line) + (or (rmail-prolog-start-line? line) + (rmail-message-start-line? line) + (umail-delimiter? line))))) (else (error "Malformed RMAIL file:" port))))) @@ -309,6 +318,15 @@ ;;;; Syntactic Markers +(define (rmail-prolog-start-line? line) + (string-prefix? "BABYL OPTIONS:" line)) + +(define (rmail-prolog-end-line? line) + (string-prefix? "\037" line)) + +(define (rmail-message-start-line? line) + (string=? "\f" line)) + (define rmail-message:headers-separator "*** EOOH ***") @@ -338,4 +356,8 @@ (if (or (eof-object? string) (eof-object? (read-char port))) (error "EOF while reading RMAIL message body:" port)) - string)) \ No newline at end of file + string)) + +(define (discard-to-eom port) + (input-port/discard-chars port rmail-message:end-char-set) + (input-port/discard-char port)) \ No newline at end of file diff --git a/v7/src/imail/imail-umail.scm b/v7/src/imail/imail-umail.scm index aa26b4df9..602541bee 100644 --- a/v7/src/imail/imail-umail.scm +++ b/v7/src/imail/imail-umail.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: imail-umail.scm,v 1.34 2000/06/20 19:46:56 cph Exp $ +;;; $Id: imail-umail.scm,v 1.35 2000/06/30 02:57:23 cph Exp $ ;;; ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology ;;; @@ -108,7 +108,10 @@ (error "Malformed unix mail file:" port)) (let loop ((from-line from-line) (index 0) (messages '())) (call-with-values - (lambda () (read-umail-message from-line port)) + (lambda () + (read-umail-message from-line + port + umail-delimiter?)) (lambda (message from-line) (attach-message! message folder index) (let ((messages (cons message messages))) @@ -116,33 +119,27 @@ (loop from-line (+ index 1) messages) (reverse! messages))))))))))))))) -(define (read-umail-message from-line port) - (let read-headers ((header-lines '())) +(define (read-umail-message from-line port delimiter?) + (let loop ((lines '())) (let ((line (read-line port))) (cond ((eof-object? line) - (values (read-umail-message-1 from-line - (reverse! header-lines) - '()) - #f)) - ((string-null? line) - (let read-body ((body-lines '())) - (let ((line (read-line port))) - (cond ((eof-object? line) - (values (read-umail-message-1 from-line - (reverse! header-lines) - (reverse! body-lines)) - #f)) - ((umail-delimiter? line) - (values (read-umail-message-1 from-line - (reverse! header-lines) - (reverse! body-lines)) - line)) - (else - (read-body (cons line body-lines))))))) + (values (read-umail-message-1 from-line (reverse! lines)) #f)) + ((delimiter? line) + (values (read-umail-message-1 from-line (reverse! lines)) line)) (else - (read-headers (cons line header-lines))))))) - -(define (read-umail-message-1 from-line header-lines body-lines) + (loop (cons line lines))))))) + +(define (read-umail-message-1 from-line lines) + (let loop ((lines lines) (header-lines '())) + (if (pair? lines) + (if (string-null? (car lines)) + (read-umail-message-2 from-line + (reverse! header-lines) + (cdr lines)) + (loop (cdr lines) (cons (car lines) header-lines))) + (read-umail-message-2 from-line (reverse! header-lines) '())))) + +(define (read-umail-message-2 from-line header-lines body-lines) (call-with-values (lambda () (parse-imail-header-fields (lines->header-fields header-lines))) diff --git a/v7/src/imail/todo.txt b/v7/src/imail/todo.txt index 5469563dd..751fb01ba 100644 --- a/v7/src/imail/todo.txt +++ b/v7/src/imail/todo.txt @@ -1,12 +1,9 @@ IMAIL To-Do List -$Id: todo.txt,v 1.102 2000/06/29 22:02:34 cph Exp $ +$Id: todo.txt,v 1.103 2000/06/30 02:57:24 cph Exp $ Bug fixes --------- -* RMAIL file reader must recognize when the tail of the file contains - umail messages. - MIME conformance ----------------