bug#43827: #42223 patch

[Ruthra Kumar]

Fixed the bug. It's now able to list and extract files from archive.

There is 1 edge case. If you press 'e' or 'RET' on a directory, the
expected behaviour is the message 'Entry is not a regular member of
archive'. Here, it tries to extract it as a file, cause
'archive-get-descr' fails to determine the type of the entry using
'mode' attribute. I face similar issues on RAR archive files as well.

I suspect the 'mode' is not an exact integer representation of file
permissions. Need more details on the 'mode' attribute of class

Currently, the 'mode' value for squashfs is calculated from the file
permissions outputted by 'unsquashfs -ll'.
Ex: "-rwxrwxr-x" -> #o775

> But it sounds like a useful addition (if the bugs can be fixed), but for
> such a big addition, we'd need to have the copyright on the code
> assigned to the FSF.  Would you be willing to do so?

Yes, i'm willing to assign copyright to Free Software Foundation. Let
me know the procedure.

diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index c998a8a1f1..4eb5a0af6e 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -371,6 +371,25 @@ archive-7z-update
                :inline t
                (string :format "%v"))))

+;; ------------------------------
+;; Squashfs archive configuration
+
+(defgroup archive-squashfs nil
+  "Squashfs-specific options to archive."
+  :group 'archive)
+
+(defcustom archive-squashfs-extract
+  '("rdsquashfs" "-c")
+  "Program and its options to run in order to extract a zip file member.
+Extraction should happen to standard output.  Archive and member name will
+be added."
+  :type '(list (string :tag "Program")
+           (repeat :tag "Options"
+               :inline t
+               (string :format "%v")))
+  :group 'archive-squashfs)
+
+
 ;; -------------------------------------------------------------------------
 ;;; Section: Variables

@@ -742,6 +761,7 @@ archive-find-type
                 (re-search-forward "Rar!" (+ (point) 100000) t))
            'rar-exe)
       ((looking-at "7z\274\257\047\034") '7z)
+          ((looking-at "hsqs") 'squashfs)
       (t (error "Buffer format not recognized")))))
 ;; -------------------------------------------------------------------------

@@ -2281,6 +2301,73 @@ archive-ar-write-file-member
    descr
    '("ar" "r")))

+;; -------------------------------------------------------------------------
+;;; Section Squashfs archives.
+
+(defun archive-squashfs-summarize (&optional file)
+  (unless file (setq file buffer-file-name))
+  (let* ((copy (file-local-copy file))
+         (files ()))
+    (with-temp-buffer
+      (call-process "unsquashfs" nil t nil "-ll" (or file copy))
+      (if copy (delete-file copy))
+      (goto-char (point-min))
+      (search-forward-regexp "[drwxl\\-]\\{10\\}")
+      (search-forward "squashfs-root" nil t nil)
+      (beginning-of-line)
+      (while
+          (looking-at (concat "^\\([drwxl\\-]\\{10\\}\\) "        ;Mode
+                              "\\(.+\\)/\\(.+\\) "  ;user/group
+                              "\\(.+\\) "     ;size
+
"\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\) " ;date
+                              "\\([0-9]\\{2\\}:[0-9]\\{2\\}\\) " ;time
+                              "\\(.+\\)\n"     ;Filename
+                              ))
+        (let*
+            ((name (match-string 7))
+             (flags (match-string 1))
+             (uid (match-string 2))
+             (gid (match-string 3))
+             (size (string-to-number (match-string 4)))
+             (date (match-string 5))
+             (time (match-string 6))
+             (date-time)
+             (mode))
+          (goto-char (match-end 0))
+          (if (equal name "squashfs-root")
+              (setf name "/"))
+          (setq name (string-replace "squashfs-root/" "" name))
;remove 'squashfs-root/' in filenames
+          (setq date-time (concat date " " time))
+          (setq mode (file-modes-symbolic-to-number (concat "u="
(string-replace "-" ""  (substring flags 1 4))
+                                                            ",g="
(string-replace "-" ""  (substring flags 4 7))
+                                                            ",o="
(string-replace "-" ""  (substring flags 7 10)))))  ;convert symbolic
to integer representation
+          (push (archive--file-desc name name mode size date-time
:uid uid :gid gid)
+                files))))
+    (archive--summarize-descs (nreverse files))
+    ))
+
+(defun archive-squashfs-extract-by-stdout (archive name command
&optional stderr-test)
+  (let ((stderr-file (make-temp-file "arc-stderr")))
+    (unwind-protect
+    (prog1
+        (apply #'call-process
+           (car command)
+           nil
+           (if stderr-file (list t stderr-file) t)
+           nil
+           (append (cdr command) (list name archive)))
+      (with-temp-buffer
+        (insert-file-contents stderr-file)
+        (goto-char (point-min))
+        (when (if (stringp stderr-test)
+              (not (re-search-forward stderr-test nil t))
+            (> (buffer-size) 0))
+          (message "%s" (buffer-string)))))
+      (if (file-exists-p stderr-file)
+          (delete-file stderr-file)))))
+
+(defun archive-squashfs-extract (archive name)
+  (archive-squashfs-extract-by-stdout archive name archive-squashfs-extract))

 ;; -------------------------------------------------------------------------
 ;; This line was a mistake; it is kept now for compatibility.
