branch: elpa/jabber
commit a01e2c71b823132bd5e7da731e50e354ba918b68
Author: Talos Apollo <[email protected]>
Commit: Talos Apollo <[email protected]>
chat: Offer saving unsupported images
---
lisp/jabber-chat.el | 109 +++++++++++++++++++++++++++++++++------------
lisp/jabber-image.el | 65 ++++++++++++++++++---------
tests/jabber-test-chat.el | 68 ++++++++++++++++++++++++++--
tests/jabber-test-image.el | 11 +++++
4 files changed, 202 insertions(+), 51 deletions(-)
diff --git a/lisp/jabber-chat.el b/lisp/jabber-chat.el
index d0df6c5742..280ff09971 100644
--- a/lisp/jabber-chat.el
+++ b/lisp/jabber-chat.el
@@ -1655,44 +1655,68 @@ not a valid aesgcm:// URL. The fragment must be 88 hex
characters
:iv iv
:key key))))
+(defun jabber-chat--aesgcm-image-result-from-body
+ (encrypted key iv allowed-types)
+ "Decrypt ENCRYPTED and return an image result.
+KEY, IV, and ALLOWED-TYPES follow
+`jabber-chat--aesgcm-image-from-body'."
+ (cond ((null encrypted) (list :error 'response))
+ ((not (jabber-image--size-ok-p encrypted)) (list :error 'size))
+ (t
+ (condition-case err
+ (jabber-image--result-from-data
+ (jabber-omemo-aesgcm-decrypt key iv encrypted)
+ allowed-types)
+ (error
+ (list :error 'decrypt
+ :message (error-message-string err)))))))
+
(defun jabber-chat--aesgcm-image-from-body (encrypted key iv allowed-types)
"Decrypt ENCRYPTED with KEY and IV and build an inline image.
Return nil when ENCRYPTED is missing or exceeds
`jabber-image-max-bytes', decryption fails, or the plaintext
fails the ALLOWED-TYPES check per `jabber-image-from-data'."
- (and encrypted
- (jabber-image--size-ok-p encrypted)
- (and-let* ((plaintext (condition-case err
- (jabber-omemo-aesgcm-decrypt key iv encrypted)
- (error
- (message "aesgcm: decryption failed: %s"
- (error-message-string err))
- nil))))
- (jabber-image-from-data plaintext allowed-types))))
-
-(defun jabber-chat--fetch-aesgcm-image (url allowed-types callback &rest
cbargs)
- "Fetch and decrypt an aesgcm:// image URL.
-Downloads via HTTPS, decrypts with AES-256-GCM, and calls
-CALLBACK with the created image (or nil) followed by CBARGS.
-ALLOWED-TYPES and `jabber-image-max-bytes' are enforced per
-`jabber-image-from-data'."
+ (let ((result (jabber-chat--aesgcm-image-result-from-body
+ encrypted key iv allowed-types)))
+ (when (eq (plist-get result :error) 'decrypt)
+ (message "aesgcm: decryption failed: %s" (plist-get result :message)))
+ (plist-get result :image)))
+
+(defun jabber-chat--fetch-aesgcm-image-result
+ (url allowed-types callback &rest cbargs)
+ "Fetch URL and call CALLBACK with a decrypted image result and CBARGS.
+ALLOWED-TYPES restricts the decoded image types; nil permits any."
(let ((parsed (jabber-chat--parse-aesgcm-url url)))
(if (null parsed)
- (apply callback nil cbargs)
+ (apply callback (list :error 'url) cbargs)
(url-queue-retrieve
(plist-get parsed :https-url)
(lambda (status key iv types cb args)
(let ((url-buffer (current-buffer))
- (image (unless (plist-get status :error)
- (jabber-chat--aesgcm-image-from-body
- (jabber-image--response-body) key iv types))))
+ (result
+ (if (plist-get status :error)
+ (list :error 'fetch)
+ (jabber-chat--aesgcm-image-result-from-body
+ (jabber-image--response-body) key iv types))))
(kill-buffer url-buffer)
- (apply cb image args)))
+ (apply cb result args)))
(list (plist-get parsed :key) (plist-get parsed :iv)
allowed-types callback cbargs)
'silent
'inhibit-cookies))))
+(defun jabber-chat--fetch-aesgcm-image (url allowed-types callback &rest
cbargs)
+ "Fetch and decrypt an aesgcm:// image URL.
+Downloads via HTTPS, decrypts with AES-256-GCM, and calls
+CALLBACK with the created image (or nil) followed by CBARGS.
+ALLOWED-TYPES and `jabber-image-max-bytes' are enforced per
+`jabber-image-from-data'."
+ (apply #'jabber-chat--fetch-aesgcm-image-result
+ url allowed-types
+ (lambda (result cb args)
+ (apply cb (plist-get result :image) args))
+ callback cbargs))
+
(defconst jabber-chat--image-extension-types
'(("png" . png)
("jpg" . jpeg)
@@ -1814,7 +1838,7 @@ not `jabber-image-max-bytes'."
((jabber-chat--restore-cached-image url beg end))
(t
(let ((inhibit-read-only t))
- (jabber-chat--start-image-fetch url beg end nil))
+ (jabber-chat--start-image-fetch url beg end nil t))
(message "Loading image...")))))
(defun jabber-chat-url-action-at-point (&optional arg)
@@ -2061,6 +2085,33 @@ manual loading with RET still may."
(put-text-property beg end 'jabber-chat-image-fetching
'failed))))))))
+(defun jabber-chat--offer-image-save (url data)
+ "Offer to save fetched DATA from URL without another download."
+ (when (y-or-n-p "Cannot display image; save it instead? ")
+ (let* ((parsed (and (string-prefix-p "aesgcm://" url)
+ (jabber-chat--parse-aesgcm-url url)))
+ (save-url (if parsed (plist-get parsed :https-url) url))
+ (dest (jabber-chat--download-destination save-url)))
+ (jabber-chat--record-download-directory dest)
+ (with-temp-file dest
+ (set-buffer-multibyte nil)
+ (insert data))
+ (message "Downloaded %s" dest))))
+
+(defun jabber-chat--handle-image-result
+ (result url beg end buffer manual)
+ "Handle fetched image RESULT for URL between BEG and END in BUFFER.
+When MANUAL is non-nil, offer retained bytes after a decode failure."
+ (when (and (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (jabber-chat--url-markers-valid-p beg end url buffer)))
+ (jabber-chat--replace-url-with-image
+ (plist-get result :image) url beg end buffer)
+ (when (and manual
+ (eq (plist-get result :error) 'decode)
+ (plist-get result :data))
+ (jabber-chat--offer-image-save url (plist-get result :data)))))
+
(defvar-local jabber-chat--image-scan-timer nil
"Idle timer for scanning image URLs in this buffer.")
@@ -2115,21 +2166,23 @@ Return the possibly shifted bounds as a cons cell."
(insert "\n"))
(cons (1+ beg) (1+ end)))))
-(defun jabber-chat--start-image-fetch (url beg end allowed-types)
+(defun jabber-chat--start-image-fetch
+ (url beg end allowed-types &optional manual)
"Fetch image URL and display it over BEG..END in the current buffer.
ALLOWED-TYPES restricts decoding per `jabber-image-from-data';
-nil permits any supported type."
+nil permits any supported type. MANUAL is non-nil for a fetch
+explicitly requested by the user."
(jabber-chat--mark-image-fetching beg end url)
(let ((beg (copy-marker beg))
(end (copy-marker end))
(buf (current-buffer)))
(if (string-prefix-p "aesgcm://" url)
- (jabber-chat--fetch-aesgcm-image
+ (jabber-chat--fetch-aesgcm-image-result
url allowed-types
- #'jabber-chat--replace-url-with-image url beg end buf)
- (jabber-image-fetch
+ #'jabber-chat--handle-image-result url beg end buf manual)
+ (jabber-image--fetch-result
url allowed-types
- #'jabber-chat--replace-url-with-image url beg end buf))))
+ #'jabber-chat--handle-image-result url beg end buf manual))))
(defun jabber-chat--scan-image-url (url beg end auto)
"Process one image URL between BEG and END found by the scan.
diff --git a/lisp/jabber-image.el b/lisp/jabber-image.el
index 66b3e90384..857da41474 100644
--- a/lisp/jabber-image.el
+++ b/lisp/jabber-image.el
@@ -103,20 +103,33 @@ 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--result-from-data (data allowed-types)
+ "Return an image decoding result for DATA and ALLOWED-TYPES.
+The result contains either :image, or an :error symbol. Decode
+failures also retain DATA under :data so an explicit user action
+can offer to save the payload without fetching it again."
+ (cond ((null data) (list :error 'response))
+ ((not (jabber-image--size-ok-p data)) (list :error 'size))
+ ((not (jabber-image--type-ok-p data allowed-types))
+ (list :error 'type))
+ (t
+ (condition-case err
+ (list :image (jabber-image-create data))
+ (error
+ (list :error 'decode
+ :message (error-message-string err)
+ :data data))))))
+
(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))))
+ (let ((result (jabber-image--result-from-data data allowed-types)))
+ (when (eq (plist-get result :error) 'decode)
+ (message "jabber-image: failed to decode image: %s"
+ (plist-get result :message)))
+ (plist-get result :image)))
(defun jabber-image--response-body ()
"Return the HTTP response body of the current buffer, or nil.
@@ -127,26 +140,38 @@ separator is found."
(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. 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'."
+(defun jabber-image--fetch-result (url allowed-types callback &rest cbargs)
+ "Fetch URL and call CALLBACK with an image result and CBARGS.
+ALLOWED-TYPES restricts decoded image types; nil permits any.
+The result follows `jabber-image--result-from-data'. Transport
+failures use the error symbol `fetch'."
(url-queue-retrieve
url
(lambda (status types cb args)
(let ((url-buffer (current-buffer))
- (image (unless (plist-get status :error)
- (jabber-image-from-data
- (jabber-image--response-body) types))))
+ (result (if (plist-get status :error)
+ (list :error 'fetch)
+ (jabber-image--result-from-data
+ (jabber-image--response-body) types))))
(kill-buffer url-buffer)
- (apply cb image args)))
+ (apply cb result args)))
(list allowed-types callback cbargs)
'silent
'inhibit-cookies))
+(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. 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'."
+ (apply #'jabber-image--fetch-result
+ url allowed-types
+ (lambda (result cb args)
+ (apply cb (plist-get result :image) args))
+ callback cbargs))
+
(provide 'jabber-image)
;;; jabber-image.el ends here
diff --git a/tests/jabber-test-chat.el b/tests/jabber-test-chat.el
index 8671eb9feb..2b3cfc7111 100644
--- a/tests/jabber-test-chat.el
+++ b/tests/jabber-test-chat.el
@@ -1106,13 +1106,24 @@ JC is a fake connection from
`jabber-test-chat--make-fake-jc'."
(ert-deftest jabber-test-chat-aesgcm-image-threads-allowed-types ()
(cl-letf (((symbol-function 'jabber-omemo-aesgcm-decrypt)
(lambda (&rest _) "plaintext"))
- ((symbol-function 'jabber-image-from-data)
- (lambda (data types) (list data types))))
+ ((symbol-function 'jabber-image--result-from-data)
+ (lambda (data types) (list :image (list data types)))))
(let ((jabber-image-max-bytes nil))
(should (equal (jabber-chat--aesgcm-image-from-body
"ct" "key" "iv" '(png))
'("plaintext" (png)))))))
+(ert-deftest jabber-test-chat-aesgcm-decode-failure-retains-plaintext ()
+ "An unsupported decrypted payload remains available for manual saving."
+ (cl-letf (((symbol-function 'jabber-omemo-aesgcm-decrypt)
+ (lambda (&rest _) "decrypted-heic"))
+ ((symbol-function 'jabber-image--result-from-data)
+ (lambda (data _types) (list :error 'decode :data data))))
+ (let ((result (jabber-chat--aesgcm-image-result-from-body
+ "ciphertext" "key" "iv" nil)))
+ (should (eq (plist-get result :error) 'decode))
+ (should (equal (plist-get result :data) "decrypted-heic")))))
+
(ert-deftest jabber-test-chat-aesgcm-image-nil-body-returns-nil ()
(should-not (jabber-chat--aesgcm-image-from-body nil "key" "iv" nil)))
@@ -1289,7 +1300,7 @@ and `url' to the URL; `display-graphic-p' is stubbed to
t."
"Manual load passes nil ALLOWED-TYPES to the fetch."
(jabber-test-chat--with-manual-load-buffer
(jabber-chat--load-image-at-point)
- (should (equal fetches (list (list url 1 (point-max) nil))))))
+ (should (equal fetches (list (list url 1 (point-max) nil t))))))
(ert-deftest jabber-test-chat-manual-load-blocked-while-in-flight ()
(jabber-test-chat--with-manual-load-buffer
@@ -1365,6 +1376,57 @@ and `url' to the URL; `display-graphic-p' is stubbed to
t."
(goto-char (point-min))
(should-error (jabber-chat-url-action-at-point) :type 'user-error)))
+(ert-deftest jabber-test-chat-manual-decode-failure-offers-decrypted-save ()
+ "Manual aesgcm preview failure offers its decrypted bytes for saving."
+ (with-temp-buffer
+ (let* ((url (concat "aesgcm://example.org/photo.jpg#"
+ (make-string 88 ?a)))
+ (saved nil))
+ (insert (propertize url 'jabber-chat-image-url url))
+ (cl-letf (((symbol-function 'jabber-chat--offer-image-save)
+ (lambda (save-url data)
+ (setq saved (list save-url data)))))
+ (jabber-chat--handle-image-result
+ (list :error 'decode :data "decrypted-heic")
+ url (copy-marker 1) (copy-marker (point-max))
+ (current-buffer) t)
+ (should (equal saved (list url "decrypted-heic")))
+ (should (eq (get-text-property 1 'jabber-chat-image-fetching)
+ 'failed))))))
+
+(ert-deftest jabber-test-chat-aesgcm-save-fallback-writes-decrypted-bytes ()
+ "The aesgcm save fallback writes retained plaintext, not ciphertext."
+ (let* ((url (concat "aesgcm://example.org/photo.jpg#"
+ (make-string 88 ?a)))
+ (plaintext (unibyte-string 0 1 2 255))
+ (dest (make-temp-file "jabber-save-fallback-")))
+ (unwind-protect
+ (cl-letf (((symbol-function 'y-or-n-p) (lambda (&rest _) t))
+ ((symbol-function 'jabber-chat--download-destination)
+ (lambda (_) dest)))
+ (jabber-chat--offer-image-save url plaintext)
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert-file-contents-literally dest)
+ (should (equal (buffer-string) plaintext))))
+ (delete-file dest))))
+
+(ert-deftest jabber-test-chat-automatic-decode-failure-does-not-offer-save ()
+ "Background image fetching must never open an interactive save prompt."
+ (with-temp-buffer
+ (let ((url "https://example.org/photo.jpg";)
+ (offered nil))
+ (insert (propertize url 'jabber-chat-image-url url))
+ (cl-letf (((symbol-function 'jabber-chat--offer-image-save)
+ (lambda (&rest _) (setq offered t))))
+ (jabber-chat--handle-image-result
+ (list :error 'decode :data "unsupported-image")
+ url (copy-marker 1) (copy-marker (point-max))
+ (current-buffer) nil)
+ (should-not offered)
+ (should (eq (get-text-property 1 'jabber-chat-image-fetching)
+ 'failed))))))
+
(provide 'jabber-test-chat)
;;; jabber-test-chat.el ends here
diff --git a/tests/jabber-test-image.el b/tests/jabber-test-image.el
index 3adfbd4a23..d74a1c8053 100644
--- a/tests/jabber-test-image.el
+++ b/tests/jabber-test-image.el
@@ -88,6 +88,17 @@ Binds `calls' to the list of DATA arguments received."
(let ((jabber-image-max-bytes nil))
(should-not (jabber-image-from-data jabber-test-image--png-bytes)))))
+(ert-deftest jabber-test-image-result-retains-data-on-decode-error ()
+ "A decode failure keeps bytes available for a manual save fallback."
+ (cl-letf (((symbol-function 'jabber-image-create)
+ (lambda (&rest _) (error "Invalid image type ‘heic’"))))
+ (let* ((jabber-image-max-bytes nil)
+ (data "unsupported-image-bytes")
+ (result (jabber-image--result-from-data data nil)))
+ (should (eq (plist-get result :error) 'decode))
+ (should (equal (plist-get result :data) data))
+ (should-not (plist-get result :image)))))
+
;;; Response body extraction
(ert-deftest jabber-test-image-response-body-extracts-bytes ()
![https://example.org/photo.jpg"](https://example.org/photo.jpg"){kind=link}