From 95d7d5e3b70056fd572739eab3d0442d38441211 Mon Sep 17 00:00:00 2001 From: ruthra 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