bug#61326: [DRAFT PATCH v5] Work around zip's filename extension limitation (was: Adding --no-add-suffix to zip patch)

[Ruijie Yu via "Bug reports for GNU Emacs, the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>]

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


> [...]
> Thank you for the review.  I will take a closer look at etc/CONTRIBUTE
> -- apparently I didn't read it in enough detail.  I will report back
> within the next few days.

New iteration.  As mentioned from my last message, I have reverted the
part where I tried to rewrite part of `archive-expunge' using `cl-do'.

Test cases for arc-mode still pass:
    $ make -C test arc-mode-tests

Note that I mentioned the new internal helper functions in the commit
message, as I saw João too has mentioned updates to internal functions
in 9d3fdf7e0.

If mentioning the internal functions turns out to be unnecessary, simply
removing these lines from the patch should suffice.  Otherwise, if
there's something else that looks wrong in the commit message, please
let me know.

FTR, I am still waiting for the counter signature from FSF before this
can be included into emacs.git.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Handle-modifications-on-extensionless-zips-correctly.patch --]
[-- Type: text/x-patch, Size: 9155 bytes --]

From f3b29596ef3ddfa63d6cd65fcbf8a5210e99989f Mon Sep 17 00:00:00 2001
From: Ruijie Yu <ruijie+git@netyu.xyz>
Date: Mon, 6 Mar 2023 11:03:32 +0800
Subject: [PATCH] Handle modifications on extensionless zips correctly
 (Bug#61326)

* lisp/arc-mode.el
(archive-*-write-file-member) (archive-*-expunge):
Refactor to correctly modify extensionless zip archives.
(archive-expunge):
Move implementation to a separate helper function to facilitate testing.
(archive--act-files): New helper function to wrap around `call-process' calls.
(archive--need-rename-p):
New helper function to check whether a temporary rename is necessary.
(archive--ensure-extension) (archive--maybe-rename):
New helper functions to rename archive if the caller deems it necessary.
(archive--with-ensure-extension):
New helper function to handle writing an archive while ensuring extensionless
archives work correctly by temporarily renaming them.

* test/lisp/arc-mode-tests.el
(arc-mode-test-zip-ensure-ext): New regression test for bug#61326.
---
 lisp/arc-mode.el            | 76 +++++++++++++++++++++++++++----------
 test/lisp/arc-mode-tests.el | 67 ++++++++++++++++++++++++++++++++
 2 files changed, 123 insertions(+), 20 deletions(-)

diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index 5e696c091b2..0a971799746 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -645,6 +645,49 @@ archive-get-descr
       (if (not noerror)
           (error "Line does not describe a member of the archive")))))
 ;; -------------------------------------------------------------------------
+;;; Section: Helper functions for requiring filename extensions
+
+(defun archive--act-files (command files)
+  (lambda (archive)
+    (apply #'call-process (car command)
+           nil nil nil (append (cdr command) (cons archive files)))))
+
+(defun archive--need-rename-p (&optional archive)
+  (let ((archive
+         (file-name-nondirectory (or archive buffer-file-name))))
+    (cl-case archive-subtype
+      ((zip) (not (seq-contains-p archive ?. #'eq))))))
+
+(defun archive--ensure-extension (archive ensure-extension)
+  (if ensure-extension
+      (make-temp-name (expand-file-name (concat archive "_tmp.")))
+    archive))
+
+(defun archive--maybe-rename (newname need-rename-p)
+  ;; Operating with archive as current buffer, and protect
+  ;; `default-directory' from being modified in `rename-visited-file'.
+  (when need-rename-p
+    (let ((default-directory default-directory))
+      (rename-visited-file newname))))
+
+(defun archive--with-ensure-extension (archive proc-fn)
+  (let ((saved default-directory))
+    (with-current-buffer (find-buffer-visiting archive)
+      (let ((ensure-extension (archive--need-rename-p))
+            (default-directory saved))
+        (unwind-protect
+            ;; Some archive programs (like zip) expect filenames to
+            ;; have an extension, so if necessary, temporarily rename
+            ;; an extensionless file for write accesses.
+            (let ((archive (archive--ensure-extension
+                            archive ensure-extension)))
+              (archive--maybe-rename archive ensure-extension)
+              (let ((exitcode (funcall proc-fn archive)))
+                (or (zerop exitcode)
+                    (error "Updating was unsuccessful (%S)" exitcode))))
+          (progn (archive--maybe-rename archive ensure-extension)
+                 (revert-buffer nil t)))))))
+;; -------------------------------------------------------------------------
 ;;; Section: the mode definition

 ;;;###autoload
@@ -1378,16 +1421,9 @@ archive-*-write-file-member
      (setq ename
        (encode-coding-string ename archive-file-name-coding-system))
           (let* ((coding-system-for-write 'no-conversion)
-        (default-directory (file-name-as-directory archive-tmpdir))
-        (exitcode (apply #'call-process
-                 (car command)
-                 nil
-                 nil
-                 nil
-                 (append (cdr command)
-                     (list archive ename)))))
-            (or (zerop exitcode)
-       (error "Updating was unsuccessful (%S)" exitcode))))
+                 (default-directory (file-name-as-directory archive-tmpdir)))
+            (archive--with-ensure-extension
+             archive (archive--act-files command (list ename)))))
       (archive-delete-local tmpfile))))

 (defun archive-write-file (&optional file)
@@ -1510,9 +1546,7 @@ archive-chgrp-entry
      (archive-resummarize))
       (error "Setting group is not supported for this archive type"))))

-(defun archive-expunge ()
-  "Do the flagged deletions."
-  (interactive)
+(defun archive--expunge-maybe-force (force)
   (let (files)
     (save-excursion
       (goto-char archive-file-list-start)
@@ -1526,7 +1560,8 @@ archive-expunge
     (and files
     (or (not archive-read-only)
         (error "Archive is read-only"))
-    (or (yes-or-no-p (format "Really delete %d member%s? "
+         (or force
+             (yes-or-no-p (format "Really delete %d member%s? "
                  (length files)
                  (if (null (cdr files)) "" "s")))
         (error "Operation aborted"))
@@ -1540,13 +1575,14 @@ archive-expunge
           (archive-resummarize)
         (revert-buffer))))))

+(defun archive-expunge ()
+  "Do the flagged deletions."
+  (interactive)
+  (archive--expunge-maybe-force nil))
+
 (defun archive-*-expunge (archive files command)
-  (apply #'call-process
-    (car command)
-    nil
-    nil
-    nil
-    (append (cdr command) (cons archive files))))
+  (archive--with-ensure-extension
+   archive (archive--act-files command files)))

 (defun archive-rename-entry (newname)
   "Change the name associated with this entry in the archive file."
diff --git a/test/lisp/arc-mode-tests.el b/test/lisp/arc-mode-tests.el
index 32bce1b71bd..ae44ef3439c 100644
--- a/test/lisp/arc-mode-tests.el
+++ b/test/lisp/arc-mode-tests.el
@@ -46,6 +46,73 @@ arc-mode-test-zip-extract-gz
       (when (buffer-live-p zip-buffer) (kill-buffer zip-buffer))
       (when (buffer-live-p gz-buffer) (kill-buffer gz-buffer)))))

+(ert-deftest arc-mode-test-zip-ensure-ext ()
+  ;; Bug#61326
+  (skip-unless (executable-find "zip"))
+  (let* ((default-directory arc-mode-tests-data-directory)
+         (base-zip-1 "base-1.zip")
+         (base-zip-2 "base-2.zip")
+         (content-1 '("1" "2"))
+         (content-2 '("3" "4"))
+         (make-file (lambda (name)
+                      (with-temp-buffer
+                        (insert name)
+                        (write-file name))))
+         (make-zip
+          (lambda (zip files)
+            (delete-file zip nil)
+            (funcall (archive--act-files '("zip") files) zip)))
+         (update-fn
+          (lambda (zip-nonempty)
+            (with-current-buffer (find-file-noselect zip-nonempty)
+              (save-excursion
+                (goto-char archive-file-list-start)
+                (save-current-buffer
+                  (archive-extract)
+                  (save-excursion
+                    (goto-char (point-max))
+                    (insert ?a)
+                    (save-buffer))
+                  (kill-buffer (current-buffer)))
+                (archive-extract)
+                ;; [2] must be ?a; [3] must be (eobp)
+                (should (eq (char-after 2) ?a))
+                (should (eq (point-max) 3))))))
+         (delete-fn
+          (lambda (zip-nonempty)
+            (with-current-buffer (find-file-noselect zip-nonempty)
+              ;; mark delete and expunge first entry
+              (save-excursion
+                (goto-char archive-file-list-start)
+                (should (length= archive-files 2))
+                (archive-flag-deleted 1)
+                (archive--expunge-maybe-force t)
+                (should (length= archive-files 1))))))
+         (test-modify
+          (lambda (zip mod-fn)
+            (let ((zip-base (concat zip ".zip"))
+                  (tag (gensym)))
+              (copy-file base-zip-1 zip t)
+              (copy-file base-zip-2 zip-base t)
+              (file-has-changed-p zip tag)
+              (file-has-changed-p zip-base tag)
+              (funcall mod-fn zip)
+              (should-not (file-has-changed-p zip-base tag))
+              (should (file-has-changed-p zip tag))))))
+    ;; setup: make two zip files with different contents
+    (mapc make-file (append content-1 content-2))
+    (mapc (lambda (args) (apply make-zip args))
+          (list (list base-zip-1 content-1)
+                (list base-zip-2 content-2)))
+    ;; test 1: with "test-update" and "test-update.zip", update
+    ;; "test-update": (1) ensure only "test-update" is modified, (2)
+    ;; ensure the contents of the new member is expected.
+    (funcall test-modify "test-update" update-fn)
+    ;; test 2: with "test-delete" and "test-delete.zip", delete entry
+    ;; from "test-delete": (1) ensure only "test-delete" is modified,
+    ;; (2) ensure the file list is reduced as expected.
+    (funcall test-modify "test-delete" delete-fn)))
+
 (provide 'arc-mode-tests)

 ;;; arc-mode-tests.el ends here
--
2.39.2


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


--
Best,


RY