From: Alex Bochannek Date: Mon, 28 Sep 2020 12:09:07 +0000 (+0200) Subject: Repad the Face header in Gnus X-Git-Tag: emacs-28.0.90~5839 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=eaf224f88d988d7c8facddf884cc9e2eb192bed8;p=emacs.git Repad the Face header in Gnus * lisp/gnus/gnus-fun.el (gnus-convert-face-to-png): Use it. * lisp/gnus/gnus-util.el (gnus-base64-repad): New function (bug#43441). --- diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el index c95449762e4..2461fd45fd5 100644 --- a/lisp/gnus/gnus-fun.el +++ b/lisp/gnus/gnus-fun.el @@ -205,11 +205,12 @@ different input formats." (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) diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index aa9f137e203..f8126906b87 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -1343,6 +1343,53 @@ forbidden in URL encoding." (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. +Existing padding is ignored. + +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))) + (when (and reject-newlines (> (length splitstr) 1)) + (error "Invalid Base64 string")) + (dolist (substr splitstr) + (when (and line-length (> (length substr) line-length)) + (error "Base64 string exceeds line-length")) + (when (string-match "[^A-Za-z0-9+/=]" substr) + (error "Invalid Base64 string"))) + (let* ((str (string-join splitstr)) + (len (length str))) + (when (string-match "=" str) + (setq len (match-beginning 0))) + (concat + (substring str 0 len) + (make-string (/ + (- 24 + (pcase (mod (* len 6) 24) + (`0 24) + (n n))) + 6) + ?=))))) + (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', diff --git a/test/lisp/gnus/gnus-util-tests.el b/test/lisp/gnus/gnus-util-tests.el index 7eadb0de716..ed33be46a3a 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 @@ (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