diff --git a/lisp/files.el b/lisp/files.el
index c2c58dae93..aca62fe7eb 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -2758,8 +2758,8 @@ auto-mode-alist
      ;; The list of archive file extensions should be in sync with
      ;; `auto-coding-alist' with `no-conversion' coding system.
      ("\\.\\(\
-arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\|rar\\|cbr\\|7z\\|\
-ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\)\\'" .
archive-mode)
+arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\|rar\\|cbr\\|7z\\|squashfs\\|\
+ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\|SQUASHFS\\)\\'"
. archive-mode)
      ("\\.oxt\\'" . archive-mode) ;(Open|Libre)Office extensions.
      ("\\.\\(deb\\|[oi]pk\\)\\'" . archive-mode) ; Debian/Opkg packages.
      ;; Mailer puts message to be edited in
diff --git a/lisp/international/mule.el b/lisp/international/mule.el
index 2af64de77b..ad9c3a2306 100644
--- a/lisp/international/mule.el
+++ b/lisp/international/mule.el
@@ -1710,8 +1710,8 @@ auto-coding-alist
   ;; self-extracting exe archives.
   (mapcar (lambda (arg) (cons (purecopy (car arg)) (cdr arg)))
       '(("\\.\\(\
-arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\|rar\\|7z\\|\
-ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|7Z\\)\\'"
+arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\|rar\\|7z\\|squashfs\\|\
+ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|7Z\\|SQUASHFS\\)\\'"
      . no-conversion-multibyte)
     ("\\.\\(exe\\|EXE\\)\\'" . no-conversion)
     ("\\.\\(sx[dmicw]\\|odt\\|tar\\|t[bg]z\\)\\'" . no-conversion)


