Do network/scheme line-ending translation automatically when reading

and writing literals.  We shouldn't need to worry about binary data in
mail messages.

diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm
index 412eead162d772cb092dcba75395336694114804..aa170bf952a811fedcec5ba3fda4d2cf6fe0032c 100644 (file)
--- a/v7/src/imail/imail-imap.scm
+++ b/v7/src/imail/imail-imap.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-imap.scm,v 1.43 2000/05/16 04:14:37 cph Exp $
+;;; $Id: imail-imap.scm,v 1.44 2000/05/16 15:14:13 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -1015,15 +1015,14 @@
      (%set-message-flags! message (map imap-flag->imail-flag datum))
      #t)
     ((RFC822.HEADER)
-     (%set-message-header-fields!
-      message
-      (lines->header-fields (network-string->lines datum)))
+     (%set-message-header-fields! message
+                                 (lines->header-fields (string->lines datum)))
      #t)
     ((RFC822.SIZE)
      (%set-imap-message-length! message datum)
      #t)
     ((RFC822.TEXT)
-     (%set-message-body! message (translate-string-line-endings datum))
+     (%set-message-body! message datum)
      #t)
     ((UID)
      (%set-imap-message-uid! message datum)

diff --git a/v7/src/imail/imail-util.scm b/v7/src/imail/imail-util.scm
index 30c786d80387793db94a5346d5879567a9a2c9e6..a4a826fb27e103a784c1eb14561cc9910c832c0e 100644 (file)
--- a/v7/src/imail/imail-util.scm
+++ b/v7/src/imail/imail-util.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-util.scm,v 1.13 2000/05/08 14:53:09 cph Exp $
+;;; $Id: imail-util.scm,v 1.14 2000/05/16 15:14:14 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -192,35 +192,4 @@
     line))
 
 (define (edwin-variable-value name)
-  (variable-value (name->variable name 'ERROR)))
-
-(define (translate-string-line-endings string)
-  (translate-substring-line-endings string 0 (string-length string)))
-
-(define (translate-substring-line-endings string start end)
-  (let ((indexes (substring-search-all "\r\n" string start end)))
-    (let ((s (make-string (fix:- (fix:- end start) (length indexes)))))
-      (let loop ((indexes indexes) (i start) (j 0))
-       (if (pair? indexes)
-           (let ((j (substring-move! string i (car indexes) s j)))
-             (string-set! s j #\newline)
-             (loop (cdr indexes) (fix:+ (car indexes) 2) (fix:+ j 1)))
-           (substring-move! string i end s j)))
-      s)))
-
-(define (network-string->lines string)
-  (network-substring->lines string 0 (string-length string)))
-
-(define (network-substring->lines string start end)
-  (let loop
-      ((start start)
-       (indexes (substring-search-all "\r\n" string start end))
-       (lines '()))
-    (if (pair? indexes)
-       (loop (fix:+ (car indexes) 2)
-             (cdr indexes)
-             (cons (substring string start (car indexes)) lines))
-       (reverse!
-        (if (fix:< start end)
-            (cons (substring string start end) lines)
-            lines)))))
\ No newline at end of file
+  (variable-value (name->variable name 'ERROR)))
\ No newline at end of file

diff --git a/v7/src/imail/imap-response.scm b/v7/src/imail/imap-response.scm
index 75a3f242f4cc7a27c1b0ad48714c32073a59bc7d..318fec6f69e8130a1c9e56451622530ed5e1e164 100644 (file)
--- a/v7/src/imail/imap-response.scm
+++ b/v7/src/imail/imap-response.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imap-response.scm,v 1.15 2000/05/16 03:58:31 cph Exp $
+;;; $Id: imap-response.scm,v 1.16 2000/05/16 15:14:16 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -268,7 +268,7 @@
                       (loop))
                     (lose))))
              (else (lose)))))))
-
+\f
 (define (read-literal port)
   (discard-known-char #\{ port)
   (let ((n (read-number port)))
@@ -284,7 +284,19 @@
              (loop (fix:+ start m)))))
       (if trace-imap-server-responses?
          (write-string s (notification-output-port)))
+      (translate-network-line-endings-to-scheme! s)
       s)))
+
+(define (translate-network-line-endings-to-scheme! string)
+  (let ((n (string-length string)))
+    (let ((i (substring-search-forward "\r\n" string 0 n)))
+      (if i
+         (let loop ((i i) (n n))
+           (let* ((n (substring-move! s (fix:+ i 1) n s i))
+                  (i (substring-search-forward "\r\n" string (fix:+ i 1) n)))
+             (if i
+                 (loop i n)
+                 (set-string-maximum-length! string n))))))))
 \f
 (define (read-list port #!optional read-item)
   (read-closed-list #\( #\)

diff --git a/v7/src/imail/imap-syntax.scm b/v7/src/imail/imap-syntax.scm
index b435c03650fbf4482f1168e47e4cf9350f34d051..0fa8f313a4b07cfc4ca28e67b5a491c62db950d6 100644 (file)
--- a/v7/src/imail/imap-syntax.scm
+++ b/v7/src/imail/imap-syntax.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imap-syntax.scm,v 1.8 2000/05/16 03:13:43 cph Exp $
+;;; $Id: imap-syntax.scm,v 1.9 2000/05/16 15:14:17 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -598,7 +598,17 @@
   (imap:write-literal-substring-body string 0 (string-length string) port))
 
 (define (imap:write-literal-substring-body string start end port)
-  (write-substring string start end port))
+  ;; Translate newlines back to network line endings.
+  (let loop ((start start))
+    (if (fix:<= start end)
+       (let ((index (substring-find-next-char string start end #\newline)))
+         (if index
+             (begin
+               (write-substring string start index port)
+               (write-char #\return port)
+               (write-char #\linefeed port)
+               (loop (fix:+ index 1)))
+             (write-substring string start end port))))))
 
 (define (imap:universal-time->date-time time)
   (imap:decoded-time->date-time (universal-time->global-decoded-time time)))