+
+;; -------------------------------------------------------------------------
+;;; Section: Rar Archives
+
+(defun archive-rar-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)
+ (maxsize 5)
+ (files ()))
+ (with-temp-buffer
+ (call-process "unrar-free" nil t nil "--list" (or file copy))
+ (if copy (delete-file copy))
+ (goto-char (point-min))
+ (re-search-forward "^-+\n")
+ (while (looking-at (concat " \\(.*\\)\n" ;Name.
+ ;; Size ; Packed.
+ " +\\([0-9]+\\) +[0-9]+"
+ ;; Ratio ; Date'
+ " +\\([0-9%]+\\) +\\([-0-9]+\\)"
+ ;; Time ; Attr.
+ " +\\([0-9:]+\\) +......"
+ ;; CRC; Meth ; Var.
+ " +[0-9A-F]+ +[^ \n]+ +[0-9.]+\n"))
+ (goto-char (match-end 0))
+ (let ((name (match-string 1))
+ (size (match-string 2)))
+ (if (> (length name) maxname) (setq maxname (length name)))
+ (if (> (length size) maxsize) (setq maxsize (length size)))
+ (push (vector name name nil nil
+ ;; Size, Ratio.
+ size (match-string 3)
+ ;; Date, Time.
+ (match-string 4) (match-string 5))
+ files))))
+ (setq files (nreverse files))
+ (goto-char (point-min))
+ (let* ((format (format " %%s %%s %%%ds %%5s %%s" maxsize))
+ (sep (format format "--------" "-----" (make-string maxsize ?-)
+ "-----" ""))
+ (column (length sep)))
+ (insert (format format " Date " "Time " "Size " "Ratio" " Filename") "\n")
+ (insert sep (make-string maxname ?-) "\n")
+ (archive-summarize-files (mapcar (lambda (desc)
+ (let ((text
+ (format format
+ (aref desc 6)
+ (aref desc 7)
+ (aref desc 4)
+ (aref desc 5)
+ (aref desc 1))))
+ (vector text
+ column
+ (length text))))
+ files))
+ (insert sep (make-string maxname ?-) "\n")
+ (apply 'vector files))))
+
+(defun archive-rar-extract (archive name)
+ ;; unrar-free seems to have no way to extract to stdout or even to a file.
+ (if (file-name-absolute-p name)
+ ;; The code below assumes the name is relative and may do undesirable
+ ;; things otherwise.
+ (error "Can't extract files with non-relative names")
+ (let ((dest (make-temp-file "arc-rar" 'dir)))
+ (unwind-protect
+ (progn
+ (call-process "unrar-free" nil nil nil
+ "--extract" archive name dest)
+ (insert-file-contents-literally (expand-file-name name dest)))
+ (delete-file (expand-file-name name dest))
+ (while (file-name-directory name)
+ (setq name (directory-file-name (file-name-directory name)))
+ (delete-directory (expand-file-name name dest)))
+ (delete-directory dest)))))
+
+;;; Section: Rar self-extracting .exe archives.
+
+(defun archive-rar-exe-summarize ()
+ (let ((tmpfile (make-temp-file "rarexe")))
+ (unwind-protect
+ (progn
+ (goto-char (point-min))
+ (re-search-forward "Rar!")
+ (write-region (match-beginning 0) (point-max) tmpfile)
+ (archive-rar-summarize tmpfile))
+ (delete-file tmpfile))))
+
+(defun archive-rar-exe-extract (archive name)
+ (let* ((tmpfile (make-temp-file "rarexe"))
+ (buf (find-buffer-visiting archive))
+ (tmpbuf (unless buf (generate-new-buffer " *rar-exe*"))))
+ (unwind-protect
+ (progn
+ (with-current-buffer (or buf tmpbuf)
+ (save-excursion
+ (save-restriction
+ (if buf
+ ;; point-max unwidened is assumed to be the end of the
+ ;; summary text and the beginning of the actual file data.
+ (progn (goto-char (point-max)) (widen))
+ (insert-file-contents-literally archive)
+ (goto-char (point-min)))
+ (re-search-forward "Rar!")
+ (write-region (match-beginning 0) (point-max) tmpfile))))
+ (archive-rar-extract tmpfile name))
+ (if tmpbuf (kill-buffer tmpbuf))
+ (delete-file tmpfile))))
+
+
+;;; Section `ar' archives.
+
+;; TODO: we currently only handle the basic format of ar archives,
+;; not the GNU nor the BSD extensions. As it turns out, this is sufficient
+;; for .deb packages.
+
+(autoload 'tar-grind-file-mode "tar-mode")
+
+(defconst archive-ar-file-header-re
+ "\\(.\\{16\\}\\)\\([ 0-9]\\{12\\}\\)\\([ 0-9]\\{6\\}\\)\\([ 0-9]\\{6\\}\\)\\([ 0-7]\\{8\\}\\)\\([ 0-9]\\{10\\}\\)`\n")
+
+(defun archive-ar-summarize ()
+ ;; File is used internally for `archive-rar-exe-summarize'.
+ (let* ((maxname 10)
+ (maxtime 16)
+ (maxuser 5)
+ (maxgroup 5)
+ (maxmode 8)
+ (maxsize 5)
+ (files ()))
+ (goto-char (point-min))
+ (search-forward "!<arch>\n")
+ (while (looking-at archive-ar-file-header-re)
+ (let ((name (match-string 1))
+ ;; Emacs will automatically use float here because those
+ ;; timestamps don't fit in our ints.
+ (time (string-to-number (match-string 2)))
+ (user (match-string 3))
+ (group (match-string 4))
+ (mode (string-to-number (match-string 5) 8))
+ (size (string-to-number (match-string 6))))
+ ;; Move to the beginning of the data.
+ (goto-char (match-end 0))
+ (cond
+ ((equal name "// ")
+ ;; FIXME: todo
+ nil)
+ ((equal name "/ ")
+ ;; FIXME: todo
+ nil)
+ (t
+ (setq time
+ (format-time-string
+ "%Y-%m-%d %H:%M"
+ (let ((high (truncate (/ time 65536))))
+ (list high (truncate (- time (* 65536.0 high)))))))
+ (setq name (substring name 0 (string-match "/? *\\'" name)))
+ (setq user (substring user 0 (string-match " +\\'" user)))
+ (setq group (substring group 0 (string-match " +\\'" group)))
+ (setq mode (tar-grind-file-mode mode))
+ ;; Move to the end of the data.
+ (forward-char size) (if (eq ?\n (char-after)) (forward-char 1))
+ (setq size (number-to-string size))
+ (if (> (length name) maxname) (setq maxname (length name)))
+ (if (> (length time) maxtime) (setq maxtime (length time)))
+ (if (> (length user) maxuser) (setq maxuser (length user)))
+ (if (> (length group) maxgroup) (setq maxgroup (length group)))
+ (if (> (length mode) maxmode) (setq maxmode (length mode)))
+ (if (> (length size) maxsize) (setq maxsize (length size)))
+ (push (vector name name nil mode
+ time user group size)
+ files)))))
+ (setq files (nreverse files))
+ (goto-char (point-min))
+ (let* ((format (format "%%%ds %%%ds/%%-%ds %%%ds %%%ds %%s"
+ maxmode maxuser maxgroup maxsize maxtime))
+ (sep (format format (make-string maxmode ?-)
+ (make-string maxuser ?-)
+ (make-string maxgroup ?-)
+ (make-string maxsize ?-)
+ (make-string maxtime ?-) ""))
+ (column (length sep)))
+ (insert (format format " Mode " "User" "Group" " Size "
+ " Date " "Filename")
+ "\n")
+ (insert sep (make-string maxname ?-) "\n")
+ (archive-summarize-files (mapcar (lambda (desc)
+ (let ((text
+ (format format
+ (aref desc 3)
+ (aref desc 5)
+ (aref desc 6)
+ (aref desc 7)
+ (aref desc 4)
+ (aref desc 1))))
+ (vector text
+ column
+ (length text))))
+ files))
+ (insert sep (make-string maxname ?-) "\n")
+ (apply 'vector files))))
+
+(defun archive-ar-extract (archive name)
+ (let ((destbuf (current-buffer))
+ (archivebuf (find-file-noselect archive))
+ (from nil) size)
+ (with-current-buffer archivebuf
+ (save-restriction
+ ;; We may be in archive-mode or not, so either with or without
+ ;; narrowing and with or without a prepended summary.
+ (widen)
+ (search-forward "!<arch>\n")
+ (while (and (not from) (looking-at archive-ar-file-header-re))
+ (let ((this (match-string 1)))
+ (setq size (string-to-number (match-string 6)))
+ (goto-char (match-end 0))
+ (setq this (substring this 0 (string-match "/? *\\'" this)))
+ (if (equal name this)
+ (setq from (point))
+ ;; Move to the end of the data.
+ (forward-char size) (if (eq ?\n (char-after)) (forward-char 1)))))
+ (when from
+ (set-buffer-multibyte nil)
+ (with-current-buffer destbuf
+ ;; Do it within the `widen'.
+ (insert-buffer-substring archivebuf from (+ from size)))
+ (set-buffer-multibyte 'to)
+ ;; Inform the caller that the call succeeded.
+ t)))))
+