bug#61326: [DRAFT PATCH v4] 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: 2422 bytes --]


Eli Zaretskii <eliz@gnu.org> writes:

> [...]
>> By the way, while writing tests, I see a need to modify
>> `archive-expunge' to accept an additional optional argument FORCE acting
>> as the prefix argument.  I suppose if this is favored, I should probably
>> say something in the etc/NEWS file (as well as the docstring, and maybe
>> an info page somewhere)?  FTR, previously prefix arguments are ignored
>> for `archive-expunge'.
>>
>> The reason for the need of a FORCE argument is so that I want to ensure
>> that file contents are correct after deleting a member using
>> archive-mode functionalities without getting prompted for confirmation.
>> However, `archive-expunge' ATM requires a user prompt via its baked-in
>> `yes-or-no-p' call.
>
> This is a separate feature.  [...] So if we are going to treat
> archive-expunge differently, I think we'll need a very good reason.

I see, thanks for explaining.

In the attached patches I followed the alternative approach which I
described in my previous message: take the meat of the function into a
separate helper function, and use that in the `archive-expunge' function
and in my new test.  If someone else has a good reason for using prefix
argument to "force" deletion, they can ask in a new bug report.

Another question regarding this change: when moving `archive-expunge'
into `archive--expunge-maybe-force', I rewrote the portion that
populates the list of files that are marked for deletion.  Originally it
was using `while' + `setq', and seeing that arc-mode.el already requires
`cl-lib', I turned it into a `cl-do' construct.  Do people have a
preference or does it matter?  I can change this portion back to the
original if there's objection.

To ease the review process, I have broken down the changes into two
patch files.  The first one is merely to take out `archive-expunge' into
helper function `archive--expunge-maybe-force', and the second one is
everything else, including the tests.

The goal for the final patch is to combine these two into one, to make
necessary indentation changes around the portions that I touched, and to
only use the commit message of the second patch _verbatim_ -- so please
verify that this commit message is satisfactory in emacs.git, thanks.

FTR, I ran `make check' and ensured that my changes didn't introduce
regressions, while also noticed that some tests in vc and eglot fail
both before and after my changes.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-REVIEW-pull-out-content-of-arc-expunge-for-nonintera.patch --]
[-- Type: text/x-patch, Size: 2229 bytes --]

From 3b9196a095c6843b7c87b867a82fa7a2d930bb0b 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 1/2] REVIEW: pull out content of arc-expunge for
 noninteractive deletion

---
 lisp/arc-mode.el | 30 +++++++++++++++++++-----------
 1 file changed, 19 insertions(+), 11 deletions(-)

diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index 6f3e922880d..f8d7182597b 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -1508,23 +1508,26 @@ archive-chgrp-entry
      (archive-resummarize))
       (error "Setting group is not supported for this archive type"))))

-(defun archive-expunge ()
-  "Do the flagged deletions."
-  (interactive)
-  (let (files)
+(defun archive--expunge-maybe-force (force)
+  (let ((files
     (save-excursion
       (goto-char archive-file-list-start)
-      (while (< (point) archive-file-list-end)
-        (if (= (following-char) ?D)
-       (setq files (cons (archive--file-desc-ext-file-name
+           (cl-do ((files
+                    nil
+                    (prog1
+                        (if (eq (following-char) ?D)
+                            (cons (archive--file-desc-ext-file-name
                           (archive-get-descr))
-                         files)))
-        (forward-line 1)))
-    (setq files (nreverse files))
+                                  files)
+                          files)
+                      (forward-line 1))))
+               ((>= (point) archive-file-list-end)
+                (nreverse files))))))
     (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"))
@@ -1538,6 +1541,11 @@ 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)
--
2.39.2


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

From ba5825f9bdd323a460f4a327670d99ed34df3128 Mon Sep 17 00:00:00 2001
From: Ruijie Yu <ruijie+git@netyu.xyz>
Date: Thu, 9 Feb 2023 00:45:19 +0800
Subject: [PATCH 2/2] Handle modifications on extensionless zips correctly
 (bug#61326)

* lisp/arc-mode.el: Refactor to handle extless zips
* test/lisp/arc-mode-tests.el: New test for correctly handling extless zips
---
 lisp/arc-mode.el            | 64 ++++++++++++++++++++++++++---------
 test/lisp/arc-mode-tests.el | 67 +++++++++++++++++++++++++++++++++++++
 2 files changed, 115 insertions(+), 16 deletions(-)

diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index f8d7182597b..47611f13b6f 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
@@ -1376,16 +1419,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)
@@ -1547,12 +1583,8 @@ archive-expunge
   (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 #4: Type: text/plain, Size: 15 bytes --]


--
Best,


RY