From 4f035f090e1c1994216e9e7178544e80d0611991 Mon Sep 17 00:00:00 2001 From: Jens Schmidt Date: Fri, 18 Apr 2025 14:16:17 +0200 Subject: [PATCH] Detect more types of split zip archives * lisp/arc-mode.el (archive-find-type): Detect more types of split zip archives. * test/lisp/arc-mode-tests.el (arc-mode-test-make-file) (arc-mode-test-make-archive): Factor out functions from ... (arc-mode-test-zip-ensure-ext): ... this test. (define-arc-mode-test-on-type): Add macro to test function `archive-find-type' and use the macro to test detection of various archive types. (Bug 77898) (cherry picked from commit d74cbf0519edff34f334b62b4f163e98d51336e0) --- lisp/arc-mode.el | 10 +++- test/lisp/arc-mode-tests.el | 92 +++++++++++++++++++++++++++++++------ 2 files changed, 88 insertions(+), 14 deletions(-) diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index a2b4725e242..5c707576376 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -793,7 +793,15 @@ archive. ;; The funny [] here make it unlikely that the .elc file will be treated ;; as an archive by other software. (let (case-fold-search) - (cond ((looking-at "\\(PK00\\)?[P]K\003\004") 'zip) + ;; See APPNOTE.txt (version 6.3.10) from PKWARE for the zip + ;; file signatures: + ;; - PK\003\004 == 0x04034b50: local file header signature + ;; (section 4.3.7) + ;; - PK\007\010 == 0x08074b50 (followed by local header): + ;; spanned/split archive signature (section 8.5.3) + ;; - PK00 == 0x30304b50 (followed by local header): temporary + ;; spanned/split archive signature (section 8.5.4) + (cond ((looking-at "\\(?:PK\007\010\\|PK00\\)?[P]K\003\004") 'zip) ((looking-at "..-l[hz][0-9ds]-") 'lzh) ((looking-at "....................[\334]\247\304\375") 'zoo) ((and (looking-at "\C-z") ; signature too simple, IMHO diff --git a/test/lisp/arc-mode-tests.el b/test/lisp/arc-mode-tests.el index f0bb46d734f..f6c84db1ad8 100644 --- a/test/lisp/arc-mode-tests.el +++ b/test/lisp/arc-mode-tests.el @@ -62,6 +62,79 @@ (when (buffer-live-p tar-buffer) (kill-buffer tar-buffer)) (when (buffer-live-p gz-buffer) (kill-buffer gz-buffer))))) +(defun arc-mode-test-make-file (name) + "Create file NAME in default directory with content NAME. +Return NAME." + (with-temp-buffer + (insert name) + (write-file name)) + name) + +(defun arc-mode-test-make-archive (command arc files) + "Call COMMAND to create archive ARC containing FILES. +Return a cons (ARC . EXIT-STATUS)." + (unless (listp command) + (setq command (list command))) + (delete-file arc nil) + (cons arc (funcall (archive--act-files command files) arc))) + +(defmacro define-arc-mode-test-on-type (name command extension type) + "Define and execute a test that tests function `archive-find-type'. +Name the test based on NAME. The generated test first calls + + (call-process (car COMMAND) nil nil nil + (append COMMAND (list ARCHIVE MEMBER))) + +to create file ARCHIVE with extension EXTENSION and containing a single +member MEMBER. Then the test finds ARCHIVE and ensures that function +`archive-find-type' detects it as an archive having type TYPE." + (let* ((command (eval command)) + (argv0 (car command)) + (type (eval type))) + `(ert-deftest ,(intern (format "arc-mode-test-type-%s" name)) () + (skip-unless (executable-find ,argv0)) + (let ((default-directory arc-mode-tests-data-directory) + (member nil) (archive nil) (buffer nil) + result exit-status type) + (unwind-protect + (progn + (setq member (arc-mode-test-make-file "member") + result (arc-mode-test-make-archive + (quote ,command) ,(format "arc.%s" extension) (list member)) + archive (car result) + exit-status (cdr result)) + ;; do not count archiver errors as test failures + (skip-unless (eq exit-status 0)) + (with-current-buffer + (setq buffer (find-file-literally archive)) + (setq type (condition-case err + (archive-find-type) + (error + ;; turn the most likely error into a nice + ;; and self-explaining symbol that can be + ;; compared in a `should' + (if (string= (cadr err) "Buffer format not recognized") + 'signature-not-recognized + (signal (car err) (cdr err)))))) + (should (eq type (quote ,type))))) + (when buffer (kill-buffer buffer)) + (dolist (file (list member archive)) + (when file (ignore-errors (delete-file file))))))))) + +(define-arc-mode-test-on-type "zip" '("zip") "zip" 'zip) + +(define-arc-mode-test-on-type "split-zip" '("zip" "-s1") "zip" 'zip) + +(define-arc-mode-test-on-type "arc" '("arc" "a") "arc" 'arc) + +(define-arc-mode-test-on-type "lha" '("lha" "a") "lzh" 'lzh) + +(define-arc-mode-test-on-type "rar" '("rar" "a") "rar" 'rar) + +(define-arc-mode-test-on-type "ar" '("ar" "q") "a" 'ar) + +(define-arc-mode-test-on-type "7z" '("7za" "a") "7z" '7z) + (ert-deftest arc-mode-test-zip-ensure-ext () "Regression test for bug#61326." (skip-unless (executable-find "zip")) @@ -71,16 +144,6 @@ (base-zip-2 "base-2.zip") (content-1 '("1" "2")) (content-2 '("3" "4")) - (make-file (lambda (name) - (push name created-files) - (with-temp-buffer - (insert name) - (write-file name)))) - (make-zip - (lambda (zip files) - (delete-file zip nil) - (push zip created-files) - (funcall (archive--act-files '("zip") files) zip))) (update-fn (lambda (zip-nonempty) (with-current-buffer (find-file-noselect zip-nonempty) @@ -123,9 +186,12 @@ (unwind-protect (progn ;; setup: make two zip files with different contents - (mapc make-file (append content-1 content-2)) - (funcall make-zip base-zip-1 content-1) - (funcall make-zip base-zip-2 content-2) + (dolist (file (append content-1 content-2)) + (push (arc-mode-test-make-file file) created-files)) + (push (car (arc-mode-test-make-archive "zip" base-zip-1 content-1)) + created-files) + (push (car (arc-mode-test-make-archive "zip" base-zip-2 content-2)) + created-files) ;; test 1: with "test-update" and "test-update.zip", update ;; "test-update": (1) ensure only "test-update" is modified, (2) -- 2.39.5