From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Ruijie Yu via "Bug reports for GNU Emacs, the Swiss army knife of text editors" Newsgroups: gmane.emacs.bugs Subject: bug#61326: [DRAFT PATCH v4] Work around zip's filename extension limitation (was: Adding --no-add-suffix to zip patch) Date: Mon, 06 Mar 2023 12:05:23 +0800 Message-ID: References: <87ilgeoc4w.fsf@tullinup.koldfront.dk> <8574C128-9560-490A-88E6-49E415BBDB24@netyu.xyz> <83k00up32i.fsf@gnu.org> <83bkm4nihw.fsf@gnu.org> <83zg8sahin.fsf@gnu.org> <83jzzwa6u3.fsf@gnu.org> <83h6uz8ac4.fsf@gnu.org> Reply-To: Ruijie Yu Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="28414"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: mu4e 1.8.14; emacs 30.0.50 Cc: asjo@koldfront.dk, 61326@debbugs.gnu.org To: Eli Zaretskii Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Mon Mar 06 05:48:21 2023 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1pZ2lo-00079p-BR for geb-bug-gnu-emacs@m.gmane-mx.org; Mon, 06 Mar 2023 05:48:20 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pZ2la-00041Y-Rz; Sun, 05 Mar 2023 23:48:06 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pZ2lX-00041E-18 for bug-gnu-emacs@gnu.org; Sun, 05 Mar 2023 23:48:03 -0500 Original-Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pZ2lW-0005mY-HU for bug-gnu-emacs@gnu.org; Sun, 05 Mar 2023 23:48:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pZ2lW-0006Kf-D1 for bug-gnu-emacs@gnu.org; Sun, 05 Mar 2023 23:48:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Ruijie Yu Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Mon, 06 Mar 2023 04:48:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 61326 X-GNU-PR-Package: emacs Original-Received: via spool by 61326-submit@debbugs.gnu.org id=B61326.167807803224149 (code B ref 61326); Mon, 06 Mar 2023 04:48:02 +0000 Original-Received: (at 61326) by debbugs.gnu.org; 6 Mar 2023 04:47:12 +0000 Original-Received: from localhost ([127.0.0.1]:41088 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pZ2kh-0006HR-7L for submit@debbugs.gnu.org; Sun, 05 Mar 2023 23:47:12 -0500 Original-Received: from netyu.xyz ([152.44.41.246]:40566 helo=mail.netyu.xyz) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pZ2ke-0006HI-Vd for 61326@debbugs.gnu.org; Sun, 05 Mar 2023 23:47:09 -0500 Original-Received: from fw.net.yu.netyu.xyz ( [222.248.4.98]) by netyu.xyz (OpenSMTPD) with ESMTPSA id 7b060f83 (TLSv1.3:TLS_AES_256_GCM_SHA384:256:NO); Mon, 6 Mar 2023 04:47:07 +0000 (UTC) In-reply-to: <83h6uz8ac4.fsf@gnu.org> X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:257369 Archived-At: --=-=-= Content-Type: text/plain Eli Zaretskii 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. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-REVIEW-pull-out-content-of-arc-expunge-for-nonintera.patch >From 3b9196a095c6843b7c87b867a82fa7a2d930bb0b Mon Sep 17 00:00:00 2001 From: Ruijie Yu 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-Handle-modifications-on-extensionless-zips-correctly.patch >From ba5825f9bdd323a460f4a327670d99ed34df3128 Mon Sep 17 00:00:00 2001 From: Ruijie Yu 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 --=-=-= Content-Type: text/plain -- Best, RY --=-=-=--