branch: elpa/jabber
commit dc4852e049c50895b278e478d50e93643c8cb933
Author: Thanos Apollo <[email protected]>
Commit: Thanos Apollo <[email protected]>
image: Add size cap and detected-type checks to image fetch
---
Makefile | 1 +
lisp/jabber-chat.el | 6 +--
lisp/jabber-image.el | 65 +++++++++++++++++++++-------
tests/jabber-test-image.el | 105 +++++++++++++++++++++++++++++++++++++++++++++
4 files changed, 158 insertions(+), 19 deletions(-)
diff --git a/Makefile b/Makefile
index fad2246d97..2383b74898 100644
--- a/Makefile
+++ b/Makefile
@@ -31,6 +31,7 @@ TESTS ?= tests/jabber-test-activity.el \
tests/jabber-test-db.el \
tests/jabber-test-disco.el \
tests/jabber-test-httpupload.el \
+ tests/jabber-test-image.el \
tests/jabber-test-mam.el \
tests/jabber-test-menu.el \
tests/jabber-test-message-correct.el \
diff --git a/lisp/jabber-chat.el b/lisp/jabber-chat.el
index 3a338c8b35..b9e8cc4424 100644
--- a/lisp/jabber-chat.el
+++ b/lisp/jabber-chat.el
@@ -37,6 +37,7 @@
(require 'url-parse)
(require 'url-queue)
(require 'hex-util)
+(require 'jabber-image)
;; For the `image-property' setf-expander (not preloaded on emacs-nox).
(require 'image)
@@ -251,7 +252,6 @@ holding state for the next composed message stay inert."
(declare-function jabber-muc-nickname "jabber-muc.el" (group &optional jc))
(declare-function jabber-muc-our-nick-p "jabber-muc.el" (group nick))
(defvar jabber-muc-xmlns-user)
-(declare-function jabber-image-fetch "jabber-image" (url callback &rest
cbargs))
(declare-function jabber-omemo-aesgcm-decrypt "jabber-omemo"
(key iv ciphertext-with-tag))
(defvar jabber-backlog-days)
@@ -276,8 +276,6 @@ holding state for the next composed message stay inert."
(declare-function jabber-mam-chat-opened "jabber-mam" (jc peer))
(declare-function jabber-chatstates--clear-typing "jabber-chatstates" ())
(defvar jabber-oob-xmlns) ; jabber-xml.el
-(defvar jabber-image-max-width) ; jabber-image.el
-(defvar jabber-image-max-height) ; jabber-image.el
;;
@@ -1975,7 +1973,7 @@ Preserve URL text and restore cached images without
refetching."
#'jabber-chat--replace-url-with-image
url beg end buf)
(jabber-image-fetch
- url
+ url nil
#'jabber-chat--replace-url-with-image
url beg end buf))))))))))))
diff --git a/lisp/jabber-image.el b/lisp/jabber-image.el
index 92371727c7..66b3e90384 100644
--- a/lisp/jabber-image.el
+++ b/lisp/jabber-image.el
@@ -29,7 +29,6 @@
;;; Code:
-(require 'mm-decode)
(require 'url-queue)
;; For the `image-property' setf-expander (not preloaded on emacs-nox).
(require 'image)
@@ -46,6 +45,13 @@
"Maximum height in pixels for inline images."
:type 'integer)
+(defcustom jabber-image-max-bytes (* 25 1024 1024)
+ "Maximum size in bytes for downloaded inline images.
+Larger downloads are never decoded, not even when loaded
+manually. nil means no limit."
+ :type '(choice (const :tag "No limit" nil)
+ (natnum :tag "Bytes")))
+
(defun jabber-image--mime-to-type (mime-type)
"Return an image type symbol for MIME-TYPE string, or nil."
(when mime-type
@@ -86,29 +92,58 @@ MAX-WIDTH and MAX-HEIGHT default to
`jabber-image-max-width' and
(or max-height jabber-image-max-height))
image))
-(defun jabber-image-fetch (url callback &rest cbargs)
+(defun jabber-image--size-ok-p (data)
+ "Return non-nil when DATA fits within `jabber-image-max-bytes'."
+ (or (null jabber-image-max-bytes)
+ (<= (string-bytes data) jabber-image-max-bytes)))
+
+(defun jabber-image--type-ok-p (data allowed-types)
+ "Return non-nil when DATA's detected image type is permitted.
+ALLOWED-TYPES is a list of image type symbols; nil permits any."
+ (or (null allowed-types)
+ (memq (image-type-from-data data) allowed-types)))
+
+(defun jabber-image-from-data (data &optional allowed-types)
+ "Create a dynamically-sized image from raw DATA string.
+Return nil when DATA exceeds `jabber-image-max-bytes', its
+detected type is not in ALLOWED-TYPES (nil permits any), or it
+cannot be decoded."
+ (and data
+ (jabber-image--size-ok-p data)
+ (jabber-image--type-ok-p data allowed-types)
+ (condition-case err
+ (jabber-image-create data)
+ (error
+ (message "jabber-image: failed to decode image: %s"
+ (error-message-string err))
+ nil))))
+
+(defun jabber-image--response-body ()
+ "Return the HTTP response body of the current buffer, or nil.
+The buffer is made unibyte; nil is returned when no header
+separator is found."
+ (set-buffer-multibyte nil)
+ (goto-char (point-min))
+ (when (re-search-forward "\r?\n\r?\n" nil t)
+ (buffer-substring-no-properties (point) (point-max))))
+
+(defun jabber-image-fetch (url allowed-types callback &rest cbargs)
"Fetch image at URL asynchronously.
When complete, call CALLBACK with the image object (or nil on
-error) followed by CBARGS. Image is sized per
+error) followed by CBARGS. The image must satisfy
+`jabber-image-max-bytes' and ALLOWED-TYPES per
+`jabber-image-from-data'; it is sized per
`jabber-image-max-width' and `jabber-image-max-height'."
(url-queue-retrieve
url
- (lambda (status cb args)
+ (lambda (status types cb args)
(let ((url-buffer (current-buffer))
(image (unless (plist-get status :error)
- (goto-char (point-min))
- (when (re-search-forward "\r?\n\r?\n" nil t)
- (let* ((handle (mm-dissect-buffer t))
- (img (mm-get-image handle)))
- (when img
- (setf (image-property img :max-width)
- jabber-image-max-width)
- (setf (image-property img :max-height)
- jabber-image-max-height)
- img))))))
+ (jabber-image-from-data
+ (jabber-image--response-body) types))))
(kill-buffer url-buffer)
(apply cb image args)))
- (list callback cbargs)
+ (list allowed-types callback cbargs)
'silent
'inhibit-cookies))
diff --git a/tests/jabber-test-image.el b/tests/jabber-test-image.el
new file mode 100644
index 0000000000..3adfbd4a23
--- /dev/null
+++ b/tests/jabber-test-image.el
@@ -0,0 +1,105 @@
+;;; jabber-test-image.el --- Tests for jabber-image -*- lexical-binding: t;
-*-
+
+;;; Commentary:
+
+;; Image size cap and detected-type policy checks.
+
+;;; Code:
+
+(require 'ert)
+(require 'cl-lib)
+
+(require 'jabber-image)
+
+(defconst jabber-test-image--png-bytes
+ (unibyte-string #x89 ?P ?N ?G #x0d #x0a #x1a #x0a
+ 0 0 0 13 ?I ?H ?D ?R)
+ "Enough PNG magic bytes for `image-type-from-data'.")
+
+(defconst jabber-test-image--gif-bytes
+ (concat "GIF89a" (unibyte-string 1 0 1 0 0 0 0))
+ "Enough GIF magic bytes for `image-type-from-data'.")
+
+;;; Size cap
+
+(ert-deftest jabber-test-image-size-ok-p-nil-limit-allows-any ()
+ (let ((jabber-image-max-bytes nil))
+ (should (jabber-image--size-ok-p (make-string 100000 ?x)))))
+
+(ert-deftest jabber-test-image-size-ok-p-enforces-limit ()
+ (let ((jabber-image-max-bytes 10))
+ (should (jabber-image--size-ok-p "123456789"))
+ (should (jabber-image--size-ok-p "1234567890"))
+ (should-not (jabber-image--size-ok-p "12345678901"))))
+
+;;; Type allowlist
+
+(ert-deftest jabber-test-image-type-ok-p-detects-png ()
+ (should (jabber-image--type-ok-p jabber-test-image--png-bytes '(png)))
+ (should-not (jabber-image--type-ok-p jabber-test-image--png-bytes '(jpeg))))
+
+(ert-deftest jabber-test-image-type-ok-p-detects-gif ()
+ (should (jabber-image--type-ok-p jabber-test-image--gif-bytes '(gif png)))
+ (should-not (jabber-image--type-ok-p jabber-test-image--gif-bytes '(png))))
+
+(ert-deftest jabber-test-image-type-ok-p-nil-allows-any ()
+ (should (jabber-image--type-ok-p jabber-test-image--png-bytes nil))
+ (should (jabber-image--type-ok-p "not an image at all" nil)))
+
+;;; jabber-image-from-data
+
+(defmacro jabber-test-image--with-fake-create (&rest body)
+ "Run BODY with `jabber-image-create' stubbed to a recorder.
+Binds `calls' to the list of DATA arguments received."
+ `(let ((calls nil))
+ (cl-letf (((symbol-function 'jabber-image-create)
+ (lambda (data &rest _)
+ (push data calls)
+ (list 'image :type 'png))))
+ ,@body)))
+
+(ert-deftest jabber-test-image-from-data-respects-size-cap ()
+ (jabber-test-image--with-fake-create
+ (let ((jabber-image-max-bytes 4))
+ (should-not (jabber-image-from-data jabber-test-image--png-bytes))
+ (should (null calls)))))
+
+(ert-deftest jabber-test-image-from-data-respects-allowlist ()
+ (jabber-test-image--with-fake-create
+ (let ((jabber-image-max-bytes nil))
+ (should-not (jabber-image-from-data jabber-test-image--png-bytes '(jpeg)))
+ (should (null calls)))))
+
+(ert-deftest jabber-test-image-from-data-nil-allowlist-decodes ()
+ (jabber-test-image--with-fake-create
+ (let ((jabber-image-max-bytes nil))
+ (should (equal (jabber-image-from-data jabber-test-image--png-bytes)
+ '(image :type png)))
+ (should (equal calls (list jabber-test-image--png-bytes))))))
+
+(ert-deftest jabber-test-image-from-data-nil-data-returns-nil ()
+ (jabber-test-image--with-fake-create
+ (should-not (jabber-image-from-data nil))
+ (should (null calls))))
+
+(ert-deftest jabber-test-image-from-data-decode-error-returns-nil ()
+ (cl-letf (((symbol-function 'jabber-image-create)
+ (lambda (&rest _) (error "boom"))))
+ (let ((jabber-image-max-bytes nil))
+ (should-not (jabber-image-from-data jabber-test-image--png-bytes)))))
+
+;;; Response body extraction
+
+(ert-deftest jabber-test-image-response-body-extracts-bytes ()
+ (with-temp-buffer
+ (insert "HTTP/1.1 200 OK\r\nContent-Type: image/png\r\n\r\nBODY")
+ (should (equal (jabber-image--response-body) "BODY"))))
+
+(ert-deftest jabber-test-image-response-body-nil-without-separator ()
+ (with-temp-buffer
+ (insert "HTTP/1.1 200 OK")
+ (should-not (jabber-image--response-body))))
+
+(provide 'jabber-test-image)
+
+;;; jabber-test-image.el ends here
