emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

master ead957a 1/2: Add support for squashfs files in archive mode


From: Lars Ingebrigtsen
Subject: master ead957a 1/2: Add support for squashfs files in archive mode
Date: Fri, 23 Oct 2020 09:11:45 -0400 (EDT)

branch: master
commit ead957a2c3281002d5675f0f6efdc28ea223ea6f
Author: Ruthra Kumar <ruthrab@gmail.com>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Add support for squashfs files in archive mode
    
    * lisp/arc-mode.el (archive-squashfs-extract): New variable
    (bug#43827).
    (archive-find-type): Identify squashfs.
    (archive-squashfs-summarize, archive-squashfs-extract-by-stdout):
    New functions to parse/extract squashfs.
    
    * lisp/files.el (auto-mode-alist): Add squashfs.
---
 etc/NEWS                   |   3 ++
 lisp/arc-mode.el           | 120 ++++++++++++++++++++++++++++++++++++++++-----
 lisp/files.el              |   4 +-
 lisp/international/mule.el |   4 +-
 4 files changed, 116 insertions(+), 15 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 9e8182a..11c19b3 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -308,6 +308,9 @@ and variables.
 
 ** Archive mode
 
+---
+*** Archive Mode can now parse .squashfs files.
+
 *** Can now modify members of 'ar' archives.
 
 *** Display of summaries unified between backends.
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index eb62a85..ce0c061 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -51,17 +51,17 @@
 ;; ARCHIVE TYPES: Currently only the archives below are handled, but the
 ;; structure for handling just about anything is in place.
 ;;
-;;                     Arc     Lzh     Zip     Zoo     Rar     7z      Ar
-;;                     --------------------------------------------------
-;; View listing                Intern  Intern  Intern  Intern  Y       Y       
Y
-;; Extract member      Y       Y       Y       Y       Y       Y       Y
-;; Save changed member Y       Y       Y       Y       N       Y       Y
-;; Add new member      N       N       N       N       N       N       N
-;; Delete member       Y       Y       Y       Y       N       Y       N
-;; Rename member       Y       Y       N       N       N       N       N
-;; Chmod               -       Y       Y       -       N       N       N
-;; Chown               -       Y       -       -       N       N       N
-;; Chgrp               -       Y       -       -       N       N       N
+;;                     Arc     Lzh     Zip     Zoo     Rar     7z      Ar      
Squashfs
+;;                     
---------------------------------------------------------------
+;; View listing                Intern  Intern  Intern  Intern  Y       Y       
Y       Y
+;; Extract member      Y       Y       Y       Y       Y       Y       Y       
Y
+;; Save changed member Y       Y       Y       Y       N       Y       Y       
N
+;; Add new member      N       N       N       N       N       N       N       
N
+;; Delete member       Y       Y       Y       Y       N       Y       N       
N
+;; Rename member       Y       Y       N       N       N       N       N       
N
+;; Chmod               -       Y       Y       -       N       N       N       
N
+;; Chown               -       Y       -       -       N       N       N       
N
+;; Chgrp               -       Y       -       -       N       N       N       
N
 ;;
 ;; Special thanks to Bill Brodie <wbrodie@panix.com> for very useful tips
 ;; on the first released version of this package.
@@ -370,6 +370,24 @@ file.  Archive and member name will be added."
                       :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 squashsfs 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")))
+  :version "28.1"
+  :group 'archive-squashfs)
+
 ;; -------------------------------------------------------------------------
 ;;; Section: Variables
 
@@ -741,6 +759,7 @@ archive.
                 (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")))))
 ;; -------------------------------------------------------------------------
 
@@ -2280,6 +2299,85 @@ NAME is expected to be the 16-bytes part of an ar 
record."
    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))
+      (when copy
+        (delete-file copy))
+      (goto-char (point-min))
+      (search-forward-regexp "[drwxl\\-]\\{10\\}")
+      (beginning-of-line)
+      (while (looking-at (concat
+                          "^\\(.[rwx\\-]\\{9\\}\\) " ;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))
+          ;; Only list directory and regular files
+          (when (or (eq (aref flags 0) ?d)
+                    (eq (aref flags 0) ?-))
+            (when (equal name "squashfs-root")
+              (setf name "/"))
+            ;; Remove 'squashfs-root/' from filenames.
+            (setq name (string-replace "squashfs-root/" "" name))
+            (setq date-time (concat date " " time))
+            (setq mode (logior
+                        (cond
+                         ((eq (aref flags 0) ?d) #o40000)
+                         (t 0))
+                        ;; Convert symbolic to octal representation.
+                        (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))))))
+            (push (archive--file-desc name name mode size
+                                      date-time :uid uid :gid gid)
+                  files)))
+        (goto-char (match-end 0))))
+    (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 bbc8f88..fdf758a 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -2758,8 +2758,8 @@ since only a single case-insensitive search through the 
alist is made."
      ;; 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 2af64de..ad9c3a2 100644
--- a/lisp/international/mule.el
+++ b/lisp/international/mule.el
@@ -1710,8 +1710,8 @@ in-place."
   ;; 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)



reply via email to

[Prev in Thread] Current Thread [Next in Thread]