On Wed, Oct 7, 2020 at 9:23 AM Lars Ingebrigtsen <larsi@gnus.org> wrote:
>
> Ruthra Kumar <ruthrab@gmail.com> writes:
>
> > Bug #42223. Added support for squashfs archive files. arc-mode can now show 
> > a
> > dired like listing of squashfs files.
>
> I tried applying your patch to Emacs 28, and then opened a .snap file
> (which is supposed to be a squashfs file system), but it failed with
> the backtrace included below.
>
> But it sounds like a useful addition (if the bugs can be fixed), but for
> such a big addition, we'd need to have the copyright on the code
> assigned to the FSF.  Would you be willing to do so?
>
>
> ---
> Backtrace:
>
> Debugger entered--Lisp error: (wrong-type-argument archive--file-summary [" 
> -rw-r--r--    0/0 android.img" 19 30])
>   signal(wrong-type-argument (archive--file-summary [" -rw-r--r--    0/0 
> android.img" 19 30]))
>   archive-summarize-files(([" -rw-r--r--    0/0 android.img" 19 30] [" 
> -rw-r--r--    0/0 apparmor/anbox-container.aa" 19 46] [" -rwxr-xr-x    0/0 
> bin/anbox-bridge.sh" 19 38] [" -rwxr-xr-x    0/0 bin/anbox-shell.sh" 19 37] 
> [" -rwxr-xr-x    0/0 bin/anbox-wrapper.sh" 19 39] [" -rwxr-xr-x    0/0 
> bin/app-android-settings.sh" 19 46] [" -rwxr-xr-x    0/0 bin/app-appmgr.sh" 
> 19 36] [" -rwxr-xr-x    0/0 bin/collect-bug-info.sh" 19 42] [" -rwxr-xr-x    
> 0/0 bin/container-manager.sh" 19 43] [" -rwxr-xr-x    0/0 bin/desktop-launch" 
> 19 37] [" -rwxr-xr-x    0/0 bin/lxc-attach" 19 33] [" -rwxr-xr-x    0/0 
> bin/lxc-info" 19 31] [" -rwxr-xr-x    0/0 bin/lxc-ls" 19 29] [" -rwxr-xr-x    
> 0/0 bin/lxc-start" 19 32] [" -rwxr-xr-x    0/0 bin/lxc-stop" 19 31] [" 
> -rwxr-xr-x    0/0 bin/lxc-top" 19 30] [" -rwxr-xr-x    0/0 
> command-anbox.wrapper" 19 40] [" -rwxr-xr-x    0/0 
> command-android-settings.wrappe..." 19 51] [" -rwxr-xr-x    0/0 
> command-appmgr.wrapper" 19 41] [" -rwxr-xr-x    0/0 
> command-collect-bug-info.wrappe..." 19 51] [" -rwxr-xr-x    0/0 
> command-container-manager.wrapp..." 19 52] [" -rwxr-xr-x    0/0 
> command-shell.wrapper" 19 40] [" -rw-r--r--    0/0 
> desktop/android-settings.deskto..." 19 51] [" -rw-r--r--    0/0 
> desktop/appmgr.desktop" 19 41] [" -rw-r--r--    0/0 etc/apparmor/parser.conf" 
> 19 43] [" -rw-r--r--    0/0 etc/apparmor/subdomain.conf" 19 46] [" -rw-r--r-- 
>    0/0 etc/apparmor.d/abstractions/X" 19 48] [" -rw-r--r--    0/0 
> etc/apparmor.d/abstractions/apa..." 19 61] [" -rw-r--r--    0/0 
> etc/apparmor.d/abstractions/app..." 19 74] [" -rw-r--r--    0/0 
> etc/apparmor.d/abstractions/app..." 19 67] [" -rw-r--r--    0/0 
> etc/apparmor.d/abstractions/app..." 19 75] [" -rw-r--r--    0/0 
> etc/apparmor.d/abstractions/app..." 19 70] [" -rw-r--r--    0/0 
> etc/apparmor.d/abstractions/app..." 19 70] [" -rw-r--r--    0/0 
> etc/apparmor.d/abstractions/asp..." 19 53] [" -rw-r--r--    0/0 
> etc/apparmor.d/abstractions/aud..." 19 52] [" -rw-r--r--    0/0 
> etc/apparmor.d/abstractions/aut..." 19 61] [" -rw-r--r--    0/0 
> etc/apparmor.d/abstractions/bas..." 19 51] [" -rw-r--r--    0/0 
> etc/apparmor.d/abstractions/bas..." 19 51] [" -rw-r--r--    0/0 
> etc/apparmor.d/abstractions/con..." 19 55] [" -rw-r--r--    0/0 
> etc/apparmor.d/abstractions/cup..." 19 58] [" -rw-r--r--    0/0 
> etc/apparmor.d/abstractions/dbu..." 19 51] [" -rw-r--r--    0/0 
> etc/apparmor.d/abstractions/dbu..." 19 65] [" -rw-r--r--    0/0 
> etc/apparmor.d/abstractions/dbu..." 19 72] [" -rw-r--r--    0/0 
> etc/apparmor.d/abstractions/dbu..." 19 59] [" -rw-r--r--    0/0 
> etc/apparmor.d/abstractions/dbu..." 19 66] [" -rw-r--r--    0/0 
> etc/apparmor.d/abstractions/dbu..." 19 58] [" -rw-r--r--    0/0 
> etc/apparmor.d/abstractions/dco..." 19 52] [" -rw-r--r--    0/0 
> etc/apparmor.d/abstractions/dov..." 19 61] [" -rw-r--r--    0/0 
> etc/apparmor.d/abstractions/enc..." 19 54] [" -rw-r--r--    0/0 
> etc/apparmor.d/abstractions/fon..." 19 52] ...))
>   archive-squashfs-summarize()
>   archive-summarize(nil)
>   archive-mode()
>   set-auto-mode-0(archive-mode nil)
>   set-auto-mode()
>   normal-mode(t)
>   after-find-file(nil t)
>   find-file-noselect-1(#<buffer 
> Nr9K6UJaIOD8wHpDEQl16nabFFt9LLEQ_185.squashfs> 
> "~/Downloads/Nr9K6UJaIOD8wHpDEQl16nabFFt9LLEQ_185.s..." nil nil 
> "~/Downloads/Nr9K6UJaIOD8wHpDEQl16nabFFt9LLEQ_185.s..." (24380717 66306))
>   find-file-noselect("/home/larsi/Downloads/Nr9K6UJaIOD8wHpDEQl16nabFFt9..." 
> nil nil nil)
>   find-file("/home/larsi/Downloads/Nr9K6UJaIOD8wHpDEQl16nabFFt9...")
>   dired-find-file()
>   funcall-interactively(dired-find-file)
>   call-interactively(dired-find-file nil nil)
>   command-execute(dired-find-file)
>
>
> --
> (domestic pets only, the antidote for overdose, milk.)
>    bloggy blog: http://lars.ingebrigtsen.no