From 54d005a0f1ff7ba5eb29d975e4f6735d24a4c972 Mon Sep 17 00:00:00 2001 From: Arun Isaac Date: Sat, 15 Sep 2018 16:01:03 +0530 Subject: quoted-printable: Q-encode #\? and #\_ with their ASCII values. * email/quoted-printable.scm (%q-encoding-literal-char-set, %quoted-printable-literal-char-set): New variables. (quoted-printable-encode): Move core encoding code to ... (quoted-printable-style-encode): ... this new function. (q-encoding-decode): Call quoted-printable-style-encode with the appropriate literal-char-set instead of calling quoted-printable-encode. * tests/quoted-printable.scm (q-encoding of special characters): Add to check for this bug. --- email/quoted-printable.scm | 71 +++++++++++++++++++++++++++++----------------- tests/quoted-printable.scm | 6 ++++ 2 files changed, 51 insertions(+), 26 deletions(-) diff --git a/email/quoted-printable.scm b/email/quoted-printable.scm index d119f6a..7b88b04 100644 --- a/email/quoted-printable.scm +++ b/email/quoted-printable.scm @@ -53,6 +53,43 @@ (else (put-u8 out (char->integer c)) (quoted-printable-decode in out))))))) +(define* (quoted-printable-style-encode + in out literal-char-set + #:optional (number-of-chars-left-on-this-line 76)) + (let ((x (get-u8 in)) + (put-into-output + (lambda (str) + (let* ((len (string-length str)) + (break-line? (<= number-of-chars-left-on-this-line len))) + (put-string + out (string-append (if break-line? "=\n" "") str)) + (if break-line? + (- 76 len) + (- number-of-chars-left-on-this-line len)))))) + (unless (eof-object? x) + (let ((c (integer->char x))) + (quoted-printable-style-encode + in out literal-char-set + (put-into-output + (if (char-set-contains? literal-char-set c) + (string c) + (format #f "=~:@(~2,'0x~)" x)))))))) + +;; Character set of characters to be represented by themselves in +;; quoted-printable encoding +(define %quoted-printable-literal-char-set + (char-set-delete + (ucs-range->char-set (char->integer #\space) + (char->integer #\delete)) + #\=)) + +;; Character set of characters to be represented by themselves in Q +;; encoding +(define %q-encoding-literal-char-set + (char-set-delete + %quoted-printable-literal-char-set + #\? #\_)) + (define quoted-printable-encode (match-lambda* (((? bytevector? bv)) @@ -62,31 +99,8 @@ (call-with-output-string (cut quoted-printable-encode in <>))) (((? port? in) (? port? out)) - (quoted-printable-encode in out 76)) - (((? port? in) (? port? out) (? integer? number-of-chars-left-on-this-line)) - (let ((x (get-u8 in)) - (put-into-output - (lambda (str) - (let* ((len (string-length str)) - (break-line? (<= number-of-chars-left-on-this-line len))) - (put-string - out (string-append (if break-line? "=\n" "") str)) - (if break-line? - (- 76 len) - (- number-of-chars-left-on-this-line len)))))) - (unless (eof-object? x) - (let ((c (integer->char x))) - (quoted-printable-encode - in out - (put-into-output - (if (char-set-contains? - (char-set-delete - (ucs-range->char-set (char->integer #\space) - (char->integer #\delete)) - #\=) - c) - (string c) - (format #f "=~:@(~2,'0x~)" x)))))))))) + (quoted-printable-style-encode + in out %quoted-printable-literal-char-set)))) (define (q-encoding-decode str) (quoted-printable-decode @@ -99,4 +113,9 @@ (string-map (lambda (c) (if (char=? c #\Space) #\_ c)) - (quoted-printable-encode bv))) + (call-with-port + (open-bytevector-input-port bv) + (lambda (in) + (call-with-output-string + (cut quoted-printable-style-encode in <> + %q-encoding-literal-char-set)))))) diff --git a/tests/quoted-printable.scm b/tests/quoted-printable.scm index 334380d..554b85d 100755 --- a/tests/quoted-printable.scm +++ b/tests/quoted-printable.scm @@ -106,4 +106,10 @@ abriquent pour te la vendre une =C3=A2me vulgaire.") charset) decoded-text)) +(test-equal "q-encoding of special characters" + (q-encoding-encode (string->bytevector " _?" "UTF-8")) + (string-append "_" + (quoted-printable-escape-encode-char #\_) + (quoted-printable-escape-encode-char #\?))) + (test-end "quoted-printable") -- cgit v1.2.3