From: Taylor R Campbell <campbell@mumble.net>
Date: Mon, 27 May 2019 17:54:34 +0000 (+0000)
Subject: Set port coding to ISO-8859-1 for IMAP.
X-Git-Tag: mit-scheme-pucked-10.1.11~6^2~23
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=c4109d9287476d1f432fc411a040d24ce92a8675;p=mit-scheme.git

Set port coding to ISO-8859-1 for IMAP.

This is a sleazy workaround: sometimes the input is really encoded as
UTF-8, but passing it through Scheme `strings' as ISO-8859-1 works
out to approximately the not-wrong thing.  Really we should be
operating on octets, not on characters-as-if-they-were-octets.
---

diff --git a/src/imail/imail-imap.scm b/src/imail/imail-imap.scm
index 243b0bf4d..d48856a41 100644
--- a/src/imail/imail-imap.scm
+++ b/src/imail/imail-imap.scm
@@ -615,6 +615,7 @@ USA.
 		  (open-tcp-stream-socket (imap-url-host url)
 					  (or (imap-url-port url) "imap2"))))))
 	  (port/set-line-ending port 'NEWLINE)
+	  (port/set-coding port 'ISO-8859-1)
 	  (let ((response
 		 (imap:catch-no-response #f
 		   (lambda ()
@@ -1930,6 +1931,7 @@ USA.
 		(guarantee-init-file-directory temporary-directory)
 		(call-with-temporary-output-file pathname temporary-directory
 		  (lambda (output-port)
+		    (port/set-coding output-port 'ISO-8859-1)
 		    (imap:bind-fetch-body-part-port output-port
 		      (lambda ()
 			(fetch-message-body-part-1 message
@@ -1952,7 +1954,9 @@ USA.
 		  (guarantee-init-file-directory pathname)
 		  (guarantee-init-file-directory temporary-directory)
 		  (call-with-temporary-output-file pathname temporary-directory
-		    fetch-to-port)))
+		    (lambda (port)
+		      (port/set-coding port 'ISO-8859-1)
+		      (fetch-to-port port)))))
 	    (file->port pathname port)))
 	(lambda ()
 	  (fetch-to-port port))))))
@@ -2126,6 +2130,7 @@ USA.
 (define (string->file string pathname #!optional temporary-directory)
   (call-with-temporary-output-file pathname temporary-directory
     (lambda (port)
+      (port/set-coding port 'ISO-8859-1)
       (write-string string port))))
 
 (define (call-with-temporary-output-file pathname temporary-directory receiver)
@@ -2154,6 +2159,7 @@ USA.
 (define (file->port pathname output-port)
   (call-with-input-file pathname
     (lambda (input-port)
+      (port/set-coding input-port 'ISO-8859-1)
       (let ((buffer (make-string #x1000)))
 	(let loop ()
 	  (let ((n (read-string! buffer input-port)))
diff --git a/src/imail/imap-response.scm b/src/imail/imap-response.scm
index 012f6bc35..e6ec8aab7 100644
--- a/src/imail/imap-response.scm
+++ b/src/imail/imap-response.scm
@@ -557,6 +557,7 @@ USA.
 
 (define (start-imap-transcript pathname)
   (set! imap-transcript-port (open-output-file pathname))
+  (port/set-coding imap-transcript-port 'ISO-8859-1)
   unspecific)
 
 (define (stop-imap-transcript)