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)