From d338325c2b603db8433c9b6b12216201d5ee21e9 Mon Sep 17 00:00:00 2001
From: Michael Albinus <michael.albinus@gmx.de>
Date: Sat, 9 Dec 2017 14:34:30 +0100
Subject: [PATCH] Support for archive file names

* doc/misc/tramp.texi (Top, Usage): Add entry "Archive file names".
(History): Mention archive file names.
(GVFS based methods): Mentio "http" and "https" methods.
(Archive file names): New node.
(Frequently Asked Questions): Add Emacs 27 as supported version.

* etc/NEWS: Mention tramp-archive.el.

* lisp/net/tramp.el (tramp-run-real-handler)
(tramp-register-file-name-handlers)
(tramp-register-file-name-handlers, tramp-unload-file-name-handlers):
Add `tramp-archive-file-name-handler'.
(tramp-handle-file-name-completion): Do not insist in Tramp
file names.

* lisp/net/tramp-archive.el: New package.

* lisp/net/tramp-cache.el (tramp-dump-connection-properties): Check for
"archive" method.

* lisp/net/tramp-cmds.el (tramp-cleanup-all-connections): Cleanup also
local copies of archives.

* lisp/net/tramp-compat.el (tramp-compat-use-url-tramp-p): New defconst.

* lisp/net/tramp-gvfs.el (tramp-gvfs-methods): Add "http" and "https".
(tramp-gvfs-gio-mapping): Add "gvfs-mount".
(tramp-gvfs-handler-mounted-unmounted)
(tramp-gvfs-connection-mounted-p, tramp-gvfs-mount-spec):
Handle "uri" and "http".
(tramp-gvfs-unmount): New defun.

* test/lisp/net/tramp-archive-tests.el: New package.
---
 doc/misc/tramp.texi                           | 216 ++++-
 etc/NEWS                                      |   6 +
 lisp/net/tramp-archive.el                     | 556 ++++++++++++
 lisp/net/tramp-cache.el                       |   2 +
 lisp/net/tramp-cmds.el                        |   3 +
 lisp/net/tramp-compat.el                      |  16 +-
 lisp/net/tramp-gvfs.el                        |  50 +-
 lisp/net/tramp.el                             |  15 +-
 test/lisp/net/tramp-archive-resources/bar/bar |   1 +
 test/lisp/net/tramp-archive-resources/foo.hrd |   1 +
 test/lisp/net/tramp-archive-resources/foo.lnk |   1 +
 .../net/tramp-archive-resources/foo.tar.gz    | Bin 0 -> 234 bytes
 test/lisp/net/tramp-archive-resources/foo.txt |   1 +
 test/lisp/net/tramp-archive-tests.el          | 796 ++++++++++++++++++
 14 files changed, 1646 insertions(+), 18 deletions(-)
 create mode 100644 lisp/net/tramp-archive.el
 create mode 100644 test/lisp/net/tramp-archive-resources/bar/bar
 create mode 100644 test/lisp/net/tramp-archive-resources/foo.hrd
 create mode 120000 test/lisp/net/tramp-archive-resources/foo.lnk
 create mode 100644 test/lisp/net/tramp-archive-resources/foo.tar.gz
 create mode 100644 test/lisp/net/tramp-archive-resources/foo.txt
 create mode 100644 test/lisp/net/tramp-archive-tests.el

diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index e7d9cb15dee..3869e19fb96 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -164,6 +164,7 @@ Using @value{tramp}
 * Ad-hoc multi-hops::           Declaring multiple hops in the file name.
 * Remote processes::            Integration with other Emacs packages.
 * Cleanup remote connections::  Cleanup remote connections.
+* Archive file names::          Access to files in file archives.
 
 How file names, directories and localnames are mangled and managed
 
@@ -407,7 +408,8 @@ since April 2007 (and removed in December 2016).  GVFS integration
 started in February 2009.  Remote commands on MS Windows hosts since
 September 2011.  Ad-hoc multi-hop methods (with a changed syntax)
 re-enabled in November 2011.  In November 2012, added Juergen
-Hoetzel's @file{tramp-adb.el}.
+Hoetzel's @file{tramp-adb.el}.  Archive file names are supported since
+December 2017.
 
 XEmacs support was stopped in January 2016.  Since March 2017,
 @value{tramp} syntax mandates a method.
@@ -1134,7 +1136,10 @@ requires the SYNCE-GVFS plugin.
 This user option is a list of external methods for GVFS@.  By default,
 this list includes @option{afp}, @option{dav}, @option{davs},
 @option{gdrive}, @option{obex}, @option{sftp} and @option{synce}.
-Other methods to include are: @option{ftp} and @option{smb}.
+Other methods to include are @option{ftp}, @option{http},
+@option{https} and @option{smb}.  These methods are not intended to be
+used directly as GVFS based method.  Instead, they are added here for
+the benefit of @ref{Archive file names}.
 @end defopt
 
 
@@ -2284,6 +2289,7 @@ is a feature of Emacs that may cause missed prompts when using
 * Ad-hoc multi-hops::           Declaring multiple hops in the file name.
 * Remote processes::            Integration with other Emacs packages.
 * Cleanup remote connections::  Cleanup remote connections.
+* Archive file names::          Access to files in file archives.
 @end menu
 
 
@@ -2913,6 +2919,209 @@ that remote connection.
 @end deffn
 
 
+@node Archive file names
+@section Archive file names
+@cindex file archives
+@cindex archive file names
+@cindex method archive
+@cindex archive method
+
+@value{tramp} offers also transparent access to files inside file
+archives.  This is possible only on machines which have installed the
+virtual file system for the Gnome Desktop (GVFS), @ref{GVFS based
+methods}.  Internally, file archives are mounted via the GVFS
+@option{archive} method.
+
+A file archive is a regular file of kind @file{/path/to/dir/file.EXT}.
+The extension @samp{.EXT} identifies the type of the file archive.  A
+file inside a file archive, called archive file name, has the name
+@file{/path/to/dir/file.EXT/dir/file}.
+
+Most of the @ref{Magic File Names, , magic file name operations,
+elisp}, are implemented for archive file names, exceptions are all
+operations which write into a file archive, and process related
+operations.  Therefore, functions like
+
+@lisp
+(copy-file "/path/to/dir/file.tar/dir/file" "/somewhere/else")
+@end lisp
+
+@noindent
+work out of the box.  This is also true for file name completion, and
+for libraries like @code{dired} or @code{ediff}, which accept archive
+file names as well.
+
+@vindex tramp-archive-suffixes
+File archives are identified by the file name extension @samp{.EXT}.
+Since GVFS uses internally the library @code{libarchive(3)}, all
+suffixes, which are accepted by this library, work also for archive
+file names.  Accepted suffixes are listed in the constant
+@code{tramp-archive-suffixes}.  They are
+
+@itemize
+@item @samp{.7z} ---
+7-Zip archives
+@cindex 7z, file archive suffix
+@cindex file archive suffix 7z
+
+@item @samp{.apk} ---
+Android package kits
+@cindex apk, file archive suffix
+@cindex file archive suffix apk
+
+@item @samp{.ar} ---
+UNIX archiver formats
+@cindex ar, file archive suffix
+@cindex file archive suffix ar
+
+@item @samp{.cab}, @samp{.CAB} ---
+Microsoft Windows cabinets
+@cindex cab, file archive suffix
+@cindex CAB, file archive suffix
+@cindex file archive suffix cab
+@cindex file archive suffix CAB
+
+@item @samp{.cpio} ---
+CPIO archives
+@cindex cpio, file archive suffix
+@cindex file archive suffix cpio
+
+@item @samp{.deb} ---
+Debian packages
+@cindex deb, file archive suffix
+@cindex file archive suffix deb
+
+@item @samp{.depot} ---
+HP-UX SD depots
+@cindex depot, file archive suffix
+@cindex file archive suffix depot
+
+@item @samp{.exe} ---
+Self extracting Microsoft Windows EXE files
+@cindex exe, file archive suffix
+@cindex file archive suffix exe
+
+@item @samp{.iso} ---
+ISO 9660 images
+@cindex iso, file archive suffix
+@cindex file archive suffix iso
+
+@item @samp{.jar} ---
+Java archives
+@cindex jar, file archive suffix
+@cindex file archive suffix jar
+
+@item @samp{.lzh}, @samp{LZH} ---
+Microsoft Windows compressed LHA archives
+@cindex lzh, file archive suffix
+@cindex LZH, file archive suffix
+@cindex file archive suffix lzh
+@cindex file archive suffix LZH
+
+@item @samp{.mtree} ---
+BSD mtree format
+@cindex mtree, file archive suffix
+@cindex file archive suffix mtree
+
+@item @samp{.pax} ---
+Posix archives
+@cindex pax, file archive suffix
+@cindex file archive suffix pax
+
+@item @samp{.rar} ---
+RAR archives
+@cindex rar, file archive suffix
+@cindex file archive suffix rar
+
+@item @samp{.rpm} ---
+Red Hat packages
+@cindex rpm, file archive suffix
+@cindex file archive suffix rpm
+
+@item @samp{.shar} ---
+Shell archives
+@cindex shar, file archive suffix
+@cindex file archive suffix shar
+
+@item @samp{.tar}, @samp{tbz}, @samp{tgz}, @samp{tlz}, @samp{txz} ---
+(Compressed) tape archives
+@cindex tar, file archive suffix
+@cindex tbz, file archive suffix
+@cindex tgz, file archive suffix
+@cindex tlz, file archive suffix
+@cindex txz, file archive suffix
+@cindex file archive suffix tar
+@cindex file archive suffix tbz
+@cindex file archive suffix tgz
+@cindex file archive suffix tlz
+@cindex file archive suffix txz
+
+@item @samp{.warc} ---
+Web archives
+@cindex warc, file archive suffix
+@cindex file archive suffix warc
+
+@item @samp{.xar} ---
+macOS XAR archives
+@cindex xar, file archive suffix
+@cindex file archive suffix xar
+
+@item @samp{.xps} ---
+Open XML Paper Specification (OpenXPS) documents
+@cindex xps, file archive suffix
+@cindex file archive suffix xps
+
+@item @samp{.zip}, @samp{.ZIP} ---
+ZIP archives
+@cindex zip, file archive suffix
+@cindex ZIP, file archive suffix
+@cindex file archive suffix zip
+@cindex file archive suffix ZIP
+@end itemize
+
+@vindex tramp-archive-compression-suffixes
+File archives could also be compressed, identified by an additional
+compression suffix.  Valid compression suffixes are listed in the
+constant @code{tramp-archive-compression-suffixes}.  They are
+@samp{.bz2}, @samp{.gz}, @samp{.lrz}, @samp{.lz}, @samp{.lz4},
+@samp{.lzma}, @samp{.lzo}, @samp{.uu}, @samp{.xz} and @samp{.Z}.  A
+valid archive file name would be
+@file{/path/to/dir/file.tar.gz/dir/file}.  Even several suffixes in a
+row are possible, like @file{/path/to/dir/file.tar.gz.uu/dir/file}.
+
+@vindex tramp-archive-all-gvfs-methods
+An archive file name could be a remote file name, as in
+@file{/ftp:anonymous@@ftp.gnu.org:/gnu/tramp/tramp-2.3.2.tar.gz/INSTALL}.
+Since all file operations are mapped internally to GVFS operations,
+remote file names supported by @code{tramp-gvfs} perform better,
+because no local copy of the file archive must be downloaded first.
+For example, @samp{/sftp:user@@host:...} performs better than the
+similar @samp{/scp:user@@host:...}.  See the constant
+@code{tramp-archive-all-gvfs-methods} for a complete list of
+@code{tramp-gvfs} supported method names.
+
+If @code{url-handler-mode} is enabled, archives could be visited via
+URLs, like @file{https://ftp.gnu.org/gnu/tramp/tramp-2.3.2.tar.gz/INSTALL}.
+This allows complex file operations like
+
+@lisp
+@group
+(ediff-directories
+ "https://ftp.gnu.org/gnu/tramp/tramp-2.3.1.tar.gz/tramp-2.3.1"
+ "https://ftp.gnu.org/gnu/tramp/tramp-2.3.2.tar.gz/tramp-2.3.2" "")
+@end group
+@end lisp
+
+It is even possible to access file archives in file archives, as
+
+@lisp
+@group
+(find-file
+ "http://ftp.debian.org/debian/pool/main/c/coreutils/coreutils_8.28-1_amd64.deb/control.tar.gz/control")
+@end group
+@end lisp
+
+
 @node Bug Reports
 @chapter Reporting Bugs and Problems
 @cindex bug reports
@@ -2997,7 +3206,8 @@ Where is the latest @value{tramp}?
 @item
 Which systems does it work on?
 
-The package works successfully on Emacs 24, Emacs 25, and Emacs 26.
+The package works successfully on Emacs 24, Emacs 25, Emacs 26, and
+Emacs 27.
 
 While Unix and Unix-like systems are the primary remote targets,
 @value{tramp} has equal success connecting to other platforms, such as
diff --git a/etc/NEWS b/etc/NEWS
index cbd50f02272..0165768bc13 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -125,6 +125,12 @@ To restore the old behavior, use
 
 * New Modes and Packages in Emacs 27.1
 
++++
+** The package tramp-archive.el brings file name handler support for
+file archives.  It works on systems which support GVFS, which is
+GNU/Linux, roughly spoken.  See the chapter "(tramp) Archive file
+names" in the Tramp manual for full documentation of these facilities.
+
 
 * Incompatible Lisp Changes in Emacs 27.1
 
diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el
new file mode 100644
index 00000000000..d1e4804bf94
--- /dev/null
+++ b/lisp/net/tramp-archive.el
@@ -0,0 +1,556 @@
+;;; tramp-archive.el --- Tramp archive manager  -*- lexical-binding:t -*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Author: Michael Albinus <michael.albinus@gmx.de>
+;; Keywords: comm, processes
+;; Package: tramp
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Access functions for file archives.  This is possible only on
+;; machines which have installed the virtual file system for the Gnome
+;; Desktop (GVFS).  Internally, file archives are mounted via the GVFS
+;; "archive" method.
+
+;; A file archive is a regular file of kind "/path/to/dir/file.EXT".
+;; The extension ".EXT" identifies the type of the file archive.  A
+;; file inside a file archive, called archive file name, has the name
+;; "/path/to/dir/file.EXT/dir/file".
+
+;; Most of the magic file name operations are implemented for archive
+;; file names, exceptions are all operations which write into a file
+;; archive, and process related operations.  Therefore, functions like
+
+;;   (copy-file "/path/to/dir/file.tar/dir/file" "/somewhere/else")
+
+;; work out of the box.  This is also true for file name completion,
+;; and for libraries like `dired' or `ediff', which accept archive
+;; file names as well.
+
+;; File archives are identified by the file name extension ".EXT".
+;; Since GVFS uses internally the library libarchive(3), all suffixes,
+;; which are accepted by this library, work also for archive file
+;; names.  Accepted suffixes are listed in the constant
+;; `tramp-archive-suffixes'.  They are
+
+;; * ".7z" - 7-Zip archives
+;; * ".apk" - Android package kits
+;; * ".ar" - UNIX archiver formats
+;; * ".cab", ".CAB" - Microsoft Windows cabinets
+;; * ".cpio" - CPIO archives
+;; * ".deb" - Debian packages
+;; * ".depot" - HP-UX SD depots
+;; * ".exe" - Self extracting Microsoft Windows EXE files
+;; * ".iso" - ISO 9660 images
+;; * ".jar" - Java archives
+;; * ".lzh", "LZH" - Microsoft Windows compressed LHA archives
+;; * ".mtree" - BSD mtree format
+;; * ".pax" - Posix archives
+;; * ".rar" - RAR archives
+;; * ".rpm" - Red Hat packages
+;; * ".shar" - Shell archives
+;; * ".tar", "tbz", "tgz", "tlz", "txz" - (Compressed) tape archives
+;; * ".warc" - Web archives
+;; * ".xar" - macOS XAR archives
+;; * ".xps" - Open XML Paper Specification (OpenXPS) documents
+;; * ".zip", ".ZIP" - ZIP archives
+
+;; File archives could also be compressed, identified by an additional
+;; compression suffix.  Valid compression suffixes are listed in the
+;; constant `tramp-archive-compression-suffixes'.  They are ".bz2",
+;; ".gz", ".lrz", ".lz", ".lz4", ".lzma", ".lzo", ".uu", ".xz" and
+;; ".Z".  A valid archive file name would be
+;; "/path/to/dir/file.tar.gz/dir/file".  Even several suffixes in a
+;; row are possible, like "/path/to/dir/file.tar.gz.uu/dir/file".
+
+;; An archive file name could be a remote file name, as in
+;; "/ftp:anonymous@ftp.gnu.org:/gnu/tramp/tramp-2.3.2.tar.gz/INSTALL".
+;; Since all file operations are mapped internally to GVFS operations,
+;; remote file names supported by tramp-gvfs.el perform better,
+;; because no local copy of the file archive must be downloaded first.
+;; For example, "/sftp:user@host:..." performs better than the similar
+;; "/scp:user@host:...".  See the constant
+;; `tramp-archive-all-gvfs-methods' for a complete list of
+;; tramp-gvfs.el supported method names.
+
+;; If `url-handler-mode' is enabled, archives could be visited via
+;; URLs, like "https://ftp.gnu.org/gnu/tramp/tramp-2.3.2.tar.gz/INSTALL".
+;; This allows complex file operations like
+
+;;   (ediff-directories
+;;    "https://ftp.gnu.org/gnu/tramp/tramp-2.3.1.tar.gz/tramp-2.3.1"
+;;    "https://ftp.gnu.org/gnu/tramp/tramp-2.3.2.tar.gz/tramp-2.3.2" "")
+
+;; It is even possible to access file archives in file archives, as
+
+;;   (find-file
+;;    "http://ftp.debian.org/debian/pool/main/c/coreutils/coreutils_8.28-1_amd64.deb/control.tar.gz/control")
+
+;;; Code:
+
+(require 'tramp-gvfs)
+
+(autoload 'dired-uncache "dired")
+(autoload 'url-tramp-convert-url-to-tramp "url-tramp")
+(defvar url-handler-mode-hook)
+(defvar url-handler-regexp)
+(defvar url-tramp-protocols)
+
+;; <https://github.com/libarchive/libarchive/wiki/LibarchiveFormats>
+;;;###tramp-autoload
+(defconst tramp-archive-suffixes
+  ;; "cab", "lzh" and "zip" are included with lower and upper letters,
+  ;; because Microsoft Windows provides them often with capital
+  ;; letters.
+  '("7z" ;; 7-Zip archives.
+    "apk" ;; Android package kits.  Not in libarchive testsuite.
+    "ar" ;; UNIX archiver formats.
+    "cab" "CAB" ;; Microsoft Windows cabinets.
+    "cpio" ;; CPIO archives.
+    "deb" ;; Debian packages.  Not in libarchive testsuite.
+    "depot" ;; HP-UX SD depot.  Not in libarchive testsuite.
+    "exe" ;; Self extracting Microsoft Windows EXE files.
+    "iso" ;; ISO 9660 images.
+    "jar" ;; Java archives.  Not in libarchive testsuite.
+    "lzh" "LZH" ;; Microsoft Windows compressed LHA archives.
+    "mtree" ;; BSD mtree format.
+    "pax" ;; Posix archives.
+    "rar" ;; RAR archives.
+    "rpm" ;; Red Hat packages.
+    "shar" ;; Shell archives.  Not in libarchive testsuite.
+    "tar" "tbz" "tgz" "tlz" "txz" ;; (Compressed) tape archives.
+    "warc" ;; Web archives.
+    "xar" ;; macOS XAR archives.  Not in libarchive testsuite.
+    "xps" ;; Open XML Paper Specification (OpenXPS) documents.
+    "zip" "ZIP") ;; ZIP archives.
+  "List of suffixes which indicate a file archive.
+It must be supported by libarchive(3).")
+
+;; <http://unix-memo.readthedocs.io/en/latest/vfs.html>
+;;    read and write: tar, cpio, pax , gzip , zip, bzip2, xz, lzip, lzma, ar, mtree, iso9660, compress,
+;;    read only: 7-Zip, mtree, xar, lha/lzh, rar, microsoft cab,
+
+;;;###tramp-autoload
+(defconst tramp-archive-compression-suffixes
+  '("bz2" "gz" "lrz" "lz" "lz4" "lzma" "lzo" "uu" "xz" "Z")
+  "List of suffixes which indicate a compressed file.
+It must be supported by libarchive(3).")
+
+;;;###tramp-autoload
+(defconst tramp-archive-file-name-regexp
+  (concat
+    "\\`" "\\(" ".+" "\\."
+      ;; Default suffixes ...
+      (regexp-opt tramp-archive-suffixes)
+      ;; ... with compression.
+      "\\(?:" "\\." (regexp-opt tramp-archive-compression-suffixes) "\\)*"
+    "\\)" ;; \1
+    "\\(" "/" ".*" "\\)" "\\'") ;; \2
+  "Regular expression matching archive file names.")
+
+;;;###tramp-autoload
+(defconst tramp-archive-method "archive"
+  "Method name for archives in GVFS.")
+
+(defconst tramp-archive-all-gvfs-methods
+  (cons tramp-archive-method
+	(let ((values (cdr (cadr (get 'tramp-gvfs-methods 'custom-type)))))
+	  (setq values (mapcar 'last values)
+		values (mapcar 'car values))))
+  "List of all methods `tramp-gvfs-methods' offers.")
+
+
+;; New handlers should be added here.
+;;;###tramp-autoload
+(defconst tramp-archive-file-name-handler-alist
+  '((access-file . ignore)
+    (add-name-to-file . tramp-archive-handle-not-implemented)
+    ;; `byte-compiler-base-file-name' performed by default handler.
+    ;; `copy-directory' performed by default handler.
+    (copy-file . tramp-archive-handle-copy-file)
+    (delete-directorye . tramp-archive-handle-not-implemented)
+    (delete-file . tramp-archive-handle-not-implemented)
+    ;; `diff-latest-backup-file' performed by default handler.
+    (directory-file-name . tramp-archive-handle-directory-file-name)
+    (directory-files . tramp-handle-directory-files)
+    (directory-files-and-attributes
+     . tramp-handle-directory-files-and-attributes)
+    (dired-compress-file . tramp-archive-handle-not-implemented)
+    (dired-uncache . tramp-archive-handle-dired-uncache)
+    ;; `expand-file-name' performed by default handler.
+    (file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
+    (file-acl . ignore)
+    (file-attributes . tramp-archive-handle-file-attributes)
+    (file-directory-p . tramp-handle-file-directory-p)
+    (file-equal-p . tramp-handle-file-equal-p)
+    (file-executable-p . tramp-archive-handle-file-executable-p)
+    (file-exists-p . tramp-handle-file-exists-p)
+    (file-in-directory-p . tramp-handle-file-in-directory-p)
+    (file-local-copy . tramp-archive-handle-file-local-copy)
+    (file-modes . tramp-handle-file-modes)
+    (file-name-all-completions . tramp-archive-handle-file-name-all-completions)
+    ;; `file-name-as-directory' performed by default handler.
+    (file-name-case-insensitive-p . ignore)
+    (file-name-completion . tramp-handle-file-name-completion)
+    ;; `file-name-directory' performed by default handler.
+    ;; `file-name-nondirectory' performed by default handler.
+    ;; `file-name-sans-versions' performed by default handler.
+    (file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
+    (file-notify-add-watch . ignore)
+    (file-notify-rm-watch . ignore)
+    (file-notify-valid-p . ignore)
+    (file-ownership-preserved-p . ignore)
+    (file-readable-p . tramp-archive-handle-file-readable-p)
+    (file-regular-p . tramp-handle-file-regular-p)
+    ;; `file-remote-p' performed by default handler.
+    (file-selinux-context . tramp-handle-file-selinux-context)
+    (file-symlink-p . tramp-handle-file-symlink-p)
+    (file-system-info . tramp-archive-handle-file-system-info)
+    (file-truename . tramp-archive-handle-file-truename)
+    (file-writable-p . ignore)
+    (find-backup-file-name . ignore)
+    ;; `find-file-noselect' performed by default handler.
+    ;; `get-file-buffer' performed by default handler.
+    (insert-directory . tramp-archive-handle-insert-directory)
+    (insert-file-contents . tramp-archive-handle-insert-file-contents)
+    (load . tramp-archive-handle-load)
+    (make-auto-save-file-name . ignore)
+    (make-directory . tramp-archive-handle-not-implemented)
+    (make-directory-internal . tramp-archive-handle-not-implemented)
+    (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
+    (make-symbolic-link . tramp-archive-handle-not-implemented)
+    (process-file . ignore)
+    (rename-file . tramp-archive-handle-not-implemented)
+    (set-file-acl . ignore)
+    (set-file-modes . tramp-archive-handle-not-implemented)
+    (set-file-selinux-context . ignore)
+    (set-file-times . tramp-archive-handle-not-implemented)
+    (set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
+    (shell-command . tramp-archive-handle-not-implemented)
+    (start-file-process . tramp-archive-handle-not-implemented)
+    ;; `substitute-in-file-name' performed by default handler.
+    ;; `temporary-file-directory' performed by default handler.
+    (unhandled-file-name-directory . ignore)
+    (vc-registered . ignore)
+    (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
+    (write-region . tramp-archive-handle-not-implemented))
+  "Alist of handler functions for GVFS archive method.
+Operations not mentioned here will be handled by the default Emacs primitives.")
+
+;;;###tramp-autoload
+(defun tramp-archive-file-name-handler (operation &rest args)
+  "Invoke the GVFS archive related OPERATION.
+First arg specifies the OPERATION, second arg is a list of arguments to
+pass to the OPERATION."
+  (unless tramp-gvfs-enabled
+    (tramp-compat-user-error nil "Package `tramp-archive' not supported"))
+  (let ((tramp-methods (cons `(,tramp-archive-method) tramp-methods))
+	(tramp-gvfs-methods tramp-archive-all-gvfs-methods)
+	(fn (assoc operation tramp-archive-file-name-handler-alist)))
+    (when (eq (cdr fn) 'tramp-archive-handle-not-implemented)
+      (setq args (cons operation args)))
+    (if fn
+	(save-match-data (apply (cdr fn) args))
+      (tramp-run-real-handler operation args))))
+
+;; Mark `operations' the handler is responsible for.
+(put 'tramp-archive-file-name-handler 'operations
+     (mapcar 'car tramp-archive-file-name-handler-alist))
+
+;; `tramp-archive-file-name-handler' must be placed before `url-file-handler'.
+(when url-handler-mode (tramp-register-file-name-handlers))
+
+(eval-after-load 'url-handler
+  (progn
+    (add-hook 'url-handler-mode-hook 'tramp-register-file-name-handlers)
+    (add-hook
+     'tramp-archive-unload-hook
+     (lambda ()
+       (remove-hook
+	'url-handler-mode-hook 'tramp-register-file-name-handlers)))))
+
+;; Debug.
+;(trace-function-background 'tramp-archive-file-name-handler)
+;(trace-function-background 'tramp-gvfs-file-name-handler)
+;(trace-function-background 'tramp-file-name-archive)
+;(trace-function-background 'tramp-archive-dissect-file-name)
+
+
+;; File name conversions.
+
+(defun tramp-archive-file-name-p (name)
+  "Return t if NAME is a string with archive file name syntax."
+  (and (stringp name)
+       (string-match tramp-archive-file-name-regexp name)
+       t))
+
+(defvar tramp-archive-hash (make-hash-table :test 'equal)
+  "Hash table for archive local copies.")
+
+(defun tramp-archive-local-copy (archive)
+  "Return copy of ARCHIVE, usable by GVFS.
+ARCHIVE is the archive component of an archive file name."
+  (setq archive (file-truename archive))
+  (let ((tramp-verbose 0))
+    (with-tramp-connection-property
+	;; This is just an auxiliary VEC for caching properties.
+	(make-tramp-file-name :method tramp-archive-method :host archive)
+	"archive"
+      (cond
+       ;; File archives inside file archives.
+       ((tramp-archive-file-name-p archive)
+	(let ((archive
+	       (tramp-make-tramp-file-name
+		(tramp-archive-dissect-file-name archive) nil 'noarchive)))
+	  ;; We call `file-attributes' in order to mount the archive.
+	  (file-attributes archive)
+	  (puthash archive nil tramp-archive-hash)
+	  archive))
+       ;; http://...
+       ((and url-handler-mode
+	     tramp-compat-use-url-tramp-p
+             (string-match url-handler-regexp archive)
+	     (string-match "https?" (url-type (url-generic-parse-url archive))))
+	(let* ((url-tramp-protocols
+		(cons
+		 (url-type (url-generic-parse-url archive))
+		 url-tramp-protocols))
+	       (archive (url-tramp-convert-url-to-tramp archive)))
+	  (puthash archive nil tramp-archive-hash)
+	  archive))
+       ;; GVFS supported schemes.
+       ((or (tramp-gvfs-file-name-p archive)
+	    (not (file-remote-p archive)))
+	(puthash archive nil tramp-archive-hash)
+	archive)
+       ;; Anything else.  Here we call `file-local-copy', which we
+       ;; have avoided so far.
+       (t (let ((inhibit-file-name-operation 'file-local-copy)
+		(inhibit-file-name-handlers
+		 (cons 'jka-compr-handler inhibit-file-name-handlers))
+		result)
+	    (or (and (setq result (gethash archive tramp-archive-hash nil))
+		     (file-readable-p result))
+		(puthash
+		 archive
+		 (setq result (file-local-copy archive))
+		 tramp-archive-hash))
+	    result))))))
+
+;;;###tramp-autoload
+(defun tramp-archive-cleanup-hash ()
+  "Remove local copies of archives, used by GVFS."
+  (maphash
+   (lambda (key value)
+     ;; Unmount local copy.
+     (ignore-errors
+       (let ((tramp-gvfs-methods tramp-archive-all-gvfs-methods)
+	     (file-archive (file-name-as-directory key)))
+	 (tramp-message
+	  (and (tramp-tramp-file-p key) (tramp-dissect-file-name key)) 3
+	  "Unmounting %s" file-archive)
+	 (tramp-gvfs-unmount
+	  (tramp-dissect-file-name
+	   (tramp-archive-gvfs-file-name file-archive)))))
+     ;; Delete local copy.
+     (ignore-errors (when value (delete-file value)))
+     (remhash key tramp-archive-hash))
+   tramp-archive-hash)
+  (clrhash tramp-archive-hash))
+
+(add-hook 'kill-emacs-hook 'tramp-archive-cleanup-hash)
+(add-hook 'tramp-archive-unload-hook
+	  (lambda ()
+	    (remove-hook 'kill-emacs-hook
+			 'tramp-archive-cleanup-hash)))
+
+(defun tramp-archive-dissect-file-name (name)
+  "Return a `tramp-file-name' structure.
+The structure consists of the `tramp-archive-method' method, the
+hexlified archive name as host, and the localname.  The archive
+name is kept in slot `hop'"
+  (save-match-data
+    (unless (tramp-archive-file-name-p name)
+      (tramp-compat-user-error nil "Not an archive file name: \"%s\"" name))
+    ;; The `string-match' happened in `tramp-archive-file-name-p'.
+    (let ((archive (match-string 1 name))
+	  (localname (match-string 2 name))
+	  (tramp-verbose 0))
+      (make-tramp-file-name
+       :method tramp-archive-method :user nil :domain nil :host
+       (url-hexify-string
+	(tramp-gvfs-url-file-name (tramp-archive-local-copy archive)))
+       :port nil :localname localname :hop archive))))
+
+(defsubst tramp-file-name-archive (vec)
+  "Extract the archive file name from VEC.
+VEC is expected to be a `tramp-file-name', with the method being
+`tramp-archive-method', and the host being a coded URL.  The
+archive name is extracted from the hop part of the VEC structure."
+  (and (tramp-file-name-p vec)
+       (string-equal (tramp-file-name-method vec) tramp-archive-method)
+       (tramp-file-name-hop vec)))
+
+(defmacro with-parsed-tramp-archive-file-name (filename var &rest body)
+  "Parse an archive filename and make components available in the body.
+This works exactly as `with-parsed-tramp-file-name' for the Tramp
+file name structure returned by `tramp-archive-dissect-file-name'.
+A variable `foo-archive' (or `archive') will be bound to the
+archive name part of FILENAME, assuming `foo' (or nil) is the
+value of VAR.  OTOH, the variable `foo-hop' (or `hop') won't be
+offered."
+  (declare (debug (form symbolp body))
+           (indent 2))
+  (let ((bindings
+         (mapcar (lambda (elem)
+                   `(,(if var (intern (format "%s-%s" var elem)) elem)
+                     (,(intern (format "tramp-file-name-%s" elem))
+                      ,(or var 'v))))
+		 `,(cons
+		    'archive
+		    (delete 'hop (tramp-compat-tramp-file-name-slots))))))
+    `(let* ((,(or var 'v) (tramp-archive-dissect-file-name ,filename))
+            ,@bindings)
+       ;; We don't know which of those vars will be used, so we bind them all,
+       ;; and then add here a dummy use of all those variables, so we don't get
+       ;; flooded by warnings about those vars `body' didn't use.
+       (ignore ,@(mapcar #'car bindings))
+       ,@body)))
+
+(defun tramp-archive-gvfs-file-name (name)
+  "Return FILENAME in GVFS syntax."
+  (tramp-make-tramp-file-name
+   (tramp-archive-dissect-file-name name) nil 'nohop))
+
+
+;; File name primitives.
+
+(defun tramp-archive-handle-copy-file
+  (filename newname &optional ok-if-already-exists keep-date
+   preserve-uid-gid preserve-extended-attributes)
+  "Like `copy-file' for file archives."
+  (when (tramp-archive-file-name-p newname)
+    (tramp-error
+     (tramp-archive-dissect-file-name newname) 'file-error
+      "Permission denied: %s" newname))
+  (copy-file
+   (tramp-archive-gvfs-file-name filename) newname ok-if-already-exists
+   keep-date preserve-uid-gid preserve-extended-attributes))
+
+(defun tramp-archive-handle-directory-file-name (directory)
+  "Like `directory-file-name' for file archives."
+  (with-parsed-tramp-archive-file-name directory nil
+    (if (and (not (zerop (length localname)))
+	     (eq (aref localname (1- (length localname))) ?/)
+	     (not (string= localname "/")))
+	(substring directory 0 -1)
+      ;; We do not want to leave the file archive.  This would require
+      ;; unnecessary download of http-based file archives, for
+      ;; example.  So we return `directory'.
+      directory)))
+
+(defun tramp-archive-handle-dired-uncache (dir)
+  "Like `dired-uncache' for file archives."
+  (dired-uncache (tramp-archive-gvfs-file-name dir)))
+
+(defun tramp-archive-handle-file-attributes (filename &optional id-format)
+  "Like `file-attributes' for file archives."
+  (file-attributes (tramp-archive-gvfs-file-name filename) id-format))
+
+(defun tramp-archive-handle-file-executable-p (filename)
+  "Like `file-executable-p' for file archives."
+  (file-executable-p (tramp-archive-gvfs-file-name filename)))
+
+(defun tramp-archive-handle-file-local-copy (filename)
+  "Like `file-local-copy' for file archives."
+  (file-local-copy (tramp-archive-gvfs-file-name filename)))
+
+(defun tramp-archive-handle-file-name-all-completions (filename directory)
+  "Like `file-name-all-completions' for file archives."
+  (file-name-all-completions filename (tramp-archive-gvfs-file-name directory)))
+
+(defun tramp-archive-handle-file-readable-p (filename)
+  "Like `file-readable-p' for file archives."
+  (with-parsed-tramp-file-name
+      (tramp-archive-gvfs-file-name filename) nil
+    (tramp-check-cached-permissions v ?r)))
+
+(defun tramp-archive-handle-file-system-info (filename)
+  "Like `file-system-info' for file archives."
+  (with-parsed-tramp-archive-file-name filename nil
+    (list (tramp-compat-file-attribute-size (file-attributes archive)) 0 0)))
+
+(defun tramp-archive-handle-file-truename (filename)
+  "Like `file-truename' for file archives."
+  (with-parsed-tramp-archive-file-name filename nil
+    (let ((local (or (file-symlink-p filename) localname)))
+      (unless (file-name-absolute-p local)
+	(setq local (expand-file-name local (file-name-directory localname))))
+      (concat (file-truename archive) local))))
+
+(defun tramp-archive-handle-insert-directory
+  (filename switches &optional wildcard full-directory-p)
+  "Like `insert-directory' for file archives."
+  (insert-directory
+   (tramp-archive-gvfs-file-name filename) switches wildcard full-directory-p)
+  (goto-char (point-min))
+  (while (search-forward (tramp-archive-gvfs-file-name filename) nil 'noerror)
+    (replace-match filename)))
+
+(defun tramp-archive-handle-insert-file-contents
+  (filename &optional visit beg end replace)
+  "Like `insert-file-contents' for file archives."
+  (let ((result
+	 (insert-file-contents
+	  (tramp-archive-gvfs-file-name filename) visit beg end replace)))
+    (prog1
+	(list (expand-file-name filename)
+	      (cadr result))
+      (when visit (setq buffer-file-name filename)))))
+
+(defun tramp-archive-handle-load
+    (file &optional noerror nomessage nosuffix must-suffix)
+  "Like `load' for file archives."
+  (load
+   (tramp-archive-gvfs-file-name file) noerror nomessage nosuffix must-suffix))
+
+(defun tramp-archive-handle-not-implemented (operation &rest args)
+  "Generic handler for operations not implemented for file archives."
+  (let ((v (ignore-errors
+	     (tramp-archive-dissect-file-name
+	      (apply 'tramp-file-name-for-operation operation args)))))
+    (tramp-message v 10 "%s" (cons operation args))
+    (tramp-error
+     v 'file-error
+     "Operation `%s' not implemented for file archives" operation)))
+
+(add-hook 'tramp-unload-hook
+	  (lambda ()
+	    (unload-feature 'tramp-archive 'force)))
+
+(provide 'tramp-archive)
+
+;;; TODO:
+
+;; * See, whether we could retrieve better file attributes like uid,
+;;   gid, permissions.
+;;
+;; * Implement write access, when possible.
+
+;;; tramp-archive.el ends here
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index 87ec3c2a130..bd746c1a99a 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -384,6 +384,8 @@ used to cache connection properties of the local machine."
 	(maphash
 	 (lambda (key value)
 	   (if (and (tramp-file-name-p key) value
+		    (not (string-equal
+			  (tramp-file-name-method key) tramp-archive-method))
 		    (not (tramp-file-name-localname key))
 		    (not (gethash "login-as" value))
 		    (not (gethash "started" value)))
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index 35c00a01558..1f72e255c49 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -143,6 +143,9 @@ This includes password cache, file cache, connection cache, buffers."
   ;; Flush file and connection cache.
   (clrhash tramp-cache-data)
 
+  ;; Cleanup local copies of archives.
+  (tramp-archive-cleanup-hash)
+
   ;; Remove buffers.
   (dolist (name (tramp-list-tramp-buffers))
     (when (bufferp (get-buffer name)) (kill-buffer name))))
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 9cdfc065128..a9e9ce85d68 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -190,11 +190,6 @@ This is a string of ten letters or dashes as in ls -l."
   (if (get 'file-missing 'error-conditions) 'file-missing 'file-error)
   "The error symbol for the `file-missing' error.")
 
-(add-hook 'tramp-unload-hook
-	  (lambda ()
-	    (unload-feature 'tramp-loaddefs 'force)
-	    (unload-feature 'tramp-compat 'force)))
-
 ;; `file-name-quoted-p', `file-name-quote' and `file-name-unquote' are
 ;; introduced in Emacs 26.
 (eval-and-compile
@@ -243,6 +238,17 @@ If NAME is a remote file name, the local part of NAME is unquoted."
       `(cdr (mapcar 'car (cl-struct-slot-info 'tramp-file-name)))
     `(cdr (mapcar 'car (get 'tramp-file-name 'cl-struct-slots)))))
 
+;; The signature of `tramp-make-tramp-file-name' has been changed.
+;; Therefore, we cannot us `url-tramp-convert-url-to-tramp' prior
+;; Emacs 26.1.  We use `temporary-file-directory' as indicator.
+(defconst tramp-compat-use-url-tramp-p (fboundp 'temporary-file-directory)
+  "Whether to use url-tramp.el.")
+
+(add-hook 'tramp-unload-hook
+	  (lambda ()
+	    (unload-feature 'tramp-loaddefs 'force)
+	    (unload-feature 'tramp-compat 'force)))
+
 (provide 'tramp-compat)
 
 ;;; TODO:
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index d862e957ce8..a1d50b6f2e8 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -54,10 +54,12 @@
 ;; device, if it hasn't been done already.  There might be also some
 ;; few seconds delay in discovering available bluetooth devices.
 
-;; Other possible connection methods are "ftp" and "smb".  When one of
-;; these methods is added to the list, the remote access for that
-;; method is performed via GVFS instead of the native Tramp
-;; implementation.
+;; Other possible connection methods are "ftp", "http", "https" and
+;; "smb".  When one of these methods is added to the list, the remote
+;; access for that method is performed via GVFS instead of the native
+;; Tramp implementation.  However, this is not recommended.  These
+;; methods are listed here for the benefit of file archives, see
+;; tramp-archive.el.
 
 ;; GVFS offers even more connection methods.  The complete list of
 ;; connection methods of the actual GVFS implementation can be
@@ -119,6 +121,8 @@
 			 (const "davs")
 			 (const "ftp")
 			 (const "gdrive")
+			 (const "http")
+			 (const "https")
 			 (const "obex")
 			 (const "sftp")
 			 (const "smb")
@@ -424,6 +428,7 @@ Every entry is a list (NAME ADDRESS).")
     ("gvfs-ls" . "list")
     ("gvfs-mkdir" . "mkdir")
     ("gvfs-monitor-file" . "monitor")
+    ("gvfs-mount" . "mount")
     ("gvfs-move" . "move")
     ("gvfs-rm" . "remove")
     ("gvfs-trash" . "trash"))
@@ -1455,6 +1460,8 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"."
 		    (cadr (assoc "port" (cadr mount-spec)))))
 	     (ssl (tramp-gvfs-dbus-byte-array-to-string
 		   (cadr (assoc "ssl" (cadr mount-spec)))))
+	     (uri (tramp-gvfs-dbus-byte-array-to-string
+		   (cadr (assoc "uri" (cadr mount-spec)))))
 	     (prefix (concat
 		      (tramp-gvfs-dbus-byte-array-to-string
 		       (car mount-spec))
@@ -1469,6 +1476,12 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"."
 	  (setq method "davs"))
 	(when (string-equal "google-drive" method)
 	  (setq method "gdrive"))
+	(when (and (string-equal "http" method) (stringp uri))
+	  (setq uri (url-generic-parse-url uri)
+		method (url-type uri)
+		user (url-user uri)
+		host (url-host uri)
+		port (url-portspec uri)))
 	(with-parsed-tramp-file-name
 	    (tramp-make-tramp-file-name method user domain host port "") nil
 	  (tramp-message
@@ -1537,6 +1550,8 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"."
 		     (cadr (assoc "port" (cadr mount-spec)))))
 	      (ssl (tramp-gvfs-dbus-byte-array-to-string
 		    (cadr (assoc "ssl" (cadr mount-spec)))))
+	      (uri (tramp-gvfs-dbus-byte-array-to-string
+		    (cadr (assoc "uri" (cadr mount-spec)))))
 	      (prefix (concat
 		       (tramp-gvfs-dbus-byte-array-to-string
 			(car mount-spec))
@@ -1554,6 +1569,12 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"."
 	   (setq method "gdrive"))
 	 (when (and (string-equal "synce" method) (zerop (length user)))
 	   (setq user (or (tramp-file-name-user vec) "")))
+	 (when (and (string-equal "http" method) (stringp uri))
+	   (setq uri (url-generic-parse-url uri)
+		 method (url-type uri)
+		 user (url-user uri)
+		 host (url-host uri)
+		 port (url-portspec uri)))
 	 (when (and
 		(string-equal method (tramp-file-name-method vec))
 		(string-equal user (tramp-file-name-user vec))
@@ -1570,6 +1591,16 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"."
 	    vec "default-location" default-location)
 	   (throw 'mounted t)))))))
 
+(defun tramp-gvfs-unmount (vec)
+  "Unmount the object identified by VEC."
+  (let ((vec (copy-tramp-file-name vec)))
+    (setf (tramp-file-name-localname vec) "/"
+	  (tramp-file-name-hop vec) nil)
+    (when (tramp-gvfs-connection-mounted-p vec)
+      (tramp-gvfs-send-command
+       vec "gvfs-mount" "-u"
+       (tramp-gvfs-url-file-name (tramp-make-tramp-file-name vec))))))
+
 (defun tramp-gvfs-mount-spec-entry (key value)
   "Construct a mount-spec entry to be used in a mount_spec.
 It was \"a(say)\", but has changed to \"a{sv})\"."
@@ -1611,7 +1642,14 @@ It was \"a(say)\", but has changed to \"a{sv})\"."
                ((string-equal "gdrive" method)
                 (list (tramp-gvfs-mount-spec-entry "type" "google-drive")
                       (tramp-gvfs-mount-spec-entry "host" host)))
-               (t
+               ((string-match "\\`http" method)
+                (list (tramp-gvfs-mount-spec-entry "type" "http")
+                      (tramp-gvfs-mount-spec-entry
+		       "uri"
+		       (url-recreate-url
+			(url-parse-make-urlobj
+			 method user nil host port "/" nil nil t)))))
+	       (t
                 (list (tramp-gvfs-mount-spec-entry "type" method)
                       (tramp-gvfs-mount-spec-entry "host" host))))
             ,@(when user
@@ -2033,6 +2071,8 @@ They are retrieved from the hal daemon."
 
 ;;; TODO:
 
+;; * (Customizable) unmount when exiting Emacs.  See tramp-archive.el.
+
 ;; * Host name completion for existing mount points (afp-server,
 ;;   smb-server) or via smb-network.
 ;;
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index b933778447c..c73ec1de30f 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -2064,6 +2064,7 @@ pass to the OPERATION."
 	  `(tramp-file-name-handler
 	    tramp-vc-file-name-handler
 	    tramp-completion-file-name-handler
+	    tramp-archive-file-name-handler
 	    cygwin-mount-name-hook-function
 	    cygwin-mount-map-drive-hook-function
 	    .
@@ -2369,12 +2370,14 @@ remote file names."
   ;; loading of Tramp.
   (dolist (fnh '(tramp-file-name-handler
 		 tramp-completion-file-name-handler
+		 tramp-archive-file-name-handler
 		 tramp-autoload-file-name-handler))
     (let ((a1 (rassq fnh file-name-handler-alist)))
       (setq file-name-handler-alist (delq a1 file-name-handler-alist))))
 
   ;; Add the handlers.  We do not add anything to the `operations'
-  ;; property of `tramp-file-name-handler', this shall be done by the
+  ;; property of `tramp-file-name-handler' and
+  ;; `tramp-archive-file-name-handler', this shall be done by the
   ;; respective foreign handlers.
   (add-to-list 'file-name-handler-alist
 	       (cons tramp-file-name-regexp 'tramp-file-name-handler))
@@ -2388,6 +2391,11 @@ remote file names."
   (put 'tramp-completion-file-name-handler 'operations
        (mapcar 'car tramp-completion-file-name-handler-alist))
 
+  (add-to-list 'file-name-handler-alist
+	       (cons tramp-archive-file-name-regexp
+		     'tramp-archive-file-name-handler))
+  (put 'tramp-archive-file-name-handler 'safe-magic t)
+
   ;; If jka-compr or epa-file are already loaded, move them to the
   ;; front of `file-name-handler-alist'.
   (dolist (fnh '(epa-file-handler jka-compr-handler))
@@ -2441,6 +2449,7 @@ Add operations defined in `HANDLER-alist' to `tramp-file-name-handler'."
   "Unload Tramp file name handlers from `file-name-handler-alist'."
   (dolist (fnh '(tramp-file-name-handler
 		 tramp-completion-file-name-handler
+		 tramp-archive-file-name-handler
 		 tramp-autoload-file-name-handler))
     (let ((a1 (rassq fnh file-name-handler-alist)))
       (setq file-name-handler-alist (delq a1 file-name-handler-alist))))))
@@ -3100,10 +3109,6 @@ User is always nil."
 (defun tramp-handle-file-name-completion
   (filename directory &optional predicate)
   "Like `file-name-completion' for Tramp files."
-  (unless (tramp-tramp-file-p directory)
-    (error
-     "tramp-handle-file-name-completion invoked on non-tramp directory `%s'"
-     directory))
   (let (hits-ignored-extensions)
     (or
      (try-completion
diff --git a/test/lisp/net/tramp-archive-resources/bar/bar b/test/lisp/net/tramp-archive-resources/bar/bar
new file mode 100644
index 00000000000..5716ca5987c
--- /dev/null
+++ b/test/lisp/net/tramp-archive-resources/bar/bar
@@ -0,0 +1 @@
+bar
diff --git a/test/lisp/net/tramp-archive-resources/foo.hrd b/test/lisp/net/tramp-archive-resources/foo.hrd
new file mode 100644
index 00000000000..257cc5642cb
--- /dev/null
+++ b/test/lisp/net/tramp-archive-resources/foo.hrd
@@ -0,0 +1 @@
+foo
diff --git a/test/lisp/net/tramp-archive-resources/foo.lnk b/test/lisp/net/tramp-archive-resources/foo.lnk
new file mode 120000
index 00000000000..996f1789ff6
--- /dev/null
+++ b/test/lisp/net/tramp-archive-resources/foo.lnk
@@ -0,0 +1 @@
+foo.txt
\ No newline at end of file
diff --git a/test/lisp/net/tramp-archive-resources/foo.tar.gz b/test/lisp/net/tramp-archive-resources/foo.tar.gz
new file mode 100644
index 0000000000000000000000000000000000000000..68925b147fc2481aef6b686322fc6a093765d74e
GIT binary patch
literal 234
zcmV<G02TiqiwFn?<`!B217>e;E_7jX0PWV{3W6{Y2k?FFDfR@l+j-mbC=o@XpawmD
zHz<&x#1B)-{|{uK!X5s-X;pRylbKU7#<WrtH(p;1v3KIxM<L^g#Cc;ScVo$|AIi>J
zQ`Xg`x%D6Ko4Wp^D$QSytTj@=A%rja7o+_3Jb4P5zsuUy6Y}4!-2<%W)VBL`cg$L2
z&io6<H2<Co%>NQJf6V`erTMR$Yt|Zb{{I5A&Ob}R#`@IUa38WZhxyO`h^O~|_qPAD
k=xbnUiI3C9^9KL`00000000000D%AU0KrAAd;ll_0FAbF#Q*>R

literal 0
HcmV?d00001

diff --git a/test/lisp/net/tramp-archive-resources/foo.txt b/test/lisp/net/tramp-archive-resources/foo.txt
new file mode 100644
index 00000000000..257cc5642cb
--- /dev/null
+++ b/test/lisp/net/tramp-archive-resources/foo.txt
@@ -0,0 +1 @@
+foo
diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el
new file mode 100644
index 00000000000..bbe7d4c9aad
--- /dev/null
+++ b/test/lisp/net/tramp-archive-tests.el
@@ -0,0 +1,796 @@
+;;; tramp-archive-tests.el --- Tests of file archive access  -*- lexical-binding:t -*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Author: Michael Albinus <michael.albinus@gmx.de>
+
+;; This program is free software: you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see `https://www.gnu.org/licenses/'.
+
+;;; Code:
+
+(require 'ert)
+(require 'tramp-archive)
+
+(defconst tramp-archive-test-resource-directory
+  (let ((default-directory
+	  (if load-in-progress
+	      (file-name-directory load-file-name)
+	    default-directory)))
+    (cond
+     ((file-accessible-directory-p (expand-file-name "resources"))
+      (expand-file-name "resources"))
+     ((file-accessible-directory-p (expand-file-name "tramp-archive-resources"))
+      (expand-file-name "tramp-archive-resources"))))
+  "The resources directory test files are located in.")
+
+(defconst tramp-archive-test-file-archive
+  (file-truename
+   (expand-file-name "foo.tar.gz" tramp-archive-test-resource-directory))
+  "The test file archive.")
+
+(defconst tramp-archive-test-archive
+  (file-name-as-directory tramp-archive-test-file-archive)
+  "The test archive.")
+
+(setq password-cache-expiry nil
+      tramp-verbose 0
+      tramp-cache-read-persistent-data t ;; For auth-sources.
+      tramp-copy-size-limit nil
+      tramp-message-show-message nil
+      tramp-persistency-file-name nil)
+
+(defun tramp-archive--test-make-temp-name ()
+  "Return a temporary file name for test.
+The temporary file is not created."
+  (expand-file-name
+   (make-temp-name "tramp-archive-test") temporary-file-directory))
+
+(defun tramp-archive--test-delete (tmpfile)
+  "Delete temporary file or directory TMPFILE.
+This needs special support, because archive file names, which are
+the origin of the temporary TMPFILE, have no write permissions."
+  (unless (file-writable-p (file-name-directory tmpfile))
+    (set-file-modes
+     (file-name-directory tmpfile)
+     (logior (file-modes (file-name-directory tmpfile)) #o0700)))
+  (set-file-modes tmpfile #o0700)
+  (if (file-regular-p tmpfile)
+      (delete-file tmpfile)
+    (mapc
+     'tramp-archive--test-delete
+     (directory-files tmpfile 'full directory-files-no-dot-files-regexp))
+    (delete-directory tmpfile)))
+
+(defun tramp-archive--test-emacs26-p ()
+  "Check for Emacs version >= 26.1.
+Some semantics has been changed for there, w/o new functions or
+variables, so we check the Emacs version directly."
+  (>= emacs-major-version 26))
+
+(ert-deftest tramp-archive-test00-availability ()
+  "Test availability of Tramp functions."
+  :expected-result (if tramp-gvfs-enabled :passed :failed)
+  (should
+   (and
+    tramp-gvfs-enabled
+    (file-exists-p tramp-archive-test-file-archive)
+    (tramp-archive-file-name-p tramp-archive-test-archive))))
+
+(ert-deftest tramp-archive-test01-file-name-syntax ()
+  "Check archive file name syntax."
+  (should-not (tramp-archive-file-name-p tramp-archive-test-file-archive))
+  (should (tramp-archive-file-name-p tramp-archive-test-archive))
+  (should (tramp-archive-file-name-p (concat tramp-archive-test-archive "foo")))
+  (should
+   (tramp-archive-file-name-p (concat tramp-archive-test-archive "foo/bar")))
+  ;; A file archive inside a file archive.
+  (should
+   (tramp-archive-file-name-p (concat tramp-archive-test-archive "foo.tar")))
+  (should
+   (tramp-archive-file-name-p (concat tramp-archive-test-archive "foo.tar/"))))
+
+(ert-deftest tramp-archive-test02-file-name-dissect ()
+  "Check archive file name components."
+  (skip-unless tramp-gvfs-enabled)
+
+  (with-parsed-tramp-archive-file-name tramp-archive-test-archive nil
+    (should (string-equal method tramp-archive-method))
+    (should-not user)
+    (should-not domain)
+    (should
+     (string-equal
+      host
+      (file-remote-p
+       (tramp-archive-gvfs-file-name tramp-archive-test-archive) 'host)))
+    (should
+     (string-equal
+      host
+      (url-hexify-string (concat "file://" tramp-archive-test-file-archive))))
+    (should-not port)
+    (should (string-equal localname "/"))
+    (should (string-equal archive tramp-archive-test-file-archive)))
+
+  ;; Localname.
+  (with-parsed-tramp-archive-file-name
+      (concat tramp-archive-test-archive "foo") nil
+    (should (string-equal method tramp-archive-method))
+    (should-not user)
+    (should-not domain)
+    (should
+     (string-equal
+      host
+      (file-remote-p
+       (tramp-archive-gvfs-file-name tramp-archive-test-archive) 'host)))
+   (should
+     (string-equal
+      host
+      (url-hexify-string (concat "file://" tramp-archive-test-file-archive))))
+    (should-not port)
+    (should (string-equal localname "/foo"))
+    (should (string-equal archive tramp-archive-test-file-archive)))
+
+  ;; File archive in file archive.
+  (let* ((tramp-archive-test-file-archive
+	  (concat tramp-archive-test-archive "bar.tar"))
+	 (tramp-archive-test-archive
+	  (file-name-as-directory tramp-archive-test-file-archive))
+	 (tramp-methods (cons `(,tramp-archive-method) tramp-methods))
+	 (tramp-gvfs-methods tramp-archive-all-gvfs-methods))
+    (unwind-protect
+	(with-parsed-tramp-archive-file-name tramp-archive-test-archive nil
+	  (should (string-equal method tramp-archive-method))
+	  (should-not user)
+	  (should-not domain)
+	  (should
+	   (string-equal
+	    host
+	    (file-remote-p
+	     (tramp-archive-gvfs-file-name tramp-archive-test-archive) 'host)))
+	  ;; We reimplement the logic of tramp-archive.el here.  Don't
+	  ;; know, whether it is worth the test.
+	  (should
+	   (string-equal
+	    host
+	    (url-hexify-string
+	     (concat
+	      (tramp-gvfs-url-file-name
+	       (tramp-make-tramp-file-name
+		tramp-archive-method
+		;; User and Domain.
+		nil nil
+		;; Host.
+		(url-hexify-string
+		 (concat
+		  "file://"
+		  ;; `directory-file-name' does not leave file archive
+		  ;; boundaries.  So we must cut the trailing slash
+		  ;; ourselves.
+		  (substring
+		   (file-name-directory tramp-archive-test-file-archive) 0 -1)))
+		nil "/"))
+	      (file-name-nondirectory tramp-archive-test-file-archive)))))
+	  (should-not port)
+	  (should (string-equal localname "/"))
+	  (should (string-equal archive tramp-archive-test-file-archive)))
+
+      ;; Cleanup.
+      (tramp-archive-cleanup-hash))))
+
+(ert-deftest tramp-archive-test05-expand-file-name ()
+  "Check `expand-file-name'."
+  (should
+   (string-equal
+    (expand-file-name "/foo.tar/path/./file") "/foo.tar/path/file"))
+  (should
+   (string-equal (expand-file-name "/foo.tar/path/../file") "/foo.tar/file"))
+  ;; `expand-file-name' does not care "~/" in archive file names.
+  (should
+   (string-equal (expand-file-name "/foo.tar/~/file") "/foo.tar/~/file"))
+  ;; `expand-file-name' does not care file archive boundaries.
+  (should (string-equal (expand-file-name "/foo.tar/./file") "/foo.tar/file"))
+  (should (string-equal (expand-file-name "/foo.tar/../file") "/file")))
+
+(ert-deftest tramp-archive-test06-directory-file-name ()
+  "Check `directory-file-name'.
+This checks also `file-name-as-directory', `file-name-directory',
+`file-name-nondirectory' and `unhandled-file-name-directory'."
+  (should
+   (string-equal
+    (directory-file-name "/foo.tar/path/to/file") "/foo.tar/path/to/file"))
+  (should
+   (string-equal
+    (directory-file-name "/foo.tar/path/to/file/") "/foo.tar/path/to/file"))
+  ;; `directory-file-name' does not leave file archive boundaries.
+  (should (string-equal (directory-file-name "/foo.tar/") "/foo.tar/"))
+
+  (should
+   (string-equal
+    (file-name-as-directory "/foo.tar/path/to/file") "/foo.tar/path/to/file/"))
+  (should
+   (string-equal
+    (file-name-as-directory "/foo.tar/path/to/file/") "/foo.tar/path/to/file/"))
+  (should (string-equal (file-name-as-directory "/foo.tar/") "/foo.tar/"))
+  (should (string-equal (file-name-as-directory "/foo.tar") "/foo.tar/"))
+
+  (should
+   (string-equal
+    (file-name-directory "/foo.tar/path/to/file") "/foo.tar/path/to/"))
+  (should
+   (string-equal
+    (file-name-directory "/foo.tar/path/to/file/") "/foo.tar/path/to/file/"))
+  (should (string-equal (file-name-directory "/foo.tar/") "/foo.tar/"))
+
+  (should
+   (string-equal (file-name-nondirectory "/foo.tar/path/to/file") "file"))
+  (should
+   (string-equal (file-name-nondirectory "/foo.tar/path/to/file/") ""))
+  (should (string-equal (file-name-nondirectory "/foo.tar/") ""))
+
+  (should-not
+   (unhandled-file-name-directory "/foo.tar/path/to/file")))
+
+(ert-deftest tramp-archive-test07-file-exists-p ()
+  "Check `file-exist-p', `write-region' and `delete-file'."
+  (skip-unless tramp-gvfs-enabled)
+
+  (unwind-protect
+      (let ((default-directory tramp-archive-test-archive))
+	(should (file-exists-p tramp-archive-test-file-archive))
+	(should (file-exists-p tramp-archive-test-archive))
+	(should (file-exists-p "foo.txt"))
+	(should (file-exists-p "foo.lnk"))
+	(should (file-exists-p "bar"))
+	(should (file-exists-p "bar/bar"))
+	(should-error
+	 (write-region "foo" nil "baz")
+	 :type 'file-error)
+	(should-error
+	 (delete-file "baz")
+	 :type 'file-error))
+
+    ;; Cleanup.
+    (tramp-archive-cleanup-hash)))
+
+(ert-deftest tramp-archive-test08-file-local-copy ()
+  "Check `file-local-copy'."
+  (skip-unless tramp-gvfs-enabled)
+
+  (let (tmp-name)
+    (unwind-protect
+	(progn
+	  (should
+	   (setq tmp-name
+		 (file-local-copy
+		  (expand-file-name "bar/bar" tramp-archive-test-archive))))
+	  (with-temp-buffer
+	    (insert-file-contents tmp-name)
+	    (should (string-equal (buffer-string) "bar\n")))
+	    ;; Error case.
+	    (tramp-archive--test-delete tmp-name)
+	    (should-error
+	     (setq tmp-name
+		   (file-local-copy
+		    (expand-file-name "what" tramp-archive-test-archive)))
+	     :type tramp-file-missing))
+
+      ;; Cleanup.
+      (ignore-errors
+	(tramp-archive--test-delete tmp-name)
+	(tramp-archive-cleanup-hash)))))
+
+(ert-deftest tramp-archive-test09-insert-file-contents ()
+  "Check `insert-file-contents'."
+  (skip-unless tramp-gvfs-enabled)
+
+  (let ((tmp-name (expand-file-name "bar/bar" tramp-archive-test-archive)))
+    (unwind-protect
+	(with-temp-buffer
+	  (insert-file-contents tmp-name)
+	  (should (string-equal (buffer-string) "bar\n"))
+	  (insert-file-contents tmp-name)
+	  (should (string-equal (buffer-string) "bar\nbar\n"))
+	  ;; Insert partly.
+	  (insert-file-contents tmp-name nil 1 3)
+	  (should (string-equal (buffer-string) "arbar\nbar\n"))
+	  ;; Replace.
+	  (insert-file-contents tmp-name nil nil nil 'replace)
+	  (should (string-equal (buffer-string) "bar\n"))
+	  ;; Error case.
+	  (should-error
+	   (insert-file-contents
+	    (expand-file-name "what" tramp-archive-test-archive))
+	   :type tramp-file-missing))
+
+	;; Cleanup.
+	(tramp-archive-cleanup-hash))))
+
+(ert-deftest tramp-archive-test11-copy-file ()
+  "Check `copy-file'."
+  (skip-unless tramp-gvfs-enabled)
+
+  ;; Copy simple file.
+  (let ((tmp-name1 (expand-file-name "bar/bar" tramp-archive-test-archive))
+	(tmp-name2 (tramp-archive--test-make-temp-name)))
+    (unwind-protect
+	(progn
+	  (copy-file tmp-name1 tmp-name2)
+	  (should (file-exists-p tmp-name2))
+	  (with-temp-buffer
+	    (insert-file-contents tmp-name2)
+	    (should (string-equal (buffer-string) "bar\n")))
+	  (should-error
+	   (copy-file tmp-name1 tmp-name2)
+	   :type 'file-already-exists)
+	  (copy-file tmp-name1 tmp-name2 'ok)
+	  ;; The file archive is not writable.
+	  (should-error
+	   (copy-file tmp-name2 tmp-name1 'ok)
+	   :type 'file-error))
+
+      ;; Cleanup.
+      (ignore-errors (tramp-archive--test-delete tmp-name2))
+      (tramp-archive-cleanup-hash)))
+
+  ;; Copy directory to existing directory.
+  (let ((tmp-name1 (expand-file-name "bar" tramp-archive-test-archive))
+	(tmp-name2 (tramp-archive--test-make-temp-name)))
+    (unwind-protect
+	(progn
+	  (make-directory tmp-name2)
+	  (should (file-directory-p tmp-name2))
+	  ;; Directory `tmp-name2' exists already, so we must use
+	  ;; `file-name-as-directory'.
+	  (copy-file tmp-name1 (file-name-as-directory tmp-name2))
+	  (should
+	   (file-exists-p
+	    (expand-file-name
+	     (concat (file-name-nondirectory tmp-name1) "/bar") tmp-name2))))
+
+      ;; Cleanup.
+      (ignore-errors (tramp-archive--test-delete tmp-name2))
+      (tramp-archive-cleanup-hash)))
+
+  ;; Copy directory/file to non-existing directory.
+  (let ((tmp-name1 (expand-file-name "bar" tramp-archive-test-archive))
+	(tmp-name2 (tramp-archive--test-make-temp-name)))
+    (unwind-protect
+	(progn
+	  (make-directory tmp-name2)
+	  (should (file-directory-p tmp-name2))
+	  (copy-file
+	   tmp-name1
+	   (expand-file-name (file-name-nondirectory tmp-name1) tmp-name2))
+	  (should
+	   (file-exists-p
+	    (expand-file-name
+	     (concat (file-name-nondirectory tmp-name1) "/bar") tmp-name2))))
+
+      ;; Cleanup.
+      (ignore-errors (tramp-archive--test-delete tmp-name2))
+      (tramp-archive-cleanup-hash))))
+
+(ert-deftest tramp-archive-test15-copy-directory ()
+  "Check `copy-directory'."
+  (skip-unless tramp-gvfs-enabled)
+
+  (let* ((tmp-name1 (expand-file-name "bar" tramp-archive-test-archive))
+	 (tmp-name2 (tramp-archive--test-make-temp-name))
+	 (tmp-name3 (expand-file-name
+		     (file-name-nondirectory tmp-name1) tmp-name2))
+	 (tmp-name4 (expand-file-name "bar" tmp-name2))
+	 (tmp-name5 (expand-file-name "bar" tmp-name3)))
+
+    ;; Copy complete directory.
+    (unwind-protect
+	(progn
+	  ;; Copy empty directory.
+	  (copy-directory tmp-name1 tmp-name2)
+	  (should (file-directory-p tmp-name2))
+	  (should (file-exists-p tmp-name4))
+	  ;; Target directory does exist already.
+	  ;; This has been changed in Emacs 26.1.
+	  (when (tramp-archive--test-emacs26-p)
+	    (should-error
+	     (copy-directory tmp-name1 tmp-name2)
+	     :type 'file-error))
+	  (tramp-archive--test-delete tmp-name4)
+	  (copy-directory tmp-name1 (file-name-as-directory tmp-name2))
+	  (should (file-directory-p tmp-name3))
+	  (should (file-exists-p tmp-name5)))
+
+      ;; Cleanup.
+      (ignore-errors (tramp-archive--test-delete tmp-name2))
+      (tramp-archive-cleanup-hash))
+
+    ;; Copy directory contents.
+    (unwind-protect
+        (progn
+          ;; Copy empty directory.
+          (copy-directory tmp-name1 tmp-name2 nil 'parents 'contents)
+          (should (file-directory-p tmp-name2))
+          (should (file-exists-p tmp-name4))
+          ;; Target directory does exist already.
+          (tramp-archive--test-delete tmp-name4)
+          (copy-directory
+           tmp-name1 (file-name-as-directory tmp-name2)
+           nil 'parents 'contents)
+          (should (file-directory-p tmp-name2))
+          (should (file-exists-p tmp-name4))
+          (should-not (file-directory-p tmp-name3))
+          (should-not (file-exists-p tmp-name5)))
+
+      ;; Cleanup.
+      (ignore-errors (tramp-archive--test-delete tmp-name2))
+      (tramp-archive-cleanup-hash))))
+
+(ert-deftest tramp-archive-test16-directory-files ()
+  "Check `directory-files'."
+  (skip-unless tramp-gvfs-enabled)
+
+  (let ((tmp-name tramp-archive-test-archive)
+	(files '("." ".." "bar" "foo.hrd" "foo.lnk" "foo.txt")))
+    (unwind-protect
+	(progn
+	  (should (file-directory-p tmp-name))
+	  (should (equal (directory-files tmp-name) files))
+	  (should (equal (directory-files tmp-name 'full)
+			 (mapcar (lambda (x) (concat tmp-name x)) files)))
+	  (should (equal (directory-files
+			  tmp-name nil directory-files-no-dot-files-regexp)
+			 (delete "." (delete ".." files))))
+	  (should (equal (directory-files
+			  tmp-name 'full directory-files-no-dot-files-regexp)
+			 (mapcar (lambda (x) (concat tmp-name x))
+				 (delete "." (delete ".." files))))))
+
+      ;; Cleanup.
+      (tramp-archive-cleanup-hash))))
+
+(ert-deftest tramp-archive-test17-insert-directory ()
+  "Check `insert-directory'."
+  (skip-unless tramp-gvfs-enabled)
+
+  (let (;; We test for the summary line.  Keyword "total" could be localized.
+	(process-environment
+	 (append '("LANG=C" "LANGUAGE=C" "LC_ALL=C") process-environment)))
+    (unwind-protect
+	(progn
+	  ;; Due to Bug#29423, this works only since for Emacs 26.1.
+	  (when nil ;; TODO (tramp-archive--test-emacs26-p)
+	    (with-temp-buffer
+	      (insert-directory tramp-archive-test-archive nil)
+	      (goto-char (point-min))
+	      (should
+	       (looking-at-p (regexp-quote tramp-archive-test-archive)))))
+	  (with-temp-buffer
+	    (insert-directory tramp-archive-test-archive "-al")
+	    (goto-char (point-min))
+	    (should
+	     (looking-at-p
+	      (format "^.+ %s$" (regexp-quote tramp-archive-test-archive)))))
+	  (with-temp-buffer
+	    (insert-directory
+	     (file-name-as-directory tramp-archive-test-archive)
+	     "-al" nil 'full-directory-p)
+	    (goto-char (point-min))
+	    (should
+	     (looking-at-p
+	      (concat
+	       ;; There might be a summary line.
+	       "\\(total.+[[:digit:]]+\n\\)?"
+	       ;; We don't know in which order the files appear.
+	       (format
+		"\\(.+ %s\\( ->.+\\)?\n\\)\\{%d\\}"
+		(regexp-opt (directory-files tramp-archive-test-archive))
+		(length (directory-files tramp-archive-test-archive))))))))
+
+      ;; Cleanup.
+      (tramp-archive-cleanup-hash))))
+
+(ert-deftest tramp-archive-test18-file-attributes ()
+  "Check `file-attributes'.
+This tests also `file-readable-p' and `file-regular-p'."
+  (skip-unless tramp-gvfs-enabled)
+
+  (let ((tmp-name1 (expand-file-name "foo.txt" tramp-archive-test-archive))
+	(tmp-name2 (expand-file-name "foo.lnk" tramp-archive-test-archive))
+	(tmp-name3 (expand-file-name "bar" tramp-archive-test-archive))
+	attr)
+    (unwind-protect
+	(progn
+	  (should (file-exists-p tmp-name1))
+	  (should (file-readable-p tmp-name1))
+	  (should (file-regular-p tmp-name1))
+
+	  ;; We do not test inodes and device numbers.
+	  (setq attr (file-attributes tmp-name1))
+	  (should (consp attr))
+	  (should (null (car attr)))
+	  (should (numberp (nth 1 attr))) ;; Link.
+	  (should (numberp (nth 2 attr))) ;; Uid.
+	  (should (numberp (nth 3 attr))) ;; Gid.
+	  ;; Last access time.
+	  (should (stringp (current-time-string (nth 4 attr))))
+	  ;; Last modification time.
+	  (should (stringp (current-time-string (nth 5 attr))))
+	  ;; Last status change time.
+	  (should (stringp (current-time-string (nth 6 attr))))
+	  (should (numberp (nth 7 attr))) ;; Size.
+	  (should (stringp (nth 8 attr))) ;; Modes.
+
+	  (setq attr (file-attributes tmp-name1 'string))
+	  (should (stringp (nth 2 attr))) ;; Uid.
+	  (should (stringp (nth 3 attr))) ;; Gid.
+
+	  ;; Symlink.
+	  (should (file-exists-p tmp-name2))
+	  (should (file-symlink-p tmp-name2))
+	  (setq attr (file-attributes tmp-name2))
+	  (should (string-equal (car attr) (file-name-nondirectory tmp-name1)))
+
+	  ;; Directory.
+	  (should (file-exists-p tmp-name3))
+	  (should (file-readable-p tmp-name3))
+	  (should-not (file-regular-p tmp-name3))
+	  (setq attr (file-attributes tmp-name3))
+	  (should (eq (car attr) t)))
+
+      ;; Cleanup.
+      (tramp-archive-cleanup-hash))))
+
+(ert-deftest tramp-archive-test19-directory-files-and-attributes ()
+  "Check `directory-files-and-attributes'."
+  (skip-unless tramp-gvfs-enabled)
+
+  (let ((tmp-name (expand-file-name "bar" tramp-archive-test-archive))
+	attr)
+    (unwind-protect
+	(progn
+	  (should (file-directory-p tmp-name))
+	  (setq attr (directory-files-and-attributes tmp-name))
+	  (should (consp attr))
+	  (dolist (elt attr)
+	    (should
+	     (equal (file-attributes (expand-file-name (car elt) tmp-name))
+		    (cdr elt))))
+	  (setq attr (directory-files-and-attributes tmp-name 'full))
+	  (dolist (elt attr)
+	    (should (equal (file-attributes (car elt)) (cdr elt))))
+	  (setq attr (directory-files-and-attributes tmp-name nil "^b"))
+	  (should (equal (mapcar 'car attr) '("bar"))))
+
+      ;; Cleanup.
+      (tramp-archive-cleanup-hash))))
+
+(ert-deftest tramp-archive-test20-file-modes ()
+  "Check `file-modes'.
+This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
+  (skip-unless tramp-gvfs-enabled)
+
+  (let ((tmp-name1 (expand-file-name "foo.txt" tramp-archive-test-archive))
+	(tmp-name2 (expand-file-name "bar" tramp-archive-test-archive)))
+    (unwind-protect
+	(progn
+	  (should (file-exists-p tmp-name1))
+	  ;; `set-file-modes' is not implemented.
+	  (should-error
+	   (set-file-modes tmp-name1 #o777)
+	   :type 'file-error)
+	  (should (= (file-modes tmp-name1) #o400))
+	  (should-not (file-executable-p tmp-name1))
+	  (should-not (file-writable-p tmp-name1))
+
+	  (should (file-exists-p tmp-name2))
+	  ;; `set-file-modes' is not implemented.
+	  (should-error
+	   (set-file-modes tmp-name2 #o777)
+	   :type 'file-error)
+	  (should (= (file-modes tmp-name2) #o500))
+	  (should (file-executable-p tmp-name2))
+	  (should-not (file-writable-p tmp-name2)))
+
+      ;; Cleanup.
+      (tramp-archive-cleanup-hash))))
+
+(ert-deftest tramp-archive-test21-file-links ()
+  "Check `file-symlink-p' and `file-truename'"
+  (skip-unless tramp-gvfs-enabled)
+
+  ;; We must use `file-truename' for the file archive, because it
+  ;; could be located on a symlinked directory.  This would let the
+  ;; test fail.
+  (let* ((tramp-archive-test-archive (file-truename tramp-archive-test-archive))
+	 (tmp-name1 (expand-file-name "foo.txt" tramp-archive-test-archive))
+	 (tmp-name2 (expand-file-name "foo.lnk" tramp-archive-test-archive)))
+
+    (unwind-protect
+	(progn
+	  (should (file-exists-p tmp-name1))
+	  (should (string-equal tmp-name1 (file-truename tmp-name1)))
+	  ;; `make-symbolic-link' is not implemented.
+	  (should-error
+	   (make-symbolic-link tmp-name1 tmp-name2)
+	   :type 'file-error)
+	  (should (file-symlink-p tmp-name2))
+	  (should
+	   (string-equal
+	    ;; This is "/foo.txt".
+	    (with-parsed-tramp-archive-file-name tmp-name1 nil localname)
+	    ;; `file-symlink-p' returns "foo.txt".  Wer must expand, therefore.
+	    (with-parsed-tramp-archive-file-name
+		(expand-file-name
+		 (file-symlink-p tmp-name2) tramp-archive-test-archive)
+		nil
+	      localname)))
+	  (should-not (string-equal tmp-name2 (file-truename tmp-name2)))
+	  (should
+	   (string-equal (file-truename tmp-name1) (file-truename tmp-name2)))
+	  (should (file-equal-p tmp-name1 tmp-name2)))
+
+      ;; Cleanup.
+      (tramp-archive-cleanup-hash))))
+
+(ert-deftest tramp-archive-test26-file-name-completion ()
+  "Check `file-name-completion' and `file-name-all-completions'."
+  (skip-unless tramp-gvfs-enabled)
+
+  (let ((tmp-name tramp-archive-test-archive))
+    (unwind-protect
+	(progn
+	  ;; Local files.
+	  (should (equal (file-name-completion "fo" tmp-name) "foo."))
+	  (should (equal (file-name-completion "foo.txt" tmp-name) t))
+	  (should (equal (file-name-completion "b" tmp-name) "bar/"))
+	  (should-not (file-name-completion "a" tmp-name))
+	  (should
+	   (equal
+	    (file-name-completion "b" tmp-name 'file-directory-p) "bar/"))
+	  (should
+	   (equal
+	    (sort (file-name-all-completions "fo" tmp-name) 'string-lessp)
+	    '("foo.hrd" "foo.lnk" "foo.txt")))
+	  (should
+	   (equal
+	    (sort (file-name-all-completions "b" tmp-name) 'string-lessp)
+	    '("bar/")))
+	  (should-not (file-name-all-completions "a" tmp-name))
+	  ;; `completion-regexp-list' restricts the completion to
+	  ;; files which match all expressions in this list.
+	  (let ((completion-regexp-list
+		 `(,directory-files-no-dot-files-regexp "b")))
+	    (should
+	     (equal (file-name-completion "" tmp-name) "bar/"))
+	    (should
+	     (equal
+	      (sort (file-name-all-completions "" tmp-name) 'string-lessp)
+	      '("bar/")))))
+
+      ;; Cleanup.
+      (tramp-archive-cleanup-hash))))
+
+;; The functions were introduced in Emacs 26.1.
+(ert-deftest tramp-archive-test37-make-nearby-temp-file ()
+  "Check `make-nearby-temp-file' and `temporary-file-directory'."
+  (skip-unless tramp-gvfs-enabled)
+  ;; Since Emacs 26.1.
+  (skip-unless
+   (and (fboundp 'make-nearby-temp-file) (fboundp 'temporary-file-directory)))
+
+  ;; `make-nearby-temp-file' and `temporary-file-directory' exists
+  ;; since Emacs 26.1.  We don't want to see compiler warnings for
+  ;; older Emacsen.
+  (let ((default-directory tramp-archive-test-archive)
+	tmp-file)
+    ;; The file archive shall know a temporary file directory.  It is
+    ;; not in the archive itself.
+    (should (stringp (with-no-warnings (temporary-file-directory))))
+    (should-not
+     (tramp-archive-file-name-p (with-no-warnings (temporary-file-directory))))
+
+    ;; A temporary file or directory shall not be located in the
+    ;; archive itself.
+    (setq tmp-file
+	  (with-no-warnings (make-nearby-temp-file "tramp-archive-test")))
+    (should (file-exists-p tmp-file))
+    (should (file-regular-p tmp-file))
+    (should-not (tramp-archive-file-name-p tmp-file))
+    (delete-file tmp-file)
+    (should-not (file-exists-p tmp-file))
+
+    (setq tmp-file
+	  (with-no-warnings (make-nearby-temp-file "tramp-archive-test" 'dir)))
+    (should (file-exists-p tmp-file))
+    (should (file-directory-p tmp-file))
+    (should-not (tramp-archive-file-name-p tmp-file))
+    (delete-directory tmp-file)
+    (should-not (file-exists-p tmp-file))))
+
+(ert-deftest tramp-archive-test40-archive-file-system-info ()
+  "Check that `file-system-info' returns proper values."
+  (skip-unless tramp-gvfs-enabled)
+  ;; Since Emacs 27.1.
+  (skip-unless (fboundp 'file-system-info))
+
+  ;; `file-system-info' exists since Emacs 27.  We don't want to see
+  ;; compiler warnings for older Emacsen.
+  (let ((fsi (with-no-warnings (file-system-info tramp-archive-test-archive))))
+    (skip-unless fsi)
+    (should (and (consp fsi)
+		 (= (length fsi) 3)
+		 (numberp (nth 0 fsi))
+		 ;; FREE and AVAIL are always 0.
+		 (zerop (nth 1 fsi))
+		 (zerop (nth 2 fsi))))))
+
+(ert-deftest tramp-archive-test41-libarchive-tests ()
+  "Run tests of libarchive test files."
+  :tags '(:expensive-test)
+  (skip-unless tramp-gvfs-enabled)
+  ;; We do not want to run unless chosen explicitly.  This test makes
+  ;; sense only in my local environment.  Michael Albinus.
+  (skip-unless
+   (equal
+    (ert--stats-selector ert--current-run-stats)
+    (ert-test-name (ert-running-test))))
+
+  (url-handler-mode)
+  (unwind-protect
+      (dolist (dir
+	       '("~/Downloads" "/sftp::~/Downloads" "/ssh::~/Downloads"
+		 "http://ftp.debian.org/debian/pool/main/c/coreutils"))
+	(dolist
+	    (file
+	     '("coreutils_8.26-3_amd64.deb"
+	       "coreutils_8.26-3ubuntu3_amd64.deb"))
+	  (setq file (expand-file-name file dir))
+	  (when (file-exists-p file)
+	    (setq file (expand-file-name "control.tar.gz/control" file))
+	    (message "%s" file)
+	    (should (file-attributes (file-name-as-directory file))))))
+
+    ;; Cleanup.
+    (tramp-archive-cleanup-hash))
+
+  (unwind-protect
+      (dolist (dir '("" "/sftp::" "/ssh::"))
+	(dolist
+	    (file
+	     (apply
+	      'append
+	      (mapcar
+	       (lambda (x) (directory-files (concat dir x) 'full "uu\\'" 'sort))
+	       '("~/src/libarchive-3.2.2/libarchive/test"
+		 "~/src/libarchive-3.2.2/cpio/test"
+		 "~/src/libarchive-3.2.2/tar/test"))))
+	  (setq file (file-name-as-directory file))
+	  (cond
+	   ((not (tramp-archive-file-name-p file))
+	    (message "skipped: %s" file))
+	   ((file-attributes file)
+	    (message "%s" file))
+	   (t (message "failed: %s" file)))
+	  (tramp-archive-cleanup-hash)))
+
+    ;; Cleanup.
+    (tramp-archive-cleanup-hash)))
+
+(defun tramp-archive-test-all (&optional interactive)
+  "Run all tests for \\[tramp-archive]."
+  (interactive "p")
+  (funcall
+   (if interactive 'ert-run-tests-interactively 'ert-run-tests-batch)
+   "^tramp-archive"))
+
+(provide 'tramp-archive-tests)
+;;; tramp-archive-tests.el ends here
-- 
2.39.5