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).
This commit is contained in:
Alex Bochannek
Lars Ingebrigtsen
parent
232382415d
commit
eaf224f88d
3 changed files with 151 additions and 5 deletions
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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',
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue