bug#43441: 27.1; [PATCH] Fix incorrectly base64-padded faces in gnus-convert-face-to-png

bug#43441: 27.1; [PATCH] Fix incorrectly base64-padded faces in gnus-convert-face-to-png

[Alex Bochannek]

[-- Attachment #1: Type: text/plain, Size: 1157 bytes --]

Hello!

I noticed a problem with Faces not showing up despite a Face-header
being present in a message. In this particular case,
base64-decode-region failed to decode the header, which had incorrect
(i.e., excessive) padding. A command line and a Web-based decoder
happily ignored the superfluous '='s at the end of the string. Here is
the string in question:

"iVBORw0KGgoAAAANSUhEUgAAADAAAAAwBAMAAAClLOS0AAAAMFBMVEUwXjFLc0vD0cS7y7zw9PDZ4tkWSRaVrZZ+m39qi2tXfVj////7+/utwK4IPggAOAAJUUA7AAABKklEQVQ4jWPYjQMwDFYJp0NKEKCNJmEf9h8CsimXiL2e33s3/e7F7K2Cs3f3dCMkQkMKj4YuCY3K3iR+e7fMaiSjvkX0/5cFGrWpe2uLzOpaExUVqMS/8PX/Re5ey960OLBTZpFA8+IlSBKPQ92zNyUUBsosN58uIY0k8f+/ONCoYytkVuhWzVwNkYiYbqk5M3NmOVBi41YZ8RsGF7shEtFb5KJ3r969CyixM7OTPeFUxG2IxLO8/9/SvqXlc+/x3h295YzLlj2nIRJQj//nRvc5TEIal8RsXBLVuCQwIgoq/u80DomP6HEOk/iOS+IJLonZOCT+ReOQ+Lkbh0QKLonbOCR+7MYhsRqHBJrVcIl/1TgklqKLQyQ+tGKIgyQOqXpjig94diZRAgAXmDX6jyWafAAAAABJRU5ErkJggg======"

The correct number of '='s here is two.

I don't suspect this problem is widespread in other uses of the base64
decoder, so it seems appropriate to me to just patch
gnus-convert-face-to-png to generate the right amount of padding.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Fix incorrectly base64-padded faces in gnus-convert-face-to-png --]
[-- Type: text/x-patch, Size: 1111 bytes --]

diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el
index c95449762e..f1773db29a 100644
--- a/lisp/gnus/gnus-fun.el
+++ b/lisp/gnus/gnus-fun.el
@@ -205,11 +205,27 @@ gnus-face-encode
 (defun gnus-convert-face-to-png (face)
   "Convert FACE (which is base64-encoded) to a PNG.
 The PNG is returned as a string."
-  (mm-with-unibyte-buffer
-    (insert face)
-    (ignore-errors
-      (base64-decode-region (point-min) (point-max)))
-    (buffer-string)))
+  (let ((face (replace-regexp-in-string "[^[:graph:]]" "" face)))
+    ;; Calculate correct base64 padding
+    (if (string-match "=" face)
+	(let ((length (match-beginning 0))
+	      (padding nil))
+	  (progn (setq padding
+		       (/
+			(- 24
+			   (pcase (mod (* length 6) 24)
+			     (`0 24)
+			     (n n)))
+			6))
+		 (setq face (concat
+			     (substring face 0
+					(match-beginning 0))
+			     (make-string padding ?=))))))
+    (mm-with-unibyte-buffer
+      (insert face)
+      (ignore-errors
+	(base64-decode-region (point-min) (point-max)))
+      (buffer-string))))
 
 ;;;###autoload
 (defun gnus-convert-png-to-face (file)

[-- Attachment #3: Type: text/plain, Size: 35 bytes --]


-- 
Alex. (abochannek@google.com)

bug#43441: 27.1; [PATCH] Fix incorrectly base64-padded faces in gnus-convert-face-to-png

[Lars Ingebrigtsen]

Alex Bochannek <alex@bochannek.com> writes:

> I don't suspect this problem is widespread in other uses of the base64
> decoder, so it seems appropriate to me to just patch
> gnus-convert-face-to-png to generate the right amount of padding.

Hm...  I think it would be nice to have a utility function to fix up
base64 padding, and then gnus-convert-face-to-png could just use that?

It should work for both base64 that has newlines inserted and not.

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

bug#43441: 27.1; [PATCH] Fix incorrectly base64-padded faces in gnus-convert-face-to-png

[Alex Bochannek]

[-- Attachment #1: Type: text/plain, Size: 829 bytes --]

Lars Ingebrigtsen <larsi@gnus.org> writes:

> Alex Bochannek <alex@bochannek.com> writes:
>
>> I don't suspect this problem is widespread in other uses of the base64
>> decoder, so it seems appropriate to me to just patch
>> gnus-convert-face-to-png to generate the right amount of padding.
>
> Hm...  I think it would be nice to have a utility function to fix up
> base64 padding, and then gnus-convert-face-to-png could just use that?
>
> It should work for both base64 that has newlines inserted and not.

Took me a little while, but I broke this out into a utility function as
you suggested. I also wrote some tests for it. As part of me getting
familiar with ERT, I added a bunch of tests for gnus-string< and
gnus-string>, which I hope are useful. They should probably be in a
separate commit, but I leave that up to you.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Fix incorrectly base64-padded faces in gnus-convert-face-to-png --]
[-- Type: text/x-patch, Size: 710 bytes --]

diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el
index c95449762e..2461fd45fd 100644
--- a/lisp/gnus/gnus-fun.el
+++ b/lisp/gnus/gnus-fun.el
@@ -205,11 +205,12 @@ gnus-face-encode
 (defun gnus-convert-face-to-png (face)
   "Convert FACE (which is base64-encoded) to a PNG.
 The PNG is returned as a string."
-  (mm-with-unibyte-buffer
-    (insert face)
-    (ignore-errors
-      (base64-decode-region (point-min) (point-max)))
-    (buffer-string)))
+  (let ((face (gnus-base64-repad face)))
+    (mm-with-unibyte-buffer
+      (insert face)
+      (ignore-errors
+	(base64-decode-region (point-min) (point-max)))
+      (buffer-string))))
 
 ;;;###autoload
 (defun gnus-convert-png-to-face (file)

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: Implement gnus-base64-repad utility function to create properly base64-padded strings --]
[-- Type: text/x-patch, Size: 2576 bytes --]

diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index aa9f137e20..7e8dcaa47c 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -1343,6 +1343,58 @@ gnus-url-unhex-string
     (setq tmp (concat tmp str))
     tmp))
 
+(defun gnus-base64-repad (str &optional reject-newlines line-length)
+  "Take a base 64-encoded string and return it padded correctly,
+regardless of what padding the input string alread had.
+
+If any combination of CR and LF characters are present and
+REJECT-NEWLINES is nil remove them, otherwise raise an error. If
+LINE-LENGTH is set and the string (or any line in the string if
+REJECT-NEWLINES is nil) is longer than that number, raise an
+error. Common line length for input characters are 76 plus CRLF
+(RFC 2045 MIME), 64 plus CRLF (RFC 1421 PEM), and 1000 including
+CRLF (RFC 5321 SMTP).
+"
+  ;;; RFC 4648 specifies that:
+  ;;; - three 8-bit inputs make up a 24-bit group
+  ;;; - the 24-bit group is broken up into four 6-bit values
+  ;;; - each 6-bit value is mapped to one character of the base 64 alphabet
+  ;;; - if the final 24-bit quantum is filled with only 8 bits the output
+  ;;;   will be two base 64 characters followed by two "=" padding characters
+  ;;; - if the final 24-bit quantum is filled with only 16 bits the output
+  ;;;   will be three base 64 character followed by one "=" padding character
+  ;;;
+  ;;; RFC 4648 section 3 considerations:
+  ;;; - if reject-newlines is nil (default), concatenate multi-line
+  ;;;   input (3.1, 3.3)
+  ;;; - if line-length is set, error on input exceeding the limit (3.1)
+  ;;; - reject characters outside base encoding (3.3, also section 12)
+
+  (let ((splitstr (split-string str "[\r\n]" t)))
+    (progn
+      (if (and reject-newlines (> (length splitstr) 1))
+	  	 (error "Invalid Base64 string"))
+      (dolist (substr splitstr)
+	(if (and line-length (> (length substr) line-length))
+	    (error "Base64 string exceeds line-length"))
+	(if (string-match "[^A-Za-z0-9+/=]" substr)
+	    (error "Invalid Base64 string")))
+      (let* ((str (string-join splitstr))
+	     (len (length str))
+	     (padding nil))
+	(if (string-match "=" str)
+	    (setq len (match-beginning 0)))
+	(progn (setq padding
+		     (/
+		      (- 24
+			 (pcase (mod (* len 6) 24)
+			   (`0 24)
+			   (n n)))
+		      6))
+	       (concat
+		(substring str 0 len)
+		(make-string padding ?=)))))))
+
 (defun gnus-make-predicate (spec)
   "Transform SPEC into a function that can be called.
 SPEC is a predicate specifier that contains stuff like `or', `and',

[-- Attachment #4: Implement test cases of gnus-string>, gnus-string<, and gnus-base64-repad --]
[-- Type: text/x-patch, Size: 4368 bytes --]

diff --git a/test/lisp/gnus/gnus-util-tests.el b/test/lisp/gnus/gnus-util-tests.el
index 7eadb0de71..ed33be46a3 100644
--- a/test/lisp/gnus/gnus-util-tests.el
+++ b/test/lisp/gnus/gnus-util-tests.el
@@ -25,6 +25,65 @@
 (require 'ert)
 (require 'gnus-util)
 
+(ert-deftest gnus-string> ()
+  ;; Failure paths
+  (should-error (gnus-string> "" 1)
+                :type 'wrong-type-argument)
+  (should-error (gnus-string> "")
+                :type 'wrong-number-of-arguments)
+
+  ;; String tests
+  (should (gnus-string> "def" "abc"))
+  (should (gnus-string> 'def 'abc))
+  (should (gnus-string> "abc" "DEF"))
+  (should (gnus-string> "abc" 'DEF))
+  (should (gnus-string> "αβγ" "abc"))
+  (should (gnus-string> "אבג" "αβγ"))
+  (should (gnus-string> nil ""))
+  (should (gnus-string> "abc" ""))
+  (should (gnus-string> "abc" "ab"))
+  (should-not (gnus-string> "abc" "abc"))
+  (should-not (gnus-string> "abc" "def"))
+  (should-not (gnus-string> "DEF" "abc"))
+  (should-not (gnus-string> 'DEF "abc"))
+  (should-not (gnus-string> "123" "abc"))
+  (should-not (gnus-string> "" "")))
+
+(ert-deftest gnus-string< ()
+  ;; Failure paths
+  (should-error (gnus-string< "" 1)
+                :type 'wrong-type-argument)
+  (should-error (gnus-string< "")
+                :type 'wrong-number-of-arguments)
+
+  ;; String tests
+  (setq case-fold-search nil)
+  (should (gnus-string< "abc" "def"))
+  (should (gnus-string< 'abc 'def))
+  (should (gnus-string< "DEF" "abc"))
+  (should (gnus-string< "DEF" 'abc))
+  (should (gnus-string< "abc" "αβγ"))
+  (should (gnus-string< "αβγ" "אבג"))
+  (should (gnus-string< "" nil))
+  (should (gnus-string< "" "abc"))
+  (should (gnus-string< "ab" "abc"))
+  (should-not (gnus-string< "abc" "abc"))
+  (should-not (gnus-string< "def" "abc"))
+  (should-not (gnus-string< "abc" "DEF"))
+  (should-not (gnus-string< "abc" 'DEF))
+  (should-not (gnus-string< "abc" "123"))
+  (should-not (gnus-string< "" ""))
+
+  ;; gnus-string< checks case-fold-search
+  (setq case-fold-search t)
+  (should (gnus-string< "abc" "DEF"))
+  (should (gnus-string< "abc" 'GHI))
+  (should (gnus-string< 'abc "DEF"))
+  (should (gnus-string< 'GHI 'JKL))
+  (should (gnus-string< "abc" "ΑΒΓ"))
+  (should-not (gnus-string< "ABC" "abc"))
+  (should-not (gnus-string< "def" "ABC")))
+
 (ert-deftest gnus-subsetp ()
   ;; False for non-lists.
   (should-not (gnus-subsetp "1" "1"))
@@ -73,4 +132,43 @@ gnus-setdiff
   (should (equal '("1") (gnus-setdiff '(2 "1" 2) '(2))))
   (should (equal '("1" "1") (gnus-setdiff '(2 "1" 2 "1") '(2)))))
 
+(ert-deftest gnus-base64-repad ()
+  (should-error (gnus-base64-repad "" nil nil nil)
+                :type 'wrong-number-of-arguments)
+  (should-error (gnus-base64-repad 1)
+                :type 'wrong-type-argument)
+
+  ;; RFC4648 test vectors
+  (should (equal "" (gnus-base64-repad "")))
+  (should (equal "Zg==" (gnus-base64-repad "Zg==")))
+  (should (equal "Zm8=" (gnus-base64-repad "Zm8=")))
+  (should (equal "Zm9v" (gnus-base64-repad "Zm9v")))
+  (should (equal "Zm9vYg==" (gnus-base64-repad "Zm9vYg==")))
+  (should (equal "Zm9vYmE=" (gnus-base64-repad "Zm9vYmE=")))
+  (should (equal "Zm9vYmFy" (gnus-base64-repad "Zm9vYmFy")))
+
+  (should (equal "Zm8=" (gnus-base64-repad "Zm8")))
+  (should (equal "Zg==" (gnus-base64-repad "Zg")))
+  (should (equal "Zg==" (gnus-base64-repad "Zg====")))
+
+  (should-error (gnus-base64-repad " ")
+                :type 'error)
+  (should-error (gnus-base64-repad "Zg== ")
+                :type 'error)
+  (should-error (gnus-base64-repad "Z?\x00g==")
+                :type 'error)
+  ;; line-length
+  (should-error (gnus-base64-repad "Zg====" nil 4)
+                :type 'error)
+  ;; reject-newlines
+  (should-error (gnus-base64-repad "Zm9v\r\nYmFy" t)
+                :type 'error)
+  (should (equal "Zm9vYmFy" (gnus-base64-repad "Zm9vYmFy" t)))
+  (should (equal "Zm9vYmFy" (gnus-base64-repad "Zm9v\r\nYmFy" nil)))
+  (should (equal "Zm9vYmFy" (gnus-base64-repad "Zm9v\r\nYmFy\n" nil)))
+  (should-error (gnus-base64-repad "Zm9v\r\n YmFy\r\n" nil)
+                :type 'error)
+  (should-error (gnus-base64-repad "Zm9v\r\nYmFy" nil 3)
+                :type 'error))
+
 ;;; gnustest-gnus-util.el ends here

[-- Attachment #5: Type: text/plain, Size: 11 bytes --]


-- 
Alex.

bug#43441: 27.1; [PATCH] Fix incorrectly base64-padded faces in gnus-convert-face-to-png

[Lars Ingebrigtsen]

Alex Bochannek <alex@bochannek.com> writes:

> Took me a little while, but I broke this out into a utility function as
> you suggested. I also wrote some tests for it. As part of me getting
> familiar with ERT, I added a bunch of tests for gnus-string< and
> gnus-string>, which I hope are useful. They should probably be in a
> separate commit, but I leave that up to you.

Thanks; looks good to me.  I did some minor touch-ups before committing
-- the first line in the comment string should be a complete sentence,
and ";;" instead of ";;;", and when is preferred over else-less ifs and
pushed to Emacs 28.

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

bug#43441: 27.1; [PATCH] Fix incorrectly base64-padded faces in gnus-convert-face-to-png

[Alex Bochannek]

Lars Ingebrigtsen <larsi@gnus.org> writes:

> Alex Bochannek <alex@bochannek.com> writes:
>
>> Took me a little while, but I broke this out into a utility function as
>> you suggested. I also wrote some tests for it. As part of me getting
>> familiar with ERT, I added a bunch of tests for gnus-string< and
>> gnus-string>, which I hope are useful. They should probably be in a
>> separate commit, but I leave that up to you.
>
> Thanks; looks good to me.  I did some minor touch-ups before committing
> -- the first line in the comment string should be a complete sentence,
> and ";;" instead of ";;;", and when is preferred over else-less ifs and
> pushed to Emacs 28.

Great, thanks!

-- 
Alex.