Fix case of quoted-printable hex digits.

https://tools.ietf.org/html/rfc2045#section-6.7

  `In this encoding, octets are to be represented as determined by the
   following rules:

   `(1)   (General 8bit representation) Any octet, except a CR or
          LF that is part of a CRLF line break of the canonical
          (standard) form of the data being encoded, may be
          represented by an "=" followed by a two digit
          hexadecimal representation of the octet's value.  The
          digits of the hexadecimal alphabet, for this purpose,
          are "0123456789ABCDEF".  Uppercase letters must be
          used; lowercase letters are not allowed.  [...]'

(cherry picked from commit 280d8a878893e33d124dd22553890f6c71988008)

diff --git a/src/relnotes/bug-qp-hex b/src/relnotes/bug-qp-hex
new file mode 100644 (file)
index 0000000..853cc3c
--- /dev/null
+++ b/src/relnotes/bug-qp-hex
@@ -0,0 +1,4 @@
+Bug fix: The quoted-printable encoder correctly produces uppercase
+hexadecimal digits; a change in the default case of output in
+digit->char had caused it to erroneously produce lowercase hexadecimal
+digits in violation of RFC 2045.

diff --git a/src/runtime/mime-codec.scm b/src/runtime/mime-codec.scm
index b742d6653ad6618d7120aaf35ce52a9828c035f7..7cb99aff7c9a28286e61b1e6602aacca8d5ced3d 100644 (file)
--- a/src/runtime/mime-codec.scm
+++ b/src/runtime/mime-codec.scm
@@ -95,7 +95,9 @@ USA.
     (cond ((fix:< start end)
           (let ((char (string-ref string start))
                 (start (fix:+ start 1)))
-            (cond ((not (char-lwsp? char))
+            (cond ((not (char-8-bit? char))
+                   (error "Quoted-printable encoder can't handle Unicode"))
+                  ((not (char-lwsp? char))
                    (if (char-in-set? char char-set:qp-encoded)
                        (write-qp-encoded context char)
                        (write-qp-clear context char))
@@ -140,8 +142,10 @@ USA.
   (let ((port (qp-encoding-context/port context))
        (column (qp-encoding-context/column context))
        (d (char->integer char)))
-    (let ((c1 (digit->char (fix:lsh d -4) 16))
-         (c2 (digit->char (fix:and d #x0F) 16)))
+    (assert (<= 0 d #xff))
+    (define (hex c) (string-ref "0123456789ABCDEF" c))
+    (let ((c1 (hex (fix:lsh d -4)))
+         (c2 (hex (fix:and d #x0F))))
       (if (fix:= column 73)
          (set-qp-encoding-context/pending-output! context (string #\= c1 c2))
          (begin

diff --git a/tests/runtime/test-mime-codec.scm b/tests/runtime/test-mime-codec.scm
index f8d141cfb5b00d3501b8dde0d5f5b78365050ba9..0040e1984cfa7a6e50af90015f72207ff369b27f 100644 (file)
--- a/tests/runtime/test-mime-codec.scm
+++ b/tests/runtime/test-mime-codec.scm
@@ -294,16 +294,13 @@ USA.
 
 (define-test 'QUOTED-PRINTABLE/UPPERCASE
   (lambda ()
-    ;; Currently uses digit->char which no longer produces uppercase.
-    (expect-failure
-     (lambda ()
-       (let* ((string "The quïck brøwn fox jump§ over the lazʒ doﻎ.")
-             (utf8 (string->utf8 string))
-             (bytestring (iso8859-1->string utf8)))
-        (assert-equal
-         (encode-quoted-printable bytestring #t)
-         (string-append "The qu=C3=AFck br=C3=B8wn=C2=A0fox jump=C2=A7"
-                        " over the laz=CA=92 do=EF=BB=\n=8E.")))))))
+    (let* ((string "The quïck brøwn fox jump§ over the lazʒ doﻎ.")
+          (utf8 (string->utf8 string))
+          (bytestring (iso8859-1->string utf8)))
+      (assert-equal
+       (encode-quoted-printable bytestring #t)
+       (string-append "The qu=C3=AFck br=C3=B8wn=C2=A0fox jump=C2=A7"
+                     " over the laz=CA=92 do=EF=BB=\n=8E.")))))
 
 (define-test 'QUOTED-PRINTABLE/UNICODE-BUG
   (lambda ()