lisp/net/tramp-archive.el

   1 ;;; tramp-archive.el --- Tramp archive manager  -*- lexical-binding:t -*-
   2
   3 ;; Copyright (C) 2017 Free Software Foundation, Inc.
   4
   5 ;; Author: Michael Albinus <michael.albinus@gmx.de>
   6 ;; Keywords: comm, processes
   7 ;; Package: tramp
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;; Access functions for file archives.  This is possible only on
  27 ;; machines which have installed the virtual file system for the Gnome
  28 ;; Desktop (GVFS).  Internally, file archives are mounted via the GVFS
  29 ;; "archive" method.
  30
  31 ;; A file archive is a regular file of kind "/path/to/dir/file.EXT".
  32 ;; The extension ".EXT" identifies the type of the file archive.  A
  33 ;; file inside a file archive, called archive file name, has the name
  34 ;; "/path/to/dir/file.EXT/dir/file".
  35
  36 ;; Most of the magic file name operations are implemented for archive
  37 ;; file names, exceptions are all operations which write into a file
  38 ;; archive, and process related operations.  Therefore, functions like
  39
  40 ;;   (copy-file "/path/to/dir/file.tar/dir/file" "/somewhere/else")
  41
  42 ;; work out of the box.  This is also true for file name completion,
  43 ;; and for libraries like `dired' or `ediff', which accept archive
  44 ;; file names as well.
  45
  46 ;; File archives are identified by the file name extension ".EXT".
  47 ;; Since GVFS uses internally the library libarchive(3), all suffixes,
  48 ;; which are accepted by this library, work also for archive file
  49 ;; names.  Accepted suffixes are listed in the constant
  50 ;; `tramp-archive-suffixes'.  They are
  51
  52 ;; * ".7z" - 7-Zip archives
  53 ;; * ".apk" - Android package kits
  54 ;; * ".ar" - UNIX archiver formats
  55 ;; * ".cab", ".CAB" - Microsoft Windows cabinets
  56 ;; * ".cpio" - CPIO archives
  57 ;; * ".deb" - Debian packages
  58 ;; * ".depot" - HP-UX SD depots
  59 ;; * ".exe" - Self extracting Microsoft Windows EXE files
  60 ;; * ".iso" - ISO 9660 images
  61 ;; * ".jar" - Java archives
  62 ;; * ".lzh", "LZH" - Microsoft Windows compressed LHA archives
  63 ;; * ".mtree" - BSD mtree format
  64 ;; * ".pax" - Posix archives
  65 ;; * ".rar" - RAR archives
  66 ;; * ".rpm" - Red Hat packages
  67 ;; * ".shar" - Shell archives
  68 ;; * ".tar", "tbz", "tgz", "tlz", "txz" - (Compressed) tape archives
  69 ;; * ".warc" - Web archives
  70 ;; * ".xar" - macOS XAR archives
  71 ;; * ".xps" - Open XML Paper Specification (OpenXPS) documents
  72 ;; * ".zip", ".ZIP" - ZIP archives
  73
  74 ;; File archives could also be compressed, identified by an additional
  75 ;; compression suffix.  Valid compression suffixes are listed in the
  76 ;; constant `tramp-archive-compression-suffixes'.  They are ".bz2",
  77 ;; ".gz", ".lrz", ".lz", ".lz4", ".lzma", ".lzo", ".uu", ".xz" and
  78 ;; ".Z".  A valid archive file name would be
  79 ;; "/path/to/dir/file.tar.gz/dir/file".  Even several suffixes in a
  80 ;; row are possible, like "/path/to/dir/file.tar.gz.uu/dir/file".
  81
  82 ;; An archive file name could be a remote file name, as in
  83 ;; "/ftp:anonymous@ftp.gnu.org:/gnu/tramp/tramp-2.3.2.tar.gz/INSTALL".
  84 ;; Since all file operations are mapped internally to GVFS operations,
  85 ;; remote file names supported by tramp-gvfs.el perform better,
  86 ;; because no local copy of the file archive must be downloaded first.
  87 ;; For example, "/sftp:user@host:..." performs better than the similar
  88 ;; "/scp:user@host:...".  See the constant
  89 ;; `tramp-archive-all-gvfs-methods' for a complete list of
  90 ;; tramp-gvfs.el supported method names.
  91
  92 ;; If `url-handler-mode' is enabled, archives could be visited via
  93 ;; URLs, like "https://ftp.gnu.org/gnu/tramp/tramp-2.3.2.tar.gz/INSTALL".
  94 ;; This allows complex file operations like
  95
  96 ;;   (ediff-directories
  97 ;;    "https://ftp.gnu.org/gnu/tramp/tramp-2.3.1.tar.gz/tramp-2.3.1"
  98 ;;    "https://ftp.gnu.org/gnu/tramp/tramp-2.3.2.tar.gz/tramp-2.3.2" "")
  99
 100 ;; It is even possible to access file archives in file archives, as
 101
 102 ;;   (find-file
 103 ;;    "http://ftp.debian.org/debian/pool/main/c/coreutils/coreutils_8.28-1_amd64.deb/control.tar.gz/control")
 104
 105 ;;; Code:
 106
 107 (require 'tramp-gvfs)
 108
 109 (autoload 'dired-uncache "dired")
 110 (autoload 'url-tramp-convert-url-to-tramp "url-tramp")
 111 (defvar url-handler-mode-hook)
 112 (defvar url-handler-regexp)
 113 (defvar url-tramp-protocols)
 114
 115 ;; <https://github.com/libarchive/libarchive/wiki/LibarchiveFormats>
 116 ;;;###tramp-autoload
 117 (defconst tramp-archive-suffixes
 118   ;; "cab", "lzh" and "zip" are included with lower and upper letters,
 119   ;; because Microsoft Windows provides them often with capital
 120   ;; letters.
 121   '("7z" ;; 7-Zip archives.
 122     "apk" ;; Android package kits.  Not in libarchive testsuite.
 123     "ar" ;; UNIX archiver formats.
 124     "cab" "CAB" ;; Microsoft Windows cabinets.
 125     "cpio" ;; CPIO archives.
 126     "deb" ;; Debian packages.  Not in libarchive testsuite.
 127     "depot" ;; HP-UX SD depot.  Not in libarchive testsuite.
 128     "exe" ;; Self extracting Microsoft Windows EXE files.
 129     "iso" ;; ISO 9660 images.
 130     "jar" ;; Java archives.  Not in libarchive testsuite.
 131     "lzh" "LZH" ;; Microsoft Windows compressed LHA archives.
 132     "mtree" ;; BSD mtree format.
 133     "pax" ;; Posix archives.
 134     "rar" ;; RAR archives.
 135     "rpm" ;; Red Hat packages.
 136     "shar" ;; Shell archives.  Not in libarchive testsuite.
 137     "tar" "tbz" "tgz" "tlz" "txz" ;; (Compressed) tape archives.
 138     "warc" ;; Web archives.
 139     "xar" ;; macOS XAR archives.  Not in libarchive testsuite.
 140     "xps" ;; Open XML Paper Specification (OpenXPS) documents.
 141     "zip" "ZIP") ;; ZIP archives.
 142   "List of suffixes which indicate a file archive.
 143 It must be supported by libarchive(3).")
 144
 145 ;; <http://unix-memo.readthedocs.io/en/latest/vfs.html>
 146 ;;    read and write: tar, cpio, pax , gzip , zip, bzip2, xz, lzip, lzma, ar, mtree, iso9660, compress,
 147 ;;    read only: 7-Zip, mtree, xar, lha/lzh, rar, microsoft cab,
 148
 149 ;;;###tramp-autoload
 150 (defconst tramp-archive-compression-suffixes
 151   '("bz2" "gz" "lrz" "lz" "lz4" "lzma" "lzo" "uu" "xz" "Z")
 152   "List of suffixes which indicate a compressed file.
 153 It must be supported by libarchive(3).")
 154
 155 ;;;###tramp-autoload
 156 (defconst tramp-archive-file-name-regexp
 157   (concat
 158     "\\`" "\\(" ".+" "\\."
 159       ;; Default suffixes ...
 160       (regexp-opt tramp-archive-suffixes)
 161       ;; ... with compression.
 162       "\\(?:" "\\." (regexp-opt tramp-archive-compression-suffixes) "\\)*"
 163     "\\)" ;; \1
 164     "\\(" "/" ".*" "\\)" "\\'") ;; \2
 165   "Regular expression matching archive file names.")
 166
 167 ;;;###tramp-autoload
 168 (defconst tramp-archive-method "archive"
 169   "Method name for archives in GVFS.")
 170
 171 (defconst tramp-archive-all-gvfs-methods
 172   (cons tramp-archive-method
 173         (let ((values (cdr (cadr (get 'tramp-gvfs-methods 'custom-type)))))
 174           (setq values (mapcar 'last values)
 175                 values (mapcar 'car values))))
 176   "List of all methods `tramp-gvfs-methods' offers.")
 177
 178 \f
 179 ;; New handlers should be added here.
 180 ;;;###tramp-autoload
 181 (defconst tramp-archive-file-name-handler-alist
 182   '((access-file . ignore)
 183     (add-name-to-file . tramp-archive-handle-not-implemented)
 184     ;; `byte-compiler-base-file-name' performed by default handler.
 185     ;; `copy-directory' performed by default handler.
 186     (copy-file . tramp-archive-handle-copy-file)
 187     (delete-directorye . tramp-archive-handle-not-implemented)
 188     (delete-file . tramp-archive-handle-not-implemented)
 189     ;; `diff-latest-backup-file' performed by default handler.
 190     (directory-file-name . tramp-archive-handle-directory-file-name)
 191     (directory-files . tramp-handle-directory-files)
 192     (directory-files-and-attributes
 193      . tramp-handle-directory-files-and-attributes)
 194     (dired-compress-file . tramp-archive-handle-not-implemented)
 195     (dired-uncache . tramp-archive-handle-dired-uncache)
 196     ;; `expand-file-name' performed by default handler.
 197     (file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
 198     (file-acl . ignore)
 199     (file-attributes . tramp-archive-handle-file-attributes)
 200     (file-directory-p . tramp-handle-file-directory-p)
 201     (file-equal-p . tramp-handle-file-equal-p)
 202     (file-executable-p . tramp-archive-handle-file-executable-p)
 203     (file-exists-p . tramp-handle-file-exists-p)
 204     (file-in-directory-p . tramp-handle-file-in-directory-p)
 205     (file-local-copy . tramp-archive-handle-file-local-copy)
 206     (file-modes . tramp-handle-file-modes)
 207     (file-name-all-completions . tramp-archive-handle-file-name-all-completions)
 208     ;; `file-name-as-directory' performed by default handler.
 209     (file-name-case-insensitive-p . ignore)
 210     (file-name-completion . tramp-handle-file-name-completion)
 211     ;; `file-name-directory' performed by default handler.
 212     ;; `file-name-nondirectory' performed by default handler.
 213     ;; `file-name-sans-versions' performed by default handler.
 214     (file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
 215     (file-notify-add-watch . ignore)
 216     (file-notify-rm-watch . ignore)
 217     (file-notify-valid-p . ignore)
 218     (file-ownership-preserved-p . ignore)
 219     (file-readable-p . tramp-archive-handle-file-readable-p)
 220     (file-regular-p . tramp-handle-file-regular-p)
 221     ;; `file-remote-p' performed by default handler.
 222     (file-selinux-context . tramp-handle-file-selinux-context)
 223     (file-symlink-p . tramp-handle-file-symlink-p)
 224     (file-system-info . tramp-archive-handle-file-system-info)
 225     (file-truename . tramp-archive-handle-file-truename)
 226     (file-writable-p . ignore)
 227     (find-backup-file-name . ignore)
 228     ;; `find-file-noselect' performed by default handler.
 229     ;; `get-file-buffer' performed by default handler.
 230     (insert-directory . tramp-archive-handle-insert-directory)
 231     (insert-file-contents . tramp-archive-handle-insert-file-contents)
 232     (load . tramp-archive-handle-load)
 233     (make-auto-save-file-name . ignore)
 234     (make-directory . tramp-archive-handle-not-implemented)
 235     (make-directory-internal . tramp-archive-handle-not-implemented)
 236     (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
 237     (make-symbolic-link . tramp-archive-handle-not-implemented)
 238     (process-file . ignore)
 239     (rename-file . tramp-archive-handle-not-implemented)
 240     (set-file-acl . ignore)
 241     (set-file-modes . tramp-archive-handle-not-implemented)
 242     (set-file-selinux-context . ignore)
 243     (set-file-times . tramp-archive-handle-not-implemented)
 244     (set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
 245     (shell-command . tramp-archive-handle-not-implemented)
 246     (start-file-process . tramp-archive-handle-not-implemented)
 247     ;; `substitute-in-file-name' performed by default handler.
 248     ;; `temporary-file-directory' performed by default handler.
 249     (unhandled-file-name-directory . ignore)
 250     (vc-registered . ignore)
 251     (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
 252     (write-region . tramp-archive-handle-not-implemented))
 253   "Alist of handler functions for GVFS archive method.
 254 Operations not mentioned here will be handled by the default Emacs primitives.")
 255
 256 ;;;###tramp-autoload
 257 (defun tramp-archive-file-name-handler (operation &rest args)
 258   "Invoke the GVFS archive related OPERATION.
 259 First arg specifies the OPERATION, second arg is a list of arguments to
 260 pass to the OPERATION."
 261   (unless tramp-gvfs-enabled
 262     (tramp-compat-user-error nil "Package `tramp-archive' not supported"))
 263   (let ((tramp-methods (cons `(,tramp-archive-method) tramp-methods))
 264         (tramp-gvfs-methods tramp-archive-all-gvfs-methods)
 265         (fn (assoc operation tramp-archive-file-name-handler-alist)))
 266     (when (eq (cdr fn) 'tramp-archive-handle-not-implemented)
 267       (setq args (cons operation args)))
 268     (if fn
 269         (save-match-data (apply (cdr fn) args))
 270       (tramp-run-real-handler operation args))))
 271
 272 ;; Mark `operations' the handler is responsible for.
 273 (put 'tramp-archive-file-name-handler 'operations
 274      (mapcar 'car tramp-archive-file-name-handler-alist))
 275
 276 ;; `tramp-archive-file-name-handler' must be placed before `url-file-handler'.
 277 (when url-handler-mode (tramp-register-file-name-handlers))
 278
 279 (eval-after-load 'url-handler
 280   (progn
 281     (add-hook 'url-handler-mode-hook 'tramp-register-file-name-handlers)
 282     (add-hook
 283      'tramp-archive-unload-hook
 284      (lambda ()
 285        (remove-hook
 286         'url-handler-mode-hook 'tramp-register-file-name-handlers)))))
 287
 288 ;; Debug.
 289 ;(trace-function-background 'tramp-archive-file-name-handler)
 290 ;(trace-function-background 'tramp-gvfs-file-name-handler)
 291 ;(trace-function-background 'tramp-file-name-archive)
 292 ;(trace-function-background 'tramp-archive-dissect-file-name)
 293
 294 \f
 295 ;; File name conversions.
 296
 297 (defun tramp-archive-file-name-p (name)
 298   "Return t if NAME is a string with archive file name syntax."
 299   (and (stringp name)
 300        (string-match tramp-archive-file-name-regexp name)
 301        t))
 302
 303 (defvar tramp-archive-hash (make-hash-table :test 'equal)
 304   "Hash table for archive local copies.")
 305
 306 (defun tramp-archive-local-copy (archive)
 307   "Return copy of ARCHIVE, usable by GVFS.
 308 ARCHIVE is the archive component of an archive file name."
 309   (setq archive (file-truename archive))
 310   (let ((tramp-verbose 0))
 311     (with-tramp-connection-property
 312         ;; This is just an auxiliary VEC for caching properties.
 313         (make-tramp-file-name :method tramp-archive-method :host archive)
 314         "archive"
 315       (cond
 316        ;; File archives inside file archives.
 317        ((tramp-archive-file-name-p archive)
 318         (let ((archive
 319                (tramp-make-tramp-file-name
 320                 (tramp-archive-dissect-file-name archive) nil 'noarchive)))
 321           ;; We call `file-attributes' in order to mount the archive.
 322           (file-attributes archive)
 323           (puthash archive nil tramp-archive-hash)
 324           archive))
 325        ;; http://...
 326        ((and url-handler-mode
 327              tramp-compat-use-url-tramp-p
 328              (string-match url-handler-regexp archive)
 329              (string-match "https?" (url-type (url-generic-parse-url archive))))
 330         (let* ((url-tramp-protocols
 331                 (cons
 332                  (url-type (url-generic-parse-url archive))
 333                  url-tramp-protocols))
 334                (archive (url-tramp-convert-url-to-tramp archive)))
 335           (puthash archive nil tramp-archive-hash)
 336           archive))
 337        ;; GVFS supported schemes.
 338        ((or (tramp-gvfs-file-name-p archive)
 339             (not (file-remote-p archive)))
 340         (puthash archive nil tramp-archive-hash)
 341         archive)
 342        ;; Anything else.  Here we call `file-local-copy', which we
 343        ;; have avoided so far.
 344        (t (let ((inhibit-file-name-operation 'file-local-copy)
 345                 (inhibit-file-name-handlers
 346                  (cons 'jka-compr-handler inhibit-file-name-handlers))
 347                 result)
 348             (or (and (setq result (gethash archive tramp-archive-hash nil))
 349                      (file-readable-p result))
 350                 (puthash
 351                  archive
 352                  (setq result (file-local-copy archive))
 353                  tramp-archive-hash))
 354             result))))))
 355
 356 ;;;###tramp-autoload
 357 (defun tramp-archive-cleanup-hash ()
 358   "Remove local copies of archives, used by GVFS."
 359   (maphash
 360    (lambda (key value)
 361      ;; Unmount local copy.
 362      (ignore-errors
 363        (let ((tramp-gvfs-methods tramp-archive-all-gvfs-methods)
 364              (file-archive (file-name-as-directory key)))
 365          (tramp-message
 366           (and (tramp-tramp-file-p key) (tramp-dissect-file-name key)) 3
 367           "Unmounting %s" file-archive)
 368          (tramp-gvfs-unmount
 369           (tramp-dissect-file-name
 370            (tramp-archive-gvfs-file-name file-archive)))))
 371      ;; Delete local copy.
 372      (ignore-errors (when value (delete-file value)))
 373      (remhash key tramp-archive-hash))
 374    tramp-archive-hash)
 375   (clrhash tramp-archive-hash))
 376
 377 (add-hook 'kill-emacs-hook 'tramp-archive-cleanup-hash)
 378 (add-hook 'tramp-archive-unload-hook
 379           (lambda ()
 380             (remove-hook 'kill-emacs-hook
 381                          'tramp-archive-cleanup-hash)))
 382
 383 (defun tramp-archive-dissect-file-name (name)
 384   "Return a `tramp-file-name' structure.
 385 The structure consists of the `tramp-archive-method' method, the
 386 hexlified archive name as host, and the localname.  The archive
 387 name is kept in slot `hop'"
 388   (save-match-data
 389     (unless (tramp-archive-file-name-p name)
 390       (tramp-compat-user-error nil "Not an archive file name: \"%s\"" name))
 391     ;; The `string-match' happened in `tramp-archive-file-name-p'.
 392     (let ((archive (match-string 1 name))
 393           (localname (match-string 2 name))
 394           (tramp-verbose 0))
 395       (make-tramp-file-name
 396        :method tramp-archive-method :user nil :domain nil :host
 397        (url-hexify-string
 398         (tramp-gvfs-url-file-name (tramp-archive-local-copy archive)))
 399        :port nil :localname localname :hop archive))))
 400
 401 (defsubst tramp-file-name-archive (vec)
 402   "Extract the archive file name from VEC.
 403 VEC is expected to be a `tramp-file-name', with the method being
 404 `tramp-archive-method', and the host being a coded URL.  The
 405 archive name is extracted from the hop part of the VEC structure."
 406   (and (tramp-file-name-p vec)
 407        (string-equal (tramp-file-name-method vec) tramp-archive-method)
 408        (tramp-file-name-hop vec)))
 409
 410 (defmacro with-parsed-tramp-archive-file-name (filename var &rest body)
 411   "Parse an archive filename and make components available in the body.
 412 This works exactly as `with-parsed-tramp-file-name' for the Tramp
 413 file name structure returned by `tramp-archive-dissect-file-name'.
 414 A variable `foo-archive' (or `archive') will be bound to the
 415 archive name part of FILENAME, assuming `foo' (or nil) is the
 416 value of VAR.  OTOH, the variable `foo-hop' (or `hop') won't be
 417 offered."
 418   (declare (debug (form symbolp body))
 419            (indent 2))
 420   (let ((bindings
 421          (mapcar (lambda (elem)
 422                    `(,(if var (intern (format "%s-%s" var elem)) elem)
 423                      (,(intern (format "tramp-file-name-%s" elem))
 424                       ,(or var 'v))))
 425                  `,(cons
 426                     'archive
 427                     (delete 'hop (tramp-compat-tramp-file-name-slots))))))
 428     `(let* ((,(or var 'v) (tramp-archive-dissect-file-name ,filename))
 429             ,@bindings)
 430        ;; We don't know which of those vars will be used, so we bind them all,
 431        ;; and then add here a dummy use of all those variables, so we don't get
 432        ;; flooded by warnings about those vars `body' didn't use.
 433        (ignore ,@(mapcar #'car bindings))
 434        ,@body)))
 435
 436 (defun tramp-archive-gvfs-file-name (name)
 437   "Return FILENAME in GVFS syntax."
 438   (tramp-make-tramp-file-name
 439    (tramp-archive-dissect-file-name name) nil 'nohop))
 440
 441 \f
 442 ;; File name primitives.
 443
 444 (defun tramp-archive-handle-copy-file
 445   (filename newname &optional ok-if-already-exists keep-date
 446    preserve-uid-gid preserve-extended-attributes)
 447   "Like `copy-file' for file archives."
 448   (when (tramp-archive-file-name-p newname)
 449     (tramp-error
 450      (tramp-archive-dissect-file-name newname) 'file-error
 451       "Permission denied: %s" newname))
 452   (copy-file
 453    (tramp-archive-gvfs-file-name filename) newname ok-if-already-exists
 454    keep-date preserve-uid-gid preserve-extended-attributes))
 455
 456 (defun tramp-archive-handle-directory-file-name (directory)
 457   "Like `directory-file-name' for file archives."
 458   (with-parsed-tramp-archive-file-name directory nil
 459     (if (and (not (zerop (length localname)))
 460              (eq (aref localname (1- (length localname))) ?/)
 461              (not (string= localname "/")))
 462         (substring directory 0 -1)
 463       ;; We do not want to leave the file archive.  This would require
 464       ;; unnecessary download of http-based file archives, for
 465       ;; example.  So we return `directory'.
 466       directory)))
 467
 468 (defun tramp-archive-handle-dired-uncache (dir)
 469   "Like `dired-uncache' for file archives."
 470   (dired-uncache (tramp-archive-gvfs-file-name dir)))
 471
 472 (defun tramp-archive-handle-file-attributes (filename &optional id-format)
 473   "Like `file-attributes' for file archives."
 474   (file-attributes (tramp-archive-gvfs-file-name filename) id-format))
 475
 476 (defun tramp-archive-handle-file-executable-p (filename)
 477   "Like `file-executable-p' for file archives."
 478   (file-executable-p (tramp-archive-gvfs-file-name filename)))
 479
 480 (defun tramp-archive-handle-file-local-copy (filename)
 481   "Like `file-local-copy' for file archives."
 482   (file-local-copy (tramp-archive-gvfs-file-name filename)))
 483
 484 (defun tramp-archive-handle-file-name-all-completions (filename directory)
 485   "Like `file-name-all-completions' for file archives."
 486   (file-name-all-completions filename (tramp-archive-gvfs-file-name directory)))
 487
 488 (defun tramp-archive-handle-file-readable-p (filename)
 489   "Like `file-readable-p' for file archives."
 490   (with-parsed-tramp-file-name
 491       (tramp-archive-gvfs-file-name filename) nil
 492     (tramp-check-cached-permissions v ?r)))
 493
 494 (defun tramp-archive-handle-file-system-info (filename)
 495   "Like `file-system-info' for file archives."
 496   (with-parsed-tramp-archive-file-name filename nil
 497     (list (tramp-compat-file-attribute-size (file-attributes archive)) 0 0)))
 498
 499 (defun tramp-archive-handle-file-truename (filename)
 500   "Like `file-truename' for file archives."
 501   (with-parsed-tramp-archive-file-name filename nil
 502     (let ((local (or (file-symlink-p filename) localname)))
 503       (unless (file-name-absolute-p local)
 504         (setq local (expand-file-name local (file-name-directory localname))))
 505       (concat (file-truename archive) local))))
 506
 507 (defun tramp-archive-handle-insert-directory
 508   (filename switches &optional wildcard full-directory-p)
 509   "Like `insert-directory' for file archives."
 510   (insert-directory
 511    (tramp-archive-gvfs-file-name filename) switches wildcard full-directory-p)
 512   (goto-char (point-min))
 513   (while (search-forward (tramp-archive-gvfs-file-name filename) nil 'noerror)
 514     (replace-match filename)))
 515
 516 (defun tramp-archive-handle-insert-file-contents
 517   (filename &optional visit beg end replace)
 518   "Like `insert-file-contents' for file archives."
 519   (let ((result
 520          (insert-file-contents
 521           (tramp-archive-gvfs-file-name filename) visit beg end replace)))
 522     (prog1
 523         (list (expand-file-name filename)
 524               (cadr result))
 525       (when visit (setq buffer-file-name filename)))))
 526
 527 (defun tramp-archive-handle-load
 528     (file &optional noerror nomessage nosuffix must-suffix)
 529   "Like `load' for file archives."
 530   (load
 531    (tramp-archive-gvfs-file-name file) noerror nomessage nosuffix must-suffix))
 532
 533 (defun tramp-archive-handle-not-implemented (operation &rest args)
 534   "Generic handler for operations not implemented for file archives."
 535   (let ((v (ignore-errors
 536              (tramp-archive-dissect-file-name
 537               (apply 'tramp-file-name-for-operation operation args)))))
 538     (tramp-message v 10 "%s" (cons operation args))
 539     (tramp-error
 540      v 'file-error
 541      "Operation `%s' not implemented for file archives" operation)))
 542
 543 (add-hook 'tramp-unload-hook
 544           (lambda ()
 545             (unload-feature 'tramp-archive 'force)))
 546
 547 (provide 'tramp-archive)
 548
 549 ;;; TODO:
 550
 551 ;; * See, whether we could retrieve better file attributes like uid,
 552 ;;   gid, permissions.
 553 ;;
 554 ;; * Implement write access, when possible.
 555
 556 ;;; tramp-archive.el ends here