bug#43827: #42223 patch

[Ruthra Kumar <ruthrab@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 1388 bytes --]

attached latest diff.

On Fri, Oct 9, 2020 at 9:49 AM Lars Ingebrigtsen <larsi@gnus.org> wrote:
>
> Ruthra Kumar <ruthrab@gmail.com> writes:
>
> > Fixed the bug. It's now able to list and extract files from archive.
>
> Thanks; I was unable to try it because it seems like the patch was
> mangled during transport again.  Can you re-send it as an attachment?
>
> > 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
>
> Right.  That should be fixed, but if the same issue is present in .rar
> files, too, then doing so before integrating probably isn't necessary.
>
> > Yes, i'm willing to assign copyright to Free Software Foundation. Let
> > me know the procedure.
>
> Sent off-list.
>
> --
> (domestic pets only, the antidote for overdose, milk.)
>    bloggy blog: http://lars.ingebrigtsen.no

[-- Attachment #2: patch43827_01.diff --]
[-- Type: text/x-patch, Size: 6016 bytes --]

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)