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 v5] Work around zip's filename extension limitation (was: Adding --no-add-suffix to zip patch) Date: Fri, 17 Mar 2023 11:19:39 +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> <834jqry8fn.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="12113"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: mu4e 1.8.14; emacs 30.0.50 Cc: Eli Zaretskii , asjo@koldfront.dk, 61326@debbugs.gnu.org To: Ruijie Yu Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Fri Mar 17 04:53:30 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 1pd19m-0002wq-0m for geb-bug-gnu-emacs@m.gmane-mx.org; Fri, 17 Mar 2023 04:53:30 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pd19L-0000h9-TE; Thu, 16 Mar 2023 23:53:04 -0400 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 1pd19K-0000gw-QR for bug-gnu-emacs@gnu.org; Thu, 16 Mar 2023 23:53:02 -0400 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 1pd19K-0006IQ-HJ for bug-gnu-emacs@gnu.org; Thu, 16 Mar 2023 23:53:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pd19K-0008TL-0F for bug-gnu-emacs@gnu.org; Thu, 16 Mar 2023 23:53:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Ruijie Yu Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Fri, 17 Mar 2023 03:53:01 +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.167902512832484 (code B ref 61326); Fri, 17 Mar 2023 03:53:01 +0000 Original-Received: (at 61326) by debbugs.gnu.org; 17 Mar 2023 03:52:08 +0000 Original-Received: from localhost ([127.0.0.1]:43423 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pd18R-0008Rr-NL for submit@debbugs.gnu.org; Thu, 16 Mar 2023 23:52:08 -0400 Original-Received: from netyu.xyz ([152.44.41.246]:58110 helo=mail.netyu.xyz) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pd18J-0008RJ-NX for 61326@debbugs.gnu.org; Thu, 16 Mar 2023 23:52:05 -0400 Original-Received: from fw.net.yu.netyu.xyz ( [222.248.4.98]) by netyu.xyz (OpenSMTPD) with ESMTPSA id a6821310 (TLSv1.3:TLS_AES_256_GCM_SHA384:256:NO); Fri, 17 Mar 2023 03:51:58 +0000 (UTC) In-reply-to: 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:258047 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable > [...] > 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=C3=A3o 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. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Handle-modifications-on-extensionless-zips-correctly.patch >From f3b29596ef3ddfa63d6cd65fcbf8a5210e99989f Mon Sep 17 00:00:00 2001 From: Ruijie Yu 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 --=-=-= Content-Type: text/plain -- Best, RY --=-=-=--