unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
* bug#43827: #42223 patch
@ 2020-10-06  5:23 Ruthra Kumar
  2020-10-07  3:53 ` Lars Ingebrigtsen
  0 siblings, 1 reply; 8+ messages in thread
From: Ruthra Kumar @ 2020-10-06  5:23 UTC (permalink / raw)
  To: 43827


[-- Attachment #1.1: Type: text/plain, Size: 170 bytes --]

Severity: wishlist
Tags: patch

Bug #42223. Added support for squashfs archive files. arc-mode can now show
a dired like listing of squashfs files.

Regards
Ruthra Kumar

[-- Attachment #1.2: Type: text/html, Size: 279 bytes --]

[-- Attachment #2: 0001-Bug-42223-squashfs-mode.patch --]
[-- Type: text/x-patch, Size: 7429 bytes --]

From 95d7d5e3b70056fd572739eab3d0442d38441211 Mon Sep 17 00:00:00 2001
From: ruthra <ruthrab@gmail.com>
Date: Tue, 6 Oct 2020 10:36:26 +0530
Subject: [PATCH] Bug #42223 squashfs-mode Added support for squashfs archive
 files. Archive contents will be displayed in a dired like listing. Only read
 and extract operations are implemented as squashfs is a readonly format.

squashfs extension added to 'auto-mode-alist' and 'auto-coding-alist' variables.

Following new functions are added to 'arc-mode' major mode.
archive-squashfs-summarize
archive-squashfs-extract-by-stdout
archive-squashfs-extract
---
 lisp/arc-mode.el           | 97 ++++++++++++++++++++++++++++++++++++++
 lisp/files.el              |  4 +-
 lisp/international/mule.el |  4 +-
 3 files changed, 101 insertions(+), 4 deletions(-)

diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index c998a8a1f1..0388cfb484 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -371,6 +371,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 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 +760,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")))))
 ;; -------------------------------------------------------------------------
 
@@ -2281,6 +2300,84 @@ 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)
+  ;; File is used internally for `archive-rar-exe-summarize'.
+  (unless file (setq file buffer-file-name))
+  (let* ((copy (file-local-copy file))
+         (maxname 10)
+         (maxusergroup 6)
+         (files ()))
+    (with-temp-buffer
+      (call-process (car archive-squashfs-extract) nil t nil "-d" (or file copy))
+      (if copy (delete-file copy))
+      (goto-char (point-min))
+      (while (looking-at (concat "^\\(file\\|dir\\) " ;File or Directory
+			         "\\(.*\\) "    ;Filename                                 
+			         "\\([0-9]+\\) "	      ;File Permission
+			         "\\([0-9]+\\) "	      ;Uid
+			         "\\([0-9]+\\)\n"	      ;Gid
+			         ))
+        (goto-char (match-end 0))
+        (let ((name (match-string 2))
+              (type (match-string 1))
+              (permission (match-string 3))
+              (uid (match-string 4))
+              (guid (match-string 5))
+              (usergroup))
+          (if (equal type "file")
+              (progn 
+                (setq usergroup (concat uid "/" guid))
+                (if (> (length name) maxname) (setq maxname (length name)))
+                (if (> (length usergroup) maxusergroup) (setq maxusergroup (length usergroup)))
+                (push (vector name name
+                              nil nil
+                              nil usergroup (archive-int-to-mode (string-to-number permission 8)))
+                      files))))))
+    (setq files (nreverse files))
+    (goto-char (point-min))
+    (let* ((format (format " %%10s %%%ds %%s" maxusergroup))
+           (sep (format format "----------" (make-string maxusergroup ?-) ""))
+           (column (length sep)))
+      (insert (format format "Filemode" "uid/gid" "Filename") "\n")
+      (insert sep (make-string maxname ?-) "\n")
+      (archive-summarize-files (mapcar (lambda (desc)
+                                         (let ((text
+                                                (format format
+                                                        (aref desc 6)  ;Filemode
+                                                        (aref desc 5) ;uid
+                                                        (aref desc 0)))) ;Filename
+                                           (vector text
+                                                   column
+                                                   (length text))))
+                                       files))
+      (insert sep (make-string maxname ?-) "\n")
+      (apply #'vector 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 @@ 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 e7496c08bf..e0d248a490 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)
-- 
2.23.0


^ permalink raw reply related	[flat|nested] 8+ messages in thread
end of thread, other threads:[~2020-10-23 11:03 UTC | newest]

Thread overview: 8+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2020-10-06  5:23 bug#43827: #42223 patch Ruthra Kumar
2020-10-07  3:53 ` Lars Ingebrigtsen
2020-10-08  6:31   ` Ruthra Kumar
2020-10-09  4:19     ` Lars Ingebrigtsen
2020-10-09  5:25       ` Ruthra Kumar
2020-10-10 20:03         ` bug#43827: #42223 squashfs patch Lars Ingebrigtsen
2020-10-23  6:09           ` Ruthra Kumar
2020-10-23 11:03             ` Lars Ingebrigtsen

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).