[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/tramp 7ea5630 2/4: Reorganization
From: |
Michael Albinus |
Subject: |
[elpa] externals/tramp 7ea5630 2/4: Reorganization |
Date: |
Sat, 25 May 2019 04:00:46 -0400 (EDT) |
branch: externals/tramp
commit 7ea5630a3ff31809b18f8884e8203e5290a3e493
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>
Reorganization
---
.gitignore | 10 +-
Makefile | 38 +
texi/dir_sample => dir | 4 +
lisp/.gitignore | 3 -
lisp/tramp-adb.el | 1320 ----------
lisp/tramp-archive.el | 666 -----
lisp/tramp-cache.el | 526 ----
lisp/tramp-cmds.el | 434 ----
lisp/tramp-compat.el | 330 ---
lisp/tramp-ftp.el | 209 --
lisp/tramp-gvfs.el | 2067 ----------------
lisp/tramp-integration.el | 199 --
lisp/tramp-rclone.el | 608 -----
lisp/tramp-sh.el | 5965 --------------------------------------------
lisp/tramp-smb.el | 2112 ----------------
lisp/tramp-sudoedit.el | 893 -------
lisp/tramp-uu.el | 101 -
lisp/tramp.el | 4975 -------------------------------------
tramp-adb.el | 1321 +++++++++-
tramp-archive.el | 667 ++++-
tramp-cache.el | 527 +++-
tramp-cmds.el | 435 +++-
tramp-compat.el | 331 ++-
tramp-ftp.el | 210 +-
tramp-gvfs.el | 2068 +++++++++++++++-
tramp-integration.el | 200 +-
tramp-loaddefs.el | 1 -
tramp-rclone.el | 609 ++++-
tramp-sh.el | 5966 ++++++++++++++++++++++++++++++++++++++++++++-
tramp-smb.el | 2113 +++++++++++++++-
tramp-sudoedit.el | 894 ++++++-
tramp-uu.el | 102 +-
tramp.el | 4976 ++++++++++++++++++++++++++++++++++++-
tramp.info | 4597 ++++++++++++++++++++++++++++++++++
trampver.el | 1 -
35 files changed, 25045 insertions(+), 20433 deletions(-)
diff --git a/.gitignore b/.gitignore
index d60f17b..c531d98 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,9 +1 @@
-MANIFEST
-Makefile
-autom4te.cache
-config.*
-configure
-configure.lineno
-info
-tramp-*.tar.gz*
-*.diff
+*.elc
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..3774e48
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,38 @@
+# -*- coding: utf-8; -*-
+# Emacs Makefile for Tramp
+
+# Copyright (C) 2019 Free Software Foundation, Inc.
+
+# Author: Michael Albinus <address@hidden>
+# Keywords: comm, processes
+
+# This file 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 file 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 <http://www.gnu.org/licenses/>.
+
+EMACS = emacs
+EM = $(EMACS) -Q -batch -L .
+LISP_FILES = $(wildcard *.el)
+
+.PHONY: all autoloads
+
+.SUFFIXES: .el
+
+all: autoloads
+
+autoloads: $(LISP_FILES)
+ $(EM) -l autoload \
+ --eval "(setq generate-autoload-cookie \";;;###tramp-autoload\")" \
+ --eval "(setq generated-autoload-file \
+ (expand-file-name \"tramp-loaddefs.el\"))" \
+ --eval "(setq make-backup-files nil)" \
+ -f batch-update-autoloads .
diff --git a/texi/dir_sample b/dir
similarity index 81%
rename from texi/dir_sample
rename to dir
index 7436d21..20168b3 100644
--- a/texi/dir_sample
+++ b/dir
@@ -17,3 +17,7 @@ The Info Directory
or cross reference to follow it to its target.
* Menu: Each line that starts with a * is a topic you can select with "m".
+
+Emacs network features
+* Tramp: (tramp). Transparent Remote Access, Multiple Protocol
+ Emacs remote file access via ssh and scp.
diff --git a/lisp/.gitignore b/lisp/.gitignore
deleted file mode 100644
index 861690b..0000000
--- a/lisp/.gitignore
+++ /dev/null
@@ -1,3 +0,0 @@
-tramp-loaddefs.el
-trampver.el
-*.elc
diff --git a/lisp/tramp-adb.el b/lisp/tramp-adb.el
deleted file mode 100644
index 008a5ce..0000000
--- a/lisp/tramp-adb.el
+++ /dev/null
@@ -1,1320 +0,0 @@
-;;; tramp-adb.el --- Functions for calling Android Debug Bridge from Tramp
-*- lexical-binding:t -*-
-
-;; Copyright (C) 2011-2019 Free Software Foundation, Inc.
-
-;; Author: Jürgen Hötzel <address@hidden>
-;; 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:
-
-;; The Android Debug Bridge "adb" must be installed on your local
-;; machine. If it is not in your $PATH, add the following form into
-;; your .emacs:
-;;
-;; (setq tramp-adb-program "/path/to/adb")
-;;
-;; Due to security it is not possible to access non-root devices.
-
-;;; Code:
-
-(require 'tramp)
-
-(defcustom tramp-adb-program "adb"
- "Name of the Android Debug Bridge program."
- :group 'tramp
- :version "24.4"
- :type 'string)
-
-(defcustom tramp-adb-connect-if-not-connected nil
- "Try to run `adb connect' if provided device is not connected currently.
-It is used for TCP/IP devices."
- :group 'tramp
- :version "25.1"
- :type 'boolean)
-
-;;;###tramp-autoload
-(defconst tramp-adb-method "adb"
- "When this method name is used, forward all calls to Android Debug Bridge.")
-
-(defcustom tramp-adb-prompt
-
"^[[:digit:]]*|?[[:alnum:]\e;address@hidden:alnum:]]*[^#\\$]*[#\\$][[:space:]]"
- "Regexp used as prompt in almquist shell."
- :type 'string
- :version "24.4"
- :group 'tramp)
-
-(defconst tramp-adb-ls-date-regexp
-
"[[:space:]][0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9][[:space:]][0-9][0-9]:[0-9][0-9][[:space:]]"
- "Regexp for date format in ls output.")
-
-(defconst tramp-adb-ls-toolbox-regexp
- (concat
- "^[[:space:]]*\\([-.[:alpha:]]+\\)" ; \1 permissions
- "\\(?:[[:space:]]+[[:digit:]]+\\)?" ; links (Android 7/toybox)
- "[[:space:]]*\\([^[:space:]]+\\)" ; \2 username
- "[[:space:]]+\\([^[:space:]]+\\)" ; \3 group
- "[[:space:]]+\\([[:digit:]]+\\)" ; \4 size
- "[[:space:]]+\\([-[:digit:]]+[[:space:]][:[:digit:]]+\\)" ; \5 date
- "[[:space:]]\\(.*\\)$") ; \6 filename
- "Regexp for ls output.")
-
-;;;###tramp-autoload
-(tramp--with-startup
- (add-to-list 'tramp-methods
- `(,tramp-adb-method
- (tramp-tmpdir "/data/local/tmp")
- (tramp-default-port 5555)))
-
- (add-to-list 'tramp-default-host-alist `(,tramp-adb-method nil ""))
-
- (tramp-set-completion-function
- tramp-adb-method '((tramp-adb-parse-device-names ""))))
-
-;;;###tramp-autoload
-(defconst tramp-adb-file-name-handler-alist
- '((access-file . tramp-handle-access-file)
- (add-name-to-file . tramp-handle-add-name-to-file)
- ;; `byte-compiler-base-file-name' performed by default handler.
- ;; `copy-directory' performed by default handler.
- (copy-file . tramp-adb-handle-copy-file)
- (delete-directory . tramp-adb-handle-delete-directory)
- (delete-file . tramp-adb-handle-delete-file)
- ;; `diff-latest-backup-file' performed by default handler.
- (directory-file-name . tramp-handle-directory-file-name)
- (directory-files . tramp-handle-directory-files)
- (directory-files-and-attributes
- . tramp-adb-handle-directory-files-and-attributes)
- (dired-compress-file . ignore)
- (dired-uncache . tramp-handle-dired-uncache)
- (exec-path . tramp-adb-handle-exec-path)
- (expand-file-name . tramp-handle-expand-file-name)
- (file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
- (file-acl . ignore)
- (file-attributes . tramp-adb-handle-file-attributes)
- (file-directory-p . tramp-handle-file-directory-p)
- (file-equal-p . tramp-handle-file-equal-p)
- ;; FIXME: This is too sloppy.
- (file-executable-p . tramp-handle-file-exists-p)
- (file-exists-p . tramp-handle-file-exists-p)
- (file-in-directory-p . tramp-handle-file-in-directory-p)
- (file-local-copy . tramp-adb-handle-file-local-copy)
- (file-modes . tramp-handle-file-modes)
- (file-name-all-completions . tramp-adb-handle-file-name-all-completions)
- (file-name-as-directory . tramp-handle-file-name-as-directory)
- (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p)
- (file-name-completion . tramp-handle-file-name-completion)
- (file-name-directory . tramp-handle-file-name-directory)
- (file-name-nondirectory . tramp-handle-file-name-nondirectory)
- ;; `file-name-sans-versions' performed by default handler.
- (file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
- (file-notify-add-watch . tramp-handle-file-notify-add-watch)
- (file-notify-rm-watch . tramp-handle-file-notify-rm-watch)
- (file-notify-valid-p . tramp-handle-file-notify-valid-p)
- (file-ownership-preserved-p . ignore)
- (file-readable-p . tramp-handle-file-exists-p)
- (file-regular-p . tramp-handle-file-regular-p)
- (file-remote-p . tramp-handle-file-remote-p)
- (file-selinux-context . tramp-handle-file-selinux-context)
- (file-symlink-p . tramp-handle-file-symlink-p)
- (file-system-info . tramp-adb-handle-file-system-info)
- (file-truename . tramp-adb-handle-file-truename)
- (file-writable-p . tramp-adb-handle-file-writable-p)
- (find-backup-file-name . tramp-handle-find-backup-file-name)
- ;; `get-file-buffer' performed by default handler.
- (insert-directory . tramp-handle-insert-directory)
- (insert-file-contents . tramp-handle-insert-file-contents)
- (load . tramp-handle-load)
- (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
- (make-directory . tramp-adb-handle-make-directory)
- (make-directory-internal . ignore)
- (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
- (make-process . tramp-adb-handle-make-process)
- (make-symbolic-link . tramp-handle-make-symbolic-link)
- (process-file . tramp-adb-handle-process-file)
- (rename-file . tramp-adb-handle-rename-file)
- (set-file-acl . ignore)
- (set-file-modes . tramp-adb-handle-set-file-modes)
- (set-file-selinux-context . ignore)
- (set-file-times . tramp-adb-handle-set-file-times)
- (set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
- (shell-command . tramp-handle-shell-command)
- (start-file-process . tramp-handle-start-file-process)
- (substitute-in-file-name . tramp-handle-substitute-in-file-name)
- (temporary-file-directory . tramp-handle-temporary-file-directory)
- (tramp-set-file-uid-gid . ignore)
- (unhandled-file-name-directory . ignore)
- (vc-registered . ignore)
- (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
- (write-region . tramp-adb-handle-write-region))
- "Alist of handler functions for Tramp ADB method.")
-
-;; It must be a `defsubst' in order to push the whole code into
-;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
-;;;###tramp-autoload
-(defsubst tramp-adb-file-name-p (filename)
- "Check if it's a filename for ADB."
- (and (tramp-tramp-file-p filename)
- (string= (tramp-file-name-method (tramp-dissect-file-name filename))
- tramp-adb-method)))
-
-;;;###tramp-autoload
-(defun tramp-adb-file-name-handler (operation &rest args)
- "Invoke the ADB handler for OPERATION.
-First arg specifies the OPERATION, second arg is a list of arguments to
-pass to the OPERATION."
- (let ((fn (assoc operation tramp-adb-file-name-handler-alist)))
- (if fn
- (save-match-data (apply (cdr fn) args))
- (tramp-run-real-handler operation args))))
-
-;;;###tramp-autoload
-(tramp--with-startup
- (tramp-register-foreign-file-name-handler
- #'tramp-adb-file-name-p #'tramp-adb-file-name-handler))
-
-;;;###tramp-autoload
-(defun tramp-adb-parse-device-names (_ignore)
- "Return a list of (nil host) tuples allowed to access."
- (delq nil
- (mapcar
- (lambda (line)
- (when (string-match "^\\(\\S-+\\)[[:space:]]+device$" line)
- ;; Replace ":" by "#".
- `(nil ,(replace-regexp-in-string
- ":" tramp-prefix-port-format (match-string 1 line)))))
- (tramp-process-lines nil tramp-adb-program "devices"))))
-
-(defun tramp-adb-handle-file-system-info (filename)
- "Like `file-system-info' for Tramp files."
- (ignore-errors
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (tramp-message v 5 "file system info: %s" localname)
- (tramp-adb-send-command
- v (format "df -k %s" (tramp-shell-quote-argument localname)))
- (with-current-buffer (tramp-get-connection-buffer v)
- (goto-char (point-min))
- (forward-line)
- (when (looking-at
- (eval-when-compile
- (concat "[[:space:]]*[^[:space:]]+"
- "[[:space:]]+\\([[:digit:]]+\\)"
- "[[:space:]]+\\([[:digit:]]+\\)"
- "[[:space:]]+\\([[:digit:]]+\\)")))
- ;; The values are given as 1k numbers, so we must change
- ;; them to number of bytes.
- (list (* 1024 (string-to-number (match-string 1)))
- ;; The second value is the used size. We need the
- ;; free size.
- (* 1024 (- (string-to-number (match-string 1))
- (string-to-number (match-string 2))))
- (* 1024 (string-to-number (match-string 3)))))))))
-
-;; This is derived from `tramp-sh-handle-file-truename'. Maybe the
-;; code could be shared?
-(defun tramp-adb-handle-file-truename (filename)
- "Like `file-truename' for Tramp files."
- ;; Preserve trailing "/".
- (funcall
- (if (string-equal (file-name-nondirectory filename) "")
- #'file-name-as-directory #'identity)
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (tramp-make-tramp-file-name
- v
- (with-tramp-file-property v localname "file-truename"
- (let ((result nil) ; result steps in reverse order
- (quoted (tramp-compat-file-name-quoted-p localname)))
- (tramp-message v 4 "Finding true name for `%s'" filename)
- (let* ((steps (split-string localname "/" 'omit))
- (localnamedir (tramp-run-real-handler
- 'file-name-as-directory (list localname)))
- (is-dir (string= localname localnamedir))
- (thisstep nil)
- (numchase 0)
- ;; Don't make the following value larger than
- ;; necessary. People expect an error message in a
- ;; timely fashion when something is wrong; otherwise
- ;; they might think that Emacs is hung. Of course,
- ;; correctness has to come first.
- (numchase-limit 20)
- symlink-target)
- (while (and steps (< numchase numchase-limit))
- (setq thisstep (pop steps))
- (tramp-message
- v 5 "Check %s"
- (mapconcat #'identity
- (append '("") (reverse result) (list thisstep))
- "/"))
- (setq symlink-target
- (tramp-compat-file-attribute-type
- (file-attributes
- (tramp-make-tramp-file-name
- v (mapconcat #'identity
- (append
- '("") (reverse result) (list thisstep))
- "/")))))
- (cond ((string= "." thisstep)
- (tramp-message v 5 "Ignoring step `.'"))
- ((string= ".." thisstep)
- (tramp-message v 5 "Processing step `..'")
- (pop result))
- ((stringp symlink-target)
- ;; It's a symlink, follow it.
- (tramp-message v 5 "Follow symlink to %s" symlink-target)
- (setq numchase (1+ numchase))
- (when (file-name-absolute-p symlink-target)
- (setq result nil))
- ;; If the symlink was absolute, we'll get a string
- ;; like "/address@hidden:/some/target"; extract the
- ;; "/some/target" part from it.
- (when (tramp-tramp-file-p symlink-target)
- (unless (tramp-equal-remote filename symlink-target)
- (tramp-error
- v 'file-error
- "Symlink target `%s' on wrong host" symlink-target))
- (setq symlink-target localname))
- (setq steps
- (append (split-string symlink-target "/" 'omit)
- steps)))
- (t
- ;; It's a file.
- (setq result (cons thisstep result)))))
- (when (>= numchase numchase-limit)
- (tramp-error
- v 'file-error
- "Maximum number (%d) of symlinks exceeded" numchase-limit))
- (setq result (reverse result))
- ;; Combine list to form string.
- (setq result
- (if result
- (mapconcat #'identity (cons "" result) "/")
- "/"))
- (when (and is-dir (or (string= "" result)
- (not (string= (substring result -1) "/"))))
- (setq result (concat result "/"))))
-
- ;; Detect cycle.
- (when (and (file-symlink-p filename)
- (string-equal result localname))
- (tramp-error
- v 'file-error
- "Apparent cycle of symbolic links for %s" filename))
- ;; If the resulting localname looks remote, we must quote it
- ;; for security reasons.
- (when (or quoted (file-remote-p result))
- (let (file-name-handler-alist)
- (setq result (tramp-compat-file-name-quote result))))
- (tramp-message v 4 "True name of `%s' is `%s'" localname result)
- result))))))
-
-(defun tramp-adb-handle-file-attributes (filename &optional id-format)
- "Like `file-attributes' for Tramp files."
- (unless id-format (setq id-format 'integer))
- (ignore-errors
- (with-parsed-tramp-file-name filename nil
- (with-tramp-file-property
- v localname (format "file-attributes-%s" id-format)
- (and
- (tramp-adb-send-command-and-check
- v (format "%s -d -l %s"
- (tramp-adb-get-ls-command v)
- (tramp-shell-quote-argument localname)))
- (with-current-buffer (tramp-get-buffer v)
- (tramp-adb-sh-fix-ls-output)
- (cdar (tramp-do-parse-file-attributes-with-ls v id-format))))))))
-
-(defun tramp-do-parse-file-attributes-with-ls (vec &optional id-format)
- "Parse `file-attributes' for Tramp files using the ls(1) command."
- (with-current-buffer (tramp-get-buffer vec)
- (goto-char (point-min))
- (let ((file-properties nil))
- (while (re-search-forward tramp-adb-ls-toolbox-regexp nil t)
- (let* ((mod-string (match-string 1))
- (is-dir (eq ?d (aref mod-string 0)))
- (is-symlink (eq ?l (aref mod-string 0)))
- (uid (match-string 2))
- (gid (match-string 3))
- (size (string-to-number (match-string 4)))
- (date (match-string 5))
- (name (match-string 6))
- (symlink-target
- (and is-symlink
- (cadr (split-string name "\\( -> \\|\n\\)")))))
- (push (list
- (if is-symlink
- (car (split-string name "\\( -> \\|\n\\)"))
- name)
- (or is-dir symlink-target)
- 1 ;link-count
- ;; no way to handle numeric ids in Androids ash
- (if (eq id-format 'integer) 0 uid)
- (if (eq id-format 'integer) 0 gid)
- tramp-time-dont-know ; atime
- (date-to-time date) ; mtime
- tramp-time-dont-know ; ctime
- size
- mod-string
- ;; fake
- t 1
- (tramp-get-device vec))
- file-properties)))
- file-properties)))
-
-(defun tramp-adb-handle-directory-files-and-attributes
- (directory &optional full match nosort id-format)
- "Like `directory-files-and-attributes' for Tramp files."
- (when (file-directory-p directory)
- (with-parsed-tramp-file-name (expand-file-name directory) nil
- (copy-tree
- (with-tramp-file-property
- v localname (format "directory-files-and-attributes-%s-%s-%s-%s"
- full match id-format nosort)
- (with-current-buffer (tramp-get-buffer v)
- (when (tramp-adb-send-command-and-check
- v (format "%s -a -l %s"
- (tramp-adb-get-ls-command v)
- (tramp-shell-quote-argument localname)))
- ;; We insert also filename/. and filename/.., because "ls" doesn't.
- ;; Looks like it does include them in toybox, since Android 6.
- (unless (re-search-backward "\\.$" nil t)
- (narrow-to-region (point-max) (point-max))
- (tramp-adb-send-command
- v (format "%s -d -a -l %s %s"
- (tramp-adb-get-ls-command v)
- (tramp-shell-quote-argument
- (concat (file-name-as-directory localname) "."))
- (tramp-shell-quote-argument
- (concat (file-name-as-directory localname) ".."))))
- (widen)))
- (tramp-adb-sh-fix-ls-output)
- (let ((result (tramp-do-parse-file-attributes-with-ls
- v (or id-format 'integer))))
- (when full
- (setq result
- (mapcar
- (lambda (x)
- (cons (expand-file-name (car x) directory) (cdr x)))
- result)))
- (unless nosort
- (setq result
- (sort result (lambda (x y) (string< (car x) (car y))))))
- (delq nil
- (mapcar (lambda (x)
- (if (or (not match) (string-match-p match (car x)))
- x))
- result)))))))))
-
-(defun tramp-adb-get-ls-command (vec)
- "Determine `ls' command and its arguments."
- (with-tramp-connection-property vec "ls"
- (tramp-message vec 5 "Finding a suitable `ls' command")
- (cond
- ;; Support Android derived systems where "ls" command is provided
- ;; by GNU Coreutils. Force "ls" to print one column and set
- ;; time-style to imitate other "ls" flavors.
- ((tramp-adb-send-command-and-check
- vec "ls --time-style=long-iso /dev/null")
- "ls -1 --time-style=long-iso")
- ;; Can't disable coloring explicitly for toybox ls command. We
- ;; also must force "ls" to print just one column.
- ((tramp-adb-send-command-and-check vec "toybox") "ls -1")
- ;; On CyanogenMod based system BusyBox is used and "ls" output
- ;; coloring is enabled by default. So we try to disable it when
- ;; possible.
- ((tramp-adb-send-command-and-check vec "ls --color=never -al /dev/null")
- "ls --color=never")
- (t "ls"))))
-
-(defun tramp-adb--gnu-switches-to-ash (switches)
- "Almquist shell can't handle multiple arguments.
-Convert (\"-al\") to (\"-a\" \"-l\"). Remove arguments like \"--dired\"."
- (split-string
- (apply #'concat
- (mapcar (lambda (s)
- (replace-regexp-in-string
- "\\(.\\)" " -\\1" (replace-regexp-in-string "^-" "" s)))
- ;; FIXME: Warning about removed switches (long and non-dash).
- (delq nil
- (mapcar
- (lambda (s)
- (and (not (string-match-p "\\(^--\\|^[^-]\\)" s)) s))
- switches))))))
-
-(defun tramp-adb-sh-fix-ls-output (&optional sort-by-time)
- "Insert dummy 0 in empty size columns.
-Androids \"ls\" command doesn't insert size column for directories:
-Emacs dired can't find files."
- (save-excursion
- ;; Insert missing size.
- (goto-char (point-min))
- (while
- (search-forward-regexp
-
"[[:space:]]\\([[:space:]][0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9][[:space:]]\\)" nil
t)
- (replace-match "0\\1" "\\1" nil)
- ;; Insert missing "/".
- (when (looking-at-p "[0-9][0-9]:[0-9][0-9][[:space:]]+$")
- (end-of-line)
- (insert "/")))
- ;; Sort entries.
- (let* ((lines (split-string (buffer-string) "\n" t))
- (sorted-lines
- (sort
- lines
- (if sort-by-time
- #'tramp-adb-ls-output-time-less-p
- #'tramp-adb-ls-output-name-less-p))))
- (delete-region (point-min) (point-max))
- (insert " " (mapconcat #'identity sorted-lines "\n ")))
- ;; Add final newline.
- (goto-char (point-max))
- (unless (bolp) (insert "\n"))))
-
-(defun tramp-adb-ls-output-time-less-p (a b)
- "Sort \"ls\" output by time, descending."
- (let (time-a time-b)
- (string-match tramp-adb-ls-date-regexp a)
- (setq time-a (apply #'encode-time (parse-time-string (match-string 0 a))))
- (string-match tramp-adb-ls-date-regexp b)
- (setq time-b (apply #'encode-time (parse-time-string (match-string 0 b))))
- (time-less-p time-b time-a)))
-
-(defun tramp-adb-ls-output-name-less-p (a b)
- "Sort \"ls\" output by name, ascending."
- (if (string-match directory-listing-before-filename-regexp a)
- (let ((posa (match-end 0)))
- (if (string-match directory-listing-before-filename-regexp b)
- (let ((posb (match-end 0)))
- (string-lessp (substring a posa) (substring b posb)))))))
-
-(defun tramp-adb-handle-make-directory (dir &optional parents)
- "Like `make-directory' for Tramp files."
- (setq dir (expand-file-name dir))
- (with-parsed-tramp-file-name dir nil
- (when parents
- (let ((par (expand-file-name ".." dir)))
- (unless (file-directory-p par)
- (make-directory par parents))))
- (tramp-flush-file-properties v (file-name-directory localname))
- (tramp-flush-directory-properties v localname)
- (unless (or (tramp-adb-send-command-and-check
- v (format "mkdir %s" (tramp-shell-quote-argument localname)))
- (and parents (file-directory-p dir)))
- (tramp-error v 'file-error "Couldn't make directory %s" dir))))
-
-(defun tramp-adb-handle-delete-directory (directory &optional recursive _trash)
- "Like `delete-directory' for Tramp files."
- (setq directory (expand-file-name directory))
- (with-parsed-tramp-file-name (file-truename directory) nil
- (tramp-flush-file-properties v (file-name-directory localname))
- (tramp-flush-directory-properties v localname))
- (with-parsed-tramp-file-name directory nil
- (tramp-flush-file-properties v (file-name-directory localname))
- (tramp-flush-directory-properties v localname)
- (tramp-adb-barf-unless-okay
- v (format "%s %s"
- (if recursive "rm -r" "rmdir")
- (tramp-shell-quote-argument localname))
- "Couldn't delete %s" directory)))
-
-(defun tramp-adb-handle-delete-file (filename &optional _trash)
- "Like `delete-file' for Tramp files."
- (setq filename (expand-file-name filename))
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v (file-name-directory localname))
- (tramp-flush-file-properties v localname)
- (tramp-adb-barf-unless-okay
- v (format "rm %s" (tramp-shell-quote-argument localname))
- "Couldn't delete %s" filename)))
-
-(defun tramp-adb-handle-file-name-all-completions (filename directory)
- "Like `file-name-all-completions' for Tramp files."
- (all-completions
- filename
- (with-parsed-tramp-file-name (expand-file-name directory) nil
- (with-tramp-file-property v localname "file-name-all-completions"
- (tramp-adb-send-command
- v (format "%s -a %s"
- (tramp-adb-get-ls-command v)
- (tramp-shell-quote-argument localname)))
- (mapcar
- (lambda (f)
- (if (file-directory-p (expand-file-name f directory))
- (file-name-as-directory f)
- f))
- (with-current-buffer (tramp-get-buffer v)
- (delete-dups
- (append
- ;; In older Android versions, "." and ".." are not
- ;; included. In newer versions (toybox, since Android 6)
- ;; they are. We fix this by `delete-dups'.
- '("." "..")
- (delq
- nil
- (mapcar
- (lambda (l) (and (not (string-match-p "^[[:space:]]*$" l)) l))
- (split-string (buffer-string) "\n")))))))))))
-
-(defun tramp-adb-handle-file-local-copy (filename)
- "Like `file-local-copy' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (unless (file-exists-p (file-truename filename))
- (tramp-error
- v tramp-file-missing
- "Cannot make local copy of non-existing file `%s'" filename))
- (let ((tmpfile (tramp-compat-make-temp-file filename)))
- (with-tramp-progress-reporter
- v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
- ;; "adb pull ..." does not always return an error code.
- (when (or (tramp-adb-execute-adb-command
- v "pull" (tramp-compat-file-name-unquote localname) tmpfile)
- (not (file-exists-p tmpfile)))
- (ignore-errors (delete-file tmpfile))
- (tramp-error
- v 'file-error "Cannot make local copy of file `%s'" filename))
- (set-file-modes tmpfile (logior (or (file-modes filename) 0) #o0400)))
- tmpfile)))
-
-(defun tramp-adb-handle-file-writable-p (filename)
- "Like `file-writable-p' for Tramp files.
-But handle the case, if the \"test\" command is not available."
- (with-parsed-tramp-file-name filename nil
- (with-tramp-file-property v localname "file-writable-p"
- (if (tramp-adb-find-test-command v)
- (if (file-exists-p filename)
- (tramp-adb-send-command-and-check
- v (format "test -w %s" (tramp-shell-quote-argument localname)))
- (and
- (file-directory-p (file-name-directory filename))
- (file-writable-p (file-name-directory filename))))
-
- ;; Missing "test" command on Android < 4.
- (let ((rw-path "/data/data"))
- (tramp-message
- v 5
- "Not implemented yet (assuming \"/data/data\" is writable): %s"
- localname)
- (and (>= (length localname) (length rw-path))
- (string= (substring localname 0 (length rw-path))
- rw-path)))))))
-
-(defun tramp-adb-handle-write-region
- (start end filename &optional append visit lockname mustbenew)
- "Like `write-region' for Tramp files."
- (setq filename (expand-file-name filename))
- (with-parsed-tramp-file-name filename nil
- (when (and mustbenew (file-exists-p filename)
- (or (eq mustbenew 'excl)
- (not
- (y-or-n-p
- (format "File %s exists; overwrite anyway? " filename)))))
- (tramp-error v 'file-already-exists filename))
-
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-properties v (file-name-directory localname))
- (tramp-flush-file-properties v localname)
- (let* ((curbuf (current-buffer))
- (tmpfile (tramp-compat-make-temp-file filename)))
- (when (and append (file-exists-p filename))
- (copy-file filename tmpfile 'ok)
- (set-file-modes tmpfile (logior (or (file-modes tmpfile) 0) #o0600)))
- (tramp-run-real-handler
- #'write-region (list start end tmpfile append 'no-message lockname))
- (with-tramp-progress-reporter
- v 3 (format-message
- "Moving tmp file `%s' to `%s'" tmpfile filename)
- (unwind-protect
- (when (tramp-adb-execute-adb-command
- v "push" tmpfile (tramp-compat-file-name-unquote localname))
- (tramp-error v 'file-error "Cannot write: `%s'" filename))
- (delete-file tmpfile)))
-
- (unless (equal curbuf (current-buffer))
- (tramp-error
- v 'file-error
- "Buffer has changed from `%s' to `%s'" curbuf (current-buffer)))
-
- ;; Set file modification time.
- (when (or (eq visit t) (stringp visit))
- (set-visited-file-modtime
- (tramp-compat-file-attribute-modification-time
- (file-attributes filename))))
-
- ;; The end.
- (when (and (null noninteractive)
- (or (eq visit t) (null visit) (stringp visit)))
- (tramp-message v 0 "Wrote %s" filename))
- (run-hooks 'tramp-handle-write-region-hook))))
-
-(defun tramp-adb-handle-set-file-modes (filename mode)
- "Like `set-file-modes' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v (file-name-directory localname))
- (tramp-flush-file-properties v localname)
- (tramp-adb-send-command-and-check v (format "chmod %o %s" mode
localname))))
-
-(defun tramp-adb-handle-set-file-times (filename &optional time)
- "Like `set-file-times' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v (file-name-directory localname))
- (tramp-flush-file-properties v localname)
- (let ((time (if (or (null time)
- (tramp-compat-time-equal-p time tramp-time-doesnt-exist)
- (tramp-compat-time-equal-p time tramp-time-dont-know))
- (current-time)
- time))
- (quoted-name (tramp-shell-quote-argument localname)))
- ;; Older versions of toybox 'touch' mishandle nanoseconds and/or
- ;; trailing "Z", so fall back on plain seconds if nanoseconds+Z
- ;; fails. Also, fall back on old POSIX 'touch -t' if 'touch -d'
- ;; (introduced in POSIX.1-2008) fails.
- (tramp-adb-send-command-and-check
- v (format (concat "touch -d %s %s 2>/dev/null || "
- "touch -d %s %s 2>/dev/null || "
- "touch -t %s %s")
- (format-time-string "%Y-%m-%dT%H:%M:%S.%NZ" time t)
- quoted-name
- (format-time-string "%Y-%m-%dT%H:%M:%S" time t)
- quoted-name
- (format-time-string "%Y%m%d%H%M.%S" time t)
- quoted-name)))))
-
-(defun tramp-adb-handle-copy-file
- (filename newname &optional ok-if-already-exists keep-date
- _preserve-uid-gid _preserve-extended-attributes)
- "Like `copy-file' for Tramp files.
-PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
- (setq filename (expand-file-name filename)
- newname (expand-file-name newname))
-
- (if (file-directory-p filename)
- (copy-directory filename newname keep-date t)
-
- (let ((t1 (tramp-tramp-file-p filename))
- (t2 (tramp-tramp-file-p newname)))
- (with-parsed-tramp-file-name (if t1 filename newname) nil
- (with-tramp-progress-reporter
- v 0 (format "Copying %s to %s" filename newname)
-
- (if (and t1 t2 (tramp-equal-remote filename newname))
- (let ((l1 (tramp-compat-file-local-name filename))
- (l2 (tramp-compat-file-local-name newname)))
- (when (and (not ok-if-already-exists)
- (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
- ;; We must also flush the cache of the directory,
- ;; because `file-attributes' reads the values from
- ;; there.
- (tramp-flush-file-properties v (file-name-directory l2))
- (tramp-flush-file-properties v l2)
- ;; Short track.
- (tramp-adb-barf-unless-okay
- v (format
- "cp -f %s %s"
- (tramp-shell-quote-argument l1)
- (tramp-shell-quote-argument l2))
- "Error copying %s to %s" filename newname))
-
- (let ((tmpfile (file-local-copy filename)))
-
- (if tmpfile
- ;; Remote filename.
- (condition-case err
- (rename-file tmpfile newname ok-if-already-exists)
- ((error quit)
- (delete-file tmpfile)
- (signal (car err) (cdr err))))
-
- ;; Remote newname.
- (when (and (file-directory-p newname)
- (tramp-compat-directory-name-p newname))
- (setq newname
- (expand-file-name
- (file-name-nondirectory filename) newname)))
-
- (with-parsed-tramp-file-name newname nil
- (when (and (not ok-if-already-exists)
- (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
-
- ;; We must also flush the cache of the directory,
- ;; because `file-attributes' reads the values from
- ;; there.
- (tramp-flush-file-properties
- v (file-name-directory localname))
- (tramp-flush-file-properties v localname)
- (when (tramp-adb-execute-adb-command
- v "push"
- (tramp-compat-file-name-unquote filename)
- (tramp-compat-file-name-unquote localname))
- (tramp-error
- v 'file-error
- "Cannot copy `%s' `%s'" filename newname)))))))))
-
- ;; KEEP-DATE handling.
- (when keep-date
- (set-file-times
- newname
- (tramp-compat-file-attribute-modification-time
- (file-attributes filename))))))
-
-(defun tramp-adb-handle-rename-file
- (filename newname &optional ok-if-already-exists)
- "Like `rename-file' for Tramp files."
- (setq filename (expand-file-name filename)
- newname (expand-file-name newname))
-
- (if (file-directory-p filename)
- (progn
- (copy-directory filename newname t t)
- (delete-directory filename 'recursive))
-
- (let ((t1 (tramp-tramp-file-p filename))
- (t2 (tramp-tramp-file-p newname)))
- (with-parsed-tramp-file-name (if t1 filename newname) nil
- (with-tramp-progress-reporter
- v 0 (format "Renaming %s to %s" filename newname)
-
- (if (and t1 t2
- (tramp-equal-remote filename newname)
- (not (file-directory-p filename)))
- (let ((l1 (tramp-compat-file-local-name filename))
- (l2 (tramp-compat-file-local-name newname)))
- (when (and (not ok-if-already-exists)
- (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-properties v (file-name-directory l1))
- (tramp-flush-file-properties v l1)
- (tramp-flush-file-properties v (file-name-directory l2))
- (tramp-flush-file-properties v l2)
- ;; Short track.
- (tramp-adb-barf-unless-okay
- v (format
- "mv -f %s %s"
- (tramp-shell-quote-argument l1)
- (tramp-shell-quote-argument l2))
- "Error renaming %s to %s" filename newname))
-
- ;; Rename by copy.
- (copy-file
- filename newname ok-if-already-exists 'keep-time 'preserve-uid-gid)
- (delete-file filename)))))))
-
-(defun tramp-adb-handle-process-file
- (program &optional infile destination display &rest args)
- "Like `process-file' for Tramp files."
- ;; The implementation is not complete yet.
- (when (and (numberp destination) (zerop destination))
- (error "Implementation does not handle immediate return"))
-
- (with-parsed-tramp-file-name default-directory nil
- (let (command input tmpinput stderr tmpstderr outbuf ret)
- ;; Compute command.
- (setq command (mapconcat #'tramp-shell-quote-argument
- (cons program args) " "))
- ;; Determine input.
- (if (null infile)
- (setq input "/dev/null")
- (setq infile (expand-file-name infile))
- (if (tramp-equal-remote default-directory infile)
- ;; INFILE is on the same remote host.
- (setq input (with-parsed-tramp-file-name infile nil localname))
- ;; INFILE must be copied to remote host.
- (setq input (tramp-make-tramp-temp-file v)
- tmpinput (tramp-make-tramp-file-name v input))
- (copy-file infile tmpinput t)))
- (when input (setq command (format "%s <%s" command input)))
-
- ;; Determine output.
- (cond
- ;; Just a buffer.
- ((bufferp destination)
- (setq outbuf destination))
- ;; A buffer name.
- ((stringp destination)
- (setq outbuf (get-buffer-create destination)))
- ;; (REAL-DESTINATION ERROR-DESTINATION)
- ((consp destination)
- ;; output.
- (cond
- ((bufferp (car destination))
- (setq outbuf (car destination)))
- ((stringp (car destination))
- (setq outbuf (get-buffer-create (car destination))))
- ((car destination)
- (setq outbuf (current-buffer))))
- ;; stderr.
- (cond
- ((stringp (cadr destination))
- (setcar (cdr destination) (expand-file-name (cadr destination)))
- (if (tramp-equal-remote default-directory (cadr destination))
- ;; stderr is on the same remote host.
- (setq stderr (with-parsed-tramp-file-name
- (cadr destination) nil localname))
- ;; stderr must be copied to remote host. The temporary
- ;; file must be deleted after execution.
- (setq stderr (tramp-make-tramp-temp-file v)
- tmpstderr (tramp-make-tramp-file-name v stderr))))
- ;; stderr to be discarded.
- ((null (cadr destination))
- (setq stderr "/dev/null"))))
- ;; 't
- (destination
- (setq outbuf (current-buffer))))
- (when stderr (setq command (format "%s 2>%s" command stderr)))
-
- ;; Send the command. It might not return in time, so we protect
- ;; it. Call it in a subshell, in order to preserve working
- ;; directory.
- (condition-case nil
- (progn
- (setq ret
- (if (tramp-adb-send-command-and-check
- v
- (format "(cd %s; %s)"
- (tramp-shell-quote-argument localname) command))
- ;; Set return status accordingly.
- 0 1))
- ;; We should add the output anyway.
- (when outbuf
- (with-current-buffer outbuf
- (insert-buffer-substring (tramp-get-connection-buffer v)))
- (when (and display (get-buffer-window outbuf t)) (redisplay))))
- ;; When the user did interrupt, we should do it also. We use
- ;; return code -1 as marker.
- (quit
- (kill-buffer (tramp-get-connection-buffer v))
- (setq ret -1))
- ;; Handle errors.
- (error
- (kill-buffer (tramp-get-connection-buffer v))
- (setq ret 1)))
-
- ;; Provide error file.
- (when tmpstderr (rename-file tmpstderr (cadr destination) t))
-
- ;; Cleanup. We remove all file cache values for the connection,
- ;; because the remote process could have changed them.
- (when tmpinput (delete-file tmpinput))
-
- (unless process-file-side-effects
- (tramp-flush-directory-properties v ""))
-
- ;; Return exit status.
- (if (equal ret -1)
- (keyboard-quit)
- ret))))
-
-;; We use BUFFER also as connection buffer during setup. Because of
-;; this, its original contents must be saved, and restored once
-;; connection has been setup.
-(defun tramp-adb-handle-make-process (&rest args)
- "Like `make-process' for Tramp files."
- (when args
- (with-parsed-tramp-file-name (expand-file-name default-directory) nil
- (let ((name (plist-get args :name))
- (buffer (plist-get args :buffer))
- (command (plist-get args :command))
- (coding (plist-get args :coding))
- (noquery (plist-get args :noquery))
- (connection-type (plist-get args :connection-type))
- (filter (plist-get args :filter))
- (sentinel (plist-get args :sentinel))
- (stderr (plist-get args :stderr)))
- (unless (stringp name)
- (signal 'wrong-type-argument (list #'stringp name)))
- (unless (or (null buffer) (bufferp buffer) (stringp buffer))
- (signal 'wrong-type-argument (list #'stringp buffer)))
- (unless (consp command)
- (signal 'wrong-type-argument (list #'consp command)))
- (unless (or (null coding)
- (and (symbolp coding) (memq coding coding-system-list))
- (and (consp coding)
- (memq (car coding) coding-system-list)
- (memq (cdr coding) coding-system-list)))
- (signal 'wrong-type-argument (list #'symbolp coding)))
- (unless (or (null connection-type) (memq connection-type '(pipe pty)))
- (signal 'wrong-type-argument (list #'symbolp connection-type)))
- (unless (or (null filter) (functionp filter))
- (signal 'wrong-type-argument (list #'functionp filter)))
- (unless (or (null sentinel) (functionp sentinel))
- (signal 'wrong-type-argument (list #'functionp sentinel)))
- (unless (or (null stderr) (bufferp stderr) (stringp stderr))
- (signal 'wrong-type-argument (list #'stringp stderr)))
-
- (let* ((buffer
- (if buffer
- (get-buffer-create buffer)
- ;; BUFFER can be nil. We use a temporary buffer.
- (generate-new-buffer tramp-temp-buffer-name)))
- (program (car command))
- (args (cdr command))
- (command
- (format "cd %s && exec %s"
- (tramp-shell-quote-argument localname)
- (mapconcat #'tramp-shell-quote-argument
- (cons program args) " ")))
- (tramp-process-connection-type
- (or (null program) tramp-process-connection-type))
- (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
- (name1 name)
- (i 0))
-
- (while (get-process name1)
- ;; NAME must be unique as process name.
- (setq i (1+ i)
- name1 (format "%s<%d>" name i)))
- (setq name name1)
- ;; Set the new process properties.
- (tramp-set-connection-property v "process-name" name)
- (tramp-set-connection-property v "process-buffer" buffer)
-
- (with-current-buffer (tramp-get-connection-buffer v)
- (unwind-protect
- ;; We catch this event. Otherwise, `make-process'
- ;; could be called on the local host.
- (save-excursion
- (save-restriction
- ;; Activate narrowing in order to save BUFFER
- ;; contents. Clear also the modification time;
- ;; otherwise we might be interrupted by
- ;; `verify-visited-file-modtime'.
- (let ((buffer-undo-list t)
- (inhibit-read-only t))
- (clear-visited-file-modtime)
- (narrow-to-region (point-max) (point-max))
- ;; We call `tramp-adb-maybe-open-connection', in
- ;; order to cleanup the prompt afterwards.
- (tramp-adb-maybe-open-connection v)
- (delete-region (point-min) (point-max))
- ;; Send the command.
- (let* ((p (tramp-get-connection-process v)))
- (tramp-adb-send-command v command nil t) ; nooutput
- ;; Set sentinel and filter.
- (when sentinel
- (set-process-sentinel p sentinel))
- (when filter
- (set-process-filter p filter))
- ;; Set query flag and process marker for this
- ;; process. We ignore errors, because the
- ;; process could have finished already.
- (ignore-errors
- (set-process-query-on-exit-flag p (null noquery))
- (set-marker (process-mark p) (point)))
- ;; Read initial output. Remove the first line,
- ;; which is the command echo.
- (while
- (progn
- (goto-char (point-min))
- (not (re-search-forward "[\n]" nil t)))
- (tramp-accept-process-output p 0))
- (delete-region (point-min) (point))
- ;; Return process.
- p))))
-
- ;; Save exit.
- (if (string-match-p tramp-temp-buffer-name (buffer-name))
- (ignore-errors
- (set-process-buffer (tramp-get-connection-process v) nil)
- (kill-buffer (current-buffer)))
- (set-buffer-modified-p bmp))
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer"))))))))
-
-(defun tramp-adb-handle-exec-path ()
- "Like `exec-path' for Tramp files."
- (append
- (with-parsed-tramp-file-name default-directory nil
- (with-tramp-connection-property v "remote-path"
- (tramp-adb-send-command v "echo \\\"$PATH\\\"")
- (split-string
- (with-current-buffer (tramp-get-connection-buffer v)
- ;; Read the expression.
- (goto-char (point-min))
- (read (current-buffer)))
- ":" 'omit)))
- ;; The equivalent to `exec-directory'.
- `(,(tramp-compat-file-local-name default-directory))))
-
-(defun tramp-adb-get-device (vec)
- "Return full host name from VEC to be used in shell execution.
-E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\"
- a host name \"R38273882DE\" returns \"R38273882DE\"."
- ;; Sometimes this is called before there is a connection process
- ;; yet. In order to work with the connection cache, we flush all
- ;; unwanted entries first.
- (tramp-flush-connection-properties nil)
- (with-tramp-connection-property (tramp-get-connection-process vec) "device"
- (let* ((host (tramp-file-name-host vec))
- (port (tramp-file-name-port-or-default vec))
- (devices (mapcar #'cadr (tramp-adb-parse-device-names nil))))
- (replace-regexp-in-string
- tramp-prefix-port-format ":"
- (cond ((member host devices) host)
- ;; This is the case when the host is connected to the default port.
- ((member (format "%s%s%d" host tramp-prefix-port-format port)
- devices)
- (format "%s:%d" host port))
- ;; An empty host name shall be mapped as well, when there
- ;; is exactly one entry in `devices'.
- ((and (zerop (length host)) (= (length devices) 1))
- (car devices))
- ;; Try to connect device.
- ((and tramp-adb-connect-if-not-connected
- (not (zerop (length host)))
- (not (tramp-adb-execute-adb-command
- vec "connect"
- (replace-regexp-in-string
- tramp-prefix-port-format ":" host))))
- ;; When new device connected, running other adb command (e.g.
- ;; adb shell) immediately will fail. To get around this
- ;; problem, add sleep 0.1 second here.
- (sleep-for 0.1)
- host)
- (t (tramp-error
- vec 'file-error "Could not find device %s" host)))))))
-
-(defun tramp-adb-execute-adb-command (vec &rest args)
- "Returns nil on success error-output on failure."
- (when (and (> (length (tramp-file-name-host vec)) 0)
- ;; The -s switch is only available for ADB device commands.
- (not (member (car args) '("connect" "disconnect"))))
- (setq args (append (list "-s" (tramp-adb-get-device vec)) args)))
- (with-temp-buffer
- (prog1
- (unless
- (zerop
- (apply #'tramp-call-process vec tramp-adb-program nil t nil args))
- (buffer-string))
- (tramp-message vec 6 "%s" (buffer-string)))))
-
-(defun tramp-adb-find-test-command (vec)
- "Checks, whether the ash has a builtin \"test\" command.
-This happens for Android >= 4.0."
- (with-tramp-connection-property vec "test"
- (tramp-adb-send-command-and-check vec "type test")))
-
-;; Connection functions
-
-(defun tramp-adb-send-command (vec command &optional neveropen nooutput)
- "Send the COMMAND to connection VEC."
- (unless neveropen (tramp-adb-maybe-open-connection vec))
- (tramp-message vec 6 "%s" command)
- (tramp-send-string vec command)
- (unless nooutput
- ;; FIXME: Race condition.
- (tramp-adb-wait-for-output (tramp-get-connection-process vec))
- (with-current-buffer (tramp-get-connection-buffer vec)
- (save-excursion
- (goto-char (point-min))
- ;; We can't use stty to disable echo of command. stty is said
- ;; to be added to toybox 0.7.6. busybox shall have it, but this
- ;; isn't used any longer for Android.
- (delete-matching-lines (regexp-quote command))
- ;; When the local machine is W32, there are still trailing ^M.
- ;; There must be a better solution by setting the correct coding
- ;; system, but this requires changes in core Tramp.
- (goto-char (point-min))
- (while (re-search-forward "\r+$" nil t)
- (replace-match "" nil nil))))))
-
-(defun tramp-adb-send-command-and-check (vec command)
- "Run COMMAND and check its exit status.
-Sends `echo $?' along with the COMMAND for checking the exit
-status. If COMMAND is nil, just sends `echo $?'. Returns nil if
-the exit status is not equal 0, and t otherwise."
- (tramp-adb-send-command
- vec (if command
- (format "%s; echo tramp_exit_status $?" command)
- "echo tramp_exit_status $?"))
- (with-current-buffer (tramp-get-connection-buffer vec)
- (goto-char (point-max))
- (unless (re-search-backward "tramp_exit_status [0-9]+" nil t)
- (tramp-error
- vec 'file-error "Couldn't find exit status of `%s'" command))
- (skip-chars-forward "^ ")
- (prog1
- (zerop (read (current-buffer)))
- (let ((inhibit-read-only t))
- (delete-region (match-beginning 0) (point-max))))))
-
-(defun tramp-adb-barf-unless-okay (vec command fmt &rest args)
- "Run COMMAND, check exit status, throw error if exit status not okay.
-FMT and ARGS are passed to `error'."
- (unless (tramp-adb-send-command-and-check vec command)
- (apply #'tramp-error vec 'file-error fmt args)))
-
-(defun tramp-adb-wait-for-output (proc &optional timeout)
- "Wait for output from remote command."
- (unless (buffer-live-p (process-buffer proc))
- (delete-process proc)
- (tramp-error proc 'file-error "Process `%s' not available, try again"
proc))
- (let ((prompt (tramp-get-connection-property proc "prompt"
tramp-adb-prompt)))
- (with-current-buffer (process-buffer proc)
- (if (tramp-wait-for-regexp proc timeout prompt)
- (let ((inhibit-read-only t))
- (goto-char (point-min))
- ;; ADB terminal sends "^H" sequences.
- (when (re-search-forward "<\b+" (point-at-eol) t)
- (forward-line 1)
- (delete-region (point-min) (point)))
- ;; Delete the prompt.
- (goto-char (point-min))
- (when (re-search-forward prompt (point-at-eol) t)
- (forward-line 1)
- (delete-region (point-min) (point)))
- (goto-char (point-max))
- (re-search-backward prompt nil t)
- (delete-region (point) (point-max)))
- (if timeout
- (tramp-error
- proc 'file-error
- "[[Remote prompt `%s' not found in %d secs]]" prompt timeout)
- (tramp-error
- proc 'file-error "[[Remote prompt `%s' not found]]" prompt))))))
-
-(defun tramp-adb-maybe-open-connection (vec)
- "Maybe open a connection VEC.
-Does not do anything if a connection is already open, but re-opens the
-connection if a previous connection has died for some reason."
- (let* ((buf (tramp-get-connection-buffer vec))
- (p (get-buffer-process buf))
- (host (tramp-file-name-host vec))
- (user (tramp-file-name-user vec))
- (device (tramp-adb-get-device vec)))
-
- ;; Maybe we know already that "su" is not supported. We cannot
- ;; use a connection property, because we have not checked yet
- ;; whether it is still the same device.
- (when (and user (not (tramp-get-file-property vec "" "su-command-p" t)))
- (tramp-error vec 'file-error "Cannot switch to user `%s'" user))
-
- (unless (process-live-p p)
- ;; During completion, don't reopen a new connection. We check
- ;; this for the process related to `tramp-buffer-name';
- ;; otherwise `start-file-process' wouldn't run ever when
- ;; `non-essential' is non-nil.
- (when (and (tramp-completion-mode-p)
- (null (get-process (tramp-buffer-name vec))))
- (throw 'non-essential 'non-essential))
-
- (save-match-data
- (when (and p (processp p)) (delete-process p))
- (if (zerop (length device))
- (tramp-error vec 'file-error "Device %s not connected" host))
- (with-tramp-progress-reporter vec 3 "Opening adb shell connection"
- (let* ((coding-system-for-read 'utf-8-dos) ;is this correct?
- (process-connection-type tramp-process-connection-type)
- (args (if (> (length host) 0)
- (list "-s" device "shell")
- (list "shell")))
- (p (let ((default-directory
- (tramp-compat-temporary-file-directory)))
- (apply #'start-process (tramp-get-connection-name vec) buf
- tramp-adb-program args)))
- (prompt (md5 (concat (prin1-to-string process-environment)
- (current-time-string)))))
- (tramp-message
- vec 6 "%s" (mapconcat #'identity (process-command p) " "))
- ;; Wait for initial prompt. On some devices, it needs an
- ;; initial RET, in order to get it.
- (sleep-for 0.1)
- (tramp-send-string vec tramp-rsh-end-of-line)
- (tramp-adb-wait-for-output p 30)
- (unless (process-live-p p)
- (tramp-error vec 'file-error "Terminated!"))
-
- ;; Set sentinel and query flag. Initialize variables.
- (set-process-sentinel p #'tramp-process-sentinel)
- (process-put p 'vector vec)
- (process-put p 'adjust-window-size-function #'ignore)
- (set-process-query-on-exit-flag p nil)
-
- ;; Change prompt.
- (tramp-set-connection-property
- p "prompt" (regexp-quote (format "///%s#$" prompt)))
- (tramp-adb-send-command
- vec (format "PS1=\"///\"\"%s\"\"#$\"" prompt))
-
- ;; Check whether the properties have been changed. If
- ;; yes, this is a strong indication that we must expire all
- ;; connection properties. We start again.
- (tramp-message vec 5 "Checking system information")
- (tramp-adb-send-command
- vec "echo \\\"`getprop ro.product.model` `getprop
ro.product.version` `getprop ro.build.version.release`\\\"")
- (let ((old-getprop
- (tramp-get-connection-property vec "getprop" nil))
- (new-getprop
- (tramp-set-connection-property
- vec "getprop"
- (with-current-buffer (tramp-get-connection-buffer vec)
- ;; Read the expression.
- (goto-char (point-min))
- (read (current-buffer))))))
- (when (and (stringp old-getprop)
- (not (string-equal old-getprop new-getprop)))
- (tramp-message
- vec 3
- "Connection reset, because remote host changed from `%s' to
`%s'"
- old-getprop new-getprop)
- (tramp-cleanup-connection vec t)
- (tramp-adb-maybe-open-connection vec)))
-
- ;; Change user if indicated.
- (when user
- (tramp-adb-send-command vec (format "su %s" user))
- (unless (tramp-adb-send-command-and-check vec nil)
- (delete-process p)
- (tramp-flush-file-property vec "" "su-command-p")
- (tramp-error
- vec 'file-error "Cannot switch to user `%s'" user)))
-
- ;; Set connection-local variables.
- (tramp-set-connection-local-variables vec)
-
- ;; Mark it as connected.
- (tramp-set-connection-property p "connected" t)))))))
-
-;; Default settings for connection-local variables.
-(defconst tramp-adb-connection-local-default-profile
- '((shell-file-name . "/system/bin/sh")
- (shell-command-switch . "-c"))
- "Default connection-local variables for remote adb connections.")
-
-;; `connection-local-set-profile-variables' and
-;; `connection-local-set-profiles' exists since Emacs 26.1.
-(eval-after-load "shell"
- '(progn
- (tramp-compat-funcall
- 'connection-local-set-profile-variables
- 'tramp-adb-connection-local-default-profile
- tramp-adb-connection-local-default-profile)
- (tramp-compat-funcall
- 'connection-local-set-profiles
- `(:application tramp :protocol ,tramp-adb-method)
- 'tramp-adb-connection-local-default-profile)))
-
-(add-hook 'tramp-unload-hook
- (lambda ()
- (unload-feature 'tramp-adb 'force)))
-
-(provide 'tramp-adb)
-
-;;; tramp-adb.el ends here
diff --git a/lisp/tramp-archive.el b/lisp/tramp-archive.el
deleted file mode 100644
index e6ae73a..0000000
--- a/lisp/tramp-archive.el
+++ /dev/null
@@ -1,666 +0,0 @@
-;;; tramp-archive.el --- Tramp archive manager -*- lexical-binding:t -*-
-
-;; Copyright (C) 2017-2019 Free Software Foundation, Inc.
-
-;; Author: Michael Albinus <address@hidden>
-;; 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
-;; * ".msu", ".MSU" - Microsoft Windows Update packages
-;; * ".mtree" - BSD mtree format
-;; * ".odb" ".odf" ".odg" ".odp" ".ods" ".odt" - OpenDocument formats
-;; * ".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
-;; * ".xpi" - XPInstall Mozilla addons
-;; * ".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:address@hidden:/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:address@hidden:..." performs better than the similar
-;; "/scp:address@hidden:...". 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:
-
-(eval-when-compile (require 'cl-lib))
-;; Sometimes, compilation fails with "Variable binding depth exceeds
-;; max-specpdl-size".
-(eval-and-compile
- (let ((max-specpdl-size (* 2 max-specpdl-size))) (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)
-
-;; We cannot check `tramp-gvfs-enabled' in loaddefs.el, because this
-;; would load Tramp. So we make a cheaper check.
-;;;###autoload
-(defvar tramp-archive-enabled (featurep 'dbusbind)
- "Non-nil when file archive support is available.")
-
-;; After loading tramp-gvfs.el, we know it better.
-(setq tramp-archive-enabled tramp-gvfs-enabled)
-
-;; <https://github.com/libarchive/libarchive/wiki/LibarchiveFormats>
-;; Note: "arc" and "zoo" are supported by `archive-mode', but they
-;; don't work here.
-;;;###autoload
-(defconst tramp-archive-suffixes
- ;; "cab", "lzh", "msu" 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.
- "msu" "MSU" ;; Microsoft Windows Update packages. Not in testsuite.
- "mtree" ;; BSD mtree format.
- "odb" "odf" "odg" "odp" "ods" "odt" ;; OpenDocument formats. Not in
testsuite.
- "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.
- "xpi" ;; XPInstall Mozilla addons. 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.
-
-;;;###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).")
-
-;; The definition of `tramp-archive-file-name-regexp' contains calls
-;; to `regexp-opt', which cannot be autoloaded while loading
-;; loaddefs.el. So we use a macro, which is evaluated only when needed.
-;;;###autoload
-(progn (defmacro tramp-archive-autoload-file-name-regexp ()
- "Regular expression matching archive file names."
- '(concat
- "\\`" "\\(" ".+" "\\."
- ;; Default suffixes ...
- (regexp-opt tramp-archive-suffixes)
- ;; ... with compression.
- "\\(?:" "\\." (regexp-opt tramp-archive-compression-suffixes) "\\)*"
- "\\)" ;; \1
- "\\(" "/" ".*" "\\)" "\\'"))) ;; \2
-
-;; In older Emacsen (prior 27.1), `tramp-archive-autoload-file-name-regexp'
-;; is not autoloaded. So we cannot expect it to be known in
-;; tramp-loaddefs.el. But it exists, when tramp-archive.el is loaded.
-;;;###tramp-autoload
-(defconst tramp-archive-file-name-regexp
- (ignore-errors (tramp-archive-autoload-file-name-regexp))
- "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 . tramp-archive-handle-access-file)
- (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-directory . 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)
- (exec-path . ignore)
- ;; `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)
- ;; `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-process . ignore)
- (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 . tramp-archive-handle-temporary-file-directory)
- ;; `tramp-set-file-uid-gid' 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 file archive method.
-Operations not mentioned here will be handled by the default Emacs
primitives.")
-
-(defsubst tramp-archive-file-name-for-operation (operation &rest args)
- "Like `tramp-file-name-for-operation', but for archive file name syntax."
- (cl-letf (((symbol-function #'tramp-tramp-file-p)
- #'tramp-archive-file-name-p))
- (apply #'tramp-file-name-for-operation operation args)))
-
-(defun tramp-archive-run-real-handler (operation args)
- "Invoke normal file name handler for OPERATION.
-First arg specifies the OPERATION, second arg is a list of arguments to
-pass to the OPERATION."
- (let* ((inhibit-file-name-handlers
- `(tramp-archive-file-name-handler
- .
- ,(and (eq inhibit-file-name-operation operation)
- inhibit-file-name-handlers)))
- (inhibit-file-name-operation operation))
- (apply operation args)))
-
-;;;###tramp-autoload
-(defun tramp-archive-file-name-handler (operation &rest args)
- "Invoke the file archive related OPERATION.
-First arg specifies the OPERATION, second arg is a list of arguments to
-pass to the OPERATION."
- (if (not tramp-archive-enabled)
- ;; Unregister `tramp-archive-file-name-handler'.
- (progn
- (tramp-register-file-name-handlers)
- (tramp-archive-run-real-handler operation args))
-
- (let* ((filename (apply #'tramp-archive-file-name-for-operation
- operation args))
- (archive (tramp-archive-file-name-archive filename)))
-
- ;; `filename' could be a quoted file name. Or the file
- ;; archive could be a directory, see Bug#30293.
- (if (or (null archive)
- (tramp-archive-run-real-handler
- #'file-directory-p (list archive)))
- (tramp-archive-run-real-handler operation args)
- ;; Now run the handler.
- (let ((tramp-methods (cons `(,tramp-archive-method) tramp-methods))
- (tramp-gvfs-methods tramp-archive-all-gvfs-methods)
- ;; Set uid and gid. gvfsd-archive could do it, but it doesn't.
- (tramp-unknown-id-integer (user-uid))
- (tramp-unknown-id-string (user-login-name))
- (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-archive-run-real-handler operation args)))))))
-
-;;;###autoload
-(defalias
- 'tramp-archive-autoload-file-name-handler #'tramp-autoload-file-name-handler)
-
-;;;###autoload
-(progn (defun tramp-register-archive-file-name-handler ()
- "Add archive file name handler to `file-name-handler-alist'."
- (when tramp-archive-enabled
- (add-to-list 'file-name-handler-alist
- (cons (tramp-archive-autoload-file-name-regexp)
- #'tramp-archive-autoload-file-name-handler))
- (put 'tramp-archive-autoload-file-name-handler 'safe-magic t))))
-
-;;;###autoload
-(progn
- (add-hook 'after-init-hook #'tramp-register-archive-file-name-handler)
- (add-hook
- 'tramp-archive-unload-hook
- (lambda ()
- (remove-hook
- 'after-init-hook #'tramp-register-archive-file-name-handler))))
-
-;; In older Emacsen (prior 27.1), the autoload above does not exist.
-;; So we call it again; it doesn't hurt.
-(tramp-register-archive-file-name-handler)
-
-;; 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)))))
-
-
-;; 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)
- ;; `tramp-archive-file-name-regexp' does not suppress quoted file names.
- (not (tramp-compat-file-name-quoted-p name t))
- ;; We cannot use `string-match-p', the matches are used.
- (string-match tramp-archive-file-name-regexp name)
- t))
-
-(defun tramp-archive-file-name-archive (name)
- "Return archive part of NAME."
- (and (tramp-archive-file-name-p name)
- (match-string 1 name)))
-
-(defun tramp-archive-file-name-localname (name)
- "Return localname part of NAME."
- (and (tramp-archive-file-name-p name)
- (match-string 2 name)))
-
-(defvar tramp-archive-hash (make-hash-table :test 'equal)
- "Hash table for archive local copies.
-The hash key is the archive name. The value is a cons of the
-used `tramp-file-name' structure for tramp-gvfs, and the file
-name of a local copy, if any.")
-
-(defsubst tramp-archive-gvfs-host (archive)
- "Return host name of ARCHIVE as used in GVFS for mounting"
- (url-hexify-string (tramp-gvfs-url-file-name archive)))
-
-(defun tramp-archive-dissect-file-name (name)
- "Return a `tramp-file-name' structure.
-The structure consists of the `tramp-archive-method' method, the
-hexified 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-user-error nil "Not an archive file name: \"%s\"" name))
- (let* ((localname (tramp-archive-file-name-localname name))
- (archive (file-truename (tramp-archive-file-name-archive name)))
- (vec (make-tramp-file-name
- :method tramp-archive-method :hop archive)))
-
- (cond
- ;; The value is already in the hash table.
- ((gethash archive tramp-archive-hash)
- (setq vec (car (gethash archive tramp-archive-hash))))
-
- ;; 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)))
- (setf (tramp-file-name-host vec) (tramp-archive-gvfs-host archive)))
- (puthash archive (list vec) tramp-archive-hash))
-
- ;; http://...
- ((and url-handler-mode
- tramp-compat-use-url-tramp-p
- (string-match-p url-handler-regexp archive)
- (string-match-p
- "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)))
- (setf (tramp-file-name-host vec) (tramp-archive-gvfs-host archive)))
- (puthash archive (list vec) tramp-archive-hash))
-
- ;; GVFS supported schemes.
- ((or (tramp-gvfs-file-name-p archive)
- (not (file-remote-p archive)))
- (setf (tramp-file-name-host vec) (tramp-archive-gvfs-host archive))
- (puthash archive (list vec) tramp-archive-hash))
-
- ;; 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))
- (copy (file-local-copy archive)))
- (setf (tramp-file-name-host vec) (tramp-archive-gvfs-host copy))
- (puthash archive (cons vec copy) tramp-archive-hash))))
-
- ;; So far, `vec' handles just the mount point. Add `localname',
- ;; which shouldn't be pushed to the hash.
- (setf (tramp-file-name-localname vec) localname)
- vec)))
-
-(defun tramp-archive-cleanup-hash ()
- "Remove local copies of archives, used by GVFS."
- (maphash
- (lambda (key value)
- ;; Unmount local copy.
- (ignore-errors
- (tramp-message (car value) 3 "Unmounting %s" (or (cdr value) key))
- (tramp-gvfs-unmount (car value)))
- ;; Delete local copy.
- (ignore-errors (delete-file (cdr value)))
- (remhash key tramp-archive-hash))
- tramp-archive-hash)
- (clrhash tramp-archive-hash))
-
-(add-hook 'tramp-cleanup-all-connections-hook #'tramp-archive-cleanup-hash)
-(add-hook 'kill-emacs-hook #'tramp-archive-cleanup-hash)
-(add-hook 'tramp-archive-unload-hook
- (lambda ()
- (remove-hook 'tramp-cleanup-all-connections-hook
- #'tramp-archive-cleanup-hash)
- (remove-hook 'kill-emacs-hook
- #'tramp-archive-cleanup-hash)))
-
-(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-access-file (filename string)
- "Like `access-file' for Tramp files."
- (access-file (tramp-archive-gvfs-file-name filename) string))
-
-(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."
- (file-readable-p (tramp-archive-gvfs-file-name filename)))
-
-(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-temporary-file-directory ()
- "Like `temporary-file-directory' for file archives."
- ;; If the default directory, the file archive, is located on a
- ;; mounted directory, it is returned as it. Not what we want.
- (with-parsed-tramp-archive-file-name default-directory nil
- (let ((default-directory (file-name-directory archive)))
- (tramp-compat-temporary-file-directory))))
-
-(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-archive-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:
-
-;; * Check, whether we could retrieve better file attributes like uid,
-;; gid, permissions. See gvfsbackendarchive.c
-;; (archive_file_set_info_from_entry), where it is commented out.
-;;
-;; * Implement write access, when possible.
-;; https://bugzilla.gnome.org/show_bug.cgi?id=589617
-
-;;; tramp-archive.el ends here
diff --git a/lisp/tramp-cache.el b/lisp/tramp-cache.el
deleted file mode 100644
index a9ff3a7..0000000
--- a/lisp/tramp-cache.el
+++ /dev/null
@@ -1,526 +0,0 @@
-;;; tramp-cache.el --- file information caching for Tramp -*-
lexical-binding:t -*-
-
-;; Copyright (C) 2000, 2005-2019 Free Software Foundation, Inc.
-
-;; Author: Daniel Pittman <address@hidden>
-;; Michael Albinus <address@hidden>
-;; Maintainer: Michael Albinus <address@hidden>
-;; 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:
-
-;; An implementation of information caching for remote files.
-
-;; Each connection, identified by a `tramp-file-name' structure or by
-;; a process, has a unique cache. We distinguish 4 kind of caches,
-;; depending on the key:
-;;
-;; - localname is NIL. This are reusable properties. Examples:
-;; "remote-shell" identifies the POSIX shell to be called on the
-;; remote host, or "perl" is the command to be called on the remote
-;; host when starting a Perl script. These properties are saved in
-;; the file `tramp-persistency-file-name'.
-;;
-;; - localname is a string. This are temporary properties, which are
-;; related to the file localname is referring to. Examples:
-;; "file-exists-p" is t or nil, depending on the file existence, or
-;; "file-attributes" caches the result of the function
-;; `file-attributes'. These entries have a timestamp, and they
-;; expire after `remote-file-name-inhibit-cache' seconds if this
-;; variable is set.
-;;
-;; - The key is a process. This are temporary properties related to
-;; an open connection. Examples: "scripts" keeps shell script
-;; definitions already sent to the remote shell, "last-cmd-time" is
-;; the time stamp a command has been sent to the remote process.
-;;
-;; - The key is nil. This are temporary properties related to the
-;; local machine. Examples: "parse-passwd" and "parse-group" keep
-;; the results of parsing "/etc/passwd" and "/etc/group",
-;; "{uid,gid}-{integer,string}" are the local uid and gid, and
-;; "locale" is the used shell locale.
-
-;; Some properties are handled special:
-;;
-;; - "process-name", "process-buffer" and "first-password-request" are
-;; not saved in the file `tramp-persistency-file-name'.
-
-;;; Code:
-
-(require 'tramp)
-(autoload 'time-stamp-string "time-stamp")
-
-;;; -- Cache --
-
-;;;###tramp-autoload
-(defvar tramp-cache-data (make-hash-table :test #'equal)
- "Hash table for remote files properties.")
-
-;;;###tramp-autoload
-(defcustom tramp-connection-properties nil
- "List of static connection properties.
-Every entry has the form (REGEXP PROPERTY VALUE). The regexp
-matches remote file names. It can be nil. PROPERTY is a string,
-and VALUE the corresponding value. They are used, if there is no
-matching entry for PROPERTY in `tramp-cache-data'. For more
-details see the info pages."
- :group 'tramp
- :version "24.4"
- :type '(repeat (list (choice :tag "File Name regexp" regexp (const nil))
- (choice :tag " Property" string)
- (choice :tag " Value" sexp))))
-
-(defcustom tramp-persistency-file-name
- (expand-file-name (locate-user-emacs-file "tramp"))
- "File which keeps connection history for Tramp connections."
- :group 'tramp
- :type 'file)
-
-(defvar tramp-cache-data-changed nil
- "Whether persistent cache data have been changed.")
-
-(defun tramp-get-hash-table (key)
- "Returns the hash table for KEY.
-If it doesn't exist yet, it is created and initialized with
-matching entries of `tramp-connection-properties'."
- (or (gethash key tramp-cache-data)
- (let ((hash
- (puthash key (make-hash-table :test #'equal) tramp-cache-data)))
- (when (tramp-file-name-p key)
- (dolist (elt tramp-connection-properties)
- (when (string-match-p
- (or (nth 0 elt) "")
- (tramp-make-tramp-file-name key 'noloc 'nohop))
- (tramp-set-connection-property key (nth 1 elt) (nth 2 elt)))))
- hash)))
-
-;;;###tramp-autoload
-(defun tramp-get-file-property (key file property default)
- "Get the PROPERTY of FILE from the cache context of KEY.
-Returns DEFAULT if not set."
- ;; Unify localname. Remove hop from `tramp-file-name' structure.
- (setq file (tramp-compat-file-name-unquote file)
- key (copy-tramp-file-name key))
- (setf (tramp-file-name-localname key)
- (tramp-run-real-handler #'directory-file-name (list file))
- (tramp-file-name-hop key) nil)
- (let* ((hash (tramp-get-hash-table key))
- (value (when (hash-table-p hash) (gethash property hash))))
- (if ;; We take the value only if there is any, and
- ;; `remote-file-name-inhibit-cache' indicates that it is still
- ;; valid. Otherwise, DEFAULT is set.
- (and (consp value)
- (or (null remote-file-name-inhibit-cache)
- (and (integerp remote-file-name-inhibit-cache)
- (time-less-p
- ;; `current-time' can be nil once we get rid of Emacs 24.
- (current-time)
- (time-add
- (car value)
- ;; `seconds-to-time' can be removed once we get
- ;; rid of Emacs 24.
- (seconds-to-time remote-file-name-inhibit-cache))))
- (and (consp remote-file-name-inhibit-cache)
- (time-less-p
- remote-file-name-inhibit-cache (car value)))))
- (setq value (cdr value))
- (setq value default))
-
- (tramp-message key 8 "%s %s %s" file property value)
- (when (>= tramp-verbose 10)
- (let* ((var (intern (concat "tramp-cache-get-count-" property)))
- (val (or (bound-and-true-p var)
- (progn
- (add-hook 'tramp-cache-unload-hook
- (lambda () (makunbound var)))
- 0))))
- (set var (1+ val))))
- value))
-
-;;;###tramp-autoload
-(defun tramp-set-file-property (key file property value)
- "Set the PROPERTY of FILE to VALUE, in the cache context of KEY.
-Returns VALUE."
- ;; Unify localname. Remove hop from `tramp-file-name' structure.
- (setq file (tramp-compat-file-name-unquote file)
- key (copy-tramp-file-name key))
- (setf (tramp-file-name-localname key)
- (tramp-run-real-handler #'directory-file-name (list file))
- (tramp-file-name-hop key) nil)
- (let ((hash (tramp-get-hash-table key)))
- ;; We put the timestamp there.
- (puthash property (cons (current-time) value) hash)
- (tramp-message key 8 "%s %s %s" file property value)
- (when (>= tramp-verbose 10)
- (let* ((var (intern (concat "tramp-cache-set-count-" property)))
- (val (or (bound-and-true-p var)
- (progn
- (add-hook 'tramp-cache-unload-hook
- (lambda () (makunbound var)))
- 0))))
- (set var (1+ val))))
- value))
-
-;;;###tramp-autoload
-(defun tramp-flush-file-property (key file property)
- "Remove PROPERTY of FILE in the cache context of KEY."
- ;; Unify localname. Remove hop from `tramp-file-name' structure.
- (setq file (tramp-compat-file-name-unquote file)
- key (copy-tramp-file-name key))
- (setf (tramp-file-name-localname key)
- (tramp-run-real-handler #'directory-file-name (list file))
- (tramp-file-name-hop key) nil)
- (remhash property (tramp-get-hash-table key))
- (tramp-message key 8 "%s %s" file property)
- (when (>= tramp-verbose 10)
- (let ((var (intern (concat "tramp-cache-set-count-" property))))
- (makunbound var))))
-
-;;;###tramp-autoload
-(defun tramp-flush-file-properties (key file)
- "Remove all properties of FILE in the cache context of KEY."
- (let* ((file (tramp-run-real-handler
- #'directory-file-name (list file)))
- (truename (tramp-get-file-property key file "file-truename" nil)))
- ;; Unify localname. Remove hop from `tramp-file-name' structure.
- (setq file (tramp-compat-file-name-unquote file)
- key (copy-tramp-file-name key))
- (setf (tramp-file-name-localname key) file
- (tramp-file-name-hop key) nil)
- (tramp-message key 8 "%s" file)
- (remhash key tramp-cache-data)
- ;; Remove file properties of symlinks.
- (when (and (stringp truename)
- (not (string-equal file (directory-file-name truename))))
- (tramp-flush-file-properties key truename))))
-
-;;;###tramp-autoload
-(defun tramp-flush-directory-properties (key directory)
- "Remove all properties of DIRECTORY in the cache context of KEY.
-Remove also properties of all files in subdirectories."
- (setq directory (tramp-compat-file-name-unquote directory))
- (let* ((directory (tramp-run-real-handler
- #'directory-file-name (list directory)))
- (truename (tramp-get-file-property key directory "file-truename" nil)))
- (tramp-message key 8 "%s" directory)
- (maphash
- (lambda (key _value)
- (when (and (tramp-file-name-p key)
- (stringp (tramp-file-name-localname key))
- (string-match-p (regexp-quote directory)
- (tramp-file-name-localname key)))
- (remhash key tramp-cache-data)))
- tramp-cache-data)
- ;; Remove file properties of symlinks.
- (when (and (stringp truename)
- (not (string-equal directory (directory-file-name truename))))
- (tramp-flush-directory-properties key truename))))
-
-;; Reverting or killing a buffer should also flush file properties.
-;; They could have been changed outside Tramp. In eshell, "ls" would
-;; not show proper directory contents when a file has been copied or
-;; deleted before. We must apply `save-match-data', because it would
-;; corrupt other packages otherwise (reported from org).
-(defun tramp-flush-file-function ()
- "Flush all Tramp cache properties from `buffer-file-name'.
-This is suppressed for temporary buffers."
- (save-match-data
- (unless (or (null (buffer-name))
- (string-match-p "^\\( \\|\\*\\)" (buffer-name)))
- (let ((bfn (if (stringp (buffer-file-name))
- (buffer-file-name)
- default-directory))
- (tramp-verbose 0))
- (when (tramp-tramp-file-p bfn)
- (with-parsed-tramp-file-name bfn nil
- (tramp-flush-file-properties v localname)))))))
-
-(add-hook 'before-revert-hook #'tramp-flush-file-function)
-(add-hook 'eshell-pre-command-hook #'tramp-flush-file-function)
-(add-hook 'kill-buffer-hook #'tramp-flush-file-function)
-(add-hook 'tramp-cache-unload-hook
- (lambda ()
- (remove-hook 'before-revert-hook
- #'tramp-flush-file-function)
- (remove-hook 'eshell-pre-command-hook
- #'tramp-flush-file-function)
- (remove-hook 'kill-buffer-hook
- #'tramp-flush-file-function)))
-
-;;; -- Properties --
-
-;;;###tramp-autoload
-(defun tramp-get-connection-property (key property default)
- "Get the named PROPERTY for the connection.
-KEY identifies the connection, it is either a process or a
-`tramp-file-name' structure. A special case is nil, which is
-used to cache connection properties of the local machine. If the
-value is not set for the connection, returns DEFAULT."
- ;; Unify key by removing localname and hop from `tramp-file-name'
- ;; structure. Work with a copy in order to avoid side effects.
- (when (tramp-file-name-p key)
- (setq key (copy-tramp-file-name key))
- (setf (tramp-file-name-localname key) nil
- (tramp-file-name-hop key) nil))
- (let* ((hash (tramp-get-hash-table key))
- (value
- ;; If the key is an auxiliary process object, check whether
- ;; the process is still alive.
- (if (and (processp key) (not (process-live-p key)))
- default
- (if (hash-table-p hash)
- (gethash property hash default)
- default))))
- (tramp-message key 7 "%s %s" property value)
- value))
-
-;;;###tramp-autoload
-(defun tramp-set-connection-property (key property value)
- "Set the named PROPERTY of a connection to VALUE.
-KEY identifies the connection, it is either a process or a
-`tramp-file-name' structure. A special case is nil, which is
-used to cache connection properties of the local machine.
-PROPERTY is set persistent when KEY is a `tramp-file-name' structure."
- ;; Unify key by removing localname and hop from `tramp-file-name'
- ;; structure. Work with a copy in order to avoid side effects.
- (when (tramp-file-name-p key)
- (setq key (copy-tramp-file-name key))
- (setf (tramp-file-name-localname key) nil
- (tramp-file-name-hop key) nil))
- (let ((hash (tramp-get-hash-table key)))
- (puthash property value hash)
- (setq tramp-cache-data-changed t)
- (tramp-message key 7 "%s %s" property value)
- value))
-
-;;;###tramp-autoload
-(defun tramp-connection-property-p (key property)
- "Check whether named PROPERTY of a connection is defined.
-KEY identifies the connection, it is either a process or a
-`tramp-file-name' structure. A special case is nil, which is
-used to cache connection properties of the local machine."
- (not (eq (tramp-get-connection-property key property 'undef) 'undef)))
-
-;;;###tramp-autoload
-(defun tramp-flush-connection-property (key property)
- "Remove the named PROPERTY of a connection identified by KEY.
-KEY identifies the connection, it is either a process or a
-`tramp-file-name' structure. A special case is nil, which is
-used to cache connection properties of the local machine.
-PROPERTY is set persistent when KEY is a `tramp-file-name' structure."
- ;; Unify key by removing localname and hop from `tramp-file-name'
- ;; structure. Work with a copy in order to avoid side effects.
- (when (tramp-file-name-p key)
- (setq key (copy-tramp-file-name key))
- (setf (tramp-file-name-localname key) nil
- (tramp-file-name-hop key) nil))
- (remhash property (tramp-get-hash-table key))
- (setq tramp-cache-data-changed t)
- (tramp-message key 7 "%s" property))
-
-;;;###tramp-autoload
-(defun tramp-flush-connection-properties (key)
- "Remove all properties identified by KEY.
-KEY identifies the connection, it is either a process or a
-`tramp-file-name' structure. A special case is nil, which is
-used to cache connection properties of the local machine."
- ;; Unify key by removing localname and hop from `tramp-file-name'
- ;; structure. Work with a copy in order to avoid side effects.
- (when (tramp-file-name-p key)
- (setq key (copy-tramp-file-name key))
- (setf (tramp-file-name-localname key) nil
- (tramp-file-name-hop key) nil))
- (tramp-message
- key 7 "%s %s" key
- (let ((hash (gethash key tramp-cache-data))
- properties)
- (when (hash-table-p hash)
- (maphash (lambda (x _y) (add-to-list 'properties x 'append)) hash))
- properties))
- (setq tramp-cache-data-changed t)
- (remhash key tramp-cache-data))
-
-;;;###tramp-autoload
-(defun tramp-cache-print (table)
- "Print hash table TABLE."
- (when (hash-table-p table)
- (let (result)
- (maphash
- (lambda (key value)
- ;; Remove text properties from KEY and VALUE.
- ;; `cl-struct-slot-*' functions exist since Emacs 25 only; we
- ;; ignore errors.
- (when (tramp-file-name-p key)
- ;; (dolist
- ;; (slot
- ;; (mapcar #'car (cdr (cl-struct-slot-info 'tramp-file-name))))
- ;; (when (stringp (cl-struct-slot-value 'tramp-file-name slot key))
- ;; (setf (cl-struct-slot-value 'tramp-file-name slot key)
- ;; (substring-no-properties
- ;; (cl-struct-slot-value 'tramp-file-name slot key))))))
- (dotimes (i (length key))
- (when (stringp (elt key i))
- (setf (elt key i) (substring-no-properties (elt key i))))))
- (when (stringp key)
- (setq key (substring-no-properties key)))
- (when (stringp value)
- (setq value (substring-no-properties value)))
- ;; Dump.
- (let ((tmp (format
- "(%s %s)"
- (if (processp key)
- (prin1-to-string (prin1-to-string key))
- (prin1-to-string key))
- (if (hash-table-p value)
- (tramp-cache-print value)
- (if (or (bufferp value)
- ;; Mutexes have entered Emacs 26.1.
- (tramp-compat-funcall 'mutexp value))
- (prin1-to-string (prin1-to-string value))
- (prin1-to-string value))))))
- (setq result (if result (concat result " " tmp) tmp))))
- table)
- result)))
-
-;;;###tramp-autoload
-(defun tramp-list-connections ()
- "Return all known `tramp-file-name' structs according to `tramp-cache'."
- (let (result tramp-verbose)
- (maphash
- (lambda (key _value)
- (when (and (tramp-file-name-p key)
- (null (tramp-file-name-localname key))
- (tramp-connection-property-p key "process-buffer"))
- (add-to-list 'result key)))
- tramp-cache-data)
- result))
-
-(defun tramp-dump-connection-properties ()
- "Write persistent connection properties into file
`tramp-persistency-file-name'."
- ;; We shouldn't fail, otherwise Emacs might not be able to be closed.
- (ignore-errors
- (when (and (hash-table-p tramp-cache-data)
- (not (zerop (hash-table-count tramp-cache-data)))
- tramp-cache-data-changed
- (stringp tramp-persistency-file-name))
- (let ((cache (copy-hash-table tramp-cache-data))
- print-length print-level)
- ;; Remove temporary data. If there is the key "login-as", we
- ;; don't save either, because all other properties might
- ;; depend on the login name, and we want to give the
- ;; possibility to use another login name later on. Key
- ;; "started" exists for the "ftp" method only, which must be
- ;; be kept persistent.
- (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)))
- (progn
- (remhash "process-name" value)
- (remhash "process-buffer" value)
- (remhash "first-password-request" value))
- (remhash key cache)))
- cache)
- ;; Dump it.
- (with-temp-file tramp-persistency-file-name
- (insert
- ";; -*- emacs-lisp -*-"
- ;; `time-stamp-string' might not exist in all Emacs flavors.
- (condition-case nil
- (progn
- (format
- " <%s %s>\n"
- (time-stamp-string "%02y/%02m/%02d %02H:%02M:%02S")
- tramp-persistency-file-name))
- (error "\n"))
- ";; Tramp connection history. Don't change this file.\n"
- ";; You can delete it, forcing Tramp to reapply the checks.\n\n"
- (with-output-to-string
- (pp (read (format "(%s)" (tramp-cache-print cache)))))))))))
-
-(unless noninteractive
- (add-hook 'kill-emacs-hook #'tramp-dump-connection-properties))
-(add-hook 'tramp-cache-unload-hook
- (lambda ()
- (remove-hook 'kill-emacs-hook
- #'tramp-dump-connection-properties)))
-
-;;;###tramp-autoload
-(defun tramp-parse-connection-properties (method)
- "Return a list of (user host) tuples allowed to access for METHOD.
-This function is added always in `tramp-get-completion-function'
-for all methods. Resulting data are derived from connection history."
- (let (res)
- (maphash
- (lambda (key _value)
- (if (and (tramp-file-name-p key)
- (string-equal method (tramp-file-name-method key))
- (not (tramp-file-name-localname key)))
- (push (list (tramp-file-name-user key)
- (tramp-file-name-host key))
- res)))
- tramp-cache-data)
- res))
-
-;; When "emacs -Q" has been called, both variables are nil. We do not
-;; load the persistency file then, in order to have a clean test environment.
-;;;###tramp-autoload
-(defvar tramp-cache-read-persistent-data (or init-file-user site-run-file)
- "Whether to read persistent data at startup time.")
-
-;; Read persistent connection history.
-(when (and (stringp tramp-persistency-file-name)
- (zerop (hash-table-count tramp-cache-data))
- tramp-cache-read-persistent-data)
- (condition-case err
- (with-temp-buffer
- (insert-file-contents tramp-persistency-file-name)
- (let ((list (read (current-buffer)))
- (tramp-verbose 0)
- element key item)
- (while (setq element (pop list))
- (setq key (pop element))
- (when (tramp-file-name-p key)
- (while (setq item (pop element))
- ;; We set only values which are not contained in
- ;; `tramp-connection-properties'. The cache is
- ;; initialized properly by side effect.
- (unless (tramp-connection-property-p key (car item))
- (tramp-set-connection-property key (pop item) (car item)))))))
- (setq tramp-cache-data-changed nil))
- (file-error
- ;; Most likely because the file doesn't exist yet. No message.
- (clrhash tramp-cache-data))
- (error
- ;; File is corrupted.
- (message "Tramp persistency file `%s' is corrupted: %s"
- tramp-persistency-file-name (error-message-string err))
- (clrhash tramp-cache-data))))
-
-(add-hook 'tramp-unload-hook
- (lambda ()
- (unload-feature 'tramp-cache 'force)))
-
-(provide 'tramp-cache)
-
-;;; tramp-cache.el ends here
diff --git a/lisp/tramp-cmds.el b/lisp/tramp-cmds.el
deleted file mode 100644
index f1e1d82..0000000
--- a/lisp/tramp-cmds.el
+++ /dev/null
@@ -1,434 +0,0 @@
-;;; tramp-cmds.el --- Interactive commands for Tramp -*- lexical-binding:t -*-
-
-;; Copyright (C) 2007-2019 Free Software Foundation, Inc.
-
-;; Author: Michael Albinus <address@hidden>
-;; 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:
-
-;; This package provides all interactive commands which are related
-;; to Tramp.
-
-;;; Code:
-
-(require 'tramp)
-
-;; Pacify byte-compiler.
-(declare-function mml-mode "mml")
-(declare-function mml-insert-empty-tag "mml")
-(declare-function reporter-dump-variable "reporter")
-(defvar reporter-eval-buffer)
-(defvar reporter-prompt-for-summary-p)
-
-;;;###tramp-autoload
-(defun tramp-change-syntax (&optional syntax)
- "Change Tramp syntax.
-SYNTAX can be one of the symbols `default' (default),
-`simplified' (ange-ftp like) or `separate' (XEmacs like)."
- (interactive
- (let ((input (completing-read
- "Enter Tramp syntax: " (tramp-syntax-values) nil t
- (symbol-name tramp-syntax))))
- (unless (string-equal input "")
- (list (intern input)))))
- (when syntax
- (customize-set-variable 'tramp-syntax syntax)))
-
-(defun tramp-list-tramp-buffers ()
- "Return a list of all Tramp connection buffers."
- (append
- (all-completions
- "*tramp" (mapcar #'list (mapcar #'buffer-name (buffer-list))))
- (all-completions
- "*debug tramp" (mapcar #'list (mapcar #'buffer-name (buffer-list))))))
-
-(defun tramp-list-remote-buffers ()
- "Return a list of all buffers with remote default-directory."
- (delq
- nil
- (mapcar
- (lambda (x)
- (with-current-buffer x (when (tramp-tramp-file-p default-directory) x)))
- (buffer-list))))
-
-;;;###tramp-autoload
-(defvar tramp-cleanup-connection-hook nil
- "List of functions to be called after Tramp connection is cleaned up.
-Each function is called with the current vector as argument.")
-
-;;;###tramp-autoload
-(defun tramp-cleanup-connection (vec &optional keep-debug keep-password)
- "Flush all connection related objects.
-This includes password cache, file cache, connection cache,
-buffers. KEEP-DEBUG non-nil preserves the debug buffer.
-KEEP-PASSWORD non-nil preserves the password cache.
-When called interactively, a Tramp connection has to be selected."
- (interactive
- ;; When interactive, select the Tramp remote identification.
- ;; Return nil when there is no Tramp connection.
- (list
- (let ((connections
- (mapcar #'tramp-make-tramp-file-name (tramp-list-connections)))
- name)
-
- (when connections
- (setq name
- (completing-read
- "Enter Tramp connection: " connections nil t
- (try-completion "" connections)))
- (and (tramp-tramp-file-p name) (tramp-dissect-file-name name))))
- nil nil))
-
- (if (not vec)
- ;; Nothing to do.
- (message "No Tramp connection found.")
-
- ;; Flush password cache.
- (unless keep-password (tramp-clear-passwd vec))
-
- ;; Cleanup `tramp-current-connection'. Otherwise, we would be
- ;; suppressed.
- (setq tramp-current-connection nil)
-
- ;; Flush file cache.
- (tramp-flush-directory-properties vec "")
-
- ;; Flush connection cache.
- (when (processp (tramp-get-connection-process vec))
- (tramp-flush-connection-properties (tramp-get-connection-process vec))
- (delete-process (tramp-get-connection-process vec)))
- (tramp-flush-connection-properties vec)
-
- ;; Remove buffers.
- (dolist
- (buf (list (get-buffer (tramp-buffer-name vec))
- (unless keep-debug
- (get-buffer (tramp-debug-buffer-name vec)))
- (tramp-get-connection-property vec "process-buffer" nil)))
- (when (bufferp buf) (kill-buffer buf)))
-
- ;; The end.
- (run-hook-with-args 'tramp-cleanup-connection-hook vec)))
-
-;;;###tramp-autoload
-(defun tramp-cleanup-this-connection ()
- "Flush all connection related objects of the current buffer's connection."
- (interactive)
- (and (tramp-tramp-file-p default-directory)
- (tramp-cleanup-connection
- (tramp-dissect-file-name default-directory 'noexpand))))
-
-;;;###tramp-autoload
-(defvar tramp-cleanup-all-connections-hook nil
- "List of functions to be called after all Tramp connections are cleaned up.")
-
-;;;###tramp-autoload
-(defun tramp-cleanup-all-connections ()
- "Flush all Tramp internal objects.
-This includes password cache, file cache, connection cache, buffers."
- (interactive)
-
- ;; Unlock Tramp.
- (setq tramp-locked nil)
-
- ;; Flush password cache.
- (password-reset)
-
- ;; Flush file and connection cache.
- (clrhash tramp-cache-data)
-
- ;; Remove ad-hoc proxies.
- (let ((proxies tramp-default-proxies-alist))
- (while proxies
- (if (ignore-errors
- (get-text-property 0 'tramp-ad-hoc (nth 2 (car proxies))))
- (setq tramp-default-proxies-alist
- (delete (car proxies) tramp-default-proxies-alist)
- proxies tramp-default-proxies-alist)
- (setq proxies (cdr proxies)))))
- (when (and tramp-default-proxies-alist tramp-save-ad-hoc-proxies)
- (customize-save-variable
- 'tramp-default-proxies-alist tramp-default-proxies-alist))
-
- ;; Remove buffers.
- (dolist (name (tramp-list-tramp-buffers))
- (when (bufferp (get-buffer name)) (kill-buffer name)))
-
- ;; The end.
- (run-hooks 'tramp-cleanup-all-connections-hook))
-
-;;;###tramp-autoload
-(defun tramp-cleanup-all-buffers ()
- "Kill all remote buffers."
- (interactive)
-
- ;; Remove all Tramp related connections.
- (tramp-cleanup-all-connections)
-
- ;; Remove all buffers with a remote default-directory.
- (dolist (name (tramp-list-remote-buffers))
- (when (bufferp (get-buffer name)) (kill-buffer name))))
-
-;; Tramp version is useful in a number of situations.
-
-;;;###tramp-autoload
-(defun tramp-version (arg)
- "Print version number of tramp.el in minibuffer or current buffer."
- (interactive "P")
- (if arg (insert tramp-version) (message tramp-version)))
-
-;; Make the "reporter" functionality available for making bug reports about
-;; the package. A most useful piece of code.
-
-(autoload 'reporter-submit-bug-report "reporter")
-
-;;;###tramp-autoload
-(defun tramp-bug ()
- "Submit a bug report to the Tramp developers."
- (interactive)
- (catch 'dont-send
- (let ((reporter-prompt-for-summary-p t)
- ;; In rare cases, it could contain the password. So we make it nil.
- tramp-password-save-function)
- (reporter-submit-bug-report
- tramp-bug-report-address ; to-address
- (format "tramp (%s %s/%s)" ; package name and version
- tramp-version tramp-repository-branch tramp-repository-version)
- (sort
- (delq nil (mapcar
- (lambda (x)
- (and x (boundp x) (cons x 'tramp-reporter-dump-variable)))
- (append
- (mapcar #'intern (all-completions "tramp-" obarray #'boundp))
- ;; Non-tramp variables of interest.
- '(shell-prompt-pattern
- backup-by-copying
- backup-by-copying-when-linked
- backup-by-copying-when-mismatch
- backup-by-copying-when-privileged-mismatch
- backup-directory-alist
- password-cache
- password-cache-expiry
- remote-file-name-inhibit-cache
- connection-local-profile-alist
- connection-local-criteria-alist
- file-name-handler-alist))))
- (lambda (x y) (string< (symbol-name (car x)) (symbol-name (car y)))))
-
- 'tramp-load-report-modules ; pre-hook
- 'tramp-append-tramp-buffers ; post-hook
- (propertize
- "\n" 'display "\
-Enter your bug report in this message, including as much detail
-as you possibly can about the problem, what you did to cause it
-and what the local and remote machines are.
-
-If you can give a simple set of instructions to make this bug
-happen reliably, please include those. Thank you for helping
-kill bugs in Tramp.
-
-Before reproducing the bug, you might apply
-
- M-x tramp-cleanup-all-connections
-
-This allows us to investigate from a clean environment. Another
-useful thing to do is to put
-
- (setq tramp-verbose 9)
-
-in your init file and to repeat the bug. Then, include the
-contents of the *tramp/foo* buffer and the *debug tramp/foo*
-buffer in your bug report.
-
---bug report follows this line--
-")))))
-
-(defun tramp-reporter-dump-variable (varsym mailbuf)
- "Pretty-print the value of the variable in symbol VARSYM."
- (let* ((reporter-eval-buffer (symbol-value 'reporter-eval-buffer))
- (val (with-current-buffer reporter-eval-buffer
- (symbol-value varsym))))
-
- (if (hash-table-p val)
- ;; Pretty print the cache.
- (set varsym (read (format "(%s)" (tramp-cache-print val))))
- ;; There are non-7bit characters to be masked.
- (when (and (stringp val)
- (string-match-p
- (concat "[^" (bound-and-true-p mm-7bit-chars) "]") val))
- (with-current-buffer reporter-eval-buffer
- (set
- varsym
- (format
- "(decode-coding-string (base64-decode-string \"%s\") 'raw-text)"
- (base64-encode-string (encode-coding-string val 'raw-text)))))))
-
- ;; Dump variable.
- (reporter-dump-variable varsym mailbuf)
-
- (unless (hash-table-p val)
- ;; Remove string quotation.
- (forward-line -1)
- (when (looking-at
- (eval-when-compile
- (concat "\\(^.*\\)" "\"" ;; \1 "
- "\\((base64-decode-string \\)" "\\\\" ;; \2 \
- "\\(\".*\\)" "\\\\" ;; \3 \
- "\\(\")\\)" "\"$"))) ;; \4 "
- (replace-match "\\1\\2\\3\\4")
- (beginning-of-line)
- (insert " ;; Variable encoded due to non-printable characters.\n"))
- (forward-line 1))
-
- ;; Reset VARSYM to old value.
- (with-current-buffer reporter-eval-buffer
- (set varsym val))))
-
-(defun tramp-load-report-modules ()
- "Load needed modules for reporting."
- (message-mode)
- (mml-mode t))
-
-(defun tramp-append-tramp-buffers ()
- "Append Tramp buffers and buffer local variables into the bug report."
- (goto-char (point-max))
-
- ;; Dump buffer local variables.
- (insert "\nlocal variables:\n================")
- (dolist (buffer
- (delq nil
- (mapcar
- (lambda (b)
- (when (string-match-p "\\*tramp/" (buffer-name b)) b))
- (buffer-list))))
- (let ((reporter-eval-buffer buffer)
- (elbuf (get-buffer-create " *tmp-reporter-buffer*")))
- (with-current-buffer elbuf
- (emacs-lisp-mode)
- (erase-buffer)
- (insert (format "\n;; %s\n(setq-local\n" (buffer-name buffer)))
- (lisp-indent-line)
- (dolist
- (varsym
- (sort
- (append
- (mapcar
- #'intern
- (all-completions "tramp-" (buffer-local-variables buffer)))
- ;; Non-tramp variables of interest.
- '(connection-local-variables-alist default-directory))
- #'string<))
- (reporter-dump-variable varsym elbuf))
- (lisp-indent-line)
- (insert ")\n"))
- (insert-buffer-substring elbuf)))
-
- ;; Dump load-path shadows.
- (insert "\nload-path shadows:\n==================\n")
- (ignore-errors
- (mapc
- (lambda (x) (when (string-match-p "tramp" x) (insert x "\n")))
- (split-string (list-load-path-shadows t) "\n")))
-
- ;; Append buffers only when we are in message mode.
- (when (and
- (eq major-mode 'message-mode)
- (bound-and-true-p mml-mode))
-
- (let ((tramp-buf-regexp "\\*\\(debug \\)?tramp/")
- (buffer-list (tramp-list-tramp-buffers))
- (curbuf (current-buffer)))
-
- ;; There is at least one Tramp buffer.
- (when buffer-list
- (switch-to-buffer (list-buffers-noselect nil))
- (delete-other-windows)
- (setq buffer-read-only nil)
- (goto-char (point-min))
- (while (not (eobp))
- (if (re-search-forward tramp-buf-regexp (point-at-eol) t)
- (forward-line 1)
- (forward-line 0)
- (let ((start (point)))
- (forward-line 1)
- (kill-region start (point)))))
- (insert "
-The buffer(s) above will be appended to this message. If you
-don't want to append a buffer because it contains sensitive data,
-or because the buffer is too large, you should delete the
-respective buffer. The buffer(s) will contain user and host
-names. Passwords will never be included there.")
-
- (when (>= tramp-verbose 6)
- (insert "\n\n")
- (let ((start (point)))
- (insert "\
-Please note that you have set `tramp-verbose' to a value of at
-least 6. Therefore, the contents of files might be included in
-the debug buffer(s).")
- (add-text-properties start (point) '(face italic))))
-
- (set-buffer-modified-p nil)
- (setq buffer-read-only t)
- (goto-char (point-min))
-
- (if (y-or-n-p "Do you want to append the buffer(s)? ")
- ;; OK, let's send. First we delete the buffer list.
- (progn
- (kill-buffer nil)
- (switch-to-buffer curbuf)
- (goto-char (point-max))
- (insert (propertize "\n" 'display "\n\
-This is a special notion of the `gnus/message' package. If you
-use another mail agent (by copying the contents of this buffer)
-please ensure that the buffers are attached to your email.\n\n"))
- (dolist (buffer buffer-list)
- (mml-insert-empty-tag
- 'part 'type "text/plain"
- 'encoding "base64" 'disposition "attachment" 'buffer buffer
- 'description buffer))
- (set-buffer-modified-p nil))
-
- ;; Don't send. Delete the message buffer.
- (set-buffer curbuf)
- (set-buffer-modified-p nil)
- (kill-buffer nil)
- (throw 'dont-send nil))))))
-
-(defalias 'tramp-submit-bug #'tramp-bug)
-
-(add-hook 'tramp-unload-hook
- (lambda () (unload-feature 'tramp-cmds 'force)))
-
-(provide 'tramp-cmds)
-
-;;; TODO:
-
-;; * Clean up unused *tramp/foo* buffers after a while. (Pete Forman)
-;;
-;; * WIBNI there was an interactive command prompting for Tramp
-;; method, hostname, username and filename and translates the user
-;; input into the correct filename syntax (depending on the Emacs
-;; flavor) (Reiner Steib)
-;;
-;; * Let the user edit the connection properties interactively.
-;; Something like `gnus-server-edit-server' in Gnus' *Server* buffer.
-
-;;; tramp-cmds.el ends here
diff --git a/lisp/tramp-compat.el b/lisp/tramp-compat.el
deleted file mode 100644
index 7c13adf..0000000
--- a/lisp/tramp-compat.el
+++ /dev/null
@@ -1,330 +0,0 @@
-;;; tramp-compat.el --- Tramp compatibility functions -*- lexical-binding:t
-*-
-
-;; Copyright (C) 2007-2019 Free Software Foundation, Inc.
-
-;; Author: Michael Albinus <address@hidden>
-;; 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:
-
-;; Tramp's main Emacs version for development is Emacs 27. This
-;; package provides compatibility functions for Emacs 24, Emacs 25 and
-;; Emacs 26.
-
-;;; Code:
-
-;; In Emacs 24 and 25, `tramp-unload-file-name-handlers' is not
-;; autoloaded. So we declare it here in order to avoid recursive
-;; load. This will be overwritten in tramp.el.
-(defun tramp-unload-file-name-handlers ())
-
-(require 'auth-source)
-(require 'format-spec)
-(require 'parse-time)
-(require 'shell)
-
-(declare-function tramp-handle-temporary-file-directory "tramp")
-
-;; For not existing functions, obsolete functions, or functions with a
-;; changed argument list, there are compiler warnings. We want to
-;; avoid them in cases we know what we do.
-(defmacro tramp-compat-funcall (function &rest arguments)
- "Call FUNCTION if it exists. Do not raise compiler warnings."
- `(when (functionp ,function)
- (with-no-warnings (funcall ,function ,@arguments))))
-
-(defsubst tramp-compat-temporary-file-directory ()
- "Return name of directory for temporary files.
-It is the default value of `temporary-file-directory'."
- ;; We must return a local directory. If it is remote, we could run
- ;; into an infloop.
- (eval (car (get 'temporary-file-directory 'standard-value))))
-
-(defsubst tramp-compat-make-temp-file (f &optional dir-flag)
- "Create a local temporary file (compat function).
-Add the extension of F, if existing."
- (let* (file-name-handler-alist
- (prefix (expand-file-name
- (symbol-value 'tramp-temp-name-prefix)
- (tramp-compat-temporary-file-directory)))
- (extension (file-name-extension f t)))
- (make-temp-file prefix dir-flag extension)))
-
-;; `temporary-file-directory' as function is introduced with Emacs 26.1.
-(defalias 'tramp-compat-temporary-file-directory-function
- (if (fboundp 'temporary-file-directory)
- #'temporary-file-directory
- #'tramp-handle-temporary-file-directory))
-
-(defun tramp-compat-process-running-p (process-name)
- "Returns t if system process PROCESS-NAME is running for `user-login-name'."
- (when (stringp process-name)
- (cond
- ;; GNU Emacs 22 on w32.
- ((fboundp 'w32-window-exists-p)
- (tramp-compat-funcall 'w32-window-exists-p process-name process-name))
-
- ;; GNU Emacs 23.
- ((and (fboundp 'list-system-processes) (fboundp 'process-attributes))
- (let (result)
- (dolist (pid (tramp-compat-funcall 'list-system-processes) result)
- (let ((attributes (process-attributes pid)))
- (when (and (string-equal
- (cdr (assoc 'user attributes)) (user-login-name))
- (let ((comm (cdr (assoc 'comm attributes))))
- ;; The returned command name could be truncated
- ;; to 15 characters. Therefore, we cannot check
- ;; for `string-equal'.
- (and comm (string-match-p
- (concat "^" (regexp-quote comm))
- process-name))))
- (setq result t)))))))))
-
-;; `default-toplevel-value' has been declared in Emacs 24.4.
-(unless (fboundp 'default-toplevel-value)
- (defalias 'default-toplevel-value #'symbol-value))
-
-;; `file-attribute-*' are introduced in Emacs 25.1.
-
-(defalias 'tramp-compat-file-attribute-type
- (if (fboundp 'file-attribute-type)
- #'file-attribute-type
- (lambda (attributes)
- "The type field in ATTRIBUTES returned by `file-attributes'.
-The value is either t for directory, string (name linked to) for
-symbolic link, or nil."
- (nth 0 attributes))))
-
-(defalias 'tramp-compat-file-attribute-link-number
- (if (fboundp 'file-attribute-link-number)
- #'file-attribute-link-number
- (lambda (attributes)
- "Return the number of links in ATTRIBUTES returned by `file-attributes'."
- (nth 1 attributes))))
-
-(defalias 'tramp-compat-file-attribute-user-id
- (if (fboundp 'file-attribute-user-id)
- #'file-attribute-user-id
- (lambda (attributes)
- "The UID field in ATTRIBUTES returned by `file-attributes'.
-This is either a string or a number. If a string value cannot be
-looked up, a numeric value, either an integer or a float, is
-returned."
- (nth 2 attributes))))
-
-(defalias 'tramp-compat-file-attribute-group-id
- (if (fboundp 'file-attribute-group-id)
- #'file-attribute-group-id
- (lambda (attributes)
- "The GID field in ATTRIBUTES returned by `file-attributes'.
-This is either a string or a number. If a string value cannot be
-looked up, a numeric value, either an integer or a float, is
-returned."
- (nth 3 attributes))))
-
-(defalias 'tramp-compat-file-attribute-modification-time
- (if (fboundp 'file-attribute-modification-time)
- #'file-attribute-modification-time
- (lambda (attributes)
- "The modification time in ATTRIBUTES returned by `file-attributes'.
-This is the time of the last change to the file's contents, and
-is a Lisp timestamp in the style of `current-time'."
- (nth 5 attributes))))
-
-(defalias 'tramp-compat-file-attribute-size
- (if (fboundp 'file-attribute-size)
- #'file-attribute-size
- (lambda (attributes)
- "The size (in bytes) in ATTRIBUTES returned by `file-attributes'.
-If the size is too large for a fixnum, this is a bignum in Emacs 27
-and later, and is a float in Emacs 26 and earlier."
- (nth 7 attributes))))
-
-(defalias 'tramp-compat-file-attribute-modes
- (if (fboundp 'file-attribute-modes)
- #'file-attribute-modes
- (lambda (attributes)
- "The file modes in ATTRIBUTES returned by `file-attributes'.
-This is a string of ten letters or dashes as in ls -l."
- (nth 8 attributes))))
-
-;; `format-message' is new in Emacs 25.1.
-(unless (fboundp 'format-message)
- (defalias 'format-message #'format))
-
-;; `directory-name-p' is new in Emacs 25.1.
-(defalias 'tramp-compat-directory-name-p
- (if (fboundp 'directory-name-p)
- #'directory-name-p
- (lambda (name)
- "Return non-nil if NAME ends with a directory separator character."
- (let ((len (length name))
- (lastc ?.))
- (if (> len 0)
- (setq lastc (aref name (1- len))))
- (or (= lastc ?/)
- (and (memq system-type '(windows-nt ms-dos))
- (= lastc ?\\)))))))
-
-;; `file-missing' is introduced in Emacs 26.1.
-(defconst tramp-file-missing
- (if (get 'file-missing 'error-conditions) 'file-missing 'file-error)
- "The error symbol for the `file-missing' error.")
-
-;; `file-local-name', `file-name-quoted-p', `file-name-quote' and
-;; `file-name-unquote' are introduced in Emacs 26.
-(defalias 'tramp-compat-file-local-name
- (if (fboundp 'file-local-name)
- #'file-local-name
- (lambda (name)
- "Return the local name component of NAME.
-It returns a file name which can be used directly as argument of
-`process-file', `start-file-process', or `shell-command'."
- (or (file-remote-p name 'localname) name))))
-
-;; `file-name-quoted-p' got a second argument in Emacs 27.1.
-(defalias 'tramp-compat-file-name-quoted-p
- (if (and
- (fboundp 'file-name-quoted-p)
- (equal (tramp-compat-funcall 'func-arity #'file-name-quoted-p) '(1 .
2)))
- #'file-name-quoted-p
- (lambda (name &optional top)
- "Whether NAME is quoted with prefix \"/:\".
-If NAME is a remote file name and TOP is nil, check the local part of NAME."
- (let ((file-name-handler-alist (unless top file-name-handler-alist)))
- (string-prefix-p "/:" (tramp-compat-file-local-name name))))))
-
-(defalias 'tramp-compat-file-name-quote
- (if (fboundp 'file-name-quote)
- #'file-name-quote
- (lambda (name)
- "Add the quotation prefix \"/:\" to file NAME.
-If NAME is a remote file name, the local part of NAME is quoted."
- (if (tramp-compat-file-name-quoted-p name)
- name
- (concat
- (file-remote-p name) "/:" (tramp-compat-file-local-name name))))))
-
-(defalias 'tramp-compat-file-name-unquote
- (if (fboundp 'file-name-unquote)
- #'file-name-unquote
- (lambda (name)
- "Remove quotation prefix \"/:\" from file NAME.
-If NAME is a remote file name, the local part of NAME is unquoted."
- (let ((localname (tramp-compat-file-local-name name)))
- (when (tramp-compat-file-name-quoted-p localname)
- (setq
- localname (if (= (length localname) 2) "/" (substring localname 2))))
- (concat (file-remote-p name) localname)))))
-
-;; `tramp-syntax' has changed its meaning in Emacs 26. We still
-;; support old settings.
-(defsubst tramp-compat-tramp-syntax ()
- "Return proper value of `tramp-syntax'."
- (defvar tramp-syntax)
- (cond ((eq tramp-syntax 'ftp) 'default)
- ((eq tramp-syntax 'sep) 'separate)
- (t tramp-syntax)))
-
-;; `cl-struct-slot-info' has been introduced with Emacs 25.
-(defmacro tramp-compat-tramp-file-name-slots ()
- (if (fboundp 'cl-struct-slot-info)
- '(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 use `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.")
-
-;; Threads have entered Emacs 26.1, `main-thread' in Emacs 27.1. But
-;; then, they might not exist when Emacs is configured
-;; --without-threads.
-(defconst tramp-compat-main-thread (bound-and-true-p main-thread)
- "The main thread of Emacs, if compiled --with-threads.")
-
-(defsubst tramp-compat-current-thread ()
- "The current thread, or nil if compiled --without-threads."
- (tramp-compat-funcall 'current-thread))
-
-(defsubst tramp-compat-thread-yield ()
- "Yield the CPU to another thread."
- (tramp-compat-funcall 'thread-yield))
-
-;; Mutexes have entered Emacs 26.1. Once we use only Emacs 26+, we
-;; must check (mutexp mutex), because the other functions might still
-;; not exist when Emacs is configured --without-threads.
-(defmacro tramp-compat-with-mutex (mutex &rest body)
- "Invoke BODY with MUTEX held, releasing MUTEX when done.
-This is the simplest safe way to acquire and release a mutex."
- (declare (indent 1) (debug t))
- `(if (fboundp 'with-mutex)
- (with-mutex ,mutex ,@body)
- ,@body))
-
-;; `exec-path' is new in Emacs 27.1.
-(defalias 'tramp-compat-exec-path
- (if (fboundp 'exec-path)
- #'exec-path
- (lambda ()
- "List of directories to search programs to run in remote subprocesses."
- (let ((handler (find-file-name-handler default-directory 'exec-path)))
- (if handler
- (funcall handler 'exec-path)
- exec-path)))))
-
-;; `time-equal-p' has appeared in Emacs 27.1.
-(defalias 'tramp-compat-time-equal-p
- (if (fboundp 'time-equal-p)
- #'time-equal-p
- (lambda (t1 t2)
- "Return non-nil if time value T1 is equal to time value T2.
-A nil value for either argument stands for the current time."
- (equal (or t1 (current-time)) (or t2 (current-time))))))
-
-;; `flatten-tree' has appeared in Emacs 27.1.
-(defalias 'tramp-compat-flatten-tree
- (if (fboundp 'flatten-tree)
- #'flatten-tree
- (lambda (tree)
- "Take TREE and \"flatten\" it."
- (let (elems)
- (setq tree (list tree))
- (while (let ((elem (pop tree)))
- (cond ((consp elem)
- (setq tree (cons (car elem) (cons (cdr elem) tree))))
- (elem
- (push elem elems)))
- tree))
- (nreverse elems)))))
-
-(add-hook 'tramp-unload-hook
- (lambda ()
- (unload-feature 'tramp-loaddefs 'force)
- (unload-feature 'tramp-compat 'force)))
-
-(provide 'tramp-compat)
-
-;;; TODO:
-
-;; * When we get rid of Emacs 24, replace "(mapconcat #'identity" by
-;; "(string-join".
-
-;;; tramp-compat.el ends here
diff --git a/lisp/tramp-ftp.el b/lisp/tramp-ftp.el
deleted file mode 100644
index 3e06ced..0000000
--- a/lisp/tramp-ftp.el
+++ /dev/null
@@ -1,209 +0,0 @@
-;;; tramp-ftp.el --- Tramp convenience functions for Ange-FTP -*-
lexical-binding:t -*-
-
-;; Copyright (C) 2002-2019 Free Software Foundation, Inc.
-
-;; Author: Michael Albinus <address@hidden>
-;; 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:
-
-;; Convenience functions for calling Ange-FTP from Tramp.
-;; Most of them are displaced from tramp.el.
-
-;;; Code:
-
-(require 'tramp)
-
-;; Pacify byte-compiler.
-(eval-when-compile
- (require 'custom))
-(declare-function ange-ftp-ftp-process-buffer "ange-ftp")
-(defvar ange-ftp-ftp-name-arg)
-(defvar ange-ftp-ftp-name-res)
-(defvar ange-ftp-name-format)
-
-;; Disable Ange-FTP from file-name-handler-alist.
-(defun tramp-disable-ange-ftp ()
- "Turn Ange-FTP off.
-This is useful for unified remoting. See
-`tramp-file-name-structure' for details. Requests suitable for
-Ange-FTP will be forwarded to Ange-FTP. Also see the variables
-`tramp-ftp-method', `tramp-default-method', and
-`tramp-default-method-alist'.
-
-This function is not needed in Emacsen which include Tramp, but is
-present for backward compatibility."
- (let ((a1 (rassq 'ange-ftp-hook-function file-name-handler-alist))
- (a2 (rassq 'ange-ftp-completion-hook-function file-name-handler-alist)))
- (setq file-name-handler-alist
- (delete a1 (delete a2 file-name-handler-alist)))))
-
-(eval-after-load "ange-ftp"
- '(tramp-disable-ange-ftp))
-
-;;;###tramp-autoload
-(defun tramp-ftp-enable-ange-ftp ()
- "Reenable Ange-FTP, when Tramp is unloaded."
- ;; The following code is commented out in Ange-FTP.
-
- ;;; This regexp takes care of real ange-ftp file names (with a slash
- ;;; and colon).
- ;;; Don't allow the host name to end in a period--some systems use /.:
- (or (assoc "^/[^/:]*[^/:.]:" file-name-handler-alist)
- (setq file-name-handler-alist
- (cons '("^/[^/:]*[^/:.]:" . ange-ftp-hook-function)
- file-name-handler-alist)))
-
- ;;; This regexp recognizes absolute filenames with only one component,
- ;;; for the sake of hostname completion.
- (or (assoc "^/[^/:]*\\'" file-name-handler-alist)
- (setq file-name-handler-alist
- (cons '("^/[^/:]*\\'" . ange-ftp-completion-hook-function)
- file-name-handler-alist)))
-
- ;;; This regexp recognizes absolute filenames with only one component
- ;;; on Windows, for the sake of hostname completion.
- (and (memq system-type '(ms-dos windows-nt))
- (or (assoc "^[a-zA-Z]:/[^/:]*\\'" file-name-handler-alist)
- (setq file-name-handler-alist
- (cons '("^[a-zA-Z]:/[^/:]*\\'" .
- ange-ftp-completion-hook-function)
- file-name-handler-alist)))))
-
-(add-hook 'tramp-ftp-unload-hook #'tramp-ftp-enable-ange-ftp)
-
-;; Define FTP method ...
-;;;###tramp-autoload
-(defconst tramp-ftp-method "ftp"
- "When this method name is used, forward all calls to Ange-FTP.")
-
-;; ... and add it to the method list.
-;;;###tramp-autoload
-(tramp--with-startup
- (add-to-list 'tramp-methods (cons tramp-ftp-method nil))
-
- ;; Add some defaults for `tramp-default-method-alist'.
- (add-to-list 'tramp-default-method-alist
- (list "\\`ftp\\." nil tramp-ftp-method))
- (add-to-list 'tramp-default-method-alist
- (list nil "\\`\\(anonymous\\|ftp\\)\\'" tramp-ftp-method))
-
- ;; Add completion function for FTP method.
- (tramp-set-completion-function
- tramp-ftp-method
- '((tramp-parse-netrc "~/.netrc"))))
-
-;;;###tramp-autoload
-(defun tramp-ftp-file-name-handler (operation &rest args)
- "Invoke the Ange-FTP handler for OPERATION.
-First arg specifies the OPERATION, second arg is a list of arguments to
-pass to the OPERATION."
- (save-match-data
- (or (boundp 'ange-ftp-name-format)
- (let (file-name-handler-alist) (require 'ange-ftp)))
- (let ((ange-ftp-name-format
- (list (nth 0 tramp-file-name-structure)
- (nth 3 tramp-file-name-structure)
- (nth 2 tramp-file-name-structure)
- (nth 4 tramp-file-name-structure)))
- ;; ange-ftp uses `ange-ftp-ftp-name-arg' and `ange-ftp-ftp-name-res'
- ;; for optimization in `ange-ftp-ftp-name'. If Tramp wasn't active,
- ;; there could be incorrect values from previous calls in case the
- ;; "ftp" method is used in the Tramp file name. So we unset
- ;; those values.
- (ange-ftp-ftp-name-arg "")
- (ange-ftp-ftp-name-res nil)
- (v (tramp-dissect-file-name
- (apply #'tramp-file-name-for-operation operation args) t)))
- (setf (tramp-file-name-method v) tramp-ftp-method)
- ;; Set "process-name" for thread support.
- (tramp-set-connection-property
- v "process-name"
- (ange-ftp-ftp-process-buffer
- (tramp-file-name-host v) (tramp-file-name-user v)))
-
- (cond
- ;; If argument is a symlink, `file-directory-p' and
- ;; `file-exists-p' call the traversed file recursively. So we
- ;; cannot disable the file-name-handler this case. We set the
- ;; connection property "started" in order to put the remote
- ;; location into the cache, which is helpful for further
- ;; completion. We don't use `with-parsed-tramp-file-name',
- ;; because this returns another user but the one declared in
- ;; "~/.netrc".
- ((memq operation '(file-directory-p file-exists-p))
- (if (apply #'ange-ftp-hook-function operation args)
- (tramp-set-connection-property v "started" t)
- nil))
-
- ;; If the second argument of `copy-file' or `rename-file' is a
- ;; remote file name but via FTP, ange-ftp doesn't check this.
- ;; We must copy it locally first, because there is no place in
- ;; ange-ftp for correct handling.
- ((and (memq operation '(copy-file rename-file))
- (tramp-tramp-file-p (cadr args))
- (not (tramp-ftp-file-name-p (cadr args))))
- (let* ((filename (car args))
- (newname (cadr args))
- (tmpfile (tramp-compat-make-temp-file filename))
- (args (cddr args)))
- ;; We must set `ok-if-already-exists' to t in the first
- ;; step, because the temp file has been created already.
- (if (eq operation 'copy-file)
- (apply operation filename tmpfile t (cdr args))
- (apply operation filename tmpfile t))
- (unwind-protect
- (rename-file tmpfile newname (car args))
- ;; Cleanup.
- (ignore-errors (delete-file tmpfile)))))
-
- ;; Normally, the handlers must be discarded.
- (t (let* ((inhibit-file-name-handlers
- (list 'tramp-file-name-handler
- 'tramp-completion-file-name-handler
- (and (eq inhibit-file-name-operation operation)
- inhibit-file-name-handlers)))
- (inhibit-file-name-operation operation))
- (apply #'ange-ftp-hook-function operation args)))))))
-
-;; It must be a `defsubst' in order to push the whole code into
-;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
-;;;###tramp-autoload
-(defsubst tramp-ftp-file-name-p (filename)
- "Check if it's a filename that should be forwarded to Ange-FTP."
- (and (tramp-tramp-file-p filename)
- (string= (tramp-file-name-method (tramp-dissect-file-name filename))
- tramp-ftp-method)))
-
-;;;###tramp-autoload
-(tramp--with-startup
- (add-to-list 'tramp-foreign-file-name-handler-alist
- (cons #'tramp-ftp-file-name-p #'tramp-ftp-file-name-handler)))
-
-(add-hook 'tramp-unload-hook
- (lambda ()
- (unload-feature 'tramp-ftp 'force)))
-
-(provide 'tramp-ftp)
-
-;;; TODO:
-
-;; * There are no backup files on FTP hosts.
-
-;;; tramp-ftp.el ends here
diff --git a/lisp/tramp-gvfs.el b/lisp/tramp-gvfs.el
deleted file mode 100644
index 3810231..0000000
--- a/lisp/tramp-gvfs.el
+++ /dev/null
@@ -1,2067 +0,0 @@
-;;; tramp-gvfs.el --- Tramp access functions for GVFS daemon -*-
lexical-binding:t -*-
-
-;; Copyright (C) 2009-2019 Free Software Foundation, Inc.
-
-;; Author: Michael Albinus <address@hidden>
-;; 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 the GVFS daemon from Tramp. Tested with GVFS
-;; 1.0 (Ubuntu 8.10, Gnome 2.24). It has been reported also to run
-;; with GVFS 0.2.5 (Ubuntu 8.04, Gnome 2.22), but there is an
-;; incompatibility with the mount_info structure, which has been
-;; worked around.
-
-;; It has also been tested with GVFS 1.6 (Ubuntu 10.04, Gnome 2.30),
-;; where the default_location has been added to mount_info (see
-;; <https://bugzilla.gnome.org/show_bug.cgi?id=561998>.
-
-;; With GVFS 1.14 (Ubuntu 12.10, Gnome 3.6) the interfaces have been
-;; changed, again. So we must introspect the D-Bus interfaces.
-
-;; All actions to mount a remote location, and to retrieve mount
-;; information, are performed by D-Bus messages. File operations
-;; themselves are performed via the mounted filesystem in ~/.gvfs.
-;; Consequently, GNU Emacs with enabled D-Bus bindings is a
-;; precondition.
-
-;; The GVFS D-Bus interface is said to be unstable. There were even
-;; no introspection data before GVFS 1.14. The interface, as
-;; discovered during development time, is given in respective
-;; comments.
-
-;; The user option `tramp-gvfs-methods' contains the list of supported
-;; connection methods. Per default, these are "afp", "dav", "davs",
-;; "gdrive", "nextcloud" and "sftp".
-
-;; "gdrive" and "nextcloud" connection methods require a respective
-;; account in GNOME Online Accounts, with enabled "Files" service.
-
-;; 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
-;; retrieved by:
-;;
-;; (message
-;; "%s"
-;; (mapcar
-;; #'car
-;; (dbus-call-method
-;; :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker
-;; tramp-gvfs-interface-mounttracker "ListMountableInfo")))
-
-;; See also /usr/share/gvfs/mounts
-
-;; Note that all other connection methods are not tested, beside the
-;; ones offered for customization in `tramp-gvfs-methods'. If you
-;; request an additional connection method to be supported, please
-;; drop me a note.
-
-;; For hostname completion, information is retrieved from the zeroconf
-;; daemon (for the "afp", "dav", "davs", and "sftp" methods). The
-;; zeroconf daemon is pre-configured to discover services in the
-;; "local" domain. If another domain shall be used for discovering
-;; services, the user option `tramp-gvfs-zeroconf-domain' can be set
-;; accordingly.
-
-;; Restrictions:
-;;
-;; * Two shares of the same SMB server cannot be mounted in parallel.
-
-;;; Code:
-
-;; D-Bus support in the Emacs core can be disabled with configuration
-;; option "--without-dbus". Declare used subroutines and variables.
-(declare-function dbus-get-unique-name "dbusbind.c")
-
-(eval-when-compile (require 'cl-lib))
-(require 'tramp)
-(require 'dbus)
-(require 'url-parse)
-(require 'url-util)
-
-;; Pacify byte-compiler.
-(eval-when-compile
- (require 'custom))
-
-(declare-function zeroconf-init "zeroconf")
-(declare-function zeroconf-list-service-types "zeroconf")
-(declare-function zeroconf-list-services "zeroconf")
-(declare-function zeroconf-service-host "zeroconf")
-(declare-function zeroconf-service-port "zeroconf")
-(declare-function zeroconf-service-txt "zeroconf")
-
-;; We don't call `dbus-ping', because this would load dbus.el.
-(defconst tramp-gvfs-enabled
- (ignore-errors
- (and (featurep 'dbusbind)
- (autoload 'zeroconf-init "zeroconf")
- (tramp-compat-funcall 'dbus-get-unique-name :system)
- (tramp-compat-funcall 'dbus-get-unique-name :session)
- (or (tramp-compat-process-running-p "gvfs-fuse-daemon")
- (tramp-compat-process-running-p "gvfsd-fuse"))))
- "Non-nil when GVFS is available.")
-
-;;;###tramp-autoload
-(defcustom tramp-gvfs-methods
- '("afp" "dav" "davs" "gdrive" "nextcloud" "sftp")
- "List of methods for remote files, accessed with GVFS."
- :group 'tramp
- :version "27.1"
- :type '(repeat (choice (const "afp")
- (const "dav")
- (const "davs")
- (const "ftp")
- (const "gdrive")
- (const "http")
- (const "https")
- (const "nextcloud")
- (const "sftp")
- (const "smb"))))
-
-(defconst tramp-goa-methods '("gdrive" "nextcloud")
- "List of methods which require registration at GNOME Online Accounts.")
-
-;; Remove GNOME Online Accounts methods if not supported.
-(unless (and tramp-gvfs-enabled
- (member tramp-goa-service (dbus-list-known-names :session)))
- (dolist (method tramp-goa-methods)
- (setq tramp-gvfs-methods (delete method tramp-gvfs-methods))))
-
-;; Add defaults for `tramp-default-user-alist' and `tramp-default-host-alist'.
-;;;###tramp-autoload
-(tramp--with-startup
- (when (string-match "\\(.+\\)@\\(\\(?:gmail\\|googlemail\\)\\.com\\)"
- user-mail-address)
- (add-to-list 'tramp-default-user-alist
- `("\\`gdrive\\'" nil ,(match-string 1 user-mail-address)))
- (add-to-list 'tramp-default-host-alist
- '("\\`gdrive\\'" nil ,(match-string 2 user-mail-address)))))
-
-(defcustom tramp-gvfs-zeroconf-domain "local"
- "Zeroconf domain to be used for discovering services, like host names."
- :group 'tramp
- :version "23.2"
- :type 'string)
-
-;; Add the methods to `tramp-methods', in order to allow minibuffer
-;; completion.
-;;;###tramp-autoload
-(when (featurep 'dbusbind)
- (tramp--with-startup
- (dolist (elt tramp-gvfs-methods)
- (unless (assoc elt tramp-methods)
- (add-to-list 'tramp-methods (cons elt nil))))))
-
-(defconst tramp-gvfs-path-tramp (concat dbus-path-emacs "/Tramp")
- "The preceding object path for own objects.")
-
-(defconst tramp-gvfs-service-daemon "org.gtk.vfs.Daemon"
- "The well known name of the GVFS daemon.")
-
-(defconst tramp-gvfs-path-mounttracker "/org/gtk/vfs/mounttracker"
- "The object path of the GVFS daemon.")
-
-(defconst tramp-gvfs-interface-mounttracker "org.gtk.vfs.MountTracker"
- "The mount tracking interface in the GVFS daemon.")
-
-;; Introspection data exist since GVFS 1.14. If there are no such
-;; data, we expect an earlier interface.
-(defconst tramp-gvfs-methods-mounttracker
- (and tramp-gvfs-enabled
- (dbus-introspect-get-method-names
- :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker
- tramp-gvfs-interface-mounttracker))
- "The list of supported methods of the mount tracking interface.")
-
-(defconst tramp-gvfs-listmounts
- (if (member "ListMounts" tramp-gvfs-methods-mounttracker)
- "ListMounts"
- "listMounts")
- "The name of the \"listMounts\" method.
-It has been changed in GVFS 1.14.")
-
-(defconst tramp-gvfs-mountlocation
- (if (member "MountLocation" tramp-gvfs-methods-mounttracker)
- "MountLocation"
- "mountLocation")
- "The name of the \"mountLocation\" method.
-It has been changed in GVFS 1.14.")
-
-(defconst tramp-gvfs-mountlocation-signature
- (and tramp-gvfs-enabled
- (dbus-introspect-get-signature
- :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker
- tramp-gvfs-interface-mounttracker tramp-gvfs-mountlocation))
- "The D-Bus signature of the \"mountLocation\" method.
-It has been changed in GVFS 1.14.")
-
-;; <interface name='org.gtk.vfs.MountTracker'>
-;; <method name='listMounts'>
-;; <arg name='mount_info_list'
-;; type='a{sosssssbay{aya{say}}ay}'
-;; direction='out'/>
-;; </method>
-;; <method name='mountLocation'>
-;; <arg name='mount_spec' type='{aya{say}}' direction='in'/>
-;; <arg name='dbus_id' type='s' direction='in'/>
-;; <arg name='object_path' type='o' direction='in'/>
-;; </method>
-;; <signal name='mounted'>
-;; <arg name='mount_info'
-;; type='{sosssssbay{aya{say}}ay}'/>
-;; </signal>
-;; <signal name='unmounted'>
-;; <arg name='mount_info'
-;; type='{sosssssbay{aya{say}}ay}'/>
-;; </signal>
-;; </interface>
-;;
-;; STRUCT mount_info
-;; STRING dbus_id
-;; OBJECT_PATH object_path
-;; STRING display_name
-;; STRING stable_name
-;; STRING x_content_types Since GVFS 1.0 only !!!
-;; STRING icon
-;; STRING preferred_filename_encoding
-;; BOOLEAN user_visible
-;; ARRAY BYTE fuse_mountpoint
-;; STRUCT mount_spec
-;; ARRAY BYTE mount_prefix
-;; ARRAY
-;; STRUCT mount_spec_item
-;; STRING key (type, user, domain, host, server,
-;; share, volume, port, ssl)
-;; ARRAY BYTE value
-;; ARRAY BYTE default_location Since GVFS 1.5 only !!!
-
-(defconst tramp-gvfs-interface-mountoperation "org.gtk.vfs.MountOperation"
- "Used by the dbus-proxying implementation of GMountOperation.")
-
-;; <interface name='org.gtk.vfs.MountOperation'>
-;; <method name='askPassword'>
-;; <arg name='message' type='s' direction='in'/>
-;; <arg name='default_user' type='s' direction='in'/>
-;; <arg name='default_domain' type='s' direction='in'/>
-;; <arg name='flags' type='u' direction='in'/>
-;; <arg name='handled' type='b' direction='out'/>
-;; <arg name='aborted' type='b' direction='out'/>
-;; <arg name='password' type='s' direction='out'/>
-;; <arg name='username' type='s' direction='out'/>
-;; <arg name='domain' type='s' direction='out'/>
-;; <arg name='anonymous' type='b' direction='out'/>
-;; <arg name='password_save' type='u' direction='out'/>
-;; </method>
-;; <method name='askQuestion'>
-;; <arg name='message' type='s' direction='in'/>
-;; <arg name='choices' type='as' direction='in'/>
-;; <arg name='handled' type='b' direction='out'/>
-;; <arg name='aborted' type='b' direction='out'/>
-;; <arg name='choice' type='u' direction='out'/>
-;; </method>
-;; </interface>
-
-;; The following flags are used in "askPassword". They are defined in
-;; /usr/include/glib-2.0/gio/gioenums.h.
-
-(defconst tramp-gvfs-password-need-password 1
- "Operation requires a password.")
-
-(defconst tramp-gvfs-password-need-username 2
- "Operation requires a username.")
-
-(defconst tramp-gvfs-password-need-domain 4
- "Operation requires a domain.")
-
-(defconst tramp-gvfs-password-saving-supported 8
- "Operation supports saving settings.")
-
-(defconst tramp-gvfs-password-anonymous-supported 16
- "Operation supports anonymous users.")
-
-;; For the time being, we just need org.goa.Account and org.goa.Files
-;; interfaces. We document the other ones, just in case.
-
-;;;###tramp-autoload
-(defconst tramp-goa-service "org.gnome.OnlineAccounts"
- "The well known name of the GNOME Online Accounts service.")
-
-(defconst tramp-goa-path "/org/gnome/OnlineAccounts"
- "The object path of the GNOME Online Accounts.")
-
-(defconst tramp-goa-path-accounts (concat tramp-goa-path "/Accounts")
- "The object path of the GNOME Online Accounts accounts.")
-
-(defconst tramp-goa-interface-documents "org.gnome.OnlineAccounts.Documents"
- "The documents interface of the GNOME Online Accounts.")
-
-;; <interface name='org.gnome.OnlineAccounts.Documents'>
-;; </interface>
-
-(defconst tramp-goa-interface-printers "org.gnome.OnlineAccounts.Printers"
- "The printers interface of the GNOME Online Accounts.")
-
-;; <interface name='org.gnome.OnlineAccounts.Printers'>
-;; </interface>
-
-(defconst tramp-goa-interface-files "org.gnome.OnlineAccounts.Files"
- "The files interface of the GNOME Online Accounts.")
-
-;; <interface name='org.gnome.OnlineAccounts.Files'>
-;; <property type='b' name='AcceptSslErrors' access='read'/>
-;; <property type='s' name='Uri' access='read'/>
-;; </interface>
-
-(defconst tramp-goa-interface-contacts "org.gnome.OnlineAccounts.Contacts"
- "The contacts interface of the GNOME Online Accounts.")
-
-;; <interface name='org.gnome.OnlineAccounts.Contacts'>
-;; <property type='b' name='AcceptSslErrors' access='read'/>
-;; <property type='s' name='Uri' access='read'/>
-;; </interface>
-
-(defconst tramp-goa-interface-calendar "org.gnome.OnlineAccounts.Calendar"
- "The calendar interface of the GNOME Online Accounts.")
-
-;; <interface name='org.gnome.OnlineAccounts.Calendar'>
-;; <property type='b' name='AcceptSslErrors' access='read'/>
-;; <property type='s' name='Uri' access='read'/>
-;; </interface>
-
-(defconst tramp-goa-interface-oauth2based
"org.gnome.OnlineAccounts.OAuth2Based"
- "The oauth2based interface of the GNOME Online Accounts.")
-
-;; <interface name='org.gnome.OnlineAccounts.OAuth2Based'>
-;; <method name='GetAccessToken'>
-;; <arg type='s' name='access_token' direction='out'/>
-;; <arg type='i' name='expires_in' direction='out'/>
-;; </method>
-;; <property type='s' name='ClientId' access='read'/>
-;; <property type='s' name='ClientSecret' access='read'/>
-;; </interface>
-
-(defconst tramp-goa-interface-account "org.gnome.OnlineAccounts.Account"
- "The account interface of the GNOME Online Accounts.")
-
-;; <interface name='org.gnome.OnlineAccounts.Account'>
-;; <method name='Remove'/>
-;; <method name='EnsureCredentials'>
-;; <arg type='i' name='expires_in' direction='out'/>
-;; </method>
-;; <property type='s' name='ProviderType' access='read'/>
-;; <property type='s' name='ProviderName' access='read'/>
-;; <property type='s' name='ProviderIcon' access='read'/>
-;; <property type='s' name='Id' access='read'/>
-;; <property type='b' name='IsLocked' access='read'/>
-;; <property type='b' name='IsTemporary' access='readwrite'/>
-;; <property type='b' name='AttentionNeeded' access='read'/>
-;; <property type='s' name='Identity' access='read'/>
-;; <property type='s' name='PresentationIdentity' access='read'/>
-;; <property type='b' name='MailDisabled' access='readwrite'/>
-;; <property type='b' name='CalendarDisabled' access='readwrite'/>
-;; <property type='b' name='ContactsDisabled' access='readwrite'/>
-;; <property type='b' name='ChatDisabled' access='readwrite'/>
-;; <property type='b' name='DocumentsDisabled' access='readwrite'/>
-;; <property type='b' name='MapsDisabled' access='readwrite'/>
-;; <property type='b' name='MusicDisabled' access='readwrite'/>
-;; <property type='b' name='PrintersDisabled' access='readwrite'/>
-;; <property type='b' name='PhotosDisabled' access='readwrite'/>
-;; <property type='b' name='FilesDisabled' access='readwrite'/>
-;; <property type='b' name='TicketingDisabled' access='readwrite'/>
-;; <property type='b' name='TodoDisabled' access='readwrite'/>
-;; <property type='b' name='ReadLaterDisabled' access='readwrite'/>
-;; </interface>
-
-(defconst tramp-goa-identity-regexp
- (concat "^" "\\(" tramp-user-regexp "\\)?"
- "@" "\\(" tramp-host-regexp "\\)?"
- "\\(?:" ":""\\(" tramp-port-regexp "\\)" "\\)?")
- "Regexp matching GNOME Online Accounts \"PresentationIdentity\" property.")
-
-(defconst tramp-goa-interface-mail "org.gnome.OnlineAccounts.Mail"
- "The mail interface of the GNOME Online Accounts.")
-
-;; <interface name='org.gnome.OnlineAccounts.Mail'>
-;; <property type='s' name='EmailAddress' access='read'/>
-;; <property type='s' name='Name' access='read'/>
-;; <property type='b' name='ImapSupported' access='read'/>
-;; <property type='b' name='ImapAcceptSslErrors' access='read'/>
-;; <property type='s' name='ImapHost' access='read'/>
-;; <property type='b' name='ImapUseSsl' access='read'/>
-;; <property type='b' name='ImapUseTls' access='read'/>
-;; <property type='s' name='ImapUserName' access='read'/>
-;; <property type='b' name='SmtpSupported' access='read'/>
-;; <property type='b' name='SmtpAcceptSslErrors' access='read'/>
-;; <property type='s' name='SmtpHost' access='read'/>
-;; <property type='b' name='SmtpUseAuth' access='read'/>
-;; <property type='b' name='SmtpAuthLogin' access='read'/>
-;; <property type='b' name='SmtpAuthPlain' access='read'/>
-;; <property type='b' name='SmtpAuthXoauth2' access='read'/>
-;; <property type='b' name='SmtpUseSsl' access='read'/>
-;; <property type='b' name='SmtpUseTls' access='read'/>
-;; <property type='s' name='SmtpUserName' access='read'/>
-;; </interface>
-
-(defconst tramp-goa-interface-chat "org.gnome.OnlineAccounts.Chat"
- "The chat interface of the GNOME Online Accounts.")
-
-;; <interface name='org.gnome.OnlineAccounts.Chat'>
-;; </interface>
-
-(defconst tramp-goa-interface-photos "org.gnome.OnlineAccounts.Photos"
- "The photos interface of the GNOME Online Accounts.")
-
-;; <interface name='org.gnome.OnlineAccounts.Photos'>
-;; </interface>
-
-(defconst tramp-goa-path-manager (concat tramp-goa-path "/Manager")
- "The object path of the GNOME Online Accounts manager.")
-
-(defconst tramp-goa-interface-documents "org.gnome.OnlineAccounts.Manager"
- "The manager interface of the GNOME Online Accounts.")
-
-;; <interface name='org.gnome.OnlineAccounts.Manager'>
-;; <method name='AddAccount'>
-;; <arg type='s' name='provider' direction='in'/>
-;; <arg type='s' name='identity' direction='in'/>
-;; <arg type='s' name='presentation_identity' direction='in'/>
-;; <arg type='a{sv}' name='credentials' direction='in'/>
-;; <arg type='a{ss}' name='details' direction='in'/>
-;; <arg type='o' name='account_object_path' direction='out'/>
-;; </method>
-;; </interface>
-
-;; The basic structure for GNOME Online Accounts. We use a list :type,
-;; in order to be compatible with Emacs 24 and 25.
-(cl-defstruct (tramp-goa-name (:type list) :named) method user host port)
-
-;; "gvfs-<command>" utilities have been deprecated in GVFS 1.31.1. We
-;; must use "gio <command>" tool instead.
-(defconst tramp-gvfs-gio-mapping
- '(("gvfs-copy" . "copy")
- ("gvfs-info" . "info")
- ("gvfs-ls" . "list")
- ("gvfs-mkdir" . "mkdir")
- ("gvfs-monitor-file" . "monitor")
- ("gvfs-mount" . "mount")
- ("gvfs-move" . "move")
- ("gvfs-rm" . "remove")
- ("gvfs-trash" . "trash"))
- "List of cons cells, mapping \"gvfs-<command>\" to \"gio <command>\".")
-
-;; <http://www.pygtk.org/docs/pygobject/gio-constants.html>
-(defconst tramp-gvfs-file-attributes
- '("name"
- "type"
- "standard::display-name"
- "standard::symlink-target"
- "unix::nlink"
- "unix::uid"
- "owner::user"
- "unix::gid"
- "owner::group"
- "time::access"
- "time::modified"
- "time::changed"
- "standard::size"
- "unix::mode"
- "access::can-read"
- "access::can-write"
- "access::can-execute"
- "unix::inode"
- "unix::device")
- "GVFS file attributes.")
-
-(defconst tramp-gvfs-file-attributes-with-gvfs-ls-regexp
- (concat "[[:blank:]]" (regexp-opt tramp-gvfs-file-attributes t) "=\\(.+?\\)")
- "Regexp to parse GVFS file attributes with `gvfs-ls'.")
-
-(defconst tramp-gvfs-file-attributes-with-gvfs-info-regexp
- (concat "^[[:blank:]]*"
- (regexp-opt tramp-gvfs-file-attributes t)
- ":[[:blank:]]+\\(.*\\)$")
- "Regexp to parse GVFS file attributes with `gvfs-info'.")
-
-(defconst tramp-gvfs-file-system-attributes
- '("filesystem::free"
- "filesystem::size"
- "filesystem::used")
- "GVFS file system attributes.")
-
-(defconst tramp-gvfs-file-system-attributes-regexp
- (concat "^[[:blank:]]*"
- (regexp-opt tramp-gvfs-file-system-attributes t)
- ":[[:blank:]]+\\(.*\\)$")
- "Regexp to parse GVFS file system attributes with `gvfs-info'.")
-
-(defconst tramp-gvfs-nextcloud-default-prefix "/remote.php/webdav"
- "Default prefix for owncloud / nextcloud methods.")
-
-(defconst tramp-gvfs-nextcloud-default-prefix-regexp
- (concat (regexp-quote tramp-gvfs-nextcloud-default-prefix) "$")
- "Regexp of default prefix for owncloud / nextcloud methods.")
-
-
-;; New handlers should be added here.
-;;;###tramp-autoload
-(defconst tramp-gvfs-file-name-handler-alist
- '((access-file . tramp-handle-access-file)
- (add-name-to-file . tramp-handle-add-name-to-file)
- ;; `byte-compiler-base-file-name' performed by default handler.
- ;; `copy-directory' performed by default handler.
- (copy-file . tramp-gvfs-handle-copy-file)
- (delete-directory . tramp-gvfs-handle-delete-directory)
- (delete-file . tramp-gvfs-handle-delete-file)
- ;; `diff-latest-backup-file' performed by default handler.
- (directory-file-name . tramp-handle-directory-file-name)
- (directory-files . tramp-handle-directory-files)
- (directory-files-and-attributes
- . tramp-handle-directory-files-and-attributes)
- (dired-compress-file . ignore)
- (dired-uncache . tramp-handle-dired-uncache)
- (exec-path . ignore)
- (expand-file-name . tramp-gvfs-handle-expand-file-name)
- (file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
- (file-acl . ignore)
- (file-attributes . tramp-gvfs-handle-file-attributes)
- (file-directory-p . tramp-handle-file-directory-p)
- (file-equal-p . tramp-handle-file-equal-p)
- (file-executable-p . tramp-gvfs-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-handle-file-local-copy)
- (file-modes . tramp-handle-file-modes)
- (file-name-all-completions . tramp-gvfs-handle-file-name-all-completions)
- (file-name-as-directory . tramp-handle-file-name-as-directory)
- (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p)
- (file-name-completion . tramp-handle-file-name-completion)
- (file-name-directory . tramp-handle-file-name-directory)
- (file-name-nondirectory . tramp-handle-file-name-nondirectory)
- ;; `file-name-sans-versions' performed by default handler.
- (file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
- (file-notify-add-watch . tramp-gvfs-handle-file-notify-add-watch)
- (file-notify-rm-watch . tramp-handle-file-notify-rm-watch)
- (file-notify-valid-p . tramp-handle-file-notify-valid-p)
- (file-ownership-preserved-p . ignore)
- (file-readable-p . tramp-gvfs-handle-file-readable-p)
- (file-regular-p . tramp-handle-file-regular-p)
- (file-remote-p . tramp-handle-file-remote-p)
- (file-selinux-context . tramp-handle-file-selinux-context)
- (file-symlink-p . tramp-handle-file-symlink-p)
- (file-system-info . tramp-gvfs-handle-file-system-info)
- (file-truename . tramp-handle-file-truename)
- (file-writable-p . tramp-handle-file-writable-p)
- (find-backup-file-name . tramp-handle-find-backup-file-name)
- ;; `get-file-buffer' performed by default handler.
- (insert-directory . tramp-handle-insert-directory)
- (insert-file-contents . tramp-handle-insert-file-contents)
- (load . tramp-handle-load)
- (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
- (make-directory . tramp-gvfs-handle-make-directory)
- (make-directory-internal . ignore)
- (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
- (make-process . ignore)
- (make-symbolic-link . tramp-handle-make-symbolic-link)
- (process-file . ignore)
- (rename-file . tramp-gvfs-handle-rename-file)
- (set-file-acl . ignore)
- (set-file-modes . ignore)
- (set-file-selinux-context . ignore)
- (set-file-times . ignore)
- (set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
- (shell-command . ignore)
- (start-file-process . ignore)
- (substitute-in-file-name . tramp-handle-substitute-in-file-name)
- (temporary-file-directory . tramp-handle-temporary-file-directory)
- (tramp-set-file-uid-gid . ignore)
- (unhandled-file-name-directory . ignore)
- (vc-registered . ignore)
- (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
- (write-region . tramp-handle-write-region))
- "Alist of handler functions for Tramp GVFS method.
-Operations not mentioned here will be handled by the default Emacs
primitives.")
-
-;; It must be a `defsubst' in order to push the whole code into
-;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
-;;;###tramp-autoload
-(defsubst tramp-gvfs-file-name-p (filename)
- "Check if it's a filename handled by the GVFS daemon."
- (and (tramp-tramp-file-p filename)
- (let ((method
- (tramp-file-name-method (tramp-dissect-file-name filename))))
- (and (stringp method) (member method tramp-gvfs-methods)))))
-
-;;;###tramp-autoload
-(defun tramp-gvfs-file-name-handler (operation &rest args)
- "Invoke the GVFS related OPERATION.
-First arg specifies the OPERATION, second arg is a list of arguments to
-pass to the OPERATION."
- (unless tramp-gvfs-enabled
- (tramp-user-error nil "Package `tramp-gvfs' not supported"))
- (let ((fn (assoc operation tramp-gvfs-file-name-handler-alist)))
- (if fn
- (save-match-data (apply (cdr fn) args))
- (tramp-run-real-handler operation args))))
-
-;;;###tramp-autoload
-(when (featurep 'dbusbind)
- (tramp--with-startup
- (tramp-register-foreign-file-name-handler
- #'tramp-gvfs-file-name-p #'tramp-gvfs-file-name-handler)))
-
-
-;; D-Bus helper function.
-
-(defun tramp-gvfs-dbus-string-to-byte-array (string)
- "Like `dbus-string-to-byte-array' but add trailing \\0 if needed."
- (dbus-string-to-byte-array
- (if (string-match "^(aya{sv})" tramp-gvfs-mountlocation-signature)
- (concat string (string 0)) string)))
-
-(defun tramp-gvfs-dbus-byte-array-to-string (byte-array)
- "Like `dbus-byte-array-to-string' but remove trailing \\0 if exists.
-Return nil for null BYTE-ARRAY."
- ;; The byte array could be a variant. Take care.
- (let ((byte-array
- (if (and (consp byte-array) (atom (car byte-array)))
- byte-array (car byte-array))))
- (and byte-array
- (dbus-byte-array-to-string
- (if (and (consp byte-array) (zerop (car (last byte-array))))
- (butlast byte-array) byte-array)))))
-
-(defun tramp-gvfs-stringify-dbus-message (message)
- "Convert a D-Bus message into readable UTF8 strings, used for traces."
- (cond
- ((and (consp message) (characterp (car message)))
- (format "%S" (tramp-gvfs-dbus-byte-array-to-string message)))
- ((and (consp message) (atom (cdr message)))
- (cons (tramp-gvfs-stringify-dbus-message (car message))
- (tramp-gvfs-stringify-dbus-message (cdr message))))
- ((consp message)
- (mapcar #'tramp-gvfs-stringify-dbus-message message))
- ((stringp message)
- (format "%S" message))
- (t message)))
-
-(defun tramp-dbus-function (vec func args)
- "Apply a D-Bus function FUNC from dbus.el.
-The call will be traced by Tramp with trace level 6."
- (let (result)
- (tramp-message vec 6 "%s" (cons func args))
- (setq result (apply func args))
- (tramp-message vec 6 "%s" result(tramp-gvfs-stringify-dbus-message result))
- result))
-
-(defmacro with-tramp-dbus-call-method
- (vec synchronous bus service path interface method &rest args)
- "Apply a D-Bus call on bus BUS.
-
-If SYNCHRONOUS is non-nil, the call is synchronously. Otherwise,
-it is an asynchronous call, with `ignore' as callback function.
-
-The other arguments have the same meaning as with `dbus-call-method'
-or `dbus-call-method-asynchronously'."
- `(let ((func (if ,synchronous
- #'dbus-call-method #'dbus-call-method-asynchronously))
- (args (append (list ,bus ,service ,path ,interface ,method)
- (if ,synchronous (list ,@args) (list 'ignore ,@args)))))
- (tramp-dbus-function ,vec func args)))
-
-(put 'with-tramp-dbus-call-method 'lisp-indent-function 2)
-(put 'with-tramp-dbus-call-method 'edebug-form-spec '(form symbolp body))
-(font-lock-add-keywords 'emacs-lisp-mode
'("\\<with-tramp-dbus-call-method\\>"))
-
-(defmacro with-tramp-dbus-get-all-properties
- (vec bus service path interface)
- "Return all properties of INTERFACE.
-The call will be traced by Tramp with trace level 6."
- ;; Check, that interface exists at object path. Retrieve properties.
- `(when (member
- ,interface
- (tramp-dbus-function
- ,vec #'dbus-introspect-get-interface-names
- (list ,bus ,service ,path)))
- (tramp-dbus-function
- ,vec #'dbus-get-all-properties (list ,bus ,service ,path ,interface))))
-
-(put 'with-tramp-dbus-get-all-properties 'lisp-indent-function 1)
-(put 'with-tramp-dbus-get-all-properties 'edebug-form-spec '(form symbolp
body))
-(font-lock-add-keywords 'emacs-lisp-mode
'("\\<with-tramp-dbus-get-all-properties\\>"))
-
-(defvar tramp-gvfs-dbus-event-vector nil
- "Current Tramp file name to be used, as vector.
-It is needed when D-Bus signals or errors arrive, because there
-is no information where to trace the message.")
-
-(defun tramp-gvfs-dbus-event-error (event err)
- "Called when a D-Bus error message arrives, see
`dbus-event-error-functions'."
- (when tramp-gvfs-dbus-event-vector
- (tramp-message tramp-gvfs-dbus-event-vector 6 "%S" event)
- (tramp-error tramp-gvfs-dbus-event-vector 'file-error "%s" (cadr err))))
-
-;; `dbus-event-error-hooks' has been renamed to
-;; `dbus-event-error-functions' in Emacs 24.3.
-(add-hook
- (if (boundp 'dbus-event-error-functions)
- 'dbus-event-error-functions 'dbus-event-error-hooks)
- #'tramp-gvfs-dbus-event-error)
-
-
-;; File name primitives.
-
-(defun tramp-gvfs-do-copy-or-rename-file
- (op filename newname &optional ok-if-already-exists keep-date
- preserve-uid-gid preserve-extended-attributes)
- "Copy or rename a remote file.
-OP must be `copy' or `rename' and indicates the operation to perform.
-FILENAME specifies the file to copy or rename, NEWNAME is the name of
-the new file (for copy) or the new name of the file (for rename).
-OK-IF-ALREADY-EXISTS means don't barf if NEWNAME exists already.
-KEEP-DATE means to make sure that NEWNAME has the same timestamp
-as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep
-the uid and gid if both files are on the same host.
-PRESERVE-EXTENDED-ATTRIBUTES is ignored.
-
-This function is invoked by `tramp-gvfs-handle-copy-file' and
-`tramp-gvfs-handle-rename-file'. It is an error if OP is neither
-of `copy' and `rename'. FILENAME and NEWNAME must be absolute
-file names."
- (unless (memq op '(copy rename))
- (error "Unknown operation `%s', must be `copy' or `rename'" op))
-
- (setq filename (file-truename filename))
- (if (file-directory-p filename)
- (progn
- (copy-directory filename newname keep-date t)
- (when (eq op 'rename) (delete-directory filename 'recursive)))
-
- (let ((t1 (tramp-tramp-file-p filename))
- (t2 (tramp-tramp-file-p newname))
- (equal-remote (tramp-equal-remote filename newname))
- (gvfs-operation (if (eq op 'copy) "gvfs-copy" "gvfs-move"))
- (msg-operation (if (eq op 'copy) "Copying" "Renaming")))
-
- (with-parsed-tramp-file-name (if t1 filename newname) nil
- (when (and (not ok-if-already-exists) (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
-
- (if (or (and equal-remote
- (tramp-get-connection-property v "direct-copy-failed" nil))
- (and t1 (not (tramp-gvfs-file-name-p filename)))
- (and t2 (not (tramp-gvfs-file-name-p newname))))
-
- ;; We cannot copy or rename directly.
- (let ((tmpfile (tramp-compat-make-temp-file filename)))
- (if (eq op 'copy)
- (copy-file
- filename tmpfile t keep-date preserve-uid-gid
- preserve-extended-attributes)
- (rename-file filename tmpfile t))
- (rename-file tmpfile newname ok-if-already-exists))
-
- ;; Direct action.
- (with-tramp-progress-reporter
- v 0 (format "%s %s to %s" msg-operation filename newname)
- (unless
- (apply
- #'tramp-gvfs-send-command v gvfs-operation
- (append
- (and (eq op 'copy) (or keep-date preserve-uid-gid)
- '("--preserve"))
- (list
- (tramp-gvfs-url-file-name filename)
- (tramp-gvfs-url-file-name newname))))
-
- (if (or (not equal-remote)
- (and equal-remote
- (tramp-get-connection-property
- v "direct-copy-failed" nil)))
- ;; Propagate the error.
- (with-current-buffer (tramp-get-connection-buffer v)
- (goto-char (point-min))
- (tramp-error-with-buffer
- nil v 'file-error
- "%s failed, see buffer `%s' for details."
- msg-operation (buffer-name)))
-
- ;; Some WebDAV server, like the one from QNAP, do not
- ;; support direct copy/move. Try a fallback.
- (tramp-set-connection-property v "direct-copy-failed" t)
- (tramp-gvfs-do-copy-or-rename-file
- op filename newname ok-if-already-exists keep-date
- preserve-uid-gid preserve-extended-attributes))))
-
- (when (and t1 (eq op 'rename))
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v (file-name-directory localname))
- (tramp-flush-file-properties v localname)))
-
- (when t2
- (with-parsed-tramp-file-name newname nil
- (tramp-flush-file-properties v (file-name-directory localname))
- (tramp-flush-file-properties v localname))))))))
-
-(defun tramp-gvfs-handle-copy-file
- (filename newname &optional ok-if-already-exists keep-date
- preserve-uid-gid preserve-extended-attributes)
- "Like `copy-file' for Tramp files."
- (setq filename (expand-file-name filename))
- (setq newname (expand-file-name newname))
- ;; At least one file a Tramp file?
- (if (or (tramp-tramp-file-p filename)
- (tramp-tramp-file-p newname))
- (tramp-gvfs-do-copy-or-rename-file
- 'copy filename newname ok-if-already-exists keep-date
- preserve-uid-gid preserve-extended-attributes)
- (tramp-run-real-handler
- 'copy-file
- (list filename newname ok-if-already-exists keep-date
- preserve-uid-gid preserve-extended-attributes))))
-
-(defun tramp-gvfs-handle-delete-directory (directory &optional recursive trash)
- "Like `delete-directory' for Tramp files."
- (with-parsed-tramp-file-name directory nil
- (if (and recursive (not (file-symlink-p directory)))
- (mapc (lambda (file)
- (if (eq t (tramp-compat-file-attribute-type
- (file-attributes file)))
- (delete-directory file recursive trash)
- (delete-file file trash)))
- (directory-files
- directory 'full directory-files-no-dot-files-regexp))
- (when (directory-files directory nil directory-files-no-dot-files-regexp)
- (tramp-error
- v 'file-error "Couldn't delete non-empty %s" directory)))
-
- (tramp-flush-file-properties v (file-name-directory localname))
- (tramp-flush-directory-properties v localname)
- (unless
- (tramp-gvfs-send-command
- v (if (and trash delete-by-moving-to-trash) "gvfs-trash" "gvfs-rm")
- (tramp-gvfs-url-file-name directory))
- ;; Propagate the error.
- (with-current-buffer (tramp-get-connection-buffer v)
- (goto-char (point-min))
- (tramp-error-with-buffer
- nil v 'file-error "Couldn't delete %s" directory)))))
-
-(defun tramp-gvfs-handle-delete-file (filename &optional trash)
- "Like `delete-file' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v (file-name-directory localname))
- (tramp-flush-file-properties v localname)
- (unless
- (tramp-gvfs-send-command
- v (if (and trash delete-by-moving-to-trash) "gvfs-trash" "gvfs-rm")
- (tramp-gvfs-url-file-name filename))
- ;; Propagate the error.
- (with-current-buffer (tramp-get-connection-buffer v)
- (goto-char (point-min))
- (tramp-error-with-buffer
- nil v 'file-error "Couldn't delete %s" filename)))))
-
-(defun tramp-gvfs-handle-expand-file-name (name &optional dir)
- "Like `expand-file-name' for Tramp files."
- ;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
- (setq dir (or dir default-directory "/"))
- ;; Handle empty NAME.
- (when (zerop (length name)) (setq name "."))
- ;; Unless NAME is absolute, concat DIR and NAME.
- (unless (file-name-absolute-p name)
- (setq name (concat (file-name-as-directory dir) name)))
- ;; If NAME is not a Tramp file, run the real handler.
- (if (not (tramp-tramp-file-p name))
- (tramp-run-real-handler #'expand-file-name (list name nil))
- ;; Dissect NAME.
- (with-parsed-tramp-file-name name nil
- ;; If there is a default location, expand tilde.
- (when (string-match "\\`\\(~\\)\\(/\\|\\'\\)" localname)
- (save-match-data
- (tramp-gvfs-maybe-open-connection
- (make-tramp-file-name
- :method method :user user :domain domain
- :host host :port port :localname "/" :hop hop)))
- (setq localname
- (replace-match
- (tramp-get-connection-property v "default-location" "~")
- nil t localname 1)))
- ;; Tilde expansion is not possible.
- (when (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
- (tramp-error
- v 'file-error
- "Cannot expand tilde in file `%s'" name))
- (unless (tramp-run-real-handler #'file-name-absolute-p (list localname))
- (setq localname (concat "/" localname)))
- ;; We do not pass "/..".
- (if (string-match-p "^\\(afp\\|davs?\\|smb\\)$" method)
- (when (string-match "^/[^/]+\\(/\\.\\./?\\)" localname)
- (setq localname (replace-match "/" t t localname 1)))
- (when (string-match "^/\\.\\./?" localname)
- (setq localname (replace-match "/" t t localname))))
- ;; There might be a double slash. Remove this.
- (while (string-match "//" localname)
- (setq localname (replace-match "/" t t localname)))
- ;; No tilde characters in file name, do normal
- ;; `expand-file-name' (this does "/./" and "/../").
- (tramp-make-tramp-file-name
- v (tramp-run-real-handler #'expand-file-name (list localname))))))
-
-(defun tramp-gvfs-get-directory-attributes (directory)
- "Return GVFS attributes association list of all files in DIRECTORY."
- (ignore-errors
- ;; Don't modify `last-coding-system-used' by accident.
- (let ((last-coding-system-used last-coding-system-used)
- result)
- (with-parsed-tramp-file-name directory nil
- (with-tramp-file-property v localname "directory-attributes"
- (tramp-message v 5 "directory gvfs attributes: %s" localname)
- ;; Send command.
- (tramp-gvfs-send-command
- v "gvfs-ls" "-h" "-n" "-a"
- (mapconcat #'identity tramp-gvfs-file-attributes ",")
- (tramp-gvfs-url-file-name directory))
- ;; Parse output.
- (with-current-buffer (tramp-get-connection-buffer v)
- (goto-char (point-min))
- (while (looking-at
- (concat "^\\(.+\\)[[:blank:]]"
- "\\([[:digit:]]+\\)[[:blank:]]"
- "(\\(.+?\\))"
- tramp-gvfs-file-attributes-with-gvfs-ls-regexp))
- (let ((item (list (cons "type" (match-string 3))
- (cons "standard::size" (match-string 2))
- (cons "name" (match-string 1)))))
- (goto-char (1+ (match-end 3)))
- (while (looking-at
- (concat
- tramp-gvfs-file-attributes-with-gvfs-ls-regexp
- "\\(" tramp-gvfs-file-attributes-with-gvfs-ls-regexp
- "\\|" "$" "\\)"))
- (push (cons (match-string 1) (match-string 2)) item)
- (goto-char (match-end 2)))
- ;; Add display name as head.
- (push
- (cons (cdr (or (assoc "standard::display-name" item)
- (assoc "name" item)))
- (nreverse item))
- result))
- (forward-line)))
- result)))))
-
-(defun tramp-gvfs-get-root-attributes (filename &optional file-system)
- "Return GVFS attributes association list of FILENAME.
-If FILE-SYSTEM is non-nil, return file system attributes."
- (ignore-errors
- ;; Don't modify `last-coding-system-used' by accident.
- (let ((last-coding-system-used last-coding-system-used)
- result)
- (with-parsed-tramp-file-name filename nil
- (with-tramp-file-property
- v localname
- (if file-system "file-system-attributes" "file-attributes")
- (tramp-message
- v 5 "file%s gvfs attributes: %s"
- (if file-system " system" "") localname)
- ;; Send command.
- (if file-system
- (tramp-gvfs-send-command
- v "gvfs-info" "--filesystem" (tramp-gvfs-url-file-name filename))
- (tramp-gvfs-send-command
- v "gvfs-info" (tramp-gvfs-url-file-name filename)))
- ;; Parse output.
- (with-current-buffer (tramp-get-connection-buffer v)
- (goto-char (point-min))
- (while (re-search-forward
- (if file-system
- tramp-gvfs-file-system-attributes-regexp
- tramp-gvfs-file-attributes-with-gvfs-info-regexp)
- nil t)
- (push (cons (match-string 1) (match-string 2)) result))
- result))))))
-
-(defun tramp-gvfs-get-file-attributes (filename)
- "Return GVFS attributes association list of FILENAME."
- (setq filename (directory-file-name (expand-file-name filename)))
- (with-parsed-tramp-file-name filename nil
- (setq localname (tramp-compat-file-name-unquote localname))
- (if (or (and (string-match-p "^\\(afp\\|davs?\\|smb\\)$" method)
- (string-match-p "^/?\\([^/]+\\)$" localname))
- (string-equal localname "/"))
- (tramp-gvfs-get-root-attributes filename)
- (assoc
- (file-name-nondirectory filename)
- (tramp-gvfs-get-directory-attributes (file-name-directory filename))))))
-
-(defun tramp-gvfs-handle-file-attributes (filename &optional id-format)
- "Like `file-attributes' for Tramp files."
- (unless id-format (setq id-format 'integer))
- (ignore-errors
- (let ((attributes (tramp-gvfs-get-file-attributes filename))
- dirp res-symlink-target res-numlinks res-uid res-gid res-access
- res-mod res-change res-size res-filemodes res-inode res-device)
- (when attributes
- ;; ... directory or symlink
- (setq dirp (if (equal "directory" (cdr (assoc "type" attributes))) t))
- (setq res-symlink-target
- (cdr (assoc "standard::symlink-target" attributes)))
- (when (stringp res-symlink-target)
- (setq res-symlink-target
- ;; Parse unibyte codes "\xNN". We assume they are
- ;; non-ASCII codepoints in the range #x80 through #xff.
- ;; Convert them to multibyte.
- (decode-coding-string
- (replace-regexp-in-string
- "\\\\x\\([[:xdigit:]]\\{2\\}\\)"
- (lambda (x)
- (unibyte-string (string-to-number (match-string 1 x) 16)))
- res-symlink-target)
- 'utf-8)))
- ;; ... number links
- (setq res-numlinks
- (string-to-number
- (or (cdr (assoc "unix::nlink" attributes)) "0")))
- ;; ... uid and gid
- (setq res-uid
- (if (eq id-format 'integer)
- (string-to-number
- (or (cdr (assoc "unix::uid" attributes))
- (eval-when-compile
- (format "%s" tramp-unknown-id-integer))))
- (or (cdr (assoc "owner::user" attributes))
- (cdr (assoc "unix::uid" attributes))
- tramp-unknown-id-string)))
- (setq res-gid
- (if (eq id-format 'integer)
- (string-to-number
- (or (cdr (assoc "unix::gid" attributes))
- (eval-when-compile
- (format "%s" tramp-unknown-id-integer))))
- (or (cdr (assoc "owner::group" attributes))
- (cdr (assoc "unix::gid" attributes))
- tramp-unknown-id-string)))
- ;; ... last access, modification and change time
- (setq res-access
- (seconds-to-time
- (string-to-number
- (or (cdr (assoc "time::access" attributes)) "0"))))
- (setq res-mod
- (seconds-to-time
- (string-to-number
- (or (cdr (assoc "time::modified" attributes)) "0"))))
- (setq res-change
- (seconds-to-time
- (string-to-number
- (or (cdr (assoc "time::changed" attributes)) "0"))))
- ;; ... size
- (setq res-size
- (string-to-number
- (or (cdr (assoc "standard::size" attributes)) "0")))
- ;; ... file mode flags
- (setq res-filemodes
- (let ((n (cdr (assoc "unix::mode" attributes))))
- (if n
- (tramp-file-mode-from-int (string-to-number n))
- (format
- "%s%s%s%s------"
- (if dirp "d" (if res-symlink-target "l" "-"))
- (if (equal (cdr (assoc "access::can-read" attributes))
- "FALSE")
- "-" "r")
- (if (equal (cdr (assoc "access::can-write" attributes))
- "FALSE")
- "-" "w")
- (if (equal (cdr (assoc "access::can-execute" attributes))
- "FALSE")
- "-" "x")))))
- ;; ... inode and device
- (setq res-inode
- (let ((n (cdr (assoc "unix::inode" attributes))))
- (if n
- (string-to-number n)
- (tramp-get-inode (tramp-dissect-file-name filename)))))
- (setq res-device
- (let ((n (cdr (assoc "unix::device" attributes))))
- (if n
- (string-to-number n)
- (tramp-get-device (tramp-dissect-file-name filename)))))
-
- ;; Return data gathered.
- (list
- ;; 0. t for directory, string (name linked to) for
- ;; symbolic link, or nil.
- (or dirp res-symlink-target)
- ;; 1. Number of links to file.
- res-numlinks
- ;; 2. File uid.
- res-uid
- ;; 3. File gid.
- res-gid
- ;; 4. Last access time, as a list of integers.
- ;; 5. Last modification time, likewise.
- ;; 6. Last status change time, likewise.
- res-access res-mod res-change
- ;; 7. Size in bytes (-1, if number is out of range).
- res-size
- ;; 8. File modes.
- res-filemodes
- ;; 9. t if file's gid would change if file were deleted
- ;; and recreated.
- nil
- ;; 10. Inode number.
- res-inode
- ;; 11. Device number.
- res-device
- )))))
-
-(defun tramp-gvfs-handle-file-executable-p (filename)
- "Like `file-executable-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (with-tramp-file-property v localname "file-executable-p"
- (and (file-exists-p filename)
- (tramp-check-cached-permissions v ?x)))))
-
-(defun tramp-gvfs-handle-file-name-all-completions (filename directory)
- "Like `file-name-all-completions' for Tramp files."
- (unless (string-match-p "/" filename)
- (all-completions
- filename
- (with-parsed-tramp-file-name (expand-file-name directory) nil
- (with-tramp-file-property v localname "file-name-all-completions"
- (let ((result '("./" "../")))
- ;; Get a list of directories and files.
- (dolist (item (tramp-gvfs-get-directory-attributes directory) result)
- (if (string-equal (cdr (assoc "type" item)) "directory")
- (push (file-name-as-directory (car item)) result)
- (push (car item) result)))))))))
-
-(defun tramp-gvfs-handle-file-notify-add-watch (file-name flags _callback)
- "Like `file-notify-add-watch' for Tramp files."
- (setq file-name (expand-file-name file-name))
- (with-parsed-tramp-file-name file-name nil
- ;; TODO: We cannot watch directories, because `gio monitor' is not
- ;; supported for gvfs-mounted directories. However,
- ;; `file-notify-add-watch' uses directories.
- (when (or (not (tramp-gvfs-gio-tool-p v)) (file-directory-p file-name))
- (tramp-error
- v 'file-notify-error "Monitoring not supported for `%s'" file-name))
- (let* ((default-directory (file-name-directory file-name))
- (events
- (cond
- ((and (memq 'change flags) (memq 'attribute-change flags))
- '(created changed changes-done-hint moved deleted
- attribute-changed))
- ((memq 'change flags)
- '(created changed changes-done-hint moved deleted))
- ((memq 'attribute-change flags) '(attribute-changed))))
- (p (apply
- #'start-process
- "gvfs-monitor" (generate-new-buffer " *gvfs-monitor*")
- `("gio" "monitor" ,(tramp-gvfs-url-file-name file-name)))))
- (if (not (processp p))
- (tramp-error
- v 'file-notify-error "Monitoring not supported for `%s'" file-name)
- (tramp-message
- v 6 "Run `%s', %S" (mapconcat #'identity (process-command p) " ") p)
- (process-put p 'vector v)
- (process-put p 'events events)
- (process-put p 'watch-name localname)
- (process-put p 'adjust-window-size-function #'ignore)
- (set-process-query-on-exit-flag p nil)
- (set-process-filter p #'tramp-gvfs-monitor-process-filter)
- (set-process-sentinel p #'tramp-file-notify-process-sentinel)
- ;; There might be an error if the monitor is not supported.
- ;; Give the filter a chance to read the output.
- (while (tramp-accept-process-output p 0))
- (unless (process-live-p p)
- (tramp-error
- p 'file-notify-error "Monitoring not supported for `%s'" file-name))
- p))))
-
-(defun tramp-gvfs-monitor-process-filter (proc string)
- "Read output from \"gvfs-monitor-file\" and add corresponding \
-file-notify events."
- (let* ((events (process-get proc 'events))
- (rest-string (process-get proc 'rest-string))
- (dd (with-current-buffer (process-buffer proc) default-directory))
- (ddu (regexp-quote (tramp-gvfs-url-file-name dd))))
- (when rest-string
- (tramp-message proc 10 "Previous string:\n%s" rest-string))
- (tramp-message proc 6 "%S\n%s" proc string)
- (setq string (concat rest-string string)
- ;; Fix action names.
- string (replace-regexp-in-string
- "attributes changed" "attribute-changed" string)
- string (replace-regexp-in-string
- "changes done" "changes-done-hint" string)
- string (replace-regexp-in-string
- "renamed to" "moved" string))
- ;; https://bugs.launchpad.net/bugs/1742946
- (when
- (string-match-p "Monitoring not supported\\|No locations given" string)
- (delete-process proc))
-
- (while (string-match
- (eval-when-compile
- (concat "^.+:"
- "[[:space:]]\\(.+\\):"
- "[[:space:]]" (regexp-opt tramp-gio-events t)
- "\\([[:space:]]\\(.+\\)\\)?$"))
- string)
-
- (let ((file (match-string 1 string))
- (file1 (match-string 4 string))
- (action (intern-soft (match-string 2 string))))
- (setq string (replace-match "" nil nil string))
- ;; File names are returned as URL paths. We must convert them.
- (when (string-match ddu file)
- (setq file (replace-match dd nil nil file)))
- (while (string-match-p "%\\([0-9A-F]\\{2\\}\\)" file)
- (setq file (url-unhex-string file)))
- (when (string-match ddu (or file1 ""))
- (setq file1 (replace-match dd nil nil file1)))
- (while (string-match-p "%\\([0-9A-F]\\{2\\}\\)" (or file1 ""))
- (setq file1 (url-unhex-string file1)))
- ;; Remove watch when file or directory to be watched is deleted.
- (when (and (member action '(moved deleted))
- (string-equal file (process-get proc 'watch-name)))
- (delete-process proc))
- ;; Usually, we would add an Emacs event now. Unfortunately,
- ;; `unread-command-events' does not accept several events at
- ;; once. Therefore, we apply the callback directly.
- (when (member action events)
- (tramp-compat-funcall
- 'file-notify-callback (list proc action file file1)))))
-
- ;; Save rest of the string.
- (when (zerop (length string)) (setq string nil))
- (when string (tramp-message proc 10 "Rest string:\n%s" string))
- (process-put proc 'rest-string string)))
-
-(defun tramp-gvfs-handle-file-readable-p (filename)
- "Like `file-readable-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (with-tramp-file-property v localname "file-readable-p"
- (and (file-exists-p filename)
- (or (tramp-check-cached-permissions v ?r)
- ;; If the user is different from what we guess to be
- ;; the user, we don't know. Let's check, whether
- ;; access is restricted explicitly.
- (and (/= (tramp-gvfs-get-remote-uid v 'integer)
- (tramp-compat-file-attribute-user-id
- (file-attributes filename 'integer)))
- (not
- (string-equal
- "FALSE"
- (cdr (assoc
- "access::can-read"
- (tramp-gvfs-get-file-attributes filename)))))))))))
-
-(defun tramp-gvfs-handle-file-system-info (filename)
- "Like `file-system-info' for Tramp files."
- (setq filename (directory-file-name (expand-file-name filename)))
- (with-parsed-tramp-file-name filename nil
- ;; We don't use cached values.
- (tramp-flush-file-property v localname "file-system-attributes")
- (let* ((attr (tramp-gvfs-get-root-attributes filename 'file-system))
- (size (cdr (assoc "filesystem::size" attr)))
- (used (cdr (assoc "filesystem::used" attr)))
- (free (cdr (assoc "filesystem::free" attr))))
- (when (and (stringp size) (stringp used) (stringp free))
- (list (string-to-number size)
- (- (string-to-number size) (string-to-number used))
- (string-to-number free))))))
-
-(defun tramp-gvfs-handle-make-directory (dir &optional parents)
- "Like `make-directory' for Tramp files."
- (setq dir (directory-file-name (expand-file-name dir)))
- (with-parsed-tramp-file-name dir nil
- (tramp-flush-file-properties v (file-name-directory localname))
- (tramp-flush-directory-properties v localname)
- (save-match-data
- (let ((ldir (file-name-directory dir)))
- ;; Make missing directory parts. "gvfs-mkdir -p ..." does not
- ;; work robust.
- (when (and parents (not (file-directory-p ldir)))
- (make-directory ldir parents))
- ;; Just do it.
- (unless (or (tramp-gvfs-send-command
- v "gvfs-mkdir" (tramp-gvfs-url-file-name dir))
- (and parents (file-directory-p dir)))
- (tramp-error v 'file-error "Couldn't make directory %s" dir))))))
-
-(defun tramp-gvfs-handle-rename-file
- (filename newname &optional ok-if-already-exists)
- "Like `rename-file' for Tramp files."
- ;; Check if both files are local -- invoke normal rename-file.
- ;; Otherwise, use Tramp from local system.
- (setq filename (expand-file-name filename))
- (setq newname (expand-file-name newname))
- ;; At least one file a Tramp file?
- (if (or (tramp-tramp-file-p filename)
- (tramp-tramp-file-p newname))
- (tramp-gvfs-do-copy-or-rename-file
- 'rename filename newname ok-if-already-exists
- 'keep-date 'preserve-uid-gid)
- (tramp-run-real-handler
- #'rename-file (list filename newname ok-if-already-exists))))
-
-
-;; File name conversions.
-
-(defun tramp-gvfs-url-file-name (filename)
- "Return FILENAME in URL syntax."
- ;; "/" must NOT be hexified.
- (setq filename (tramp-compat-file-name-unquote filename))
- (let ((url-unreserved-chars (cons ?/ url-unreserved-chars))
- result)
- (setq
- result
- (url-recreate-url
- (if (tramp-tramp-file-p filename)
- (with-parsed-tramp-file-name filename nil
- (when (string-equal "gdrive" method)
- (setq method "google-drive"))
- (when (string-equal "nextcloud" method)
- (setq method "davs"
- localname
- (concat (tramp-gvfs-get-remote-prefix v) localname)))
- (when (and user domain)
- (setq user (concat domain ";" user)))
- (url-parse-make-urlobj
- method (and user (url-hexify-string user))
- nil (and host (url-hexify-string host))
- (if (stringp port) (string-to-number port) port)
- (and localname (url-hexify-string localname)) nil nil t))
- (url-parse-make-urlobj
- "file" nil nil nil nil
- (url-hexify-string (file-truename filename)) nil nil t))))
- (when (tramp-tramp-file-p filename)
- (with-parsed-tramp-file-name filename nil
- (tramp-message v 10 "remote file `%s' is URL `%s'" filename result)))
- result))
-
-(defun tramp-gvfs-object-path (filename)
- "Create a D-Bus object path from FILENAME."
- (expand-file-name (dbus-escape-as-identifier filename)
tramp-gvfs-path-tramp))
-
-(defun tramp-gvfs-file-name (object-path)
- "Retrieve file name from D-Bus OBJECT-PATH."
- (dbus-unescape-from-identifier
- (replace-regexp-in-string "^.*/\\([^/]+\\)$" "\\1" object-path)))
-
-
-;; D-Bus GVFS functions.
-
-(defun tramp-gvfs-handler-askpassword (message user domain flags)
- "Implementation for the \"org.gtk.vfs.MountOperation.askPassword\" method."
- (let* ((filename
- (tramp-gvfs-file-name (dbus-event-path-name last-input-event)))
- (pw-prompt
- (format
- "%s for %s "
- (if (string-match "\\([pP]assword\\|[pP]assphrase\\)" message)
- (capitalize (match-string 1 message))
- "Password")
- filename))
- password)
-
- (condition-case nil
- (with-parsed-tramp-file-name filename l
- (when (and (zerop (length user))
- (not
- (zerop (logand flags tramp-gvfs-password-need-username))))
- (setq user (read-string "User name: ")))
- (when (and (zerop (length domain))
- (not
- (zerop (logand flags tramp-gvfs-password-need-domain))))
- (setq domain (read-string "Domain name: ")))
-
- (tramp-message l 6 "%S %S %S %d" message user domain flags)
- (unless (tramp-get-connection-property l "first-password-request" nil)
- (tramp-clear-passwd l))
-
- (setq password (tramp-read-passwd
- (tramp-get-connection-process l) pw-prompt))
-
- ;; Return result.
- (if (stringp password)
- (list
- t ;; password handled.
- nil ;; no abort of D-Bus.
- password
- (tramp-file-name-user l)
- domain
- nil ;; not anonymous.
- 0) ;; no password save.
- ;; No password provided.
- (list nil t "" (tramp-file-name-user l) domain nil 0)))
-
- ;; When QUIT is raised, we shall return this information to D-Bus.
- (quit (list nil t "" "" "" nil 0)))))
-
-(defun tramp-gvfs-handler-askquestion (message choices)
- "Implementation for the \"org.gtk.vfs.MountOperation.askQuestion\" method."
- (save-window-excursion
- (let ((enable-recursive-minibuffers t)
- (use-dialog-box (and use-dialog-box (null noninteractive)))
- result)
-
- (with-parsed-tramp-file-name
- (tramp-gvfs-file-name (dbus-event-path-name last-input-event)) nil
- (tramp-message v 6 "%S %S" message choices)
-
- (setq result
- (condition-case nil
- (list
- t ;; handled.
- nil ;; no abort of D-Bus.
- (with-tramp-connection-property
- (tramp-get-connection-process v) message
- ;; In theory, there can be several choices.
- ;; Until now, there is only the question whether
- ;; to accept an unknown host signature or certificate.
- (with-temp-buffer
- ;; Preserve message for `progress-reporter'.
- (with-temp-message ""
- (insert message)
- (goto-char (point-max))
- (if noninteractive
- (message "%s" message)
- (pop-to-buffer (current-buffer)))
- (if (yes-or-no-p
- (concat
- (buffer-substring
- (line-beginning-position) (point))
- " "))
- 0 1)))))
-
- ;; When QUIT is raised, we shall return this
- ;; information to D-Bus.
- (quit (list nil t 1))))
-
- (tramp-message v 6 "%s" result)
-
- ;; When the choice is "no", we set a dummy fuse-mountpoint in
- ;; order to leave the timeout.
- (unless (zerop (cl-caddr result))
- (tramp-set-file-property v "/" "fuse-mountpoint" "/"))
-
- result))))
-
-(defun tramp-gvfs-handler-mounted-unmounted (mount-info)
- "Signal handler for the \"org.gtk.vfs.MountTracker.mounted\" and
-\"org.gtk.vfs.MountTracker.unmounted\" signals."
- (ignore-errors
- (let ((signal-name (dbus-event-member-name last-input-event))
- (elt mount-info))
- ;; Jump over the first elements of the mount info. Since there
- ;; were changes in the entries, we cannot access dedicated
- ;; elements.
- (while (stringp (car elt)) (setq elt (cdr elt)))
- (let* ((fuse-mountpoint (tramp-gvfs-dbus-byte-array-to-string (cadr
elt)))
- (mount-spec (cl-caddr elt))
- (prefix (tramp-gvfs-dbus-byte-array-to-string (car mount-spec)))
- (default-location (tramp-gvfs-dbus-byte-array-to-string
- (cl-cadddr elt)))
- (method (tramp-gvfs-dbus-byte-array-to-string
- (cadr (assoc "type" (cadr mount-spec)))))
- (user (tramp-gvfs-dbus-byte-array-to-string
- (cadr (assoc "user" (cadr mount-spec)))))
- (domain (tramp-gvfs-dbus-byte-array-to-string
- (cadr (assoc "domain" (cadr mount-spec)))))
- (host (tramp-gvfs-dbus-byte-array-to-string
- (cadr (or (assoc "host" (cadr mount-spec))
- (assoc "server" (cadr mount-spec))))))
- (port (tramp-gvfs-dbus-byte-array-to-string
- (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))))))
- (when (string-match "^\\(afp\\|smb\\)" method)
- (setq method (match-string 1 method)))
- (when (and (string-equal "dav" method) (string-equal "true" ssl))
- (setq method "davs"))
- (when (and (string-equal "davs" method)
- (string-match-p
- tramp-gvfs-nextcloud-default-prefix-regexp prefix))
- (setq method "nextcloud"))
- (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)))
- (when (member method tramp-gvfs-methods)
- (with-parsed-tramp-file-name
- (tramp-make-tramp-file-name method user domain host port "") nil
- (tramp-message
- v 6 "%s %s"
- signal-name (tramp-gvfs-stringify-dbus-message mount-info))
- (tramp-flush-file-property v "/" "list-mounts")
- (if (string-equal (downcase signal-name) "unmounted")
- (tramp-flush-file-properties v "/")
- ;; Set mountpoint and location.
- (tramp-set-file-property v "/" "fuse-mountpoint" fuse-mountpoint)
- (tramp-set-connection-property
- v "default-location" default-location))))))))
-
-(when tramp-gvfs-enabled
- (dbus-register-signal
- :session nil tramp-gvfs-path-mounttracker
- tramp-gvfs-interface-mounttracker "mounted"
- #'tramp-gvfs-handler-mounted-unmounted)
- (dbus-register-signal
- :session nil tramp-gvfs-path-mounttracker
- tramp-gvfs-interface-mounttracker "Mounted"
- #'tramp-gvfs-handler-mounted-unmounted)
-
- (dbus-register-signal
- :session nil tramp-gvfs-path-mounttracker
- tramp-gvfs-interface-mounttracker "unmounted"
- #'tramp-gvfs-handler-mounted-unmounted)
- (dbus-register-signal
- :session nil tramp-gvfs-path-mounttracker
- tramp-gvfs-interface-mounttracker "Unmounted"
- #'tramp-gvfs-handler-mounted-unmounted))
-
-(defun tramp-gvfs-connection-mounted-p (vec)
- "Check, whether the location is already mounted."
- (or
- (tramp-get-file-property vec "/" "fuse-mountpoint" nil)
- (catch 'mounted
- (dolist
- (elt
- (with-tramp-file-property vec "/" "list-mounts"
- (with-tramp-dbus-call-method vec t
- :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker
- tramp-gvfs-interface-mounttracker tramp-gvfs-listmounts))
- nil)
- ;; Jump over the first elements of the mount info. Since there
- ;; were changes in the entries, we cannot access dedicated
- ;; elements.
- (while (stringp (car elt)) (setq elt (cdr elt)))
- (let* ((fuse-mountpoint (tramp-gvfs-dbus-byte-array-to-string
- (cadr elt)))
- (mount-spec (cl-caddr elt))
- (prefix (tramp-gvfs-dbus-byte-array-to-string (car mount-spec)))
- (default-location (tramp-gvfs-dbus-byte-array-to-string
- (cl-cadddr elt)))
- (method (tramp-gvfs-dbus-byte-array-to-string
- (cadr (assoc "type" (cadr mount-spec)))))
- (user (tramp-gvfs-dbus-byte-array-to-string
- (cadr (assoc "user" (cadr mount-spec)))))
- (domain (tramp-gvfs-dbus-byte-array-to-string
- (cadr (assoc "domain" (cadr mount-spec)))))
- (host (tramp-gvfs-dbus-byte-array-to-string
- (cadr (or (assoc "host" (cadr mount-spec))
- (assoc "server" (cadr mount-spec))))))
- (port (tramp-gvfs-dbus-byte-array-to-string
- (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)))))
- (share (tramp-gvfs-dbus-byte-array-to-string
- (or
- (cadr (assoc "share" (cadr mount-spec)))
- (cadr (assoc "volume" (cadr mount-spec)))))))
- (when (string-match "^\\(afp\\|smb\\)" method)
- (setq method (match-string 1 method)))
- (when (and (string-equal "dav" method) (string-equal "true" ssl))
- (setq method "davs"))
- (when (and (string-equal "davs" method)
- (string-match-p
- tramp-gvfs-nextcloud-default-prefix-regexp prefix))
- (setq method "nextcloud"))
- (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)))
- (when (and
- (string-equal method (tramp-file-name-method vec))
- (string-equal user (tramp-file-name-user vec))
- (string-equal domain (tramp-file-name-domain vec))
- (string-equal host (tramp-file-name-host vec))
- (string-equal port (tramp-file-name-port vec))
- (string-match-p (concat "^/" (regexp-quote (or share "")))
- (tramp-file-name-unquote-localname vec)))
- ;; Set mountpoint and location.
- (tramp-set-file-property vec "/" "fuse-mountpoint" fuse-mountpoint)
- (tramp-set-connection-property
- vec "default-location" default-location)
- (throw 'mounted t)))))))
-
-(defun tramp-gvfs-unmount (vec)
- "Unmount the object identified by 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))))
- (while (tramp-gvfs-connection-mounted-p vec)
- (read-event nil nil 0.1))
- (tramp-flush-connection-properties vec)
- (tramp-flush-connection-properties (tramp-get-connection-process 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})\"."
- (if (string-match-p "^(aya{sv})" tramp-gvfs-mountlocation-signature)
- (list :dict-entry key
- (list :variant (tramp-gvfs-dbus-string-to-byte-array value)))
- (list :struct key (tramp-gvfs-dbus-string-to-byte-array value))))
-
-(defun tramp-gvfs-mount-spec (vec)
- "Return a mount-spec for \"org.gtk.vfs.MountTracker.mountLocation\"."
- (let* ((method (tramp-file-name-method vec))
- (user (tramp-file-name-user vec))
- (domain (tramp-file-name-domain vec))
- (host (tramp-file-name-host vec))
- (port (tramp-file-name-port vec))
- (localname (tramp-file-name-unquote-localname vec))
- (share (when (string-match "^/?\\([^/]+\\)" localname)
- (match-string 1 localname)))
- (ssl (if (string-match-p "^davs\\|^nextcloud" method) "true" "false"))
- (mount-spec
- `(:array
- ,@(cond
- ((string-equal "smb" method)
- (list (tramp-gvfs-mount-spec-entry "type" "smb-share")
- (tramp-gvfs-mount-spec-entry "server" host)
- (tramp-gvfs-mount-spec-entry "share" share)))
- ((string-match-p "^dav\\|^nextcloud" method)
- (list (tramp-gvfs-mount-spec-entry "type" "dav")
- (tramp-gvfs-mount-spec-entry "host" host)
- (tramp-gvfs-mount-spec-entry "ssl" ssl)))
- ((string-equal "afp" method)
- (list (tramp-gvfs-mount-spec-entry "type" "afp-volume")
- (tramp-gvfs-mount-spec-entry "host" host)
- (tramp-gvfs-mount-spec-entry "volume" share)))
- ((string-equal "gdrive" method)
- (list (tramp-gvfs-mount-spec-entry "type" "google-drive")
- (tramp-gvfs-mount-spec-entry "host" host)))
- ((string-equal "nextcloud" method)
- (list (tramp-gvfs-mount-spec-entry "type" "owncloud")
- (tramp-gvfs-mount-spec-entry "host" host)))
- ((string-match-p "^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
- (list (tramp-gvfs-mount-spec-entry "user" user)))
- ,@(when domain
- (list (tramp-gvfs-mount-spec-entry "domain" domain)))
- ,@(when port
- (list (tramp-gvfs-mount-spec-entry "port" port)))))
- (mount-pref
- (if (and (string-match-p "^dav" method)
- (string-match "^/?[^/]+" localname))
- (match-string 0 localname)
- (tramp-gvfs-get-remote-prefix vec))))
-
- ;; Return.
- `(:struct ,(tramp-gvfs-dbus-string-to-byte-array mount-pref) ,mount-spec)))
-
-
-;; Connection functions.
-
-(defun tramp-gvfs-get-remote-uid (vec id-format)
- "The uid of the remote connection VEC, in ID-FORMAT.
-ID-FORMAT valid values are `string' and `integer'."
- (with-tramp-connection-property vec (format "uid-%s" id-format)
- (let ((user (tramp-file-name-user vec))
- (localname
- (tramp-get-connection-property vec "default-location" nil)))
- (cond
- ((and (equal id-format 'string) user))
- (localname
- (tramp-compat-file-attribute-user-id
- (file-attributes
- (tramp-make-tramp-file-name vec localname) id-format)))
- ((equal id-format 'integer) tramp-unknown-id-integer)
- ((equal id-format 'string) tramp-unknown-id-string)))))
-
-(defun tramp-gvfs-get-remote-gid (vec id-format)
- "The gid of the remote connection VEC, in ID-FORMAT.
-ID-FORMAT valid values are `string' and `integer'."
- (with-tramp-connection-property vec (format "gid-%s" id-format)
- (let ((localname
- (tramp-get-connection-property vec "default-location" nil)))
- (cond
- (localname
- (tramp-compat-file-attribute-group-id
- (file-attributes
- (tramp-make-tramp-file-name vec localname) id-format)))
- ((equal id-format 'integer) tramp-unknown-id-integer)
- ((equal id-format 'string) tramp-unknown-id-string)))))
-
-(defvar tramp-gvfs-get-remote-uid-gid-in-progress nil
- "Indication, that remote uid and gid determination is in progress.")
-
-(defun tramp-gvfs-get-remote-prefix (vec)
- "The prefix of the remote connection VEC.
-This is relevant for GNOME Online Accounts."
- (with-tramp-connection-property vec "prefix"
- ;; Ensure that GNOME Online Accounts are cached.
- (when (member (tramp-file-name-method vec) tramp-goa-methods)
- (tramp-get-goa-accounts vec))
- (tramp-get-connection-property
- (make-tramp-goa-name
- :method (tramp-file-name-method vec)
- :user (tramp-file-name-user vec)
- :host (tramp-file-name-host vec)
- :port (tramp-file-name-port vec))
- "prefix" "/")))
-
-(defun tramp-gvfs-maybe-open-connection (vec)
- "Maybe open a connection VEC.
-Does not do anything if a connection is already open, but re-opens the
-connection if a previous connection has died for some reason."
- ;; We set the file name, in case there are incoming D-Bus signals or
- ;; D-Bus errors.
- (setq tramp-gvfs-dbus-event-vector vec)
-
- ;; For password handling, we need a process bound to the connection
- ;; buffer. Therefore, we create a dummy process. Maybe there is a
- ;; better solution?
- (unless (get-buffer-process (tramp-get-connection-buffer vec))
- (let ((p (make-network-process
- :name (tramp-buffer-name vec)
- :buffer (tramp-get-connection-buffer vec)
- :server t :host 'local :service t :noquery t)))
- (process-put p 'vector vec)
- (set-process-query-on-exit-flag p nil)))
-
- (unless (tramp-gvfs-connection-mounted-p vec)
- (let ((method (tramp-file-name-method vec))
- (user (tramp-file-name-user vec))
- (host (tramp-file-name-host vec))
- (localname (tramp-file-name-unquote-localname vec))
- (object-path
- (tramp-gvfs-object-path (tramp-make-tramp-file-name vec 'noloc))))
-
- (when (and (string-equal method "afp")
- (string-equal localname "/"))
- (tramp-error vec 'file-error "Filename must contain an AFP volume"))
-
- (when (and (string-match-p "davs?" method)
- (string-equal localname "/"))
- (tramp-error vec 'file-error "Filename must contain a WebDAV share"))
-
- (when (and (string-equal method "smb")
- (string-equal localname "/"))
- (tramp-error vec 'file-error "Filename must contain a Windows share"))
-
- (with-tramp-progress-reporter
- vec 3
- (if (zerop (length user))
- (format "Opening connection for %s using %s" host method)
- (format "Opening connection for address@hidden using %s" user host
method))
-
- ;; Enable `auth-source'.
- (tramp-set-connection-property
- vec "first-password-request" tramp-cache-read-persistent-data)
-
- ;; There will be a callback of "askPassword" when a password is needed.
- (dbus-register-method
- :session dbus-service-emacs object-path
- tramp-gvfs-interface-mountoperation "askPassword"
- #'tramp-gvfs-handler-askpassword)
- (dbus-register-method
- :session dbus-service-emacs object-path
- tramp-gvfs-interface-mountoperation "AskPassword"
- #'tramp-gvfs-handler-askpassword)
-
- ;; There could be a callback of "askQuestion" when adding
- ;; fingerprints or checking certificates.
- (dbus-register-method
- :session dbus-service-emacs object-path
- tramp-gvfs-interface-mountoperation "askQuestion"
- #'tramp-gvfs-handler-askquestion)
- (dbus-register-method
- :session dbus-service-emacs object-path
- tramp-gvfs-interface-mountoperation "AskQuestion"
- #'tramp-gvfs-handler-askquestion)
-
- ;; The call must be asynchronously, because of the "askPassword"
- ;; or "askQuestion" callbacks.
- (if (string-match-p "(so)$" tramp-gvfs-mountlocation-signature)
- (with-tramp-dbus-call-method vec nil
- :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker
- tramp-gvfs-interface-mounttracker tramp-gvfs-mountlocation
- (tramp-gvfs-mount-spec vec)
- `(:struct :string ,(dbus-get-unique-name :session)
- :object-path ,object-path))
- (with-tramp-dbus-call-method vec nil
- :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker
- tramp-gvfs-interface-mounttracker tramp-gvfs-mountlocation
- (tramp-gvfs-mount-spec vec)
- :string (dbus-get-unique-name :session) :object-path object-path))
-
- ;; We must wait, until the mount is applied. This will be
- ;; indicated by the "mounted" signal, i.e. the "fuse-mountpoint"
- ;; file property.
- (with-timeout
- ((or (tramp-get-method-parameter vec 'tramp-connection-timeout)
- tramp-connection-timeout)
- (if (zerop (length (tramp-file-name-user vec)))
- (tramp-error
- vec 'file-error
- "Timeout reached mounting %s using %s" host method)
- (tramp-error
- vec 'file-error
- "Timeout reached mounting address@hidden using %s" user host
method)))
- (while (not (tramp-get-file-property vec "/" "fuse-mountpoint" nil))
- (read-event nil nil 0.1)))
-
- ;; If `tramp-gvfs-handler-askquestion' has returned "No", it
- ;; is marked with the fuse-mountpoint "/". We shall react.
- (when (string-equal
- (tramp-get-file-property vec "/" "fuse-mountpoint" "") "/")
- (tramp-error vec 'file-error "FUSE mount denied"))
-
- ;; Save the password.
- (ignore-errors (funcall tramp-password-save-function))
-
- ;; Set connection-local variables.
- (tramp-set-connection-local-variables vec)
-
- ;; Mark it as connected.
- (tramp-set-connection-property
- (tramp-get-connection-process vec) "connected" t))))
-
- ;; In `tramp-check-cached-permissions', the connection properties
- ;; "{uid,gid}-{integer,string}" are used. We set them to proper values.
- (unless tramp-gvfs-get-remote-uid-gid-in-progress
- (let ((tramp-gvfs-get-remote-uid-gid-in-progress t))
- (tramp-gvfs-get-remote-uid vec 'integer)
- (tramp-gvfs-get-remote-gid vec 'integer)
- (tramp-gvfs-get-remote-uid vec 'string)
- (tramp-gvfs-get-remote-gid vec 'string))))
-
-(defun tramp-gvfs-gio-tool-p (vec)
- "Check, whether the gio tool is available."
- (with-tramp-connection-property vec "gio-tool"
- (zerop (tramp-call-process vec "gio" nil nil nil "version"))))
-
-(defun tramp-gvfs-send-command (vec command &rest args)
- "Send the COMMAND with its ARGS to connection VEC.
-COMMAND is a command from the gvfs-* utilities. It is replaced
-by the corresponding gio tool call if available. `call-process'
-is applied, and it returns t if the return code is zero."
- (let* ((locale (tramp-get-local-locale vec))
- (process-environment
- (append
- `(,(format "LANG=%s" locale)
- ,(format "LANGUAGE=%s" locale)
- ,(format "LC_ALL=%s" locale))
- process-environment)))
- (when (tramp-gvfs-gio-tool-p vec)
- ;; Use gio tool.
- (setq args (cons (cdr (assoc command tramp-gvfs-gio-mapping)) args)
- command "gio"))
-
- (with-current-buffer (tramp-get-connection-buffer vec)
- (tramp-gvfs-maybe-open-connection vec)
- (erase-buffer)
- (or (zerop (apply #'tramp-call-process vec command nil t nil args))
- ;; Remove information about mounted connection.
- (and (tramp-flush-file-properties vec "/") nil)))))
-
-
-;; D-Bus GNOME Online Accounts functions.
-
-(defun tramp-get-goa-accounts (vec)
- "Retrieve GNOME Online Accounts, and cache them.
-The hash key is a `tramp-goa-name' structure. The value is an
-alist of the properties of `tramp-goa-interface-account' and
-`tramp-goa-interface-files' of the corresponding GNOME online
-account. Additionally, a property \"prefix\" is added.
-VEC is used only for traces."
- (dolist
- (object-path
- (mapcar
- #'car
- (tramp-dbus-function
- vec #'dbus-get-all-managed-objects
- `(:session ,tramp-goa-service ,tramp-goa-path))))
- (let* ((account-properties
- (with-tramp-dbus-get-all-properties vec
- :session tramp-goa-service object-path
- tramp-goa-interface-account))
- (files-properties
- (with-tramp-dbus-get-all-properties vec
- :session tramp-goa-service object-path
- tramp-goa-interface-files))
- (identity
- (or (cdr (assoc "PresentationIdentity" account-properties)) ""))
- key)
- ;; Only accounts which matter.
- (when (and
- (not (cdr (assoc "FilesDisabled" account-properties)))
- (member
- (cdr (assoc "ProviderType" account-properties))
- '("google" "owncloud"))
- (string-match tramp-goa-identity-regexp identity))
- (setq key (make-tramp-goa-name
- :method (cdr (assoc "ProviderType" account-properties))
- :user (match-string 1 identity)
- :host (match-string 2 identity)
- :port (match-string 3 identity)))
- (when (string-equal (tramp-goa-name-method key) "google")
- (setf (tramp-goa-name-method key) "gdrive"))
- (when (string-equal (tramp-goa-name-method key) "owncloud")
- (setf (tramp-goa-name-method key) "nextcloud"))
- ;; Cache all properties.
- (dolist (prop (nconc account-properties files-properties))
- (tramp-set-connection-property key (car prop) (cdr prop)))
- ;; Cache "prefix".
- (tramp-message
- vec 10 "%s prefix %s" key
- (tramp-set-connection-property
- key "prefix"
- (directory-file-name
- (url-filename
- (url-generic-parse-url
- (tramp-get-connection-property key "Uri" "file:///"))))))))))
-
-
-;; D-Bus zeroconf functions.
-
-(defun tramp-zeroconf-parse-device-names (service)
- "Return a list of (user host) tuples allowed to access."
- (mapcar
- (lambda (x)
- (let ((host (zeroconf-service-host x))
- (port (zeroconf-service-port x))
- (text (zeroconf-service-txt x))
- user)
- (when port
- (setq host (format "%s%s%d" host tramp-prefix-port-regexp port)))
- ;; A user is marked in a TXT field like "u=guest".
- (while text
- (when (string-match "u=\\(.+\\)$" (car text))
- (setq user (match-string 1 (car text))))
- (setq text (cdr text)))
- (list user host)))
- (zeroconf-list-services service)))
-
-;; We use the TRIM argument of `split-string', which exist since Emacs
-;; 24.4. I mask this for older Emacs versions, there is no harm.
-(defun tramp-gvfs-parse-device-names (service)
- "Return a list of (user host) tuples allowed to access.
-This uses \"avahi-browse\" in case D-Bus is not enabled in Avahi."
- (let ((result
- (ignore-errors
- (tramp-compat-funcall
- 'split-string
- (shell-command-to-string (format "avahi-browse -trkp %s" service))
- "[\n\r]+" 'omit "^\\+;.*$"))))
- (delete-dups
- (mapcar
- (lambda (x)
- (let* ((list (split-string x ";"))
- (host (nth 6 list))
- (text (tramp-compat-funcall
- 'split-string (nth 9 list) "\" \"" 'omit "\""))
- user)
- ;; A user is marked in a TXT field like "u=guest".
- (while text
- (when (string-match "u=\\(.+\\)$" (car text))
- (setq user (match-string 1 (car text))))
- (setq text (cdr text)))
- (list user host)))
- result))))
-
-;; Add completion functions for AFP, DAV, DAVS, SFTP and SMB methods.
-(when tramp-gvfs-enabled
- ;; Suppress D-Bus error messages.
- (let (tramp-gvfs-dbus-event-vector)
- (zeroconf-init tramp-gvfs-zeroconf-domain)
- (if (zeroconf-list-service-types)
- (progn
- (tramp-set-completion-function
- "afp" '((tramp-zeroconf-parse-device-names "_afpovertcp._tcp")))
- (tramp-set-completion-function
- "dav" '((tramp-zeroconf-parse-device-names "_webdav._tcp")))
- (tramp-set-completion-function
- "davs" '((tramp-zeroconf-parse-device-names "_webdav._tcp")))
- (tramp-set-completion-function
- "sftp" '((tramp-zeroconf-parse-device-names "_ssh._tcp")
- (tramp-zeroconf-parse-device-names "_workstation._tcp")))
- (when (member "smb" tramp-gvfs-methods)
- (tramp-set-completion-function
- "smb" '((tramp-zeroconf-parse-device-names "_smb._tcp")))))
-
- (when (executable-find "avahi-browse")
- (tramp-set-completion-function
- "afp" '((tramp-gvfs-parse-device-names "_afpovertcp._tcp")))
- (tramp-set-completion-function
- "dav" '((tramp-gvfs-parse-device-names "_webdav._tcp")))
- (tramp-set-completion-function
- "davs" '((tramp-gvfs-parse-device-names "_webdav._tcp")))
- (tramp-set-completion-function
- "sftp" '((tramp-gvfs-parse-device-names "_ssh._tcp")
- (tramp-gvfs-parse-device-names "_workstation._tcp")))
- (when (member "smb" tramp-gvfs-methods)
- (tramp-set-completion-function
- "smb" '((tramp-gvfs-parse-device-names "_smb._tcp"))))))))
-
-(add-hook 'tramp-unload-hook
- (lambda ()
- (unload-feature 'tramp-gvfs 'force)))
-
-(provide 'tramp-gvfs)
-
-;;; TODO:
-
-;; * (Customizable) unmount when exiting Emacs. See tramp-archive.el.
-;;
-;; * Host name completion for existing mount points (afp-server,
-;; smb-server, google-drive, nextcloud) or via smb-network or network.
-;;
-;; * Check, how two shares of the same SMB server can be mounted in
-;; parallel.
-;;
-;; * What's up with ftps dns-sd afc admin computer?
-
-;;; tramp-gvfs.el ends here
diff --git a/lisp/tramp-integration.el b/lisp/tramp-integration.el
deleted file mode 100644
index 35d2eb3..0000000
--- a/lisp/tramp-integration.el
+++ /dev/null
@@ -1,199 +0,0 @@
-;;; tramp-integration.el --- Tramp integration into other packages -*-
lexical-binding:t -*-
-
-;; Copyright (C) 2019 Free Software Foundation, Inc.
-
-;; Author: Michael Albinus <address@hidden>
-;; 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:
-
-;; This assembles all integration of Tramp with other packages.
-
-;;; Code:
-
-(require 'tramp-compat)
-
-;; Pacify byte-compiler.
-(require 'cl-lib)
-(declare-function recentf-cleanup "recentf")
-(declare-function tramp-dissect-file-name "tramp")
-(declare-function tramp-file-name-equal-p "tramp")
-(declare-function tramp-tramp-file-p "tramp")
-(defvar eshell-path-env)
-(defvar recentf-exclude)
-(defvar tramp-current-connection)
-(defvar tramp-postfix-host-format)
-
-;;; Fontification of `read-file-name':
-
-(defvar tramp-rfn-eshadow-overlay)
-(make-variable-buffer-local 'tramp-rfn-eshadow-overlay)
-
-(defun tramp-rfn-eshadow-setup-minibuffer ()
- "Set up a minibuffer for `file-name-shadow-mode'.
-Adds another overlay hiding filename parts according to Tramp's
-special handling of `substitute-in-file-name'."
- (when minibuffer-completing-file-name
- (setq tramp-rfn-eshadow-overlay
- (make-overlay (minibuffer-prompt-end) (minibuffer-prompt-end)))
- ;; Copy rfn-eshadow-overlay properties.
- (let ((props (overlay-properties rfn-eshadow-overlay)))
- (while props
- ;; The `field' property prevents correct minibuffer
- ;; completion; we exclude it.
- (if (not (eq (car props) 'field))
- (overlay-put tramp-rfn-eshadow-overlay (pop props) (pop props))
- (pop props) (pop props))))))
-
-(add-hook 'rfn-eshadow-setup-minibuffer-hook
- #'tramp-rfn-eshadow-setup-minibuffer)
-(add-hook 'tramp-unload-hook
- (lambda ()
- (remove-hook 'rfn-eshadow-setup-minibuffer-hook
- #'tramp-rfn-eshadow-setup-minibuffer)))
-
-(defun tramp-rfn-eshadow-update-overlay-regexp ()
- (format "[^%s/~]*\\(/\\|~\\)" tramp-postfix-host-format))
-
-;; Package rfn-eshadow is preloaded in Emacs, but for some reason,
-;; it only did (defvar rfn-eshadow-overlay) without giving it a global
-;; value, so it was only declared as dynamically-scoped within the
-;; rfn-eshadow.el file. This is now fixed in Emacs>26.1 but we still need
-;; this defvar here for older releases.
-(defvar rfn-eshadow-overlay)
-
-(defun tramp-rfn-eshadow-update-overlay ()
- "Update `rfn-eshadow-overlay' to cover shadowed part of minibuffer input.
-This is intended to be used as a minibuffer `post-command-hook' for
-`file-name-shadow-mode'; the minibuffer should have already
-been set up by `rfn-eshadow-setup-minibuffer'."
- ;; In remote files name, there is a shadowing just for the local part.
- (ignore-errors
- (let ((end (or (overlay-end rfn-eshadow-overlay)
- (minibuffer-prompt-end)))
- ;; We do not want to send any remote command.
- (non-essential t))
- (when (tramp-tramp-file-p (buffer-substring end (point-max)))
- (save-excursion
- (save-restriction
- (narrow-to-region
- (1+ (or (string-match-p
- (tramp-rfn-eshadow-update-overlay-regexp)
- (buffer-string) end)
- end))
- (point-max))
- (let ((rfn-eshadow-overlay tramp-rfn-eshadow-overlay)
- (rfn-eshadow-update-overlay-hook nil)
- file-name-handler-alist)
- (move-overlay rfn-eshadow-overlay (point-max) (point-max))
- (rfn-eshadow-update-overlay))))))))
-
-(add-hook 'rfn-eshadow-update-overlay-hook
- #'tramp-rfn-eshadow-update-overlay)
-(add-hook 'tramp-unload-hook
- (lambda ()
- (remove-hook 'rfn-eshadow-update-overlay-hook
- #'tramp-rfn-eshadow-update-overlay)))
-
-;;; Integration of eshell.el:
-
-;; eshell.el keeps the path in `eshell-path-env'. We must change it
-;; when `default-directory' points to another host.
-(defun tramp-eshell-directory-change ()
- "Set `eshell-path-env' to $PATH of the host related to `default-directory'."
- ;; Remove last element of `(exec-path)', which is `exec-directory'.
- ;; Use `path-separator' as it does eshell.
- (setq eshell-path-env
- (mapconcat
- #'identity (butlast (tramp-compat-exec-path)) path-separator)))
-
-(eval-after-load "esh-util"
- '(progn
- (add-hook 'eshell-mode-hook
- #'tramp-eshell-directory-change)
- (add-hook 'eshell-directory-change-hook
- #'tramp-eshell-directory-change)
- (add-hook 'tramp-integration-unload-hook
- (lambda ()
- (remove-hook 'eshell-mode-hook
- #'tramp-eshell-directory-change)
- (remove-hook 'eshell-directory-change-hook
- #'tramp-eshell-directory-change)))))
-
-;;; Integration of recentf.el:
-
-(defun tramp-recentf-exclude-predicate (name)
- "Predicate to exclude a remote file name from recentf.
-NAME must be equal to `tramp-current-connection'."
- (when (file-remote-p name)
- (tramp-file-name-equal-p
- (tramp-dissect-file-name name) (car tramp-current-connection))))
-
-(defun tramp-recentf-cleanup (vec)
- "Remove all file names related to VEC from recentf."
- (when (bound-and-true-p recentf-list)
- (let ((tramp-current-connection `(,vec))
- (recentf-exclude '(tramp-recentf-exclude-predicate)))
- (recentf-cleanup))))
-
-(defun tramp-recentf-cleanup-all ()
- "Remove all remote file names from recentf."
- (when (bound-and-true-p recentf-list)
- (let ((recentf-exclude '(file-remote-p)))
- (recentf-cleanup))))
-
-(eval-after-load "recentf"
- '(progn
- (add-hook 'tramp-cleanup-connection-hook
- #'tramp-recentf-cleanup)
- (add-hook 'tramp-cleanup-all-connections-hook
- #'tramp-recentf-cleanup-all)
- (add-hook 'tramp-integration-unload-hook
- (lambda ()
- (remove-hook 'tramp-cleanup-connection-hook
- #'tramp-recentf-cleanup)
- (remove-hook 'tramp-cleanup-all-connections-hook
- #'tramp-recentf-cleanup-all)))))
-
-;;; Default connection-local variables for Tramp:
-
-(defconst tramp-connection-local-default-profile
- '((shell-file-name . "/bin/sh")
- (shell-command-switch . "-c"))
- "Default connection-local variables for remote connections.")
-
-;; `connection-local-set-profile-variables' and
-;; `connection-local-set-profiles' exists since Emacs 26.1.
-(eval-after-load "shell"
- '(progn
- (tramp-compat-funcall
- 'connection-local-set-profile-variables
- 'tramp-connection-local-default-profile
- tramp-connection-local-default-profile)
- (tramp-compat-funcall
- 'connection-local-set-profiles
- `(:application tramp)
- 'tramp-connection-local-default-profile)))
-
-(add-hook 'tramp-unload-hook
- (lambda () (unload-feature 'tramp-integration 'force)))
-
-(provide 'tramp-integration)
-
-;;; tramp-integration.el ends here
diff --git a/lisp/tramp-rclone.el b/lisp/tramp-rclone.el
deleted file mode 100644
index 0148116..0000000
--- a/lisp/tramp-rclone.el
+++ /dev/null
@@ -1,608 +0,0 @@
-;;; tramp-rclone.el --- Tramp access functions to cloud storages -*-
lexical-binding:t -*-
-
-;; Copyright (C) 2018-2019 Free Software Foundation, Inc.
-
-;; Author: Michael Albinus <address@hidden>
-;; 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:
-
-;; rclone is a command line program to sync files and directories to
-;; and from cloud storages. Tramp uses its mount utility to access
-;; files and directories there. The configuration of rclone for
-;; different storage systems is performed outside Tramp, see rclone(1).
-
-;; A remote file under rclone control has the form
-;; "/rclone:<remote>:/path/to/file". <remote> is the name of a
-;; storage system in rclone's configuration. Therefore, such a remote
-;; file name does not know of any user or port specification.
-
-;;; Code:
-
-(eval-when-compile (require 'cl-lib))
-(require 'tramp)
-
-;;;###tramp-autoload
-(defconst tramp-rclone-method "rclone"
- "When this method name is used, forward all calls to rclone mounts.")
-
-(defcustom tramp-rclone-program "rclone"
- "Name of the rclone program."
- :group 'tramp
- :version "27.1"
- :type 'string)
-
-;;;###tramp-autoload
-(tramp--with-startup
- (add-to-list 'tramp-methods
- `(,tramp-rclone-method
- (tramp-mount-args nil)
- (tramp-copyto-args nil)
- (tramp-moveto-args nil)
- (tramp-about-args ("--full"))))
-
- (add-to-list 'tramp-default-host-alist `(,tramp-rclone-method nil ""))
-
- (tramp-set-completion-function
- tramp-rclone-method '((tramp-rclone-parse-device-names ""))))
-
-
-;; New handlers should be added here.
-;;;###tramp-autoload
-(defconst tramp-rclone-file-name-handler-alist
- '((access-file . tramp-handle-access-file)
- (add-name-to-file . tramp-handle-add-name-to-file)
- ;; `byte-compiler-base-file-name' performed by default handler.
- ;; `copy-directory' performed by default handler.
- (copy-file . tramp-rclone-handle-copy-file)
- (delete-directory . tramp-rclone-handle-delete-directory)
- (delete-file . tramp-rclone-handle-delete-file)
- ;; `diff-latest-backup-file' performed by default handler.
- (directory-file-name . tramp-handle-directory-file-name)
- (directory-files . tramp-rclone-handle-directory-files)
- (directory-files-and-attributes
- . tramp-handle-directory-files-and-attributes)
- (dired-compress-file . ignore)
- (dired-uncache . tramp-handle-dired-uncache)
- (exec-path . ignore)
- (expand-file-name . tramp-handle-expand-file-name)
- (file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
- (file-acl . ignore)
- (file-attributes . tramp-rclone-handle-file-attributes)
- (file-directory-p . tramp-handle-file-directory-p)
- (file-equal-p . tramp-handle-file-equal-p)
- (file-executable-p . tramp-rclone-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-handle-file-local-copy)
- (file-modes . tramp-handle-file-modes)
- (file-name-all-completions . tramp-rclone-handle-file-name-all-completions)
- (file-name-as-directory . tramp-handle-file-name-as-directory)
- (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p)
- (file-name-completion . tramp-handle-file-name-completion)
- (file-name-directory . tramp-handle-file-name-directory)
- (file-name-nondirectory . tramp-handle-file-name-nondirectory)
- ;; `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-rclone-handle-file-readable-p)
- (file-regular-p . tramp-handle-file-regular-p)
- (file-remote-p . tramp-handle-file-remote-p)
- (file-selinux-context . tramp-handle-file-selinux-context)
- (file-symlink-p . tramp-handle-file-symlink-p)
- (file-system-info . tramp-rclone-handle-file-system-info)
- (file-truename . tramp-handle-file-truename)
- (file-writable-p . tramp-handle-file-writable-p)
- (find-backup-file-name . tramp-handle-find-backup-file-name)
- ;; `get-file-buffer' performed by default handler.
- (insert-directory . tramp-handle-insert-directory)
- (insert-file-contents . tramp-handle-insert-file-contents)
- (load . tramp-handle-load)
- (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
- (make-directory . tramp-rclone-handle-make-directory)
- (make-directory-internal . ignore)
- (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
- (make-process . ignore)
- (make-symbolic-link . tramp-handle-make-symbolic-link)
- (process-file . ignore)
- (rename-file . tramp-rclone-handle-rename-file)
- (set-file-acl . ignore)
- (set-file-modes . ignore)
- (set-file-selinux-context . ignore)
- (set-file-times . ignore)
- (set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
- (shell-command . ignore)
- (start-file-process . ignore)
- (substitute-in-file-name . tramp-handle-substitute-in-file-name)
- (temporary-file-directory . tramp-handle-temporary-file-directory)
- (tramp-set-file-uid-gid . ignore)
- (unhandled-file-name-directory . ignore)
- (vc-registered . ignore)
- (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
- (write-region . tramp-handle-write-region))
- "Alist of handler functions for Tramp RCLONE method.
-Operations not mentioned here will be handled by the default Emacs
primitives.")
-
-;; It must be a `defsubst' in order to push the whole code into
-;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
-;;;###tramp-autoload
-(defsubst tramp-rclone-file-name-p (filename)
- "Check if it's a filename for rclone."
- (and (tramp-tramp-file-p filename)
- (string= (tramp-file-name-method (tramp-dissect-file-name filename))
- tramp-rclone-method)))
-
-;;;###tramp-autoload
-(defun tramp-rclone-file-name-handler (operation &rest args)
- "Invoke the rclone handler for OPERATION.
-First arg specifies the OPERATION, second arg is a list of arguments to
-pass to the OPERATION."
- (let ((fn (assoc operation tramp-rclone-file-name-handler-alist)))
- (if fn
- (save-match-data (apply (cdr fn) args))
- (tramp-run-real-handler operation args))))
-
-;;;###tramp-autoload
-(tramp--with-startup
- (tramp-register-foreign-file-name-handler
- #'tramp-rclone-file-name-p #'tramp-rclone-file-name-handler))
-
-;;;###tramp-autoload
-(defun tramp-rclone-parse-device-names (_ignore)
- "Return a list of (nil host) tuples allowed to access."
- (with-tramp-connection-property nil "rclone-device-names"
- (delq nil
- (mapcar
- (lambda (line)
- (when (string-match "^\\(\\S-+\\):$" line)
- `(nil ,(match-string 1 line))))
- (tramp-process-lines nil tramp-rclone-program "listremotes")))))
-
-
-;; File name primitives.
-
-(defun tramp-rclone-do-copy-or-rename-file
- (op filename newname &optional ok-if-already-exists keep-date
- preserve-uid-gid preserve-extended-attributes)
- "Copy or rename a remote file.
-OP must be `copy' or `rename' and indicates the operation to perform.
-FILENAME specifies the file to copy or rename, NEWNAME is the name of
-the new file (for copy) or the new name of the file (for rename).
-OK-IF-ALREADY-EXISTS means don't barf if NEWNAME exists already.
-KEEP-DATE means to make sure that NEWNAME has the same timestamp
-as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep
-the uid and gid if both files are on the same host.
-PRESERVE-EXTENDED-ATTRIBUTES is ignored.
-
-This function is invoked by `tramp-rclone-handle-copy-file' and
-`tramp-rclone-handle-rename-file'. It is an error if OP is neither
-of `copy' and `rename'. FILENAME and NEWNAME must be absolute
-file names."
- (unless (memq op '(copy rename))
- (error "Unknown operation `%s', must be `copy' or `rename'" op))
-
- (setq filename (file-truename filename))
- (if (file-directory-p filename)
- (progn
- (copy-directory filename newname keep-date t)
- (when (eq op 'rename) (delete-directory filename 'recursive)))
-
- (let ((t1 (tramp-tramp-file-p filename))
- (t2 (tramp-tramp-file-p newname))
- (rclone-operation (if (eq op 'copy) "copyto" "moveto"))
- (msg-operation (if (eq op 'copy) "Copying" "Renaming")))
-
- (with-parsed-tramp-file-name (if t1 filename newname) nil
- (when (and (not ok-if-already-exists) (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
-
- (if (or (and t1 (not (tramp-rclone-file-name-p filename)))
- (and t2 (not (tramp-rclone-file-name-p newname))))
-
- ;; We cannot copy or rename directly.
- (let ((tmpfile (tramp-compat-make-temp-file filename)))
- (if (eq op 'copy)
- (copy-file
- filename tmpfile t keep-date preserve-uid-gid
- preserve-extended-attributes)
- (rename-file filename tmpfile t))
- (rename-file tmpfile newname ok-if-already-exists))
-
- ;; Direct action.
- (with-tramp-progress-reporter
- v 0 (format "%s %s to %s" msg-operation filename newname)
- (unless (zerop
- (tramp-rclone-send-command
- v rclone-operation
- (tramp-rclone-remote-file-name filename)
- (tramp-rclone-remote-file-name newname)))
- (tramp-error
- v 'file-error
- "Error %s `%s' `%s'" msg-operation filename newname)))
-
- (when (and t1 (eq op 'rename))
- (with-parsed-tramp-file-name filename v1
- (tramp-flush-file-properties
- v1 (file-name-directory v1-localname))
- (tramp-flush-file-properties v1 v1-localname)
- (when (tramp-rclone-file-name-p filename)
- (tramp-rclone-flush-directory-cache v1)
- ;; The mount point's directory cache might need time
- ;; to flush.
- (while (file-exists-p filename)
- (tramp-flush-file-properties
- v1 (file-name-directory v1-localname))
- (tramp-flush-file-properties v1 v1-localname)))))
-
- (when t2
- (with-parsed-tramp-file-name newname v2
- (tramp-flush-file-properties
- v2 (file-name-directory v2-localname))
- (tramp-flush-file-properties v2 v2-localname)
- (when (tramp-rclone-file-name-p newname)
- (tramp-rclone-flush-directory-cache v2)
- ;; The mount point's directory cache might need time
- ;; to flush.
- (while (not (file-exists-p newname))
- (tramp-flush-file-properties
- v2 (file-name-directory v2-localname))
- (tramp-flush-file-properties v2 v2-localname))))))))))
-
-(defun tramp-rclone-handle-copy-file
- (filename newname &optional ok-if-already-exists keep-date
- preserve-uid-gid preserve-extended-attributes)
- "Like `copy-file' for Tramp files."
- (setq filename (expand-file-name filename))
- (setq newname (expand-file-name newname))
- ;; At least one file a Tramp file?
- (if (or (tramp-tramp-file-p filename)
- (tramp-tramp-file-p newname))
- (tramp-rclone-do-copy-or-rename-file
- 'copy filename newname ok-if-already-exists keep-date
- preserve-uid-gid preserve-extended-attributes)
- (tramp-run-real-handler
- #'copy-file
- (list filename newname ok-if-already-exists keep-date
- preserve-uid-gid preserve-extended-attributes))))
-
-(defun tramp-rclone-handle-delete-directory
- (directory &optional recursive trash)
- "Like `delete-directory' for Tramp files."
- (with-parsed-tramp-file-name (expand-file-name directory) nil
- (delete-directory (tramp-rclone-local-file-name directory) recursive trash)
- (tramp-flush-file-properties v (file-name-directory localname))
- (tramp-flush-directory-properties v localname)
- (tramp-rclone-flush-directory-cache v)))
-
-(defun tramp-rclone-handle-delete-file (filename &optional trash)
- "Like `delete-file' for Tramp files."
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (delete-file (tramp-rclone-local-file-name filename) trash)
- (tramp-flush-file-properties v (file-name-directory localname))
- (tramp-flush-file-properties v localname)
- (tramp-rclone-flush-directory-cache v)))
-
-(defun tramp-rclone-handle-directory-files
- (directory &optional full match nosort)
- "Like `directory-files' for Tramp files."
- (when (file-directory-p directory)
- (setq directory (file-name-as-directory (expand-file-name directory)))
- (with-parsed-tramp-file-name directory nil
- (let ((result
- (directory-files
- (tramp-rclone-local-file-name directory) full match)))
- ;; Massage the result.
- (when full
- (let ((local (concat "^" (regexp-quote (tramp-rclone-mount-point v))))
- (remote (funcall (if (tramp-compat-file-name-quoted-p directory)
- #'tramp-compat-file-name-quote #'identity)
- (file-remote-p directory))))
- (setq result
- (mapcar
- (lambda (x) (replace-regexp-in-string local remote x))
- result))))
- ;; Some storage systems do not return "." and "..".
- (dolist (item '(".." "."))
- (when (and (string-match-p (or match (regexp-quote item)) item)
- (not
- (member (if full (setq item (concat directory item)) item)
- result)))
- (setq result (cons item result))))
- ;; Return result.
- (if nosort result (sort result #'string<))))))
-
-(defun tramp-rclone-handle-file-attributes (filename &optional id-format)
- "Like `file-attributes' for Tramp files."
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (with-tramp-file-property
- v localname (format "file-attributes-%s" id-format)
- (file-attributes (tramp-rclone-local-file-name filename) id-format))))
-
-(defun tramp-rclone-handle-file-executable-p (filename)
- "Like `file-executable-p' for Tramp files."
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (with-tramp-file-property v localname "file-executable-p"
- (file-executable-p (tramp-rclone-local-file-name filename)))))
-
-(defun tramp-rclone-handle-file-name-all-completions (filename directory)
- "Like `file-name-all-completions' for Tramp files."
- (all-completions
- filename
- (delete-dups
- (append
- (file-name-all-completions
- filename (tramp-rclone-local-file-name directory))
- ;; Some storage systems do not return "." and "..".
- (let (result)
- (dolist (item '(".." ".") result)
- (when (string-prefix-p filename item)
- (catch 'match
- (dolist (elt completion-regexp-list)
- (unless (string-match-p elt item) (throw 'match nil)))
- (setq result (cons (concat item "/") result))))))))))
-
-(defun tramp-rclone-handle-file-readable-p (filename)
- "Like `file-readable-p' for Tramp files."
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (with-tramp-file-property v localname "file-readable-p"
- (file-readable-p (tramp-rclone-local-file-name filename)))))
-
-(defun tramp-rclone-handle-file-system-info (filename)
- "Like `file-system-info' for Tramp files."
- (ignore-errors
- (unless (file-directory-p filename)
- (setq filename (file-name-directory filename)))
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (tramp-message v 5 "file system info: %s" localname)
- (tramp-rclone-send-command v "about" (concat host ":"))
- (with-current-buffer (tramp-get-connection-buffer v)
- (let (total used free)
- (goto-char (point-min))
- (while (not (eobp))
- (when (looking-at "Total: [[:space:]]+\\([[:digit:]]+\\)")
- (setq total (string-to-number (match-string 1))))
- (when (looking-at "Used: [[:space:]]+\\([[:digit:]]+\\)")
- (setq used (string-to-number (match-string 1))))
- (when (looking-at "Free: [[:space:]]+\\([[:digit:]]+\\)")
- (setq free (string-to-number (match-string 1))))
- (forward-line))
- (when used
- ;; The used number of bytes is not part of the result. As
- ;; side effect, we store it as file property.
- (tramp-set-file-property v localname "used-bytes" used))
- ;; Result.
- (when (and total free)
- (list total free (- total free))))))))
-
-(defun tramp-rclone-handle-insert-directory
- (filename switches &optional wildcard full-directory-p)
- "Like `insert-directory' for Tramp files."
- (insert-directory
- (tramp-rclone-local-file-name filename) switches wildcard full-directory-p)
- (goto-char (point-min))
- (while (search-forward (tramp-rclone-local-file-name filename) nil 'noerror)
- (replace-match filename)))
-
-(defun tramp-rclone-handle-insert-file-contents
- (filename &optional visit beg end replace)
- "Like `insert-file-contents' for Tramp files."
- (let ((result
- (insert-file-contents
- (tramp-rclone-local-file-name filename) visit beg end replace)))
- (prog1
- (list (expand-file-name filename) (cadr result))
- (when visit (setq buffer-file-name filename)))))
-
-(defun tramp-rclone-handle-make-directory (dir &optional parents)
- "Like `make-directory' for Tramp files."
- (with-parsed-tramp-file-name (expand-file-name dir) nil
- (make-directory (tramp-rclone-local-file-name dir) parents)
- ;; When PARENTS is non-nil, DIR could be a chain of non-existent
- ;; directories a/b/c/... Instead of checking, we simply flush the
- ;; whole file cache.
- (tramp-flush-file-properties v localname)
- (tramp-flush-directory-properties
- v (if parents "/" (file-name-directory localname)))
- (tramp-rclone-flush-directory-cache v)))
-
-(defun tramp-rclone-handle-rename-file
- (filename newname &optional ok-if-already-exists)
- "Like `rename-file' for Tramp files."
- (setq filename (expand-file-name filename))
- (setq newname (expand-file-name newname))
- ;; At least one file a Tramp file?
- (if (or (tramp-tramp-file-p filename)
- (tramp-tramp-file-p newname))
- (tramp-rclone-do-copy-or-rename-file
- 'rename filename newname ok-if-already-exists
- 'keep-date 'preserve-uid-gid)
- (tramp-run-real-handler
- #'rename-file (list filename newname ok-if-already-exists))))
-
-
-;; File name conversions.
-
-(defun tramp-rclone-mount-point (vec)
- "Return local mount point of VEC."
- (expand-file-name
- (concat
- tramp-temp-name-prefix (tramp-file-name-method vec)
- "." (tramp-file-name-host vec))
- (tramp-compat-temporary-file-directory)))
-
-(defun tramp-rclone-mounted-p (vec)
- "Check, whether storage system determined by VEC is mounted."
- (when (tramp-get-connection-process vec)
- ;; We cannot use `with-connection-property', because we don't want
- ;; to cache a nil result.
- (or (tramp-get-connection-property
- (tramp-get-connection-process vec) "mounted" nil)
- (let* ((default-directory temporary-file-directory)
- (mount (shell-command-to-string "mount -t fuse.rclone")))
- (tramp-message vec 6 "%s" "mount -t fuse.rclone")
- (tramp-message vec 6 "\n%s" mount)
- (tramp-set-connection-property
- (tramp-get-connection-process vec) "mounted"
- (when (string-match
- (format
- "^\\(%s:\\S-*\\)" (regexp-quote (tramp-file-name-host vec)))
- mount)
- (match-string 1 mount)))))))
-
-(defun tramp-rclone-flush-directory-cache (vec)
- "Flush directory cache of VEC mount."
- (let ((rclone-pid
- ;; Identify rclone process.
- (when (tramp-get-connection-process vec)
- (with-tramp-connection-property
- (tramp-get-connection-process vec) "rclone-pid"
- (catch 'pid
- (dolist (pid (list-system-processes)) ;; "pidof rclone" ?
- (and (string-match-p
- (regexp-quote
- (format "rclone mount %s:" (tramp-file-name-host vec)))
- (or (cdr (assoc 'args (process-attributes pid))) ""))
- (throw 'pid pid))))))))
- ;; Send a SIGHUP in order to flush directory cache.
- (when rclone-pid
- (tramp-message
- vec 6 "Send SIGHUP %d: %s"
- rclone-pid (cdr (assoc 'args (process-attributes rclone-pid))))
- (signal-process rclone-pid 'SIGHUP))))
-
-(defun tramp-rclone-local-file-name (filename)
- "Return local mount name of FILENAME."
- (setq filename (tramp-compat-file-name-unquote (expand-file-name filename)))
- (with-parsed-tramp-file-name filename nil
- ;; As long as we call `tramp-rclone-maybe-open-connection' here,
- ;; we cache the result.
- (with-tramp-file-property v localname "local-file-name"
- (tramp-rclone-maybe-open-connection v)
- (let ((quoted (tramp-compat-file-name-quoted-p localname))
- (localname (tramp-compat-file-name-unquote localname)))
- (funcall
- (if quoted #'tramp-compat-file-name-quote #'identity)
- (expand-file-name
- (if (file-name-absolute-p localname)
- (substring localname 1) localname)
- (tramp-rclone-mount-point v)))))))
-
-(defun tramp-rclone-remote-file-name (filename)
- "Return FILENAME as used in the `rclone' command."
- (setq filename (tramp-compat-file-name-unquote (expand-file-name filename)))
- (if (tramp-rclone-file-name-p filename)
- (with-parsed-tramp-file-name filename nil
- ;; As long as we call `tramp-rclone-maybe-open-connection' here,
- ;; we cache the result.
- (with-tramp-file-property v localname "remote-file-name"
- (tramp-rclone-maybe-open-connection v)
- ;; TODO: This shall be handled by `expand-file-name'.
- (setq localname
- (replace-regexp-in-string "^\\." "" (or localname "")))
- (format "%s%s" (tramp-rclone-mounted-p v) localname)))
- ;; It is a local file name.
- filename))
-
-(defun tramp-rclone-maybe-open-connection (vec)
- "Maybe open a connection VEC.
-Does not do anything if a connection is already open, but re-opens the
-connection if a previous connection has died for some reason."
- (let ((host (tramp-file-name-host vec)))
- (when (rassoc `(,host) (tramp-rclone-parse-device-names nil))
- (if (zerop (length host))
- (tramp-error vec 'file-error "Storage %s not connected" host))
-
- ;; During completion, don't reopen a new connection. We check
- ;; this for the process related to `tramp-buffer-name';
- ;; otherwise `start-file-process' wouldn't run ever when
- ;; `non-essential' is non-nil.
- (when (and (tramp-completion-mode-p)
- (null (get-process (tramp-buffer-name vec))))
- (throw 'non-essential 'non-essential))
-
- ;; We need a process bound to the connection buffer. Therefore,
- ;; we create a dummy process. Maybe there is a better solution?
- (unless (get-buffer-process (tramp-get-connection-buffer vec))
- (let ((p (make-network-process
- :name (tramp-buffer-name vec)
- :buffer (tramp-get-connection-buffer vec)
- :server t :host 'local :service t :noquery t)))
- (process-put p 'vector vec)
- (set-process-query-on-exit-flag p nil)
-
- ;; Set connection-local variables.
- (tramp-set-connection-local-variables vec)))
-
- ;; Create directory.
- (unless (file-directory-p (tramp-rclone-mount-point vec))
- (make-directory (tramp-rclone-mount-point vec) 'parents))
-
- ;; Mount. This command does not return, so we use 0 as
- ;; DESTINATION of `tramp-call-process'.
- (unless (tramp-rclone-mounted-p vec)
- (apply
- #'tramp-call-process
- vec tramp-rclone-program nil 0 nil
- (delq nil
- `("mount" ,(concat host ":/")
- ,(tramp-rclone-mount-point vec)
- ;; This could be nil.
- ,(tramp-get-method-parameter vec 'tramp-mount-args))))
- (while (not (file-exists-p (tramp-make-tramp-file-name vec 'localname)))
- (tramp-cleanup-connection vec 'keep-debug 'keep-password))
-
- ;; Mark it as connected.
- (tramp-set-connection-property
- (tramp-get-connection-process vec) "connected" t))))
-
- ;; In `tramp-check-cached-permissions', the connection properties
- ;; "{uid,gid}-{integer,string}" are used. We set them to proper values.
- (with-tramp-connection-property
- vec "uid-integer" (tramp-get-local-uid 'integer))
- (with-tramp-connection-property
- vec "gid-integer" (tramp-get-local-gid 'integer))
- (with-tramp-connection-property
- vec "uid-string" (tramp-get-local-uid 'string))
- (with-tramp-connection-property
- vec "gid-string" (tramp-get-local-gid 'string)))
-
-(defun tramp-rclone-send-command (vec &rest args)
- "Send the COMMAND to connection VEC."
- (with-current-buffer (tramp-get-connection-buffer vec)
- (erase-buffer)
- (let ((flags (tramp-get-method-parameter
- vec (intern (format "tramp-%s-args" (car args))))))
- (apply #'tramp-call-process
- vec tramp-rclone-program nil t nil (append args flags)))))
-
-(add-hook 'tramp-unload-hook
- (lambda ()
- (unload-feature 'tramp-rclone 'force)))
-
-(provide 'tramp-rclone)
-
-;;; TODO:
-
-;; * If possible, get rid of "rclone mount". Maybe it is more
-;; performant then.
-
-;;; tramp-rclone.el ends here
diff --git a/lisp/tramp-sh.el b/lisp/tramp-sh.el
deleted file mode 100644
index 11b1af8..0000000
--- a/lisp/tramp-sh.el
+++ /dev/null
@@ -1,5965 +0,0 @@
-;;; tramp-sh.el --- Tramp access functions for (s)sh-like connections -*-
lexical-binding:t -*-
-
-;; Copyright (C) 1998-2019 Free Software Foundation, Inc.
-
-;; (copyright statements below in code to be updated with the above notice)
-
-;; Author: Kai Großjohann <address@hidden>
-;; Michael Albinus <address@hidden>
-;; Maintainer: Michael Albinus <address@hidden>
-;; 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/>.
-
-;;; Code:
-
-(eval-when-compile (require 'cl-lib))
-(require 'tramp)
-
-(declare-function dired-remove-file "dired-aux")
-(defvar dired-compress-file-suffixes)
-(defvar vc-handled-backends)
-(defvar vc-bzr-program)
-(defvar vc-git-program)
-(defvar vc-hg-program)
-
-(defcustom tramp-inline-compress-start-size 4096
- "The minimum size of compressing where inline transfer.
-When inline transfer, compress transferred data of file
-whose size is this value or above (up to `tramp-copy-size-limit').
-If it is nil, no compression at all will be applied."
- :group 'tramp
- :type '(choice (const nil) integer))
-
-(defcustom tramp-copy-size-limit 10240
- "The maximum file size where inline copying is preferred over an \
-out-of-the-band copy.
-If it is nil, out-of-the-band copy will be used without a check."
- :group 'tramp
- :type '(choice (const nil) integer))
-
-;;;###tramp-autoload
-(defcustom tramp-terminal-type "dumb"
- "Value of TERM environment variable for logging in to remote host.
-Because Tramp wants to parse the output of the remote shell, it is easily
-confused by ANSI color escape sequences and suchlike. Often, shell init
-files conditionalize this setup based on the TERM environment variable."
- :group 'tramp
- :type 'string)
-
-(defcustom tramp-histfile-override "~/.tramp_history"
- "When invoking a shell, override the HISTFILE with this value.
-When setting to a string, it redirects the shell history to that
-file. Be careful when setting to \"/dev/null\"; this might
-result in undesired results when using \"bash\" as shell.
-
-The value t unsets any setting of HISTFILE, and sets both
-HISTFILESIZE and HISTSIZE to 0. If you set this variable to nil,
-however, the *override* is disabled, so the history will go to
-the default storage location, e.g. \"$HOME/.sh_history\"."
- :group 'tramp
- :version "25.2"
- :type '(choice (const :tag "Do not override HISTFILE" nil)
- (const :tag "Unset HISTFILE" t)
- (string :tag "Redirect to a file")))
-
-;;;###tramp-autoload
-(defconst tramp-display-escape-sequence-regexp "\e[[;0-9]+m"
- "Terminal control escape sequences for display attributes.")
-
-(defconst tramp-device-escape-sequence-regexp "\e[[0-9]+n"
- "Terminal control escape sequences for device status.")
-
-;; ksh on OpenBSD 4.5 requires that $PS1 contains a `#' character for
-;; root users. It uses the `$' character for other users. In order
-;; to guarantee a proper prompt, we use "#$ " for the prompt.
-
-(defvar tramp-end-of-output
- (format
- "///%s#$"
- (md5 (concat (prin1-to-string process-environment) (current-time-string))))
- "String used to recognize end of output.
-The `$' character at the end is quoted; the string cannot be
-detected as prompt when being sent on echoing hosts, therefore.")
-
-;;;###tramp-autoload
-(defconst tramp-initial-end-of-output "#$ "
- "Prompt when establishing a connection.")
-
-(defconst tramp-end-of-heredoc (md5 tramp-end-of-output)
- "String used to recognize end of heredoc strings.")
-
-(defcustom tramp-use-ssh-controlmaster-options t
- "Whether to use `tramp-ssh-controlmaster-options'."
- :group 'tramp
- :version "24.4"
- :type 'boolean)
-
-(defvar tramp-ssh-controlmaster-options nil
- "Which ssh Control* arguments to use.
-
-If it is a string, it should have the form
-\"-o ControlMaster=auto -o ControlPath=\\='address@hidden:%%p\\='
--o ControlPersist=no\". Percent characters in the ControlPath
-spec must be doubled, because the string is used as format string.
-
-Otherwise, it will be auto-detected by Tramp, if
-`tramp-use-ssh-controlmaster-options' is non-nil. The value
-depends on the installed local ssh version.
-
-The string is used in `tramp-methods'.")
-
-;; Initialize `tramp-methods' with the supported methods.
-;;;###tramp-autoload
-(tramp--with-startup
- (add-to-list 'tramp-methods
- '("rcp"
- (tramp-login-program "rsh")
- (tramp-login-args (("%h") ("-l" "%u")))
- (tramp-remote-shell "/bin/sh")
- (tramp-remote-shell-login ("-l"))
- (tramp-remote-shell-args ("-c"))
- (tramp-copy-program "rcp")
- (tramp-copy-args (("-p" "%k") ("-r")))
- (tramp-copy-keep-date t)
- (tramp-copy-recursive t)))
- (add-to-list 'tramp-methods
- '("remcp"
- (tramp-login-program "remsh")
- (tramp-login-args (("%h") ("-l" "%u")))
- (tramp-remote-shell "/bin/sh")
- (tramp-remote-shell-login ("-l"))
- (tramp-remote-shell-args ("-c"))
- (tramp-copy-program "rcp")
- (tramp-copy-args (("-p" "%k")))
- (tramp-copy-keep-date t)))
- (add-to-list 'tramp-methods
- '("scp"
- (tramp-login-program "ssh")
- (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
- ("-e" "none") ("%h")))
- (tramp-async-args (("-q")))
- (tramp-remote-shell "/bin/sh")
- (tramp-remote-shell-login ("-l"))
- (tramp-remote-shell-args ("-c"))
- (tramp-copy-program "scp")
- (tramp-copy-args (("-P" "%p") ("-p" "%k") ("-q")
("-r") ("%c")))
- (tramp-copy-keep-date t)
- (tramp-copy-recursive t)))
- (add-to-list 'tramp-methods
- '("scpx"
- (tramp-login-program "ssh")
- (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
- ("-e" "none") ("-t" "-t") ("%h")
("/bin/sh")))
- (tramp-async-args (("-q")))
- (tramp-remote-shell "/bin/sh")
- (tramp-remote-shell-login ("-l"))
- (tramp-remote-shell-args ("-c"))
- (tramp-copy-program "scp")
- (tramp-copy-args (("-P" "%p") ("-p" "%k")
- ("-q") ("-r") ("%c")))
- (tramp-copy-keep-date t)
- (tramp-copy-recursive t)))
- (add-to-list 'tramp-methods
- '("rsync"
- (tramp-login-program "ssh")
- (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
- ("-e" "none") ("%h")))
- (tramp-async-args (("-q")))
- (tramp-remote-shell "/bin/sh")
- (tramp-remote-shell-login ("-l"))
- (tramp-remote-shell-args ("-c"))
- (tramp-copy-program "rsync")
- (tramp-copy-args (("-t" "%k") ("-p") ("-r") ("-s")
("-c")))
- (tramp-copy-env (("RSYNC_RSH") ("ssh" "%c")))
- (tramp-copy-keep-date t)
- (tramp-copy-keep-tmpfile t)
- (tramp-copy-recursive t)))
- (add-to-list 'tramp-methods
- '("rsh"
- (tramp-login-program "rsh")
- (tramp-login-args (("%h") ("-l" "%u")))
- (tramp-remote-shell "/bin/sh")
- (tramp-remote-shell-login ("-l"))
- (tramp-remote-shell-args ("-c"))))
- (add-to-list 'tramp-methods
- '("remsh"
- (tramp-login-program "remsh")
- (tramp-login-args (("%h") ("-l" "%u")))
- (tramp-remote-shell "/bin/sh")
- (tramp-remote-shell-login ("-l"))
- (tramp-remote-shell-args ("-c"))))
- (add-to-list 'tramp-methods
- '("ssh"
- (tramp-login-program "ssh")
- (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
- ("-e" "none") ("%h")))
- (tramp-async-args (("-q")))
- (tramp-remote-shell "/bin/sh")
- (tramp-remote-shell-login ("-l"))
- (tramp-remote-shell-args ("-c"))))
- (add-to-list 'tramp-methods
- '("sshx"
- (tramp-login-program "ssh")
- (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
- ("-e" "none") ("-t" "-t") ("%h")
("/bin/sh")))
- (tramp-async-args (("-q")))
- (tramp-remote-shell "/bin/sh")
- (tramp-remote-shell-login ("-l"))
- (tramp-remote-shell-args ("-c"))))
- (add-to-list 'tramp-methods
- '("telnet"
- (tramp-login-program "telnet")
- (tramp-login-args (("%h") ("%p") ("2>/dev/null")))
- (tramp-remote-shell "/bin/sh")
- (tramp-remote-shell-login ("-l"))
- (tramp-remote-shell-args ("-c"))))
- (add-to-list 'tramp-methods
- '("nc"
- (tramp-login-program "telnet")
- (tramp-login-args (("%h") ("%p") ("2>/dev/null")))
- (tramp-remote-shell "/bin/sh")
- (tramp-remote-shell-login ("-l"))
- (tramp-remote-shell-args ("-c"))
- (tramp-copy-program "nc")
- ;; We use "-v" for better error tracking.
- (tramp-copy-args (("-w" "1") ("-v") ("%h") ("%r")))
- (tramp-remote-copy-program "nc")
- ;; We use "-p" as required for newer busyboxes. For older
- ;; busybox/nc versions, the value must be (("-l") ("%r")).
This
- ;; can be achieved by tweaking `tramp-connection-properties'.
- (tramp-remote-copy-args (("-l") ("-p" "%r")
("2>/dev/null")))))
- (add-to-list 'tramp-methods
- '("su"
- (tramp-login-program "su")
- (tramp-login-args (("-") ("%u")))
- (tramp-remote-shell "/bin/sh")
- (tramp-remote-shell-login ("-l"))
- (tramp-remote-shell-args ("-c"))
- (tramp-connection-timeout 10)))
- (add-to-list 'tramp-methods
- '("sg"
- (tramp-login-program "sg")
- (tramp-login-args (("-") ("%u")))
- (tramp-remote-shell "/bin/sh")
- (tramp-remote-shell-args ("-c"))
- (tramp-connection-timeout 10)))
- (add-to-list 'tramp-methods
- '("sudo"
- (tramp-login-program "sudo")
- ;; The password template must be masked. Otherwise, it could
be
- ;; interpreted as password prompt if the remote host echoes
the command.
- (tramp-login-args (("-u" "%u") ("-s") ("-H")
- ("-p"
"P\"\"a\"\"s\"\"s\"\"w\"\"o\"\"r\"\"d\"\":")))
- ;; Local $SHELL could be a nasty one, like zsh or fish. Let's
override it.
- (tramp-login-env (("SHELL") ("/bin/sh")))
- (tramp-remote-shell "/bin/sh")
- (tramp-remote-shell-login ("-l"))
- (tramp-remote-shell-args ("-c"))
- (tramp-connection-timeout 10)
- (tramp-session-timeout 300)))
- (add-to-list 'tramp-methods
- '("doas"
- (tramp-login-program "doas")
- (tramp-login-args (("-u" "%u") ("-s")))
- (tramp-remote-shell "/bin/sh")
- (tramp-remote-shell-args ("-c"))
- (tramp-connection-timeout 10)
- (tramp-session-timeout 300)))
- (add-to-list 'tramp-methods
- '("ksu"
- (tramp-login-program "ksu")
- (tramp-login-args (("%u") ("-q")))
- (tramp-remote-shell "/bin/sh")
- (tramp-remote-shell-login ("-l"))
- (tramp-remote-shell-args ("-c"))
- (tramp-connection-timeout 10)))
- (add-to-list 'tramp-methods
- '("krlogin"
- (tramp-login-program "krlogin")
- (tramp-login-args (("%h") ("-l" "%u") ("-x")))
- (tramp-remote-shell "/bin/sh")
- (tramp-remote-shell-login ("-l"))
- (tramp-remote-shell-args ("-c"))))
- (add-to-list 'tramp-methods
- `("plink"
- (tramp-login-program "plink")
- (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh")
("-t")
- ("%h") ("\"")
- (,(format
- "env 'TERM=%s'
'PROMPT_COMMAND=' 'PS1=%s'"
- tramp-terminal-type
- tramp-initial-end-of-output))
- ("/bin/sh") ("\"")))
- (tramp-remote-shell "/bin/sh")
- (tramp-remote-shell-login ("-l"))
- (tramp-remote-shell-args ("-c"))))
- (add-to-list 'tramp-methods
- `("plinkx"
- (tramp-login-program "plink")
- (tramp-login-args (("-load") ("%h") ("-t") ("\"")
- (,(format
- "env 'TERM=%s'
'PROMPT_COMMAND=' 'PS1=%s'"
- tramp-terminal-type
- tramp-initial-end-of-output))
- ("/bin/sh") ("\"")))
- (tramp-remote-shell "/bin/sh")
- (tramp-remote-shell-login ("-l"))
- (tramp-remote-shell-args ("-c"))))
- (add-to-list 'tramp-methods
- `("pscp"
- (tramp-login-program "plink")
- (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh")
("-t")
- ("%h") ("\"")
- (,(format
- "env 'TERM=%s'
'PROMPT_COMMAND=' 'PS1=%s'"
- tramp-terminal-type
- tramp-initial-end-of-output))
- ("/bin/sh") ("\"")))
- (tramp-remote-shell "/bin/sh")
- (tramp-remote-shell-login ("-l"))
- (tramp-remote-shell-args ("-c"))
- (tramp-copy-program "pscp")
- (tramp-copy-args (("-l" "%u") ("-P" "%p") ("-scp")
("-p" "%k")
- ("-q") ("-r")))
- (tramp-copy-keep-date t)
- (tramp-copy-recursive t)))
- (add-to-list 'tramp-methods
- `("psftp"
- (tramp-login-program "plink")
- (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh")
("-t")
- ("%h") ("\"")
- (,(format
- "env 'TERM=%s'
'PROMPT_COMMAND=' 'PS1=%s'"
- tramp-terminal-type
- tramp-initial-end-of-output))
- ("/bin/sh") ("\"")))
- (tramp-remote-shell "/bin/sh")
- (tramp-remote-shell-login ("-l"))
- (tramp-remote-shell-args ("-c"))
- (tramp-copy-program "pscp")
- (tramp-copy-args (("-l" "%u") ("-P" "%p") ("-sftp")
("-p" "%k")
- ("-q")))
- (tramp-copy-keep-date t)))
- (add-to-list 'tramp-methods
- '("fcp"
- (tramp-login-program "fsh")
- (tramp-login-args (("%h") ("-l" "%u") ("sh" "-i")))
- (tramp-remote-shell "/bin/sh")
- (tramp-remote-shell-login ("-l"))
- (tramp-remote-shell-args ("-i") ("-c"))
- (tramp-copy-program "fcp")
- (tramp-copy-args (("-p" "%k")))
- (tramp-copy-keep-date t)))
-
- (add-to-list 'tramp-default-method-alist
- `(,tramp-local-host-regexp "\\`root\\'" "su"))
-
- (add-to-list 'tramp-default-user-alist
- `(,(concat "\\`" (regexp-opt '("su" "sudo" "doas" "ksu")) "\\'")
- nil "root"))
- ;; Do not add "ssh" based methods, otherwise ~/.ssh/config would be ignored.
- ;; Do not add "plink" based methods, they ask interactively for the user.
- (add-to-list 'tramp-default-user-alist
- `(,(concat
- "\\`"
- (regexp-opt
- '("rcp" "remcp" "rsh" "telnet" "nc" "krlogin" "fcp"))
- "\\'")
- nil ,(user-login-name))))
-
-;;;###tramp-autoload
-(defconst tramp-completion-function-alist-rsh
- '((tramp-parse-rhosts "/etc/hosts.equiv")
- (tramp-parse-rhosts "~/.rhosts"))
- "Default list of (FUNCTION FILE) pairs to be examined for rsh methods.")
-
-;;;###tramp-autoload
-(defconst tramp-completion-function-alist-ssh
- '((tramp-parse-rhosts "/etc/hosts.equiv")
- (tramp-parse-rhosts "/etc/shosts.equiv")
- (tramp-parse-shosts "/etc/ssh_known_hosts")
- (tramp-parse-sconfig "/etc/ssh_config")
- (tramp-parse-shostkeys "/etc/ssh2/hostkeys")
- (tramp-parse-sknownhosts "/etc/ssh2/knownhosts")
- (tramp-parse-rhosts "~/.rhosts")
- (tramp-parse-rhosts "~/.shosts")
- (tramp-parse-shosts "~/.ssh/known_hosts")
- (tramp-parse-sconfig "~/.ssh/config")
- (tramp-parse-shostkeys "~/.ssh2/hostkeys")
- (tramp-parse-sknownhosts "~/.ssh2/knownhosts"))
- "Default list of (FUNCTION FILE) pairs to be examined for ssh methods.")
-
-;;;###tramp-autoload
-(defconst tramp-completion-function-alist-telnet
- '((tramp-parse-hosts "/etc/hosts"))
- "Default list of (FUNCTION FILE) pairs to be examined for telnet methods.")
-
-;;;###tramp-autoload
-(defconst tramp-completion-function-alist-su
- '((tramp-parse-passwd "/etc/passwd"))
- "Default list of (FUNCTION FILE) pairs to be examined for su methods.")
-
-;;;###tramp-autoload
-(defconst tramp-completion-function-alist-sg
- '((tramp-parse-etc-group "/etc/group"))
- "Default list of (FUNCTION FILE) pairs to be examined for sg methods.")
-
-;;;###tramp-autoload
-(defconst tramp-completion-function-alist-putty
- `((tramp-parse-putty
- ,(if (memq system-type '(windows-nt))
- "HKEY_CURRENT_USER\\Software\\SimonTatham\\PuTTY\\Sessions"
- "~/.putty/sessions")))
- "Default list of (FUNCTION REGISTRY) pairs to be examined for putty
sessions.")
-
-;;;###tramp-autoload
-(tramp--with-startup
- (tramp-set-completion-function "rcp" tramp-completion-function-alist-rsh)
- (tramp-set-completion-function "remcp" tramp-completion-function-alist-rsh)
- (tramp-set-completion-function "scp" tramp-completion-function-alist-ssh)
- (tramp-set-completion-function "scpx" tramp-completion-function-alist-ssh)
- (tramp-set-completion-function "rsync" tramp-completion-function-alist-ssh)
- (tramp-set-completion-function "rsh" tramp-completion-function-alist-rsh)
- (tramp-set-completion-function "remsh" tramp-completion-function-alist-rsh)
- (tramp-set-completion-function "ssh" tramp-completion-function-alist-ssh)
- (tramp-set-completion-function "sshx" tramp-completion-function-alist-ssh)
- (tramp-set-completion-function
- "telnet" tramp-completion-function-alist-telnet)
- (tramp-set-completion-function "nc" tramp-completion-function-alist-telnet)
- (tramp-set-completion-function "su" tramp-completion-function-alist-su)
- (tramp-set-completion-function "sudo" tramp-completion-function-alist-su)
- (tramp-set-completion-function "doas" tramp-completion-function-alist-su)
- (tramp-set-completion-function "ksu" tramp-completion-function-alist-su)
- (tramp-set-completion-function "sg" tramp-completion-function-alist-sg)
- (tramp-set-completion-function
- "krlogin" tramp-completion-function-alist-rsh)
- (tramp-set-completion-function "plink" tramp-completion-function-alist-ssh)
- (tramp-set-completion-function
- "plinkx" tramp-completion-function-alist-putty)
- (tramp-set-completion-function "pscp" tramp-completion-function-alist-ssh)
- (tramp-set-completion-function "psftp" tramp-completion-function-alist-ssh)
- (tramp-set-completion-function "fcp" tramp-completion-function-alist-ssh))
-
-;; "getconf PATH" yields:
-;; HP-UX:
/usr/bin:/usr/ccs/bin:/opt/ansic/bin:/opt/langtools/bin:/opt/fortran/bin
-;; Solaris: /usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/SUNWspro/bin
-;; GNU/Linux (Debian, Suse, RHEL): /bin:/usr/bin
-;; FreeBSD: /usr/bin:/bin:/usr/sbin:/sbin: - beware trailing ":"!
-;; Darwin: /usr/bin:/bin:/usr/sbin:/sbin
-;; IRIX64: /usr/bin
-;; QNAP QTS: ---
-;;;###tramp-autoload
-(defcustom tramp-remote-path
- '(tramp-default-remote-path "/bin" "/usr/bin" "/sbin" "/usr/sbin"
- "/usr/local/bin" "/usr/local/sbin" "/local/bin" "/local/freeware/bin"
- "/local/gnu/bin" "/usr/freeware/bin" "/usr/pkg/bin" "/usr/contrib/bin"
- "/opt/bin" "/opt/sbin" "/opt/local/bin")
- "List of directories to search for executables on remote host.
-For every remote host, this variable will be set buffer local,
-keeping the list of existing directories on that host.
-
-You can use `~' in this list, but when searching for a shell which groks
-tilde expansion, all directory names starting with `~' will be ignored.
-
-`Default Directories' represent the list of directories given by
-the command \"getconf PATH\". It is recommended to use this
-entry on head of this list, because these are the default
-directories for POSIX compatible commands. On remote hosts which
-do not offer the getconf command (like cygwin), the value
-\"/bin:/usr/bin\" is used instead. This entry is represented in
-the list by the special value `tramp-default-remote-path'.
-
-`Private Directories' are the settings of the $PATH environment,
-as given in your `~/.profile'. This entry is represented in
-the list by the special value `tramp-own-remote-path'."
- :group 'tramp
- :type '(repeat (choice
- (const :tag "Default Directories" tramp-default-remote-path)
- (const :tag "Private Directories" tramp-own-remote-path)
- (string :tag "Directory"))))
-
-;;;###tramp-autoload
-(defcustom tramp-remote-process-environment
- '("ENV=''" "TMOUT=0" "LC_CTYPE=''"
- "CDPATH=" "HISTORY=" "MAIL=" "MAILCHECK=" "MAILPATH=" "PAGER=cat"
- "autocorrect=" "correct=")
- "List of environment variables to be set on the remote host.
-
-Each element should be a string of the form ENVVARNAME=VALUE. An
-entry ENVVARNAME= disables the corresponding environment variable,
-which might have been set in the init files like ~/.profile.
-
-Special handling is applied to some environment variables,
-which should not be set here:
-
-The PATH environment variable should be set via `tramp-remote-path'.
-
-The TERM environment variable should be set via `tramp-terminal-type'.
-
-The INSIDE_EMACS environment variable will automatically be set
-based on the Tramp and Emacs versions, and should not be set here."
- :group 'tramp
- :version "26.1"
- :type '(repeat string))
-
-;;;###tramp-autoload
-(defcustom tramp-sh-extra-args '(("/bash\\'" . "-norc -noprofile"))
- "Alist specifying extra arguments to pass to the remote shell.
-Entries are (REGEXP . ARGS) where REGEXP is a regular expression
-matching the shell file name and ARGS is a string specifying the
-arguments.
-
-This variable is only used when Tramp needs to start up another shell
-for tilde expansion. The extra arguments should typically prevent the
-shell from reading its init file."
- :group 'tramp
- :type '(alist :key-type regexp :value-type string))
-
-(defconst tramp-actions-before-shell
- '((tramp-login-prompt-regexp tramp-action-login)
- (tramp-password-prompt-regexp tramp-action-password)
- (tramp-wrong-passwd-regexp tramp-action-permission-denied)
- (shell-prompt-pattern tramp-action-succeed)
- (tramp-shell-prompt-pattern tramp-action-succeed)
- (tramp-yesno-prompt-regexp tramp-action-yesno)
- (tramp-yn-prompt-regexp tramp-action-yn)
- (tramp-terminal-prompt-regexp tramp-action-terminal)
- (tramp-process-alive-regexp tramp-action-process-alive))
- "List of pattern/action pairs.
-Whenever a pattern matches, the corresponding action is performed.
-Each item looks like (PATTERN ACTION).
-
-The PATTERN should be a symbol, a variable. The value of this
-variable gives the regular expression to search for. Note that the
-regexp must match at the end of the buffer, \"\\'\" is implicitly
-appended to it.
-
-The ACTION should also be a symbol, but a function. When the
-corresponding PATTERN matches, the ACTION function is called.")
-
-(defconst tramp-actions-copy-out-of-band
- '((tramp-password-prompt-regexp tramp-action-password)
- (tramp-wrong-passwd-regexp tramp-action-permission-denied)
- (tramp-copy-failed-regexp tramp-action-permission-denied)
- (tramp-process-alive-regexp tramp-action-out-of-band))
- "List of pattern/action pairs.
-This list is used for copying/renaming with out-of-band methods.
-
-See `tramp-actions-before-shell' for more info.")
-
-(defconst tramp-uudecode
- "(echo begin 600 %t; tail -n +2) | uudecode
-cat %t
-rm -f %t"
- "Shell function to implement `uudecode' to standard output.
-Many systems support `uudecode -o /dev/stdout' or `uudecode -o -'
-for this or `uudecode -p', but some systems don't, and for them
-we have this shell function.")
-
-(defconst tramp-perl-file-truename
- "%s -e '
-use File::Spec;
-use Cwd \"realpath\";
-
-sub myrealpath {
- my ($file) = @_;
- return realpath($file) if (-e $file || -l $file);
-}
-
-sub recursive {
- my ($volume, @dirs) = @_;
- my $real = myrealpath(File::Spec->catpath(
- $volume, File::Spec->catdir(@dirs), \"\"));
- if ($real) {
- my ($vol, $dir) = File::Spec->splitpath($real, 1);
- return ($vol, File::Spec->splitdir($dir));
- }
- else {
- my $last = pop(@dirs);
- ($volume, @dirs) = recursive($volume, @dirs);
- push(@dirs, $last);
- return ($volume, @dirs);
- }
-}
-
-$result = myrealpath($ARGV[0]);
-if (!$result) {
- my ($vol, $dir) = File::Spec->splitpath($ARGV[0], 1);
- ($vol, @dirs) = recursive($vol, File::Spec->splitdir($dir));
-
- $result = File::Spec->catpath($vol, File::Spec->catdir(@dirs), \"\");
-}
-
-$result =~ s/\"/\\\\\"/g;
-print \"\\\"$result\\\"\\n\";
-' \"$1\" 2>/dev/null"
- "Perl script to produce output suitable for use with `file-truename'
-on the remote file system.
-Escape sequence %s is replaced with name of Perl binary.
-This string is passed to `format', so percent characters need to be doubled.")
-
-(defconst tramp-perl-file-name-all-completions
- "%s -e '
-opendir(d, $ARGV[0]) || die(\"$ARGV[0]: $!\\nfail\\n\");
address@hidden = readdir(d); closedir(d);
-foreach $f (@files) {
- if (-d \"$ARGV[0]/$f\") {
- print \"$f/\\n\";
- }
- else {
- print \"$f\\n\";
- }
-}
-print \"ok\\n\"
-' \"$1\" 2>/dev/null"
- "Perl script to produce output suitable for use with
-`file-name-all-completions' on the remote file system. Escape
-sequence %s is replaced with name of Perl binary. This string is
-passed to `format', so percent characters need to be doubled.")
-
-;; Perl script to implement `file-attributes' in a Lisp `read'able
-;; output. If you are hacking on this, note that you get *no* output
-;; unless this spits out a complete line, including the '\n' at the
-;; end.
-;; The device number is returned as "-1", because there will be a virtual
-;; device number set in `tramp-sh-handle-file-attributes'.
-(defconst tramp-perl-file-attributes
- "%s -e '
address@hidden = lstat($ARGV[0]);
-if (address@hidden) {
- print \"nil\\n\";
- exit 0;
-}
-if (($stat[2] & 0170000) == 0120000)
-{
- $type = readlink($ARGV[0]);
- $type =~ s/\"/\\\\\"/g;
- $type = \"\\\"$type\\\"\";
-}
-elsif (($stat[2] & 0170000) == 040000)
-{
- $type = \"t\";
-}
-else
-{
- $type = \"nil\"
-};
-$uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) .
\"\\\"\";
-$gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) .
\"\\\"\";
-printf(
- \"(%%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u %%u t %%u -1)\\n\",
- $type,
- $stat[3],
- $uid,
- $gid,
- $stat[8] >> 16 & 0xffff,
- $stat[8] & 0xffff,
- $stat[9] >> 16 & 0xffff,
- $stat[9] & 0xffff,
- $stat[10] >> 16 & 0xffff,
- $stat[10] & 0xffff,
- $stat[7],
- $stat[2],
- $stat[1]
-);' \"$1\" \"$2\" 2>/dev/null"
- "Perl script to produce output suitable for use with `file-attributes'
-on the remote file system.
-Escape sequence %s is replaced with name of Perl binary.
-This string is passed to `format', so percent characters need to be doubled.")
-
-(defconst tramp-perl-directory-files-and-attributes
- "%s -e '
-chdir($ARGV[0]) or printf(\"\\\"Cannot change to $ARGV[0]: $''!''\\\"\\n\"),
exit();
-opendir(DIR,\".\") or printf(\"\\\"Cannot open directory $ARGV[0]:
$''!''\\\"\\n\"), exit();
address@hidden = readdir(DIR);
-closedir(DIR);
-$n = scalar(@list);
-printf(\"(\\n\");
-for($i = 0; $i < $n; $i++)
-{
- $filename = $list[$i];
- @stat = lstat($filename);
- if (($stat[2] & 0170000) == 0120000)
- {
- $type = readlink($filename);
- $type =~ s/\"/\\\\\"/g;
- $type = \"\\\"$type\\\"\";
- }
- elsif (($stat[2] & 0170000) == 040000)
- {
- $type = \"t\";
- }
- else
- {
- $type = \"nil\"
- };
- $uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" .
getpwuid($stat[4]) . \"\\\"\";
- $gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" .
getgrgid($stat[5]) . \"\\\"\";
- $filename =~ s/\"/\\\\\"/g;
- printf(
- \"(\\\"%%s\\\" %%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u.0 %%u
t (%%u . %%u) (%%u . %%u))\\n\",
- $filename,
- $type,
- $stat[3],
- $uid,
- $gid,
- $stat[8] >> 16 & 0xffff,
- $stat[8] & 0xffff,
- $stat[9] >> 16 & 0xffff,
- $stat[9] & 0xffff,
- $stat[10] >> 16 & 0xffff,
- $stat[10] & 0xffff,
- $stat[7],
- $stat[2],
- $stat[1] >> 16 & 0xffff,
- $stat[1] & 0xffff,
- $stat[0] >> 16 & 0xffff,
- $stat[0] & 0xffff);
-}
-printf(\")\\n\");' \"$1\" \"$2\" 2>/dev/null"
- "Perl script implementing `directory-files-attributes' as Lisp `read'able
-output.
-Escape sequence %s is replaced with name of Perl binary.
-This string is passed to `format', so percent characters need to be doubled.")
-
-;; These two use base64 encoding.
-(defconst tramp-perl-encode-with-module
- "%s -MMIME::Base64 -0777 -ne 'print encode_base64($_)' 2>/dev/null"
- "Perl program to use for encoding a file.
-Escape sequence %s is replaced with name of Perl binary.
-This string is passed to `format', so percent characters need to be doubled.
-This implementation requires the MIME::Base64 Perl module to be installed
-on the remote host.")
-
-(defconst tramp-perl-decode-with-module
- "%s -MMIME::Base64 -0777 -ne 'print decode_base64($_)' 2>/dev/null"
- "Perl program to use for decoding a file.
-Escape sequence %s is replaced with name of Perl binary.
-This string is passed to `format', so percent characters need to be doubled.
-This implementation requires the MIME::Base64 Perl module to be installed
-on the remote host.")
-
-(defconst tramp-perl-encode
- "%s -e '
-# This script contributed by Juanma Barranquero <address@hidden>.
-# Copyright (C) 2002-2019 Free Software Foundation, Inc.
-use strict;
-
-my %%trans = do {
- my $i = 0;
- map {(substr(unpack(q(B8), chr $i++), 2, 6), $_)}
- split //,
q(ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/);
-};
-my $data;
-
-# We read in chunks of 54 bytes, to generate output lines
-# of 72 chars (plus end of line)
-while (read STDIN, $data, 54) {
- my $pad = q();
-
- # Only for the last chunk, and only if did not fill the last three-byte
packet
- if (eof) {
- my $mod = length($data) %% 3;
- $pad = q(=) x (3 - $mod) if $mod;
- }
-
- # Not the fastest method, but it is simple: unpack to binary string, split
- # by groups of 6 bits and convert back from binary to byte; then map into
- # the translation table
- print
- join q(),
- map($trans{$_},
- (substr(unpack(q(B*), $data) . q(00000), 0, 432) =~ /....../g)),
- $pad,
- qq(\\n);
-}' 2>/dev/null"
- "Perl program to use for encoding a file.
-Escape sequence %s is replaced with name of Perl binary.
-This string is passed to `format', so percent characters need to be doubled.")
-
-(defconst tramp-perl-decode
- "%s -e '
-# This script contributed by Juanma Barranquero <address@hidden>.
-# Copyright (C) 2002-2019 Free Software Foundation, Inc.
-use strict;
-
-my %%trans = do {
- my $i = 0;
- map {($_, substr(unpack(q(B8), chr $i++), 2, 6))}
- split //,
q(ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/)
-};
-
-my %%bytes = map {(unpack(q(B8), chr $_), chr $_)} 0 .. 255;
-
-binmode(\\*STDOUT);
-
-# We are going to accumulate into $pending to accept any line length
-# (we do not check they are <= 76 chars as the RFC says)
-my $pending = q();
-
-while (my $data = <STDIN>) {
- chomp $data;
-
- # If we find one or two =, we have reached the end and
- # any following data is to be discarded
- my $finished = $data =~ s/(==?).*/$1/;
- $pending .= $data;
-
- my $len = length($pending);
- my $chunk = substr($pending, 0, $len & ~3);
- $pending = substr($pending, $len & ~3 + 1);
-
- # Easy method: translate from chars to (pregenerated) six-bit packets,
join,
- # split in 8-bit chunks and convert back to char.
- print join q(),
- map $bytes{$_},
- ((join q(), map {$trans{$_} || q()} split //, $chunk) =~ /......../g);
-
- last if $finished;
-}' 2>/dev/null"
- "Perl program to use for decoding a file.
-Escape sequence %s is replaced with name of Perl binary.
-This string is passed to `format', so percent characters need to be doubled.")
-
-(defconst tramp-perl-pack
- "%s -e 'binmode STDIN; binmode STDOUT; print pack(q{u*}, join q{}, <>)'"
- "Perl program to use for encoding a file.
-Escape sequence %s is replaced with name of Perl binary.")
-
-(defconst tramp-perl-unpack
- "%s -e 'binmode STDIN; binmode STDOUT; print unpack(q{u*}, join q{}, <>)'"
- "Perl program to use for decoding a file.
-Escape sequence %s is replaced with name of Perl binary.")
-
-(defconst tramp-awk-encode
- "od -v -t x1 -A n | busybox awk '\\
-BEGIN {
- b64 = \"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/\"
- b16 = \"0123456789abcdef\"
-}
-{
- for (c=1; c<=length($0); c++) {
- d=index(b16, substr($0,c,1))
- if (d--) {
- for (b=1; b<=4; b++) {
- o=o*2+int(d/8); d=(d*2)%%16
- if (++obc==6) {
- printf substr(b64,o+1,1)
- if (++rc>75) { printf \"\\n\"; rc=0 }
- obc=0; o=0
- }
- }
- }
- }
-}
-END {
- if (obc) {
- tail=(obc==2) ? \"==\\n\" : \"=\\n\"
- while (obc++<6) { o=o*2 }
- printf \"%%c\", substr(b64,o+1,1)
- } else {
- tail=\"\\n\"
- }
- printf tail
-}'"
- "Awk program to use for encoding a file.
-This string is passed to `format', so percent characters need to be doubled.")
-
-(defconst tramp-awk-decode
- "busybox awk '\\
-BEGIN {
- b64 = \"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/\"
-}
-{
- for (i=1; i<=length($0); i++) {
- c=index(b64, substr($0,i,1))
- if(c--) {
- for(b=0; b<6; b++) {
- o=o*2+int(c/32); c=(c*2)%%64
- if(++obc==8) {
- if (o) {
- printf \"%%c\", o
- } else {
- system(\"dd if=/dev/zero bs=1 count=1 2>/dev/null\")
- }
- obc=0; o=0
- }
- }
- }
- }
-}'"
- "Awk program to use for decoding a file.
-This string is passed to `format', so percent characters need to be doubled.")
-
-(defconst tramp-awk-coding-test
- "test -c /dev/zero && \
-od -v -t x1 -A n </dev/null && \
-busybox awk '{}' </dev/null"
- "Test command for checking `tramp-awk-encode' and `tramp-awk-decode'.")
-
-(defconst tramp-vc-registered-read-file-names
- "echo \"(\"
-while read file; do
- quoted=`echo \"$file\" | sed -e \"s/\\\"/\\\\\\\\\\\\\\\\\\\"/\"`
- if %s \"$file\"; then
- echo \"(\\\"$quoted\\\" \\\"file-exists-p\\\" t)\"
- else
- echo \"(\\\"$quoted\\\" \\\"file-exists-p\\\" nil)\"
- fi
- if %s \"$file\"; then
- echo \"(\\\"$quoted\\\" \\\"file-readable-p\\\" t)\"
- else
- echo \"(\\\"$quoted\\\" \\\"file-readable-p\\\" nil)\"
- fi
-done
-echo \")\""
- "Script to check existence of VC related files.
-It must be send formatted with two strings; the tests for file
-existence, and file readability. Input shall be read via
-here-document, otherwise the command could exceed maximum length
-of command line.")
-
-;; New handlers should be added here.
-;;;###tramp-autoload
-(defconst tramp-sh-file-name-handler-alist
- '((access-file . tramp-handle-access-file)
- (add-name-to-file . tramp-sh-handle-add-name-to-file)
- ;; `byte-compiler-base-file-name' performed by default handler.
- (copy-directory . tramp-sh-handle-copy-directory)
- (copy-file . tramp-sh-handle-copy-file)
- (delete-directory . tramp-sh-handle-delete-directory)
- (delete-file . tramp-sh-handle-delete-file)
- ;; `diff-latest-backup-file' performed by default handler.
- (directory-file-name . tramp-handle-directory-file-name)
- (directory-files . tramp-handle-directory-files)
- (directory-files-and-attributes
- . tramp-sh-handle-directory-files-and-attributes)
- (dired-compress-file . tramp-sh-handle-dired-compress-file)
- (dired-uncache . tramp-handle-dired-uncache)
- (exec-path . tramp-sh-handle-exec-path)
- (expand-file-name . tramp-sh-handle-expand-file-name)
- (file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
- (file-acl . tramp-sh-handle-file-acl)
- (file-attributes . tramp-sh-handle-file-attributes)
- (file-directory-p . tramp-sh-handle-file-directory-p)
- (file-equal-p . tramp-handle-file-equal-p)
- (file-executable-p . tramp-sh-handle-file-executable-p)
- (file-exists-p . tramp-sh-handle-file-exists-p)
- (file-in-directory-p . tramp-handle-file-in-directory-p)
- (file-local-copy . tramp-sh-handle-file-local-copy)
- (file-modes . tramp-handle-file-modes)
- (file-name-all-completions . tramp-sh-handle-file-name-all-completions)
- (file-name-as-directory . tramp-handle-file-name-as-directory)
- (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p)
- (file-name-completion . tramp-handle-file-name-completion)
- (file-name-directory . tramp-handle-file-name-directory)
- (file-name-nondirectory . tramp-handle-file-name-nondirectory)
- ;; `file-name-sans-versions' performed by default handler.
- (file-newer-than-file-p . tramp-sh-handle-file-newer-than-file-p)
- (file-notify-add-watch . tramp-sh-handle-file-notify-add-watch)
- (file-notify-rm-watch . tramp-handle-file-notify-rm-watch)
- (file-notify-valid-p . tramp-handle-file-notify-valid-p)
- (file-ownership-preserved-p . tramp-sh-handle-file-ownership-preserved-p)
- (file-readable-p . tramp-sh-handle-file-readable-p)
- (file-regular-p . tramp-handle-file-regular-p)
- (file-remote-p . tramp-handle-file-remote-p)
- (file-selinux-context . tramp-sh-handle-file-selinux-context)
- (file-symlink-p . tramp-handle-file-symlink-p)
- (file-system-info . tramp-sh-handle-file-system-info)
- (file-truename . tramp-sh-handle-file-truename)
- (file-writable-p . tramp-sh-handle-file-writable-p)
- (find-backup-file-name . tramp-handle-find-backup-file-name)
- ;; `get-file-buffer' performed by default handler.
- (insert-directory . tramp-sh-handle-insert-directory)
- (insert-file-contents . tramp-handle-insert-file-contents)
- (load . tramp-handle-load)
- (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
- (make-directory . tramp-sh-handle-make-directory)
- ;; `make-directory-internal' performed by default handler.
- (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
- (make-process . tramp-sh-handle-make-process)
- (make-symbolic-link . tramp-sh-handle-make-symbolic-link)
- (process-file . tramp-sh-handle-process-file)
- (rename-file . tramp-sh-handle-rename-file)
- (set-file-acl . tramp-sh-handle-set-file-acl)
- (set-file-modes . tramp-sh-handle-set-file-modes)
- (set-file-selinux-context . tramp-sh-handle-set-file-selinux-context)
- (set-file-times . tramp-sh-handle-set-file-times)
- (set-visited-file-modtime . tramp-sh-handle-set-visited-file-modtime)
- (shell-command . tramp-handle-shell-command)
- (start-file-process . tramp-handle-start-file-process)
- (substitute-in-file-name . tramp-handle-substitute-in-file-name)
- (temporary-file-directory . tramp-handle-temporary-file-directory)
- (tramp-set-file-uid-gid . tramp-sh-handle-set-file-uid-gid)
- (unhandled-file-name-directory . ignore)
- (vc-registered . tramp-sh-handle-vc-registered)
- (verify-visited-file-modtime . tramp-sh-handle-verify-visited-file-modtime)
- (write-region . tramp-sh-handle-write-region))
- "Alist of handler functions.
-Operations not mentioned here will be handled by the normal Emacs functions.")
-
-;;; File Name Handler Functions:
-
-(defun tramp-sh-handle-make-symbolic-link
- (target linkname &optional ok-if-already-exists)
- "Like `make-symbolic-link' for Tramp files.
-If TARGET is a non-Tramp file, it is used verbatim as the target
-of the symlink. If TARGET is a Tramp file, only the localname
-component is used as the target of the symlink."
- (if (not (tramp-tramp-file-p (expand-file-name linkname)))
- (tramp-run-real-handler
- #'make-symbolic-link (list target linkname ok-if-already-exists))
-
- (with-parsed-tramp-file-name linkname nil
- ;; If TARGET is a Tramp name, use just the localname component.
- (when (and (tramp-tramp-file-p target)
- (tramp-file-name-equal-p v (tramp-dissect-file-name target)))
- (setq target
- (tramp-file-name-localname
- (tramp-dissect-file-name (expand-file-name target)))))
-
- ;; If TARGET is still remote, quote it.
- (if (tramp-tramp-file-p target)
- (make-symbolic-link
- (let (file-name-handler-alist) (tramp-compat-file-name-quote target))
- linkname ok-if-already-exists)
-
- (let ((ln (tramp-get-remote-ln v))
- (cwd (tramp-run-real-handler
- #'file-name-directory (list localname))))
- (unless ln
- (tramp-error
- v 'file-error
- "Making a symbolic link. ln(1) does not exist on the remote host."))
-
- ;; Do the 'confirm if exists' thing.
- (when (file-exists-p linkname)
- ;; What to do?
- (if (or (null ok-if-already-exists) ; not allowed to exist
- (and (numberp ok-if-already-exists)
- (not
- (yes-or-no-p
- (format
- "File %s already exists; make it a link anyway? "
- localname)))))
- (tramp-error v 'file-already-exists localname)
- (delete-file linkname)))
-
- (tramp-flush-file-properties v (file-name-directory localname))
- (tramp-flush-file-properties v localname)
-
- ;; Right, they are on the same host, regardless of user,
- ;; method, etc. We now make the link on the remote
- ;; machine. This will occur as the user that TARGET belongs to.
- (and (tramp-send-command-and-check
- v (format "cd %s" (tramp-shell-quote-argument cwd)))
- (tramp-send-command-and-check
- v (format
- "%s -sf %s %s" ln
- (tramp-shell-quote-argument target)
- ;; The command could exceed PATH_MAX, so we use
- ;; relative file names. However, relative file
- ;; names could start with "-".
- ;; `tramp-shell-quote-argument' does not handle
- ;; this, we must do it ourselves.
- (tramp-shell-quote-argument
- (concat "./" (file-name-nondirectory localname)))))))))))
-
-(defun tramp-sh-handle-file-truename (filename)
- "Like `file-truename' for Tramp files."
- ;; Preserve trailing "/".
- (funcall
- (if (string-equal (file-name-nondirectory filename) "")
- #'file-name-as-directory #'identity)
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (tramp-make-tramp-file-name
- v
- (with-tramp-file-property v localname "file-truename"
- (let ((result nil) ; result steps in reverse order
- (quoted (tramp-compat-file-name-quoted-p localname))
- (localname (tramp-compat-file-name-unquote localname)))
- (tramp-message v 4 "Finding true name for `%s'" filename)
- (cond
- ;; Use GNU readlink --canonicalize-missing where available.
- ((tramp-get-remote-readlink v)
- (tramp-send-command-and-check
- v
- (format "%s --canonicalize-missing %s"
- (tramp-get-remote-readlink v)
- (tramp-shell-quote-argument localname)))
- (with-current-buffer (tramp-get-connection-buffer v)
- (goto-char (point-min))
- (setq result (buffer-substring (point-min) (point-at-eol)))))
-
- ;; Use Perl implementation.
- ((and (tramp-get-remote-perl v)
- (tramp-get-connection-property v "perl-file-spec" nil)
- (tramp-get-connection-property v "perl-cwd-realpath" nil))
- (tramp-maybe-send-script
- v tramp-perl-file-truename "tramp_perl_file_truename")
- (setq result
- (tramp-send-command-and-read
- v
- (format "tramp_perl_file_truename %s"
- (tramp-shell-quote-argument localname)))))
-
- ;; Do it yourself.
- (t (let ((steps (split-string localname "/" 'omit))
- (thisstep nil)
- (numchase 0)
- ;; Don't make the following value larger than
- ;; necessary. People expect an error message in a
- ;; timely fashion when something is wrong;
- ;; otherwise they might think that Emacs is hung.
- ;; Of course, correctness has to come first.
- (numchase-limit 20)
- symlink-target)
- (while (and steps (< numchase numchase-limit))
- (setq thisstep (pop steps))
- (tramp-message
- v 5 "Check %s"
- (mapconcat #'identity
- (append '("") (reverse result) (list thisstep))
- "/"))
- (setq symlink-target
- (tramp-compat-file-attribute-type
- (file-attributes
- (tramp-make-tramp-file-name
- v
- (mapconcat #'identity
- (append '("")
- (reverse result)
- (list thisstep))
- "/")
- 'nohop))))
- (cond ((string= "." thisstep)
- (tramp-message v 5 "Ignoring step `.'"))
- ((string= ".." thisstep)
- (tramp-message v 5 "Processing step `..'")
- (pop result))
- ((stringp symlink-target)
- ;; It's a symlink, follow it.
- (tramp-message
- v 5 "Follow symlink to %s" symlink-target)
- (setq numchase (1+ numchase))
- (when (file-name-absolute-p symlink-target)
- (setq result nil))
- (setq steps
- (append
- (split-string symlink-target "/" 'omit) steps)))
- (t
- ;; It's a file.
- (setq result (cons thisstep result)))))
- (when (>= numchase numchase-limit)
- (tramp-error
- v 'file-error
- "Maximum number (%d) of symlinks exceeded" numchase-limit))
- (setq result (reverse result))
- ;; Combine list to form string.
- (setq result
- (if result
- (mapconcat #'identity (cons "" result) "/")
- "/"))
- (when (string= "" result)
- (setq result "/")))))
-
- ;; Detect cycle.
- (when (and (file-symlink-p filename)
- (string-equal result localname))
- (tramp-error
- v 'file-error
- "Apparent cycle of symbolic links for %s" filename))
- ;; If the resulting localname looks remote, we must quote it
- ;; for security reasons.
- (when (or quoted (file-remote-p result))
- (let (file-name-handler-alist)
- (setq result (tramp-compat-file-name-quote result))))
- (tramp-message v 4 "True name of `%s' is `%s'" localname result)
- result))
- 'nohop))))
-
-;; Basic functions.
-
-(defun tramp-sh-handle-file-exists-p (filename)
- "Like `file-exists-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (with-tramp-file-property v localname "file-exists-p"
- (or (not (null (tramp-get-file-property
- v localname "file-attributes-integer" nil)))
- (not (null (tramp-get-file-property
- v localname "file-attributes-string" nil)))
- (tramp-send-command-and-check
- v
- (format
- "%s %s"
- (tramp-get-file-exists-command v)
- (tramp-shell-quote-argument localname)))))))
-
-(defun tramp-sh-handle-file-attributes (filename &optional id-format)
- "Like `file-attributes' for Tramp files."
- (unless id-format (setq id-format 'integer))
- (ignore-errors
- ;; Don't modify `last-coding-system-used' by accident.
- (let ((last-coding-system-used last-coding-system-used))
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (with-tramp-file-property
- v localname (format "file-attributes-%s" id-format)
- (tramp-convert-file-attributes
- v
- (or
- (cond
- ((tramp-get-remote-stat v)
- (tramp-do-file-attributes-with-stat v localname id-format))
- ((tramp-get-remote-perl v)
- (tramp-do-file-attributes-with-perl v localname id-format))
- (t nil))
- ;; The scripts could fail, for example with huge file size.
- (tramp-do-file-attributes-with-ls v localname id-format))))))))
-
-(defun tramp-sh--quoting-style-options (vec)
- (or
- (tramp-get-ls-command-with
- vec "--quoting-style=literal --show-control-chars")
- (tramp-get-ls-command-with vec "-w")
- ""))
-
-(defun tramp-do-file-attributes-with-ls (vec localname &optional id-format)
- "Implement `file-attributes' for Tramp files using the ls(1) command."
- (let (symlinkp dirp
- res-inode res-filemodes res-numlinks
- res-uid res-gid res-size res-symlink-target)
- (tramp-message vec 5 "file attributes with ls: %s" localname)
- ;; We cannot send all three commands combined, it could exceed
- ;; NAME_MAX or PATH_MAX. Happened on macOS, for example.
- (when (or (tramp-send-command-and-check
- vec
- (format "%s %s"
- (tramp-get-file-exists-command vec)
- (tramp-shell-quote-argument localname)))
- (tramp-send-command-and-check
- vec
- (format "%s -h %s"
- (tramp-get-test-command vec)
- (tramp-shell-quote-argument localname))))
- (tramp-send-command
- vec
- (format "%s %s %s %s"
- (tramp-get-ls-command vec)
- (if (eq id-format 'integer) "-ildn" "-ild")
- ;; On systems which have no quoting style, file names
- ;; with special characters could fail.
- (tramp-sh--quoting-style-options vec)
- (tramp-shell-quote-argument localname)))
- ;; Parse `ls -l' output ...
- (with-current-buffer (tramp-get-buffer vec)
- (when (> (buffer-size) 0)
- (goto-char (point-min))
- ;; ... inode
- (setq res-inode (read (current-buffer)))
- ;; ... file mode flags
- (setq res-filemodes (symbol-name (read (current-buffer))))
- ;; ... number links
- (setq res-numlinks (read (current-buffer)))
- ;; ... uid and gid
- (setq res-uid (read (current-buffer)))
- (setq res-gid (read (current-buffer)))
- (if (eq id-format 'integer)
- (progn
- (unless (numberp res-uid)
- (setq res-uid tramp-unknown-id-integer))
- (unless (numberp res-gid)
- (setq res-gid tramp-unknown-id-integer)))
- (progn
- (unless (stringp res-uid) (setq res-uid (symbol-name res-uid)))
- (unless (stringp res-gid) (setq res-gid (symbol-name res-gid)))))
- ;; ... size
- (setq res-size (read (current-buffer)))
- ;; From the file modes, figure out other stuff.
- (setq symlinkp (eq ?l (aref res-filemodes 0)))
- (setq dirp (eq ?d (aref res-filemodes 0)))
- ;; If symlink, find out file name pointed to.
- (when symlinkp
- (search-forward "-> ")
- (setq res-symlink-target
- (if (looking-at-p "\"")
- (read (current-buffer))
- (buffer-substring (point) (point-at-eol)))))
- ;; Return data gathered.
- (list
- ;; 0. t for directory, string (name linked to) for symbolic
- ;; link, or nil.
- (or dirp res-symlink-target)
- ;; 1. Number of links to file.
- res-numlinks
- ;; 2. File uid.
- res-uid
- ;; 3. File gid.
- res-gid
- ;; 4. Last access time.
- ;; 5. Last modification time.
- ;; 6. Last status change time.
- tramp-time-dont-know tramp-time-dont-know tramp-time-dont-know
- ;; 7. Size in bytes (-1, if number is out of range).
- res-size
- ;; 8. File modes, as a string of ten letters or dashes as in ls -l.
- res-filemodes
- ;; 9. t if file's gid would change if file were deleted and
- ;; recreated. Will be set in `tramp-convert-file-attributes'.
- t
- ;; 10. Inode number.
- res-inode
- ;; 11. Device number. Will be replaced by a virtual device number.
- -1))))))
-
-(defun tramp-do-file-attributes-with-perl
- (vec localname &optional id-format)
- "Implement `file-attributes' for Tramp files using a Perl script."
- (tramp-message vec 5 "file attributes with perl: %s" localname)
- (tramp-maybe-send-script
- vec tramp-perl-file-attributes "tramp_perl_file_attributes")
- (tramp-send-command-and-read
- vec
- (format "tramp_perl_file_attributes %s %s"
- (tramp-shell-quote-argument localname) id-format)))
-
-(defun tramp-do-file-attributes-with-stat
- (vec localname &optional id-format)
- "Implement `file-attributes' for Tramp files using stat(1) command."
- (tramp-message vec 5 "file attributes with stat: %s" localname)
- (tramp-send-command-and-read
- vec
- (format
- (eval-when-compile
- (concat
- ;; On Opsware, pdksh (which is the true name of ksh there)
- ;; doesn't parse correctly the sequence "((". Therefore, we
- ;; add a space. Apostrophes in the stat output are masked as
- ;; `tramp-stat-marker', in order to make a proper shell escape
- ;; of them in file names.
- "( (%s %s || %s -h %s) && (%s -c "
- "'((%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' "
- "%s | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g') || echo nil)"))
- (tramp-get-file-exists-command vec)
- (tramp-shell-quote-argument localname)
- (tramp-get-test-command vec)
- (tramp-shell-quote-argument localname)
- (tramp-get-remote-stat vec)
- tramp-stat-marker tramp-stat-marker
- (if (eq id-format 'integer)
- "%u"
- (eval-when-compile (concat tramp-stat-marker "%U" tramp-stat-marker)))
- (if (eq id-format 'integer)
- "%g"
- (eval-when-compile (concat tramp-stat-marker "%G" tramp-stat-marker)))
- tramp-stat-marker tramp-stat-marker
- (tramp-shell-quote-argument localname)
- tramp-stat-quoted-marker)))
-
-(defun tramp-sh-handle-set-visited-file-modtime (&optional time-list)
- "Like `set-visited-file-modtime' for Tramp files."
- (unless (buffer-file-name)
- (error "Can't set-visited-file-modtime: buffer `%s' not visiting a file"
- (buffer-name)))
- (if time-list
- (tramp-run-real-handler #'set-visited-file-modtime (list time-list))
- (let ((f (buffer-file-name))
- coding-system-used)
- (with-parsed-tramp-file-name f nil
- (let* ((remote-file-name-inhibit-cache t)
- (attr (file-attributes f))
- (modtime (or (tramp-compat-file-attribute-modification-time attr)
- tramp-time-doesnt-exist)))
- (setq coding-system-used last-coding-system-used)
- (if (not (tramp-compat-time-equal-p modtime tramp-time-dont-know))
- (tramp-run-real-handler #'set-visited-file-modtime (list modtime))
- (progn
- (tramp-send-command
- v
- (format "%s -ild %s"
- (tramp-get-ls-command v)
- (tramp-shell-quote-argument localname)))
- (setq attr (buffer-substring (point) (point-at-eol))))
- (tramp-set-file-property
- v localname "visited-file-modtime-ild" attr))
- (setq last-coding-system-used coding-system-used)
- nil)))))
-
-;; This function makes the same assumption as
-;; `tramp-sh-handle-set-visited-file-modtime'.
-(defun tramp-sh-handle-verify-visited-file-modtime (&optional buf)
- "Like `verify-visited-file-modtime' for Tramp files.
-At the time `verify-visited-file-modtime' calls this function, we
-already know that the buffer is visiting a file and that
-`visited-file-modtime' does not return 0. Do not call this
-function directly, unless those two cases are already taken care
-of."
- (with-current-buffer (or buf (current-buffer))
- (let ((f (buffer-file-name)))
- ;; There is no file visiting the buffer, or the buffer has no
- ;; recorded last modification time, or there is no established
- ;; connection.
- (if (or (not f)
- (zerop (float-time (visited-file-modtime)))
- (not (file-remote-p f nil 'connected)))
- t
- (with-parsed-tramp-file-name f nil
- (let* ((remote-file-name-inhibit-cache t)
- (attr (file-attributes f))
- (modtime (tramp-compat-file-attribute-modification-time attr))
- (mt (visited-file-modtime)))
-
- (cond
- ;; File exists, and has a known modtime.
- ((and attr
- (not
- (tramp-compat-time-equal-p modtime tramp-time-dont-know)))
- (< (abs (tramp-time-diff modtime mt)) 2))
- ;; Modtime has the don't know value.
- (attr
- (tramp-send-command
- v
- (format "%s -ild %s"
- (tramp-get-ls-command v)
- (tramp-shell-quote-argument localname)))
- (with-current-buffer (tramp-get-buffer v)
- (setq attr (buffer-substring (point) (point-at-eol))))
- (equal
- attr
- (tramp-get-file-property
- v localname "visited-file-modtime-ild" "")))
- ;; If file does not exist, say it is not modified if and
- ;; only if that agrees with the buffer's record.
- (t (tramp-compat-time-equal-p mt tramp-time-doesnt-exist)))))))))
-
-(defun tramp-sh-handle-set-file-modes (filename mode)
- "Like `set-file-modes' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v (file-name-directory localname))
- (tramp-flush-file-properties v localname)
- ;; FIXME: extract the proper text from chmod's stderr.
- (tramp-barf-unless-okay
- v
- (format "chmod %o %s" mode (tramp-shell-quote-argument localname))
- "Error while changing file's mode %s" filename)))
-
-(defun tramp-sh-handle-set-file-times (filename &optional time)
- "Like `set-file-times' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (when (tramp-get-remote-touch v)
- (tramp-flush-file-properties v (file-name-directory localname))
- (tramp-flush-file-properties v localname)
- (let ((time
- (if (or (null time)
- (tramp-compat-time-equal-p time tramp-time-doesnt-exist)
- (tramp-compat-time-equal-p time tramp-time-dont-know))
- (current-time)
- time)))
- (tramp-send-command-and-check
- v (format
- "env TZ=UTC %s %s %s"
- (tramp-get-remote-touch v)
- (if (tramp-get-connection-property v "touch-t" nil)
- (format "-t %s" (format-time-string "%Y%m%d%H%M.%S" time t))
- "")
- (tramp-shell-quote-argument localname)))))))
-
-(defun tramp-sh-handle-set-file-uid-gid (filename &optional uid gid)
- "Like `tramp-set-file-uid-gid' for Tramp files."
- ;; Modern Unices allow chown only for root. So we might need
- ;; another implementation, see `dired-do-chown'. OTOH, it is mostly
- ;; working with su(do)? when it is needed, so it shall succeed in
- ;; the majority of cases.
- ;; Don't modify `last-coding-system-used' by accident.
- (let ((last-coding-system-used last-coding-system-used))
- (with-parsed-tramp-file-name filename nil
- (if (and (zerop (user-uid)) (tramp-local-host-p v))
- ;; If we are root on the local host, we can do it directly.
- (tramp-set-file-uid-gid localname uid gid)
- (let ((uid (or (and (natnump uid) uid)
- (tramp-get-remote-uid v 'integer)))
- (gid (or (and (natnump gid) gid)
- (tramp-get-remote-gid v 'integer))))
- (tramp-send-command
- v (format
- "chown %d:%d %s" uid gid
- (tramp-shell-quote-argument localname))))))))
-
-(defun tramp-remote-selinux-p (vec)
- "Check, whether SELINUX is enabled on the remote host."
- (with-tramp-connection-property (tramp-get-connection-process vec)
"selinux-p"
- (tramp-send-command-and-check vec "selinuxenabled")))
-
-(defun tramp-sh-handle-file-selinux-context (filename)
- "Like `file-selinux-context' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (with-tramp-file-property v localname "file-selinux-context"
- (let ((context '(nil nil nil nil))
- (regexp (eval-when-compile
- (concat "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\):"
- "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\)"))))
- (when (and (tramp-remote-selinux-p v)
- (tramp-send-command-and-check
- v (format
- "%s -d -Z %s"
- (tramp-get-ls-command v)
- (tramp-shell-quote-argument localname))))
- (with-current-buffer (tramp-get-connection-buffer v)
- (goto-char (point-min))
- (when (re-search-forward regexp (point-at-eol) t)
- (setq context (list (match-string 1) (match-string 2)
- (match-string 3) (match-string 4))))))
- ;; Return the context.
- context))))
-
-(defun tramp-sh-handle-set-file-selinux-context (filename context)
- "Like `set-file-selinux-context' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (when (and (consp context)
- (tramp-remote-selinux-p v))
- (let ((user (and (stringp (nth 0 context)) (nth 0 context)))
- (role (and (stringp (nth 1 context)) (nth 1 context)))
- (type (and (stringp (nth 2 context)) (nth 2 context)))
- (range (and (stringp (nth 3 context)) (nth 3 context))))
- (when (tramp-send-command-and-check
- v (format "chcon %s %s %s %s %s"
- (if user (format "--user=%s" user) "")
- (if role (format "--role=%s" role) "")
- (if type (format "--type=%s" type) "")
- (if range (format "--range=%s" range) "")
- (tramp-shell-quote-argument localname)))
- (if (and user role type range)
- (tramp-set-file-property
- v localname "file-selinux-context" context)
- (tramp-flush-file-property v localname "file-selinux-context"))
- t)))))
-
-(defun tramp-remote-acl-p (vec)
- "Check, whether ACL is enabled on the remote host."
- (with-tramp-connection-property (tramp-get-connection-process vec) "acl-p"
- (tramp-send-command-and-check vec "getfacl /")))
-
-(defun tramp-sh-handle-file-acl (filename)
- "Like `file-acl' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (with-tramp-file-property v localname "file-acl"
- (when (and (tramp-remote-acl-p v)
- (tramp-send-command-and-check
- v (format
- "getfacl -ac %s"
- (tramp-shell-quote-argument localname))))
- (with-current-buffer (tramp-get-connection-buffer v)
- (goto-char (point-max))
- (delete-blank-lines)
- (when (> (point-max) (point-min))
- (substring-no-properties (buffer-string))))))))
-
-(defun tramp-sh-handle-set-file-acl (filename acl-string)
- "Like `set-file-acl' for Tramp files."
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (if (and (stringp acl-string) (tramp-remote-acl-p v)
- (progn
- (tramp-send-command
- v (format "setfacl --set-file=- %s <<'%s'\n%s\n%s\n"
- (tramp-shell-quote-argument localname)
- tramp-end-of-heredoc
- acl-string
- tramp-end-of-heredoc))
- (tramp-send-command-and-check v nil)))
- ;; Success.
- (progn
- (tramp-set-file-property v localname "file-acl" acl-string)
- t)
- ;; In case of errors, we return nil.
- (tramp-flush-file-property v localname "file-acl-string")
- nil)))
-
-;; Simple functions using the `test' command.
-
-(defun tramp-sh-handle-file-executable-p (filename)
- "Like `file-executable-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (with-tramp-file-property v localname "file-executable-p"
- ;; Examine `file-attributes' cache to see if request can be
- ;; satisfied without remote operation.
- (or (tramp-check-cached-permissions v ?x)
- (tramp-run-test "-x" filename)))))
-
-(defun tramp-sh-handle-file-readable-p (filename)
- "Like `file-readable-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (with-tramp-file-property v localname "file-readable-p"
- ;; Examine `file-attributes' cache to see if request can be
- ;; satisfied without remote operation.
- (or (tramp-check-cached-permissions v ?r)
- (tramp-run-test "-r" filename)))))
-
-;; When the remote shell is started, it looks for a shell which groks
-;; tilde expansion. Here, we assume that all shells which grok tilde
-;; expansion will also provide a `test' command which groks `-nt' (for
-;; newer than). If this breaks, tell me about it and I'll try to do
-;; something smarter about it.
-(defun tramp-sh-handle-file-newer-than-file-p (file1 file2)
- "Like `file-newer-than-file-p' for Tramp files."
- (cond ((not (file-exists-p file1)) nil)
- ((not (file-exists-p file2)) t)
- (t ;; We are sure both files exist at this point. We try to
- ;; get the mtime of both files. If they are not equal to
- ;; the "dont-know" value, then we subtract the times and
- ;; obtain the result.
- (let ((fa1 (file-attributes file1))
- (fa2 (file-attributes file2)))
- (if (and
- (not
- (tramp-compat-time-equal-p
- (tramp-compat-file-attribute-modification-time fa1)
- tramp-time-dont-know))
- (not
- (tramp-compat-time-equal-p
- (tramp-compat-file-attribute-modification-time fa2)
- tramp-time-dont-know)))
- (time-less-p
- (tramp-compat-file-attribute-modification-time fa2)
- (tramp-compat-file-attribute-modification-time fa1))
- ;; If one of them is the dont-know value, then we can
- ;; still try to run a shell command on the remote host.
- ;; However, this only works if both files are Tramp
- ;; files and both have the same method, same user, same
- ;; host.
- (unless (tramp-equal-remote file1 file2)
- (with-parsed-tramp-file-name
- (if (tramp-tramp-file-p file1) file1 file2) nil
- (tramp-error
- v 'file-error
- "Files %s and %s must have same method, user, host"
- file1 file2)))
- (with-parsed-tramp-file-name file1 nil
- (tramp-run-test2
- (tramp-get-test-nt-command v) file1 file2)))))))
-
-;; Functions implemented using the basic functions above.
-
-(defun tramp-sh-handle-file-directory-p (filename)
- "Like `file-directory-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- ;; `file-directory-p' is used as predicate for file name completion.
- ;; Sometimes, when a connection is not established yet, it is
- ;; desirable to return t immediately for "/method:foo:". It can
- ;; be expected that this is always a directory.
- (or (zerop (length localname))
- (with-tramp-file-property v localname "file-directory-p"
- (tramp-run-test "-d" filename)))))
-
-(defun tramp-sh-handle-file-writable-p (filename)
- "Like `file-writable-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (with-tramp-file-property v localname "file-writable-p"
- (if (file-exists-p filename)
- ;; Examine `file-attributes' cache to see if request can be
- ;; satisfied without remote operation.
- (or (tramp-check-cached-permissions v ?w)
- (tramp-run-test "-w" filename))
- ;; If file doesn't exist, check if directory is writable.
- (and (tramp-run-test "-d" (file-name-directory filename))
- (tramp-run-test "-w" (file-name-directory filename)))))))
-
-(defun tramp-sh-handle-file-ownership-preserved-p (filename &optional group)
- "Like `file-ownership-preserved-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (with-tramp-file-property v localname "file-ownership-preserved-p"
- (let ((attributes (file-attributes filename)))
- ;; Return t if the file doesn't exist, since it's true that no
- ;; information would be lost by an (attempted) delete and create.
- (or (null attributes)
- (and
- (= (tramp-compat-file-attribute-user-id attributes)
- (tramp-get-remote-uid v 'integer))
- (or (not group)
- (= (tramp-compat-file-attribute-group-id attributes)
- (tramp-get-remote-gid v 'integer)))))))))
-
-;; Directory listings.
-
-(defun tramp-sh-handle-directory-files-and-attributes
- (directory &optional full match nosort id-format)
- "Like `directory-files-and-attributes' for Tramp files."
- (unless id-format (setq id-format 'integer))
- (when (file-directory-p directory)
- (setq directory (expand-file-name directory))
- (let* ((temp
- (copy-tree
- (with-parsed-tramp-file-name directory nil
- (with-tramp-file-property
- v localname
- (format "directory-files-and-attributes-%s" id-format)
- (mapcar
- (lambda (x)
- (cons (car x) (tramp-convert-file-attributes v (cdr x))))
- (cond
- ((tramp-get-remote-stat v)
- (tramp-do-directory-files-and-attributes-with-stat
- v localname id-format))
- ((tramp-get-remote-perl v)
- (tramp-do-directory-files-and-attributes-with-perl
- v localname id-format))
- (t nil)))))))
- result item)
-
- (while temp
- (setq item (pop temp))
- (when (or (null match) (string-match-p match (car item)))
- (when full
- (setcar item (expand-file-name (car item) directory)))
- (push item result)))
-
- (or (if nosort
- result
- (sort result (lambda (x y) (string< (car x) (car y)))))
- ;; The scripts could fail, for example with huge file size.
- (tramp-handle-directory-files-and-attributes
- directory full match nosort id-format)))))
-
-(defun tramp-do-directory-files-and-attributes-with-perl
- (vec localname &optional id-format)
- "Implement `directory-files-and-attributes' for Tramp files using a Perl
script."
- (tramp-message vec 5 "directory-files-and-attributes with perl: %s"
localname)
- (tramp-maybe-send-script
- vec tramp-perl-directory-files-and-attributes
- "tramp_perl_directory_files_and_attributes")
- (let ((object
- (tramp-send-command-and-read
- vec
- (format "tramp_perl_directory_files_and_attributes %s %s"
- (tramp-shell-quote-argument localname) id-format))))
- (when (stringp object) (tramp-error vec 'file-error object))
- object))
-
-(defun tramp-do-directory-files-and-attributes-with-stat
- (vec localname &optional id-format)
- "Implement `directory-files-and-attributes' for Tramp files using stat(1)
command."
- (tramp-message vec 5 "directory-files-and-attributes with stat: %s"
localname)
- (tramp-send-command-and-read
- vec
- (format
- (eval-when-compile
- (concat
- ;; We must care about file names with spaces, or starting with
- ;; "-"; this would confuse xargs. "ls -aQ" might be a
- ;; solution, but it does not work on all remote systems.
- ;; Apostrophes in the stat output are masked as
- ;; `tramp-stat-marker', in order to make a proper shell escape
- ;; of them in file names.
- "cd %s && echo \"(\"; (%s %s -a | "
- "xargs %s -c "
- "'(%s%%n%s (%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' "
- "-- 2>/dev/null | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g'); echo \")\""))
- (tramp-shell-quote-argument localname)
- (tramp-get-ls-command vec)
- ;; On systems which have no quoting style, file names with special
- ;; characters could fail.
- (tramp-sh--quoting-style-options vec)
- (tramp-get-remote-stat vec)
- tramp-stat-marker tramp-stat-marker
- tramp-stat-marker tramp-stat-marker
- (if (eq id-format 'integer)
- "%u"
- (eval-when-compile (concat tramp-stat-marker "%U" tramp-stat-marker)))
- (if (eq id-format 'integer)
- "%g"
- (eval-when-compile (concat tramp-stat-marker "%G" tramp-stat-marker)))
- tramp-stat-marker tramp-stat-marker
- tramp-stat-quoted-marker)))
-
-;; This function should return "foo/" for directories and "bar" for
-;; files.
-(defun tramp-sh-handle-file-name-all-completions (filename directory)
- "Like `file-name-all-completions' for Tramp files."
- (unless (string-match-p "/" filename)
- (all-completions
- filename
- (with-parsed-tramp-file-name (expand-file-name directory) nil
- (with-tramp-file-property v localname "file-name-all-completions"
- (let (result)
- ;; Get a list of directories and files, including reliably
- ;; tagging the directories with a trailing "/". Because I
- ;; rock. address@hidden
- (tramp-send-command
- v
- (if (tramp-get-remote-perl v)
- (progn
- (tramp-maybe-send-script
- v tramp-perl-file-name-all-completions
- "tramp_perl_file_name_all_completions")
- (format "tramp_perl_file_name_all_completions %s"
- (tramp-shell-quote-argument localname)))
-
- (format (eval-when-compile
- (concat
- "(cd %s 2>&1 && %s -a 2>/dev/null"
- " | while IFS= read f; do"
- " if %s -d \"$f\" 2>/dev/null;"
- " then \\echo \"$f/\"; else \\echo \"$f\"; fi; done"
- " && \\echo ok) || \\echo fail"))
- (tramp-shell-quote-argument localname)
- (tramp-get-ls-command v)
- (tramp-get-test-command v))))
-
- ;; Now grab the output.
- (with-current-buffer (tramp-get-buffer v)
- (goto-char (point-max))
-
- ;; Check result code, found in last line of output.
- (forward-line -1)
- (if (looking-at-p "^fail$")
- (progn
- ;; Grab error message from line before last line
- ;; (it was put there by `cd 2>&1').
- (forward-line -1)
- (tramp-error
- v 'file-error
- "tramp-sh-handle-file-name-all-completions: %s"
- (buffer-substring (point) (point-at-eol))))
- ;; For peace of mind, if buffer doesn't end in `fail'
- ;; then it should end in `ok'. If neither are in the
- ;; buffer something went seriously wrong on the remote
- ;; side.
- (unless (looking-at-p "^ok$")
- (tramp-error
- v 'file-error "\
-tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'"
- (tramp-shell-quote-argument localname) (buffer-string))))
-
- (while (zerop (forward-line -1))
- (push (buffer-substring (point) (point-at-eol)) result)))
- result))))))
-
-;; cp, mv and ln
-
-(defun tramp-sh-handle-add-name-to-file
- (filename newname &optional ok-if-already-exists)
- "Like `add-name-to-file' for Tramp files."
- (unless (tramp-equal-remote filename newname)
- (with-parsed-tramp-file-name
- (if (tramp-tramp-file-p filename) filename newname) nil
- (tramp-error
- v 'file-error
- "add-name-to-file: %s"
- "only implemented for same method, same user, same host")))
- (with-parsed-tramp-file-name filename v1
- (with-parsed-tramp-file-name newname v2
- (let ((ln (when v1 (tramp-get-remote-ln v1))))
-
- ;; Do the 'confirm if exists' thing.
- (when (file-exists-p newname)
- ;; What to do?
- (if (or (null ok-if-already-exists) ; not allowed to exist
- (and (numberp ok-if-already-exists)
- (not (yes-or-no-p
- (format
- "File %s already exists; make it a link anyway? "
- v2-localname)))))
- (tramp-error v2 'file-already-exists newname)
- (delete-file newname)))
- (tramp-flush-file-properties v2 (file-name-directory v2-localname))
- (tramp-flush-file-properties v2 v2-localname)
- (tramp-barf-unless-okay
- v1
- (format "%s %s %s" ln
- (tramp-shell-quote-argument v1-localname)
- (tramp-shell-quote-argument v2-localname))
- "error with add-name-to-file, see buffer `%s' for details"
- (buffer-name))))))
-
-(defun tramp-sh-handle-copy-file
- (filename newname &optional ok-if-already-exists keep-date
- preserve-uid-gid preserve-extended-attributes)
- "Like `copy-file' for Tramp files."
- (setq filename (expand-file-name filename)
- newname (expand-file-name newname))
- (if (or (tramp-tramp-file-p filename)
- (tramp-tramp-file-p newname))
- (tramp-do-copy-or-rename-file
- 'copy filename newname ok-if-already-exists keep-date
- preserve-uid-gid preserve-extended-attributes)
- (tramp-run-real-handler
- 'copy-file
- (list filename newname ok-if-already-exists keep-date
- preserve-uid-gid preserve-extended-attributes))))
-
-(defun tramp-sh-handle-copy-directory
- (dirname newname &optional keep-date parents copy-contents)
- "Like `copy-directory' for Tramp files."
- (let ((t1 (tramp-tramp-file-p dirname))
- (t2 (tramp-tramp-file-p newname)))
- (with-parsed-tramp-file-name (if t1 dirname newname) nil
- (if (and (not copy-contents)
- (tramp-get-method-parameter v 'tramp-copy-recursive)
- ;; When DIRNAME and NEWNAME are remote, they must have
- ;; the same method.
- (or (null t1) (null t2)
- (string-equal
- (tramp-file-name-method (tramp-dissect-file-name dirname))
- (tramp-file-name-method
- (tramp-dissect-file-name newname)))))
- ;; scp or rsync DTRT.
- (progn
- (when (and (file-directory-p newname)
- (not (tramp-compat-directory-name-p newname)))
- (tramp-error v 'file-already-exists newname))
- (setq dirname (directory-file-name (expand-file-name dirname))
- newname (directory-file-name (expand-file-name newname)))
- (when (and (file-directory-p newname)
- (not (string-equal (file-name-nondirectory dirname)
- (file-name-nondirectory newname))))
- (setq newname
- (expand-file-name
- (file-name-nondirectory dirname) newname)))
- (unless (file-directory-p (file-name-directory newname))
- (make-directory (file-name-directory newname) parents))
- (tramp-do-copy-or-rename-file-out-of-band
- 'copy dirname newname keep-date))
-
- ;; We must do it file-wise.
- (tramp-run-real-handler
- 'copy-directory
- (list dirname newname keep-date parents copy-contents)))
-
- ;; When newname did exist, we have wrong cached values.
- (when t2
- (with-parsed-tramp-file-name newname nil
- (tramp-flush-file-properties v (file-name-directory localname))
- (tramp-flush-file-properties v localname))))))
-
-(defun tramp-sh-handle-rename-file
- (filename newname &optional ok-if-already-exists)
- "Like `rename-file' for Tramp files."
- ;; Check if both files are local -- invoke normal rename-file.
- ;; Otherwise, use Tramp from local system.
- (setq filename (expand-file-name filename))
- (setq newname (expand-file-name newname))
- ;; At least one file a Tramp file?
- (if (or (tramp-tramp-file-p filename)
- (tramp-tramp-file-p newname))
- (tramp-do-copy-or-rename-file
- 'rename filename newname ok-if-already-exists
- 'keep-time 'preserve-uid-gid)
- (tramp-run-real-handler
- #'rename-file (list filename newname ok-if-already-exists))))
-
-(defun tramp-do-copy-or-rename-file
- (op filename newname &optional ok-if-already-exists keep-date
- preserve-uid-gid preserve-extended-attributes)
- "Copy or rename a remote file.
-OP must be `copy' or `rename' and indicates the operation to perform.
-FILENAME specifies the file to copy or rename, NEWNAME is the name of
-the new file (for copy) or the new name of the file (for rename).
-OK-IF-ALREADY-EXISTS means don't barf if NEWNAME exists already.
-KEEP-DATE means to make sure that NEWNAME has the same timestamp
-as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep
-the uid and gid if both files are on the same host.
-PRESERVE-EXTENDED-ATTRIBUTES activates selinux and acl commands.
-
-This function is invoked by `tramp-sh-handle-copy-file' and
-`tramp-sh-handle-rename-file'. It is an error if OP is neither
-of `copy' and `rename'. FILENAME and NEWNAME must be absolute
-file names."
- (unless (memq op '(copy rename))
- (error "Unknown operation `%s', must be `copy' or `rename'" op))
-
- (if (and
- (file-directory-p filename)
- (not (tramp-equal-remote filename newname)))
- (progn
- (copy-directory filename newname keep-date t)
- (when (eq op 'rename) (delete-directory filename 'recursive)))
-
- (let ((t1 (tramp-tramp-file-p filename))
- (t2 (tramp-tramp-file-p newname))
- (length (tramp-compat-file-attribute-size
- (file-attributes (file-truename filename))))
- ;; `file-extended-attributes' exists since Emacs 24.4.
- (attributes (and preserve-extended-attributes
- (apply #'file-extended-attributes (list filename)))))
-
- (with-parsed-tramp-file-name (if t1 filename newname) nil
- (when (and (not ok-if-already-exists) (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
-
- (with-tramp-progress-reporter
- v 0 (format "%s %s to %s"
- (if (eq op 'copy) "Copying" "Renaming")
- filename newname)
-
- (cond
- ;; Both are Tramp files.
- ((and t1 t2)
- (with-parsed-tramp-file-name filename v1
- (with-parsed-tramp-file-name newname v2
- (cond
- ;; Shortcut: if method, host, user are the same for
- ;; both files, we invoke `cp' or `mv' on the remote
- ;; host directly.
- ((tramp-equal-remote filename newname)
- (tramp-do-copy-or-rename-file-directly
- op filename newname
- ok-if-already-exists keep-date preserve-uid-gid))
-
- ;; Try out-of-band operation.
- ((and
- (tramp-method-out-of-band-p v1 length)
- (tramp-method-out-of-band-p v2 length))
- (tramp-do-copy-or-rename-file-out-of-band
- op filename newname keep-date))
-
- ;; No shortcut was possible. So we copy the file
- ;; first. If the operation was `rename', we go back
- ;; and delete the original file (if the copy was
- ;; successful). The approach is simple-minded: we
- ;; create a new buffer, insert the contents of the
- ;; source file into it, then write out the buffer to
- ;; the target file. The advantage is that it doesn't
- ;; matter which file name handlers are used for the
- ;; source and target file.
- (t
- (tramp-do-copy-or-rename-file-via-buffer
- op filename newname keep-date))))))
-
- ;; One file is a Tramp file, the other one is local.
- ((or t1 t2)
- (cond
- ;; Fast track on local machine.
- ((tramp-local-host-p v)
- (tramp-do-copy-or-rename-file-directly
- op filename newname
- ok-if-already-exists keep-date preserve-uid-gid))
-
- ;; If the Tramp file has an out-of-band method, the
- ;; corresponding copy-program can be invoked.
- ((tramp-method-out-of-band-p v length)
- (tramp-do-copy-or-rename-file-out-of-band
- op filename newname keep-date))
-
- ;; Use the inline method via a Tramp buffer.
- (t (tramp-do-copy-or-rename-file-via-buffer
- op filename newname keep-date))))
-
- (t
- ;; One of them must be a Tramp file.
- (error "Tramp implementation says this cannot happen")))
-
- ;; Handle `preserve-extended-attributes'. We ignore possible
- ;; errors, because ACL strings could be incompatible.
- ;; `set-file-extended-attributes' exists since Emacs 24.4.
- (when attributes
- (ignore-errors
- (apply #'set-file-extended-attributes (list newname attributes))))
-
- ;; In case of `rename', we must flush the cache of the source file.
- (when (and t1 (eq op 'rename))
- (with-parsed-tramp-file-name filename v1
- (tramp-flush-file-properties
- v1 (file-name-directory v1-localname))
- (tramp-flush-file-properties v1 v1-localname)))
-
- ;; When newname did exist, we have wrong cached values.
- (when t2
- (with-parsed-tramp-file-name newname v2
- (tramp-flush-file-properties
- v2 (file-name-directory v2-localname))
- (tramp-flush-file-properties v2 v2-localname))))))))
-
-(defun tramp-do-copy-or-rename-file-via-buffer (op filename newname keep-date)
- "Use an Emacs buffer to copy or rename a file.
-First arg OP is either `copy' or `rename' and indicates the operation.
-FILENAME is the source file, NEWNAME the target file.
-KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME."
- ;; Check, whether file is too large. Emacs checks in `insert-file-1'
- ;; and `find-file-noselect', but that's not called here.
- (abort-if-file-too-large
- (tramp-compat-file-attribute-size (file-attributes (file-truename
filename)))
- (symbol-name op) filename)
- ;; We must disable multibyte, because binary data shall not be
- ;; converted. We don't want the target file to be compressed, so we
- ;; let-bind `jka-compr-inhibit' to t. `epa-file-handler' shall not
- ;; be called either. We remove `tramp-file-name-handler' from
- ;; `inhibit-file-name-handlers'; otherwise the file name handler for
- ;; `insert-file-contents' might be deactivated in some corner cases.
- (let ((coding-system-for-read 'binary)
- (coding-system-for-write 'binary)
- (jka-compr-inhibit t)
- (inhibit-file-name-operation 'write-region)
- (inhibit-file-name-handlers
- (cons 'epa-file-handler
- (remq 'tramp-file-name-handler inhibit-file-name-handlers))))
- (with-temp-file newname
- (set-buffer-multibyte nil)
- (insert-file-contents-literally filename)))
- ;; KEEP-DATE handling.
- (when keep-date
- (set-file-times
- newname
- (tramp-compat-file-attribute-modification-time
- (file-attributes filename))))
- ;; Set the mode.
- (set-file-modes newname (tramp-default-file-modes filename))
- ;; If the operation was `rename', delete the original file.
- (unless (eq op 'copy) (delete-file filename)))
-
-(defun tramp-do-copy-or-rename-file-directly
- (op filename newname ok-if-already-exists keep-date preserve-uid-gid)
- "Invokes `cp' or `mv' on the remote system.
-OP must be one of `copy' or `rename', indicating `cp' or `mv',
-respectively. FILENAME specifies the file to copy or rename,
-NEWNAME is the name of the new file (for copy) or the new name of
-the file (for rename). Both files must reside on the same host.
-KEEP-DATE means to make sure that NEWNAME has the same timestamp
-as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep
-the uid and gid from FILENAME."
- (let ((t1 (tramp-tramp-file-p filename))
- (t2 (tramp-tramp-file-p newname))
- (file-times (tramp-compat-file-attribute-modification-time
- (file-attributes filename)))
- (file-modes (tramp-default-file-modes filename)))
- (with-parsed-tramp-file-name (if t1 filename newname) nil
- (let* ((cmd (cond ((and (eq op 'copy) preserve-uid-gid) "cp -f -p")
- ((eq op 'copy) "cp -f")
- ((eq op 'rename) "mv -f")
- (t (tramp-error
- v 'file-error
- "Unknown operation `%s', must be `copy' or `rename'"
- op))))
- (localname1 (tramp-compat-file-local-name filename))
- (localname2 (tramp-compat-file-local-name newname))
- (prefix (file-remote-p (if t1 filename newname)))
- cmd-result)
- (when (and (eq op 'copy) (file-directory-p filename))
- (setq cmd (concat cmd " -R")))
-
- (cond
- ;; Both files are on a remote host, with same user.
- ((and t1 t2)
- (setq cmd-result
- (tramp-send-command-and-check
- v (format "%s %s %s" cmd
- (tramp-shell-quote-argument localname1)
- (tramp-shell-quote-argument localname2))))
- (with-current-buffer (tramp-get-buffer v)
- (goto-char (point-min))
- (unless
- (or
- (and keep-date
- ;; Mask cp -f error.
- (re-search-forward
- tramp-operation-not-permitted-regexp nil t))
- cmd-result)
- (tramp-error-with-buffer
- nil v 'file-error
- "Copying directly failed, see buffer `%s' for details."
- (buffer-name)))))
-
- ;; We are on the local host.
- ((or t1 t2)
- (cond
- ;; We can do it directly.
- ((let (file-name-handler-alist)
- (and (file-readable-p localname1)
- ;; No sticky bit when renaming.
- (or (eq op 'copy)
- (zerop
- (logand
- (file-modes (file-name-directory localname1)) #o1000)))
- (file-writable-p (file-name-directory localname2))
- (or (file-directory-p localname2)
- (file-writable-p localname2))))
- (if (eq op 'copy)
- (copy-file
- localname1 localname2 ok-if-already-exists
- keep-date preserve-uid-gid)
- (tramp-run-real-handler
- #'rename-file
- (list localname1 localname2 ok-if-already-exists))))
-
- ;; We can do it directly with `tramp-send-command'
- ((and (file-readable-p (concat prefix localname1))
- (file-writable-p
- (file-name-directory (concat prefix localname2)))
- (or (file-directory-p (concat prefix localname2))
- (file-writable-p (concat prefix localname2))))
- (tramp-do-copy-or-rename-file-directly
- op (concat prefix localname1) (concat prefix localname2)
- ok-if-already-exists keep-date t)
- ;; We must change the ownership to the local user.
- (tramp-set-file-uid-gid
- (concat prefix localname2)
- (tramp-get-local-uid 'integer)
- (tramp-get-local-gid 'integer)))
-
- ;; We need a temporary file in between.
- (t
- ;; Create the temporary file.
- (let ((tmpfile (tramp-compat-make-temp-file localname1)))
- (unwind-protect
- (progn
- (cond
- (t1
- (tramp-barf-unless-okay
- v (format
- "%s %s %s" cmd
- (tramp-shell-quote-argument localname1)
- (tramp-shell-quote-argument tmpfile))
- "Copying directly failed, see buffer `%s' for details."
- (tramp-get-buffer v))
- ;; We must change the ownership as remote user.
- ;; Since this does not work reliable, we also
- ;; give read permissions.
- (set-file-modes (concat prefix tmpfile) #o0777)
- (tramp-set-file-uid-gid
- (concat prefix tmpfile)
- (tramp-get-local-uid 'integer)
- (tramp-get-local-gid 'integer)))
- (t2
- (if (eq op 'copy)
- (copy-file
- localname1 tmpfile t keep-date preserve-uid-gid)
- (tramp-run-real-handler
- #'rename-file (list localname1 tmpfile t)))
- ;; We must change the ownership as local user.
- ;; Since this does not work reliable, we also
- ;; give read permissions.
- (set-file-modes tmpfile #o0777)
- (tramp-set-file-uid-gid
- tmpfile
- (tramp-get-remote-uid v 'integer)
- (tramp-get-remote-gid v 'integer))))
-
- ;; Move the temporary file to its destination.
- (cond
- (t2
- (tramp-barf-unless-okay
- v (format
- "cp -f -p %s %s"
- (tramp-shell-quote-argument tmpfile)
- (tramp-shell-quote-argument localname2))
- "Copying directly failed, see buffer `%s' for details."
- (tramp-get-buffer v)))
- (t1
- (tramp-run-real-handler
- #'rename-file
- (list tmpfile localname2 ok-if-already-exists)))))
-
- ;; Save exit.
- (ignore-errors (delete-file tmpfile)))))))))
-
- ;; Set the time and mode. Mask possible errors.
- (ignore-errors
- (when keep-date
- (set-file-times newname file-times)
- (set-file-modes newname file-modes))))))
-
-(defun tramp-do-copy-or-rename-file-out-of-band (op filename newname keep-date)
- "Invoke `scp' program to copy.
-The method used must be an out-of-band method."
- (let* ((t1 (tramp-tramp-file-p filename))
- (t2 (tramp-tramp-file-p newname))
- (orig-vec (tramp-dissect-file-name (if t1 filename newname)))
- copy-program copy-args copy-env copy-keep-date listener spec
- options source target remote-copy-program remote-copy-args)
-
- (with-parsed-tramp-file-name (if t1 filename newname) nil
- (if (and t1 t2)
-
- ;; Both are Tramp files. We shall optimize it when the
- ;; methods for FILENAME and NEWNAME are the same.
- (let* ((dir-flag (file-directory-p filename))
- (tmpfile (tramp-compat-make-temp-file localname dir-flag)))
- (if dir-flag
- (setq tmpfile
- (expand-file-name
- (file-name-nondirectory newname) tmpfile)))
- (unwind-protect
- (progn
- (tramp-do-copy-or-rename-file-out-of-band
- op filename tmpfile keep-date)
- (tramp-do-copy-or-rename-file-out-of-band
- 'rename tmpfile newname keep-date))
- ;; Save exit.
- (ignore-errors
- (if dir-flag
- (delete-directory
- (expand-file-name ".." tmpfile) 'recursive)
- (delete-file tmpfile)))))
-
- ;; Check which ones of source and target are Tramp files.
- (setq source (funcall
- (if (and (file-directory-p filename)
- (not (file-exists-p newname)))
- #'file-name-as-directory
- #'identity)
- (if t1
- (tramp-make-copy-program-file-name v)
- (tramp-unquote-shell-quote-argument filename)))
- target (if t2
- (tramp-make-copy-program-file-name v)
- (tramp-unquote-shell-quote-argument newname)))
-
- ;; Check for user. There might be an interactive setting.
- (setq user (or (tramp-file-name-user v)
- (tramp-get-connection-property v "login-as" nil)))
-
- ;; Check for listener port.
- (when (tramp-get-method-parameter v 'tramp-remote-copy-args)
- (setq listener (number-to-string (+ 50000 (random 10000))))
- (while
- (zerop (tramp-call-process v "nc" nil nil nil "-z" host listener))
- (setq listener (number-to-string (+ 50000 (random 10000))))))
-
- ;; Compose copy command.
- (setq host (or host "")
- user (or user "")
- port (or port "")
- spec (format-spec-make
- ?t (tramp-get-connection-property
- (tramp-get-connection-process v) "temp-file" ""))
- options (format-spec (tramp-ssh-controlmaster-options v) spec)
- spec (format-spec-make
- ?h host ?u user ?p port ?r listener ?c options
- ?k (if keep-date " " ""))
- copy-program (tramp-get-method-parameter v 'tramp-copy-program)
- copy-keep-date (tramp-get-method-parameter
- v 'tramp-copy-keep-date)
-
- copy-args
- (delete
- ;; " " has either been a replacement of "%k" (when
- ;; keep-date argument is non-nil), or a replacement
- ;; for the whole keep-date sublist.
- " "
- (dolist
- (x (tramp-get-method-parameter v 'tramp-copy-args) copy-args)
- (setq copy-args
- (append
- copy-args
- (let ((y (mapcar (lambda (z) (format-spec z spec)) x)))
- (if (member "" y) '(" ") y))))))
-
- copy-env
- (delq
- nil
- (mapcar
- (lambda (x)
- (setq x (mapcar (lambda (y) (format-spec y spec)) x))
- (unless (member "" x) (mapconcat #'identity x " ")))
- (tramp-get-method-parameter v 'tramp-copy-env)))
-
- remote-copy-program
- (tramp-get-method-parameter v 'tramp-remote-copy-program))
-
- (dolist (x (tramp-get-method-parameter v 'tramp-remote-copy-args))
- (setq remote-copy-args
- (append
- remote-copy-args
- (let ((y (mapcar (lambda (z) (format-spec z spec)) x)))
- (if (member "" y) '(" ") y)))))
-
- ;; Check for local copy program.
- (unless (executable-find copy-program)
- (tramp-error
- v 'file-error "Cannot find local copy program: %s" copy-program))
-
- ;; Install listener on the remote side. The prompt must be
- ;; consumed later on, when the process does not listen anymore.
- (when remote-copy-program
- (unless (with-tramp-connection-property
- v (concat "remote-copy-program-" remote-copy-program)
- (tramp-find-executable
- v remote-copy-program (tramp-get-remote-path v)))
- (tramp-error
- v 'file-error
- "Cannot find remote listener: %s" remote-copy-program))
- (setq remote-copy-program
- (mapconcat
- #'identity
- (append
- (list remote-copy-program) remote-copy-args
- (list (if t1 (concat "<" source) (concat ">" target)) "&"))
- " "))
- (tramp-send-command v remote-copy-program)
- (with-timeout
- (60 (tramp-error
- v 'file-error
- "Listener process not running on remote host: `%s'"
- remote-copy-program))
- (tramp-send-command v (format "netstat -l | grep -q :%s" listener))
- (while (not (tramp-send-command-and-check v nil))
- (tramp-send-command
- v (format "netstat -l | grep -q :%s" listener)))))
-
- (with-temp-buffer
- (unwind-protect
- ;; The default directory must be remote.
- (let ((default-directory
- (file-name-directory (if t1 filename newname)))
- (process-environment (copy-sequence process-environment)))
- ;; Set the transfer process properties.
- (tramp-set-connection-property
- v "process-name" (buffer-name (current-buffer)))
- (tramp-set-connection-property
- v "process-buffer" (current-buffer))
- (while copy-env
- (tramp-message
- orig-vec 6 "%s=\"%s\"" (car copy-env) (cadr copy-env))
- (setenv (pop copy-env) (pop copy-env)))
- (setq
- copy-args
- (append
- copy-args
- (if remote-copy-program
- (list (if t1 (concat ">" target) (concat "<" source)))
- (list source target))))
-
- ;; Use an asynchronous process. By this, password can
- ;; be handled. We don't set a timeout, because the
- ;; copying of large files can last longer than 60 secs.
- (let* ((command
- (mapconcat
- #'identity (append (list copy-program) copy-args)
- " "))
- (p (let ((default-directory
- (tramp-compat-temporary-file-directory)))
- (start-process-shell-command
- (tramp-get-connection-name v)
- (tramp-get-connection-buffer v)
- command))))
- (tramp-message orig-vec 6 "%s" command)
- (process-put p 'vector orig-vec)
- (process-put p 'adjust-window-size-function #'ignore)
- (set-process-query-on-exit-flag p nil)
-
- ;; We must adapt `tramp-local-end-of-line' for
- ;; sending the password.
- (let ((tramp-local-end-of-line tramp-rsh-end-of-line))
- (tramp-process-actions
- p v nil tramp-actions-copy-out-of-band))))
-
- ;; Reset the transfer process properties.
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer")
- ;; Clear the remote prompt.
- (when (and remote-copy-program
- (not (tramp-send-command-and-check v nil)))
- ;; Houston, we have a problem! Likely, the listener is
- ;; still running, so let's clear everything (but the
- ;; cached password).
- (tramp-cleanup-connection v 'keep-debug 'keep-password))))
-
- ;; Handle KEEP-DATE argument.
- (when (and keep-date (not copy-keep-date))
- (set-file-times
- newname
- (tramp-compat-file-attribute-modification-time
- (file-attributes filename))))
-
- ;; Set the mode.
- (unless (and keep-date copy-keep-date)
- (ignore-errors
- (set-file-modes newname (tramp-default-file-modes filename)))))
-
- ;; If the operation was `rename', delete the original file.
- (unless (eq op 'copy)
- (if (file-regular-p filename)
- (delete-file filename)
- (delete-directory filename 'recursive))))))
-
-(defun tramp-sh-handle-make-directory (dir &optional parents)
- "Like `make-directory' for Tramp files."
- (setq dir (expand-file-name dir))
- (with-parsed-tramp-file-name dir nil
- ;; When PARENTS is non-nil, DIR could be a chain of non-existent
- ;; directories a/b/c/... Instead of checking, we simply flush the
- ;; whole cache.
- (tramp-flush-directory-properties
- v (if parents "/" (file-name-directory localname)))
- (tramp-barf-unless-okay
- v (format "%s %s"
- (if parents "mkdir -p" "mkdir")
- (tramp-shell-quote-argument localname))
- "Couldn't make directory %s" dir)))
-
-(defun tramp-sh-handle-delete-directory (directory &optional recursive trash)
- "Like `delete-directory' for Tramp files."
- (setq directory (expand-file-name directory))
- (with-parsed-tramp-file-name directory nil
- (tramp-flush-file-properties v (file-name-directory localname))
- (tramp-flush-directory-properties v localname)
- (tramp-barf-unless-okay
- v (format "cd / && %s %s"
- (or (and trash (tramp-get-remote-trash v))
- (if recursive "rm -rf" "rmdir"))
- (tramp-shell-quote-argument localname))
- "Couldn't delete %s" directory)))
-
-(defun tramp-sh-handle-delete-file (filename &optional trash)
- "Like `delete-file' for Tramp files."
- (setq filename (expand-file-name filename))
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v (file-name-directory localname))
- (tramp-flush-file-properties v localname)
- (tramp-barf-unless-okay
- v (format "%s %s"
- (or (and trash (tramp-get-remote-trash v)) "rm -f")
- (tramp-shell-quote-argument localname))
- "Couldn't delete %s" filename)))
-
-;; Dired.
-
-(defun tramp-sh-handle-dired-compress-file (file)
- "Like `dired-compress-file' for Tramp files."
- ;; Code stolen mainly from dired-aux.el.
- (with-parsed-tramp-file-name file nil
- (tramp-flush-file-properties v localname)
- (let ((suffixes dired-compress-file-suffixes)
- suffix)
- ;; See if any suffix rule matches this file name.
- (while suffixes
- (let (case-fold-search)
- (if (string-match-p (car (car suffixes)) localname)
- (setq suffix (car suffixes) suffixes nil))
- (setq suffixes (cdr suffixes))))
-
- (cond ((file-symlink-p file) nil)
- ((and suffix (nth 2 suffix))
- ;; We found an uncompression rule.
- (with-tramp-progress-reporter
- v 0 (format "Uncompressing %s" file)
- (when (tramp-send-command-and-check
- v (concat (nth 2 suffix) " "
- (tramp-shell-quote-argument localname)))
- (dired-remove-file file)
- (string-match (car suffix) file)
- (concat (substring file 0 (match-beginning 0))))))
- (t
- ;; We don't recognize the file as compressed, so compress it.
- ;; Try gzip.
- (with-tramp-progress-reporter v 0 (format "Compressing %s" file)
- (when (tramp-send-command-and-check
- v (concat "gzip -f "
- (tramp-shell-quote-argument localname)))
- (dired-remove-file file)
- (cond ((file-exists-p (concat file ".gz"))
- (concat file ".gz"))
- ((file-exists-p (concat file ".z"))
- (concat file ".z"))
- (t nil)))))))))
-
-(defun tramp-sh-handle-insert-directory
- (filename switches &optional wildcard full-directory-p)
- "Like `insert-directory' for Tramp files."
- (setq filename (expand-file-name filename))
- (unless switches (setq switches ""))
- ;; Check, whether directory is accessible.
- (unless wildcard
- (access-file filename "Reading directory"))
- (with-parsed-tramp-file-name filename nil
- (if (and (featurep 'ls-lisp)
- (not (symbol-value 'ls-lisp-use-insert-directory-program)))
- (tramp-handle-insert-directory
- filename switches wildcard full-directory-p)
- (when (stringp switches)
- (setq switches (split-string switches)))
- (when (tramp-get-ls-command-with ;FIXME: tramp-sh--quoting-style-options?
- v "--quoting-style=literal --show-control-chars")
- (setq switches
- (append
- switches '("--quoting-style=literal" "--show-control-chars"))))
- (unless (tramp-get-ls-command-with v "--dired")
- (setq switches (delete "--dired" switches)))
- (when wildcard
- (setq wildcard (tramp-run-real-handler
- #'file-name-nondirectory (list localname)))
- (setq localname (tramp-run-real-handler
- #'file-name-directory (list localname))))
- (unless (or full-directory-p (member "-d" switches))
- (setq switches (append switches '("-d"))))
- (setq switches (mapconcat #'tramp-shell-quote-argument switches " "))
- (when wildcard
- (setq switches (concat switches " " wildcard)))
- (tramp-message
- v 4 "Inserting directory `ls %s %s', wildcard %s, fulldir %s"
- switches filename (if wildcard "yes" "no")
- (if full-directory-p "yes" "no"))
- ;; If `full-directory-p', we just say `ls -l FILENAME'.
- ;; Else we chdir to the parent directory, then say `ls -ld BASENAME'.
- (if full-directory-p
- (tramp-send-command
- v
- (format "%s %s %s 2>/dev/null"
- (tramp-get-ls-command v)
- switches
- (if wildcard
- localname
- (tramp-shell-quote-argument (concat localname ".")))))
- (tramp-barf-unless-okay
- v
- (format "cd %s" (tramp-shell-quote-argument
- (tramp-run-real-handler
- #'file-name-directory (list localname))))
- "Couldn't `cd %s'"
- (tramp-shell-quote-argument
- (tramp-run-real-handler #'file-name-directory (list localname))))
- (tramp-send-command
- v
- (format "%s %s %s 2>/dev/null"
- (tramp-get-ls-command v)
- switches
- (if (or wildcard
- (zerop (length
- (tramp-run-real-handler
- #'file-name-nondirectory (list localname)))))
- ""
- (tramp-shell-quote-argument
- (tramp-run-real-handler
- #'file-name-nondirectory (list localname)))))))
-
- (save-restriction
- (let ((beg (point)))
- (narrow-to-region (point) (point))
- ;; We cannot use `insert-buffer-substring' because the Tramp
- ;; buffer changes its contents before insertion due to calling
- ;; `expand-file-name' and alike.
- (insert
- (with-current-buffer (tramp-get-buffer v)
- (buffer-string)))
-
- ;; Check for "--dired" output.
- (forward-line -2)
- (when (looking-at-p "//SUBDIRED//")
- (forward-line -1))
- (when (looking-at "//DIRED//\\s-+")
- (let ((databeg (match-end 0))
- (end (point-at-eol)))
- ;; Now read the numeric positions of file names.
- (goto-char databeg)
- (while (< (point) end)
- (let ((start (+ beg (read (current-buffer))))
- (end (+ beg (read (current-buffer)))))
- (if (memq (char-after end) '(?\n ?\ ))
- ;; End is followed by \n or by " -> ".
- (put-text-property start end 'dired-filename t))))))
- ;; Remove trailing lines.
- (goto-char (point-at-bol))
- (while (looking-at "//")
- (forward-line 1)
- (delete-region (match-beginning 0) (point)))
-
- ;; Some busyboxes are reluctant to discard colors.
- (unless
- (string-match-p "color" (tramp-get-connection-property v "ls" ""))
- (goto-char beg)
- (while
- (re-search-forward tramp-display-escape-sequence-regexp nil t)
- (replace-match "")))
-
- ;; Decode the output, it could be multibyte.
- (decode-coding-region
- beg (point-max)
- (or file-name-coding-system default-file-name-coding-system))
-
- ;; The inserted file could be from somewhere else.
- (when (and (not wildcard) (not full-directory-p))
- (goto-char (point-max))
- (when (file-symlink-p filename)
- (goto-char (search-backward "->" beg 'noerror)))
- (search-backward
- (if (zerop (length (file-name-nondirectory filename)))
- "."
- (file-name-nondirectory filename))
- beg 'noerror)
- (replace-match (file-relative-name filename) t))
-
- ;; Try to insert the amount of free space.
- (goto-char (point-min))
- ;; First find the line to put it on.
- (when (re-search-forward "^\\([[:space:]]*total\\)" nil t)
- (let ((available (get-free-disk-space ".")))
- (when available
- ;; Replace "total" with "total used", to avoid confusion.
- (replace-match "\\1 used in directory")
- (end-of-line)
- (insert " available " available))))
-
- (goto-char (point-max)))))))
-
-;; Canonicalization of file names.
-
-(defun tramp-sh-handle-expand-file-name (name &optional dir)
- "Like `expand-file-name' for Tramp files.
-If the localname part of the given file name starts with \"/../\" then
-the result will be a local, non-Tramp, file name."
- ;; If DIR is not given, use `default-directory' or "/".
- (setq dir (or dir default-directory "/"))
- ;; Handle empty NAME.
- (when (zerop (length name)) (setq name "."))
- ;; Unless NAME is absolute, concat DIR and NAME.
- (unless (file-name-absolute-p name)
- (setq name (concat (file-name-as-directory dir) name)))
- ;; If connection is not established yet, run the real handler.
- (if (not (tramp-connectable-p name))
- (tramp-run-real-handler #'expand-file-name (list name nil))
- ;; Dissect NAME.
- (with-parsed-tramp-file-name name nil
- (unless (tramp-run-real-handler #'file-name-absolute-p (list localname))
- (setq localname (concat "~/" localname)))
- ;; Tilde expansion if necessary. This needs a shell which
- ;; groks tilde expansion! The function `tramp-find-shell' is
- ;; supposed to find such a shell on the remote host. Please
- ;; tell me about it when this doesn't work on your system.
- (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
- (let ((uname (match-string 1 localname))
- (fname (match-string 2 localname)))
- ;; We cannot simply apply "~/", because under sudo "~/" is
- ;; expanded to the local user home directory but to the
- ;; root home directory. On the other hand, using always
- ;; the default user name for tilde expansion is not
- ;; appropriate either, because ssh and companions might
- ;; use a user name from the config file.
- (when (and (string-equal uname "~")
- (string-match-p "\\`su\\(do\\)?\\'" method))
- (setq uname (concat uname user)))
- (setq uname
- (with-tramp-connection-property v uname
- (tramp-send-command
- v (format "cd %s && pwd" (tramp-shell-quote-argument uname)))
- (with-current-buffer (tramp-get-buffer v)
- (goto-char (point-min))
- (buffer-substring (point) (point-at-eol)))))
- (setq localname (concat uname fname))))
- ;; There might be a double slash, for example when "~/"
- ;; expands to "/". Remove this.
- (while (string-match "//" localname)
- (setq localname (replace-match "/" t t localname)))
- ;; No tilde characters in file name, do normal
- ;; `expand-file-name' (this does "/./" and "/../").
- ;; `default-directory' is bound, because on Windows there would
- ;; be problems with UNC shares or Cygwin mounts.
- (let ((default-directory (tramp-compat-temporary-file-directory)))
- (tramp-make-tramp-file-name
- v (tramp-drop-volume-letter
- (tramp-run-real-handler
- #'expand-file-name (list localname))))))))
-
-;;; Remote commands:
-
-;; We use BUFFER also as connection buffer during setup. Because of
-;; this, its original contents must be saved, and restored once
-;; connection has been setup.
-(defun tramp-sh-handle-make-process (&rest args)
- "Like `make-process' for Tramp files."
- (when args
- (with-parsed-tramp-file-name (expand-file-name default-directory) nil
- (let ((name (plist-get args :name))
- (buffer (plist-get args :buffer))
- (command (plist-get args :command))
- (coding (plist-get args :coding))
- (noquery (plist-get args :noquery))
- (connection-type (plist-get args :connection-type))
- (filter (plist-get args :filter))
- (sentinel (plist-get args :sentinel))
- (stderr (plist-get args :stderr)))
- (unless (stringp name)
- (signal 'wrong-type-argument (list #'stringp name)))
- (unless (or (null buffer) (bufferp buffer) (stringp buffer))
- (signal 'wrong-type-argument (list #'stringp buffer)))
- (unless (consp command)
- (signal 'wrong-type-argument (list #'consp command)))
- (unless (or (null coding)
- (and (symbolp coding) (memq coding coding-system-list))
- (and (consp coding)
- (memq (car coding) coding-system-list)
- (memq (cdr coding) coding-system-list)))
- (signal 'wrong-type-argument (list #'symbolp coding)))
- (unless (or (null connection-type) (memq connection-type '(pipe pty)))
- (signal 'wrong-type-argument (list #'symbolp connection-type)))
- (unless (or (null filter) (functionp filter))
- (signal 'wrong-type-argument (list #'functionp filter)))
- (unless (or (null sentinel) (functionp sentinel))
- (signal 'wrong-type-argument (list #'functionp sentinel)))
- (unless (or (null stderr) (bufferp stderr) (stringp stderr))
- (signal 'wrong-type-argument (list #'stringp stderr)))
-
- (let* ((buffer
- (if buffer
- (get-buffer-create buffer)
- ;; BUFFER can be nil. We use a temporary buffer.
- (generate-new-buffer tramp-temp-buffer-name)))
- (stderr (and stderr (get-buffer-create stderr)))
- (tmpstderr (and stderr (tramp-make-tramp-temp-file v)))
- (program (car command))
- (args (cdr command))
- ;; When PROGRAM matches "*sh", and the first arg is
- ;; "-c", it might be that the arguments exceed the
- ;; command line length. Therefore, we modify the
- ;; command.
- (heredoc (and (stringp program)
- (string-match-p "sh$" program)
- (string-equal "-c" (car args))
- (= (length args) 2)))
- ;; When PROGRAM is nil, we just provide a tty.
- (args (if (not heredoc) args
- (let ((i 250))
- (while (and (< i (length (cadr args)))
- (string-match " " (cadr args) i))
- (setcdr
- args
- (list
- (replace-match " \\\\\n" nil nil (cadr args))))
- (setq i (+ i 250))))
- (cdr args)))
- ;; Use a human-friendly prompt, for example for
- ;; `shell'. We discard hops, if existing, that's why
- ;; we cannot use `file-remote-p'.
- (prompt (format "PS1=%s %s"
- (tramp-make-tramp-file-name v nil 'nohop)
- tramp-initial-end-of-output))
- ;; We use as environment the difference to toplevel
- ;; `process-environment'.
- env uenv
- (env (dolist (elt (cons prompt process-environment) env)
- (or (member
- elt (default-toplevel-value 'process-environment))
- (if (string-match-p "=" elt)
- (setq env (append env `(,elt)))
- (if (tramp-get-env-with-u-option v)
- (setq env (append `("-u" ,elt) env))
- (setq uenv (cons elt uenv)))))))
- (command
- (when (stringp program)
- (format "cd %s && %s exec %s %s env %s %s"
- (tramp-shell-quote-argument localname)
- (if uenv
- (format
- "unset %s &&"
- (mapconcat
- #'tramp-shell-quote-argument uenv " "))
- "")
- (if heredoc (format "<<'%s'" tramp-end-of-heredoc) "")
- (if tmpstderr (format "2>'%s'" tmpstderr) "")
- (mapconcat #'tramp-shell-quote-argument env " ")
- (if heredoc
- (format "%s\n(\n%s\n) </dev/tty\n%s"
- program (car args) tramp-end-of-heredoc)
- (mapconcat #'tramp-shell-quote-argument
- (cons program args) " ")))))
- (tramp-process-connection-type
- (or (null program) tramp-process-connection-type))
- (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
- (name1 name)
- (i 0)
- ;; We do not want to raise an error when `make-process'
- ;; has been started several times in `eshell' and
- ;; friends.
- tramp-current-connection
- p)
-
- (while (get-process name1)
- ;; NAME must be unique as process name.
- (setq i (1+ i)
- name1 (format "%s<%d>" name i)))
- (setq name name1)
- ;; Set the new process properties.
- (tramp-set-connection-property v "process-name" name)
- (tramp-set-connection-property v "process-buffer" buffer)
-
- (with-current-buffer (tramp-get-connection-buffer v)
- (unwind-protect
- ;; We catch this event. Otherwise, `make-process' could
- ;; be called on the local host.
- (save-excursion
- (save-restriction
- ;; Activate narrowing in order to save BUFFER
- ;; contents. Clear also the modification time;
- ;; otherwise we might be interrupted by
- ;; `verify-visited-file-modtime'.
- (let ((buffer-undo-list t)
- (inhibit-read-only t)
- (mark (point-max)))
- (clear-visited-file-modtime)
- (narrow-to-region (point-max) (point-max))
- ;; We call `tramp-maybe-open-connection', in
- ;; order to cleanup the prompt afterwards.
- (catch 'suppress
- (tramp-maybe-open-connection v)
- (setq p (tramp-get-connection-process v))
- ;; Set the pid of the remote shell. This is
- ;; needed when sending signals remotely.
- (let ((pid (tramp-send-command-and-read v "echo $$")))
- (process-put p 'remote-pid pid)
- (tramp-set-connection-property p "remote-pid" pid))
- ;; `tramp-maybe-open-connection' and
- ;; `tramp-send-command-and-read' could have
- ;; trashed the connection buffer. Remove this.
- (widen)
- (delete-region mark (point-max))
- (narrow-to-region (point-max) (point-max))
- ;; Now do it.
- (if command
- ;; Send the command.
- (tramp-send-command v command nil t) ; nooutput
- ;; Check, whether a pty is associated.
- (unless (process-get p 'remote-tty)
- (tramp-error
- v 'file-error
- "pty association is not supported for `%s'"
- name))))
- ;; Set sentinel and filter.
- (when sentinel
- (set-process-sentinel p sentinel))
- (when filter
- (set-process-filter p filter))
- ;; Set query flag and process marker for this
- ;; process. We ignore errors, because the
- ;; process could have finished already.
- (ignore-errors
- (set-process-query-on-exit-flag p (null noquery))
- (set-marker (process-mark p) (point)))
- ;; Provide error buffer. This shows only
- ;; initial error messages; messages arriving
- ;; later on shall be inserted by `auto-revert'.
- ;; The temporary file will still be existing.
- ;; TODO: Write a sentinel, which deletes the
- ;; temporary file.
- (when tmpstderr
- ;; We must flush them here already; otherwise
- ;; `insert-file-contents' will fail.
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer")
- (with-current-buffer stderr
- (insert-file-contents
- (tramp-make-tramp-file-name v tmpstderr) 'visit)
- (auto-revert-mode)))
- ;; Return process.
- p)))
-
- ;; Save exit.
- (if (string-match-p tramp-temp-buffer-name (buffer-name))
- (ignore-errors
- (set-process-buffer p nil)
- (kill-buffer (current-buffer)))
- (set-buffer-modified-p bmp))
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer"))))))))
-
-(defun tramp-sh-handle-process-file
- (program &optional infile destination display &rest args)
- "Like `process-file' for Tramp files."
- ;; The implementation is not complete yet.
- (when (and (numberp destination) (zerop destination))
- (error "Implementation does not handle immediate return"))
-
- (with-parsed-tramp-file-name default-directory nil
- (let (command env uenv input tmpinput stderr tmpstderr outbuf ret)
- ;; Compute command.
- (setq command (mapconcat #'tramp-shell-quote-argument
- (cons program args) " "))
- ;; We use as environment the difference to toplevel
`process-environment'.
- (dolist (elt process-environment)
- (or (member elt (default-toplevel-value 'process-environment))
- (if (string-match-p "=" elt)
- (setq env (append env `(,elt)))
- (if (tramp-get-env-with-u-option v)
- (setq env (append `("-u" ,elt) env))
- (setq uenv (cons elt uenv))))))
- (when env
- (setq command
- (format
- "env %s %s"
- (mapconcat #'tramp-shell-quote-argument env " ") command)))
- (when uenv
- (setq command
- (format
- "unset %s && %s"
- (mapconcat #'tramp-shell-quote-argument uenv " ") command)))
- ;; Determine input.
- (if (null infile)
- (setq input "/dev/null")
- (setq infile (expand-file-name infile))
- (if (tramp-equal-remote default-directory infile)
- ;; INFILE is on the same remote host.
- (setq input (with-parsed-tramp-file-name infile nil localname))
- ;; INFILE must be copied to remote host.
- (setq input (tramp-make-tramp-temp-file v)
- tmpinput (tramp-make-tramp-file-name v input 'nohop))
- (copy-file infile tmpinput t)))
- (when input (setq command (format "%s <%s" command input)))
-
- ;; Determine output.
- (cond
- ;; Just a buffer.
- ((bufferp destination)
- (setq outbuf destination))
- ;; A buffer name.
- ((stringp destination)
- (setq outbuf (get-buffer-create destination)))
- ;; (REAL-DESTINATION ERROR-DESTINATION)
- ((consp destination)
- ;; output.
- (cond
- ((bufferp (car destination))
- (setq outbuf (car destination)))
- ((stringp (car destination))
- (setq outbuf (get-buffer-create (car destination))))
- ((car destination)
- (setq outbuf (current-buffer))))
- ;; stderr.
- (cond
- ((stringp (cadr destination))
- (setcar (cdr destination) (expand-file-name (cadr destination)))
- (if (tramp-equal-remote default-directory (cadr destination))
- ;; stderr is on the same remote host.
- (setq stderr (with-parsed-tramp-file-name
- (cadr destination) nil localname))
- ;; stderr must be copied to remote host. The temporary
- ;; file must be deleted after execution.
- (setq stderr (tramp-make-tramp-temp-file v)
- tmpstderr (tramp-make-tramp-file-name v stderr 'nohop))))
- ;; stderr to be discarded.
- ((null (cadr destination))
- (setq stderr "/dev/null"))))
- ;; 't
- (destination
- (setq outbuf (current-buffer))))
- (when stderr (setq command (format "%s 2>%s" command stderr)))
-
- ;; Send the command. It might not return in time, so we protect
- ;; it. Call it in a subshell, in order to preserve working
- ;; directory.
- (condition-case nil
- (unwind-protect
- (setq ret
- (if (tramp-send-command-and-check
- v (format "cd %s && %s"
- (tramp-shell-quote-argument localname)
- command)
- t t)
- 0 1))
- ;; We should add the output anyway.
- (when outbuf
- (with-current-buffer outbuf
- (insert
- (with-current-buffer (tramp-get-connection-buffer v)
- (buffer-string))))
- (when (and display (get-buffer-window outbuf t)) (redisplay))))
- ;; When the user did interrupt, we should do it also. We use
- ;; return code -1 as marker.
- (quit
- (kill-buffer (tramp-get-connection-buffer v))
- (setq ret -1))
- ;; Handle errors.
- (error
- (kill-buffer (tramp-get-connection-buffer v))
- (setq ret 1)))
-
- ;; Provide error file.
- (when tmpstderr (rename-file tmpstderr (cadr destination) t))
-
- ;; Cleanup. We remove all file cache values for the connection,
- ;; because the remote process could have changed them.
- (when tmpinput (delete-file tmpinput))
-
- (unless process-file-side-effects
- (tramp-flush-directory-properties v ""))
-
- ;; Return exit status.
- (if (equal ret -1)
- (keyboard-quit)
- ret))))
-
-(defun tramp-sh-handle-exec-path ()
- "Like `exec-path' for Tramp files."
- (append
- (tramp-get-remote-path (tramp-dissect-file-name default-directory))
- ;; The equivalent to `exec-directory'.
- `(,(tramp-compat-file-local-name default-directory))))
-
-(defun tramp-sh-handle-file-local-copy (filename)
- "Like `file-local-copy' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (unless (file-exists-p (file-truename filename))
- (tramp-error
- v tramp-file-missing
- "Cannot make local copy of non-existing file `%s'" filename))
-
- (let* ((size (tramp-compat-file-attribute-size
- (file-attributes (file-truename filename))))
- (rem-enc (tramp-get-inline-coding v "remote-encoding" size))
- (loc-dec (tramp-get-inline-coding v "local-decoding" size))
- (tmpfile (tramp-compat-make-temp-file filename)))
-
- (condition-case err
- (cond
- ;; `copy-file' handles direct copy and out-of-band methods.
- ((or (tramp-local-host-p v)
- (tramp-method-out-of-band-p v size))
- (copy-file filename tmpfile 'ok-if-already-exists 'keep-time))
-
- ;; Use inline encoding for file transfer.
- (rem-enc
- (with-tramp-progress-reporter
- v 3
- (format-message
- "Encoding remote file `%s' with `%s'" filename rem-enc)
- (tramp-barf-unless-okay
- v (format rem-enc (tramp-shell-quote-argument localname))
- "Encoding remote file failed"))
-
- (with-tramp-progress-reporter
- v 3 (format-message
- "Decoding local file `%s' with `%s'" tmpfile loc-dec)
- (if (functionp loc-dec)
- ;; If local decoding is a function, we call it. We
- ;; must disable multibyte, because
- ;; `uudecode-decode-region' doesn't handle it
- ;; correctly. Unset `file-name-handler-alist'.
- ;; Otherwise, epa-file gets confused.
- (let (file-name-handler-alist
- (coding-system-for-write 'binary))
- (with-temp-file tmpfile
- (set-buffer-multibyte nil)
- (insert-buffer-substring (tramp-get-buffer v))
- (funcall loc-dec (point-min) (point-max))))
-
- ;; If tramp-decoding-function is not defined for this
- ;; method, we invoke tramp-decoding-command instead.
- (let ((tmpfile2 (tramp-compat-make-temp-file filename)))
- ;; Unset `file-name-handler-alist'. Otherwise,
- ;; epa-file gets confused.
- (let (file-name-handler-alist
- (coding-system-for-write 'binary))
- (with-current-buffer (tramp-get-buffer v)
- (write-region
- (point-min) (point-max) tmpfile2 nil 'no-message)))
- (unwind-protect
- (tramp-call-local-coding-command
- loc-dec tmpfile2 tmpfile)
- (delete-file tmpfile2)))))
-
- ;; Set proper permissions.
- (set-file-modes tmpfile (tramp-default-file-modes filename))
- ;; Set local user ownership.
- (tramp-set-file-uid-gid tmpfile))
-
- ;; Oops, I don't know what to do.
- (t (tramp-error
- v 'file-error "Wrong method specification for `%s'" method)))
-
- ;; Error handling.
- ((error quit)
- (delete-file tmpfile)
- (signal (car err) (cdr err))))
-
- (run-hooks 'tramp-handle-file-local-copy-hook)
- tmpfile)))
-
-;; CCC grok LOCKNAME
-(defun tramp-sh-handle-write-region
- (start end filename &optional append visit lockname mustbenew)
- "Like `write-region' for Tramp files."
- (setq filename (expand-file-name filename))
- (with-parsed-tramp-file-name filename nil
- (when (and mustbenew (file-exists-p filename)
- (or (eq mustbenew 'excl)
- (not
- (y-or-n-p
- (format "File %s exists; overwrite anyway? " filename)))))
- (tramp-error v 'file-already-exists filename))
-
- (let ((uid (or (tramp-compat-file-attribute-user-id
- (file-attributes filename 'integer))
- (tramp-get-remote-uid v 'integer)))
- (gid (or (tramp-compat-file-attribute-group-id
- (file-attributes filename 'integer))
- (tramp-get-remote-gid v 'integer))))
-
- (if (and (tramp-local-host-p v)
- ;; `file-writable-p' calls `file-expand-file-name'. We
- ;; cannot use `tramp-run-real-handler' therefore.
- (let (file-name-handler-alist)
- (and
- (file-writable-p (file-name-directory localname))
- (or (file-directory-p localname)
- (file-writable-p localname)))))
- ;; Short track: if we are on the local host, we can run directly.
- (tramp-run-real-handler
- #'write-region
- (list start end localname append 'no-message lockname))
-
- (let* ((modes (save-excursion (tramp-default-file-modes filename)))
- ;; We use this to save the value of
- ;; `last-coding-system-used' after writing the tmp
- ;; file. At the end of the function, we set
- ;; `last-coding-system-used' to this saved value. This
- ;; way, any intermediary coding systems used while
- ;; talking to the remote shell or suchlike won't hose
- ;; this variable. This approach was snarfed from
- ;; ange-ftp.el.
- coding-system-used
- ;; Write region into a tmp file. This isn't really
- ;; needed if we use an encoding function, but currently
- ;; we use it always because this makes the logic
- ;; simpler. We must also set `temporary-file-directory',
- ;; because it could point to a remote directory.
- (temporary-file-directory
- (tramp-compat-temporary-file-directory))
- (tmpfile (or tramp-temp-buffer-file-name
- (tramp-compat-make-temp-file filename))))
-
- ;; If `append' is non-nil, we copy the file locally, and let
- ;; the native `write-region' implementation do the job.
- (when append (copy-file filename tmpfile 'ok))
-
- ;; We say `no-message' here because we don't want the
- ;; visited file modtime data to be clobbered from the temp
- ;; file. We call `set-visited-file-modtime' ourselves later
- ;; on. We must ensure that `file-coding-system-alist'
- ;; matches `tmpfile'.
- (let (file-name-handler-alist
- (file-coding-system-alist
- (tramp-find-file-name-coding-system-alist filename tmpfile)))
- (condition-case err
- (tramp-run-real-handler
- #'write-region
- (list start end tmpfile append 'no-message lockname))
- ((error quit)
- (setq tramp-temp-buffer-file-name nil)
- (delete-file tmpfile)
- (signal (car err) (cdr err))))
-
- ;; Now, `last-coding-system-used' has the right value. Remember it.
- (setq coding-system-used last-coding-system-used))
-
- ;; The permissions of the temporary file should be set. If
- ;; FILENAME does not exist (eq modes nil) it has been
- ;; renamed to the backup file. This case `save-buffer'
- ;; handles permissions.
- ;; Ensure that it is still readable.
- (when modes
- (set-file-modes tmpfile (logior (or modes 0) #o0400)))
-
- ;; This is a bit lengthy due to the different methods
- ;; possible for file transfer. First, we check whether the
- ;; method uses an scp program. If so, we call it.
- ;; Otherwise, both encoding and decoding command must be
- ;; specified. However, if the method _also_ specifies an
- ;; encoding function, then that is used for encoding the
- ;; contents of the tmp file.
- (let* ((size (tramp-compat-file-attribute-size
- (file-attributes tmpfile)))
- (rem-dec (tramp-get-inline-coding v "remote-decoding" size))
- (loc-enc (tramp-get-inline-coding v "local-encoding" size)))
- (cond
- ;; `copy-file' handles direct copy and out-of-band methods.
- ((or (tramp-local-host-p v)
- (tramp-method-out-of-band-p v size))
- (if (and (not (stringp start))
- (= (or end (point-max)) (point-max))
- (= (or start (point-min)) (point-min))
- (tramp-get-method-parameter v 'tramp-copy-keep-tmpfile))
- (progn
- (setq tramp-temp-buffer-file-name tmpfile)
- (condition-case err
- ;; We keep the local file for performance
- ;; reasons, useful for "rsync".
- (copy-file tmpfile filename t)
- ((error quit)
- (setq tramp-temp-buffer-file-name nil)
- (delete-file tmpfile)
- (signal (car err) (cdr err)))))
- (setq tramp-temp-buffer-file-name nil)
- ;; Don't rename, in order to keep context in SELinux.
- (unwind-protect
- (copy-file tmpfile filename t)
- (delete-file tmpfile))))
-
- ;; Use inline file transfer.
- (rem-dec
- ;; Encode tmpfile.
- (unwind-protect
- (with-temp-buffer
- (set-buffer-multibyte nil)
- ;; Use encoding function or command.
- (with-tramp-progress-reporter
- v 3 (format-message
- "Encoding local file `%s' using `%s'"
- tmpfile loc-enc)
- (if (functionp loc-enc)
- ;; The following `let' is a workaround for
- ;; the base64.el that comes with pgnus-0.84.
- ;; If both of the following conditions are
- ;; satisfied, it tries to write to a local
- ;; file in default-directory, but at this
- ;; point, default-directory is remote.
- ;; (`call-process-region' can't write to
- ;; remote files, it seems.) The file in
- ;; question is a tmp file anyway.
- (let ((coding-system-for-read 'binary)
- (default-directory
- (tramp-compat-temporary-file-directory)))
- (insert-file-contents-literally tmpfile)
- (funcall loc-enc (point-min) (point-max)))
-
- (unless (zerop (tramp-call-local-coding-command
- loc-enc tmpfile t))
- (tramp-error
- v 'file-error
- (eval-when-compile
- (concat "Cannot write to `%s', "
- "local encoding command `%s' failed"))
- filename loc-enc))))
-
- ;; Send buffer into remote decoding command which
- ;; writes to remote file. Because this happens on
- ;; the remote host, we cannot use the function.
- (with-tramp-progress-reporter
- v 3 (format-message
- "Decoding remote file `%s' using `%s'"
- filename rem-dec)
- (goto-char (point-max))
- (unless (bolp) (newline))
- (tramp-send-command
- v
- (format
- (concat rem-dec " <<'%s'\n%s%s")
- (tramp-shell-quote-argument localname)
- tramp-end-of-heredoc
- (buffer-string)
- tramp-end-of-heredoc))
- (tramp-barf-unless-okay
- v nil
- "Couldn't write region to `%s', decode using `%s' failed"
- filename rem-dec)
- ;; When `file-precious-flag' is set, the region is
- ;; written to a temporary file. Check that the
- ;; checksum is equal to that from the local tmpfile.
- (when file-precious-flag
- (erase-buffer)
- (and
- ;; cksum runs locally, if possible.
- (zerop (tramp-call-process v "cksum" tmpfile t))
- ;; cksum runs remotely.
- (tramp-send-command-and-check
- v
- (format
- "cksum <%s" (tramp-shell-quote-argument localname)))
- ;; ... they are different.
- (not
- (string-equal
- (buffer-string)
- (with-current-buffer (tramp-get-buffer v)
- (buffer-string))))
- (tramp-error
- v 'file-error
- (eval-when-compile
- (concat "Couldn't write region to `%s',"
- " decode using `%s' failed"))
- filename rem-dec)))))
-
- ;; Save exit.
- (delete-file tmpfile)))
-
- ;; That's not expected.
- (t
- (tramp-error
- v 'file-error
- (eval-when-compile
- (concat "Method `%s' should specify both encoding and "
- "decoding command or an scp program"))
- method))))
-
- ;; Make `last-coding-system-used' have the right value.
- (when coding-system-used
- (set 'last-coding-system-used coding-system-used))))
-
- (tramp-flush-file-properties v (file-name-directory localname))
- (tramp-flush-file-properties v localname)
-
- ;; We must protect `last-coding-system-used', now we have set it
- ;; to its correct value.
- (let (last-coding-system-used (need-chown t))
- ;; Set file modification time.
- (when (or (eq visit t) (stringp visit))
- (let ((file-attr (file-attributes filename 'integer)))
- (set-visited-file-modtime
- ;; We must pass modtime explicitly, because FILENAME can
- ;; be different from (buffer-file-name), f.e. if
- ;; `file-precious-flag' is set.
- (tramp-compat-file-attribute-modification-time file-attr))
- (when (and (= (tramp-compat-file-attribute-user-id file-attr) uid)
- (= (tramp-compat-file-attribute-group-id file-attr)
gid))
- (setq need-chown nil))))
-
- ;; Set the ownership.
- (when need-chown
- (tramp-set-file-uid-gid filename uid gid))
- (when (and (null noninteractive)
- (or (eq visit t) (null visit) (stringp visit)))
- (tramp-message v 0 "Wrote %s" filename))
- (run-hooks 'tramp-handle-write-region-hook)))))
-
-(defvar tramp-vc-registered-file-names nil
- "List used to collect file names, which are checked during `vc-registered'.")
-
-;; VC backends check for the existence of various different special
-;; files. This is very time consuming, because every single check
-;; requires a remote command (the file cache must be invalidated).
-;; Therefore, we apply a kind of optimization. We install the file
-;; name handler `tramp-vc-file-name-handler', which does nothing but
-;; remembers all file names for which `file-exists-p' or
-;; `file-readable-p' has been applied. A first run of `vc-registered'
-;; is performed. Afterwards, a script is applied for all collected
-;; file names, using just one remote command. The result of this
-;; script is used to fill the file cache with actual values. Now we
-;; can reset the file name handlers, and we make a second run of
-;; `vc-registered', which returns the expected result without sending
-;; any other remote command.
-(defun tramp-sh-handle-vc-registered (file)
- "Like `vc-registered' for Tramp files."
- (when vc-handled-backends
- (with-temp-message ""
- (with-parsed-tramp-file-name file nil
- (with-tramp-progress-reporter
- v 3 (format-message "Checking `vc-registered' for %s" file)
-
- ;; There could be new files, created by the vc backend. We
- ;; cannot reuse the old cache entries, therefore. In
- ;; `tramp-get-file-property', `remote-file-name-inhibit-cache'
- ;; could also be a timestamp as `current-time' returns. This
- ;; means invalidate all cache entries with an older timestamp.
- (let (tramp-vc-registered-file-names
- (remote-file-name-inhibit-cache (current-time))
- (file-name-handler-alist
- `((,tramp-file-name-regexp . tramp-vc-file-name-handler))))
-
- ;; Here we collect only file names, which need an operation.
- (tramp-with-demoted-errors
- v "Error in 1st pass of `vc-registered': %s"
- (tramp-run-real-handler #'vc-registered (list file)))
- (tramp-message v 10 "\n%s" tramp-vc-registered-file-names)
-
- ;; Send just one command, in order to fill the cache.
- (when tramp-vc-registered-file-names
- (tramp-maybe-send-script
- v
- (format tramp-vc-registered-read-file-names
- (tramp-get-file-exists-command v)
- (format "%s -r" (tramp-get-test-command v)))
- "tramp_vc_registered_read_file_names")
-
- (dolist
- (elt
- (ignore-errors
- ;; We cannot use `tramp-send-command-and-read',
- ;; because this does not cooperate well with
- ;; heredoc documents.
- (tramp-send-command
- v
- (format
- "tramp_vc_registered_read_file_names <<'%s'\n%s\n%s\n"
- tramp-end-of-heredoc
- (mapconcat #'tramp-shell-quote-argument
- tramp-vc-registered-file-names
- "\n")
- tramp-end-of-heredoc))
- (with-current-buffer (tramp-get-connection-buffer v)
- ;; Read the expression.
- (goto-char (point-min))
- (read (current-buffer)))))
-
- (tramp-set-file-property
- v (car elt) (cadr elt) (cadr (cdr elt))))))
-
- ;; Second run. Now all `file-exists-p' or `file-readable-p'
- ;; calls shall be answered from the file cache. We unset
- ;; `process-file-side-effects' and `remote-file-name-inhibit-cache'
- ;; in order to keep the cache.
- (let ((vc-handled-backends vc-handled-backends)
- remote-file-name-inhibit-cache process-file-side-effects)
- ;; Reduce `vc-handled-backends' in order to minimize process calls.
- (when (and (memq 'Bzr vc-handled-backends)
- (boundp 'vc-bzr-program)
- (not (with-tramp-connection-property v vc-bzr-program
- (tramp-find-executable
- v vc-bzr-program (tramp-get-remote-path v)))))
- (setq vc-handled-backends (remq 'Bzr vc-handled-backends)))
- (when (and (memq 'Git vc-handled-backends)
- (boundp 'vc-git-program)
- (not (with-tramp-connection-property v vc-git-program
- (tramp-find-executable
- v vc-git-program (tramp-get-remote-path v)))))
- (setq vc-handled-backends (remq 'Git vc-handled-backends)))
- (when (and (memq 'Hg vc-handled-backends)
- (boundp 'vc-hg-program)
- (not (with-tramp-connection-property v vc-hg-program
- (tramp-find-executable
- v vc-hg-program (tramp-get-remote-path v)))))
- (setq vc-handled-backends (remq 'Hg vc-handled-backends)))
- ;; Run.
- (tramp-with-demoted-errors
- v "Error in 2nd pass of `vc-registered': %s"
- (tramp-run-real-handler #'vc-registered (list file)))))))))
-
-;;;###tramp-autoload
-(defun tramp-sh-file-name-handler (operation &rest args)
- "Invoke remote-shell Tramp file name handler.
-Fall back to normal file name handler if no Tramp handler exists."
- (let ((fn (assoc operation tramp-sh-file-name-handler-alist)))
- (if fn
- (save-match-data (apply (cdr fn) args))
- (tramp-run-real-handler operation args))))
-
-;; This must be the last entry, because `identity' always matches.
-;;;###tramp-autoload
-(tramp--with-startup
- (tramp-register-foreign-file-name-handler
- #'identity #'tramp-sh-file-name-handler 'append))
-
-(defun tramp-vc-file-name-handler (operation &rest args)
- "Invoke special file name handler, which collects files to be handled."
- (save-match-data
- (let ((filename
- (tramp-replace-environment-variables
- (apply #'tramp-file-name-for-operation operation args)))
- (fn (assoc operation tramp-sh-file-name-handler-alist)))
- (if (tramp-tramp-file-p filename)
- (with-parsed-tramp-file-name filename nil
- (cond
- ;; That's what we want: file names, for which checks are
- ;; applied. We assume that VC uses only `file-exists-p'
- ;; and `file-readable-p' checks; otherwise we must extend
- ;; the list. We do not perform any action, but return
- ;; nil, in order to keep `vc-registered' running.
- ((and fn (memq operation '(file-exists-p file-readable-p)))
- (add-to-list 'tramp-vc-registered-file-names localname 'append)
- nil)
- ;; `process-file' and `start-file-process' shall be ignored.
- ((and fn (eq operation 'process-file) 0))
- ((and fn (eq operation 'start-file-process) nil))
- ;; Tramp file name handlers like `expand-file-name'. They
- ;; must still work.
- (fn (save-match-data (apply (cdr fn) args)))
- ;; Default file name handlers, we don't care.
- (t (tramp-run-real-handler operation args))))
-
- ;; When `tramp-mode' is not enabled, or the file name is
- ;; quoted, we don't do anything.
- (tramp-run-real-handler operation args)))))
-
-(defun tramp-sh-handle-file-notify-add-watch (file-name flags _callback)
- "Like `file-notify-add-watch' for Tramp files."
- (setq file-name (expand-file-name file-name))
- (with-parsed-tramp-file-name file-name nil
- (let ((default-directory (file-name-directory file-name))
- command events filter p sequence)
- (cond
- ;; "inotifywait".
- ((setq command (tramp-get-remote-inotifywait v))
- (setq filter #'tramp-sh-inotifywait-process-filter
- events
- (cond
- ((and (memq 'change flags) (memq 'attribute-change flags))
- (eval-when-compile
- (concat "create,modify,move,moved_from,moved_to,move_self,"
- "delete,delete_self,attrib,ignored")))
- ((memq 'change flags)
- (eval-when-compile
- (concat "create,modify,move,moved_from,moved_to,move_self,"
- "delete,delete_self,ignored")))
- ((memq 'attribute-change flags) "attrib,ignored"))
- sequence `(,command "-mq" "-e" ,events ,localname)
- ;; Make events a list of symbols.
- events
- (mapcar
- (lambda (x) (intern-soft (replace-regexp-in-string "_" "-" x)))
- (split-string events "," 'omit))))
- ;; "gio monitor".
- ((setq command (tramp-get-remote-gio-monitor v))
- (setq filter #'tramp-sh-gio-monitor-process-filter
- events
- (cond
- ((and (memq 'change flags) (memq 'attribute-change flags))
- '(created changed changes-done-hint moved deleted
- attribute-changed))
- ((memq 'change flags)
- '(created changed changes-done-hint moved deleted))
- ((memq 'attribute-change flags) '(attribute-changed)))
- sequence `(,command "monitor" ,localname)))
- ;; "gvfs-monitor-dir".
- ((setq command (tramp-get-remote-gvfs-monitor-dir v))
- (setq filter #'tramp-sh-gvfs-monitor-dir-process-filter
- events
- (cond
- ((and (memq 'change flags) (memq 'attribute-change flags))
- '(created changed changes-done-hint moved deleted
- attribute-changed))
- ((memq 'change flags)
- '(created changed changes-done-hint moved deleted))
- ((memq 'attribute-change flags) '(attribute-changed)))
- sequence `(,command ,localname)))
- ;; None.
- (t (tramp-error
- v 'file-notify-error
- "No file notification program found on %s"
- (file-remote-p file-name))))
- ;; Start process.
- (setq p (apply
- #'start-file-process
- (file-name-nondirectory command)
- (generate-new-buffer
- (format " *%s*" (file-name-nondirectory command)))
- sequence))
- ;; Return the process object as watch-descriptor.
- (if (not (processp p))
- (tramp-error
- v 'file-notify-error
- "`%s' failed to start on remote host"
- (mapconcat #'identity sequence " "))
- (tramp-message v 6 "Run `%s', %S" (mapconcat #'identity sequence " ") p)
- (process-put p 'vector v)
- ;; Needed for process filter.
- (process-put p 'events events)
- (process-put p 'watch-name localname)
- (set-process-query-on-exit-flag p nil)
- (set-process-filter p filter)
- (set-process-sentinel p #'tramp-file-notify-process-sentinel)
- ;; There might be an error if the monitor is not supported.
- ;; Give the filter a chance to read the output.
- (while (tramp-accept-process-output p 0))
- (unless (process-live-p p)
- (tramp-error
- p 'file-notify-error "Monitoring not supported for `%s'" file-name))
- p))))
-
-(defun tramp-sh-gio-monitor-process-filter (proc string)
- "Read output from \"gio monitor\" and add corresponding file-notify events."
- (let ((events (process-get proc 'events))
- (remote-prefix
- (with-current-buffer (process-buffer proc)
- (file-remote-p default-directory)))
- (rest-string (process-get proc 'rest-string)))
- (when rest-string
- (tramp-message proc 10 "Previous string:\n%s" rest-string))
- (tramp-message proc 6 "%S\n%s" proc string)
- (setq string (concat rest-string string)
- ;; Fix action names.
- string (replace-regexp-in-string
- "attributes changed" "attribute-changed" string)
- string (replace-regexp-in-string
- "changes done" "changes-done-hint" string)
- string (replace-regexp-in-string
- "renamed to" "moved" string))
- ;; https://bugs.launchpad.net/bugs/1742946
- (when
- (string-match-p "Monitoring not supported\\|No locations given" string)
- (delete-process proc))
-
- ;; Delete empty lines.
- (setq string (replace-regexp-in-string "\n\n" "\n" string))
-
- (while (string-match
- (eval-when-compile
- (concat "^[^:]+:"
- "[[:space:]]\\([^:]+\\):"
- "[[:space:]]" (regexp-opt tramp-gio-events t)
- "\\([[:space:]]\\([^:]+\\)\\)?$"))
- string)
-
- (let* ((file (match-string 1 string))
- (file1 (match-string 4 string))
- (object
- (list
- proc
- (list
- (intern-soft (match-string 2 string)))
- ;; File names are returned as absolute paths. We must
- ;; add the remote prefix.
- (concat remote-prefix file)
- (when file1 (concat remote-prefix file1)))))
- (setq string (replace-match "" nil nil string))
- ;; Remove watch when file or directory to be watched is deleted.
- (when (and (member (cl-caadr object) '(moved deleted))
- (string-equal file (process-get proc 'watch-name)))
- (delete-process proc))
- ;; Usually, we would add an Emacs event now. Unfortunately,
- ;; `unread-command-events' does not accept several events at
- ;; once. Therefore, we apply the handler directly.
- (when (member (cl-caadr object) events)
- (tramp-compat-funcall
- 'file-notify-handle-event
- `(file-notify ,object file-notify-callback)))))
-
- ;; Save rest of the string.
- (when (zerop (length string)) (setq string nil))
- (when string (tramp-message proc 10 "Rest string:\n%s" string))
- (process-put proc 'rest-string string)))
-
-(defun tramp-sh-gvfs-monitor-dir-process-filter (proc string)
- "Read output from \"gvfs-monitor-dir\" and add corresponding \
-file-notify events."
- (let ((events (process-get proc 'events))
- (remote-prefix
- (with-current-buffer (process-buffer proc)
- (file-remote-p default-directory)))
- (rest-string (process-get proc 'rest-string)))
- (when rest-string
- (tramp-message proc 10 "Previous string:\n%s" rest-string))
- (tramp-message proc 6 "%S\n%s" proc string)
- (setq string (concat rest-string string)
- ;; Attribute change is returned in unused wording.
- string (replace-regexp-in-string
- "ATTRIB CHANGED" "ATTRIBUTE_CHANGED" string))
-
- (while (string-match
- (eval-when-compile
- (concat "^[\n\r]*"
- "Directory Monitor Event:[\n\r]+"
- "Child = \\([^\n\r]+\\)[\n\r]+"
- "\\(Other = \\([^\n\r]+\\)[\n\r]+\\)?"
- "Event = \\([^[:blank:]]+\\)[\n\r]+"))
- string)
- (let* ((file (match-string 1 string))
- (file1 (match-string 3 string))
- (object
- (list
- proc
- (list
- (intern-soft
- (replace-regexp-in-string
- "_" "-" (downcase (match-string 4 string)))))
- ;; File names are returned as absolute paths. We must
- ;; add the remote prefix.
- (concat remote-prefix file)
- (when file1 (concat remote-prefix file1)))))
- (setq string (replace-match "" nil nil string))
- ;; Remove watch when file or directory to be watched is deleted.
- (when (and (member (cl-caadr object) '(moved deleted))
- (string-equal file (process-get proc 'watch-name)))
- (delete-process proc))
- ;; Usually, we would add an Emacs event now. Unfortunately,
- ;; `unread-command-events' does not accept several events at
- ;; once. Therefore, we apply the handler directly.
- (when (member (cl-caadr object) events)
- (tramp-compat-funcall
- 'file-notify-handle-event
- `(file-notify ,object file-notify-callback)))))
-
- ;; Save rest of the string.
- (when (zerop (length string)) (setq string nil))
- (when string (tramp-message proc 10 "Rest string:\n%s" string))
- (process-put proc 'rest-string string)))
-
-(defun tramp-sh-inotifywait-process-filter (proc string)
- "Read output from \"inotifywait\" and add corresponding file-notify events."
- (let ((events (process-get proc 'events)))
- (tramp-message proc 6 "%S\n%s" proc string)
- (dolist (line (split-string string "[\n\r]+" 'omit))
- ;; Check, whether there is a problem.
- (unless (string-match
- (eval-when-compile
- (concat "^[^[:blank:]]+"
- "[[:blank:]]+\\([^[:blank:]]+\\)+"
- "\\([[:blank:]]+\\([^\n\r]+\\)\\)?"))
- line)
- (tramp-error proc 'file-notify-error "%s" line))
-
- (let ((object
- (list
- proc
- (mapcar
- (lambda (x)
- (intern-soft
- (replace-regexp-in-string "_" "-" (downcase x))))
- (split-string (match-string 1 line) "," 'omit))
- (match-string 3 line))))
- ;; Remove watch when file or directory to be watched is deleted.
- (when (member (cl-caadr object) '(move-self delete-self ignored))
- (delete-process proc))
- ;; Usually, we would add an Emacs event now. Unfortunately,
- ;; `unread-command-events' does not accept several events at
- ;; once. Therefore, we apply the handler directly.
- (when (member (cl-caadr object) events)
- (tramp-compat-funcall
- 'file-notify-handle-event
- `(file-notify ,object file-notify-callback)))))))
-
-(defun tramp-sh-handle-file-system-info (filename)
- "Like `file-system-info' for Tramp files."
- (ignore-errors
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (when (tramp-get-remote-df v)
- (tramp-message v 5 "file system info: %s" localname)
- (tramp-send-command
- v (format
- "%s %s"
- (tramp-get-remote-df v) (tramp-shell-quote-argument localname)))
- (with-current-buffer (tramp-get-connection-buffer v)
- (goto-char (point-min))
- (forward-line)
- (when (looking-at
- (eval-when-compile
- (concat "\\(?:^/[^[:space:]]*[[:space:]]\\)?"
- "[[:space:]]*\\([[:digit:]]+\\)"
- "[[:space:]]+\\([[:digit:]]+\\)"
- "[[:space:]]+\\([[:digit:]]+\\)")))
- (mapcar
- (lambda (d)
- (* d (tramp-get-connection-property v "df-blocksize" 0)))
- (list (string-to-number (match-string 1))
- ;; The second value is the used size. We need the
- ;; free size.
- (- (string-to-number (match-string 1))
- (string-to-number (match-string 2)))
- (string-to-number (match-string 3))))))))))
-
-;;; Internal Functions:
-
-(defun tramp-maybe-send-script (vec script name)
- "Define in remote shell function NAME implemented as SCRIPT.
-Only send the definition if it has not already been done."
- ;; We cannot let-bind (tramp-get-connection-process vec) because it
- ;; might be nil.
- (let ((scripts (tramp-get-connection-property
- (tramp-get-connection-process vec) "scripts" nil)))
- (unless (member name scripts)
- (with-tramp-progress-reporter
- vec 5 (format-message "Sending script `%s'" name)
- ;; In bash, leading TABs like in `tramp-vc-registered-read-file-names'
- ;; could result in unwanted command expansion. Avoid this.
- (setq script (replace-regexp-in-string
- (make-string 1 ?\t) (make-string 8 ? ) script))
- ;; The script could contain a call of Perl. This is masked with `%s'.
- (when (and (string-match-p "%s" script)
- (not (tramp-get-remote-perl vec)))
- (tramp-error vec 'file-error "No Perl available on remote host"))
- (tramp-barf-unless-okay
- vec
- (format "%s () {\n%s\n}"
- name (format script (tramp-get-remote-perl vec)))
- "Script %s sending failed" name)
- (tramp-set-connection-property
- (tramp-get-connection-process vec) "scripts" (cons name scripts))))))
-
-(defun tramp-run-test (switch filename)
- "Run `test' on the remote system, given a SWITCH and a FILENAME.
-Returns the exit code of the `test' program."
- (with-parsed-tramp-file-name filename nil
- (tramp-send-command-and-check
- v
- (format
- "%s %s %s"
- (tramp-get-test-command v)
- switch
- (tramp-shell-quote-argument localname)))))
-
-(defun tramp-run-test2 (format-string file1 file2)
- "Run `test'-like program on the remote system, given FILE1, FILE2.
-FORMAT-STRING contains the program name, switches, and place holders.
-Returns the exit code of the `test' program. Barfs if the methods,
-hosts, or files, disagree."
- (unless (tramp-equal-remote file1 file2)
- (with-parsed-tramp-file-name (if (tramp-tramp-file-p file1) file1 file2)
nil
- (tramp-error
- v 'file-error
- "tramp-run-test2 only implemented for same method, user, host")))
- (with-parsed-tramp-file-name file1 v1
- (with-parsed-tramp-file-name file1 v2
- (tramp-send-command-and-check
- v1
- (format format-string
- (tramp-shell-quote-argument v1-localname)
- (tramp-shell-quote-argument v2-localname))))))
-
-(defun tramp-find-executable
- (vec progname dirlist &optional ignore-tilde ignore-path)
- "Searches for PROGNAME in $PATH and all directories mentioned in DIRLIST.
-First arg VEC specifies the connection, PROGNAME is the program
-to search for, and DIRLIST gives the list of directories to
-search. If IGNORE-TILDE is non-nil, directory names starting
-with `~' will be ignored. If IGNORE-PATH is non-nil, searches
-only in DIRLIST.
-
-Returns the absolute file name of PROGNAME, if found, and nil otherwise.
-
-This function expects to be in the right *tramp* buffer."
- (with-current-buffer (tramp-get-connection-buffer vec)
- (let (result)
- ;; Check whether the executable is in $PATH. "which(1)" does not
- ;; report always a correct error code; therefore we check the
- ;; number of words it returns. "SunOS 5.10" (and maybe "SunOS
- ;; 5.11") have problems with this command, we disable the call
- ;; therefore.
- (unless (or ignore-path
- (string-match-p
- (eval-when-compile (regexp-opt '("SunOS 5.10" "SunOS 5.11")))
- (tramp-get-connection-property vec "uname" "")))
- (tramp-send-command vec (format "which \\%s | wc -w" progname))
- (goto-char (point-min))
- (if (looking-at-p "^\\s-*1$")
- (setq result (concat "\\" progname))))
- (unless result
- (when ignore-tilde
- ;; Remove all ~/foo directories from dirlist.
- (let (newdl d)
- (while dirlist
- (setq d (car dirlist))
- (setq dirlist (cdr dirlist))
- (unless (char-equal ?~ (aref d 0))
- (setq newdl (cons d newdl))))
- (setq dirlist (nreverse newdl))))
- (tramp-send-command
- vec
- (format (eval-when-compile
- (concat "while read d; "
- "do if test -x $d/%s && test -f $d/%s; "
- "then echo tramp_executable $d/%s; "
- "break; fi; done <<'%s'\n"
- "%s\n%s"))
- progname progname progname
- tramp-end-of-heredoc
- (mapconcat #'identity dirlist "\n")
- tramp-end-of-heredoc))
- (goto-char (point-max))
- (when (search-backward "tramp_executable " nil t)
- (skip-chars-forward "^ ")
- (skip-chars-forward " ")
- (setq result (buffer-substring (point) (point-at-eol)))))
- result)))
-
-;; On hydra.nixos.org, the $PATH environment variable is too long to
-;; send it. This is likely not due to PATH_MAX, but PIPE_BUF. We
-;; check it, and use a temporary file in case of. See Bug#33781.
-(defun tramp-set-remote-path (vec)
- "Sets the remote environment PATH to existing directories.
-I.e., for each directory in `tramp-remote-path', it is tested
-whether it exists and if so, it is added to the environment
-variable PATH."
- (let ((command
- (format "PATH=%s; export PATH"
- (mapconcat #'identity (tramp-get-remote-path vec) ":")))
- (pipe-buf
- (or (with-tramp-connection-property vec "pipe-buf"
- (tramp-send-command-and-read
- vec "getconf PIPE_BUF / 2>/dev/null || echo nil" 'noerror))
- 4096))
- tmpfile)
- (tramp-message vec 5 "Setting $PATH environment variable")
- (if (< (length command) pipe-buf)
- (tramp-send-command vec command)
- ;; Use a temporary file.
- (setq tmpfile
- (tramp-make-tramp-file-name vec (tramp-make-tramp-temp-file vec)))
- (write-region command nil tmpfile)
- (tramp-send-command
- vec (format ". %s" (tramp-compat-file-local-name tmpfile)))
- (delete-file tmpfile))))
-
-;; ------------------------------------------------------------
-;; -- Communication with external shell --
-;; ------------------------------------------------------------
-
-(defun tramp-find-file-exists-command (vec)
- "Find a command on the remote host for checking if a file exists.
-Here, we are looking for a command which has zero exit status if the
-file exists and nonzero exit status otherwise."
- (let ((existing "/")
- (nonexistent
- (tramp-shell-quote-argument "/ this file does not exist "))
- result)
- ;; The algorithm is as follows: we try a list of several commands.
- ;; For each command, we first run `$cmd /' -- this should return
- ;; true, as the root directory always exists. And then we run
- ;; `$cmd /this\ file\ does\ not\ exist ', hoping that the file indeed
- ;; does not exist. This should return false. We use the first
- ;; command we find that seems to work.
- ;; The list of commands to try is as follows:
- ;; `ls -d' This works on most systems, but NetBSD 1.4
- ;; has a bug: `ls' always returns zero exit
- ;; status, even for files which don't exist.
- ;; `test -e' Some Bourne shells have a `test' builtin
- ;; which does not know the `-e' option.
- ;; `/bin/test -e' For those, the `test' binary on disk normally
- ;; provides the option. Alas, the binary
- ;; is sometimes `/bin/test' and sometimes it's
- ;; `/usr/bin/test'.
- ;; `/usr/bin/test -e' In case `/bin/test' does not exist.
- (unless (or
- (ignore-errors
- (and (setq result (format "%s -e" (tramp-get-test-command vec)))
- (tramp-send-command-and-check
- vec (format "%s %s" result existing))
- (not (tramp-send-command-and-check
- vec (format "%s %s" result nonexistent)))))
- (ignore-errors
- (and (setq result "/bin/test -e")
- (tramp-send-command-and-check
- vec (format "%s %s" result existing))
- (not (tramp-send-command-and-check
- vec (format "%s %s" result nonexistent)))))
- (ignore-errors
- (and (setq result "/usr/bin/test -e")
- (tramp-send-command-and-check
- vec (format "%s %s" result existing))
- (not (tramp-send-command-and-check
- vec (format "%s %s" result nonexistent)))))
- (ignore-errors
- (and (setq result (format "%s -d" (tramp-get-ls-command vec)))
- (tramp-send-command-and-check
- vec (format "%s %s" result existing))
- (not (tramp-send-command-and-check
- vec (format "%s %s" result nonexistent))))))
- (tramp-error
- vec 'file-error "Couldn't find command to check if file exists"))
- result))
-
-(defun tramp-open-shell (vec shell)
- "Opens shell SHELL."
- (with-tramp-progress-reporter
- vec 5 (format-message "Opening remote shell `%s'" shell)
- ;; Find arguments for this shell.
- (let ((alist tramp-sh-extra-args)
- item extra-args)
- (while (and alist (null extra-args))
- (setq item (pop alist))
- (when (string-match-p (car item) shell)
- (setq extra-args (cdr item))))
- ;; It is useful to set the prompt in the following command
- ;; because some people have a setting for $PS1 which /bin/sh
- ;; doesn't know about and thus /bin/sh will display a strange
- ;; prompt. For example, if $PS1 has "${CWD}" in the value, then
- ;; ksh will display the current working directory but /bin/sh
- ;; will display a dollar sign. The following command line sets
- ;; $PS1 to a sane value, and works under Bourne-ish shells as
- ;; well as csh-like shells. We also unset the variable $ENV
- ;; because that is read by some sh implementations (eg, bash
- ;; when called as sh) on startup; this way, we avoid the startup
- ;; file clobbering $PS1. $PROMPT_COMMAND is another way to set
- ;; the prompt in /bin/bash, it must be discarded as well.
- ;; $HISTFILE is set according to `tramp-histfile-override'.
- ;; $TERM and $INSIDE_EMACS set here to ensure they have the
- ;; correct values when the shell starts, not just processes
- ;; run within the shell. (Which processes include our
- ;; initial probes to ensure the remote shell is usable.)
- (tramp-send-command
- vec (format
- (eval-when-compile
- (concat
- "exec env TERM='%s' INSIDE_EMACS='%s,tramp:%s' "
- "ENV=%s %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s"))
- tramp-terminal-type
- emacs-version tramp-version ; INSIDE_EMACS
- (or (getenv-internal "ENV" tramp-remote-process-environment) "")
- (if (stringp tramp-histfile-override)
- (format "HISTFILE=%s"
- (tramp-shell-quote-argument tramp-histfile-override))
- (if tramp-histfile-override
- "HISTFILE='' HISTFILESIZE=0 HISTSIZE=0"
- ""))
- (tramp-shell-quote-argument tramp-end-of-output)
- shell (or extra-args ""))
- t)
- ;; Check proper HISTFILE setting. We give up when not working.
- (when (and (stringp tramp-histfile-override)
- (file-name-directory tramp-histfile-override))
- (tramp-barf-unless-okay
- vec
- (format
- "(cd %s)"
- (tramp-shell-quote-argument
- (file-name-directory tramp-histfile-override)))
- "`tramp-histfile-override' uses invalid file `%s'"
- tramp-histfile-override)))
-
- (tramp-set-connection-property
- (tramp-get-connection-process vec) "remote-shell" shell)))
-
-(defun tramp-find-shell (vec)
- "Opens a shell on the remote host which groks tilde expansion."
- (with-current-buffer (tramp-get-buffer vec)
- (let ((default-shell (tramp-get-method-parameter vec 'tramp-remote-shell))
- shell)
- (setq shell
- (with-tramp-connection-property vec "remote-shell"
- ;; CCC: "root" does not exist always, see my QNAP TS-459.
- ;; Which check could we apply instead?
- (tramp-send-command vec "echo ~root" t)
- (if (or (string-match-p "^~root$" (buffer-string))
- ;; The default shell (ksh93) of OpenSolaris and
- ;; Solaris is buggy. We've got reports for
- ;; "SunOS 5.10" and "SunOS 5.11" so far.
- (string-match-p
- (eval-when-compile
- (regexp-opt '("SunOS 5.10" "SunOS 5.11")))
- (tramp-get-connection-property vec "uname" "")))
-
- (or (tramp-find-executable
- vec "bash" (tramp-get-remote-path vec) t t)
- (tramp-find-executable
- vec "ksh" (tramp-get-remote-path vec) t t)
- ;; Maybe it works at least for some other commands.
- (prog1
- default-shell
- (tramp-message
- vec 2
- (eval-when-compile
- (concat
- "Couldn't find a remote shell which groks tilde "
- "expansion, using `%s'"))
- default-shell)))
-
- default-shell)))
-
- ;; Open a new shell if needed.
- (unless (string-equal shell default-shell)
- (tramp-message
- vec 5 "Starting remote shell `%s' for tilde expansion" shell)
- (tramp-open-shell vec shell)))))
-
-;; Utility functions.
-
-(defun tramp-barf-if-no-shell-prompt (proc timeout &rest error-args)
- "Wait for shell prompt and barf if none appears.
-Looks at process PROC to see if a shell prompt appears in TIMEOUT
-seconds. If not, it produces an error message with the given ERROR-ARGS."
- (let ((vec (process-get proc 'vector)))
- (condition-case nil
- (tramp-wait-for-regexp
- proc timeout
- (format
- "\\(%s\\|%s\\)\\'" shell-prompt-pattern tramp-shell-prompt-pattern))
- (error
- (delete-process proc)
- (apply #'tramp-error-with-buffer
- (tramp-get-connection-buffer vec) vec 'file-error error-args)))))
-
-(defun tramp-open-connection-setup-interactive-shell (proc vec)
- "Set up an interactive shell.
-Mainly sets the prompt and the echo correctly. PROC is the shell
-process to set up. VEC specifies the connection."
- (let ((tramp-end-of-output tramp-initial-end-of-output)
- (case-fold-search t))
- (tramp-open-shell vec (tramp-get-method-parameter vec 'tramp-remote-shell))
-
- ;; Disable echo expansion.
- (tramp-message vec 5 "Setting up remote shell environment")
- (tramp-send-command
- vec "stty -inlcr -onlcr -echo kill '^U' erase '^H'" t)
- ;; Check whether the echo has really been disabled. Some
- ;; implementations, like busybox of embedded GNU/Linux, don't
- ;; support disabling.
- (tramp-send-command vec "echo foo" t)
- (with-current-buffer (process-buffer proc)
- (goto-char (point-min))
- (when (looking-at-p "echo foo")
- (tramp-set-connection-property proc "remote-echo" t)
- (tramp-message vec 5 "Remote echo still on. Ok.")
- ;; Make sure backspaces and their echo are enabled and no line
- ;; width magic interferes with them.
- (tramp-send-command vec "stty icanon erase ^H cols 32767" t))))
-
- (tramp-message vec 5 "Setting shell prompt")
- (tramp-send-command
- vec (format "PS1=%s PS2='' PS3='' PROMPT_COMMAND=''"
- (tramp-shell-quote-argument tramp-end-of-output))
- t)
-
- ;; Check whether the output of "uname -sr" has been changed. If
- ;; yes, this is a strong indication that we must expire all
- ;; connection properties. We start again with
- ;; `tramp-maybe-open-connection', it will be caught there.
- (tramp-message vec 5 "Checking system information")
- (let ((old-uname (tramp-get-connection-property vec "uname" nil))
- (uname
- (tramp-set-connection-property
- vec "uname"
- (tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\""))))
- (when (and (stringp old-uname) (not (string-equal old-uname uname)))
- (tramp-message
- vec 3
- "Connection reset, because remote host changed from `%s' to `%s'"
- old-uname uname)
- ;; We want to keep the password.
- (tramp-cleanup-connection vec t t)
- (throw 'uname-changed (tramp-maybe-open-connection vec)))
-
- ;; Try to set up the coding system correctly.
- ;; CCC this can't be the right way to do it. Hm.
- (tramp-message vec 5 "Determining coding system")
- (with-current-buffer (process-buffer proc)
- ;; Use MULE to select the right EOL convention for communicating
- ;; with the process.
- (let ((cs (or (and (memq 'utf-8-hfs (coding-system-list))
- (string-match-p "^Darwin" uname)
- (cons 'utf-8-hfs 'utf-8-hfs))
- (and (memq 'utf-8 (coding-system-list))
- (string-match-p "utf-?8" (tramp-get-remote-locale vec))
- (cons 'utf-8 'utf-8))
- (process-coding-system proc)
- (cons 'undecided 'undecided)))
- cs-decode cs-encode)
- (when (symbolp cs) (setq cs (cons cs cs)))
- (setq cs-decode (or (car cs) 'undecided)
- cs-encode (or (cdr cs) 'undecided)
- cs-encode
- (coding-system-change-eol-conversion
- cs-encode (if (string-match-p "^Darwin" uname) 'mac 'unix)))
- (tramp-send-command vec "(echo foo ; echo bar)" t)
- (goto-char (point-min))
- (when (search-forward "\r" nil t)
- (setq cs-decode (coding-system-change-eol-conversion cs-decode 'dos)))
- (set-process-coding-system proc cs-decode cs-encode)
- (tramp-message
- vec 5 "Setting coding system to `%s' and `%s'" cs-decode cs-encode)))
-
- (tramp-send-command vec "set +o vi +o emacs" t)
-
- ;; Check whether the remote host suffers from buggy
- ;; `send-process-string'. This is known for FreeBSD (see comment
- ;; in `send_process', file process.c). I've tested sending 624
- ;; bytes successfully, sending 625 bytes failed. Emacs makes a
- ;; hack when this host type is detected locally. It cannot handle
- ;; remote hosts, though.
- (with-tramp-connection-property proc "chunksize"
- (cond
- ((and (integerp tramp-chunksize) (> tramp-chunksize 0))
- tramp-chunksize)
- (t
- (tramp-message
- vec 5 "Checking remote host type for `send-process-string' bug")
- (if (string-match-p "^FreeBSD" uname) 500 0))))
-
- ;; Set remote PATH variable.
- (tramp-set-remote-path vec)
-
- ;; Search for a good shell before searching for a command which
- ;; checks if a file exists. This is done because Tramp wants to
- ;; use "test foo; echo $?" to check if various conditions hold,
- ;; and there are buggy /bin/sh implementations which don't execute
- ;; the "echo $?" part if the "test" part has an error. In
- ;; particular, the OpenSolaris /bin/sh is a problem. There are
- ;; also other problems with /bin/sh of OpenSolaris, like
- ;; redirection of stderr in function declarations, or changing
- ;; HISTFILE in place. Therefore, OpenSolaris' /bin/sh is replaced
- ;; by bash, when detected.
- (tramp-find-shell vec)
-
- ;; Disable unexpected output.
- (tramp-send-command vec "mesg n 2>/dev/null; biff n 2>/dev/null" t)
-
- ;; IRIX64 bash expands "!" even when in single quotes. This
- ;; destroys our shell functions, we must disable it. See
- ;;
<http://stackoverflow.com/questions/3291692/irix-bash-shell-expands-expression-in-single-quotes-yet-shouldnt>.
- (when (string-match-p "^IRIX64" uname)
- (tramp-send-command vec "set +H" t))
-
- ;; Disable tab expansion.
- (if (string-match-p "BSD\\|Darwin" uname)
- (tramp-send-command vec "stty tabs" t)
- (tramp-send-command vec "stty tab0" t))
-
- ;; Set utf8 encoding. Needed for macOS, for example. This is
- ;; non-POSIX, so we must expect errors on some systems.
- (tramp-send-command vec "stty iutf8 2>/dev/null" t)
-
- ;; Set `remote-tty' process property.
- (let ((tty (tramp-send-command-and-read vec "echo \\\"`tty`\\\""
'noerror)))
- (unless (zerop (length tty))
- (process-put proc 'remote-tty tty)
- (tramp-set-connection-property proc "remote-tty" tty)))
-
- ;; Dump stty settings in the traces.
- (when (>= tramp-verbose 9)
- (tramp-send-command vec "stty -a" t))
-
- ;; Set the environment.
- (tramp-message vec 5 "Setting default environment")
-
- (let (unset vars)
- (dolist (item (reverse
- (append `(,(tramp-get-remote-locale vec))
- (copy-sequence tramp-remote-process-environment))))
- (setq item (split-string item "=" 'omit))
- (setcdr item (mapconcat #'identity (cdr item) "="))
- (if (and (stringp (cdr item)) (not (string-equal (cdr item) "")))
- (push (format "%s %s" (car item) (cdr item)) vars)
- (push (car item) unset)))
- (when vars
- (tramp-send-command
- vec
- (format
- "while read var val; do export $var=\"$val\"; done <<'%s'\n%s\n%s"
- tramp-end-of-heredoc
- (mapconcat #'identity vars "\n")
- tramp-end-of-heredoc)
- t))
- (when unset
- (tramp-send-command
- vec (format "unset %s" (mapconcat #'identity unset " ")) t)))))
-
-;; Old text from documentation of tramp-methods:
-;; Using a uuencode/uudecode inline method is discouraged, please use one
-;; of the base64 methods instead since base64 encoding is much more
-;; reliable and the commands are more standardized between the different
-;; Unix versions. But if you can't use base64 for some reason, please
-;; note that the default uudecode command does not work well for some
-;; Unices, in particular AIX and Irix. For AIX, you might want to use
-;; the following command for uudecode:
-;;
-;; sed '/^begin/d;/^[` ]$/d;/^end/d' | iconv -f uucode -t ISO8859-1
-;;
-;; For Irix, no solution is known yet.
-
-(autoload 'uudecode-decode-region "uudecode")
-
-(defconst tramp-local-coding-commands
- `((b64 base64-encode-region base64-decode-region)
- (uu tramp-uuencode-region uudecode-decode-region)
- (pack ,(format tramp-perl-pack "perl") ,(format tramp-perl-unpack "perl")))
- "List of local coding commands for inline transfer.
-Each item is a list that looks like this:
-
-\(FORMAT ENCODING DECODING)
-
-FORMAT is a symbol describing the encoding/decoding format. It can be
-`b64' for base64 encoding, `uu' for uu encoding, or `pack' for simple packing.
-
-ENCODING and DECODING can be strings, giving commands, or symbols,
-giving functions. If they are strings, then they can contain
-the \"%s\" format specifier. If that specifier is present, the input
-file name will be put into the command line at that spot. If the
-specifier is not present, the input should be read from standard
-input.
-
-If they are functions, they will be called with two arguments, start
-and end of region, and are expected to replace the region contents
-with the encoded or decoded results, respectively.")
-
-(defconst tramp-remote-coding-commands
- `((b64 "base64" "base64 -d -i")
- ;; "-i" is more robust with older base64 from GNU coreutils.
- ;; However, I don't know whether all base64 versions do supports
- ;; this option.
- (b64 "base64" "base64 -d")
- (b64 "openssl enc -base64" "openssl enc -d -base64")
- (b64 "mimencode -b" "mimencode -u -b")
- (b64 "mmencode -b" "mmencode -u -b")
- (b64 "recode data..base64" "recode base64..data")
- (b64 tramp-perl-encode-with-module tramp-perl-decode-with-module)
- (b64 tramp-perl-encode tramp-perl-decode)
- ;; This is painful slow, so we put it on the end.
- (b64 tramp-awk-encode tramp-awk-decode ,tramp-awk-coding-test)
- (uu "uuencode xxx" "uudecode -o /dev/stdout" "test -c /dev/stdout")
- (uu "uuencode xxx" "uudecode -o -")
- (uu "uuencode xxx" "uudecode -p")
- (uu "uuencode xxx" tramp-uudecode)
- (pack tramp-perl-pack tramp-perl-unpack))
- "List of remote coding commands for inline transfer.
-Each item is a list that looks like this:
-
-\(FORMAT ENCODING DECODING [TEST])
-
-FORMAT is a symbol describing the encoding/decoding format. It can be
-`b64' for base64 encoding, `uu' for uu encoding, or `pack' for simple packing.
-
-ENCODING and DECODING can be strings, giving commands, or symbols,
-giving variables. If they are strings, then they can contain
-the \"%s\" format specifier. If that specifier is present, the input
-file name will be put into the command line at that spot. If the
-specifier is not present, the input should be read from standard
-input.
-
-If they are variables, this variable is a string containing a
-Perl or Shell implementation for this functionality. This
-program will be transferred to the remote host, and it is
-available as shell function with the same name. A \"%t\" format
-specifier in the variable value denotes a temporary file.
-
-The optional TEST command can be used for further tests, whether
-ENCODING and DECODING are applicable.")
-
-(defun tramp-find-inline-encoding (vec)
- "Find an inline transfer encoding that works.
-Goes through the list `tramp-local-coding-commands' and
-`tramp-remote-coding-commands'."
- (save-excursion
- (let ((local-commands tramp-local-coding-commands)
- (magic "xyzzy")
- (p (tramp-get-connection-process vec))
- loc-enc loc-dec rem-enc rem-dec rem-test litem ritem found)
- (while (and local-commands (not found))
- (setq litem (pop local-commands))
- (catch 'wont-work-local
- (let ((format (nth 0 litem))
- (remote-commands tramp-remote-coding-commands))
- (setq loc-enc (nth 1 litem))
- (setq loc-dec (nth 2 litem))
- ;; If the local encoder or decoder is a string, the
- ;; corresponding command has to work locally.
- (if (not (stringp loc-enc))
- (tramp-message
- vec 5 "Checking local encoding function `%s'" loc-enc)
- (tramp-message
- vec 5 "Checking local encoding command `%s' for sanity" loc-enc)
- (unless (zerop (tramp-call-local-coding-command loc-enc nil nil))
- (throw 'wont-work-local nil)))
- (if (not (stringp loc-dec))
- (tramp-message
- vec 5 "Checking local decoding function `%s'" loc-dec)
- (tramp-message
- vec 5 "Checking local decoding command `%s' for sanity" loc-dec)
- (unless (zerop (tramp-call-local-coding-command loc-dec nil nil))
- (throw 'wont-work-local nil)))
- ;; Search for remote coding commands with the same format
- (while (and remote-commands (not found))
- (setq ritem (pop remote-commands))
- (catch 'wont-work-remote
- (when (equal format (nth 0 ritem))
- (setq rem-enc (nth 1 ritem))
- (setq rem-dec (nth 2 ritem))
- (setq rem-test (nth 3 ritem))
- ;; Check the remote test command if exists.
- (when (stringp rem-test)
- (tramp-message
- vec 5 "Checking remote test command `%s'" rem-test)
- (unless (tramp-send-command-and-check vec rem-test t)
- (throw 'wont-work-remote nil)))
- ;; Check if remote perl exists when necessary.
- (when (and (symbolp rem-enc)
- (string-match-p "perl" (symbol-name rem-enc))
- (not (tramp-get-remote-perl vec)))
- (throw 'wont-work-remote nil))
- ;; Check if remote encoding and decoding commands can be
- ;; called remotely with null input and output. This makes
- ;; sure there are no syntax errors and the command is really
- ;; found. Note that we do not redirect stdout to /dev/null,
- ;; for two reasons: when checking the decoding command, we
- ;; actually check the output it gives. And also, when
- ;; redirecting "mimencode" output to /dev/null, then as root
- ;; it might change the permissions of /dev/null!
- (unless (stringp rem-enc)
- (let ((name (symbol-name rem-enc)))
- (while (string-match "-" name)
- (setq name (replace-match "_" nil t name)))
- (tramp-maybe-send-script vec (symbol-value rem-enc) name)
- (setq rem-enc name)))
- (tramp-message
- vec 5
- "Checking remote encoding command `%s' for sanity" rem-enc)
- (unless (tramp-send-command-and-check
- vec (format "%s </dev/null" rem-enc) t)
- (throw 'wont-work-remote nil))
-
- (unless (stringp rem-dec)
- (let ((name (symbol-name rem-dec))
- (value (symbol-value rem-dec))
- tmpfile)
- (while (string-match "-" name)
- (setq name (replace-match "_" nil t name)))
- (when (string-match-p "\\(^\\|[^%]\\)%t" value)
- (setq tmpfile
- (make-temp-name
- (expand-file-name
- tramp-temp-name-prefix
- (tramp-get-remote-tmpdir vec)))
- value
- (format-spec
- value
- (format-spec-make
- ?t (tramp-compat-file-local-name tmpfile)))))
- (tramp-maybe-send-script vec value name)
- (setq rem-dec name)))
- (tramp-message
- vec 5
- "Checking remote decoding command `%s' for sanity" rem-dec)
- (unless (tramp-send-command-and-check
- vec
- (format "echo %s | %s | %s" magic rem-enc rem-dec)
- t)
- (throw 'wont-work-remote nil))
-
- (with-current-buffer (tramp-get-connection-buffer vec)
- (goto-char (point-min))
- (unless (looking-at-p (regexp-quote magic))
- (throw 'wont-work-remote nil)))
-
- ;; `rem-enc' and `rem-dec' could be a string meanwhile.
- (setq rem-enc (nth 1 ritem))
- (setq rem-dec (nth 2 ritem))
- (setq found t)))))))
-
- (when found
- ;; Set connection properties. Since the commands are risky
- ;; (due to output direction), we cache them in the process cache.
- (tramp-message vec 5 "Using local encoding `%s'" loc-enc)
- (tramp-set-connection-property p "local-encoding" loc-enc)
- (tramp-message vec 5 "Using local decoding `%s'" loc-dec)
- (tramp-set-connection-property p "local-decoding" loc-dec)
- (tramp-message vec 5 "Using remote encoding `%s'" rem-enc)
- (tramp-set-connection-property p "remote-encoding" rem-enc)
- (tramp-message vec 5 "Using remote decoding `%s'" rem-dec)
- (tramp-set-connection-property p "remote-decoding" rem-dec)))))
-
-(defun tramp-call-local-coding-command (cmd input output)
- "Call the local encoding or decoding command.
-If CMD contains \"%s\", provide input file INPUT there in command.
-Otherwise, INPUT is passed via standard input.
-INPUT can also be nil which means `/dev/null'.
-OUTPUT can be a string (which specifies a file name), or t (which
-means standard output and thus the current buffer), or nil (which
-means discard it)."
- (tramp-call-process
- nil tramp-encoding-shell
- (when (and input (not (string-match-p "%s" cmd))) input)
- (if (eq output t) t nil)
- nil
- tramp-encoding-command-switch
- (concat
- (if (string-match-p "%s" cmd) (format cmd input) cmd)
- (if (stringp output) (concat " >" output) ""))))
-
-(defconst tramp-inline-compress-commands
- '(;; Suppress warnings about obsolete environment variable GZIP.
- ("env GZIP= gzip" "env GZIP= gzip -d")
- ("bzip2" "bzip2 -d")
- ("xz" "xz -d")
- ("compress" "compress -d"))
- "List of compress and decompress commands for inline transfer.
-Each item is a list that looks like this:
-
-\(COMPRESS DECOMPRESS)
-
-COMPRESS or DECOMPRESS are strings with the respective commands.")
-
-(defun tramp-find-inline-compress (vec)
- "Find an inline transfer compress command that works.
-Goes through the list `tramp-inline-compress-commands'."
- (save-excursion
- (let ((commands tramp-inline-compress-commands)
- (magic "xyzzy")
- (p (tramp-get-connection-process vec))
- item compress decompress found)
- (while (and commands (not found))
- (catch 'next
- (setq item (pop commands)
- compress (nth 0 item)
- decompress (nth 1 item))
- (tramp-message
- vec 5
- "Checking local compress commands `%s', `%s' for sanity"
- compress decompress)
- (unless
- (zerop
- (tramp-call-local-coding-command
- (format
- "echo %s | %s | %s" magic
- ;; Windows shells need the program file name after
- ;; the pipe symbol be quoted if they use forward
- ;; slashes as directory separators.
- (mapconcat
- #'shell-quote-argument (split-string compress) " ")
- (mapconcat
- #'shell-quote-argument (split-string decompress) " "))
- nil nil))
- (throw 'next nil))
- (tramp-message
- vec 5
- "Checking remote compress commands `%s', `%s' for sanity"
- compress decompress)
- (unless (tramp-send-command-and-check
- vec (format "echo %s | %s | %s" magic compress decompress) t)
- (throw 'next nil))
- (setq found t)))
-
- ;; Did we find something?
- (if found
- (progn
- ;; Set connection properties. Since the commands are
- ;; risky (due to output direction), we cache them in the
- ;; process cache.
- (tramp-message
- vec 5 "Using inline transfer compress command `%s'" compress)
- (tramp-set-connection-property p "inline-compress" compress)
- (tramp-message
- vec 5 "Using inline transfer decompress command `%s'" decompress)
- (tramp-set-connection-property p "inline-decompress" decompress))
-
- (tramp-set-connection-property p "inline-compress" nil)
- (tramp-set-connection-property p "inline-decompress" nil)
- (tramp-message
- vec 2 "Couldn't find an inline transfer compress command")))))
-
-(defun tramp-compute-multi-hops (vec)
- "Expands VEC according to `tramp-default-proxies-alist'."
- (let ((saved-tdpa tramp-default-proxies-alist)
- (target-alist `(,vec))
- (hops (or (tramp-file-name-hop vec) ""))
- (item vec)
- choices proxy)
-
- ;; Ad-hoc proxy definitions.
- (dolist (proxy (reverse (split-string hops tramp-postfix-hop-regexp
'omit)))
- (let* ((host-port (tramp-file-name-host-port item))
- (user-domain (tramp-file-name-user-domain item))
- (proxy (concat
- tramp-prefix-format proxy tramp-postfix-host-format))
- (entry
- (list (and (stringp host-port)
- (concat "^" (regexp-quote host-port) "$"))
- (and (stringp user-domain)
- (concat "^" (regexp-quote user-domain) "$"))
- (propertize proxy 'tramp-ad-hoc t))))
- (tramp-message vec 5 "Add %S to `tramp-default-proxies-alist'" entry)
- ;; Add the hop.
- (add-to-list 'tramp-default-proxies-alist entry)
- (setq item (tramp-dissect-file-name proxy))))
- ;; Save the new value.
- (when (and hops tramp-save-ad-hoc-proxies)
- (customize-save-variable
- 'tramp-default-proxies-alist tramp-default-proxies-alist))
-
- ;; Look for proxy hosts to be passed.
- (setq choices tramp-default-proxies-alist)
- (while choices
- (setq item (pop choices)
- proxy (eval (nth 2 item)))
- (when (and
- ;; Host.
- (string-match-p
- (or (eval (nth 0 item)) "")
- (or (tramp-file-name-host-port (car target-alist))
- ""))
- ;; User.
- (string-match-p
- (or (eval (nth 1 item)) "")
- (or (tramp-file-name-user-domain (car target-alist))
- "")))
- (if (null proxy)
- ;; No more hops needed.
- (setq choices nil)
- ;; Replace placeholders.
- (setq proxy
- (format-spec
- proxy
- (format-spec-make
- ?u (or (tramp-file-name-user (car target-alist)) "")
- ?h (or (tramp-file-name-host (car target-alist)) ""))))
- (with-parsed-tramp-file-name proxy l
- ;; Add the hop.
- (push l target-alist)
- ;; Start next search.
- (setq choices tramp-default-proxies-alist)))))
-
- ;; Foreign and out-of-band methods are not supported for multi-hops.
- (when (cdr target-alist)
- (setq choices target-alist)
- (while (setq item (pop choices))
- (when (or (not (tramp-get-method-parameter item 'tramp-login-program))
- (tramp-get-method-parameter item 'tramp-copy-program))
- (setq tramp-default-proxies-alist saved-tdpa)
- (tramp-user-error
- vec "Method `%s' is not supported for multi-hops."
- (tramp-file-name-method item)))))
-
- ;; Some methods ("su", "sg", "sudo", "doas", "ksu") do not use the
- ;; host name in their command template. In this case, the remote
- ;; file name must use either a local host name (first hop), or a
- ;; host name matching the previous hop.
- (let ((previous-host (or tramp-local-host-regexp "")))
- (setq choices target-alist)
- (while (setq item (pop choices))
- (let ((host (tramp-file-name-host item)))
- (unless
- (or
- ;; The host name is used for the remote shell command.
- (member
- '("%h") (tramp-get-method-parameter item 'tramp-login-args))
- ;; The host name must match previous hop.
- (string-match-p previous-host host))
- (setq tramp-default-proxies-alist saved-tdpa)
- (tramp-user-error
- vec "Host name `%s' does not match `%s'" host previous-host))
- (setq previous-host (concat "^" (regexp-quote host) "$")))))
-
- ;; Result.
- target-alist))
-
-(defun tramp-ssh-controlmaster-options (vec)
- "Return the Control* arguments of the local ssh."
- (cond
- ;; No options to be computed.
- ((or (null tramp-use-ssh-controlmaster-options)
- (null (assoc "%c" (tramp-get-method-parameter vec 'tramp-login-args))))
- "")
-
- ;; There is already a value to be used.
- ((stringp tramp-ssh-controlmaster-options) tramp-ssh-controlmaster-options)
-
- ;; Determine the options.
- (t (setq tramp-ssh-controlmaster-options "")
- (let ((case-fold-search t))
- (ignore-errors
- (when (executable-find "ssh")
- (with-tramp-progress-reporter
- vec 4 "Computing ControlMaster options"
- (with-temp-buffer
- (tramp-call-process vec "ssh" nil t nil "-o" "ControlMaster")
- (goto-char (point-min))
- (when (search-forward-regexp "missing.+argument" nil t)
- (setq tramp-ssh-controlmaster-options
- "-o ControlMaster=auto")))
- (unless (zerop (length tramp-ssh-controlmaster-options))
- (with-temp-buffer
- ;; We use a non-existing IP address, in order to
- ;; avoid useless connections, and DNS timeouts.
- ;; Setting ConnectTimeout is needed since OpenSSH 7.
- (tramp-call-process
- vec "ssh" nil t nil
- "-o" "ConnectTimeout=1" "-o" "ControlPath=%C" "0.0.0.1")
- (goto-char (point-min))
- (setq tramp-ssh-controlmaster-options
- (concat tramp-ssh-controlmaster-options
- (if (search-forward-regexp "unknown.+key" nil t)
- " -o ControlPath='address@hidden:%%p'"
- " -o ControlPath='tramp.%%C'"))))
- (with-temp-buffer
- (tramp-call-process vec "ssh" nil t nil "-o" "ControlPersist")
- (goto-char (point-min))
- (when (search-forward-regexp "missing.+argument" nil t)
- (setq tramp-ssh-controlmaster-options
- (concat tramp-ssh-controlmaster-options
- " -o ControlPersist=no")))))))))
- tramp-ssh-controlmaster-options)))
-
-(defun tramp-timeout-session (vec)
- "Close the connection VEC after a session timeout.
-If there is just some editing, retry it after 5 seconds."
- (if (and tramp-locked tramp-locker
- (tramp-file-name-equal-p vec (car tramp-current-connection)))
- (progn
- (tramp-message
- vec 5 "Cannot timeout session, trying it again in %s seconds." 5)
- (run-at-time 5 nil 'tramp-timeout-session vec))
- (tramp-message
- vec 3 "Timeout session %s" (tramp-make-tramp-file-name vec 'localname))
- (tramp-cleanup-connection vec 'keep-debug)))
-
-(defun tramp-maybe-open-connection (vec)
- "Maybe open a connection VEC.
-Does not do anything if a connection is already open, but re-opens the
-connection if a previous connection has died for some reason."
- (let ((p (tramp-get-connection-process vec))
- (process-name (tramp-get-connection-property vec "process-name" nil))
- (pos (with-current-buffer (tramp-get-connection-buffer vec) (point)))
- tmp-process-environment)
-
- ;; If Tramp opens the same connection within a short time frame,
- ;; there is a problem. We shall signal this.
- (unless (or (process-live-p p)
- (not (tramp-file-name-equal-p
- vec (car tramp-current-connection)))
- (time-less-p
- ;; `current-time' can be removed once we get rid of Emacs 24.
- (time-since (or (cdr tramp-current-connection) (current-time)))
- ;; `seconds-to-time' can be removed once we get rid
- ;; of Emacs 24.
- (seconds-to-time (or tramp-connection-min-time-diff 0))))
- (throw 'suppress 'suppress))
-
- ;; If too much time has passed since last command was sent, look
- ;; whether process is still alive. If it isn't, kill it. When
- ;; using ssh, it can sometimes happen that the remote end has hung
- ;; up but the local ssh client doesn't recognize this until it
- ;; tries to send some data to the remote end. So that's why we
- ;; try to send a command from time to time, then look again
- ;; whether the process is really alive.
- (condition-case nil
- ;; `seconds-to-time' can be removed once we get rid of Emacs 24.
- (when (and (time-less-p (seconds-to-time 60)
- (time-since
- (tramp-get-connection-property
- p "last-cmd-time" (seconds-to-time 0))))
- (process-live-p p))
- (tramp-send-command vec "echo are you awake" t t)
- (unless (and (process-live-p p)
- (tramp-wait-for-output p 10))
- ;; The error will be caught locally.
- (tramp-error vec 'file-error "Awake did fail")))
- (file-error
- (tramp-cleanup-connection vec t)
- (setq p nil)))
-
- ;; New connection must be opened.
- (condition-case err
- (unless (process-live-p p)
-
- ;; During completion, don't reopen a new connection. We
- ;; check this for the process related to
- ;; `tramp-buffer-name'; otherwise `start-file-process'
- ;; wouldn't run ever when `non-essential' is non-nil.
- (when (and (tramp-completion-mode-p)
- (null (get-process (tramp-buffer-name vec))))
- (throw 'non-essential 'non-essential))
-
- (with-tramp-progress-reporter
- vec 3
- (if (zerop (length (tramp-file-name-user vec)))
- (format "Opening connection for %s using %s"
- (tramp-file-name-host vec)
- (tramp-file-name-method vec))
- (format "Opening connection for address@hidden using %s"
- (tramp-file-name-user vec)
- (tramp-file-name-host vec)
- (tramp-file-name-method vec)))
-
- (catch 'uname-changed
- ;; Start new process.
- (when (and p (processp p))
- (delete-process p))
- ;; Use a temporary `process-environment', in order not
- ;; to penetrate local processes.
- (let ((process-environment (copy-sequence process-environment)))
- (setenv "TERM" tramp-terminal-type)
- (setenv "LC_ALL" (tramp-get-local-locale vec))
- (if (stringp tramp-histfile-override)
- (setenv "HISTFILE" tramp-histfile-override)
- (if tramp-histfile-override
- (progn
- (setenv "HISTFILE")
- (setenv "HISTFILESIZE" "0")
- (setenv "HISTSIZE" "0"))))
- (setenv "PROMPT_COMMAND")
- (setenv "PS1" tramp-initial-end-of-output)
- (setq tmp-process-environment
- (copy-sequence process-environment)))
- (unless (stringp tramp-encoding-shell)
- (tramp-error vec 'file-error "`tramp-encoding-shell' not set"))
- (let* ((current-host (system-name))
- (target-alist (tramp-compute-multi-hops vec))
- ;; We will apply `tramp-ssh-controlmaster-options'
- ;; only for the first hop.
- (options (tramp-ssh-controlmaster-options vec))
- (process-connection-type tramp-process-connection-type)
- (process-adaptive-read-buffering nil)
- ;; There are unfortunate settings for "cmdproxy" on
- ;; W32 systems.
- (process-coding-system-alist nil)
- (coding-system-for-read nil)
- ;; This must be done in order to avoid our file
- ;; name handler.
- (p (let ((default-directory
- (tramp-compat-temporary-file-directory))
- (process-environment tmp-process-environment))
- (apply
- #'start-process
- (tramp-get-connection-name vec)
- (tramp-get-connection-buffer vec)
- (if tramp-encoding-command-interactive
- (list tramp-encoding-shell
- tramp-encoding-command-interactive)
- (list tramp-encoding-shell))))))
-
- ;; Set sentinel and query flag. Initialize variables.
- (set-process-sentinel p #'tramp-process-sentinel)
- (process-put p 'vector vec)
- (process-put p 'adjust-window-size-function #'ignore)
- (set-process-query-on-exit-flag p nil)
- (setq tramp-current-connection (cons vec (current-time)))
-
- (tramp-message
- vec 6 "%s" (mapconcat #'identity (process-command p) " "))
-
- ;; Check whether process is alive.
- (tramp-barf-if-no-shell-prompt
- p 10
- "Couldn't find local shell prompt for %s" tramp-encoding-shell)
-
- ;; Now do all the connections as specified.
- (while target-alist
- (let* ((hop (car target-alist))
- (l-method (tramp-file-name-method hop))
- (l-user (tramp-file-name-user hop))
- (l-domain (tramp-file-name-domain hop))
- (l-host (tramp-file-name-host hop))
- (l-port (tramp-file-name-port hop))
- (login-program
- (tramp-get-method-parameter hop 'tramp-login-program))
- (login-args
- (tramp-get-method-parameter hop 'tramp-login-args))
- (login-env
- (tramp-get-method-parameter hop 'tramp-login-env))
- (async-args
- (tramp-get-method-parameter hop 'tramp-async-args))
- (connection-timeout
- (tramp-get-method-parameter
- hop 'tramp-connection-timeout))
- (command login-program)
- ;; We don't create the temporary file. In
- ;; fact, it is just a prefix for the
- ;; ControlPath option of ssh; the real
- ;; temporary file has another name, and it is
- ;; created and protected by ssh. It is also
- ;; removed by ssh when the connection is
- ;; closed. The temporary file name is cached
- ;; in the main connection process, therefore
- ;; we cannot use `tramp-get-connection-process'.
- (tmpfile
- (with-tramp-connection-property
- (get-process (tramp-buffer-name vec)) "temp-file"
- (make-temp-name
- (expand-file-name
- tramp-temp-name-prefix
- (tramp-compat-temporary-file-directory)))))
- spec r-shell)
-
- ;; Add arguments for asynchronous processes.
- (when (and process-name async-args)
- (setq login-args (append async-args login-args)))
-
- ;; Check, whether there is a restricted shell.
- (dolist (elt tramp-restricted-shell-hosts-alist)
- (when (string-match-p elt current-host)
- (setq r-shell t)))
- (setq current-host l-host)
-
- ;; Set password prompt vector.
- (tramp-set-connection-property
- p "password-vector"
- (make-tramp-file-name
- :method l-method :user l-user :domain l-domain
- :host l-host :port l-port))
-
- ;; Set session timeout.
- (when (tramp-get-method-parameter
- hop 'tramp-session-timeout)
- (tramp-set-connection-property
- p "session-timeout"
- (tramp-get-method-parameter
- hop 'tramp-session-timeout)))
-
- ;; Add login environment.
- (when login-env
- (setq
- login-env
- (mapcar
- (lambda (x)
- (setq x (mapcar (lambda (y) (format-spec y spec)) x))
- (unless (member "" x) (mapconcat #'identity x " ")))
- login-env))
- (while login-env
- (setq command
- (format
- "%s=%s %s"
- (pop login-env)
- (tramp-shell-quote-argument (pop login-env))
- command)))
- (setq command (concat "env " command)))
-
- ;; Replace `login-args' place holders.
- (setq
- l-host (or l-host "")
- l-user (or l-user "")
- l-port (or l-port "")
- spec (format-spec-make ?t tmpfile)
- options (format-spec options spec)
- spec (format-spec-make
- ?h l-host ?u l-user ?p l-port ?c options)
- command
- (concat
- ;; We do not want to see the trailing local
- ;; prompt in `start-file-process'.
- (unless r-shell "exec ")
- command " "
- (mapconcat
- (lambda (x)
- (setq x (mapcar (lambda (y) (format-spec y spec)) x))
- (unless (member "" x) (mapconcat #'identity x " ")))
- login-args " ")
- ;; Local shell could be a Windows COMSPEC. It
- ;; doesn't know the ";" syntax, but we must exit
- ;; always for `start-file-process'. It could
- ;; also be a restricted shell, which does not
- ;; allow "exec".
- (when r-shell " && exit || exit")))
-
- ;; Send the command.
- (tramp-message vec 3 "Sending command `%s'" command)
- (tramp-send-command vec command t t)
- (tramp-process-actions
- p vec
- (min
- pos (with-current-buffer (process-buffer p) (point-max)))
- tramp-actions-before-shell
- (or connection-timeout tramp-connection-timeout))
- (tramp-message
- vec 3 "Found remote shell prompt on `%s'" l-host))
- ;; Next hop.
- (setq options ""
- target-alist (cdr target-alist)))
-
- ;; Set connection-local variables.
- (tramp-set-connection-local-variables vec)
-
- ;; Activate session timeout.
- (when (tramp-get-connection-property p "session-timeout" nil)
- (run-at-time
- (tramp-get-connection-property p "session-timeout" nil) nil
- 'tramp-timeout-session vec))
-
- ;; Make initial shell settings.
- (tramp-open-connection-setup-interactive-shell p vec)
-
- ;; Mark it as connected.
- (tramp-set-connection-property p "connected" t)))))
-
- ;; Cleanup, and propagate the signal.
- ((error quit)
- (tramp-cleanup-connection vec t)
- (signal (car err) (cdr err))))))
-
-(defun tramp-send-command (vec command &optional neveropen nooutput)
- "Send the COMMAND to connection VEC.
-Erases temporary buffer before sending the command. If optional
-arg NEVEROPEN is non-nil, never try to open the connection. This
-is meant to be used from `tramp-maybe-open-connection' only. The
-function waits for output unless NOOUTPUT is set."
- (unless neveropen (tramp-maybe-open-connection vec))
- (let ((p (tramp-get-connection-process vec)))
- (when (tramp-get-connection-property p "remote-echo" nil)
- ;; We mark the command string that it can be erased in the output buffer.
- (tramp-set-connection-property p "check-remote-echo" t)
- ;; If we put `tramp-echo-mark' after a trailing newline (which
- ;; is assumed to be unquoted) `tramp-send-string' doesn't see
- ;; that newline and adds `tramp-rsh-end-of-line' right after
- ;; `tramp-echo-mark', so the remote shell sees two consecutive
- ;; trailing line endings and sends two prompts after executing
- ;; the command, which confuses `tramp-wait-for-output'.
- (when (and (not (string= command ""))
- (string-equal (substring command -1) "\n"))
- (setq command (substring command 0 -1)))
- ;; No need to restore a trailing newline here since `tramp-send-string'
- ;; makes sure that the string ends in `tramp-rsh-end-of-line', anyway.
- (setq command (format "%s%s%s" tramp-echo-mark command tramp-echo-mark)))
- ;; Send the command.
- (tramp-message vec 6 "%s" command)
- (tramp-send-string vec command)
- (unless nooutput (tramp-wait-for-output p))))
-
-(defun tramp-wait-for-output (proc &optional timeout)
- "Wait for output from remote command."
- (unless (buffer-live-p (process-buffer proc))
- (delete-process proc)
- (tramp-error proc 'file-error "Process `%s' not available, try again"
proc))
- (with-current-buffer (process-buffer proc)
- (let* (;; Initially, `tramp-end-of-output' is "#$ ". There might
- ;; be leading escape sequences, which must be ignored.
- ;; Busyboxes built with the EDITING_ASK_TERMINAL config
- ;; option send also escape sequences, which must be
- ;; ignored.
- (regexp (format "[^#$\n]*%s\\(%s\\)?\r?$"
- (regexp-quote tramp-end-of-output)
- tramp-device-escape-sequence-regexp))
- ;; Sometimes, the commands do not return a newline but a
- ;; null byte before the shell prompt, for example "git
- ;; ls-files -c -z ...".
- (regexp1 (format "\\(^\\|\000\\)%s" regexp))
- (found (tramp-wait-for-regexp proc timeout regexp1)))
- (if found
- (let ((inhibit-read-only t))
- ;; A simple-minded busybox has sent " ^H" sequences.
- ;; Delete them.
- (goto-char (point-min))
- (when (re-search-forward "^\\(.\b\\)+$" (point-at-eol) t)
- (forward-line 1)
- (delete-region (point-min) (point)))
- ;; Delete the prompt.
- (goto-char (point-max))
- (re-search-backward regexp nil t)
- (delete-region (point) (point-max)))
- (if timeout
- (tramp-error
- proc 'file-error
- "[[Remote prompt `%s' not found in %d secs]]"
- tramp-end-of-output timeout)
- (tramp-error
- proc 'file-error
- "[[Remote prompt `%s' not found]]" tramp-end-of-output)))
- ;; Return value is whether end-of-output sentinel was found.
- found)))
-
-(defun tramp-send-command-and-check
- (vec command &optional subshell dont-suppress-err)
- "Run COMMAND and check its exit status.
-Sends `echo $?' along with the COMMAND for checking the exit status.
-If COMMAND is nil, just sends `echo $?'. Returns t if the exit
-status is 0, and nil otherwise.
-
-If the optional argument SUBSHELL is non-nil, the command is
-executed in a subshell, ie surrounded by parentheses. If
-DONT-SUPPRESS-ERR is non-nil, stderr won't be sent to /dev/null."
- (tramp-send-command
- vec
- (concat (if subshell "( " "")
- command
- (if command (if dont-suppress-err "; " " 2>/dev/null; ") "")
- "echo tramp_exit_status $?"
- (if subshell " )" "")))
- (with-current-buffer (tramp-get-connection-buffer vec)
- (goto-char (point-max))
- (unless (re-search-backward "tramp_exit_status [0-9]+" nil t)
- (tramp-error
- vec 'file-error "Couldn't find exit status of `%s'" command))
- (skip-chars-forward "^ ")
- (prog1
- (zerop (read (current-buffer)))
- (let ((inhibit-read-only t))
- (delete-region (match-beginning 0) (point-max))))))
-
-(defun tramp-barf-unless-okay (vec command fmt &rest args)
- "Run COMMAND, check exit status, throw error if exit status not okay.
-Similar to `tramp-send-command-and-check' but accepts two more arguments
-FMT and ARGS which are passed to `error'."
- (or (tramp-send-command-and-check vec command)
- (apply #'tramp-error vec 'file-error fmt args)))
-
-(defun tramp-send-command-and-read (vec command &optional noerror marker)
- "Run COMMAND and return the output, which must be a Lisp expression.
-If MARKER is a regexp, read the output after that string.
-In case there is no valid Lisp expression and NOERROR is nil, it
-raises an error."
- (when (if noerror
- (ignore-errors (tramp-send-command-and-check vec command))
- (tramp-barf-unless-okay
- vec command "`%s' returns with error" command))
- (with-current-buffer (tramp-get-connection-buffer vec)
- (goto-char (point-min))
- ;; Read the marker.
- (when (stringp marker)
- (condition-case nil
- (re-search-forward marker)
- (error (unless noerror
- (tramp-error
- vec 'file-error
- "`%s' does not return the marker `%s': `%s'"
- command marker (buffer-string))))))
- ;; Read the expression.
- (condition-case nil
- (prog1 (read (current-buffer))
- ;; Error handling.
- (when (re-search-forward "\\S-" (point-at-eol) t)
- (error nil)))
- (error (unless noerror
- (tramp-error
- vec 'file-error
- "`%s' does not return a valid Lisp expression: `%s'"
- command (buffer-string))))))))
-
-;; FIXME: Move to tramp.el?
-;;;###tramp-autoload
-(defun tramp-convert-file-attributes (vec attr)
- "Convert `file-attributes' ATTR generated by perl script, stat or ls.
-Convert file mode bits to string and set virtual device number.
-Return ATTR."
- (when attr
- (save-match-data
- ;; Remove color escape sequences from symlink.
- (when (stringp (car attr))
- (while (string-match tramp-display-escape-sequence-regexp (car attr))
- (setcar attr (replace-match "" nil nil (car attr)))))
- ;; Convert uid and gid. Use `tramp-unknown-id-integer' as
- ;; indication of unusable value.
- (when (and (numberp (nth 2 attr)) (< (nth 2 attr) 0))
- (setcar (nthcdr 2 attr) tramp-unknown-id-integer))
- (when (and (floatp (nth 2 attr))
- (<= (nth 2 attr) most-positive-fixnum))
- (setcar (nthcdr 2 attr) (round (nth 2 attr))))
- (when (and (numberp (nth 3 attr)) (< (nth 3 attr) 0))
- (setcar (nthcdr 3 attr) tramp-unknown-id-integer))
- (when (and (floatp (nth 3 attr))
- (<= (nth 3 attr) most-positive-fixnum))
- (setcar (nthcdr 3 attr) (round (nth 3 attr))))
- ;; Convert last access time.
- (unless (listp (nth 4 attr))
- (setcar (nthcdr 4 attr) (seconds-to-time (nth 4 attr))))
- ;; Convert last modification time.
- (unless (listp (nth 5 attr))
- (setcar (nthcdr 5 attr) (seconds-to-time (nth 5 attr))))
- ;; Convert last status change time.
- (unless (listp (nth 6 attr))
- (setcar (nthcdr 6 attr) (seconds-to-time (nth 6 attr))))
- ;; Convert file size.
- (when (< (nth 7 attr) 0)
- (setcar (nthcdr 7 attr) -1))
- (when (and (floatp (nth 7 attr))
- (<= (nth 7 attr) most-positive-fixnum))
- (setcar (nthcdr 7 attr) (round (nth 7 attr))))
- ;; Convert file mode bits to string.
- (unless (stringp (nth 8 attr))
- (setcar (nthcdr 8 attr) (tramp-file-mode-from-int (nth 8 attr)))
- (when (stringp (car attr))
- (aset (nth 8 attr) 0 ?l)))
- ;; Convert directory indication bit.
- (when (string-match-p "^d" (nth 8 attr))
- (setcar attr t))
- ;; Convert symlink from `tramp-do-file-attributes-with-stat'.
- ;; Decode also multibyte string.
- (when (consp (car attr))
- (setcar attr
- (and (stringp (caar attr))
- (string-match ".+ -> .\\(.+\\)." (caar attr))
- (decode-coding-string
- (match-string 1 (caar attr)) 'utf-8))))
- ;; Set file's gid change bit.
- (setcar (nthcdr 9 attr)
- (if (numberp (nth 3 attr))
- (not (= (nth 3 attr)
- (tramp-get-remote-gid vec 'integer)))
- (not (string-equal
- (nth 3 attr)
- (tramp-get-remote-gid vec 'string)))))
- ;; Convert inode.
- (when (floatp (nth 10 attr))
- (setcar (nthcdr 10 attr)
- (condition-case nil
- (let ((high (nth 10 attr))
- middle low)
- (if (<= high most-positive-fixnum)
- (floor high)
- ;; The low 16 bits.
- (setq low (mod high #x10000)
- high (/ high #x10000))
- (if (<= high most-positive-fixnum)
- (cons (floor high) (floor low))
- ;; The middle 24 bits.
- (setq middle (mod high #x1000000)
- high (/ high #x1000000))
- (cons (floor high)
- (cons (floor middle) (floor low))))))
- ;; Inodes can be incredible huge. We must hide this.
- (error (tramp-get-inode vec)))))
- ;; Set virtual device number.
- (setcar (nthcdr 11 attr)
- (tramp-get-device vec)))
- attr))
-
-(defun tramp-shell-case-fold (string)
- "Converts STRING to shell glob pattern which ignores case."
- (mapconcat
- (lambda (c)
- (if (equal (downcase c) (upcase c))
- (vector c)
- (format "[%c%c]" (downcase c) (upcase c))))
- string
- ""))
-
-(defun tramp-make-copy-program-file-name (vec)
- "Create a file name suitable for `scp', `pscp', or `nc' and workalikes."
- (let ((method (tramp-file-name-method vec))
- (user (tramp-file-name-user vec))
- (host (tramp-file-name-host vec))
- (localname
- (directory-file-name (tramp-file-name-unquote-localname vec))))
- (when (string-match-p tramp-ipv6-regexp host)
- (setq host (format "[%s]" host)))
- (unless (string-match-p "ftp$" method)
- (setq localname (tramp-shell-quote-argument localname)))
- (cond
- ((tramp-get-method-parameter vec 'tramp-remote-copy-program)
- localname)
- ((not (zerop (length user)))
- (format "address@hidden:%s" user host (shell-quote-argument localname)))
- (t (format "%s:%s" host (shell-quote-argument localname))))))
-
-(defun tramp-method-out-of-band-p (vec size)
- "Return t if this is an out-of-band method, nil otherwise."
- (and
- ;; It shall be an out-of-band method.
- (tramp-get-method-parameter vec 'tramp-copy-program)
- ;; There must be a size, otherwise the file doesn't exist.
- (numberp size)
- ;; Either the file size is large enough, or (in rare cases) there
- ;; does not exist a remote encoding.
- (or (null tramp-copy-size-limit)
- (> size tramp-copy-size-limit)
- (null (tramp-get-inline-coding vec "remote-encoding" size)))))
-
-;; Variables local to connection.
-
-(defun tramp-get-remote-path (vec)
- "Compile list of remote directories for $PATH.
-Nonexistent directories are removed from spec."
- (with-current-buffer (tramp-get-connection-buffer vec)
- ;; Expand connection-local variables.
- (tramp-set-connection-local-variables vec)
- (with-tramp-connection-property
- ;; When `tramp-own-remote-path' is in `tramp-remote-path', we
- ;; cache the result for the session only. Otherwise, the
- ;; result is cached persistently.
- (if (memq 'tramp-own-remote-path tramp-remote-path)
- (tramp-get-connection-process vec)
- vec)
- "remote-path"
- (let* ((remote-path (copy-tree tramp-remote-path))
- (elt1 (memq 'tramp-default-remote-path remote-path))
- (elt2 (memq 'tramp-own-remote-path remote-path))
- (default-remote-path
- (when elt1
- (or
- (tramp-send-command-and-read
- vec "echo \\\"`getconf PATH 2>/dev/null`\\\"" 'noerror)
- ;; Default if "getconf" is not available.
- (progn
- (tramp-message
- vec 3
- "`getconf PATH' not successful, using default value
\"%s\"."
- "/bin:/usr/bin")
- "/bin:/usr/bin"))))
- (own-remote-path
- ;; The login shell could return more than just the $PATH
- ;; string. So we use `tramp-end-of-heredoc' as marker.
- (when elt2
- (or
- (tramp-send-command-and-read
- vec
- (format
- "%s %s %s 'echo %s \\\"$PATH\\\"'"
- (tramp-get-method-parameter vec 'tramp-remote-shell)
- (mapconcat
- #'identity
- (tramp-get-method-parameter vec 'tramp-remote-shell-login)
- " ")
- (mapconcat
- #'identity
- (tramp-get-method-parameter vec 'tramp-remote-shell-args)
- " ")
- (tramp-shell-quote-argument tramp-end-of-heredoc))
- 'noerror (regexp-quote tramp-end-of-heredoc))
- (progn
- (tramp-message
- vec 2 "Could not retrieve `tramp-own-remote-path'")
- nil)))))
-
- ;; Replace place holder `tramp-default-remote-path'.
- (when elt1
- (setcdr elt1
- (append
- (split-string (or default-remote-path "") ":" 'omit)
- (cdr elt1)))
- (setq remote-path (delq 'tramp-default-remote-path remote-path)))
-
- ;; Replace place holder `tramp-own-remote-path'.
- (when elt2
- (setcdr elt2
- (append
- (split-string (or own-remote-path "") ":" 'omit)
- (cdr elt2)))
- (setq remote-path (delq 'tramp-own-remote-path remote-path)))
-
- ;; Remove double entries.
- (setq elt1 remote-path)
- (while (consp elt1)
- (while (and (car elt1) (setq elt2 (member (car elt1) (cdr elt1))))
- (setcar elt2 nil))
- (setq elt1 (cdr elt1)))
-
- ;; Remove non-existing directories.
- (delq
- nil
- (mapcar
- (lambda (x)
- (and
- (stringp x)
- (file-directory-p (tramp-make-tramp-file-name vec x 'nohop))
- x))
- remote-path))))))
-
-(defun tramp-get-remote-locale (vec)
- "Determine remote locale, supporting UTF8 if possible."
- (with-tramp-connection-property vec "locale"
- (tramp-send-command vec "locale -a")
- (let ((candidates '("en_US.utf8" "C.utf8" "en_US.UTF-8" "C.UTF-8"))
- locale)
- (with-current-buffer (tramp-get-connection-buffer vec)
- (while candidates
- (goto-char (point-min))
- (if (string-match-p (format "^%s\r?$" (regexp-quote (car candidates)))
- (buffer-string))
- (setq locale (car candidates)
- candidates nil)
- (setq candidates (cdr candidates)))))
- ;; Return value.
- (format "LC_ALL=%s" (or locale "C")))))
-
-(defun tramp-get-ls-command (vec)
- "Determine remote `ls' command."
- (with-tramp-connection-property vec "ls"
- (tramp-message vec 5 "Finding a suitable `ls' command")
- (or
- (catch 'ls-found
- (dolist (cmd '("ls" "gnuls" "gls"))
- (let ((dl (tramp-get-remote-path vec))
- result)
- (while (and dl (setq result (tramp-find-executable vec cmd dl t t)))
- ;; Check parameters. On busybox, "ls" output coloring is
- ;; enabled by default sometimes. So we try to disable it
- ;; when possible. $LS_COLORING is not supported there.
- ;; Some "ls" versions are sensitive to the order of
- ;; arguments, they fail when "-al" is after the
- ;; "--color=never" argument (for example on FreeBSD).
- (when (tramp-send-command-and-check
- vec (format "%s -lnd /" result))
- (when (tramp-send-command-and-check
- vec (format
- "%s --color=never -al /dev/null" result))
- (setq result (concat result " --color=never")))
- (throw 'ls-found result))
- (setq dl (cdr dl))))))
- (tramp-error vec 'file-error "Couldn't find a proper `ls' command"))))
-
-(defun tramp-get-ls-command-with (vec option)
- "Return OPTION, if the remote `ls' command supports the OPTION option."
- (with-tramp-connection-property vec (concat "ls" option)
- (tramp-message vec 5 "Checking, whether `ls %s' works" option)
- ;; Some "ls" versions are sensitive to the order of arguments,
- ;; they fail when "-al" is after the "--dired" argument (for
- ;; example on FreeBSD). Busybox does not support this kind of
- ;; options.
- (and
- (not
- (tramp-send-command-and-check
- vec
- (format
- "%s --help 2>&1 | grep -iq busybox" (tramp-get-ls-command vec))))
- (tramp-send-command-and-check
- vec (format "%s %s -al /dev/null" (tramp-get-ls-command vec) option))
- option)))
-
-(defun tramp-get-test-command (vec)
- "Determine remote `test' command."
- (with-tramp-connection-property vec "test"
- (tramp-message vec 5 "Finding a suitable `test' command")
- (if (tramp-send-command-and-check vec "test 0")
- "test"
- (tramp-find-executable vec "test" (tramp-get-remote-path vec)))))
-
-(defun tramp-get-test-nt-command (vec)
- "Check, whether the remote `test' command supports the -nt option."
- ;; Does `test A -nt B' work? Use abominable `find' construct if it
- ;; doesn't. BSD/OS 4.0 wants the parentheses around the command,
- ;; for otherwise the shell crashes.
- (with-tramp-connection-property vec "test-nt"
- (or
- (progn
- (tramp-send-command
- vec (format "( %s / -nt / )" (tramp-get-test-command vec)))
- (with-current-buffer (tramp-get-buffer vec)
- (goto-char (point-min))
- (when (looking-at-p (regexp-quote tramp-end-of-output))
- (format "%s %%s -nt %%s" (tramp-get-test-command vec)))))
- (progn
- (tramp-send-command
- vec
- (format
- "tramp_test_nt () {\n%s -n \"`find $1 -prune -newer $2 -print`\"\n}"
- (tramp-get-test-command vec)))
- "tramp_test_nt %s %s"))))
-
-(defun tramp-get-file-exists-command (vec)
- "Determine remote command for file existing check."
- (with-tramp-connection-property vec "file-exists"
- (tramp-message vec 5 "Finding command to check if file exists")
- (tramp-find-file-exists-command vec)))
-
-(defun tramp-get-remote-ln (vec)
- "Determine remote `ln' command."
- (with-tramp-connection-property vec "ln"
- (tramp-message vec 5 "Finding a suitable `ln' command")
- (tramp-find-executable vec "ln" (tramp-get-remote-path vec))))
-
-(defun tramp-get-remote-perl (vec)
- "Determine remote `perl' command."
- (with-tramp-connection-property vec "perl"
- (tramp-message vec 5 "Finding a suitable `perl' command")
- (let ((result
- (or (tramp-find-executable vec "perl5" (tramp-get-remote-path vec))
- (tramp-find-executable vec "perl" (tramp-get-remote-path vec)))))
- ;; Perform a basic check.
- (and result
- (null (tramp-send-command-and-check
- vec (format "%s -e 'print \"Hello\n\";'" result)))
- (setq result nil))
- ;; We must check also for some Perl modules.
- (when result
- (with-tramp-connection-property vec "perl-file-spec"
- (tramp-send-command-and-check
- vec (format "%s -e 'use File::Spec;'" result)))
- (with-tramp-connection-property vec "perl-cwd-realpath"
- (tramp-send-command-and-check
- vec (format "%s -e 'use Cwd \"realpath\";'" result))))
- result)))
-
-(defun tramp-get-remote-stat (vec)
- "Determine remote `stat' command."
- (with-tramp-connection-property vec "stat"
- (tramp-message vec 5 "Finding a suitable `stat' command")
- (let ((result (tramp-find-executable
- vec "stat" (tramp-get-remote-path vec)))
- tmp)
- ;; Check whether stat(1) returns usable syntax. "%s" does not
- ;; work on older AIX systems. Recent GNU stat versions (8.24?)
- ;; use shell quoted format for "%N", we check the boundaries "`"
- ;; and "'", therefore. See Bug#23422 in coreutils.
- ;; Since GNU stat 8.26, environment variable QUOTING_STYLE is
- ;; supported.
- (when result
- (setq result (concat "env QUOTING_STYLE=locale " result)
- tmp (tramp-send-command-and-read
- vec (format "%s -c '(\"%%N\" %%s)' /" result) 'noerror))
- (unless (and (listp tmp) (stringp (car tmp))
- (string-match-p "^\\(`/'\\|‘/’\\)$" (car tmp))
- (integerp (cadr tmp)))
- (setq result nil)))
- result)))
-
-(defun tramp-get-remote-readlink (vec)
- "Determine remote `readlink' command."
- (with-tramp-connection-property vec "readlink"
- (tramp-message vec 5 "Finding a suitable `readlink' command")
- (let ((result (tramp-find-executable
- vec "readlink" (tramp-get-remote-path vec))))
- (when (and result
- (tramp-send-command-and-check
- vec (format "%s --canonicalize-missing /" result)))
- result))))
-
-(defun tramp-get-remote-trash (vec)
- "Determine remote `trash' command.
-This command is returned only if `delete-by-moving-to-trash' is non-nil."
- (and delete-by-moving-to-trash
- (with-tramp-connection-property vec "trash"
- (tramp-message vec 5 "Finding a suitable `trash' command")
- (tramp-find-executable vec "trash" (tramp-get-remote-path vec)))))
-
-(defun tramp-get-remote-touch (vec)
- "Determine remote `touch' command."
- (with-tramp-connection-property vec "touch"
- (tramp-message vec 5 "Finding a suitable `touch' command")
- (let ((result (tramp-find-executable
- vec "touch" (tramp-get-remote-path vec)))
- (tmpfile
- (make-temp-name
- (expand-file-name
- tramp-temp-name-prefix (tramp-get-remote-tmpdir vec)))))
- ;; Busyboxes do support the "-t" option only when they have been
- ;; built with the DESKTOP config option. Let's check it.
- (when result
- (tramp-set-connection-property
- vec "touch-t"
- (tramp-send-command-and-check
- vec
- (format
- "%s -t %s %s"
- result
- (format-time-string "%Y%m%d%H%M.%S")
- (tramp-compat-file-local-name tmpfile))))
- (delete-file tmpfile))
- result)))
-
-(defun tramp-get-remote-df (vec)
- "Determine remote `df' command."
- (with-tramp-connection-property vec "df"
- (tramp-message vec 5 "Finding a suitable `df' command")
- (let ((df (tramp-find-executable vec "df" (tramp-get-remote-path vec)))
- result)
- (when df
- (cond
- ;; coreutils.
- ((tramp-send-command-and-check
- vec
- (format
- "%s /"
- (setq result
- (format "%s --block-size=1 --output=size,used,avail" df))))
- (tramp-set-connection-property vec "df-blocksize" 1)
- result)
- ;; POSIX.1
- ((tramp-send-command-and-check
- vec (format "%s /" (setq result (format "%s -k" df))))
- (tramp-set-connection-property vec "df-blocksize" 1024)
- result))))))
-
-(defun tramp-get-remote-gio-monitor (vec)
- "Determine remote `gio-monitor' command."
- (with-tramp-connection-property vec "gio-monitor"
- (tramp-message vec 5 "Finding a suitable `gio-monitor' command")
- (tramp-find-executable vec "gio" (tramp-get-remote-path vec) t t)))
-
-(defun tramp-get-remote-gvfs-monitor-dir (vec)
- "Determine remote `gvfs-monitor-dir' command."
- (with-tramp-connection-property vec "gvfs-monitor-dir"
- (tramp-message vec 5 "Finding a suitable `gvfs-monitor-dir' command")
- ;; We distinguish "gvfs-monitor-dir.exe" from cygwin in order to
- ;; establish better timeouts in filenotify-tests.el. Any better
- ;; distinction approach would be welcome!
- (or (tramp-find-executable
- vec "gvfs-monitor-dir.exe" (tramp-get-remote-path vec) t t)
- (tramp-find-executable
- vec "gvfs-monitor-dir" (tramp-get-remote-path vec) t t))))
-
-(defun tramp-get-remote-inotifywait (vec)
- "Determine remote `inotifywait' command."
- (with-tramp-connection-property vec "inotifywait"
- (tramp-message vec 5 "Finding a suitable `inotifywait' command")
- (tramp-find-executable vec "inotifywait" (tramp-get-remote-path vec) t t)))
-
-(defun tramp-get-remote-id (vec)
- "Determine remote `id' command."
- (with-tramp-connection-property vec "id"
- (tramp-message vec 5 "Finding POSIX `id' command")
- (catch 'id-found
- (dolist (cmd '("id" "gid"))
- (let ((dl (tramp-get-remote-path vec))
- result)
- (while (and dl (setq result (tramp-find-executable vec cmd dl t t)))
- ;; Check POSIX parameter.
- (when (tramp-send-command-and-check vec (format "%s -u" result))
- (throw 'id-found result))
- (setq dl (cdr dl))))))))
-
-(defun tramp-get-remote-uid-with-id (vec id-format)
- "Implement `tramp-get-remote-uid' for Tramp files using `id'."
- (tramp-send-command-and-read
- vec
- (format "%s -u%s %s"
- (tramp-get-remote-id vec)
- (if (equal id-format 'integer) "" "n")
- (if (equal id-format 'integer)
- "" "| sed -e s/^/\\\"/ -e s/\\$/\\\"/"))))
-
-(defun tramp-get-remote-uid-with-perl (vec id-format)
- "Implement `tramp-get-remote-uid' for Tramp files using a Perl script."
- (tramp-send-command-and-read
- vec
- (format "%s -le '%s'"
- (tramp-get-remote-perl vec)
- (if (equal id-format 'integer)
- "print $>"
- "print \"\\\"\", scalar getpwuid($>), \"\\\"\""))))
-
-(defun tramp-get-remote-python (vec)
- "Determine remote `python' command."
- (with-tramp-connection-property vec "python"
- (tramp-message vec 5 "Finding a suitable `python' command")
- (or (tramp-find-executable vec "python" (tramp-get-remote-path vec))
- (tramp-find-executable vec "python2" (tramp-get-remote-path vec))
- (tramp-find-executable vec "python3" (tramp-get-remote-path vec)))))
-
-(defun tramp-get-remote-uid-with-python (vec id-format)
- "Implement `tramp-get-remote-uid' for Tramp files using `python'."
- (tramp-send-command-and-read
- vec
- (format "%s -c \"%s\""
- (tramp-get-remote-python vec)
- (if (equal id-format 'integer)
- "import os; print (os.getuid())"
- "import os, pwd; print ('\\\"' + pwd.getpwuid(os.getuid())[0] +
'\\\"')"))))
-
-(defun tramp-get-remote-uid (vec id-format)
- "The uid of the remote connection VEC, in ID-FORMAT.
-ID-FORMAT valid values are `string' and `integer'."
- (with-tramp-connection-property vec (format "uid-%s" id-format)
- (let ((res
- (ignore-errors
- (cond
- ((tramp-get-remote-id vec)
- (tramp-get-remote-uid-with-id vec id-format))
- ((tramp-get-remote-perl vec)
- (tramp-get-remote-uid-with-perl vec id-format))
- ((tramp-get-remote-python vec)
- (tramp-get-remote-uid-with-python vec id-format))))))
- ;; Ensure there is a valid result.
- (cond
- ((and (equal id-format 'integer) (not (integerp res)))
- tramp-unknown-id-integer)
- ((and (equal id-format 'string) (not (stringp res)))
- tramp-unknown-id-string)
- (t res)))))
-
-(defun tramp-get-remote-gid-with-id (vec id-format)
- "Implement `tramp-get-remote-gid' for Tramp files using `id'."
- (tramp-send-command-and-read
- vec
- (format "%s -g%s %s"
- (tramp-get-remote-id vec)
- (if (equal id-format 'integer) "" "n")
- (if (equal id-format 'integer)
- "" "| sed -e s/^/\\\"/ -e s/\\$/\\\"/"))))
-
-(defun tramp-get-remote-gid-with-perl (vec id-format)
- "Implement `tramp-get-remote-gid' for Tramp files using a Perl script."
- (tramp-send-command-and-read
- vec
- (format "%s -le '%s'"
- (tramp-get-remote-perl vec)
- (if (equal id-format 'integer)
- "print ($)=~/(\\d+)/)"
- "print \"\\\"\", scalar getgrgid($)), \"\\\"\""))))
-
-(defun tramp-get-remote-gid-with-python (vec id-format)
- "Implement `tramp-get-remote-gid' for Tramp files using `python'."
- (tramp-send-command-and-read
- vec
- (format "%s -c \"%s\""
- (tramp-get-remote-python vec)
- (if (equal id-format 'integer)
- "import os; print (os.getgid())"
- "import os, grp; print ('\\\"' + grp.getgrgid(os.getgid())[0] +
'\\\"')"))))
-
-(defun tramp-get-remote-gid (vec id-format)
- "The gid of the remote connection VEC, in ID-FORMAT.
-ID-FORMAT valid values are `string' and `integer'."
- (with-tramp-connection-property vec (format "gid-%s" id-format)
- (let ((res
- (ignore-errors
- (cond
- ((tramp-get-remote-id vec)
- (tramp-get-remote-gid-with-id vec id-format))
- ((tramp-get-remote-perl vec)
- (tramp-get-remote-gid-with-perl vec id-format))
- ((tramp-get-remote-python vec)
- (tramp-get-remote-gid-with-python vec id-format))))))
- ;; Ensure there is a valid result.
- (cond
- ((and (equal id-format 'integer) (not (integerp res)))
- tramp-unknown-id-integer)
- ((and (equal id-format 'string) (not (stringp res)))
- tramp-unknown-id-string)
- (t res)))))
-
-(defun tramp-get-env-with-u-option (vec)
- "Check, whether the remote `env' command supports the -u option."
- (with-tramp-connection-property vec "env-u-option"
- (tramp-message vec 5 "Checking, whether `env -u' works")
- ;; Option "-u" is a GNU extension.
- (tramp-send-command-and-check
- vec "env FOO=foo env -u FOO 2>/dev/null | grep -qv FOO" t)))
-
-;; Some predefined connection properties.
-(defun tramp-get-inline-compress (vec prop size)
- "Return the compress command related to PROP.
-PROP is either `inline-compress' or `inline-decompress'. SIZE is
-the length of the file to be compressed.
-
-If no corresponding command is found, nil is returned."
- (when (and (integerp tramp-inline-compress-start-size)
- (> size tramp-inline-compress-start-size))
- (with-tramp-connection-property (tramp-get-connection-process vec) prop
- (tramp-find-inline-compress vec)
- (tramp-get-connection-property
- (tramp-get-connection-process vec) prop nil))))
-
-(defun tramp-get-inline-coding (vec prop size)
- "Return the coding command related to PROP.
-PROP is either `remote-encoding', `remote-decoding',
-`local-encoding' or `local-decoding'.
-
-SIZE is the length of the file to be coded. Depending on SIZE,
-compression might be applied.
-
-If no corresponding command is found, nil is returned.
-Otherwise, either a string is returned which contains a `%s' mark
-to be used for the respective input or output file; or a Lisp
-function cell is returned to be applied on a buffer."
- ;; We must catch the errors, because we want to return nil, when
- ;; no inline coding is found.
- (ignore-errors
- (let ((coding
- (with-tramp-connection-property
- (tramp-get-connection-process vec) prop
- (tramp-find-inline-encoding vec)
- (tramp-get-connection-property
- (tramp-get-connection-process vec) prop nil)))
- (prop1 (if (string-match-p "encoding" prop)
- "inline-compress" "inline-decompress"))
- compress)
- ;; The connection property might have been cached. So we must
- ;; send the script to the remote side - maybe.
- (when (and coding (symbolp coding) (string-match-p "remote" prop))
- (let ((name (symbol-name coding)))
- (while (string-match "-" name)
- (setq name (replace-match "_" nil t name)))
- (tramp-maybe-send-script vec (symbol-value coding) name)
- (setq coding name)))
- (when coding
- ;; Check for the `compress' command.
- (setq compress (tramp-get-inline-compress vec prop1 size))
- ;; Return the value.
- (cond
- ((and compress (symbolp coding))
- (if (string-match-p "decompress" prop1)
- `(lambda (beg end)
- (,coding beg end)
- (let ((coding-system-for-write 'binary)
- (coding-system-for-read 'binary))
- (apply
- #'tramp-call-process-region ',vec (point-min) (point-max)
- (car (split-string ,compress)) t t nil
- (cdr (split-string ,compress)))))
- `(lambda (beg end)
- (let ((coding-system-for-write 'binary)
- (coding-system-for-read 'binary))
- (apply
- #'tramp-call-process-region ',vec beg end
- (car (split-string ,compress)) t t nil
- (cdr (split-string ,compress))))
- (,coding (point-min) (point-max)))))
- ((symbolp coding)
- coding)
- ((and compress (string-match-p "decoding" prop))
- (format
- ;; Windows shells need the program file name after
- ;; the pipe symbol be quoted if they use forward
- ;; slashes as directory separators.
- (cond
- ((and (string-match-p "local" prop)
- (memq system-type '(windows-nt)))
- "(%s | \"%s\")")
- ((string-match-p "local" prop) "(%s | %s)")
- (t "(%s | %s >%%s)"))
- coding compress))
- (compress
- (format
- ;; Windows shells need the program file name after
- ;; the pipe symbol be quoted if they use forward
- ;; slashes as directory separators.
- (if (and (string-match-p "local" prop)
- (memq system-type '(windows-nt)))
- "(%s <%%s | \"%s\")"
- "(%s <%%s | %s)")
- compress coding))
- ((string-match-p "decoding" prop)
- (cond
- ((string-match-p "local" prop) (format "%s" coding))
- (t (format "%s >%%s" coding))))
- (t
- (format "%s <%%s" coding)))))))
-
-(add-hook 'tramp-unload-hook
- (lambda ()
- (unload-feature 'tramp-sh 'force)))
-
-(provide 'tramp-sh)
-
-;;; TODO:
-
-;; * Don't use globbing for directories with many files, as this is
-;; likely to produce long command lines, and some shells choke on
-;; long command lines.
-;;
-;; * Don't search for perl5 and perl. Instead, only search for perl and
-;; then look if it's the right version (with `perl -v').
-;;
-;; * When editing a remote CVS controlled file as a different user, VC
-;; gets confused about the file locking status. Try to find out why
-;; the workaround doesn't work.
-;;
-;; * WIBNI if we had a command "trampclient"? If I was editing in
-;; some shell with root privileges, it would be nice if I could
-;; just call
-;; trampclient filename.c
-;; as an editor, and the _current_ shell would connect to an Emacs
-;; server and would be used in an existing non-privileged Emacs
-;; session for doing the editing in question.
-;; That way, I need not tell Emacs my password again and be afraid
-;; that it makes it into core dumps or other ugly stuff (I had Emacs
-;; once display a just typed password in the context of a keyboard
-;; sequence prompt for a question immediately following in a shell
-;; script run within Emacs -- nasty).
-;; And if I have some ssh session running to a different computer,
-;; having the possibility of passing a local file there to a local
-;; Emacs session (in case I can arrange for a connection back) would
-;; be nice.
-;; Likely the corresponding Tramp server should not allow the
-;; equivalent of the emacsclient -eval option in order to make this
-;; reasonably unproblematic. And maybe trampclient should have some
-;; way of passing credentials, like by using an SSL socket or
-;; something. (David Kastrup)
-;;
-;; * Reconnect directly to a compliant shell without first going
-;; through the user's default shell. (Pete Forman)
-;;
-;; * Avoid the local shell entirely for starting remote processes. If
-;; so, I think even a signal, when delivered directly to the local
-;; SSH instance, would correctly be propagated to the remote process
-;; automatically; possibly SSH would have to be started with
-;; "-t". (Markus Triska)
-;;
-;; * It makes me wonder if tramp couldn't fall back to ssh when scp
-;; isn't on the remote host. (Mark A. Hershberger)
-;;
-;; * Use lsh instead of ssh. (Alfred M. Szmidt)
-;;
-;; * Optimize out-of-band copying when both methods are scp-like (not
-;; rsync).
-;;
-;; * Keep a second connection open for out-of-band methods like scp or
-;; rsync.
-;;
-;; * Implement completion for "/method:address@hidden:~<abc> TAB".
-;;
-;; * I think you could get the best of both worlds by using an
-;; approach similar to Tramp but running a little tramp-daemon on
-;; the other end, such that we can use a more efficient
-;; communication protocol (e.g. when saving a file we could locally
-;; diff it against the last version (of which the remote daemon
-;; would also keep a copy), and then only send the diff).
-;;
-;; This said, even using such a daemon it might be difficult to get
-;; good performance: part of the problem is the number of
-;; round-trips. E.g. when saving a file we have to check if the
-;; file was modified in the mean time and whether saving into a new
-;; inode would change the owner (etc...), which each require a
-;; round-trip. To get rid of these round-trips, we'd have to
-;; shortcut this code and delegate the higher-level "save file"
-;; operation to the remote server, which then has to perform those
-;; tasks but still obeying the locally set customizations about how
-;; to do each one of those tasks.
-;;
-;; We could either put higher-level ops in there (like
-;; `save-buffer'), which implies replicating the whole `save-buffer'
-;; behavior, which is a lot of work and likely to be not 100%
-;; faithful.
-;;
-;; Or we could introduce new low-level ops that are asynchronous,
-;; and then rewrite save-buffer to use them. IOW save-buffer would
-;; start with a bunch of calls like `start-getting-file-attributes'
-;; which could immediately be passed on to the remote side, and
-;; later on checks the return value of those calls as and when
-;; needed. (Stefan Monnier)
-;;
-;; * Implement detaching/re-attaching remote sessions. By this, a
-;; session could be reused after a connection loss. Use dtach, or
-;; screen, or tmux, or mosh.
-;;
-;; * Implement `:stderr' of `make-process' as pipe process.
-
-;;; tramp-sh.el ends here
diff --git a/lisp/tramp-smb.el b/lisp/tramp-smb.el
deleted file mode 100644
index 9d15c05..0000000
--- a/lisp/tramp-smb.el
+++ /dev/null
@@ -1,2112 +0,0 @@
-;;; tramp-smb.el --- Tramp access functions for SMB servers -*-
lexical-binding:t -*-
-
-;; Copyright (C) 2002-2019 Free Software Foundation, Inc.
-
-;; Author: Michael Albinus <address@hidden>
-;; 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 SMB servers like SAMBA or M$ Windows from Tramp.
-
-;;; Code:
-
-(eval-when-compile (require 'cl-lib))
-(require 'tramp)
-
-;; Define SMB method ...
-;;;###tramp-autoload
-(defconst tramp-smb-method "smb"
- "Method to connect SAMBA and M$ SMB servers.")
-
-;; ... and add it to the method list.
-;;;###tramp-autoload
-(unless (memq system-type '(cygwin windows-nt))
- (tramp--with-startup
- (add-to-list 'tramp-methods
- `(,tramp-smb-method
- ;; This is just a guess. We don't know whether the share
"C$"
- ;; is available for public use, and whether the user has
write
- ;; access.
- (tramp-tmpdir "/C$/Temp")
- ;; Another guess. We might implement a better check later
on.
- (tramp-case-insensitive t)))))
-
-;; Add a default for `tramp-default-user-alist'. Rule: For the SMB method,
-;; the anonymous user is chosen.
-;;;###tramp-autoload
-(tramp--with-startup
- (add-to-list 'tramp-default-user-alist
- `(,(concat "\\`" tramp-smb-method "\\'") nil nil))
-
- ;; Add completion function for SMB method.
- (tramp-set-completion-function
- tramp-smb-method
- '((tramp-parse-netrc "~/.netrc"))))
-
-(defcustom tramp-smb-program "smbclient"
- "Name of SMB client to run."
- :group 'tramp
- :type 'string)
-
-(defcustom tramp-smb-acl-program "smbcacls"
- "Name of SMB acls to run."
- :group 'tramp
- :type 'string
- :version "24.4")
-
-(defcustom tramp-smb-conf "/dev/null"
- "Path of the smb.conf file.
-If it is nil, no smb.conf will be added to the `tramp-smb-program'
-call, letting the SMB client use the default one."
- :group 'tramp
- :type '(choice (const nil) (file :must-match t)))
-
-(defvar tramp-smb-version nil
- "Version string of the SMB client.")
-
-(defconst tramp-smb-server-version
- "Domain=\\[[^]]*\\] OS=\\[[^]]*\\] Server=\\[[^]]*\\]"
- "Regexp of SMB server identification.")
-
-(defconst tramp-smb-prompt "^\\(smb:\\|PS\\) .+> \\|^\\s-+Server\\s-+Comment$"
- "Regexp used as prompt in smbclient or powershell.")
-
-(defconst tramp-smb-wrong-passwd-regexp
- (regexp-opt
- '("NT_STATUS_LOGON_FAILURE"
- "NT_STATUS_WRONG_PASSWORD"))
- "Regexp for login error strings of SMB servers.")
-
-(defconst tramp-smb-errors
- (mapconcat
- #'identity
- `(;; Connection error / timeout / unknown command.
- "Connection\\( to \\S-+\\)? failed"
- "Read from server failed, maybe it closed the connection"
- "Call timed out: server did not respond"
- "\\S-+: command not found"
- "Server doesn't support UNIX CIFS calls"
- ,(regexp-opt
- '(;; Samba.
- "ERRDOS"
- "ERRHRD"
- "ERRSRV"
- "ERRbadfile"
- "ERRbadpw"
- "ERRfilexists"
- "ERRnoaccess"
- "ERRnomem"
- "ERRnosuchshare"
- ;; See /usr/include/samba-4.0/core/ntstatus.h.
- ;; Windows 4.0 (Windows NT), Windows 5.0 (Windows 2000),
- ;; Windows 5.1 (Windows XP), Windows 5.2 (Windows Server 2003),
- ;; Windows 6.0 (Windows Vista), Windows 6.1 (Windows 7),
- ;; Windows 6.3 (Windows Server 2012, Windows 10).
- "NT_STATUS_ACCESS_DENIED"
- "NT_STATUS_ACCOUNT_LOCKED_OUT"
- "NT_STATUS_BAD_NETWORK_NAME"
- "NT_STATUS_CANNOT_DELETE"
- "NT_STATUS_CONNECTION_DISCONNECTED"
- "NT_STATUS_CONNECTION_REFUSED"
- "NT_STATUS_CONNECTION_RESET"
- "NT_STATUS_DIRECTORY_NOT_EMPTY"
- "NT_STATUS_DUPLICATE_NAME"
- "NT_STATUS_FILE_IS_A_DIRECTORY"
- "NT_STATUS_HOST_UNREACHABLE"
- "NT_STATUS_IMAGE_ALREADY_LOADED"
- "NT_STATUS_INVALID_LEVEL"
- "NT_STATUS_INVALID_PARAMETER_MIX"
- "NT_STATUS_IO_TIMEOUT"
- "NT_STATUS_LOGON_FAILURE"
- "NT_STATUS_NETWORK_ACCESS_DENIED"
- "NT_STATUS_NOT_IMPLEMENTED"
- "NT_STATUS_NO_LOGON_SERVERS"
- "NT_STATUS_NO_SUCH_FILE"
- "NT_STATUS_NO_SUCH_USER"
- "NT_STATUS_NOT_A_DIRECTORY"
- "NT_STATUS_OBJECT_NAME_COLLISION"
- "NT_STATUS_OBJECT_NAME_INVALID"
- "NT_STATUS_OBJECT_NAME_NOT_FOUND"
- "NT_STATUS_OBJECT_PATH_SYNTAX_BAD"
- "NT_STATUS_PASSWORD_MUST_CHANGE"
- "NT_STATUS_RESOURCE_NAME_NOT_FOUND"
- "NT_STATUS_REVISION_MISMATCH"
- "NT_STATUS_SHARING_VIOLATION"
- "NT_STATUS_TRUSTED_RELATIONSHIP_FAILURE"
- "NT_STATUS_UNSUCCESSFUL"
- "NT_STATUS_WRONG_PASSWORD")))
- "\\|")
- "Regexp for possible error strings of SMB servers.
-Used instead of analyzing error codes of commands.")
-
-(defconst tramp-smb-actions-with-share
- '((tramp-smb-prompt tramp-action-succeed)
- (tramp-password-prompt-regexp tramp-action-password)
- (tramp-wrong-passwd-regexp tramp-action-permission-denied)
- (tramp-smb-errors tramp-action-permission-denied)
- (tramp-process-alive-regexp tramp-action-process-alive))
- "List of pattern/action pairs.
-This list is used for login to SMB servers.
-
-See `tramp-actions-before-shell' for more info.")
-
-(defconst tramp-smb-actions-without-share
- '((tramp-password-prompt-regexp tramp-action-password)
- (tramp-wrong-passwd-regexp tramp-action-permission-denied)
- (tramp-smb-errors tramp-action-permission-denied)
- (tramp-process-alive-regexp tramp-action-out-of-band))
- "List of pattern/action pairs.
-This list is used for login to SMB servers.
-
-See `tramp-actions-before-shell' for more info.")
-
-(defconst tramp-smb-actions-with-tar
- '((tramp-password-prompt-regexp tramp-action-password)
- (tramp-wrong-passwd-regexp tramp-action-permission-denied)
- (tramp-smb-errors tramp-action-permission-denied)
- (tramp-process-alive-regexp tramp-smb-action-with-tar))
- "List of pattern/action pairs.
-This list is used for tar-like copy of directories.
-
-See `tramp-actions-before-shell' for more info.")
-
-(defconst tramp-smb-actions-get-acl
- '((tramp-password-prompt-regexp tramp-action-password)
- (tramp-wrong-passwd-regexp tramp-action-permission-denied)
- (tramp-smb-errors tramp-action-permission-denied)
- (tramp-process-alive-regexp tramp-smb-action-get-acl))
- "List of pattern/action pairs.
-This list is used for smbcacls actions.
-
-See `tramp-actions-before-shell' for more info.")
-
-(defconst tramp-smb-actions-set-acl
- '((tramp-password-prompt-regexp tramp-action-password)
- (tramp-wrong-passwd-regexp tramp-action-permission-denied)
- (tramp-smb-errors tramp-action-permission-denied)
- (tramp-process-alive-regexp tramp-smb-action-set-acl))
- "List of pattern/action pairs.
-This list is used for smbcacls actions.
-
-See `tramp-actions-before-shell' for more info.")
-
-;; New handlers should be added here.
-;;;###tramp-autoload
-(defconst tramp-smb-file-name-handler-alist
- '((access-file . tramp-handle-access-file)
- (add-name-to-file . tramp-smb-handle-add-name-to-file)
- ;; `byte-compiler-base-file-name' performed by default handler.
- (copy-directory . tramp-smb-handle-copy-directory)
- (copy-file . tramp-smb-handle-copy-file)
- (delete-directory . tramp-smb-handle-delete-directory)
- (delete-file . tramp-smb-handle-delete-file)
- ;; `diff-latest-backup-file' performed by default handler.
- (directory-file-name . tramp-handle-directory-file-name)
- (directory-files . tramp-smb-handle-directory-files)
- (directory-files-and-attributes
- . tramp-handle-directory-files-and-attributes)
- (dired-compress-file . ignore)
- (dired-uncache . tramp-handle-dired-uncache)
- (exec-path . ignore)
- (expand-file-name . tramp-smb-handle-expand-file-name)
- (file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
- (file-acl . tramp-smb-handle-file-acl)
- (file-attributes . tramp-smb-handle-file-attributes)
- (file-directory-p . tramp-handle-file-directory-p)
- (file-file-equal-p . tramp-handle-file-equal-p)
- (file-executable-p . tramp-handle-file-exists-p)
- (file-exists-p . tramp-handle-file-exists-p)
- (file-in-directory-p . tramp-handle-file-in-directory-p)
- (file-local-copy . tramp-smb-handle-file-local-copy)
- (file-modes . tramp-handle-file-modes)
- (file-name-all-completions . tramp-smb-handle-file-name-all-completions)
- (file-name-as-directory . tramp-handle-file-name-as-directory)
- (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p)
- (file-name-completion . tramp-handle-file-name-completion)
- (file-name-directory . tramp-handle-file-name-directory)
- (file-name-nondirectory . tramp-handle-file-name-nondirectory)
- ;; `file-name-sans-versions' performed by default handler.
- (file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
- (file-notify-add-watch . tramp-handle-file-notify-add-watch)
- (file-notify-rm-watch . tramp-handle-file-notify-rm-watch)
- (file-notify-valid-p . tramp-handle-file-notify-valid-p)
- (file-ownership-preserved-p . ignore)
- (file-readable-p . tramp-handle-file-exists-p)
- (file-regular-p . tramp-handle-file-regular-p)
- (file-remote-p . tramp-handle-file-remote-p)
- (file-selinux-context . tramp-handle-file-selinux-context)
- (file-symlink-p . tramp-handle-file-symlink-p)
- (file-system-info . tramp-smb-handle-file-system-info)
- (file-truename . tramp-handle-file-truename)
- (file-writable-p . tramp-smb-handle-file-writable-p)
- (find-backup-file-name . tramp-handle-find-backup-file-name)
- ;; `get-file-buffer' performed by default handler.
- (insert-directory . tramp-smb-handle-insert-directory)
- (insert-file-contents . tramp-handle-insert-file-contents)
- (load . tramp-handle-load)
- (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
- (make-directory . tramp-smb-handle-make-directory)
- (make-directory-internal . tramp-smb-handle-make-directory-internal)
- (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
- (make-process . ignore)
- (make-symbolic-link . tramp-smb-handle-make-symbolic-link)
- (process-file . tramp-smb-handle-process-file)
- (rename-file . tramp-smb-handle-rename-file)
- (set-file-acl . tramp-smb-handle-set-file-acl)
- (set-file-modes . tramp-smb-handle-set-file-modes)
- (set-file-selinux-context . ignore)
- (set-file-times . ignore)
- (set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
- (shell-command . tramp-handle-shell-command)
- (start-file-process . tramp-smb-handle-start-file-process)
- (substitute-in-file-name . tramp-smb-handle-substitute-in-file-name)
- (temporary-file-directory . tramp-handle-temporary-file-directory)
- (tramp-set-file-uid-gid . ignore)
- (unhandled-file-name-directory . ignore)
- (vc-registered . ignore)
- (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
- (write-region . tramp-smb-handle-write-region))
- "Alist of handler functions for Tramp SMB method.
-Operations not mentioned here will be handled by the default Emacs
primitives.")
-
-;; Options for remote processes via winexe.
-(defcustom tramp-smb-winexe-program "winexe"
- "Name of winexe client to run.
-If it isn't found in the local $PATH, the absolute path of winexe
-shall be given. This is needed for remote processes."
- :group 'tramp
- :type 'string
- :version "24.3")
-
-(defcustom tramp-smb-winexe-shell-command "powershell.exe"
- "Shell to be used for processes on remote machines.
-This must be Powershell V2 compatible."
- :group 'tramp
- :type 'string
- :version "24.3")
-
-(defcustom tramp-smb-winexe-shell-command-switch "-file -"
- "Command switch used together with `tramp-smb-winexe-shell-command'.
-This can be used to disable echo etc."
- :group 'tramp
- :type 'string
- :version "24.3")
-
-;; It must be a `defsubst' in order to push the whole code into
-;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
-;;;###tramp-autoload
-(defsubst tramp-smb-file-name-p (filename)
- "Check if it's a filename for SMB servers."
- (and (tramp-tramp-file-p filename)
- (string= (tramp-file-name-method (tramp-dissect-file-name filename))
- tramp-smb-method)))
-
-;;;###tramp-autoload
-(defun tramp-smb-file-name-handler (operation &rest args)
- "Invoke the SMB related OPERATION.
-First arg specifies the OPERATION, second arg is a list of arguments to
-pass to the OPERATION."
- (let ((fn (assoc operation tramp-smb-file-name-handler-alist)))
- (if fn
- (save-match-data (apply (cdr fn) args))
- (tramp-run-real-handler operation args))))
-
-;;;###tramp-autoload
-(unless (memq system-type '(cygwin windows-nt))
- (tramp--with-startup
- (tramp-register-foreign-file-name-handler
- #'tramp-smb-file-name-p #'tramp-smb-file-name-handler)))
-
-;; File name primitives.
-
-(defun tramp-smb-handle-add-name-to-file
- (filename newname &optional ok-if-already-exists)
- "Like `add-name-to-file' for Tramp files."
- (unless (tramp-equal-remote filename newname)
- (with-parsed-tramp-file-name
- (if (tramp-tramp-file-p filename) filename newname) nil
- (tramp-error
- v 'file-error
- "add-name-to-file: %s"
- "only implemented for same method, same user, same host")))
- (with-parsed-tramp-file-name filename v1
- (with-parsed-tramp-file-name newname v2
- (when (file-directory-p filename)
- (tramp-error
- v2 'file-error
- "add-name-to-file: %s must not be a directory" filename))
- ;; Do the 'confirm if exists' thing.
- (when (file-exists-p newname)
- ;; What to do?
- (if (or (null ok-if-already-exists) ; not allowed to exist
- (and (numberp ok-if-already-exists)
- (not (yes-or-no-p
- (format
- "File %s already exists; make it a link anyway? "
- v2-localname)))))
- (tramp-error v2 'file-already-exists newname)
- (delete-file newname)))
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-properties v2 (file-name-directory v2-localname))
- (tramp-flush-file-properties v2 v2-localname)
- (unless
- (tramp-smb-send-command
- v1
- (format
- "%s \"%s\" \"%s\""
- (if (tramp-smb-get-cifs-capabilities v1) "link" "hardlink")
- (tramp-smb-get-localname v1)
- (tramp-smb-get-localname v2)))
- (tramp-error
- v2 'file-error
- "error with add-name-to-file, see buffer `%s' for details"
- (buffer-name))))))
-
-(defun tramp-smb-action-with-tar (proc vec)
- "Untar from connection buffer."
- (if (not (process-live-p proc))
- (throw 'tramp-action 'process-died)
-
- (with-current-buffer (tramp-get-connection-buffer vec)
- (goto-char (point-min))
- (when (search-forward-regexp tramp-smb-server-version nil t)
- ;; There might be a hidden password prompt.
- (widen)
- (forward-line)
- (tramp-message vec 6 (buffer-substring (point-min) (point)))
- (delete-region (point-min) (point))
- (throw 'tramp-action 'ok)))))
-
-(defun tramp-smb-handle-copy-directory
- (dirname newname &optional keep-date parents copy-contents)
- "Like `copy-directory' for Tramp files."
- (if copy-contents
- ;; We must do it file-wise.
- (tramp-run-real-handler
- #'copy-directory (list dirname newname keep-date parents copy-contents))
-
- (setq dirname (expand-file-name dirname)
- newname (expand-file-name newname))
- (let ((t1 (tramp-tramp-file-p dirname))
- (t2 (tramp-tramp-file-p newname)))
- (with-parsed-tramp-file-name (if t1 dirname newname) nil
- (with-tramp-progress-reporter
- v 0 (format "Copying %s to %s" dirname newname)
- (when (and (file-directory-p newname)
- (not (tramp-compat-directory-name-p newname)))
- (tramp-error v 'file-already-exists newname))
- (cond
- ;; We must use a local temporary directory.
- ((and t1 t2)
- (let ((tmpdir
- (make-temp-name
- (expand-file-name
- tramp-temp-name-prefix
- (tramp-compat-temporary-file-directory)))))
- (unwind-protect
- (progn
- (make-directory tmpdir)
- (copy-directory
- dirname (file-name-as-directory tmpdir) keep-date 'parents)
- (copy-directory
- (expand-file-name (file-name-nondirectory dirname) tmpdir)
- newname keep-date parents))
- (delete-directory tmpdir 'recursive))))
-
- ;; We can copy recursively.
- ;; TODO: Does not work reliably.
- (nil ;(and (or t1 t2) (tramp-smb-get-cifs-capabilities v))
- (when (and (file-directory-p newname)
- (not (string-equal (file-name-nondirectory dirname)
- (file-name-nondirectory newname))))
- (setq newname
- (expand-file-name
- (file-name-nondirectory dirname) newname))
- (if t2 (setq v (tramp-dissect-file-name newname))))
- (if (not (file-directory-p newname))
- (make-directory newname parents))
-
- (let* ((share (tramp-smb-get-share v))
- (localname (file-name-as-directory
- (replace-regexp-in-string
- "\\\\" "/" (tramp-smb-get-localname v))))
- (tmpdir (make-temp-name
- (expand-file-name
- tramp-temp-name-prefix
- (tramp-compat-temporary-file-directory))))
- (args (list (concat "//" host "/" share) "-E")))
-
- (if (not (zerop (length user)))
- (setq args (append args (list "-U" user)))
- (setq args (append args (list "-N"))))
-
- (when domain (setq args (append args (list "-W" domain))))
- (when port (setq args (append args (list "-p" port))))
- (when tramp-smb-conf
- (setq args (append args (list "-s" tramp-smb-conf))))
- (setq args
- (if t1
- ;; Source is remote.
- (append args
- (list "-D" (tramp-unquote-shell-quote-argument
- localname)
- "-c" (shell-quote-argument "tar qc - *")
- "|" "tar" "xfC" "-"
- (tramp-unquote-shell-quote-argument
- tmpdir)))
- ;; Target is remote.
- (append (list "tar" "cfC" "-"
- (tramp-unquote-shell-quote-argument dirname)
- "." "|")
- args
- (list "-D" (tramp-unquote-shell-quote-argument
- localname)
- "-c" (shell-quote-argument "tar qx -")))))
-
- (unwind-protect
- (with-temp-buffer
- ;; Set the transfer process properties.
- (tramp-set-connection-property
- v "process-name" (buffer-name (current-buffer)))
- (tramp-set-connection-property
- v "process-buffer" (current-buffer))
-
- (when t1
- ;; The smbclient tar command creates always
- ;; complete paths. We must emulate the
- ;; directory structure, and symlink to the real
- ;; target.
- (make-directory
- (expand-file-name
- ".." (concat tmpdir localname))
- 'parents)
- (make-symbolic-link
- newname (directory-file-name (concat tmpdir localname))))
-
- ;; Use an asynchronous processes. By this,
- ;; password can be handled.
- (let* ((default-directory tmpdir)
- (p (apply
- #'start-process
- (tramp-get-connection-name v)
- (tramp-get-connection-buffer v)
- tramp-smb-program args)))
-
- (tramp-message
- v 6 "%s" (mapconcat #'identity (process-command p) " "))
- (process-put p 'vector v)
- (process-put p 'adjust-window-size-function #'ignore)
- (set-process-query-on-exit-flag p nil)
- (tramp-process-actions p v nil tramp-smb-actions-with-tar)
-
- (while (process-live-p p)
- (sit-for 0.1))
- (tramp-message v 6 "\n%s" (buffer-string))))
-
- ;; Reset the transfer process properties.
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer")
- (when t1 (delete-directory tmpdir 'recursive))))
-
- ;; Handle KEEP-DATE argument.
- (when keep-date
- (set-file-times
- newname
- (tramp-compat-file-attribute-modification-time
- (file-attributes dirname))))
-
- ;; Set the mode.
- (unless keep-date
- (set-file-modes newname (tramp-default-file-modes dirname)))
-
- ;; When newname did exist, we have wrong cached values.
- (when t2
- (with-parsed-tramp-file-name newname nil
- (tramp-flush-file-properties v (file-name-directory localname))
- (tramp-flush-file-properties v localname))))
-
- ;; We must do it file-wise.
- (t
- (tramp-run-real-handler
- #'copy-directory (list dirname newname keep-date parents)))))))))
-
-(defun tramp-smb-handle-copy-file
- (filename newname &optional ok-if-already-exists keep-date
- _preserve-uid-gid _preserve-extended-attributes)
- "Like `copy-file' for Tramp files.
-KEEP-DATE has no effect in case NEWNAME resides on an SMB server.
-PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
- (setq filename (expand-file-name filename)
- newname (expand-file-name newname))
- (with-tramp-progress-reporter
- (tramp-dissect-file-name
- (if (tramp-tramp-file-p filename) filename newname))
- 0 (format "Copying %s to %s" filename newname)
-
- (if (file-directory-p filename)
- (copy-directory filename newname keep-date 'parents 'copy-contents)
-
- (let ((tmpfile (file-local-copy filename)))
- (if tmpfile
- ;; Remote filename.
- (condition-case err
- (rename-file tmpfile newname ok-if-already-exists)
- ((error quit)
- (delete-file tmpfile)
- (signal (car err) (cdr err))))
-
- ;; Remote newname.
- (when (and (file-directory-p newname)
- (tramp-compat-directory-name-p newname))
- (setq newname
- (expand-file-name (file-name-nondirectory filename) newname)))
-
- (with-parsed-tramp-file-name newname nil
- (when (and (not ok-if-already-exists)
- (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
-
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-properties v (file-name-directory localname))
- (tramp-flush-file-properties v localname)
- (unless (tramp-smb-get-share v)
- (tramp-error
- v 'file-error "Target `%s' must contain a share name" newname))
- (unless (tramp-smb-send-command
- v (format "put \"%s\" \"%s\""
- (tramp-compat-file-name-unquote filename)
- (tramp-smb-get-localname v)))
- (tramp-error
- v 'file-error "Cannot copy `%s' to `%s'" filename newname))))))
-
- ;; KEEP-DATE handling.
- (when keep-date
- (set-file-times
- newname
- (tramp-compat-file-attribute-modification-time
- (file-attributes filename))))))
-
-(defun tramp-smb-handle-delete-directory (directory &optional recursive _trash)
- "Like `delete-directory' for Tramp files."
- (setq directory (directory-file-name (expand-file-name directory)))
- (when (file-exists-p directory)
- (when recursive
- (mapc
- (lambda (file)
- (if (file-directory-p file)
- (delete-directory file recursive)
- (delete-file file)))
- ;; We do not want to delete "." and "..".
- (directory-files directory 'full directory-files-no-dot-files-regexp)))
-
- (with-parsed-tramp-file-name directory nil
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-properties v (file-name-directory localname))
- (tramp-flush-directory-properties v localname)
- (unless (tramp-smb-send-command
- v (format
- "%s \"%s\""
- (if (tramp-smb-get-cifs-capabilities v) "posix_rmdir" "rmdir")
- (tramp-smb-get-localname v)))
- ;; Error.
- (with-current-buffer (tramp-get-connection-buffer v)
- (goto-char (point-min))
- (search-forward-regexp tramp-smb-errors nil t)
- (tramp-error
- v 'file-error "%s `%s'" (match-string 0) directory)))
-
- ;; "rmdir" does not report an error. So we check ourselves.
- (when (file-exists-p directory)
- (tramp-error
- v 'file-error "`%s' not removed." directory)))))
-
-(defun tramp-smb-handle-delete-file (filename &optional _trash)
- "Like `delete-file' for Tramp files."
- (setq filename (expand-file-name filename))
- (when (file-exists-p filename)
- (with-parsed-tramp-file-name filename nil
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-properties v (file-name-directory localname))
- (tramp-flush-file-properties v localname)
- (unless (tramp-smb-send-command
- v (format
- "%s \"%s\""
- (if (tramp-smb-get-cifs-capabilities v) "posix_unlink" "rm")
- (tramp-smb-get-localname v)))
- ;; Error.
- (with-current-buffer (tramp-get-connection-buffer v)
- (goto-char (point-min))
- (search-forward-regexp tramp-smb-errors nil t)
- (tramp-error
- v 'file-error "%s `%s'" (match-string 0) filename))))))
-
-(defun tramp-smb-handle-directory-files
- (directory &optional full match nosort)
- "Like `directory-files' for Tramp files."
- (let ((result (mapcar #'directory-file-name
- (file-name-all-completions "" directory))))
- ;; Discriminate with regexp.
- (when match
- (setq result
- (delete nil
- (mapcar (lambda (x) (when (string-match-p match x) x))
- result))))
- ;; Append directory.
- (when full
- (setq result
- (mapcar
- (lambda (x) (format "%s/%s" directory x))
- result)))
- ;; Sort them if necessary.
- (unless nosort (setq result (sort result #'string-lessp)))
- result))
-
-(defun tramp-smb-handle-expand-file-name (name &optional dir)
- "Like `expand-file-name' for Tramp files."
- ;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
- (setq dir (or dir default-directory "/"))
- ;; Handle empty NAME.
- (when (zerop (length name)) (setq name "."))
- ;; Unless NAME is absolute, concat DIR and NAME.
- (unless (file-name-absolute-p name)
- (setq name (concat (file-name-as-directory dir) name)))
- ;; If NAME is not a Tramp file, run the real handler.
- (if (not (tramp-tramp-file-p name))
- (tramp-run-real-handler #'expand-file-name (list name nil))
- ;; Dissect NAME.
- (with-parsed-tramp-file-name name nil
- ;; Tilde expansion if necessary. We use the user name as share,
- ;; which is often the case in domains.
- (when (string-match "\\`/?~\\([^/]*\\)" localname)
- (setq localname
- (replace-match
- (if (zerop (length (match-string 1 localname)))
- user
- (match-string 1 localname))
- nil nil localname)))
- ;; Make the file name absolute.
- (unless (tramp-run-real-handler #'file-name-absolute-p (list localname))
- (setq localname (concat "/" localname)))
- ;; No tilde characters in file name, do normal
- ;; `expand-file-name' (this does "/./" and "/../").
- (tramp-make-tramp-file-name
- v (tramp-run-real-handler #'expand-file-name (list localname))))))
-
-(defun tramp-smb-action-get-acl (proc vec)
- "Read ACL data from connection buffer."
- (unless (process-live-p proc)
- ;; Accept pending output.
- (while (tramp-accept-process-output proc))
- (with-current-buffer (tramp-get-connection-buffer vec)
- ;; There might be a hidden password prompt.
- (widen)
- (tramp-message vec 10 "\n%s" (buffer-string))
- (goto-char (point-min))
- (while (and (not (eobp)) (not (looking-at-p "^REVISION:")))
- (forward-line)
- (delete-region (point-min) (point)))
- (while (and (not (eobp)) (looking-at-p "^.+:.+"))
- (forward-line))
- (delete-region (point) (point-max))
- (throw 'tramp-action 'ok))))
-
-(defun tramp-smb-handle-file-acl (filename)
- "Like `file-acl' for Tramp files."
- (ignore-errors
- (with-parsed-tramp-file-name filename nil
- (with-tramp-file-property v localname "file-acl"
- (when (executable-find tramp-smb-acl-program)
- (let* ((share (tramp-smb-get-share v))
- (localname (replace-regexp-in-string
- "\\\\" "/" (tramp-smb-get-localname v)))
- (args (list (concat "//" host "/" share) "-E")))
-
- (if (not (zerop (length user)))
- (setq args (append args (list "-U" user)))
- (setq args (append args (list "-N"))))
-
- (when domain (setq args (append args (list "-W" domain))))
- (when port (setq args (append args (list "-p" port))))
- (when tramp-smb-conf
- (setq args (append args (list "-s" tramp-smb-conf))))
- (setq
- args
- (append args (list (tramp-unquote-shell-quote-argument localname)
- "2>/dev/null")))
-
- (unwind-protect
- (with-temp-buffer
- ;; Set the transfer process properties.
- (tramp-set-connection-property
- v "process-name" (buffer-name (current-buffer)))
- (tramp-set-connection-property
- v "process-buffer" (current-buffer))
-
- ;; Use an asynchronous process. By this, password can
- ;; be handled.
- (let ((p (apply
- #'start-process
- (tramp-get-connection-name v)
- (tramp-get-connection-buffer v)
- tramp-smb-acl-program args)))
-
- (tramp-message
- v 6 "%s" (mapconcat #'identity (process-command p) " "))
- (process-put p 'vector v)
- (process-put p 'adjust-window-size-function #'ignore)
- (set-process-query-on-exit-flag p nil)
- (tramp-process-actions p v nil tramp-smb-actions-get-acl)
- (when (> (point-max) (point-min))
- (substring-no-properties (buffer-string)))))
-
- ;; Reset the transfer process properties.
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer"))))))))
-
-(defun tramp-smb-handle-file-attributes (filename &optional id-format)
- "Like `file-attributes' for Tramp files."
- (unless id-format (setq id-format 'integer))
- (ignore-errors
- (with-parsed-tramp-file-name filename nil
- (with-tramp-file-property
- v localname (format "file-attributes-%s" id-format)
- (if (tramp-smb-get-stat-capability v)
- (tramp-smb-do-file-attributes-with-stat v id-format)
- ;; Reading just the filename entry via "dir localname" is not
- ;; possible, because when filename is a directory, some
- ;; smbclient versions return the content of the directory, and
- ;; other versions don't. Therefore, the whole content of the
- ;; upper directory is retrieved, and the entry of the filename
- ;; is extracted from.
- (let* ((entries (tramp-smb-get-file-entries
- (file-name-directory filename)))
- (entry (assoc (file-name-nondirectory filename) entries))
- (uid (if (equal id-format 'string) "nobody" -1))
- (gid (if (equal id-format 'string) "nogroup" -1))
- (inode (tramp-get-inode v))
- (device (tramp-get-device v)))
-
- ;; Check result.
- (when entry
- (list (and (string-match-p "d" (nth 1 entry))
- t) ;0 file type
- -1 ;1 link count
- uid ;2 uid
- gid ;3 gid
- tramp-time-dont-know ;4 atime
- (nth 3 entry) ;5 mtime
- tramp-time-dont-know ;6 ctime
- (nth 2 entry) ;7 size
- (nth 1 entry) ;8 mode
- nil ;9 gid weird
- inode ;10 inode number
- device)))))))) ;11 file system number
-
-(defun tramp-smb-do-file-attributes-with-stat (vec &optional id-format)
- "Implement `file-attributes' for Tramp files using stat command."
- (tramp-message
- vec 5 "file attributes with stat: %s" (tramp-file-name-localname vec))
- (with-current-buffer (tramp-get-connection-buffer vec)
- (let* (size id link uid gid atime mtime ctime mode inode)
- (when (tramp-smb-send-command
- vec (format "stat \"%s\"" (tramp-smb-get-localname vec)))
-
- ;; Loop the listing.
- (goto-char (point-min))
- (unless (re-search-forward tramp-smb-errors nil t)
- (while (not (eobp))
- (cond
- ((looking-at
- "Size:\\s-+\\([0-9]+\\)\\s-+Blocks:\\s-+[0-9]+\\s-+\\(\\w+\\)")
- (setq size (string-to-number (match-string 1))
- id (if (string-equal "directory" (match-string 2)) t
- (if (string-equal "symbolic" (match-string 2)) ""))))
- ((looking-at
- "Inode:\\s-+\\([0-9]+\\)\\s-+Links:\\s-+\\([0-9]+\\)")
- (setq inode (string-to-number (match-string 1))
- link (string-to-number (match-string 2))))
- ((looking-at
-
"Access:\\s-+([0-9]+/\\(\\S-+\\))\\s-+Uid:\\s-+\\([0-9]+\\)\\s-+Gid:\\s-+\\([0-9]+\\)")
- (setq mode (match-string 1)
- uid (if (equal id-format 'string) (match-string 2)
- (string-to-number (match-string 2)))
- gid (if (equal id-format 'string) (match-string 3)
- (string-to-number (match-string 3)))))
- ((looking-at
-
"Access:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)")
- (setq atime
- (encode-time
- (string-to-number (match-string 6)) ;; sec
- (string-to-number (match-string 5)) ;; min
- (string-to-number (match-string 4)) ;; hour
- (string-to-number (match-string 3)) ;; day
- (string-to-number (match-string 2)) ;; month
- (string-to-number (match-string 1))))) ;; year
- ((looking-at
-
"Modify:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)")
- (setq mtime
- (encode-time
- (string-to-number (match-string 6)) ;; sec
- (string-to-number (match-string 5)) ;; min
- (string-to-number (match-string 4)) ;; hour
- (string-to-number (match-string 3)) ;; day
- (string-to-number (match-string 2)) ;; month
- (string-to-number (match-string 1))))) ;; year
- ((looking-at
-
"Change:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)")
- (setq ctime
- (encode-time
- (string-to-number (match-string 6)) ;; sec
- (string-to-number (match-string 5)) ;; min
- (string-to-number (match-string 4)) ;; hour
- (string-to-number (match-string 3)) ;; day
- (string-to-number (match-string 2)) ;; month
- (string-to-number (match-string 1)))))) ;; year
- (forward-line))
-
- ;; Resolve symlink.
- (when (and (stringp id)
- (tramp-smb-send-command
- vec
- (format "readlink \"%s\"" (tramp-smb-get-localname vec))))
- (goto-char (point-min))
- (and (looking-at ".+ -> \\(.+\\)")
- (setq id (match-string 1))))
-
- ;; Return the result.
- (when (or id link uid gid atime mtime ctime size mode inode)
- (list id link uid gid atime mtime ctime size mode nil inode
- (tramp-get-device vec))))))))
-
-(defun tramp-smb-handle-file-local-copy (filename)
- "Like `file-local-copy' for Tramp files."
- (with-parsed-tramp-file-name (file-truename filename) nil
- (unless (file-exists-p (file-truename filename))
- (tramp-error
- v tramp-file-missing
- "Cannot make local copy of non-existing file `%s'" filename))
- (let ((tmpfile (tramp-compat-make-temp-file filename)))
- (with-tramp-progress-reporter
- v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
- (unless (tramp-smb-send-command
- v (format "get \"%s\" \"%s\""
- (tramp-smb-get-localname v) tmpfile))
- ;; Oops, an error. We shall cleanup.
- (delete-file tmpfile)
- (tramp-error
- v 'file-error "Cannot make local copy of file `%s'" filename)))
- tmpfile)))
-
-;; This function should return "foo/" for directories and "bar" for
-;; files.
-(defun tramp-smb-handle-file-name-all-completions (filename directory)
- "Like `file-name-all-completions' for Tramp files."
- (all-completions
- filename
- (with-parsed-tramp-file-name (expand-file-name directory) nil
- (with-tramp-file-property v localname "file-name-all-completions"
- (delete-dups
- (mapcar
- (lambda (x)
- (list
- (if (string-match-p "d" (nth 1 x))
- (file-name-as-directory (nth 0 x))
- (nth 0 x))))
- (tramp-smb-get-file-entries directory)))))))
-
-(defun tramp-smb-handle-file-system-info (filename)
- "Like `file-system-info' for Tramp files."
- (ignore-errors
- (unless (file-directory-p filename)
- (setq filename (file-name-directory filename)))
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (tramp-message v 5 "file system info: %s" localname)
- (tramp-smb-send-command v (format "du %s/*" (tramp-smb-get-localname v)))
- (with-current-buffer (tramp-get-connection-buffer v)
- (let (total avail blocksize)
- (goto-char (point-min))
- (forward-line)
- (when (looking-at
- (eval-when-compile
- (concat "[[:space:]]*\\([[:digit:]]+\\)"
- " blocks of size \\([[:digit:]]+\\)"
- "\\. \\([[:digit:]]+\\) blocks available")))
- (setq blocksize (string-to-number (match-string 2))
- total (* blocksize (string-to-number (match-string 1)))
- avail (* blocksize (string-to-number (match-string 3)))))
- (forward-line)
- (when (looking-at "Total number of bytes: \\([[:digit:]]+\\)")
- ;; The used number of bytes is not part of the result. As
- ;; side effect, we store it as file property.
- (tramp-set-file-property
- v localname "used-bytes" (string-to-number (match-string 1))))
- ;; Result.
- (when (and total avail)
- (list total (- total avail) avail)))))))
-
-(defun tramp-smb-handle-file-writable-p (filename)
- "Like `file-writable-p' for Tramp files."
- (if (file-exists-p filename)
- (string-match-p
- "w"
- (or (tramp-compat-file-attribute-modes (file-attributes filename)) ""))
- (let ((dir (file-name-directory filename)))
- (and (file-exists-p dir)
- (file-writable-p dir)))))
-
-(defun tramp-smb-handle-insert-directory
- (filename switches &optional wildcard full-directory-p)
- "Like `insert-directory' for Tramp files."
- (setq filename (expand-file-name filename))
- (unless switches (setq switches ""))
- ;; Mark trailing "/".
- (when (and (zerop (length (file-name-nondirectory filename)))
- (not full-directory-p))
- (setq switches (concat switches "F")))
- (if full-directory-p
- ;; Called from `dired-add-entry'.
- (setq filename (file-name-as-directory filename))
- (setq filename (directory-file-name filename)))
- ;; Check, whether directory is accessible.
- (unless wildcard
- (access-file filename "Reading directory"))
- (with-parsed-tramp-file-name filename nil
- (with-tramp-progress-reporter v 0 (format "Opening directory %s" filename)
- (save-match-data
- (let ((base (file-name-nondirectory filename))
- ;; We should not destroy the cache entry.
- (entries (copy-tree
- (tramp-smb-get-file-entries
- (file-name-directory filename))))
- (avail (get-free-disk-space filename))
- ;; `get-free-disk-space' calls `file-system-info', which
- ;; sets file property "used-bytes" as side effect.
- (used
- (format
- "%.0f"
- (/ (tramp-get-file-property v localname "used-bytes" 0) 1024))))
-
- (when wildcard
- (string-match "\\." base)
- (setq base (replace-match "\\\\." nil nil base))
- (string-match "\\*" base)
- (setq base (replace-match ".*" nil nil base))
- (string-match "\\?" base)
- (setq base (replace-match ".?" nil nil base)))
-
- ;; Filter entries.
- (setq entries
- (delq
- nil
- (if (or wildcard (zerop (length base)))
- ;; Check for matching entries.
- (mapcar
- (lambda (x)
- (when (string-match-p
- (format "^%s" base) (nth 0 x))
- x))
- entries)
- ;; We just need the only and only entry FILENAME.
- (list (assoc base entries)))))
-
- ;; Sort entries.
- (setq entries
- (sort
- entries
- (lambda (x y)
- (if (string-match-p "t" switches)
- ;; Sort by date.
- (time-less-p (nth 3 y) (nth 3 x))
- ;; Sort by name.
- (string-lessp (nth 0 x) (nth 0 y))))))
-
- ;; Handle "-F" switch.
- (when (string-match-p "F" switches)
- (mapc
- (lambda (x)
- (unless (zerop (length (car x)))
- (cond
- ((char-equal ?d (string-to-char (nth 1 x)))
- (setcar x (concat (car x) "/")))
- ((char-equal ?x (string-to-char (nth 1 x)))
- (setcar x (concat (car x) "*"))))))
- entries))
-
- ;; Insert size information.
- (when full-directory-p
- (insert
- (if avail
- (format "total used in directory %s available %s\n" used avail)
- (format "total %s\n" used))))
-
- ;; Print entries.
- (mapc
- (lambda (x)
- (unless (zerop (length (nth 0 x)))
- (let ((attr
- (when (tramp-smb-get-stat-capability v)
- (ignore-errors
- (file-attributes
- (expand-file-name
- (nth 0 x) (file-name-directory filename))
- 'string)))))
- (when (string-match-p "l" switches)
- (insert
- (format
- "%10s %3d %-8s %-8s %8s %s "
- (or (tramp-compat-file-attribute-modes attr) (nth 1 x))
- (or (tramp-compat-file-attribute-link-number attr) 1)
- (or (tramp-compat-file-attribute-user-id attr) "nobody")
- (or (tramp-compat-file-attribute-group-id attr) "nogroup")
- (or (tramp-compat-file-attribute-size attr) (nth 2 x))
- (format-time-string
- (if (time-less-p
- ;; Half a year.
- (time-since (nth 3 x)) (days-to-time 183))
- "%b %e %R"
- "%b %e %Y")
- (nth 3 x))))) ; date
-
- ;; We mark the file name. The inserted name could be
- ;; from somewhere else, so we use the relative file name
- ;; of `default-directory'.
- (let ((start (point)))
- (insert
- (format
- "%s"
- (file-relative-name
- (expand-file-name
- (nth 0 x) (file-name-directory filename))
- (when full-directory-p (file-name-directory filename)))))
- (put-text-property start (point) 'dired-filename t))
-
- ;; Insert symlink.
- (when (and (string-match-p "l" switches)
- (stringp (tramp-compat-file-attribute-type attr)))
- (insert " -> " (tramp-compat-file-attribute-type attr))))
-
- (insert "\n")
- (forward-line)
- (beginning-of-line)))
- entries))))))
-
-(defun tramp-smb-handle-make-directory (dir &optional parents)
- "Like `make-directory' for Tramp files."
- (setq dir (directory-file-name (expand-file-name dir)))
- (unless (file-name-absolute-p dir)
- (setq dir (expand-file-name dir default-directory)))
- (with-parsed-tramp-file-name dir nil
- (let* ((ldir (file-name-directory dir)))
- ;; Make missing directory parts.
- (when (and parents
- (tramp-smb-get-share v)
- (not (file-directory-p ldir)))
- (make-directory ldir parents))
- ;; Just do it.
- (when (file-directory-p ldir)
- (make-directory-internal dir))
- (unless (file-directory-p dir)
- (tramp-error v 'file-error "Couldn't make directory %s" dir)))))
-
-(defun tramp-smb-handle-make-directory-internal (directory)
- "Like `make-directory-internal' for Tramp files."
- (setq directory (directory-file-name (expand-file-name directory)))
- (unless (file-name-absolute-p directory)
- (setq directory (expand-file-name directory default-directory)))
- (with-parsed-tramp-file-name directory nil
- (let* ((file (tramp-smb-get-localname v)))
- (when (file-directory-p (file-name-directory directory))
- (tramp-smb-send-command
- v
- (if (tramp-smb-get-cifs-capabilities v)
- (format "posix_mkdir \"%s\" %o" file (default-file-modes))
- (format "mkdir \"%s\"" file)))
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-properties v (file-name-directory localname))
- (tramp-flush-file-properties v localname))
- (unless (file-directory-p directory)
- (tramp-error v 'file-error "Couldn't make directory %s" directory)))))
-
-(defun tramp-smb-handle-make-symbolic-link
- (target linkname &optional ok-if-already-exists)
- "Like `make-symbolic-link' for Tramp files.
-If TARGET is a non-Tramp file, it is used verbatim as the target
-of the symlink. If TARGET is a Tramp file, only the localname
-component is used as the target of the symlink."
- (if (not (tramp-tramp-file-p (expand-file-name linkname)))
- (tramp-run-real-handler
- #'make-symbolic-link (list target linkname ok-if-already-exists))
-
- (with-parsed-tramp-file-name linkname nil
- ;; If TARGET is a Tramp name, use just the localname component.
- (when (and (tramp-tramp-file-p target)
- (tramp-file-name-equal-p v (tramp-dissect-file-name target)))
- (setq target
- (tramp-file-name-localname
- (tramp-dissect-file-name (expand-file-name target)))))
-
- ;; If TARGET is still remote, quote it.
- (if (tramp-tramp-file-p target)
- (make-symbolic-link
- (let (file-name-handler-alist) (tramp-compat-file-name-quote target))
- linkname ok-if-already-exists)
-
- ;; Do the 'confirm if exists' thing.
- (when (file-exists-p linkname)
- ;; What to do?
- (if (or (null ok-if-already-exists) ; not allowed to exist
- (and (numberp ok-if-already-exists)
- (not (yes-or-no-p
- (format
- "File %s already exists; make it a link anyway? "
- localname)))))
- (tramp-error v 'file-already-exists localname)
- (delete-file linkname)))
-
- (unless (tramp-smb-get-cifs-capabilities v)
- (tramp-error v 'file-error "make-symbolic-link not supported"))
-
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-properties v (file-name-directory localname))
- (tramp-flush-file-properties v localname)
-
- (unless
- (tramp-smb-send-command
- v (format "symlink \"%s\" \"%s\""
- (tramp-compat-file-name-unquote target)
- (tramp-smb-get-localname v)))
- (tramp-error
- v 'file-error
- "error with make-symbolic-link, see buffer `%s' for details"
- (tramp-get-connection-buffer v)))))))
-
-(defun tramp-smb-handle-process-file
- (program &optional infile destination display &rest args)
- "Like `process-file' for Tramp files."
- ;; The implementation is not complete yet.
- (when (and (numberp destination) (zerop destination))
- (error "Implementation does not handle immediate return"))
-
- (with-parsed-tramp-file-name default-directory nil
- (let* ((name (file-name-nondirectory program))
- (name1 name)
- (i 0)
- input tmpinput outbuf command ret)
-
- ;; Determine input.
- (when infile
- (setq infile (expand-file-name infile))
- (if (tramp-equal-remote default-directory infile)
- ;; INFILE is on the same remote host.
- (setq input (with-parsed-tramp-file-name infile nil localname))
- ;; INFILE must be copied to remote host.
- (setq input (tramp-make-tramp-temp-file v)
- tmpinput (tramp-make-tramp-file-name v input))
- (copy-file infile tmpinput t))
- ;; Transform input into a filename powershell does understand.
- (setq input (format "//%s%s" host input)))
-
- ;; Determine output.
- (cond
- ;; Just a buffer.
- ((bufferp destination)
- (setq outbuf destination))
- ;; A buffer name.
- ((stringp destination)
- (setq outbuf (get-buffer-create destination)))
- ;; (REAL-DESTINATION ERROR-DESTINATION)
- ((consp destination)
- ;; output.
- (cond
- ((bufferp (car destination))
- (setq outbuf (car destination)))
- ((stringp (car destination))
- (setq outbuf (get-buffer-create (car destination))))
- ((car destination)
- (setq outbuf (current-buffer))))
- ;; stderr.
- (tramp-message v 2 "%s" "STDERR not supported"))
- ;; 't
- (destination
- (setq outbuf (current-buffer))))
-
- ;; Construct command.
- (setq command (mapconcat #'identity (cons program args) " ")
- command (if input
- (format
- "get-content %s | & %s"
- (tramp-smb-shell-quote-argument input) command)
- (format "& %s" command)))
-
- (while (get-process name1)
- ;; NAME must be unique as process name.
- (setq i (1+ i)
- name1 (format "%s<%d>" name i)))
-
- ;; Set the new process properties.
- (tramp-set-connection-property v "process-name" name1)
- (tramp-set-connection-property
- v "process-buffer"
- (or outbuf (generate-new-buffer tramp-temp-buffer-name)))
-
- ;; Call it.
- (condition-case nil
- (with-current-buffer (tramp-get-connection-buffer v)
- ;; Preserve buffer contents.
- (narrow-to-region (point-max) (point-max))
- (tramp-smb-call-winexe v)
- (when (tramp-smb-get-share v)
- (tramp-smb-send-command
- v (format "cd \"//%s%s\"" host (file-name-directory localname))))
- (tramp-smb-send-command v command)
- ;; Preserve command output.
- (narrow-to-region (point-max) (point-max))
- (let ((p (tramp-get-connection-process v)))
- (tramp-smb-send-command v "exit $lasterrorcode")
- (while (process-live-p p)
- (sleep-for 0.1)
- (setq ret (process-exit-status p))))
- (delete-region (point-min) (point-max))
- (widen))
-
- ;; When the user did interrupt, we should do it also. We use
- ;; return code -1 as marker.
- (quit
- (setq ret -1))
- ;; Handle errors.
- (error
- (setq ret 1)))
-
- ;; We should redisplay the output.
- (when (and display outbuf (get-buffer-window outbuf t)) (redisplay))
-
- ;; Cleanup. We remove all file cache values for the connection,
- ;; because the remote process could have changed them.
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer")
- (when tmpinput (delete-file tmpinput))
- (unless outbuf
- (kill-buffer (tramp-get-connection-property v "process-buffer" nil)))
-
- (unless process-file-side-effects
- (tramp-flush-directory-properties v ""))
-
- ;; Return exit status.
- (if (equal ret -1)
- (keyboard-quit)
- ret))))
-
-(defun tramp-smb-handle-rename-file
- (filename newname &optional ok-if-already-exists)
- "Like `rename-file' for Tramp files."
- (setq filename (expand-file-name filename)
- newname (expand-file-name newname))
-
- (when (and (not ok-if-already-exists)
- (file-exists-p newname))
- (tramp-error
- (tramp-dissect-file-name
- (if (tramp-tramp-file-p filename) filename newname))
- 'file-already-exists newname))
-
- (with-tramp-progress-reporter
- (tramp-dissect-file-name
- (if (tramp-tramp-file-p filename) filename newname))
- 0 (format "Renaming %s to %s" filename newname)
-
- (if (and (not (file-exists-p newname))
- (tramp-equal-remote filename newname)
- (string-equal
- (tramp-smb-get-share (tramp-dissect-file-name filename))
- (tramp-smb-get-share (tramp-dissect-file-name newname))))
- ;; We can rename directly.
- (with-parsed-tramp-file-name filename v1
- (with-parsed-tramp-file-name newname v2
-
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-properties v1 (file-name-directory v1-localname))
- (tramp-flush-file-properties v1 v1-localname)
- (tramp-flush-file-properties v2 (file-name-directory v2-localname))
- (tramp-flush-file-properties v2 v2-localname)
- (unless (tramp-smb-get-share v2)
- (tramp-error
- v2 'file-error "Target `%s' must contain a share name" newname))
- (unless (tramp-smb-send-command
- v2 (format "rename \"%s\" \"%s\""
- (tramp-smb-get-localname v1)
- (tramp-smb-get-localname v2)))
- (tramp-error v2 'file-error "Cannot rename `%s'" filename))))
-
- ;; We must rename via copy.
- (copy-file
- filename newname ok-if-already-exists 'keep-time 'preserve-uid-gid)
- (if (file-directory-p filename)
- (delete-directory filename 'recursive)
- (delete-file filename)))))
-
-(defun tramp-smb-action-set-acl (proc vec)
- "Set ACL data."
- (unless (process-live-p proc)
- ;; Accept pending output.
- (while (tramp-accept-process-output proc))
- (with-current-buffer (tramp-get-connection-buffer vec)
- (tramp-message vec 10 "\n%s" (buffer-string))
- (throw 'tramp-action 'ok))))
-
-(defun tramp-smb-handle-set-file-acl (filename acl-string)
- "Like `set-file-acl' for Tramp files."
- (ignore-errors
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-property v localname "file-acl")
-
- (when (and (stringp acl-string) (executable-find tramp-smb-acl-program))
- (let* ((share (tramp-smb-get-share v))
- (localname (replace-regexp-in-string
- "\\\\" "/" (tramp-smb-get-localname v)))
- (args (list (concat "//" host "/" share) "-E" "-S"
- (replace-regexp-in-string
- "\n" "," acl-string))))
-
- (if (not (zerop (length user)))
- (setq args (append args (list "-U" user)))
- (setq args (append args (list "-N"))))
-
- (when domain (setq args (append args (list "-W" domain))))
- (when port (setq args (append args (list "-p" port))))
- (when tramp-smb-conf
- (setq args (append args (list "-s" tramp-smb-conf))))
- (setq
- args
- (append args (list (tramp-unquote-shell-quote-argument localname)
- "&&" "echo" "tramp_exit_status" "0"
- "||" "echo" "tramp_exit_status" "1")))
-
- (unwind-protect
- (with-temp-buffer
- ;; Set the transfer process properties.
- (tramp-set-connection-property
- v "process-name" (buffer-name (current-buffer)))
- (tramp-set-connection-property
- v "process-buffer" (current-buffer))
-
- ;; Use an asynchronous process. By this, password can
- ;; be handled.
- (let ((p (apply
- #'start-process
- (tramp-get-connection-name v)
- (tramp-get-connection-buffer v)
- tramp-smb-acl-program args)))
-
- (tramp-message
- v 6 "%s" (mapconcat #'identity (process-command p) " "))
- (process-put p 'vector v)
- (process-put p 'adjust-window-size-function #'ignore)
- (set-process-query-on-exit-flag p nil)
- (tramp-process-actions p v nil tramp-smb-actions-set-acl)
- (goto-char (point-max))
- ;; This is meant for traces, and returning from the
- ;; function. No error is propagated outside, due to
- ;; the `ignore-errors' closure.
- (unless (re-search-backward "tramp_exit_status [0-9]+" nil t)
- (tramp-error
- v 'file-error
- "Couldn't find exit status of `%s'" tramp-smb-acl-program))
- (skip-chars-forward "^ ")
- (when (zerop (read (current-buffer)))
- ;; Success.
- (tramp-set-file-property v localname "file-acl" acl-string)
- t)))
-
- ;; Reset the transfer process properties.
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer")))))))
-
-(defun tramp-smb-handle-set-file-modes (filename mode)
- "Like `set-file-modes' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (when (tramp-smb-get-cifs-capabilities v)
- (tramp-flush-file-properties v localname)
- (unless (tramp-smb-send-command
- v (format "chmod \"%s\" %o" (tramp-smb-get-localname v) mode))
- (tramp-error
- v 'file-error "Error while changing file's mode %s" filename)))))
-
-;; We use BUFFER also as connection buffer during setup. Because of
-;; this, its original contents must be saved, and restored once
-;; connection has been setup.
-(defun tramp-smb-handle-start-file-process (name buffer program &rest args)
- "Like `start-file-process' for Tramp files."
- (with-parsed-tramp-file-name default-directory nil
- (let* ((buffer
- (if buffer
- (get-buffer-create buffer)
- ;; BUFFER can be nil. We use a temporary buffer.
- (generate-new-buffer tramp-temp-buffer-name)))
- (command (mapconcat #'identity (cons program args) " "))
- (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
- (name1 name)
- (i 0))
- (unwind-protect
- (save-excursion
- (save-restriction
- (while (get-process name1)
- ;; NAME must be unique as process name.
- (setq i (1+ i)
- name1 (format "%s<%d>" name i)))
- ;; Set the new process properties.
- (tramp-set-connection-property v "process-name" name1)
- (tramp-set-connection-property v "process-buffer" buffer)
- ;; Activate narrowing in order to save BUFFER contents.
- (with-current-buffer (tramp-get-connection-buffer v)
- (let ((buffer-undo-list t))
- (narrow-to-region (point-max) (point-max))
- (tramp-smb-call-winexe v)
- (when (tramp-smb-get-share v)
- (tramp-smb-send-command
- v (format
- "cd \"//%s%s\""
- host (file-name-directory localname))))
- (tramp-message v 6 "(%s); exit" command)
- (tramp-send-string v command)))
- ;; Return value.
- (tramp-get-connection-process v)))
-
- ;; Save exit.
- (with-current-buffer (tramp-get-connection-buffer v)
- (if (string-match-p tramp-temp-buffer-name (buffer-name))
- (progn
- (set-process-buffer (tramp-get-connection-process v) nil)
- (kill-buffer (current-buffer)))
- (set-buffer-modified-p bmp)))
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer")))))
-
-(defun tramp-smb-handle-substitute-in-file-name (filename)
- "Like `handle-substitute-in-file-name' for Tramp files.
-\"//\" substitutes only in the local filename part. Catches
-errors for shares like \"C$/\", which are common in Microsoft Windows."
- ;; Check, whether the local part is a quoted file name.
- (if (tramp-compat-file-name-quoted-p filename)
- filename
- (with-parsed-tramp-file-name filename nil
- ;; Ignore in LOCALNAME everything before "//".
- (when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)"
localname))
- (setq filename
- (concat (file-remote-p filename)
- (replace-match "\\1" nil nil localname)))))
- (condition-case nil
- (tramp-run-real-handler #'substitute-in-file-name (list filename))
- (error filename))))
-
-(defun tramp-smb-handle-write-region
- (start end filename &optional append visit lockname mustbenew)
- "Like `write-region' for Tramp files."
- (setq filename (expand-file-name filename))
- (with-parsed-tramp-file-name filename nil
- (when (and mustbenew (file-exists-p filename)
- (or (eq mustbenew 'excl)
- (not
- (y-or-n-p
- (format "File %s exists; overwrite anyway? " filename)))))
- (tramp-error v 'file-already-exists filename))
-
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-properties v (file-name-directory localname))
- (tramp-flush-file-properties v localname)
- (let ((curbuf (current-buffer))
- (tmpfile (tramp-compat-make-temp-file filename)))
- (when (and append (file-exists-p filename))
- (copy-file filename tmpfile 'ok))
- ;; We say `no-message' here because we don't want the visited file
- ;; modtime data to be clobbered from the temp file. We call
- ;; `set-visited-file-modtime' ourselves later on.
- (tramp-run-real-handler
- #'write-region (list start end tmpfile append 'no-message lockname))
-
- (with-tramp-progress-reporter
- v 3 (format "Moving tmp file %s to %s" tmpfile filename)
- (unwind-protect
- (unless (tramp-smb-send-command
- v (format "put %s \"%s\""
- tmpfile (tramp-smb-get-localname v)))
- (tramp-error v 'file-error "Cannot write `%s'" filename))
- (delete-file tmpfile)))
-
- (unless (equal curbuf (current-buffer))
- (tramp-error
- v 'file-error
- "Buffer has changed from `%s' to `%s'" curbuf (current-buffer)))
-
- ;; Set file modification time.
- (when (or (eq visit t) (stringp visit))
- (set-visited-file-modtime
- (tramp-compat-file-attribute-modification-time
- (file-attributes filename))))
-
- ;; The end.
- (when (and (null noninteractive)
- (or (eq visit t) (null visit) (stringp visit)))
- (tramp-message v 0 "Wrote %s" filename))
- (run-hooks 'tramp-handle-write-region-hook))))
-
-;; Internal file name functions.
-
-(defun tramp-smb-get-share (vec)
- "Returns the share name of LOCALNAME."
- (save-match-data
- (let ((localname (tramp-file-name-unquote-localname vec)))
- (when (string-match "^/?\\([^/]+\\)/" localname)
- (match-string 1 localname)))))
-
-(defun tramp-smb-get-localname (vec)
- "Returns the file name of LOCALNAME.
-If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"."
- (save-match-data
- (let ((localname (tramp-file-name-unquote-localname vec)))
- (setq
- localname
- (if (string-match "^/?[^/]+\\(/.*\\)" localname)
- ;; There is a share, separated by "/".
- (if (not (tramp-smb-get-cifs-capabilities vec))
- (mapconcat
- (lambda (x) (if (equal x ?/) "\\" (char-to-string x)))
- (match-string 1 localname) "")
- (match-string 1 localname))
- ;; There is just a share.
- (if (string-match "^/?\\([^/]+\\)$" localname)
- (match-string 1 localname)
- "")))
-
- ;; Sometimes we have discarded `substitute-in-file-name'.
- (when (string-match "\\(\\$\\$\\)\\(/\\|$\\)" localname)
- (setq localname (replace-match "$" nil nil localname 1)))
-
- ;; A period followed by a space, or trailing periods and spaces,
- ;; are not supported.
- (when (string-match-p "\\. \\|\\.$\\| $" localname)
- (tramp-error
- vec 'file-error
- "Invalid file name %s" (tramp-make-tramp-file-name vec localname)))
-
- localname)))
-
-;; Share names of a host are cached. It is very unlikely that the
-;; shares do change during connection.
-(defun tramp-smb-get-file-entries (directory)
- "Read entries which match DIRECTORY.
-Either the shares are listed, or the `dir' command is executed.
-Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)."
- ;; If CIFS capabilities are enabled, symlinks are not listed
- ;; by `dir'. This is a consequence of
- ;; <https://www.samba.org/samba/news/symlink_attack.html>. See also
- ;; <https://bugzilla.samba.org/show_bug.cgi?id=5116>.
- (with-parsed-tramp-file-name (file-name-as-directory directory) nil
- (setq localname (or localname "/"))
- (with-tramp-file-property v localname "file-entries"
- (with-current-buffer (tramp-get-connection-buffer v)
- (let* ((share (tramp-smb-get-share v))
- (cache (tramp-get-connection-property v "share-cache" nil))
- res entry)
-
- (if (and (not share) cache)
- ;; Return cached shares.
- (setq res cache)
-
- ;; Read entries.
- (if share
- (tramp-smb-send-command
- v (format "dir \"%s*\"" (tramp-smb-get-localname v)))
- ;; `tramp-smb-maybe-open-connection' lists also the share names.
- (tramp-smb-maybe-open-connection v))
-
- ;; Loop the listing.
- (goto-char (point-min))
- (if (re-search-forward tramp-smb-errors nil t)
- (tramp-error v 'file-error "%s `%s'" (match-string 0) directory)
- (while (not (eobp))
- (setq entry (tramp-smb-read-file-entry share))
- (forward-line)
- (when entry (push entry res))))
-
- ;; Cache share entries.
- (unless share
- (tramp-set-connection-property v "share-cache" res)))
-
- ;; Add directory itself.
- (push '("" "drwxrwxrwx" 0 (0 0)) res)
-
- ;; Return entries.
- (delq nil res))))))
-
-;; Return either a share name (if SHARE is nil), or a file name.
-;;
-;; If shares are listed, the following format is expected:
-;;
-;; Disk| - leading spaces
-;; [^|]+| - share name, 14 char
-;; .* - comment
-;;
-;; Entries provided by smbclient DIR aren't fully regular.
-;; They should have the format
-;;
-;; \s-\{2,2} - leading spaces
-;; \S-\(.*\S-\)\s-* - file name, 30 chars, left bound
-;; \s-+[ADHRSV]* - permissions, 7 chars, right bound
-;; \s- - space delimiter
-;; \s-+[0-9]+ - size, 8 chars, right bound
-;; \s-\{2,2\} - space delimiter
-;; \w\{3,3\} - weekday
-;; \s- - space delimiter
-;; \w\{3,3\} - month
-;; \s- - space delimiter
-;; [ 12][0-9] - day
-;; \s- - space delimiter
-;; [0-9]\{2,2\}:[0-9]\{2,2\}:[0-9]\{2,2\} - time
-;; \s- - space delimiter
-;; [0-9]\{4,4\} - year
-;;
-;; samba/src/client.c (http://samba.org/doxygen/samba/client_8c-source.html)
-;; has function display_finfo:
-;;
-;; d_printf(" %-30s%7.7s %8.0f %s",
-;; finfo->name,
-;; attrib_string(finfo->mode),
-;; (double)finfo->size,
-;; asctime(LocalTime(&t)));
-;;
-;; in Samba 1.9, there's the following code:
-;;
-;; DEBUG(0,(" %-30s%7.7s%10d %s",
-;; CNV_LANG(finfo->name),
-;; attrib_string(finfo->mode),
-;; finfo->size,
-;; asctime(LocalTime(&t))));
-;;
-;; Problems:
-;; * Modern regexp constructs, like spy groups and counted repetitions, aren't
-;; available in older Emacsen.
-;; * The length of constructs (file name, size) might exceed the default.
-;; * File names might contain spaces.
-;; * Permissions might be empty.
-;;
-;; So we try to analyze backwards.
-(defun tramp-smb-read-file-entry (share)
- "Parse entry in SMB output buffer.
-If SHARE is result, entries are of type dir. Otherwise, shares are listed.
-Result is the list (LOCALNAME MODE SIZE MTIME)."
-;; We are called from `tramp-smb-get-file-entries', which sets the
-;; current buffer.
- (let ((line (buffer-substring (point) (point-at-eol)))
- localname mode size month day hour min sec year mtime)
-
- (if (not share)
-
- ;; Read share entries.
- (when (string-match "^Disk|\\([^|]+\\)|" line)
- (setq localname (match-string 1 line)
- mode "dr-xr-xr-x"
- size 0))
-
- ;; Real listing.
- (cl-block nil
-
- ;; year.
- (if (string-match "\\([0-9]+\\)$" line)
- (setq year (string-to-number (match-string 1 line))
- line (substring line 0 -5))
- (cl-return))
-
- ;; time.
- (if (string-match "\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)$" line)
- (setq hour (string-to-number (match-string 1 line))
- min (string-to-number (match-string 2 line))
- sec (string-to-number (match-string 3 line))
- line (substring line 0 -9))
- (cl-return))
-
- ;; day.
- (if (string-match "\\([0-9]+\\)$" line)
- (setq day (string-to-number (match-string 1 line))
- line (substring line 0 -3))
- (cl-return))
-
- ;; month.
- (if (string-match "\\(\\w+\\)$" line)
- (setq month (match-string 1 line)
- line (substring line 0 -4))
- (cl-return))
-
- ;; weekday.
- (if (string-match-p "\\(\\w+\\)$" line)
- (setq line (substring line 0 -5))
- (cl-return))
-
- ;; size.
- (if (string-match "\\([0-9]+\\)$" line)
- (let ((length (- (max 10 (1+ (length (match-string 1 line)))))))
- (setq size (string-to-number (match-string 1 line)))
- (when (string-match
- "\\([ACDEHNORrsSTV]+\\)" (substring line length))
- (setq length (+ length (match-end 0))))
- (setq line (substring line 0 length)))
- (cl-return))
-
- ;; mode: ARCHIVE, COMPRESSED, DIRECTORY, ENCRYPTED, HIDDEN,
- ;; NONINDEXED, NORMAL, OFFLINE, READONLY,
- ;; REPARSE_POINT, SPARSE, SYSTEM, TEMPORARY, VOLID.
-
- (if (string-match "\\([ACDEHNORrsSTV]+\\)?$" line)
- (setq
- mode (or (match-string 1 line) "")
- mode (format
- "%s%s"
- (if (string-match-p "D" mode) "d" "-")
- (mapconcat
- (lambda (_x) "") " "
- (concat "r" (if (string-match-p "R" mode) "-" "w") "x")))
- line (substring line 0 -6))
- (cl-return))
-
- ;; localname.
- (if (string-match "^\\s-+\\(\\S-\\(.*\\S-\\)?\\)\\s-*$" line)
- (setq localname (match-string 1 line))
- (cl-return))))
-
- (when (and localname mode size)
- (setq mtime
- (if (and sec min hour day month year)
- (encode-time
- sec min hour day
- (cdr (assoc (downcase month) parse-time-months))
- year)
- tramp-time-dont-know))
- (list localname mode size mtime))))
-
-(defun tramp-smb-get-cifs-capabilities (vec)
- "Check, whether the SMB server supports POSIX commands."
- ;; When we are not logged in yet, we return nil.
- (if (process-live-p (tramp-get-connection-process vec))
- (with-tramp-connection-property
- (tramp-get-connection-process vec) "cifs-capabilities"
- (save-match-data
- (when (tramp-smb-send-command vec "posix")
- (with-current-buffer (tramp-get-connection-buffer vec)
- (goto-char (point-min))
- (when
- (re-search-forward "Server supports CIFS capabilities" nil t)
- (member
- "pathnames"
- (split-string
- (buffer-substring (point) (point-at-eol)) nil 'omit)))))))))
-
-(defun tramp-smb-get-stat-capability (vec)
- "Check, whether the SMB server supports the STAT command."
- ;; When we are not logged in yet, we return nil.
- (if (and (tramp-smb-get-share vec)
- (process-live-p (tramp-get-connection-process vec)))
- (with-tramp-connection-property
- (tramp-get-connection-process vec) "stat-capability"
- (tramp-smb-send-command vec "stat \"/\""))))
-
-
-;; Connection functions.
-
-(defun tramp-smb-send-command (vec command)
- "Send the COMMAND to connection VEC.
-Returns nil if there has been an error message from smbclient."
- (tramp-smb-maybe-open-connection vec)
- (tramp-message vec 6 "%s" command)
- (tramp-send-string vec command)
- (tramp-smb-wait-for-output vec))
-
-(defun tramp-smb-maybe-open-connection (vec &optional argument)
- "Maybe open a connection to HOST, log in as USER, using `tramp-smb-program'.
-Does not do anything if a connection is already open, but re-opens the
-connection if a previous connection has died for some reason.
-If ARGUMENT is non-nil, use it as argument for
-`tramp-smb-winexe-program', and suppress any checks."
- (let* ((share (tramp-smb-get-share vec))
- (buf (tramp-get-connection-buffer vec))
- (p (get-buffer-process buf)))
-
- ;; Check whether we still have the same smbclient version.
- ;; Otherwise, we must delete the connection cache, because
- ;; capabilities migh have changed.
- (unless (or argument (processp p))
- (let ((default-directory (tramp-compat-temporary-file-directory))
- (command (concat tramp-smb-program " -V")))
-
- (unless tramp-smb-version
- (unless (executable-find tramp-smb-program)
- (tramp-error
- vec 'file-error
- "Cannot find command %s in %s" tramp-smb-program exec-path))
- (setq tramp-smb-version (shell-command-to-string command))
- (tramp-message vec 6 command)
- (tramp-message vec 6 "\n%s" tramp-smb-version)
- (if (string-match "[ \t\n\r]+\\'" tramp-smb-version)
- (setq tramp-smb-version
- (replace-match "" nil nil tramp-smb-version))))
-
- (unless (string-equal
- tramp-smb-version
- (tramp-get-connection-property
- vec "smbclient-version" tramp-smb-version))
- (tramp-flush-directory-properties vec "")
- (tramp-flush-connection-properties vec))
-
- (tramp-set-connection-property
- vec "smbclient-version" tramp-smb-version)))
-
- ;; If too much time has passed since last command was sent, look
- ;; whether there has been an error message; maybe due to
- ;; connection timeout.
- (with-current-buffer buf
- (goto-char (point-min))
- ;; `seconds-to-time' can be removed once we get rid of Emacs 24.
- (when (and (time-less-p (seconds-to-time 60)
- (time-since
- (tramp-get-connection-property
- p "last-cmd-time" (seconds-to-time 0))))
- (process-live-p p)
- (re-search-forward tramp-smb-errors nil t))
- (delete-process p)
- (setq p nil)))
-
- ;; Check whether it is still the same share.
- (unless (and (process-live-p p)
- (or argument
- (string-equal
- share
- (tramp-get-connection-property p "smb-share" ""))))
-
- ;; During completion, don't reopen a new connection. We
- ;; check this for the process related to
- ;; `tramp-buffer-name'; otherwise `start-file-process'
- ;; wouldn't run ever when `non-essential' is non-nil.
- (when (and (tramp-completion-mode-p)
- (null (get-process (tramp-buffer-name vec))))
- (throw 'non-essential 'non-essential))
-
- (save-match-data
- ;; There might be unread output from checking for share names.
- (when buf (with-current-buffer buf (erase-buffer)))
- (when (and p (processp p)) (delete-process p))
-
- (let* ((user (tramp-file-name-user vec))
- (host (tramp-file-name-host vec))
- (domain (tramp-file-name-domain vec))
- (port (tramp-file-name-port vec))
- args)
-
- (cond
- (argument
- (setq args (list (concat "//" host))))
- (share
- (setq args (list (concat "//" host "/" share))))
- (t
- (setq args (list "-g" "-L" host ))))
-
- (if (not (zerop (length user)))
- (setq args (append args (list "-U" user)))
- (setq args (append args (list "-N"))))
-
- (when domain (setq args (append args (list "-W" domain))))
- (when port (setq args (append args (list "-p" port))))
- (when tramp-smb-conf
- (setq args (append args (list "-s" tramp-smb-conf))))
- (when argument
- (setq args (append args (list argument))))
-
- ;; OK, let's go.
- (with-tramp-progress-reporter
- vec 3
- (format "Opening connection for //%s%s/%s"
- (if (not (zerop (length user))) (concat user "@") "")
- host (or share ""))
-
- (let* ((coding-system-for-read nil)
- (process-connection-type tramp-process-connection-type)
- (p (let ((default-directory
- (tramp-compat-temporary-file-directory)))
- (apply #'start-process
- (tramp-get-connection-name vec)
- (tramp-get-connection-buffer vec)
- (if argument
- tramp-smb-winexe-program tramp-smb-program)
- args))))
-
- (tramp-message
- vec 6 "%s" (mapconcat #'identity (process-command p) " "))
- (process-put p 'vector vec)
- (process-put p 'adjust-window-size-function #'ignore)
- (set-process-query-on-exit-flag p nil)
-
- (condition-case err
- (let (tramp-message-show-message)
- ;; Play login scenario.
- (tramp-process-actions
- p vec nil
- (if (or argument share)
- tramp-smb-actions-with-share
- tramp-smb-actions-without-share))
-
- ;; Check server version.
- ;; FIXME: With recent smbclient versions, this
- ;; information isn't printed anymore.
- ;; (unless argument
- ;; (with-current-buffer (tramp-get-connection-buffer vec)
- ;; (goto-char (point-min))
- ;; (search-forward-regexp tramp-smb-server-version nil t)
- ;; (let ((smbserver-version (match-string 0)))
- ;; (unless
- ;; (string-equal
- ;; smbserver-version
- ;; (tramp-get-connection-property
- ;; vec "smbserver-version" smbserver-version))
- ;; (tramp-flush-directory-properties vec "")
- ;; (tramp-flush-connection-properties vec))
- ;; (tramp-set-connection-property
- ;; vec "smbserver-version" smbserver-version))))
-
- ;; Set chunksize to 1. smbclient reads its input
- ;; character by character; if we send the string
- ;; at once, it is read painfully slow.
- (tramp-set-connection-property p "smb-share" share)
- (tramp-set-connection-property p "chunksize" 1)
-
- ;; Set connection-local variables.
- (tramp-set-connection-local-variables vec)
-
- ;; Mark it as connected.
- (tramp-set-connection-property p "connected" t))
-
- ;; Check for the error reason. If it was due to wrong
- ;; password, reestablish the connection. We cannot
- ;; handle this in `tramp-process-actions', because
- ;; smbclient does not ask for the password, again.
- (error
- (with-current-buffer (tramp-get-connection-buffer vec)
- (goto-char (point-min))
- (if (and (bound-and-true-p auth-sources)
- (search-forward-regexp
- tramp-smb-wrong-passwd-regexp nil t))
- ;; Disable `auth-source' and `password-cache'.
- (let (auth-sources)
- (tramp-message
- vec 3 "Retry connection with new password")
- (tramp-cleanup-connection vec t)
- (tramp-smb-maybe-open-connection vec argument))
- ;; Propagate the error.
- (signal (car err) (cdr err)))))))))))))
-
-;; We don't use timeouts. If needed, the caller shall wrap around.
-(defun tramp-smb-wait-for-output (vec)
- "Wait for output from smbclient command.
-Removes smb prompt. Returns nil if an error message has appeared."
- (with-current-buffer (tramp-get-connection-buffer vec)
- (let ((p (get-buffer-process (current-buffer)))
- (inhibit-read-only t))
-
- ;; Read pending output.
- (while (not (re-search-forward tramp-smb-prompt nil t))
- (while (tramp-accept-process-output p 0)
- (goto-char (point-min))))
- (tramp-message vec 6 "\n%s" (buffer-string))
-
- ;; Remove prompt.
- (goto-char (point-min))
- (when (re-search-forward tramp-smb-prompt nil t)
- (goto-char (point-max))
- (re-search-backward tramp-smb-prompt nil t)
- (delete-region (point) (point-max)))
-
- ;; Return value is whether no error message has appeared.
- (goto-char (point-min))
- (not (re-search-forward tramp-smb-errors nil t)))))
-
-(defun tramp-smb-kill-winexe-function ()
- "Send SIGKILL to the winexe process."
- (ignore-errors
- (let ((p (get-buffer-process (current-buffer))))
- (when (process-live-p p)
- (signal-process (process-id p) 'SIGINT)))))
-
-(defun tramp-smb-call-winexe (vec)
- "Apply a remote command, if possible, using `tramp-smb-winexe-program'."
- ;; Check for program.
- (unless (executable-find tramp-smb-winexe-program)
- (tramp-error
- vec 'file-error "Cannot find program: %s" tramp-smb-winexe-program))
-
- ;; winexe does not supports ports.
- (when (tramp-file-name-port vec)
- (tramp-error vec 'file-error "Port not supported for remote processes"))
-
- (tramp-smb-maybe-open-connection
- vec
- (format
- "%s %s"
- tramp-smb-winexe-shell-command tramp-smb-winexe-shell-command-switch))
-
- (set (make-local-variable 'kill-buffer-hook)
- '(tramp-smb-kill-winexe-function))
-
- ;; Suppress "^M". Shouldn't we specify utf8?
- (set-process-coding-system (tramp-get-connection-process vec) 'raw-text-dos)
-
- ;; Set width to 128. This avoids mixing prompt and long error messages.
- (tramp-smb-send-command vec "$rawui = (Get-Host).UI.RawUI")
- (tramp-smb-send-command vec "$bufsize = $rawui.BufferSize")
- (tramp-smb-send-command vec "$winsize = $rawui.WindowSize")
- (tramp-smb-send-command vec "$bufsize.Width = 128")
- (tramp-smb-send-command vec "$winsize.Width = 128")
- (tramp-smb-send-command vec "$rawui.BufferSize = $bufsize")
- (tramp-smb-send-command vec "$rawui.WindowSize = $winsize"))
-
-(defun tramp-smb-shell-quote-argument (s)
- "Similar to `shell-quote-argument', but uses windows cmd syntax."
- (let ((system-type 'ms-dos))
- (tramp-unquote-shell-quote-argument s)))
-
-(add-hook 'tramp-unload-hook
- (lambda ()
- (unload-feature 'tramp-smb 'force)))
-
-(provide 'tramp-smb)
-
-;;; TODO:
-
-;; * Return more comprehensive file permission string.
-;;
-;; * Try to remove the inclusion of dummy "" directory. Seems to be at
-;; several places, especially in `tramp-smb-handle-insert-directory'.
-;;
-;; * Ignore case in file names.
-
-;;; tramp-smb.el ends here
diff --git a/lisp/tramp-sudoedit.el b/lisp/tramp-sudoedit.el
deleted file mode 100644
index 0d9e04d..0000000
--- a/lisp/tramp-sudoedit.el
+++ /dev/null
@@ -1,893 +0,0 @@
-;;; tramp-sudoedit.el --- Functions for accessing under root permissions -*-
lexical-binding:t -*-
-
-;; Copyright (C) 2018-2019 Free Software Foundation, Inc.
-
-;; Author: Michael Albinus <address@hidden>
-;; 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:
-
-;; The "sudoedit" Tramp method allows to edit a file as a different
-;; user on the local host. Contrary to the "sudo" method, all magic
-;; file name functions are implemented by single "sudo ..." commands.
-;; The purpose is to make editing such a file as secure as possible;
-;; there must be no session running in the Emacs background which
-;; could be attacked from inside Emacs.
-
-;; Consequently, external processes are not implemented.
-
-;;; Code:
-
-(require 'tramp)
-
-;;;###tramp-autoload
-(defconst tramp-sudoedit-method "sudoedit"
- "When this method name is used, call sudoedit for editing a file.")
-
-;;;###tramp-autoload
-(tramp--with-startup
- (add-to-list 'tramp-methods
- `(,tramp-sudoedit-method
- (tramp-sudo-login (("sudo") ("-u" "%u") ("-S") ("-H")
- ("-p" "Password:") ("--")))))
-
- (add-to-list 'tramp-default-user-alist '("\\`sudoedit\\'" nil "root"))
-
- (tramp-set-completion-function
- tramp-sudoedit-method tramp-completion-function-alist-su))
-
-(defconst tramp-sudoedit-sudo-actions
- '((tramp-password-prompt-regexp tramp-action-password)
- (tramp-wrong-passwd-regexp tramp-action-permission-denied)
- (tramp-process-alive-regexp tramp-sudoedit-action-sudo))
- "List of pattern/action pairs.
-This list is used for sudo calls.
-
-See `tramp-actions-before-shell' for more info.")
-
-;;;###tramp-autoload
-(defconst tramp-sudoedit-file-name-handler-alist
- '((access-file . tramp-handle-access-file)
- (add-name-to-file . tramp-sudoedit-handle-add-name-to-file)
- (byte-compiler-base-file-name . ignore)
- ;; `copy-directory' performed by default handler.
- (copy-file . tramp-sudoedit-handle-copy-file)
- (delete-directory . tramp-sudoedit-handle-delete-directory)
- (delete-file . tramp-sudoedit-handle-delete-file)
- (diff-latest-backup-file . ignore)
- ;; `directory-file-name' performed by default handler.
- (directory-files . tramp-handle-directory-files)
- (directory-files-and-attributes
- . tramp-handle-directory-files-and-attributes)
- (dired-compress-file . ignore)
- (dired-uncache . tramp-handle-dired-uncache)
- (exec-path . ignore)
- (expand-file-name . tramp-sudoedit-handle-expand-file-name)
- (file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
- (file-acl . tramp-sudoedit-handle-file-acl)
- (file-attributes . tramp-sudoedit-handle-file-attributes)
- (file-directory-p . tramp-handle-file-directory-p)
- (file-equal-p . tramp-handle-file-equal-p)
- (file-executable-p . tramp-sudoedit-handle-file-executable-p)
- (file-exists-p . tramp-sudoedit-handle-file-exists-p)
- (file-in-directory-p . tramp-handle-file-in-directory-p)
- (file-local-copy . tramp-handle-file-local-copy)
- (file-modes . tramp-handle-file-modes)
- (file-name-all-completions
- . tramp-sudoedit-handle-file-name-all-completions)
- (file-name-as-directory . tramp-handle-file-name-as-directory)
- (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p)
- (file-name-completion . tramp-handle-file-name-completion)
- (file-name-directory . tramp-handle-file-name-directory)
- (file-name-nondirectory . tramp-handle-file-name-nondirectory)
- ;; `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-sudoedit-handle-file-readable-p)
- (file-regular-p . tramp-handle-file-regular-p)
- (file-remote-p . tramp-handle-file-remote-p)
- (file-selinux-context . tramp-sudoedit-handle-file-selinux-context)
- (file-symlink-p . tramp-handle-file-symlink-p)
- (file-system-info . tramp-sudoedit-handle-file-system-info)
- (file-truename . tramp-sudoedit-handle-file-truename)
- (file-writable-p . tramp-sudoedit-handle-file-writable-p)
- (find-backup-file-name . tramp-handle-find-backup-file-name)
- ;; `get-file-buffer' performed by default handler.
- (insert-directory . tramp-handle-insert-directory)
- (insert-file-contents . tramp-handle-insert-file-contents)
- (load . tramp-handle-load)
- (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
- (make-directory . tramp-sudoedit-handle-make-directory)
- (make-directory-internal . ignore)
- (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
- (make-process . ignore)
- (make-symbolic-link . tramp-sudoedit-handle-make-symbolic-link)
- (process-file . ignore)
- (rename-file . tramp-sudoedit-handle-rename-file)
- (set-file-acl . tramp-sudoedit-handle-set-file-acl)
- (set-file-modes . tramp-sudoedit-handle-set-file-modes)
- (set-file-selinux-context . tramp-sudoedit-handle-set-file-selinux-context)
- (set-file-times . tramp-sudoedit-handle-set-file-times)
- (set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
- (shell-command . ignore)
- (start-file-process . ignore)
- (substitute-in-file-name . tramp-handle-substitute-in-file-name)
- (temporary-file-directory . tramp-handle-temporary-file-directory)
- (tramp-set-file-uid-gid . tramp-sudoedit-handle-set-file-uid-gid)
- (unhandled-file-name-directory . ignore)
- (vc-registered . ignore)
- (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
- (write-region . tramp-sudoedit-handle-write-region))
- "Alist of handler functions for Tramp SUDOEDIT method.")
-
-;; It must be a `defsubst' in order to push the whole code into
-;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
-;;;###tramp-autoload
-(defsubst tramp-sudoedit-file-name-p (filename)
- "Check if it's a filename for SUDOEDIT."
- (and (tramp-tramp-file-p filename)
- (string= (tramp-file-name-method (tramp-dissect-file-name filename))
- tramp-sudoedit-method)))
-
-;;;###tramp-autoload
-(defun tramp-sudoedit-file-name-handler (operation &rest args)
- "Invoke the SUDOEDIT handler for OPERATION.
-First arg specifies the OPERATION, second arg is a list of arguments to
-pass to the OPERATION."
- (let ((fn (assoc operation tramp-sudoedit-file-name-handler-alist)))
- (if fn
- (save-match-data (apply (cdr fn) args))
- (tramp-run-real-handler operation args))))
-
-;;;###tramp-autoload
-(tramp--with-startup
- (tramp-register-foreign-file-name-handler
- #'tramp-sudoedit-file-name-p #'tramp-sudoedit-file-name-handler))
-
-
-;; File name primitives.
-
-(defun tramp-sudoedit-handle-add-name-to-file
- (filename newname &optional ok-if-already-exists)
- "Like `add-name-to-file' for Tramp files."
- (unless (tramp-equal-remote filename newname)
- (with-parsed-tramp-file-name
- (if (tramp-tramp-file-p filename) filename newname) nil
- (tramp-error
- v 'file-error
- "add-name-to-file: %s"
- "only implemented for same method, same user, same host")))
- (with-parsed-tramp-file-name filename v1
- (with-parsed-tramp-file-name newname v2
- ;; Do the 'confirm if exists' thing.
- (when (file-exists-p newname)
- ;; What to do?
- (if (or (null ok-if-already-exists) ; not allowed to exist
- (and (numberp ok-if-already-exists)
- (not (yes-or-no-p
- (format
- "File %s already exists; make it a link anyway? "
- v2-localname)))))
- (tramp-error v2 'file-already-exists newname)
- (delete-file newname)))
- (tramp-flush-file-properties v2 (file-name-directory v2-localname))
- (tramp-flush-file-properties v2 v2-localname)
- (unless
- (tramp-sudoedit-send-command
- v1 "ln"
- (tramp-compat-file-name-unquote v1-localname)
- (tramp-compat-file-name-unquote v2-localname))
- (tramp-error
- v1 'file-error
- "error with add-name-to-file, see buffer `%s' for details"
- (buffer-name))))))
-
-(defun tramp-sudoedit-do-copy-or-rename-file
- (op filename newname &optional ok-if-already-exists keep-date
- preserve-uid-gid preserve-extended-attributes)
- "Copy or rename a remote file.
-OP must be `copy' or `rename' and indicates the operation to perform.
-FILENAME specifies the file to copy or rename, NEWNAME is the name of
-the new file (for copy) or the new name of the file (for rename).
-OK-IF-ALREADY-EXISTS means don't barf if NEWNAME exists already.
-KEEP-DATE means to make sure that NEWNAME has the same timestamp
-as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep
-the uid and gid if both files are on the same host.
-PRESERVE-EXTENDED-ATTRIBUTES activates selinux and acl commands.
-
-This function is invoked by `tramp-sudoedit-handle-copy-file' and
-`tramp-sudoedit-handle-rename-file'. It is an error if OP is
-neither of `copy' and `rename'. FILENAME and NEWNAME must be
-absolute file names."
- (unless (memq op '(copy rename))
- (error "Unknown operation `%s', must be `copy' or `rename'" op))
-
- (setq filename (file-truename filename))
- (if (file-directory-p filename)
- (progn
- (copy-directory filename newname keep-date t)
- (when (eq op 'rename) (delete-directory filename 'recursive)))
-
- (let ((t1 (tramp-sudoedit-file-name-p filename))
- (t2 (tramp-sudoedit-file-name-p newname))
- (file-times (tramp-compat-file-attribute-modification-time
- (file-attributes filename)))
- (file-modes (tramp-default-file-modes filename))
- ;; `file-extended-attributes' exists since Emacs 24.4.
- (attributes (and preserve-extended-attributes
- (apply #'file-extended-attributes (list filename))))
- (sudoedit-operation
- (cond
- ((and (eq op 'copy) preserve-uid-gid) '("cp" "-f" "-p"))
- ((eq op 'copy) '("cp" "-f"))
- ((eq op 'rename) '("mv" "-f"))))
- (msg-operation (if (eq op 'copy) "Copying" "Renaming")))
-
- (with-parsed-tramp-file-name (if t1 filename newname) nil
- (when (and (not ok-if-already-exists) (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
-
- (if (or (and (file-remote-p filename) (not t1))
- (and (file-remote-p newname) (not t2)))
- ;; We cannot copy or rename directly.
- (let ((tmpfile (tramp-compat-make-temp-file filename)))
- (if (eq op 'copy)
- (copy-file filename tmpfile t)
- (rename-file filename tmpfile t))
- (rename-file tmpfile newname ok-if-already-exists))
-
- ;; Direct action.
- (with-tramp-progress-reporter
- v 0 (format "%s %s to %s" msg-operation filename newname)
- (unless (tramp-sudoedit-send-command
- v sudoedit-operation
- (tramp-compat-file-name-unquote
- (tramp-compat-file-local-name filename))
- (tramp-compat-file-name-unquote
- (tramp-compat-file-local-name newname)))
- (tramp-error
- v 'file-error
- "Error %s `%s' `%s'" msg-operation filename newname))))
-
- ;; When `newname' is local, we must change the ownership to
- ;; the local user.
- (unless (file-remote-p newname)
- (tramp-set-file-uid-gid
- (concat (file-remote-p filename) newname)
- (tramp-get-local-uid 'integer)
- (tramp-get-local-gid 'integer)))
-
- ;; Set the time and mode. Mask possible errors.
- (when keep-date
- (ignore-errors
- (set-file-times newname file-times)
- (set-file-modes newname file-modes)))
-
- ;; Handle `preserve-extended-attributes'. We ignore possible
- ;; errors, because ACL strings could be incompatible.
- ;; `set-file-extended-attributes' exists since Emacs 24.4.
- (when attributes
- (ignore-errors
- (apply #'set-file-extended-attributes (list newname attributes))))
-
- (when (and t1 (eq op 'rename))
- (with-parsed-tramp-file-name filename v1
- (tramp-flush-file-properties
- v1 (file-name-directory v1-localname))
- (tramp-flush-file-properties v1 v1-localname)))
-
- (when t2
- (with-parsed-tramp-file-name newname v2
- (tramp-flush-file-properties
- v2 (file-name-directory v2-localname))
- (tramp-flush-file-properties v2 v2-localname)))))))
-
-(defun tramp-sudoedit-handle-copy-file
- (filename newname &optional ok-if-already-exists keep-date
- preserve-uid-gid preserve-extended-attributes)
- "Like `copy-file' for Tramp files."
- (setq filename (expand-file-name filename))
- (setq newname (expand-file-name newname))
- ;; At least one file a Tramp file?
- (if (or (tramp-tramp-file-p filename)
- (tramp-tramp-file-p newname))
- (tramp-sudoedit-do-copy-or-rename-file
- 'copy filename newname ok-if-already-exists keep-date
- preserve-uid-gid preserve-extended-attributes)
- (tramp-run-real-handler
- #'copy-file
- (list filename newname ok-if-already-exists keep-date
- preserve-uid-gid preserve-extended-attributes))))
-
-(defun tramp-sudoedit-handle-delete-directory
- (directory &optional recursive trash)
- "Like `delete-directory' for Tramp files."
- (setq directory (expand-file-name directory))
- (with-parsed-tramp-file-name directory nil
- (tramp-flush-file-properties v (file-name-directory localname))
- (tramp-flush-directory-properties v localname)
- (unless
- (tramp-sudoedit-send-command
- v (or (and trash "trash")
- (if recursive '("rm" "-rf") "rmdir"))
- (tramp-compat-file-name-unquote localname))
- (tramp-error v 'file-error "Couldn't delete %s" directory))))
-
-(defun tramp-sudoedit-handle-delete-file (filename &optional trash)
- "Like `delete-file' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v (file-name-directory localname))
- (tramp-flush-file-properties v localname)
- (unless
- (tramp-sudoedit-send-command
- v (if (and trash delete-by-moving-to-trash) "trash" "rm")
- (tramp-compat-file-name-unquote localname))
- ;; Propagate the error.
- (with-current-buffer (tramp-get-connection-buffer v)
- (goto-char (point-min))
- (tramp-error-with-buffer
- nil v 'file-error "Couldn't delete %s" filename)))))
-
-(defun tramp-sudoedit-handle-expand-file-name (name &optional dir)
- "Like `expand-file-name' for Tramp files.
-If the localname part of the given file name starts with \"/../\" then
-the result will be a local, non-Tramp, file name."
- ;; If DIR is not given, use `default-directory' or "/".
- (setq dir (or dir default-directory "/"))
- ;; Handle empty NAME.
- (when (zerop (length name)) (setq name "."))
- ;; Unless NAME is absolute, concat DIR and NAME.
- (unless (file-name-absolute-p name)
- (setq name (concat (file-name-as-directory dir) name)))
- (with-parsed-tramp-file-name name nil
- ;; Tilde expansion if necessary. We cannot accept "~/", because
- ;; under sudo "~/" is expanded to the local user home directory
- ;; but to the root home directory.
- (when (zerop (length localname))
- (setq localname "~"))
- (unless (file-name-absolute-p localname)
- (setq localname (format "~%s/%s" user localname)))
- (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
- (let ((uname (match-string 1 localname))
- (fname (match-string 2 localname)))
- (when (string-equal uname "~")
- (setq uname (concat uname user)))
- (setq localname (concat uname fname))))
- ;; Do normal `expand-file-name' (this does "~user/", "/./" and "/../").
- (tramp-make-tramp-file-name v (expand-file-name localname))))
-
-(defun tramp-sudoedit-remote-acl-p (vec)
- "Check, whether ACL is enabled on the remote host."
- (with-tramp-connection-property (tramp-get-connection-process vec) "acl-p"
- (zerop (tramp-call-process vec "getfacl" nil nil nil "/"))))
-
-(defun tramp-sudoedit-handle-file-acl (filename)
- "Like `file-acl' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (with-tramp-file-property v localname "file-acl"
- (let ((result (and (tramp-sudoedit-remote-acl-p v)
- (tramp-sudoedit-send-command-string
- v "getfacl" "-acp"
- (tramp-compat-file-name-unquote localname)))))
- ;; The acl string must have a trailing \n, which is not
- ;; provided by `tramp-sudoedit-send-command-string'. Add it.
- (and (stringp result) (concat result "\n"))))))
-
-(defun tramp-sudoedit-handle-file-attributes (filename &optional id-format)
- "Like `file-attributes' for Tramp files."
- (unless id-format (setq id-format 'integer))
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (with-tramp-file-property
- v localname (format "file-attributes-%s" id-format)
- (tramp-message v 5 "file attributes: %s" localname)
- (ignore-errors
- (tramp-convert-file-attributes
- v
- (tramp-sudoedit-send-command-and-read
- v "env" "QUOTING_STYLE=locale" "stat" "-c"
- (format
- ;; Apostrophes in the stat output are masked as
- ;; `tramp-stat-marker', in order to make a proper shell
- ;; escape of them in file names.
- "((%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)"
- tramp-stat-marker tramp-stat-marker
- (if (eq id-format 'integer)
- "%u"
- (eval-when-compile
- (concat tramp-stat-marker "%U" tramp-stat-marker)))
- (if (eq id-format 'integer)
- "%g"
- (eval-when-compile
- (concat tramp-stat-marker "%G" tramp-stat-marker)))
- tramp-stat-marker tramp-stat-marker)
- (tramp-compat-file-name-unquote localname)))))))
-
-(defun tramp-sudoedit-handle-file-executable-p (filename)
- "Like `file-executable-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (with-tramp-file-property v localname "file-executable-p"
- (tramp-sudoedit-send-command
- v "test" "-x" (tramp-compat-file-name-unquote localname)))))
-
-(defun tramp-sudoedit-handle-file-exists-p (filename)
- "Like `file-exists-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (with-tramp-file-property v localname "file-exists-p"
- (tramp-sudoedit-send-command
- v "test" "-e" (tramp-compat-file-name-unquote localname)))))
-
-(defun tramp-sudoedit-handle-file-name-all-completions (filename directory)
- "Like `file-name-all-completions' for Tramp files."
- (all-completions
- filename
- (with-parsed-tramp-file-name (expand-file-name directory) nil
- (with-tramp-file-property v localname "file-name-all-completions"
- (tramp-sudoedit-send-command
- v "ls" "-a1" "--quoting-style=literal" "--show-control-chars"
- (if (zerop (length localname))
- "" (tramp-compat-file-name-unquote localname)))
- (mapcar
- (lambda (f)
- (if (file-directory-p (expand-file-name f directory))
- (file-name-as-directory f)
- f))
- (with-current-buffer (tramp-get-connection-buffer v)
- (delq
- nil
- (mapcar
- (lambda (l) (and (not (string-match-p "^[[:space:]]*$" l)) l))
- (split-string (buffer-string) "\n" 'omit)))))))))
-
-(defun tramp-sudoedit-handle-file-readable-p (filename)
- "Like `file-readable-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (with-tramp-file-property v localname "file-readable-p"
- (tramp-sudoedit-send-command
- v "test" "-r" (tramp-compat-file-name-unquote localname)))))
-
-(defun tramp-sudoedit-handle-set-file-modes (filename mode)
- "Like `set-file-modes' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v (file-name-directory localname))
- (tramp-flush-file-properties v localname)
- (unless (tramp-sudoedit-send-command
- v "chmod" (format "%o" mode)
- (tramp-compat-file-name-unquote localname))
- (tramp-error
- v 'file-error "Error while changing file's mode %s" filename))))
-
-(defun tramp-sudoedit-remote-selinux-p (vec)
- "Check, whether SELINUX is enabled on the remote host."
- (with-tramp-connection-property (tramp-get-connection-process vec)
"selinux-p"
- (zerop (tramp-call-process vec "selinuxenabled"))))
-
-(defun tramp-sudoedit-handle-file-selinux-context (filename)
- "Like `file-selinux-context' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (with-tramp-file-property v localname "file-selinux-context"
- (let ((context '(nil nil nil nil))
- (regexp (eval-when-compile
- (concat "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\):"
- "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\)"))))
- (when (and (tramp-sudoedit-remote-selinux-p v)
- (tramp-sudoedit-send-command
- v "ls" "-d" "-Z"
- (tramp-compat-file-name-unquote localname)))
- (with-current-buffer (tramp-get-connection-buffer v)
- (goto-char (point-min))
- (when (re-search-forward regexp (point-at-eol) t)
- (setq context (list (match-string 1) (match-string 2)
- (match-string 3) (match-string 4))))))
- ;; Return the context.
- context))))
-
-(defun tramp-sudoedit-handle-file-system-info (filename)
- "Like `file-system-info' for Tramp files."
- (ignore-errors
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (tramp-message v 5 "file system info: %s" localname)
- (when (tramp-sudoedit-send-command
- v "df" "--block-size=1" "--output=size,used,avail"
- (tramp-compat-file-name-unquote localname)))
- (with-current-buffer (tramp-get-connection-buffer v)
- (goto-char (point-min))
- (forward-line)
- (when (looking-at
- (eval-when-compile
- (concat "[[:space:]]*\\([[:digit:]]+\\)"
- "[[:space:]]+\\([[:digit:]]+\\)"
- "[[:space:]]+\\([[:digit:]]+\\)")))
- (list (string-to-number (match-string 1))
- ;; The second value is the used size. We need the
- ;; free size.
- (- (string-to-number (match-string 1))
- (string-to-number (match-string 2)))
- (string-to-number (match-string 3))))))))
-
-(defun tramp-sudoedit-handle-set-file-times (filename &optional time)
- "Like `set-file-times' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v (file-name-directory localname))
- (tramp-flush-file-properties v localname)
- (let ((time
- (if (or (null time)
- (tramp-compat-time-equal-p time tramp-time-doesnt-exist)
- (tramp-compat-time-equal-p time tramp-time-dont-know))
- (current-time)
- time)))
- (tramp-sudoedit-send-command
- v "env" "TZ=UTC" "touch" "-t"
- (format-time-string "%Y%m%d%H%M.%S" time t)
- (tramp-compat-file-name-unquote localname)))))
-
-(defun tramp-sudoedit-handle-file-truename (filename)
- "Like `file-truename' for Tramp files."
- ;; Preserve trailing "/".
- (funcall
- (if (string-equal (file-name-nondirectory filename) "")
- #'file-name-as-directory #'identity)
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (tramp-make-tramp-file-name
- v
- (with-tramp-file-property v localname "file-truename"
- (let ((quoted (tramp-compat-file-name-quoted-p localname))
- (localname (tramp-compat-file-name-unquote localname))
- result)
- (tramp-message v 4 "Finding true name for `%s'" filename)
- (setq result (tramp-sudoedit-send-command-string
- v "readlink" "--canonicalize-missing" localname))
- ;; Detect cycle.
- (when (and (file-symlink-p filename)
- (string-equal result localname))
- (tramp-error
- v 'file-error
- "Apparent cycle of symbolic links for %s" filename))
- ;; If the resulting localname looks remote, we must quote it
- ;; for security reasons.
- (when (or quoted (file-remote-p result))
- (let (file-name-handler-alist)
- (setq result (tramp-compat-file-name-quote result))))
- (tramp-message v 4 "True name of `%s' is `%s'" localname result)
- result))
- 'nohop))))
-
-(defun tramp-sudoedit-handle-file-writable-p (filename)
- "Like `file-writable-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (with-tramp-file-property v localname "file-writable-p"
- (if (file-exists-p filename)
- (tramp-sudoedit-send-command
- v "test" "-w" (tramp-compat-file-name-unquote localname))
- (let ((dir (file-name-directory filename)))
- (and (file-exists-p dir)
- (file-writable-p dir)))))))
-
-(defun tramp-sudoedit-handle-make-directory (dir &optional parents)
- "Like `make-directory' for Tramp files."
- (setq dir (expand-file-name dir))
- (with-parsed-tramp-file-name dir nil
- ;; When PARENTS is non-nil, DIR could be a chain of non-existent
- ;; directories a/b/c/... Instead of checking, we simply flush the
- ;; whole cache.
- (tramp-flush-directory-properties
- v (if parents "/" (file-name-directory localname)))
- (unless (tramp-sudoedit-send-command
- v (if parents '("mkdir" "-p") "mkdir")
- (tramp-compat-file-name-unquote localname))
- (tramp-error v 'file-error "Couldn't make directory %s" dir))))
-
-(defun tramp-sudoedit-handle-make-symbolic-link
- (target linkname &optional ok-if-already-exists)
- "Like `make-symbolic-link' for Tramp files.
-If TARGET is a non-Tramp file, it is used verbatim as the target
-of the symlink. If TARGET is a Tramp file, only the localname
-component is used as the target of the symlink."
- (if (not (tramp-tramp-file-p (expand-file-name linkname)))
- (tramp-run-real-handler
- #'make-symbolic-link (list target linkname ok-if-already-exists))
-
- (with-parsed-tramp-file-name linkname nil
- ;; If TARGET is a Tramp name, use just the localname component.
- (when (and (tramp-tramp-file-p target)
- (tramp-file-name-equal-p v (tramp-dissect-file-name target)))
- (setq target
- (tramp-file-name-localname
- (tramp-dissect-file-name (expand-file-name target)))))
-
- ;; If TARGET is still remote, quote it.
- (if (tramp-tramp-file-p target)
- (make-symbolic-link
- (let (file-name-handler-alist) (tramp-compat-file-name-quote target))
- linkname ok-if-already-exists)
-
- ;; Do the 'confirm if exists' thing.
- (when (file-exists-p linkname)
- ;; What to do?
- (if (or (null ok-if-already-exists) ; not allowed to exist
- (and (numberp ok-if-already-exists)
- (not
- (yes-or-no-p
- (format
- "File %s already exists; make it a link anyway? "
- localname)))))
- (tramp-error v 'file-already-exists localname)
- (delete-file linkname)))
-
- (tramp-flush-file-properties v (file-name-directory localname))
- (tramp-flush-file-properties v localname)
- (tramp-sudoedit-send-command
- v "ln" "-sf"
- (tramp-compat-file-name-unquote target)
- (tramp-compat-file-name-unquote localname))))))
-
-(defun tramp-sudoedit-handle-rename-file
- (filename newname &optional ok-if-already-exists)
- "Like `rename-file' for Tramp files."
- (setq filename (expand-file-name filename))
- (setq newname (expand-file-name newname))
- ;; At least one file a Tramp file?
- (if (or (tramp-tramp-file-p filename)
- (tramp-tramp-file-p newname))
- (tramp-sudoedit-do-copy-or-rename-file
- 'rename filename newname ok-if-already-exists
- 'keep-date 'preserve-uid-gid)
- (tramp-run-real-handler
- 'rename-file (list filename newname ok-if-already-exists))))
-
-(defun tramp-sudoedit-handle-set-file-acl (filename acl-string)
- "Like `set-file-acl' for Tramp files."
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (when (and (stringp acl-string) (tramp-sudoedit-remote-acl-p v))
- ;; Massage `acl-string'.
- (setq acl-string
- (mapconcat #'identity (split-string acl-string "\n" 'omit) ","))
- (prog1
- (tramp-sudoedit-send-command
- v "setfacl" "-m"
- acl-string (tramp-compat-file-name-unquote localname))
- (tramp-flush-file-property v localname "file-acl")))))
-
-(defun tramp-sudoedit-handle-set-file-selinux-context (filename context)
- "Like `set-file-selinux-context' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (when (and (consp context)
- (tramp-sudoedit-remote-selinux-p v))
- (let ((user (and (stringp (nth 0 context)) (nth 0 context)))
- (role (and (stringp (nth 1 context)) (nth 1 context)))
- (type (and (stringp (nth 2 context)) (nth 2 context)))
- (range (and (stringp (nth 3 context)) (nth 3 context))))
- (when (tramp-sudoedit-send-command
- v "chcon"
- (when user (format "--user=%s" user))
- (when role (format "--role=%s" role))
- (when type (format "--type=%s" type))
- (when range (format "--range=%s" range))
- (tramp-compat-file-name-unquote localname))
- (if (and user role type range)
- (tramp-set-file-property
- v localname "file-selinux-context" context)
- (tramp-flush-file-property v localname "file-selinux-context"))
- t)))))
-
-(defun tramp-sudoedit-get-remote-uid (vec id-format)
- "The uid of the remote connection VEC, in ID-FORMAT.
-ID-FORMAT valid values are `string' and `integer'."
- (with-tramp-connection-property vec (format "uid-%s" id-format)
- (if (equal id-format 'integer)
- (tramp-sudoedit-send-command-and-read vec "id" "-u")
- (tramp-sudoedit-send-command-string vec "id" "-un"))))
-
-(defun tramp-sudoedit-get-remote-gid (vec id-format)
- "The gid of the remote connection VEC, in ID-FORMAT.
-ID-FORMAT valid values are `string' and `integer'."
- (with-tramp-connection-property vec (format "gid-%s" id-format)
- (if (equal id-format 'integer)
- (tramp-sudoedit-send-command-and-read vec "id" "-g")
- (tramp-sudoedit-send-command-string vec "id" "-gn"))))
-
-(defun tramp-sudoedit-handle-set-file-uid-gid (filename &optional uid gid)
- "Like `tramp-set-file-uid-gid' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (tramp-sudoedit-send-command
- v "chown"
- (format "%d:%d"
- (or uid (tramp-sudoedit-get-remote-uid v 'integer))
- (or gid (tramp-sudoedit-get-remote-gid v 'integer)))
- (tramp-compat-file-name-unquote
- (tramp-compat-file-local-name filename)))))
-
-(defun tramp-sudoedit-handle-write-region
- (start end filename &optional append visit lockname mustbenew)
- "Like `write-region' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (let ((uid (or (tramp-compat-file-attribute-user-id
- (file-attributes filename 'integer))
- (tramp-sudoedit-get-remote-uid v 'integer)))
- (gid (or (tramp-compat-file-attribute-group-id
- (file-attributes filename 'integer))
- (tramp-sudoedit-get-remote-gid v 'integer)))
- (modes (tramp-default-file-modes filename)))
- (prog1
- (tramp-handle-write-region
- start end filename append visit lockname mustbenew)
-
- ;; Set the ownership and modes. This is not performed in
- ;; `tramp-handle-write-region'.
- (unless (and (= (tramp-compat-file-attribute-user-id
- (file-attributes filename 'integer))
- uid)
- (= (tramp-compat-file-attribute-group-id
- (file-attributes filename 'integer))
- gid))
- (tramp-set-file-uid-gid filename uid gid))
- (set-file-modes filename modes)))))
-
-
-;; Internal functions.
-
-;; Used in `tramp-sudoedit-sudo-actions'.
-(defun tramp-sudoedit-action-sudo (proc vec)
- "Check, whether a sudo process has finished.
-Remove unneeded output."
- ;; There might be pending output for the exit status.
- (unless (process-live-p proc)
- (while (tramp-accept-process-output proc 0))
- ;; Delete narrowed region, it would be in the way reading a Lisp form.
- (goto-char (point-min))
- (widen)
- (delete-region (point-min) (point))
- ;; Delete empty lines.
- (goto-char (point-min))
- (while (and (not (eobp)) (= (point) (point-at-eol)))
- (forward-line))
- (delete-region (point-min) (point))
- (tramp-message vec 3 "Process has finished.")
- (throw 'tramp-action 'ok)))
-
-(defun tramp-sudoedit-maybe-open-connection (vec)
- "Maybe open a connection VEC.
-Does not do anything if a connection is already open, but re-opens the
-connection if a previous connection has died for some reason."
- ;; We need a process bound to the connection buffer. Therefore, we
- ;; create a dummy process. Maybe there is a better solution?
- (unless (tramp-get-connection-process vec)
-
- ;; During completion, don't reopen a new connection. We check
- ;; this for the process related to `tramp-buffer-name'; otherwise
- ;; `start-file-process' wouldn't run ever when `non-essential' is
- ;; non-nil.
- (when (and (tramp-completion-mode-p)
- (null (get-process (tramp-buffer-name vec))))
- (throw 'non-essential 'non-essential))
-
- (let ((p (make-network-process
- :name (tramp-buffer-name vec)
- :buffer (tramp-get-connection-buffer vec)
- :server t :host 'local :service t :noquery t)))
- (process-put p 'vector vec)
- (set-process-query-on-exit-flag p nil)
-
- ;; Set connection-local variables.
- (tramp-set-connection-local-variables vec)
-
- ;; Mark it as connected.
- (tramp-set-connection-property p "connected" t))
-
- ;; In `tramp-check-cached-permissions', the connection properties
- ;; "{uid,gid}-{integer,string}" are used. We set them to proper values.
- (tramp-sudoedit-get-remote-uid vec 'integer)
- (tramp-sudoedit-get-remote-gid vec 'integer)
- (tramp-sudoedit-get-remote-uid vec 'string)
- (tramp-sudoedit-get-remote-gid vec 'string)))
-
-(defun tramp-sudoedit-send-command (vec &rest args)
- "Send commands ARGS to connection VEC.
-If an element of ARGS is a list, it will be flattened. If an
-element of ARGS is nil, it will be deleted.
-Erases temporary buffer before sending the command. Returns nil
-in case of error, t otherwise."
- (tramp-sudoedit-maybe-open-connection vec)
- (with-current-buffer (tramp-get-connection-buffer vec)
- (erase-buffer)
- (let* ((login (tramp-get-method-parameter vec 'tramp-sudo-login))
- (host (or (tramp-file-name-host vec) ""))
- (user (or (tramp-file-name-user vec) ""))
- (spec (format-spec-make ?h host ?u user))
- (args (append
- (tramp-compat-flatten-tree
- (mapcar
- (lambda (x)
- (setq x (mapcar (lambda (y) (format-spec y spec)) x))
- (unless (member "" x) x))
- login))
- (tramp-compat-flatten-tree (delq nil args))))
- (delete-exited-processes t)
- (process-connection-type tramp-process-connection-type)
- (p (apply #'start-process
- (tramp-get-connection-name vec) (current-buffer) args))
- ;; We suppress the messages `Waiting for prompts from remote shell'.
- (tramp-verbose (if (= tramp-verbose 3) 2 tramp-verbose))
- ;; We do not want to save the password.
- auth-source-save-behavior)
- (tramp-message vec 6 "%s" (mapconcat #'identity (process-command p) " "))
- ;; Avoid process status message in output buffer.
- (set-process-sentinel p #'ignore)
- (process-put p 'vector vec)
- (process-put p 'adjust-window-size-function #'ignore)
- (set-process-query-on-exit-flag p nil)
- (tramp-process-actions p vec nil tramp-sudoedit-sudo-actions)
- (tramp-message vec 6 "%s\n%s" (process-exit-status p) (buffer-string))
- (prog1
- (zerop (process-exit-status p))
- (delete-process p)))))
-
-(defun tramp-sudoedit-send-command-and-read (vec &rest args)
- "Run command ARGS and return the output, which must be a Lisp expression.
-In case there is no valid Lisp expression, it raises an error."
- (when (apply #'tramp-sudoedit-send-command vec args)
- (with-current-buffer (tramp-get-connection-buffer vec)
- ;; Replace stat marker.
- (goto-char (point-min))
- (when (search-forward tramp-stat-marker nil t)
- (goto-char (point-min))
- (while (search-forward "\"" nil t)
- (replace-match "\\\"" nil 'literal))
- (goto-char (point-min))
- (while (search-forward tramp-stat-marker nil t)
- (replace-match "\"")))
- ;; Read the expression.
- (tramp-message vec 6 "\n%s" (buffer-string))
- (goto-char (point-min))
- (condition-case nil
- (prog1 (read (current-buffer))
- ;; Error handling.
- (when (re-search-forward "\\S-" (point-at-eol) t)
- (error nil)))
- (error (tramp-error
- vec 'file-error
- "`%s' does not return a valid Lisp expression: `%s'"
- (car args) (buffer-string)))))))
-
-(defun tramp-sudoedit-send-command-string (vec &rest args)
- "Run command ARGS and return the output as astring."
- (when (apply #'tramp-sudoedit-send-command vec args)
- (with-current-buffer (tramp-get-connection-buffer vec)
- (tramp-message vec 6 "\n%s" (buffer-string))
- (goto-char (point-max))
- ;(delete-blank-lines)
- (while (looking-back "[ \t\n]+" nil 'greedy)
- (delete-region (match-beginning 0) (point)))
- (when (> (point-max) (point-min))
- (substring-no-properties (buffer-string))))))
-
-(add-hook 'tramp-unload-hook
- (lambda ()
- (unload-feature 'tramp-sudoedit 'force)))
-
-(provide 'tramp-sudoedit)
-
-;;; TODO:
-
-;; * Fix *-selinux functions. Likely, this is due to wrong file
-;; ownership after `write-region' and/or `copy-file'.
-
-;;; tramp-sudoedit.el ends here
diff --git a/lisp/tramp-uu.el b/lisp/tramp-uu.el
deleted file mode 100644
index c12a4eb..0000000
--- a/lisp/tramp-uu.el
+++ /dev/null
@@ -1,101 +0,0 @@
-;;; tramp-uu.el --- uuencode in Lisp -*- lexical-binding:t -*-
-
-;; Copyright (C) 2002-2019 Free Software Foundation, Inc.
-
-;; Author: Kai Großjohann <address@hidden>
-;; Maintainer: Michael Albinus <address@hidden>
-;; Keywords: comm, terminals
-;; 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:
-
-;; An implementation of "uuencode" in Lisp. Uses the function
-;; base64-encode-region which is built-in to modern Emacsen.
-
-;;; Code:
-
-(defconst tramp-uu-b64-alphabet
- "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
- "Mapping from base64-encoded character to the byte it represents.")
-
-(defconst tramp-uu-b64-char-to-byte
- (let ((i 0))
- (mapcar (lambda (c)
- (prog1
- (cons c i)
- (setq i (1+ i))))
- tramp-uu-b64-alphabet))
- "Alist of mapping from base64 character to its byte.")
-
-(defun tramp-uu-byte-to-uu-char (byte)
- "Return the character encoding BYTE."
- (if (zerop byte) ?` (+ byte 32)))
-
-(defun tramp-uu-b64-char-to-byte (char)
- "Return the byte that is encoded as CHAR."
- (cdr (assq char tramp-uu-b64-char-to-byte)))
-
-;;;###tramp-autoload
-(defun tramp-uuencode-region (beg end)
- "UU-encode the region between BEG and END."
- ;; First we base64 encode the region, then we transmogrify that into
- ;; uu encoding.
- (let ((len (base64-encode-region beg end t))
- i c)
- (save-excursion
- (goto-char beg)
- (setq i 0)
- (while (< i len)
- (setq c (char-after (point)))
- (delete-char 1)
- (if (equal c ?=)
- ;; "=" means padding. Insert "`" instead. Not counted for length.
- (progn (insert "`") (setq len (1- len)))
- (insert (tramp-uu-byte-to-uu-char (tramp-uu-b64-char-to-byte c)))
- (setq i (1+ i)))
- ;; Every 60 characters, add "M" at beginning of line (as
- ;; length byte) and insert a newline.
- (when (zerop (% i 60))
- (save-excursion
- (beginning-of-line)
- (insert (char-to-string (+ 32 (/ (* 3 60) 4)))))
- (insert "\n")))
- ;; If there is something leftover, we compute the length byte
- ;; for that stuff and insert it and a trailing newline.
- (unless (zerop (% i 60))
- (save-excursion
- (beginning-of-line)
- (insert (char-to-string (+ 32 (% (- end beg) 45)))))
- (insert "\n"))
- ;; Why is there always a "`" line at the end?
- (insert "`\nend\n")
- (goto-char beg)
- (insert "begin 600 xxx\n"))))
-
-(add-hook 'tramp-unload-hook
- (lambda ()
- (unload-feature 'tramp-uu 'force)))
-
-(provide 'tramp-uu)
-
-;;; tramp-uu.el ends here
-
-;; Local Variables:
-;; mode: Emacs-Lisp
-;; coding: utf-8
-;; End:
diff --git a/lisp/tramp.el b/lisp/tramp.el
deleted file mode 100644
index fd4ab5a..0000000
--- a/lisp/tramp.el
+++ /dev/null
@@ -1,4975 +0,0 @@
-;;; tramp.el --- Transparent Remote Access, Multiple Protocol -*-
lexical-binding:t -*-
-
-;; Copyright (C) 1998-2019 Free Software Foundation, Inc.
-
-;; Author: Kai Großjohann <address@hidden>
-;; Michael Albinus <address@hidden>
-;; Maintainer: Michael Albinus <address@hidden>
-;; Keywords: comm, processes
-;; Package: tramp
-;; Version: 2.4.2-pre
-;; Package-Requires: ((emacs "24.1"))
-;; URL: https://savannah.gnu.org/projects/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:
-
-;; This package provides remote file editing, similar to ange-ftp.
-;; The difference is that ange-ftp uses FTP to transfer files between
-;; the local and the remote host, whereas tramp.el uses a combination
-;; of rsh and rcp or other work-alike programs, such as ssh/scp.
-;;
-;; For more detailed instructions, please see the info file.
-;;
-;; Notes:
-;; -----
-;;
-;; Also see the todo list at the bottom of this file.
-;;
-;; The current version of Tramp can be retrieved from the following URL:
-;; https://ftp.gnu.org/gnu/tramp/
-;;
-;; There's a mailing list for this, as well. Its name is:
-;; address@hidden
-;; You can use the Web to subscribe, under the following URL:
-;; https://lists.gnu.org/mailman/listinfo/tramp-devel
-;;
-;; For the adventurous, the current development sources are available
-;; via Git. You can find instructions about this at the following URL:
-;; https://savannah.gnu.org/projects/tramp/
-;;
-;; Don't forget to put on your asbestos longjohns, first!
-
-;;; Code:
-
-(require 'tramp-compat)
-(require 'tramp-integration)
-(require 'trampver)
-
-;; Pacify byte-compiler.
-(require 'cl-lib)
-(declare-function netrc-parse "netrc")
-(defvar auto-save-file-name-transforms)
-(defvar ls-lisp-use-insert-directory-program)
-(defvar outline-regexp)
-
-;;; User Customizable Internal Variables:
-
-(defgroup tramp nil
- "Edit remote files with a combination of ssh, scp, etc."
- :group 'files
- :group 'comm
- :link '(custom-manual "(tramp)Top")
- :version "22.1")
-
-(eval-and-compile ;; So it's also available in tramp-loaddefs.el!
- (defvar tramp--startup-hook nil
- "Forms to be executed at the end of tramp.el.")
-
- (defmacro tramp--with-startup (&rest body)
- "Schedule BODY to be executed at the end of tramp.el."
- `(add-hook 'tramp--startup-hook (lambda () ,@body))))
-
-(require 'tramp-loaddefs)
-
-;; Maybe we need once a real Tramp mode, with key bindings etc.
-;;;###autoload
-(defcustom tramp-mode t
- "Whether Tramp is enabled.
-If it is set to nil, all remote file names are used literally."
- :group 'tramp
- :type 'boolean)
-
-(defcustom tramp-verbose 3
- "Verbosity level for Tramp messages.
-Any level x includes messages for all levels 1 .. x-1. The levels are
-
- 0 silent (no tramp messages at all)
- 1 errors
- 2 warnings
- 3 connection to remote hosts (default level)
- 4 activities
- 5 internal
- 6 sent and received strings
- 7 file caching
- 8 connection properties
- 9 test commands
-10 traces (huge)."
- :group 'tramp
- :type 'integer)
-
-(defcustom tramp-backup-directory-alist nil
- "Alist of filename patterns and backup directory names.
-Each element looks like (REGEXP . DIRECTORY), with the same meaning like
-in `backup-directory-alist'. If a Tramp file is backed up, and DIRECTORY
-is a local file name, the backup directory is prepended with Tramp file
-name prefix \(method, user, host) of file.
-
-\(setq tramp-backup-directory-alist backup-directory-alist)
-
-gives the same backup policy for Tramp files on their hosts like the
-policy for local files."
- :group 'tramp
- :type '(repeat (cons (regexp :tag "Regexp matching filename")
- (directory :tag "Backup directory name"))))
-
-(defcustom tramp-auto-save-directory nil
- "Put auto-save files in this directory, if set.
-The idea is to use a local directory so that auto-saving is faster.
-This setting has precedence over `auto-save-file-name-transforms'."
- :group 'tramp
- :type '(choice (const :tag "Use default" nil)
- (directory :tag "Auto save directory name")))
-
-(defcustom tramp-encoding-shell
- (or (tramp-compat-funcall 'w32-shell-name) "/bin/sh")
- "Use this program for encoding and decoding commands on the local host.
-This shell is used to execute the encoding and decoding command on the
-local host, so if you want to use `~' in those commands, you should
-choose a shell here which groks tilde expansion. `/bin/sh' normally
-does not understand tilde expansion.
-
-For encoding and decoding, commands like the following are executed:
-
- /bin/sh -c COMMAND < INPUT > OUTPUT
-
-This variable can be used to change the \"/bin/sh\" part. See the
-variable `tramp-encoding-command-switch' for the \"-c\" part.
-
-If the shell must be forced to be interactive, see
-`tramp-encoding-command-interactive'.
-
-Note that this variable is not used for remote commands. There are
-mechanisms in tramp.el which automatically determine the right shell to
-use for the remote host."
- :group 'tramp
- :type '(file :must-match t))
-
-(defcustom tramp-encoding-command-switch
- (if (tramp-compat-funcall 'w32-shell-dos-semantics) "/c" "-c")
- "Use this switch together with `tramp-encoding-shell' for local commands.
-See the variable `tramp-encoding-shell' for more information."
- :group 'tramp
- :type 'string)
-
-(defcustom tramp-encoding-command-interactive
- (unless (tramp-compat-funcall 'w32-shell-dos-semantics) "-i")
- "Use this switch together with `tramp-encoding-shell' for interactive shells.
-See the variable `tramp-encoding-shell' for more information."
- :version "24.1"
- :group 'tramp
- :type '(choice (const nil) string))
-
-(defvar tramp-methods nil
- "Alist of methods for remote files.
-This is a list of entries of the form (NAME PARAM1 PARAM2 ...).
-Each NAME stands for a remote access method. Each PARAM is a
-pair of the form (KEY VALUE). The following KEYs are defined:
-
- * `tramp-remote-shell'
- This specifies the shell to use on the remote host. This
- MUST be a Bourne-like shell. It is normally not necessary to
- set this to any value other than \"/bin/sh\": Tramp wants to
- use a shell which groks tilde expansion, but it can search
- for it. Also note that \"/bin/sh\" exists on all Unixen,
- this might not be true for the value that you decide to use.
- You Have Been Warned.
-
- * `tramp-remote-shell-login'
- This specifies the arguments to let `tramp-remote-shell' run
- as a login shell. It defaults to (\"-l\"), but some shells,
- like ksh, require another argument. See
- `tramp-connection-properties' for a way to overwrite the
- default value.
-
- * `tramp-remote-shell-args'
- For implementation of `shell-command', this specifies the
- arguments to let `tramp-remote-shell' run a single command.
-
- * `tramp-login-program'
- This specifies the name of the program to use for logging in to the
- remote host. This may be the name of rsh or a workalike program,
- or the name of telnet or a workalike, or the name of su or a workalike.
-
- * `tramp-login-args'
- This specifies the list of arguments to pass to the above
- mentioned program. Please note that this is a list of list of arguments,
- that is, normally you don't want to put \"-a -b\" or \"-f foo\"
- here. Instead, you want a list (\"-a\" \"-b\"), or (\"-f\" \"foo\").
- There are some patterns: \"%h\" in this list is replaced by the host
- name, \"%u\" is replaced by the user name, \"%p\" is replaced by the
- port number, and \"%%\" can be used to obtain a literal percent character.
- If a list containing \"%h\", \"%u\" or \"%p\" is unchanged during
- expansion (i.e. no host or no user specified), this list is not used as
- argument. By this, arguments like (\"-l\" \"%u\") are optional.
- \"%t\" is replaced by the temporary file name produced with
- `tramp-make-tramp-temp-file'. \"%k\" indicates the keep-date
- parameter of a program, if exists. \"%c\" adds additional
- `tramp-ssh-controlmaster-options' options for the first hop.
- The existence of `tramp-login-args', combined with the absence of
- `tramp-copy-args', is an indication that the method is capable of
- multi-hops.
-
- * `tramp-login-env'
- A list of environment variables and their values, which will
- be set when calling `tramp-login-program'.
-
- * `tramp-async-args'
- When an asynchronous process is started, we know already that
- the connection works. Therefore, we can pass additional
- parameters to suppress diagnostic messages, in order not to
- tamper the process output.
-
- * `tramp-copy-program'
- This specifies the name of the program to use for remotely copying
- the file; this might be the absolute filename of scp or the name of
- a workalike program. It is always applied on the local host.
-
- * `tramp-copy-args'
- This specifies the list of parameters to pass to the above mentioned
- program, the hints for `tramp-login-args' also apply here.
-
- * `tramp-copy-env'
- A list of environment variables and their values, which will
- be set when calling `tramp-copy-program'.
-
- * `tramp-remote-copy-program'
- The listener program to be applied on remote side, if needed.
-
- * `tramp-remote-copy-args'
- The list of parameters to pass to the listener program, the hints
- for `tramp-login-args' also apply here. Additionally, \"%r\" could
- be used here and in `tramp-copy-args'. It denotes a randomly
- chosen port for the remote listener.
-
- * `tramp-copy-keep-date'
- This specifies whether the copying program when the preserves the
- timestamp of the original file.
-
- * `tramp-copy-keep-tmpfile'
- This specifies whether a temporary local file shall be kept
- for optimization reasons (useful for \"rsync\" methods).
-
- * `tramp-copy-recursive'
- Whether the operation copies directories recursively.
-
- * `tramp-default-port'
- The default port of a method.
-
- * `tramp-tmpdir'
- A directory on the remote host for temporary files. If not
- specified, \"/tmp\" is taken as default.
-
- * `tramp-connection-timeout'
- This is the maximum time to be spent for establishing a connection.
- In general, the global default value shall be used, but for
- some methods, like \"su\" or \"sudo\", a shorter timeout
- might be desirable.
-
- * `tramp-session-timeout'
- How long a Tramp connection keeps open before being disconnected.
- This is useful for methods like \"su\" or \"sudo\", which
- shouldn't run an open connection in the background forever.
-
- * `tramp-case-insensitive'
- Whether the remote file system handles file names case insensitive.
- Only a non-nil value counts, the default value nil means to
- perform further checks on the remote host. See
- `tramp-connection-properties' for a way to overwrite this.
-
- * `tramp-mount-args'
- * `tramp-copyto-args'
- * `tramp-moveto-args'
- * `tramp-about-args'
- These parameters, a list of list like `tramp-login-args', are used
- for the \"rclone\" method, and are appended to the respective
- \"rclone\" commands. In general, they shouldn't be changed inside
- `tramp-methods'; it is recommended to change their values via
- `tramp-connection-properties'. Unlike `tramp-login-args' there is
- no pattern replacement.
-
-What does all this mean? Well, you should specify `tramp-login-program'
-for all methods; this program is used to log in to the remote site. Then,
-there are two ways to actually transfer the files between the local and the
-remote side. One way is using an additional scp-like program. If you want
-to do this, set `tramp-copy-program' in the method.
-
-Another possibility for file transfer is inline transfer, i.e. the
-file is passed through the same buffer used by `tramp-login-program'. In
-this case, the file contents need to be protected since the
-`tramp-login-program' might use escape codes or the connection might not
-be eight-bit clean. Therefore, file contents are encoded for transit.
-See the variables `tramp-local-coding-commands' and
-`tramp-remote-coding-commands' for details.
-
-So, to summarize: if the method is an out-of-band method, then you
-must specify `tramp-copy-program' and `tramp-copy-args'. If it is an
-inline method, then these two parameters should be nil.
-
-Notes:
-
-When using `su' or `sudo' the phrase \"open connection to a remote
-host\" sounds strange, but it is used nevertheless, for consistency.
-No connection is opened to a remote host, but `su' or `sudo' is
-started on the local host. You should specify a remote host
-`localhost' or the name of the local host. Another host name is
-useful only in combination with `tramp-default-proxies-alist'.")
-
-(defcustom tramp-default-method
- ;; An external copy method seems to be preferred, because it performs
- ;; much better for large files, and it hasn't too serious delays
- ;; for small files. But it must be ensured that there aren't
- ;; permanent password queries. Either a password agent like
- ;; "ssh-agent" or "Pageant" shall run, or the optional
- ;; password-cache.el or auth-sources.el packages shall be active for
- ;; password caching. If we detect that the user is running OpenSSH
- ;; 4.0 or newer, we could reuse the connection, which calls also for
- ;; an external method.
- (cond
- ;; PuTTY is installed. We don't take it, if it is installed on a
- ;; non-windows system, or pscp from the pssh (parallel ssh) package
- ;; is found.
- ((and (eq system-type 'windows-nt) (executable-find "pscp")) "pscp")
- ;; There is an ssh installation.
- ((executable-find "scp") "scp")
- ;; Fallback.
- (t "ftp"))
- "Default method to use for transferring files.
-See `tramp-methods' for possibilities.
-Also see `tramp-default-method-alist'."
- :group 'tramp
- :type 'string)
-
-(defcustom tramp-default-method-alist nil
- "Default method to use for specific host/user pairs.
-This is an alist of items (HOST USER METHOD). The first matching item
-specifies the method to use for a file name which does not specify a
-method. HOST and USER are regular expressions or nil, which is
-interpreted as a regular expression which always matches. If no entry
-matches, the variable `tramp-default-method' takes effect.
-
-If the file name does not specify the user, lookup is done using the
-empty string for the user name.
-
-See `tramp-methods' for a list of possibilities for METHOD."
- :group 'tramp
- :type '(repeat (list (choice :tag "Host regexp" regexp sexp)
- (choice :tag "User regexp" regexp sexp)
- (choice :tag "Method name" string (const nil)))))
-
-(defconst tramp-default-method-marker "-"
- "Marker for default method in remote file names.")
-
-(defcustom tramp-default-user nil
- "Default user to use for transferring files.
-It is nil by default; otherwise settings in configuration files like
-\"~/.ssh/config\" would be overwritten. Also see `tramp-default-user-alist'.
-
-This variable is regarded as obsolete, and will be removed soon."
- :group 'tramp
- :type '(choice (const nil) string))
-
-(defcustom tramp-default-user-alist nil
- "Default user to use for specific method/host pairs.
-This is an alist of items (METHOD HOST USER). The first matching item
-specifies the user to use for a file name which does not specify a
-user. METHOD and HOST are regular expressions or nil, which is
-interpreted as a regular expression which always matches. If no entry
-matches, the variable `tramp-default-user' takes effect.
-
-If the file name does not specify the method, lookup is done using the
-empty string for the method name."
- :group 'tramp
- :type '(repeat (list (choice :tag "Method regexp" regexp sexp)
- (choice :tag " Host regexp" regexp sexp)
- (choice :tag " User name" string (const nil)))))
-
-(defcustom tramp-default-host (system-name)
- "Default host to use for transferring files.
-Useful for su and sudo methods mostly."
- :group 'tramp
- :type 'string)
-
-(defcustom tramp-default-host-alist nil
- "Default host to use for specific method/user pairs.
-This is an alist of items (METHOD USER HOST). The first matching item
-specifies the host to use for a file name which does not specify a
-host. METHOD and USER are regular expressions or nil, which is
-interpreted as a regular expression which always matches. If no entry
-matches, the variable `tramp-default-host' takes effect.
-
-If the file name does not specify the method, lookup is done using the
-empty string for the method name."
- :group 'tramp
- :version "24.4"
- :type '(repeat (list (choice :tag "Method regexp" regexp sexp)
- (choice :tag " User regexp" regexp sexp)
- (choice :tag " Host name" string (const nil)))))
-
-(defcustom tramp-default-proxies-alist nil
- "Route to be followed for specific host/user pairs.
-This is an alist of items (HOST USER PROXY). The first matching
-item specifies the proxy to be passed for a file name located on
-a remote target matching address@hidden HOST and USER are regular
-expressions, which could also cover a domain (USER%DOMAIN) or
-port (HOST#PORT). PROXY must be a Tramp filename without a
-localname part. Method and user name on PROXY are optional,
-which is interpreted with the default values.
-
-PROXY can contain the patterns %h and %u, which are replaced by
-the strings matching HOST or USER (without DOMAIN and PORT parts),
-respectively.
-
-If an entry is added while parsing ad-hoc hop definitions, PROXY
-carries the non-nil text property `tramp-ad-hoc'.
-
-HOST, USER or PROXY could also be Lisp forms, which will be
-evaluated. The result must be a string or nil, which is
-interpreted as a regular expression which always matches."
- :group 'tramp
- :type '(repeat (list (choice :tag "Host regexp" regexp sexp)
- (choice :tag "User regexp" regexp sexp)
- (choice :tag " Proxy name" string (const nil)))))
-
-(defcustom tramp-save-ad-hoc-proxies nil
- "Whether to save ad-hoc proxies persistently."
- :group 'tramp
- :version "24.3"
- :type 'boolean)
-
-(defcustom tramp-restricted-shell-hosts-alist
- (when (memq system-type '(windows-nt))
- (list (concat "\\`" (regexp-quote (system-name)) "\\'")))
- "List of hosts, which run a restricted shell.
-This is a list of regular expressions, which denote hosts running
-a registered shell like \"rbash\". Those hosts can be used as
-proxies only, see `tramp-default-proxies-alist'. If the local
-host runs a registered shell, it shall be added to this list, too."
- :version "24.3"
- :group 'tramp
- :type '(repeat (regexp :tag "Host regexp")))
-
-(defcustom tramp-local-host-regexp
- (concat
- "\\`"
- (regexp-opt
- (list "localhost" "localhost6" (system-name) "127.0.0.1" "::1") t)
- "\\'")
- "Host names which are regarded as local host.
-If the local host runs a chrooted environment, set this to nil."
- :version "27.1"
- :group 'tramp
- :type '(choice (const :tag "Chrooted environment" nil)
- (regexp :tag "Host regexp")))
-
-(defvar tramp-completion-function-alist nil
- "Alist of methods for remote files.
-This is a list of entries of the form \(NAME PAIR1 PAIR2 ...).
-Each NAME stands for a remote access method. Each PAIR is of the form
-\(FUNCTION FILE). FUNCTION is responsible to extract user names and host
-names from FILE for completion. The following predefined FUNCTIONs exists:
-
- * `tramp-parse-rhosts' for \"~/.rhosts\" like files,
- * `tramp-parse-shosts' for \"~/.ssh/known_hosts\" like files,
- * `tramp-parse-sconfig' for \"~/.ssh/config\" like files,
- * `tramp-parse-shostkeys' for \"~/.ssh2/hostkeys/*\" like files,
- * `tramp-parse-sknownhosts' for \"~/.ssh2/knownhosts/*\" like files,
- * `tramp-parse-hosts' for \"/etc/hosts\" like files,
- * `tramp-parse-passwd' for \"/etc/passwd\" like files.
- * `tramp-parse-etc-group' for \"/etc/group\" like files.
- * `tramp-parse-netrc' for \"~/.netrc\" like files.
- * `tramp-parse-putty' for PuTTY registered sessions.
-
-FUNCTION can also be a user defined function. For more details see
-the info pages.")
-
-(defconst tramp-echo-mark-marker "_echo"
- "String marker to surround echoed commands.")
-
-(defconst tramp-echo-mark-marker-length (length tramp-echo-mark-marker)
- "String length of `tramp-echo-mark-marker'.")
-
-(defconst tramp-echo-mark
- (concat tramp-echo-mark-marker
- (make-string tramp-echo-mark-marker-length ?\b))
- "String mark to be transmitted around shell commands.
-Used to separate their echo from the output they produce. This
-will only be used if we cannot disable remote echo via stty.
-This string must have no effect on the remote shell except for
-producing some echo which can later be detected by
-`tramp-echoed-echo-mark-regexp'. Using `tramp-echo-mark-marker',
-followed by an equal number of backspaces to erase them will
-usually suffice.")
-
-(defconst tramp-echoed-echo-mark-regexp
- (format "%s\\(\b\\( \b\\)?\\)\\{%d\\}"
- tramp-echo-mark-marker tramp-echo-mark-marker-length)
- "Regexp which matches `tramp-echo-mark' as it gets echoed by
-the remote shell.")
-
-(defcustom tramp-local-end-of-line
- (if (memq system-type '(windows-nt)) "\r\n" "\n")
- "String used for end of line in local processes."
- :version "24.1"
- :group 'tramp
- :type 'string)
-
-(defcustom tramp-rsh-end-of-line "\n"
- "String used for end of line in rsh connections.
-I don't think this ever needs to be changed, so please tell me about it
-if you need to change this."
- :group 'tramp
- :type 'string)
-
-(defcustom tramp-login-prompt-regexp
- ".*\\(user\\|login\\)\\( .*\\)?: *"
- "Regexp matching login-like prompts.
-The regexp should match at end of buffer.
-
-Sometimes the prompt is reported to look like \"login as:\"."
- :group 'tramp
- :type 'regexp)
-
-(defcustom tramp-shell-prompt-pattern
- ;; Allow a prompt to start right after a ^M since it indeed would be
- ;; displayed at the beginning of the line (and Zsh uses it). This
- ;; regexp works only for GNU Emacs.
- ;; Allow also [] style prompts. They can appear only during
- ;; connection initialization; Tramp redefines the prompt afterwards.
- (concat "\\(?:^\\|\r\\)"
- "[^]#$%>\n]*#?[]#$%>] *\\(\e\\[[0-9;]*[a-zA-Z] *\\)*")
- "Regexp to match prompts from remote shell.
-Normally, Tramp expects you to configure `shell-prompt-pattern'
-correctly, but sometimes it happens that you are connecting to a
-remote host which sends a different kind of shell prompt. Therefore,
-Tramp recognizes things matched by `shell-prompt-pattern' as prompt,
-and also things matched by this variable. The default value of this
-variable is similar to the default value of `shell-prompt-pattern',
-which should work well in many cases.
-
-This regexp must match both `tramp-initial-end-of-output' and
-`tramp-end-of-output'."
- :group 'tramp
- :type 'regexp)
-
-(defcustom tramp-password-prompt-regexp
- (format "^.*\\(%s\\).*:address@hidden *"
- ;; `password-word-equivalents' has been introduced with Emacs 24.4.
- (regexp-opt (or (bound-and-true-p password-word-equivalents)
- '("password" "passphrase"))))
- "Regexp matching password-like prompts.
-The regexp should match at end of buffer.
-
-The `sudo' program appears to insert a `^@' character into the prompt."
- :version "24.4"
- :group 'tramp
- :type 'regexp)
-
-(defcustom tramp-wrong-passwd-regexp
- (concat "^.*"
- ;; These strings should be on the last line
- (regexp-opt '("Permission denied"
- "Login incorrect"
- "Login Incorrect"
- "Connection refused"
- "Connection closed"
- "Timeout, server not responding."
- "Sorry, try again."
- "Name or service not known"
- "Host key verification failed."
- "No supported authentication methods left to try!")
- t)
- ".*"
- "\\|"
- "^.*\\("
- ;; Here comes a list of regexes, separated by \\|
- "Received signal [0-9]+"
- "\\).*")
- "Regexp matching a `login failed' message.
-The regexp should match at end of buffer."
- :group 'tramp
- :type 'regexp)
-
-(defcustom tramp-yesno-prompt-regexp
- (concat
- (regexp-opt
- '("Are you sure you want to continue connecting (yes/no)?"
- "Are you sure you want to continue connecting (yes/no/[fingerprint])?")
- t)
- "\\s-*")
- "Regular expression matching all yes/no queries which need to be confirmed.
-The confirmation should be done with yes or no.
-The regexp should match at end of buffer.
-See also `tramp-yn-prompt-regexp'."
- :group 'tramp
- :type 'regexp)
-
-(defcustom tramp-yn-prompt-regexp
- (concat
- (regexp-opt '("Store key in cache? (y/n)"
- "Update cached key? (y/n, Return cancels connection)")
- t)
- "\\s-*")
- "Regular expression matching all y/n queries which need to be confirmed.
-The confirmation should be done with y or n.
-The regexp should match at end of buffer.
-See also `tramp-yesno-prompt-regexp'."
- :group 'tramp
- :type 'regexp)
-
-(defcustom tramp-terminal-prompt-regexp
- (concat "\\("
- "TERM = (.*)"
- "\\|"
- "Terminal type\\? \\[.*\\]"
- "\\)\\s-*")
- "Regular expression matching all terminal setting prompts.
-The regexp should match at end of buffer.
-The answer will be provided by `tramp-action-terminal', which see."
- :group 'tramp
- :type 'regexp)
-
-(defcustom tramp-operation-not-permitted-regexp
- (concat "\\(" "preserving times.*" "\\|" "set mode" "\\)" ":\\s-*"
- (regexp-opt '("Operation not permitted") t))
- "Regular expression matching keep-date problems in (s)cp operations.
-Copying has been performed successfully already, so this message can
-be ignored safely."
- :group 'tramp
- :type 'regexp)
-
-(defcustom tramp-copy-failed-regexp
- (concat "\\(.+: "
- (regexp-opt '("Permission denied"
- "not a regular file"
- "is a directory"
- "No such file or directory")
- t)
- "\\)\\s-*")
- "Regular expression matching copy problems in (s)cp operations."
- :group 'tramp
- :type 'regexp)
-
-(defcustom tramp-process-alive-regexp
- ""
- "Regular expression indicating a process has finished.
-In fact this expression is empty by intention, it will be used only to
-check regularly the status of the associated process.
-The answer will be provided by `tramp-action-process-alive',
-`tramp-action-out-of-band', which see."
- :group 'tramp
- :type 'regexp)
-
-(defconst tramp-temp-name-prefix "tramp."
- "Prefix to use for temporary files.
-If this is a relative file name (such as \"tramp.\"), it is considered
-relative to the directory name returned by the function
-`tramp-compat-temporary-file-directory' (which see). It may also be an
-absolute file name; don't forget to include a prefix for the filename
-part, though.")
-
-(defconst tramp-temp-buffer-name " *tramp temp*"
- "Buffer name for a temporary buffer.
-It shall be used in combination with `generate-new-buffer-name'.")
-
-(defvar tramp-temp-buffer-file-name nil
- "File name of a persistent local temporary file.
-Useful for \"rsync\" like methods.")
-(make-variable-buffer-local 'tramp-temp-buffer-file-name)
-(put 'tramp-temp-buffer-file-name 'permanent-local t)
-
-(defcustom tramp-syntax 'default
- "Tramp filename syntax to be used.
-
-It can have the following values:
-
- `default' -- Default syntax
- `simplified' -- Ange-FTP like syntax
- `separate' -- Syntax as defined for XEmacs originally
-
-Do not change the value by `setq', it must be changed only via
-Customize. See also `tramp-change-syntax'."
- :group 'tramp
- :version "26.1"
- :package-version '(Tramp . "2.3.3")
- :type '(choice (const :tag "Default" default)
- (const :tag "Ange-FTP" simplified)
- (const :tag "XEmacs" separate))
- :require 'tramp
- :initialize #'custom-initialize-default
- :set #'tramp-set-syntax)
-
-(defun tramp-set-syntax (symbol value)
- "Set SYMBOL to value VALUE.
-Used in user option `tramp-syntax'. There are further variables
-to be set, depending on VALUE."
- ;; Check allowed values.
- (unless (memq value (tramp-syntax-values))
- (tramp-user-error "Wrong `tramp-syntax' %s" value))
- ;; Cleanup existing buffers.
- (unless (eq (symbol-value symbol) value)
- (tramp-cleanup-all-buffers))
- ;; Set the value:
- (set-default symbol value)
- ;; Reset the depending variables.
- (with-no-warnings
- (setq tramp-prefix-format (tramp-build-prefix-format)
- tramp-prefix-regexp (tramp-build-prefix-regexp)
- tramp-method-regexp (tramp-build-method-regexp)
- tramp-postfix-method-format (tramp-build-postfix-method-format)
- tramp-postfix-method-regexp (tramp-build-postfix-method-regexp)
- tramp-prefix-ipv6-format (tramp-build-prefix-ipv6-format)
- tramp-prefix-ipv6-regexp (tramp-build-prefix-ipv6-regexp)
- tramp-postfix-ipv6-format (tramp-build-postfix-ipv6-format)
- tramp-postfix-ipv6-regexp (tramp-build-postfix-ipv6-regexp)
- tramp-postfix-host-format (tramp-build-postfix-host-format)
- tramp-postfix-host-regexp (tramp-build-postfix-host-regexp)
- tramp-remote-file-name-spec-regexp
- (tramp-build-remote-file-name-spec-regexp)
- tramp-file-name-structure (tramp-build-file-name-structure)
- tramp-file-name-regexp (tramp-build-file-name-regexp)
- tramp-completion-file-name-regexp
- (tramp-build-completion-file-name-regexp)))
- ;; Rearrange file name handlers.
- (tramp-register-file-name-handlers))
-
-;; Initialize the Tramp syntax variables. We want to override initial
-;; value of `tramp-file-name-regexp'. Other Tramp syntax variables
-;; must be initialized as well to proper values. We do not call
-;; `custom-set-variable', this would load Tramp via custom.el.
-(tramp--with-startup
- (tramp-set-syntax 'tramp-syntax (tramp-compat-tramp-syntax)))
-
-(defun tramp-syntax-values ()
- "Return possible values of `tramp-syntax', a list"
- (let ((values (cdr (get 'tramp-syntax 'custom-type))))
- (setq values (mapcar #'last values)
- values (mapcar #'car values))
- values))
-
-(defun tramp-lookup-syntax (alist)
- "Look up a syntax string in ALIST according to `tramp-compat-tramp-syntax.'
-Raise an error if `tramp-syntax' is invalid."
- (or (cdr (assq (tramp-compat-tramp-syntax) alist))
- (error "Wrong `tramp-syntax' %s" tramp-syntax)))
-
-(defconst tramp-prefix-format-alist
- '((default . "/")
- (simplified . "/")
- (separate . "/["))
- "Alist mapping Tramp syntax to strings beginning Tramp file names.")
-
-(defun tramp-build-prefix-format ()
- (tramp-lookup-syntax tramp-prefix-format-alist))
-
-(defvar tramp-prefix-format nil ;Initialized when defining `tramp-syntax'!
- "String matching the very beginning of Tramp file names.
-Used in `tramp-make-tramp-file-name'.")
-
-(defun tramp-build-prefix-regexp ()
- (concat "^" (regexp-quote tramp-prefix-format)))
-
-(defvar tramp-prefix-regexp nil ;Initialized when defining `tramp-syntax'!
- "Regexp matching the very beginning of Tramp file names.
-Should always start with \"^\". Derived from `tramp-prefix-format'.")
-
-(defconst tramp-method-regexp-alist
- '((default . "[a-zA-Z0-9-]+")
- (simplified . "")
- (separate . "[a-zA-Z0-9-]*"))
- "Alist mapping Tramp syntax to regexps matching methods identifiers.")
-
-(defun tramp-build-method-regexp ()
- (tramp-lookup-syntax tramp-method-regexp-alist))
-
-(defvar tramp-method-regexp nil ;Initialized when defining `tramp-syntax'!
- "Regexp matching methods identifiers.
-The `ftp' syntax does not support methods.")
-
-(defconst tramp-postfix-method-format-alist
- '((default . ":")
- (simplified . "")
- (separate . "/"))
- "Alist mapping Tramp syntax to the delimiter after the method.")
-
-(defun tramp-build-postfix-method-format ()
- (tramp-lookup-syntax tramp-postfix-method-format-alist))
-
-(defvar tramp-postfix-method-format nil ;Init'd when defining `tramp-syntax'!
- "String matching delimiter between method and user or host names.
-The `ftp' syntax does not support methods.
-Used in `tramp-make-tramp-file-name'.")
-
-(defun tramp-build-postfix-method-regexp ()
- (regexp-quote tramp-postfix-method-format))
-
-(defvar tramp-postfix-method-regexp nil ;Init'd when defining `tramp-syntax'!
- "Regexp matching delimiter between method and user or host names.
-Derived from `tramp-postfix-method-format'.")
-
-(defconst tramp-user-regexp "[^/|: \t]+"
- "Regexp matching user names.")
-
-(defconst tramp-prefix-domain-format "%"
- "String matching delimiter between user and domain names.")
-
-(defconst tramp-prefix-domain-regexp (regexp-quote tramp-prefix-domain-format)
- "Regexp matching delimiter between user and domain names.
-Derived from `tramp-prefix-domain-format'.")
-
-(defconst tramp-domain-regexp "[a-zA-Z0-9_.-]+"
- "Regexp matching domain names.")
-
-(defconst tramp-user-with-domain-regexp
- (concat "\\(" tramp-user-regexp "\\)"
- tramp-prefix-domain-regexp
- "\\(" tramp-domain-regexp "\\)")
- "Regexp matching user names with domain names.")
-
-(defconst tramp-postfix-user-format "@"
- "String matching delimiter between user and host names.
-Used in `tramp-make-tramp-file-name'.")
-
-(defconst tramp-postfix-user-regexp (regexp-quote tramp-postfix-user-format)
- "Regexp matching delimiter between user and host names.
-Derived from `tramp-postfix-user-format'.")
-
-(defconst tramp-host-regexp "[a-zA-Z0-9_.%-]+"
- "Regexp matching host names.")
-
-(defconst tramp-prefix-ipv6-format-alist
- '((default . "[")
- (simplified . "[")
- (separate . ""))
- "Alist mapping Tramp syntax to strings prefixing IPv6 addresses.")
-
-(defun tramp-build-prefix-ipv6-format ()
- (tramp-lookup-syntax tramp-prefix-ipv6-format-alist))
-
-(defvar tramp-prefix-ipv6-format nil ;Initialized when defining `tramp-syntax'!
- "String matching left hand side of IPv6 addresses.
-Used in `tramp-make-tramp-file-name'.")
-
-(defun tramp-build-prefix-ipv6-regexp ()
- (regexp-quote tramp-prefix-ipv6-format))
-
-(defvar tramp-prefix-ipv6-regexp nil ;Initialized when defining `tramp-syntax'!
- "Regexp matching left hand side of IPv6 addresses.
-Derived from `tramp-prefix-ipv6-format'.")
-
-;; The following regexp is a bit sloppy. But it shall serve our
-;; purposes. It covers also IPv4 mapped IPv6 addresses, like in
-;; "::ffff:192.168.0.1".
-(defconst tramp-ipv6-regexp "\\(?:[a-zA-Z0-9]*:\\)+[a-zA-Z0-9.]+"
- "Regexp matching IPv6 addresses.")
-
-(defconst tramp-postfix-ipv6-format-alist
- '((default . "]")
- (simplified . "]")
- (separate . ""))
- "Alist mapping Tramp syntax to suffix for IPv6 addresses.")
-
-(defun tramp-build-postfix-ipv6-format ()
- (tramp-lookup-syntax tramp-postfix-ipv6-format-alist))
-
-(defvar tramp-postfix-ipv6-format nil ;Initialized when defining
`tramp-syntax'!
- "String matching right hand side of IPv6 addresses.
-Used in `tramp-make-tramp-file-name'.")
-
-(defun tramp-build-postfix-ipv6-regexp ()
- (regexp-quote tramp-postfix-ipv6-format))
-
-(defvar tramp-postfix-ipv6-regexp nil ;Initialized when defining
`tramp-syntax'!
- "Regexp matching right hand side of IPv6 addresses.
-Derived from `tramp-postfix-ipv6-format'.")
-
-(defconst tramp-prefix-port-format "#"
- "String matching delimiter between host names and port numbers.")
-
-(defconst tramp-prefix-port-regexp (regexp-quote tramp-prefix-port-format)
- "Regexp matching delimiter between host names and port numbers.
-Derived from `tramp-prefix-port-format'.")
-
-(defconst tramp-port-regexp "[0-9]+"
- "Regexp matching port numbers.")
-
-(defconst tramp-host-with-port-regexp
- (concat "\\(" tramp-host-regexp "\\)"
- tramp-prefix-port-regexp
- "\\(" tramp-port-regexp "\\)")
- "Regexp matching host names with port numbers.")
-
-(defconst tramp-postfix-hop-format "|"
- "String matching delimiter after ad-hoc hop definitions.")
-
-(defconst tramp-postfix-hop-regexp (regexp-quote tramp-postfix-hop-format)
- "Regexp matching delimiter after ad-hoc hop definitions.
-Derived from `tramp-postfix-hop-format'.")
-
-(defconst tramp-postfix-host-format-alist
- '((default . ":")
- (simplified . ":")
- (separate . "]"))
- "Alist mapping Tramp syntax to strings between host and local names.")
-
-(defun tramp-build-postfix-host-format ()
- (tramp-lookup-syntax tramp-postfix-host-format-alist))
-
-(defvar tramp-postfix-host-format nil ;Initialized when defining
`tramp-syntax'!
- "String matching delimiter between host names and localnames.
-Used in `tramp-make-tramp-file-name'.")
-
-(defun tramp-build-postfix-host-regexp ()
- (regexp-quote tramp-postfix-host-format))
-
-(defvar tramp-postfix-host-regexp nil ;Initialized when defining
`tramp-syntax'!
- "Regexp matching delimiter between host names and localnames.
-Derived from `tramp-postfix-host-format'.")
-
-(defconst tramp-localname-regexp "[^\n\r]*\\'"
- "Regexp matching localnames.")
-
-(defconst tramp-unknown-id-string "UNKNOWN"
- "String used to denote an unknown user or group")
-
-(defconst tramp-unknown-id-integer -1
- "Integer used to denote an unknown user or group")
-
-;;; File name format:
-
-(defun tramp-build-remote-file-name-spec-regexp ()
- "Construct a regexp matching a Tramp file name for a Tramp syntax.
-It is expected, that `tramp-syntax' has the proper value."
- (concat
- "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
- "\\(?:" "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp "\\)?"
- "\\(" "\\(?:" tramp-host-regexp "\\|"
- tramp-prefix-ipv6-regexp "\\(?:" tramp-ipv6-regexp "\\)?"
- tramp-postfix-ipv6-regexp "\\)"
- "\\(?:" tramp-prefix-port-regexp tramp-port-regexp "\\)?" "\\)?"))
-
-(defvar tramp-remote-file-name-spec-regexp
- nil ;Initialized when defining `tramp-syntax'!
- "Regular expression matching a Tramp file name between prefix and postfix.")
-
-(defun tramp-build-file-name-structure ()
- "Construct the Tramp file name structure for a Tramp syntax.
-It is expected, that `tramp-syntax' has the proper value.
-See `tramp-file-name-structure'."
- (list
- (concat
- tramp-prefix-regexp
- "\\(" "\\(?:" tramp-remote-file-name-spec-regexp
- tramp-postfix-hop-regexp "\\)+" "\\)?"
- tramp-remote-file-name-spec-regexp tramp-postfix-host-regexp
- "\\(" tramp-localname-regexp "\\)")
- 5 6 7 8 1))
-
-(defvar tramp-file-name-structure nil ;Initialized when defining
`tramp-syntax'!
- "List of six elements (REGEXP METHOD USER HOST FILE HOP), detailing \
-the Tramp file name structure.
-
-The first element REGEXP is a regular expression matching a Tramp file
-name. The regex should contain parentheses around the method name,
-the user name, the host name, and the file name parts.
-
-The second element METHOD is a number, saying which pair of
-parentheses matches the method name. The third element USER is
-similar, but for the user name. The fourth element HOST is similar,
-but for the host name. The fifth element FILE is for the file name.
-The last element HOP is the ad-hoc hop definition, which could be a
-cascade of several hops.
-
-These numbers are passed directly to `match-string', which see. That
-means the opening parentheses are counted to identify the pair.
-
-See also `tramp-file-name-regexp'.")
-
-(defun tramp-build-file-name-regexp ()
- (car tramp-file-name-structure))
-
-;;;###autoload
-(defconst tramp-initial-file-name-regexp "\\`/.+:.*:"
- "Value for `tramp-file-name-regexp' for autoload.
-It must match the initial `tramp-syntax' settings.")
-
-;;;###autoload
-(defvar tramp-file-name-regexp tramp-initial-file-name-regexp
- "Regular expression matching file names handled by Tramp.
-This regexp should match Tramp file names but no other file
-names. When calling `tramp-register-file-name-handlers', the
-initial value is overwritten by the car of `tramp-file-name-structure'.")
-
-;;;###autoload
-(defcustom tramp-ignored-file-name-regexp nil
- "Regular expression matching file names that are not under Tramp’s control."
- :version "27.1"
- :group 'tramp
- :type '(choice (const nil) regexp))
-
-(defconst tramp-completion-file-name-regexp-default
- (concat
- "\\`/\\("
- ;; Optional multi hop.
- "\\([^/|:]+:[^/|:]*|\\)*"
- ;; Last hop.
- (if (memq system-type '(cygwin windows-nt))
- ;; The method is either "-", or at least two characters.
- "\\(-\\|[^/|:]\\{2,\\}\\)"
- ;; At least one character for method.
- "[^/|:]+")
- ;; Method separator, user name and host name.
- "\\(:[^/|:]*\\)?"
- "\\)?\\'")
- "Value for `tramp-completion-file-name-regexp' for default remoting.
-See `tramp-file-name-structure' for more explanations.
-
-On W32 systems, the volume letter must be ignored.")
-
-(defconst tramp-completion-file-name-regexp-simplified
- (concat
- "\\`/\\("
- ;; Optional multi hop.
- "\\([^/|:]*|\\)*"
- ;; Last hop.
- (if (memq system-type '(cygwin windows-nt))
- ;; At least two characters.
- "[^/|:]\\{2,\\}"
- ;; At least one character.
- "[^/|:]+")
- "\\)?\\'")
- "Value for `tramp-completion-file-name-regexp' for simplified style remoting.
-See `tramp-file-name-structure' for more explanations.
-
-On W32 systems, the volume letter must be ignored.")
-
-(defconst tramp-completion-file-name-regexp-separate
- "\\`/\\(\\[[^]]*\\)?\\'"
- "Value for `tramp-completion-file-name-regexp' for separate remoting.
-See `tramp-file-name-structure' for more explanations.")
-
-(defconst tramp-completion-file-name-regexp-alist
- `((default . ,tramp-completion-file-name-regexp-default)
- (simplified . ,tramp-completion-file-name-regexp-simplified)
- (separate . ,tramp-completion-file-name-regexp-separate))
- "Alist mapping incomplete Tramp file names.")
-
-(defun tramp-build-completion-file-name-regexp ()
- (tramp-lookup-syntax tramp-completion-file-name-regexp-alist))
-
-(defvar tramp-completion-file-name-regexp
- nil ;Initialized when defining `tramp-syntax'!
- "Regular expression matching file names handled by Tramp completion.
-This regexp should match partial Tramp file names only.
-
-Please note that the entry in `file-name-handler-alist' is made when
-this file \(tramp.el) is loaded. This means that this variable must be set
-before loading tramp.el. Alternatively, `file-name-handler-alist' can be
-updated after changing this variable.
-
-Also see `tramp-file-name-structure'.")
-
-;;;###autoload
-(defconst tramp-autoload-file-name-regexp
- (concat
- "\\`/"
- (if (memq system-type '(cygwin windows-nt))
- ;; The method is either "-", or at least two characters.
- "\\(-\\|[^/|:]\\{2,\\}\\)"
- ;; At least one character for method.
- "[^/|:]+")
- ":")
- "Regular expression matching file names handled by Tramp autoload.
-It must match the initial `tramp-syntax' settings. It should not
-match file names at root of the underlying local file system,
-like \"/sys\" or \"/C:\".")
-
-;; Chunked sending kludge. We set this to 500 for black-listed constellations
-;; known to have a bug in `process-send-string'; some ssh connections appear
-;; to drop bytes when data is sent too quickly. There is also a connection
-;; buffer local variable, which is computed depending on remote host properties
-;; when `tramp-chunksize' is zero or nil.
-(defcustom tramp-chunksize (when (memq system-type '(hpux)) 500)
-;; Parentheses in docstring starting at beginning of line are escaped.
-;; Fontification is messed up when
-;; `open-paren-in-column-0-is-defun-start' set to t.
- "If non-nil, chunksize for sending input to local process.
-It is necessary only on systems which have a buggy `process-send-string'
-implementation. The necessity, whether this variable must be set, can be
-checked via the following code:
-
- (with-temp-buffer
- (let* ((user \"xxx\") (host \"yyy\")
- (init 0) (step 50)
- (sent init) (received init))
- (while (= sent received)
- (setq sent (+ sent step))
- (erase-buffer)
- (let ((proc (start-process (buffer-name) (current-buffer)
- \"ssh\" \"-l\" user host \"wc\" \"-c\")))
- (when (process-live-p proc)
- (process-send-string proc (make-string sent ?\\ ))
- (process-send-eof proc)
- (process-send-eof proc))
- (while (not (progn (goto-char (point-min))
- (re-search-forward \"\\\\w+\" (point-max) t)))
- (accept-process-output proc 1))
- (when (process-live-p proc)
- (setq received (string-to-number (match-string 0)))
- (delete-process proc)
- (message \"Bytes sent: %s\\tBytes received: %s\" sent received)
- (sit-for 0))))
- (if (> sent (+ init step))
- (message \"You should set `tramp-chunksize' to a maximum of %s\"
- (- sent step))
- (message \"Test does not work\")
- (display-buffer (current-buffer))
- (sit-for 30))))
-
-In the Emacs normally running Tramp, evaluate the above code
-\(replace \"xxx\" and \"yyy\" by the remote user and host name,
-respectively). You can do this, for example, by pasting it into
-the `*scratch*' buffer and then hitting C-j with the cursor after the
-last closing parenthesis. Note that it works only if you have configured
-\"ssh\" to run without password query, see ssh-agent(1).
-
-You will see the number of bytes sent successfully to the remote host.
-If that number exceeds 1000, you can stop the execution by hitting
-C-g, because your Emacs is likely clean.
-
-When it is necessary to set `tramp-chunksize', you might consider to
-use an out-of-the-band method \(like \"scp\") instead of an internal one
-\(like \"ssh\"), because setting `tramp-chunksize' to non-nil decreases
-performance.
-
-If your Emacs is buggy, the code stops and gives you an indication
-about the value `tramp-chunksize' should be set. Maybe you could just
-experiment a bit, e.g. changing the values of `init' and `step'
-in the third line of the code.
-
-Please raise a bug report via \"M-x tramp-bug\" if your system needs
-this variable to be set as well."
- :group 'tramp
- :type '(choice (const nil) integer))
-
-;; Logging in to a remote host normally requires obtaining a pty. But
-;; Emacs on macOS has process-connection-type set to nil by default,
-;; so on those systems Tramp doesn't obtain a pty. Here, we allow
-;; for an override of the system default.
-(defcustom tramp-process-connection-type t
- "Overrides `process-connection-type' for connections from Tramp.
-Tramp binds `process-connection-type' to the value given here before
-opening a connection to a remote host."
- :group 'tramp
- :type '(choice (const nil) (const t) (const pty)))
-
-(defcustom tramp-connection-timeout 60
- "Defines the max time to wait for establishing a connection (in seconds).
-This can be overwritten for different connection types in `tramp-methods'.
-
-The timeout does not include the time reading a password."
- :group 'tramp
- :version "24.4"
- :type 'integer)
-
-(defcustom tramp-connection-min-time-diff 5
- "Defines seconds between two consecutive connection attempts.
-This is necessary as self defense mechanism, in order to avoid
-yo-yo connection attempts when the remote host is unavailable.
-
-A value of 0 or nil suppresses this check. This might be
-necessary, when several out-of-order copy operations are
-performed, or when several asynchronous processes will be started
-in a short time frame. In those cases it is recommended to
-let-bind this variable."
- :group 'tramp
- :version "24.4"
- :type '(choice (const nil) integer))
-
-(defcustom tramp-completion-reread-directory-timeout 10
- "Defines seconds since last remote command before rereading a directory.
-A remote directory might have changed its contents. In order to
-make it visible during file name completion in the minibuffer,
-Tramp flushes its cache and rereads the directory contents when
-more than `tramp-completion-reread-directory-timeout' seconds
-have been gone since last remote command execution. A value of t
-would require an immediate reread during filename completion, nil
-means to use always cached values for the directory contents."
- :group 'tramp
- :type '(choice (const nil) (const t) integer))
-
-;;; Internal Variables:
-
-(defvar tramp-current-connection nil
- "Last connection timestamp.")
-
-(defvar tramp-password-save-function nil
- "Password save function.
-Will be called once the password has been verified by successful
-authentication.")
-
-(defconst tramp-completion-file-name-handler-alist
- '((file-name-all-completions
- . tramp-completion-handle-file-name-all-completions)
- (file-name-completion . tramp-completion-handle-file-name-completion))
- "Alist of completion handler functions.
-Used for file names matching `tramp-completion-file-name-regexp'.
-Operations not mentioned here will be handled by Tramp's file
-name handler functions, or the normal Emacs functions.")
-
-;; Handlers for foreign methods, like FTP or SMB, shall be plugged here.
-(defvar tramp-foreign-file-name-handler-alist nil
- "Alist of elements (FUNCTION . HANDLER) for foreign methods handled
specially.
-If (FUNCTION FILENAME) returns non-nil, then all I/O on that file is done by
-calling HANDLER.")
-
-;;; Internal functions which must come first:
-
-;; Conversion functions between external representation and
-;; internal data structure. Convenience functions for internal
-;; data structure.
-
-;; The basic structure for remote file names. We use a list :type,
-;; in order to be compatible with Emacs 24 and 25.
-(cl-defstruct (tramp-file-name (:type list) :named)
- method user domain host port localname hop)
-
-(defun tramp-file-name-user-domain (vec)
- "Return user and domain components of VEC."
- (when (or (tramp-file-name-user vec) (tramp-file-name-domain vec))
- (concat (tramp-file-name-user vec)
- (and (tramp-file-name-domain vec)
- tramp-prefix-domain-format)
- (tramp-file-name-domain vec))))
-
-(defun tramp-file-name-host-port (vec)
- "Return host and port components of VEC."
- (when (or (tramp-file-name-host vec) (tramp-file-name-port vec))
- (concat (tramp-file-name-host vec)
- (and (tramp-file-name-port vec)
- tramp-prefix-port-format)
- (tramp-file-name-port vec))))
-
-(defun tramp-file-name-port-or-default (vec)
- "Return port component of VEC.
-If nil, return `tramp-default-port'."
- (or (tramp-file-name-port vec)
- (tramp-get-method-parameter vec 'tramp-default-port)))
-
-;; Comparision of file names is performed by `tramp-equal-remote'.
-(defun tramp-file-name-equal-p (vec1 vec2)
- "Check, whether VEC1 and VEC2 denote the same `tramp-file-name'."
- (and (tramp-file-name-p vec1) (tramp-file-name-p vec2)
- (string-equal (tramp-file-name-method vec1)
- (tramp-file-name-method vec2))
- (string-equal (tramp-file-name-user-domain vec1)
- (tramp-file-name-user-domain vec2))
- (string-equal (tramp-file-name-host-port vec1)
- (tramp-file-name-host-port vec2))))
-
-(defun tramp-get-method-parameter (vec param)
- "Return the method parameter PARAM.
-If VEC is a vector, check first in connection properties.
-Afterwards, check in `tramp-methods'. If the `tramp-methods'
-entry does not exist, return nil."
- (let ((hash-entry
- (replace-regexp-in-string "^tramp-" "" (symbol-name param))))
- (if (tramp-connection-property-p vec hash-entry)
- ;; We use the cached property.
- (tramp-get-connection-property vec hash-entry nil)
- ;; Use the static value from `tramp-methods'.
- (let ((methods-entry
- (assoc param (assoc (tramp-file-name-method vec) tramp-methods))))
- (when methods-entry (cadr methods-entry))))))
-
-;; The localname can be quoted with "/:". Extract this.
-(defun tramp-file-name-unquote-localname (vec)
- "Return unquoted localname component of VEC."
- (tramp-compat-file-name-unquote (tramp-file-name-localname vec)))
-
-(defun tramp-tramp-file-p (name)
- "Return t if NAME is a string with Tramp file name syntax."
- (and tramp-mode (stringp name)
- ;; No "/:" and "/c:". This is not covered by `tramp-file-name-regexp'.
- (not (string-match-p
- (if (memq system-type '(cygwin windows-nt))
- "^/[[:alpha:]]?:" "^/:")
- name))
- ;; Excluded file names.
- (or (null tramp-ignored-file-name-regexp)
- (not (string-match-p tramp-ignored-file-name-regexp name)))
- (string-match-p tramp-file-name-regexp name)
- t))
-
-(defun tramp-find-method (method user host)
- "Return the right method string to use.
-This is METHOD, if non-nil. Otherwise, do a lookup in
-`tramp-default-method-alist' and `tramp-default-method'."
- (when (and method
- (or (string-equal method "")
- (string-equal method tramp-default-method-marker)))
- (setq method nil))
- (let ((result
- (or method
- (let ((choices tramp-default-method-alist)
- lmethod item)
- (while choices
- (setq item (pop choices))
- (when (and (string-match-p (or (nth 0 item) "") (or host ""))
- (string-match-p (or (nth 1 item) "") (or user "")))
- (setq lmethod (nth 2 item))
- (setq choices nil)))
- lmethod)
- tramp-default-method)))
- ;; We must mark, whether a default value has been used.
- (if (or method (null result))
- result
- (propertize result 'tramp-default t))))
-
-(defun tramp-find-user (method user host)
- "Return the right user string to use.
-This is USER, if non-nil. Otherwise, do a lookup in
-`tramp-default-user-alist' and `tramp-default-user'."
- (let ((result
- (or user
- (let ((choices tramp-default-user-alist)
- luser item)
- (while choices
- (setq item (pop choices))
- (when (and (string-match-p (or (nth 0 item) "") (or method ""))
- (string-match-p (or (nth 1 item) "") (or host "")))
- (setq luser (nth 2 item))
- (setq choices nil)))
- luser)
- tramp-default-user)))
- ;; We must mark, whether a default value has been used.
- (if (or user (null result))
- result
- (propertize result 'tramp-default t))))
-
-(defun tramp-find-host (method user host)
- "Return the right host string to use.
-This is HOST, if non-nil. Otherwise, do a lookup in
-`tramp-default-host-alist' and `tramp-default-host'."
- (let ((result
- (or (and (> (length host) 0) host)
- (let ((choices tramp-default-host-alist)
- lhost item)
- (while choices
- (setq item (pop choices))
- (when (and (string-match-p (or (nth 0 item) "") (or method ""))
- (string-match-p (or (nth 1 item) "") (or user "")))
- (setq lhost (nth 2 item))
- (setq choices nil)))
- lhost)
- tramp-default-host)))
- ;; We must mark, whether a default value has been used.
- (if (or (> (length host) 0) (null result))
- result
- (propertize result 'tramp-default t))))
-
-(defun tramp-dissect-file-name (name &optional nodefault)
- "Return a `tramp-file-name' structure of NAME, a remote file name.
-The structure consists of method, user, domain, host, port,
-localname (file name on remote host), and hop.
-
-Unless NODEFAULT is non-nil, method, user and host are expanded
-to their default values. For the other file name parts, no
-default values are used."
- (save-match-data
- (unless (tramp-tramp-file-p name)
- (tramp-user-error nil "Not a Tramp file name: \"%s\"" name))
- (if (not (string-match (nth 0 tramp-file-name-structure) name))
- (error "`tramp-file-name-structure' didn't match!")
- (let ((method (match-string (nth 1 tramp-file-name-structure) name))
- (user (match-string (nth 2 tramp-file-name-structure) name))
- (host (match-string (nth 3 tramp-file-name-structure) name))
- (localname (match-string (nth 4 tramp-file-name-structure) name))
- (hop (match-string (nth 5 tramp-file-name-structure) name))
- domain port v)
- (when user
- (when (string-match tramp-user-with-domain-regexp user)
- (setq domain (match-string 2 user)
- user (match-string 1 user))))
-
- (when host
- (when (string-match tramp-host-with-port-regexp host)
- (setq port (match-string 2 host)
- host (match-string 1 host)))
- (when (string-match tramp-prefix-ipv6-regexp host)
- (setq host (replace-match "" nil t host)))
- (when (string-match tramp-postfix-ipv6-regexp host)
- (setq host (replace-match "" nil t host))))
-
- (unless nodefault
- (when hop
- (setq v (tramp-dissect-hop-name hop)
- hop (and hop (tramp-make-tramp-hop-name v))))
- (let ((tramp-default-host
- (or (and v (not (string-match-p "%h" (tramp-file-name-host v)))
- (tramp-file-name-host v))
- tramp-default-host)))
- (setq method (tramp-find-method method user host)
- user (tramp-find-user method user host)
- host (tramp-find-host method user host)
- hop
- (and hop
- (format-spec hop (format-spec-make ?h host ?u user))))))
-
- ;; Return result.
- (prog1
- (setq v (make-tramp-file-name
- :method method :user user :domain domain :host host
- :port port :localname localname :hop hop))
- ;; Only some methods from tramp-sh.el do support multi-hops.
- (when (and
- hop
- (or (not (tramp-get-method-parameter v 'tramp-login-program))
- (tramp-get-method-parameter v 'tramp-copy-program)))
- (tramp-user-error
- v "Method `%s' is not supported for multi-hops." method)))))))
-
-(defun tramp-dissect-hop-name (name &optional nodefault)
- "Return a `tramp-file-name' structure of `hop' part of NAME.
-See `tramp-dissect-file-name' for details."
- (let ((v (tramp-dissect-file-name
- (concat tramp-prefix-format
- (replace-regexp-in-string
- (concat tramp-postfix-hop-regexp "$")
- tramp-postfix-host-format name))
- nodefault)))
- ;; Only some methods from tramp-sh.el do support multi-hops.
- (when (or (not (tramp-get-method-parameter v 'tramp-login-program))
- (tramp-get-method-parameter v 'tramp-copy-program))
- (tramp-user-error
- v "Method `%s' is not supported for multi-hops."
- (tramp-file-name-method v)))
- ;; Return result.
- v))
-
-(defun tramp-buffer-name (vec)
- "A name for the connection buffer VEC."
- (let ((method (tramp-file-name-method vec))
- (user-domain (tramp-file-name-user-domain vec))
- (host-port (tramp-file-name-host-port vec)))
- (if (not (zerop (length user-domain)))
- (format "*tramp/%s address@hidden" method user-domain host-port)
- (format "*tramp/%s %s*" method host-port))))
-
-(defun tramp-make-tramp-file-name (&rest args)
- "Construct a Tramp file name from ARGS.
-
-ARGS could have two different signatures. The first one is of
-type (VEC &optional LOCALNAME HOP).
-If LOCALNAME is nil, the value in VEC is used. If it is a
-symbol, a null localname will be used. Otherwise, LOCALNAME is
-expected to be a string, which will be used.
-If HOP is nil, the value in VEC is used. If it is a symbol, a
-null hop will be used. Otherwise, HOP is expected to be a
-string, which will be used.
-
-The other signature exists for backward compatibility. It has
-the form (METHOD USER DOMAIN HOST PORT LOCALNAME &optional HOP)."
- (let (method user domain host port localname hop)
- (cond
- ((tramp-file-name-p (car args))
- (setq method (tramp-file-name-method (car args))
- user (tramp-file-name-user (car args))
- domain (tramp-file-name-domain (car args))
- host (tramp-file-name-host (car args))
- port (tramp-file-name-port (car args))
- localname (tramp-file-name-localname (car args))
- hop (tramp-file-name-hop (car args)))
- (when (cadr args)
- (setq localname (and (stringp (cadr args)) (cadr args))))
- (when (cl-caddr args)
- (setq hop (and (stringp (cl-caddr args)) (cl-caddr args)))))
-
- (t (setq method (nth 0 args)
- user (nth 1 args)
- domain (nth 2 args)
- host (nth 3 args)
- port (nth 4 args)
- localname (nth 5 args)
- hop (nth 6 args))))
-
- ;; Unless `tramp-syntax' is `simplified', we need a method.
- (when (and (not (zerop (length tramp-postfix-method-format)))
- (zerop (length method)))
- (signal 'wrong-type-argument (list #'stringp method)))
- (concat tramp-prefix-format hop
- (unless (zerop (length tramp-postfix-method-format))
- (concat method tramp-postfix-method-format))
- user
- (unless (zerop (length domain))
- (concat tramp-prefix-domain-format domain))
- (unless (zerop (length user))
- tramp-postfix-user-format)
- (when host
- (if (string-match-p tramp-ipv6-regexp host)
- (concat
- tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)
- host))
- (unless (zerop (length port))
- (concat tramp-prefix-port-format port))
- tramp-postfix-host-format
- localname)))
-
-(defun tramp-make-tramp-hop-name (vec)
- "Construct a Tramp hop name from VEC."
- (replace-regexp-in-string
- tramp-prefix-regexp ""
- (replace-regexp-in-string
- (concat tramp-postfix-host-regexp "$") tramp-postfix-hop-format
- (tramp-make-tramp-file-name vec 'noloc))))
-
-(defun tramp-completion-make-tramp-file-name (method user host localname)
- "Construct a Tramp file name from METHOD, USER, HOST and LOCALNAME.
-It must not be a complete Tramp file name, but as long as there are
-necessary only. This function will be used in file name completion."
- (concat tramp-prefix-format
- (unless (or (zerop (length method))
- (zerop (length tramp-postfix-method-format)))
- (concat method tramp-postfix-method-format))
- (unless (zerop (length user))
- (concat user tramp-postfix-user-format))
- (unless (zerop (length host))
- (concat
- (if (string-match-p tramp-ipv6-regexp host)
- (concat
- tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)
- host)
- tramp-postfix-host-format))
- (when localname localname)))
-
-(defun tramp-get-buffer (vec)
- "Get the connection buffer to be used for VEC."
- (or (get-buffer (tramp-buffer-name vec))
- (with-current-buffer (get-buffer-create (tramp-buffer-name vec))
- ;; We use the existence of connection property "process-buffer"
- ;; as indication, whether a connection is active.
- (tramp-set-connection-property
- vec "process-buffer"
- (tramp-get-connection-property vec "process-buffer" nil))
- (setq buffer-undo-list t
- default-directory (tramp-make-tramp-file-name vec 'noloc 'nohop))
- (current-buffer))))
-
-(defun tramp-get-connection-buffer (vec)
- "Get the connection buffer to be used for VEC.
-In case a second asynchronous communication has been started, it is different
-from `tramp-get-buffer'."
- (or (tramp-get-connection-property vec "process-buffer" nil)
- (tramp-get-buffer vec)))
-
-(defun tramp-get-connection-name (vec)
- "Get the connection name to be used for VEC.
-In case a second asynchronous communication has been started, it is different
-from the default one."
- (or (tramp-get-connection-property vec "process-name" nil)
- (tramp-buffer-name vec)))
-
-(defun tramp-get-connection-process (vec)
- "Get the connection process to be used for VEC.
-In case a second asynchronous communication has been started, it is different
-from the default one."
- (and (tramp-file-name-p vec) (get-process (tramp-get-connection-name vec))))
-
-(defun tramp-set-connection-local-variables (vec)
- "Set connection-local variables in the connection buffer used for VEC.
-If connection-local variables are not supported by this Emacs
-version, the function does nothing."
- (with-current-buffer (tramp-get-connection-buffer vec)
- ;; `hack-connection-local-variables-apply' exists since Emacs 26.1.
- (tramp-compat-funcall
- 'hack-connection-local-variables-apply
- `(:application tramp
- :protocol ,(tramp-file-name-method vec)
- :user ,(tramp-file-name-user-domain vec)
- :machine ,(tramp-file-name-host-port vec)))))
-
-(defun tramp-set-connection-local-variables-for-buffer ()
- "Set connection-local variables in the current buffer.
-If connection-local variables are not supported by this Emacs
-version, the function does nothing."
- (when (file-remote-p default-directory)
- ;; `hack-connection-local-variables-apply' exists since Emacs 26.1.
- (tramp-compat-funcall
- 'hack-connection-local-variables-apply
- `(:application tramp
- :protocol ,(file-remote-p default-directory 'method)
- :user ,(file-remote-p default-directory 'user)
- :machine ,(file-remote-p default-directory 'host)))))
-
-(defun tramp-debug-buffer-name (vec)
- "A name for the debug buffer for VEC."
- (let ((method (tramp-file-name-method vec))
- (user-domain (tramp-file-name-user-domain vec))
- (host-port (tramp-file-name-host-port vec)))
- (if (not (zerop (length user-domain)))
- (format "*debug tramp/%s address@hidden" method user-domain host-port)
- (format "*debug tramp/%s %s*" method host-port))))
-
-(defconst tramp-debug-outline-regexp
- (concat
- "[0-9]+:[0-9]+:[0-9]+\\.[0-9]+ " ;; Timestamp.
- "\\(?:\\(#<thread .+>\\) \\)?" ;; Thread.
- "[a-z0-9-]+ (\\([0-9]+\\)) #") ;; Function name, verbosity.
- "Used for highlighting Tramp debug buffers in `outline-mode'.")
-
-(defconst tramp-debug-font-lock-keywords
- '(list
- (concat "^\\(?:" tramp-debug-outline-regexp "\\).+")
- '(1 font-lock-warning-face t t)
- '(0 (outline-font-lock-face) keep t))
- "Used for highlighting Tramp debug buffers in `outline-mode'.")
-
-(defun tramp-debug-outline-level ()
- "Return the depth to which a statement is nested in the outline.
-Point must be at the beginning of a header line.
-
-The outline level is equal to the verbosity of the Tramp message."
- (1+ (string-to-number (match-string 2))))
-
-(defun tramp-get-debug-buffer (vec)
- "Get the debug buffer for VEC."
- (with-current-buffer
- (get-buffer-create (tramp-debug-buffer-name vec))
- (when (bobp)
- (setq buffer-undo-list t)
- ;; Activate `outline-mode'. This runs `text-mode-hook' and
- ;; `outline-mode-hook'. We must prevent that local processes
- ;; die. Yes: I've seen `flyspell-mode', which starts "ispell".
- (let ((default-directory (tramp-compat-temporary-file-directory)))
- (outline-mode))
- (set (make-local-variable 'outline-level) 'tramp-debug-outline-level)
- (set (make-local-variable 'font-lock-keywords)
- `(t (eval ,tramp-debug-font-lock-keywords)
- ,(eval tramp-debug-font-lock-keywords)))
- ;; Do not edit the debug buffer.
- (use-local-map special-mode-map))
- (current-buffer)))
-
-(defsubst tramp-debug-message (vec fmt-string &rest arguments)
- "Append message to debug buffer.
-Message is formatted with FMT-STRING as control string and the remaining
-ARGUMENTS to actually emit the message (if applicable)."
- (with-current-buffer (tramp-get-debug-buffer vec)
- (goto-char (point-max))
- ;; Headline.
- (when (bobp)
- (insert
- (format
- ";; Emacs: %s Tramp: %s -*- mode: outline; -*-"
- emacs-version tramp-version))
- (when (>= tramp-verbose 10)
- (let ((tramp-verbose 0))
- (insert
- (format
- "\n;; Location: %s Git: %s/%s"
- (locate-library "tramp")
- (or tramp-repository-branch "")
- (or tramp-repository-version ""))))))
- (unless (bolp)
- (insert "\n"))
- ;; Timestamp.
- (let ((now (current-time)))
- (insert (format-time-string "%T." now))
- (insert (format "%06d " (nth 2 now))))
- ;; Threads.
- (unless (or (null tramp-compat-main-thread)
- (eq (tramp-compat-current-thread) tramp-compat-main-thread))
- (insert (format "%s " (tramp-compat-current-thread))))
- ;; Calling Tramp function. We suppress compat and trace functions
- ;; from being displayed.
- (let ((btn 1) btf fn)
- (while (not fn)
- (setq btf (nth 1 (backtrace-frame btn)))
- (if (not btf)
- (setq fn "")
- (when (symbolp btf)
- (setq fn (symbol-name btf))
- (unless
- (and
- (string-match-p "^tramp" fn)
- (not
- (string-match-p
- (eval-when-compile
- (concat
- "^"
- (regexp-opt
- '("tramp-backtrace"
- "tramp-compat-funcall"
- "tramp-condition-case-unless-debug"
- "tramp-debug-message"
- "tramp-error"
- "tramp-error-with-buffer"
- "tramp-message"
- "tramp-user-error")
- t)
- "$"))
- fn)))
- (setq fn nil)))
- (setq btn (1+ btn))))
- ;; The following code inserts filename and line number. Should
- ;; be inactive by default, because it is time consuming.
-; (let ((ffn (find-function-noselect (intern fn))))
-; (insert
-; (format
-; "%s:%d: "
-; (file-name-nondirectory (buffer-file-name (car ffn)))
-; (with-current-buffer (car ffn)
-; (1+ (count-lines (point-min) (cdr ffn)))))))
- (insert (format "%s " fn)))
- ;; The message.
- (insert (apply #'format-message fmt-string arguments))))
-
-(defvar tramp-message-show-message (null noninteractive)
- "Show Tramp message in the minibuffer.
-This variable is used to suppress progress reporter output, and
-to disable messages from `tramp-error'. Those messages are
-visible anyway, because an error is raised.")
-
-(defsubst tramp-message (vec-or-proc level fmt-string &rest arguments)
- "Emit a message depending on verbosity level.
-VEC-OR-PROC identifies the Tramp buffer to use. It can be either a
-vector or a process. LEVEL says to be quiet if `tramp-verbose' is
-less than LEVEL. The message is emitted only if `tramp-verbose' is
-greater than or equal to LEVEL.
-
-The message is also logged into the debug buffer when `tramp-verbose'
-is greater than or equal 4.
-
-Calls functions `message' and `tramp-debug-message' with FMT-STRING as
-control string and the remaining ARGUMENTS to actually emit the message (if
-applicable)."
- (ignore-errors
- (when (<= level tramp-verbose)
- ;; Display only when there is a minimum level.
- (when (and tramp-message-show-message (<= level 3))
- (apply #'message
- (concat
- (cond
- ((= level 0) "")
- ((= level 1) "")
- ((= level 2) "Warning: ")
- (t "Tramp: "))
- fmt-string)
- arguments))
- ;; Log only when there is a minimum level.
- (when (>= tramp-verbose 4)
- (let ((tramp-verbose 0))
- ;; Append connection buffer for error messages.
- (when (= level 1)
- (with-current-buffer
- (if (processp vec-or-proc)
- (process-buffer vec-or-proc)
- (tramp-get-connection-buffer vec-or-proc))
- (setq fmt-string (concat fmt-string "\n%s")
- arguments (append arguments (list (buffer-string))))))
- ;; Translate proc to vec.
- (when (processp vec-or-proc)
- (setq vec-or-proc (process-get vec-or-proc 'vector))))
- ;; Do it.
- (when (tramp-file-name-p vec-or-proc)
- (apply #'tramp-debug-message
- vec-or-proc
- (concat (format "(%d) # " level) fmt-string)
- arguments))))))
-
-(defsubst tramp-backtrace (&optional vec-or-proc)
- "Dump a backtrace into the debug buffer.
-If VEC-OR-PROC is nil, the buffer *debug tramp* is used. This
-function is meant for debugging purposes."
- (when (>= tramp-verbose 10)
- (if vec-or-proc
- (tramp-message
- vec-or-proc 10 "\n%s" (with-output-to-string (backtrace)))
- (with-output-to-temp-buffer "*debug tramp*" (backtrace)))))
-
-(defsubst tramp-error (vec-or-proc signal fmt-string &rest arguments)
- "Emit an error.
-VEC-OR-PROC identifies the connection to use, SIGNAL is the
-signal identifier to be raised, remaining arguments passed to
-`tramp-message'. Finally, signal SIGNAL is raised."
- (let (tramp-message-show-message)
- (tramp-backtrace vec-or-proc)
- (unless arguments
- ;; FMT-STRING could be just a file name, as in
- ;; `file-already-exists' errors. It could contain the ?\%
- ;; character, as in smb domain spec.
- (setq arguments (list fmt-string)
- fmt-string "%s"))
- (when vec-or-proc
- (tramp-message
- vec-or-proc 1 "%s"
- (error-message-string
- (list signal
- (get signal 'error-message)
- (apply #'format-message fmt-string arguments)))))
- (signal signal (list (apply #'format-message fmt-string arguments)))))
-
-(defsubst tramp-error-with-buffer
- (buf vec-or-proc signal fmt-string &rest arguments)
- "Emit an error, and show BUF.
-If BUF is nil, show the connection buf. Wait for 30\", or until
-an input event arrives. The other arguments are passed to `tramp-error'."
- (save-window-excursion
- (let* ((buf (or (and (bufferp buf) buf)
- (and (processp vec-or-proc) (process-buffer vec-or-proc))
- (and (tramp-file-name-p vec-or-proc)
- (tramp-get-connection-buffer vec-or-proc))))
- (vec (or (and (tramp-file-name-p vec-or-proc) vec-or-proc)
- (and buf (with-current-buffer buf
- (tramp-dissect-file-name default-directory))))))
- (unwind-protect
- (apply #'tramp-error vec-or-proc signal fmt-string arguments)
- ;; Save exit.
- (when (and buf
- tramp-message-show-message
- (not (zerop tramp-verbose))
- ;; Do not show when flagged from outside.
- (not (tramp-completion-mode-p))
- ;; Show only when Emacs has started already.
- (current-message))
- (let ((enable-recursive-minibuffers t))
- ;; `tramp-error' does not show messages. So we must do it
- ;; ourselves.
- (apply #'message fmt-string arguments)
- ;; Show buffer.
- (pop-to-buffer buf)
- (discard-input)
- (sit-for 30)))
- ;; Reset timestamp. It would be wrong after waiting for a while.
- (when (tramp-file-name-equal-p vec (car tramp-current-connection))
- (setcdr tramp-current-connection (current-time)))))))
-
-;; We must make it a defun, because it is used earlier already.
-(defun tramp-user-error (vec-or-proc fmt-string &rest arguments)
- "Signal a pilot error."
- (unwind-protect
- (apply
- #'tramp-error vec-or-proc
- ;; `user-error' has appeared in Emacs 24.3.
- (if (fboundp 'user-error) 'user-error 'error) fmt-string arguments)
- ;; Save exit.
- (when (and tramp-message-show-message
- (not (zerop tramp-verbose))
- ;; Do not show when flagged from outside.
- (not (tramp-completion-mode-p))
- ;; Show only when Emacs has started already.
- (current-message))
- (let ((enable-recursive-minibuffers t))
- ;; `tramp-error' does not show messages. So we must do it ourselves.
- (apply #'message fmt-string arguments)
- (discard-input)
- (sit-for 30)
- ;; Reset timestamp. It would be wrong after waiting for a while.
- (when
- (tramp-file-name-equal-p vec-or-proc (car tramp-current-connection))
- (setcdr tramp-current-connection (current-time)))))))
-
-(defmacro tramp-with-demoted-errors (vec-or-proc format &rest body)
- "Execute BODY while redirecting the error message to `tramp-message'.
-BODY is executed like wrapped by `with-demoted-errors'. FORMAT
-is a format-string containing a %-sequence meaning to substitute
-the resulting error message."
- (declare (debug (symbolp body))
- (indent 2))
- (let ((err (make-symbol "err")))
- `(condition-case-unless-debug ,err
- (progn ,@body)
- (error (tramp-message ,vec-or-proc 3 ,format ,err) nil))))
-
-(defmacro with-parsed-tramp-file-name (filename var &rest body)
- "Parse a Tramp filename and make components available in the body.
-
-First arg FILENAME is evaluated and dissected into its components.
-Second arg VAR is a symbol. It is used as a variable name to hold
-the filename structure. It is also used as a prefix for the variables
-holding the components. For example, if VAR is the symbol `foo', then
-`foo' will be bound to the whole structure, `foo-method' will be bound to
-the method component, and so on for `foo-user', `foo-domain', `foo-host',
-`foo-port', `foo-localname', `foo-hop'.
-
-Remaining args are Lisp expressions to be evaluated (inside an implicit
-`progn').
-
-If VAR is nil, then we bind `v' to the structure and `method', `user',
-`domain', `host', `port', `localname', `hop' to the components."
- (let ((bindings
- (mapcar (lambda (elem)
- `(,(if var (intern (format "%s-%s" var elem)) elem)
- (,(intern (format "tramp-file-name-%s" elem))
- ,(or var 'v))))
- `,(tramp-compat-tramp-file-name-slots))))
- `(let* ((,(or var 'v) (tramp-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)))
-
-(put 'with-parsed-tramp-file-name 'lisp-indent-function 2)
-(put 'with-parsed-tramp-file-name 'edebug-form-spec '(form symbolp body))
-(font-lock-add-keywords 'emacs-lisp-mode
'("\\<with-parsed-tramp-file-name\\>"))
-
-(defun tramp-progress-reporter-update (reporter &optional value)
- "Report progress of an operation for Tramp."
- (let* ((parameters (cdr reporter))
- (message (aref parameters 3)))
- (when (string-match-p message (or (current-message) ""))
- (progress-reporter-update reporter value))))
-
-(defmacro with-tramp-progress-reporter (vec level message &rest body)
- "Executes BODY, spinning a progress reporter with MESSAGE.
-If LEVEL does not fit for visible messages, there are only traces
-without a visible progress reporter."
- (declare (indent 3) (debug t))
- `(progn
- (tramp-message ,vec ,level "%s..." ,message)
- (let ((cookie "failed")
- (tm
- ;; We start a pulsing progress reporter after 3 seconds.
- (when (and tramp-message-show-message
- ;; Display only when there is a minimum level.
- (<= ,level (min tramp-verbose 3)))
- (let ((pr (make-progress-reporter ,message nil nil)))
- (when pr
- (run-at-time
- 3 0.1 #'tramp-progress-reporter-update pr))))))
- (unwind-protect
- ;; Execute the body.
- (prog1 (progn ,@body) (setq cookie "done"))
- ;; Stop progress reporter.
- (if tm (cancel-timer tm))
- (tramp-message ,vec ,level "%s...%s" ,message cookie)))))
-
-(font-lock-add-keywords
- 'emacs-lisp-mode '("\\<with-tramp-progress-reporter\\>"))
-
-(defmacro with-tramp-file-property (vec file property &rest body)
- "Check in Tramp cache for PROPERTY, otherwise execute BODY and set cache.
-FILE must be a local file name on a connection identified via VEC."
- `(if (file-name-absolute-p ,file)
- (let ((value (tramp-get-file-property ,vec ,file ,property 'undef)))
- (when (eq value 'undef)
- ;; We cannot pass @body as parameter to
- ;; `tramp-set-file-property' because it mangles our
- ;; debug messages.
- (setq value (progn ,@body))
- (tramp-set-file-property ,vec ,file ,property value))
- value)
- ,@body))
-
-(put 'with-tramp-file-property 'lisp-indent-function 3)
-(put 'with-tramp-file-property 'edebug-form-spec t)
-(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-file-property\\>"))
-
-(defmacro with-tramp-connection-property (key property &rest body)
- "Check in Tramp for property PROPERTY, otherwise executes BODY and set."
- `(let ((value (tramp-get-connection-property ,key ,property 'undef)))
- (when (eq value 'undef)
- ;; We cannot pass ,@body as parameter to
- ;; `tramp-set-connection-property' because it mangles our debug
- ;; messages.
- (setq value (progn ,@body))
- (tramp-set-connection-property ,key ,property value))
- value))
-
-(put 'with-tramp-connection-property 'lisp-indent-function 2)
-(put 'with-tramp-connection-property 'edebug-form-spec t)
-(font-lock-add-keywords
- 'emacs-lisp-mode '("\\<with-tramp-connection-property\\>"))
-
-(defun tramp-drop-volume-letter (name)
- "Cut off unnecessary drive letter from file NAME.
-The functions `tramp-*-handle-expand-file-name' call `expand-file-name'
-locally on a remote file name. When the local system is a W32 system
-but the remote system is Unix, this introduces a superfluous drive
-letter into the file name. This function removes it."
- (save-match-data
- (funcall
- (if (tramp-compat-file-name-quoted-p name)
- #'tramp-compat-file-name-quote #'identity)
- (let ((name (tramp-compat-file-name-unquote name)))
- (if (string-match "\\`[a-zA-Z]:/" name)
- (replace-match "/" nil t name)
- name)))))
-
-;;; Config Manipulation Functions:
-
-(defun tramp-set-completion-function (method function-list)
- "Sets the list of completion functions for METHOD.
-FUNCTION-LIST is a list of entries of the form (FUNCTION FILE).
-The FUNCTION is intended to parse FILE according its syntax.
-It might be a predefined FUNCTION, or a user defined FUNCTION.
-For the list of predefined FUNCTIONs see `tramp-completion-function-alist'.
-
-Example:
-
- (tramp-set-completion-function
- \"ssh\"
- \\='((tramp-parse-sconfig \"/etc/ssh_config\")
- (tramp-parse-sconfig \"~/.ssh/config\")))"
- (let ((r function-list)
- (v function-list))
- (setq tramp-completion-function-alist
- (delete (assoc method tramp-completion-function-alist)
- tramp-completion-function-alist))
-
- (while v
- ;; Remove double entries.
- (when (member (car v) (cdr v))
- (setcdr v (delete (car v) (cdr v))))
- ;; Check for function and file or registry key.
- (unless (and (functionp (nth 0 (car v)))
- (cond
- ;; Windows registry.
- ((string-match-p "^HKEY_CURRENT_USER" (nth 1 (car v)))
- (and (memq system-type '(cygwin windows-nt))
- (zerop
- (tramp-call-process
- v "reg" nil nil nil "query" (nth 1 (car v))))))
- ;; Zeroconf service type.
- ((string-match-p
- "^_[[:alpha:]]+\\._[[:alpha:]]+$" (nth 1 (car v))))
- ;; Configuration file.
- (t (file-exists-p (nth 1 (car v))))))
- (setq r (delete (car v) r)))
- (setq v (cdr v)))
-
- (when r
- (add-to-list 'tramp-completion-function-alist
- (cons method r)))))
-
-(defun tramp-get-completion-function (method)
- "Returns a list of completion functions for METHOD.
-For definition of that list see `tramp-set-completion-function'."
- (append
- `(;; Default settings are taken into account.
- (tramp-parse-default-user-host ,method)
- ;; Hits from auth-sources.
- (tramp-parse-auth-sources ,method)
- ;; Hosts visited once shall be remembered.
- (tramp-parse-connection-properties ,method))
- ;; The method related defaults.
- (cdr (assoc method tramp-completion-function-alist))))
-
-;; Inodes don't exist for some file systems. Therefore we must
-;; generate virtual ones. Used in `find-buffer-visiting'. The method
-;; applied might be not so efficient (Ange-FTP uses hashes). But
-;; performance isn't the major issue given that file transfer will
-;; take time.
-(defvar tramp-inodes 0
- "Keeps virtual inodes numbers.")
-
-;; Devices must distinguish physical file systems. The device numbers
-;; provided by "lstat" aren't unique, because we operate on different hosts.
-;; So we use virtual device numbers, generated by Tramp. Both Ange-FTP and
-;; EFS use device number "-1". In order to be different, we use device number
-;; (-1 . x), whereby "x" is unique for a given (method user host).
-(defvar tramp-devices 0
- "Keeps virtual device numbers.")
-
-(defun tramp-default-file-modes (filename)
- "Return file modes of FILENAME as integer.
-If the file modes of FILENAME cannot be determined, return the
-value of `default-file-modes', without execute permissions."
- (or (file-modes filename)
- (logand (default-file-modes) #o0666)))
-
-(defun tramp-replace-environment-variables (filename)
- "Replace environment variables in FILENAME.
-Return the string with the replaced variables."
- (or (ignore-errors
- ;; Optional arg has been introduced with Emacs 24.4.
- (tramp-compat-funcall 'substitute-env-vars filename 'only-defined))
- ;; We need an own implementation.
- (save-match-data
- (let ((idx (string-match "\\$\\(\\w+\\)" filename)))
- ;; `$' is coded as `$$'.
- (when (and idx
- (or (zerop idx) (not (eq ?$ (aref filename (1- idx)))))
- (getenv (match-string 1 filename)))
- (setq filename
- (replace-match
- (substitute-in-file-name (match-string 0 filename))
- t nil filename)))
- filename))))
-
-(defun tramp-find-file-name-coding-system-alist (filename tmpname)
- "Like `find-operation-coding-system' for Tramp filenames.
-Tramp's `insert-file-contents' and `write-region' work over
-temporary file names. If `file-coding-system-alist' contains an
-expression, which matches more than the file name suffix, the
-coding system might not be determined. This function repairs it."
- (let (result)
- (dolist (elt file-coding-system-alist (nreverse result))
- (when (and (consp elt) (string-match-p (car elt) filename))
- ;; We found a matching entry in `file-coding-system-alist'.
- ;; So we add a similar entry, but with the temporary file name
- ;; as regexp.
- (push (cons (regexp-quote tmpname) (cdr elt)) result)))))
-
-(defun tramp-run-real-handler (operation args)
- "Invoke normal file name handler for OPERATION.
-First arg specifies the OPERATION, second arg is a list of arguments to
-pass to the OPERATION."
- (let* ((inhibit-file-name-handlers
- `(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
- .
- ,(and (eq inhibit-file-name-operation operation)
- inhibit-file-name-handlers)))
- (inhibit-file-name-operation operation))
- (apply operation args)))
-
-;; We handle here all file primitives. Most of them have the file
-;; name as first parameter; nevertheless we check for them explicitly
-;; in order to be signaled if a new primitive appears. This
-;; scenario is needed because there isn't a way to decide by
-;; syntactical means whether a foreign method must be called. It would
-;; ease the life if `file-name-handler-alist' would support a decision
-;; function as well but regexp only.
-(defun tramp-file-name-for-operation (operation &rest args)
- "Return file name related to OPERATION file primitive.
-ARGS are the arguments OPERATION has been called with.
-
-It does not always return a Tramp file name, for example if the
-first argument of `expand-file-name' is absolute and not remote.
-Must be handled by the callers."
- (cond
- ;; FILE resp DIRECTORY.
- ((member operation
- '(access-file byte-compiler-base-file-name delete-directory
- delete-file diff-latest-backup-file directory-file-name
- directory-files directory-files-and-attributes
- dired-compress-file dired-uncache file-acl
- file-accessible-directory-p file-attributes
- file-directory-p file-executable-p file-exists-p
- file-local-copy file-modes file-name-as-directory
- file-name-directory file-name-nondirectory
- file-name-sans-versions file-notify-add-watch
- file-ownership-preserved-p file-readable-p
- file-regular-p file-remote-p file-selinux-context
- file-symlink-p file-truename file-writable-p
- find-backup-file-name get-file-buffer
- insert-directory insert-file-contents load
- make-directory make-directory-internal set-file-acl
- set-file-modes set-file-selinux-context set-file-times
- substitute-in-file-name unhandled-file-name-directory
- vc-registered
- ;; Emacs 26+ only.
- file-name-case-insensitive-p
- ;; Emacs 27+ only.
- file-system-info
- ;; Tramp internal magic file name function.
- tramp-set-file-uid-gid))
- (if (file-name-absolute-p (nth 0 args))
- (nth 0 args)
- default-directory))
- ;; FILE DIRECTORY resp FILE1 FILE2.
- ((member operation
- '(add-name-to-file copy-directory copy-file
- file-equal-p file-in-directory-p
- file-name-all-completions file-name-completion
- ;; Starting with Emacs 26.1, just the 2nd argument of
- ;; `make-symbolic-link' matters. For backward
- ;; compatibility, we still accept the first argument as
- ;; file name to be checked. Handled properly in
- ;; `tramp-handle-*-make-symbolic-link'.
- file-newer-than-file-p make-symbolic-link rename-file))
- (cond
- ((tramp-tramp-file-p (nth 0 args)) (nth 0 args))
- ((tramp-tramp-file-p (nth 1 args)) (nth 1 args))
- (t default-directory)))
- ;; FILE DIRECTORY resp FILE1 FILE2.
- ((eq operation 'expand-file-name)
- (cond
- ((file-name-absolute-p (nth 0 args)) (nth 0 args))
- ((tramp-tramp-file-p (nth 1 args)) (nth 1 args))
- (t default-directory)))
- ;; START END FILE.
- ((eq operation 'write-region)
- (if (file-name-absolute-p (nth 2 args))
- (nth 2 args)
- default-directory))
- ;; BUFFER.
- ((member operation
- '(make-auto-save-file-name
- set-visited-file-modtime verify-visited-file-modtime))
- (buffer-file-name
- (if (bufferp (nth 0 args)) (nth 0 args) (current-buffer))))
- ;; COMMAND.
- ((member operation
- '(process-file shell-command start-file-process
- ;; Emacs 26+ only.
- make-nearby-temp-file temporary-file-directory
- ;; Emacs 27+ only.
- exec-path make-process))
- default-directory)
- ;; PROC.
- ((member operation
- '(file-notify-rm-watch
- ;; Emacs 25+ only.
- file-notify-valid-p))
- (when (processp (nth 0 args))
- (with-current-buffer (process-buffer (nth 0 args))
- default-directory)))
- ;; Unknown file primitive.
- (t (error "unknown file I/O primitive: %s" operation))))
-
-(defun tramp-find-foreign-file-name-handler (filename &optional _operation)
- "Return foreign file name handler if exists."
- (when (tramp-tramp-file-p filename)
- (let ((handler tramp-foreign-file-name-handler-alist)
- elt res)
- (while handler
- (setq elt (car handler)
- handler (cdr handler))
- (when (funcall (car elt) filename)
- (setq handler nil
- res (cdr elt))))
- res)))
-
-(defvar tramp-debug-on-error nil
- "Like `debug-on-error' but used Tramp internal.")
-
-(defmacro tramp-condition-case-unless-debug
- (var bodyform &rest handlers)
- "Like `condition-case-unless-debug' but `tramp-debug-on-error'."
- (declare (debug condition-case) (indent 2))
- `(let ((debug-on-error tramp-debug-on-error))
- (condition-case-unless-debug ,var ,bodyform ,@handlers)))
-
-;; In Emacs, there is some concurrency due to timers. If a timer
-;; interrupts Tramp and wishes to use the same connection buffer as
-;; the "main" Emacs, then garbage might occur in the connection
-;; buffer. Therefore, we need to make sure that a timer does not use
-;; the same connection buffer as the "main" Emacs. We implement a
-;; cheap global lock, instead of locking each connection buffer
-;; separately. The global lock is based on two variables,
-;; `tramp-locked' and `tramp-locker'. `tramp-locked' is set to true
-;; (with setq) to indicate a lock. But Tramp also calls itself during
-;; processing of a single file operation, so we need to allow
-;; recursive calls. That's where the `tramp-locker' variable comes in
-;; -- it is let-bound to t during the execution of the current
-;; handler. So if `tramp-locked' is t and `tramp-locker' is also t,
-;; then we should just proceed because we have been called
-;; recursively. But if `tramp-locker' is nil, then we are a timer
-;; interrupting the "main" Emacs, and then we signal an error.
-
-(defvar tramp-locked nil
- "If non-nil, then Tramp is currently busy.
-Together with `tramp-locker', this implements a locking mechanism
-preventing reentrant calls of Tramp.")
-
-(defvar tramp-locker nil
- "If non-nil, then a caller has locked Tramp.
-Together with `tramp-locked', this implements a locking mechanism
-preventing reentrant calls of Tramp.")
-
-;; Mutexes have entered Emacs 26.1.
-(defvar tramp-mutex (tramp-compat-funcall 'make-mutex "tramp")
- "Global mutex for Tramp threads.")
-
-(defun tramp-get-mutex (vec)
- "Return the mutex locking Tramp threads for VEC."
- (let ((p (tramp-get-connection-process vec)))
- (if p
- (with-tramp-connection-property p "mutex"
- (tramp-compat-funcall 'make-mutex (process-name p)))
- tramp-mutex)))
-
-;; Main function.
-(defun tramp-file-name-handler (operation &rest args)
- "Invoke Tramp file name handler.
-Falls back to normal file name handler if no Tramp file name handler exists.
-If Emacs is compiled --with-threads, the body is protected by a mutex."
- (let ((filename (apply #'tramp-file-name-for-operation operation args)))
- (if (tramp-tramp-file-p filename)
- (save-match-data
- (setq filename (tramp-replace-environment-variables filename))
- (with-parsed-tramp-file-name filename nil
- ;; Give other threads a chance.
- (tramp-compat-thread-yield)
- ;; The mutex allows concurrent run of operations. It
- ;; guarantees, that the threads are not mixed.
- (tramp-compat-with-mutex (tramp-get-mutex v)
- (let ((completion (tramp-completion-mode-p))
- (foreign
- (tramp-find-foreign-file-name-handler filename operation))
- result)
- ;; Call the backend function.
- (if foreign
- (tramp-condition-case-unless-debug err
- (let ((sf (symbol-function foreign))
- p)
- ;; Some packages set the default directory to
- ;; a remote path, before respective Tramp
- ;; packages are already loaded. This results
- ;; in recursive loading. Therefore, we load
- ;; the Tramp packages locally.
- (when (autoloadp sf)
- (let ((default-directory
- (tramp-compat-temporary-file-directory))
- file-name-handler-alist)
- (load (cadr sf) 'noerror 'nomessage)))
- ;; (tramp-message
- ;; v 4 "Running `%s'..." (cons operation args))
- ;; Switch process thread.
- (when (and tramp-mutex
- (setq p (tramp-get-connection-process v)))
- (tramp-compat-funcall
- 'set-process-thread p (tramp-compat-current-thread)))
- ;; If `non-essential' is non-nil, Tramp shall
- ;; not open a new connection.
- ;; If Tramp detects that it shouldn't continue
- ;; to work, it throws the `suppress' event.
- ;; This could happen for example, when Tramp
- ;; tries to open the same connection twice in
- ;; a short time frame.
- ;; In both cases, we try the default handler
- ;; then.
- (setq result
- (catch 'non-essential
- (catch 'suppress
- (when (and tramp-locked (not tramp-locker))
- (setq tramp-locked nil)
- (tramp-error
- (car-safe tramp-current-connection)
- 'file-error
- "Forbidden reentrant call of Tramp"))
- (let ((tl tramp-locked))
- (setq tramp-locked t)
- (unwind-protect
- (let ((tramp-locker t))
- (apply foreign operation args))
- (setq tramp-locked tl))))))
- ;; (tramp-message
- ;; v 4 "Running `%s'...`%s'" (cons operation args)
result)
- (cond
- ((eq result 'non-essential)
- (tramp-message
- v 5 "Non-essential received in operation %s"
- (cons operation args))
- (tramp-run-real-handler operation args))
- ((eq result 'suppress)
- (let (tramp-message-show-message)
- (tramp-message
- v 1 "Suppress received in operation %s"
- (cons operation args))
- (tramp-cleanup-connection v t)
- (tramp-run-real-handler operation args)))
- (t result)))
-
- ;; Trace that somebody has interrupted the operation.
- ((debug quit)
- (let (tramp-message-show-message)
- (tramp-message
- v 1 "Interrupt received in operation %s"
- (cons operation args)))
- ;; Propagate the signal.
- (signal (car err) (cdr err)))
-
- ;; When we are in completion mode, some failed
- ;; operations shall return at least a default
- ;; value in order to give the user a chance to
- ;; correct the file name in the minibuffer. In
- ;; order to get a full backtrace, one could
- ;; apply (setq tramp-debug-on-error t)
- (error
- (cond
- ((and completion (zerop (length localname))
- (memq operation
- '(file-exists-p file-directory-p)))
- t)
- ((and completion (zerop (length localname))
- (memq operation
- '(expand-file-name file-name-as-directory)))
- filename)
- ;; Propagate the error.
- (t (signal (car err) (cdr err))))))
-
- ;; Nothing to do for us. However, since we are in
- ;; `tramp-mode', we must suppress the volume letter
- ;; on MS Windows.
- (setq result (tramp-run-real-handler operation args))
- (if (stringp result)
- (tramp-drop-volume-letter result)
- result))))))
-
- ;; When `tramp-mode' is not enabled, or the file name is quoted,
- ;; we don't do anything.
- (tramp-run-real-handler operation args))))
-
-(defun tramp-completion-file-name-handler (operation &rest args)
- "Invoke Tramp file name completion handler.
-Falls back to normal file name handler if no Tramp file name handler exists."
- (let ((fn (assoc operation tramp-completion-file-name-handler-alist)))
- (if (and fn tramp-mode)
- (save-match-data (apply (cdr fn) args))
- (tramp-run-real-handler operation args))))
-
-;;;###autoload
-(progn (defun tramp-autoload-file-name-handler (operation &rest args)
- "Load Tramp file name handler, and perform OPERATION."
- (tramp-unload-file-name-handlers)
- (if tramp-mode
- (let ((default-directory temporary-file-directory))
- (load "tramp" 'noerror 'nomessage)))
- (apply operation args)))
-
-;; `tramp-autoload-file-name-handler' must be registered before
-;; evaluation of site-start and init files, because there might exist
-;; remote files already, f.e. files kept via recentf-mode.
-;;;###autoload
-(progn (defun tramp-register-autoload-file-name-handlers ()
- "Add Tramp file name handlers to `file-name-handler-alist' during autoload."
- (add-to-list 'file-name-handler-alist
- (cons tramp-autoload-file-name-regexp
- 'tramp-autoload-file-name-handler))
- (put 'tramp-autoload-file-name-handler 'safe-magic t)))
-
-;;;###autoload (tramp-register-autoload-file-name-handlers)
-
-(defun tramp-use-absolute-autoload-file-names ()
- "Change Tramp autoload objects to use absolute file names.
-This avoids problems during autoload, when `load-path' contains
-remote file names."
- ;; We expect all other Tramp files in the same directory as tramp.el.
- (let* ((dir (expand-file-name (file-name-directory (locate-library
"tramp"))))
- (files-regexp
- (format
- "^%s$"
- (regexp-opt
- (mapcar
- #'file-name-sans-extension
- (directory-files dir nil "^tramp.+\\.elc?$"))
- 'paren))))
- (mapatoms
- (lambda (atom)
- (when (and (functionp atom)
- (autoloadp (symbol-function atom))
- (string-match-p files-regexp (cadr (symbol-function atom))))
- (ignore-errors
- (setf (cadr (symbol-function atom))
- (expand-file-name (cadr (symbol-function atom)) dir))))))))
-
-(tramp--with-startup (tramp-use-absolute-autoload-file-names))
-
-(defun tramp-register-file-name-handlers ()
- "Add Tramp file name handlers to `file-name-handler-alist'."
- ;; Remove autoloaded handlers from file name handler alist. Useful,
- ;; if `tramp-syntax' has been changed.
- (tramp-unload-file-name-handlers)
-
- ;; Add the handlers. We do not add anything to the `operations'
- ;; 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))
- (put 'tramp-file-name-handler 'safe-magic t)
-
- (add-to-list 'file-name-handler-alist
- (cons tramp-completion-file-name-regexp
- #'tramp-completion-file-name-handler))
- (put 'tramp-completion-file-name-handler 'safe-magic t)
- ;; Mark `operations' the handler is responsible for.
- (put 'tramp-completion-file-name-handler 'operations
- (mapcar #'car tramp-completion-file-name-handler-alist))
-
- (when (bound-and-true-p tramp-archive-enabled)
- (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))
- (let ((entry (rassoc fnh file-name-handler-alist)))
- (when entry
- (setq file-name-handler-alist
- (cons entry (delete entry file-name-handler-alist)))))))
-
-(tramp--with-startup (tramp-register-file-name-handlers))
-
-(defun tramp-register-foreign-file-name-handler
- (func handler &optional append)
- "Register (FUNC . HANDLER) in `tramp-foreign-file-name-handler-alist'.
-FUNC is the function, which determines whether HANDLER is to be called.
-Add operations defined in `HANDLER-alist' to `tramp-file-name-handler'."
- (add-to-list
- 'tramp-foreign-file-name-handler-alist `(,func . ,handler) append)
- ;; Mark `operations' the handler is responsible for.
- (put 'tramp-file-name-handler
- 'operations
- (delete-dups
- (append
- (get 'tramp-file-name-handler 'operations)
- (mapcar
- #'car
- (symbol-value (intern (concat (symbol-name handler) "-alist"))))))))
-
-(defun tramp-exists-file-name-handler (operation &rest args)
- "Check, whether OPERATION runs a file name handler."
- ;; The file name handler is determined on base of either an
- ;; argument, `buffer-file-name', or `default-directory'.
- (ignore-errors
- (let* ((buffer-file-name "/")
- (default-directory "/")
- (fnha file-name-handler-alist)
- (check-file-name-operation operation)
- (file-name-handler-alist
- (list
- (cons "/"
- (lambda (operation &rest args)
- "Returns OPERATION if it is the one to be checked."
- (if (equal check-file-name-operation operation)
- operation
- (let ((file-name-handler-alist fnha))
- (apply operation args))))))))
- (equal (apply operation args) operation))))
-
-;;;###autoload
-(progn (defun tramp-unload-file-name-handlers ()
- "Unload Tramp file name handlers from `file-name-handler-alist'."
- (dolist (fnh file-name-handler-alist)
- (when (and (symbolp (cdr fnh))
- (string-prefix-p "tramp-" (symbol-name (cdr fnh))))
- (setq file-name-handler-alist (delq fnh file-name-handler-alist))))))
-
-(add-hook 'tramp-unload-hook #'tramp-unload-file-name-handlers)
-
-;;; File name handler functions for completion mode:
-
-;;;###autoload
-(defvar tramp-completion-mode nil
- "If non-nil, external packages signal that they are in file name
completion.")
-(make-obsolete-variable 'tramp-completion-mode 'non-essential "26.1")
-
-(defun tramp-completion-mode-p ()
- "Check, whether method / user name / host name completion is active."
- (or
- ;; Signal from outside.
- non-essential
- ;; This variable has been obsoleted in Emacs 26.
- tramp-completion-mode))
-
-(defun tramp-connectable-p (filename)
- "Check, whether it is possible to connect the remote host w/o side-effects.
-This is true, if either the remote host is already connected, or if we are
-not in completion mode."
- (let (tramp-verbose)
- (and (tramp-tramp-file-p filename)
- (or (not (tramp-completion-mode-p))
- (process-live-p
- (tramp-get-connection-process
- (tramp-dissect-file-name filename)))))))
-
-;; Method, host name and user name completion.
-;; `tramp-completion-dissect-file-name' returns a list of
-;; `tramp-file-name' structures. For all of them we return possible
-;; completions.
-(defun tramp-completion-handle-file-name-all-completions (filename directory)
- "Like `file-name-all-completions' for partial Tramp files."
- (let ((fullname
- (tramp-drop-volume-letter (expand-file-name filename directory)))
- hop result result1)
-
- ;; Suppress hop from completion.
- (when (string-match
- (concat
- tramp-prefix-regexp
- "\\(" "\\(" tramp-remote-file-name-spec-regexp
- tramp-postfix-hop-regexp
- "\\)+" "\\)")
- fullname)
- (setq hop (match-string 1 fullname)
- fullname (replace-match "" nil nil fullname 1)))
-
- ;; Possible completion structures.
- (dolist (elt (tramp-completion-dissect-file-name fullname))
- (let* ((method (tramp-file-name-method elt))
- (user (tramp-file-name-user elt))
- (host (tramp-file-name-host elt))
- (localname (tramp-file-name-localname elt))
- (m (tramp-find-method method user host))
- all-user-hosts)
-
- (unless localname ;; Nothing to complete.
-
- (if (or user host)
-
- ;; Method dependent user / host combinations.
- (progn
- (mapc
- (lambda (x)
- (setq all-user-hosts
- (append all-user-hosts
- (funcall (nth 0 x) (nth 1 x)))))
- (tramp-get-completion-function m))
-
- (setq result
- (append result
- (mapcar
- (lambda (x)
- (tramp-get-completion-user-host
- method user host (nth 0 x) (nth 1 x)))
- (delq nil all-user-hosts)))))
-
- ;; Possible methods.
- (setq result
- (append result (tramp-get-completion-methods m)))))))
-
- ;; Unify list, add hop, remove nil elements.
- (dolist (elt result)
- (when elt
- (string-match tramp-prefix-regexp elt)
- (setq elt (replace-match (concat tramp-prefix-format hop) nil nil elt))
- (push
- (substring elt (length (tramp-drop-volume-letter directory)))
- result1)))
-
- ;; Complete local parts.
- (append
- result1
- (ignore-errors
- (tramp-run-real-handler
- 'file-name-all-completions (list filename directory))))))
-
-;; Method, host name and user name completion for a file.
-(defun tramp-completion-handle-file-name-completion
- (filename directory &optional predicate)
- "Like `file-name-completion' for Tramp files."
- (try-completion
- filename
- (mapcar #'list (file-name-all-completions filename directory))
- (when (and predicate
- (tramp-connectable-p (expand-file-name filename directory)))
- (lambda (x) (funcall predicate (expand-file-name (car x) directory))))))
-
-;; I misuse a little bit the `tramp-file-name' structure in order to
-;; handle completion possibilities for partial methods / user names /
-;; host names. Return value is a list of `tramp-file-name' structures
-;; according to possible completions. If "localname" is non-nil it
-;; means there shouldn't be a completion anymore.
-
-;; Expected results:
-
-;; "/x" "/[x"
-;; ["x" nil nil nil]
-
-;; "/x:" "/[x/" "/x:y" "/[x/y" "/x:y:" "/[x/y]"
-;; ["x" nil "" nil] ["x" nil "y" nil] ["x" nil "y" ""]
-;; ["x" "" nil nil] ["x" "y" nil nil]
-
-;; "/x:y@""/[x/y@" "/x:address@hidden" "/[x/address@hidden"
"/x:address@hidden:" "/[x/address@hidden"
-;;["x" "y" nil nil] ["x" "y" "z" nil] ["x" "y" "z" ""]
-(defun tramp-completion-dissect-file-name (name)
- "Returns a list of `tramp-file-name' structures.
-They are collected by `tramp-completion-dissect-file-name1'."
- (let* ((x-nil "\\|\\(\\)")
- (tramp-completion-ipv6-regexp
- (format
- "[^%s]*"
- (if (zerop (length tramp-postfix-ipv6-format))
- tramp-postfix-host-format
- tramp-postfix-ipv6-format)))
- ;; "/method" "/[method"
- (tramp-completion-file-name-structure1
- (list
- (concat
- tramp-prefix-regexp
- "\\(" tramp-method-regexp x-nil "\\)$")
- 1 nil nil nil))
- ;; "/method:user" "/[method/user"
- (tramp-completion-file-name-structure2
- (list
- (concat
- tramp-prefix-regexp
- "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
- "\\(" tramp-user-regexp x-nil "\\)$")
- 1 2 nil nil))
- ;; "/method:host" "/[method/host"
- (tramp-completion-file-name-structure3
- (list
- (concat
- tramp-prefix-regexp
- "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
- "\\(" tramp-host-regexp x-nil "\\)$")
- 1 nil 2 nil))
- ;; "/method:[ipv6" "/[method/ipv6"
- (tramp-completion-file-name-structure4
- (list
- (concat
- tramp-prefix-regexp
- "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
- tramp-prefix-ipv6-regexp
- "\\(" tramp-completion-ipv6-regexp x-nil "\\)$")
- 1 nil 2 nil))
- ;; "/method:address@hidden" "/[method/address@hidden"
- (tramp-completion-file-name-structure5
- (list
- (concat
- tramp-prefix-regexp
- "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
- "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
- "\\(" tramp-host-regexp x-nil "\\)$")
- 1 2 3 nil))
- ;; "/method:address@hidden" "/[method/address@hidden"
- (tramp-completion-file-name-structure6
- (list
- (concat
- tramp-prefix-regexp
- "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
- "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
- tramp-prefix-ipv6-regexp
- "\\(" tramp-completion-ipv6-regexp x-nil "\\)$")
- 1 2 3 nil)))
- (delq
- nil
- (mapcar
- (lambda (structure) (tramp-completion-dissect-file-name1 structure name))
- (list
- tramp-completion-file-name-structure1
- tramp-completion-file-name-structure2
- tramp-completion-file-name-structure3
- tramp-completion-file-name-structure4
- tramp-completion-file-name-structure5
- tramp-completion-file-name-structure6)))))
-
-(defun tramp-completion-dissect-file-name1 (structure name)
- "Returns a `tramp-file-name' structure matching STRUCTURE.
-The structure consists of remote method, remote user,
-remote host and localname (filename on remote host)."
- (save-match-data
- (when (string-match (nth 0 structure) name)
- (make-tramp-file-name
- :method (and (nth 1 structure)
- (match-string (nth 1 structure) name))
- :user (and (nth 2 structure)
- (match-string (nth 2 structure) name))
- :host (and (nth 3 structure)
- (match-string (nth 3 structure) name))))))
-
-;; This function returns all possible method completions, adding the
-;; trailing method delimiter.
-(defun tramp-get-completion-methods (partial-method)
- "Returns all method completions for PARTIAL-METHOD."
- (mapcar
- (lambda (method)
- (and method
- (string-match-p (concat "^" (regexp-quote partial-method)) method)
- (tramp-completion-make-tramp-file-name method nil nil nil)))
- (mapcar #'car tramp-methods)))
-
-;; Compares partial user and host names with possible completions.
-(defun tramp-get-completion-user-host
- (method partial-user partial-host user host)
- "Returns the most expanded string for user and host name completion.
-PARTIAL-USER must match USER, PARTIAL-HOST must match HOST."
- (cond
-
- ((and partial-user partial-host)
- (if (and host
- (string-match-p (concat "^" (regexp-quote partial-host)) host)
- (string-equal partial-user (or user partial-user)))
- (setq user partial-user)
- (setq user nil
- host nil)))
-
- (partial-user
- (setq host nil)
- (unless
- (and user
- (string-match-p (concat "^" (regexp-quote partial-user)) user))
- (setq user nil)))
-
- (partial-host
- (setq user nil)
- (unless
- (and host
- (string-match-p (concat "^" (regexp-quote partial-host)) host))
- (setq host nil)))
-
- (t (setq user nil
- host nil)))
-
- (unless (zerop (+ (length user) (length host)))
- (tramp-completion-make-tramp-file-name method user host nil)))
-
-(defun tramp-parse-default-user-host (method)
- "Return a list of (user host) tuples allowed to access for METHOD.
-This function is added always in `tramp-get-completion-function'
-for all methods. Resulting data are derived from default settings."
- `((,(tramp-find-user method nil nil) ,(tramp-find-host method nil nil))))
-
-(defcustom tramp-completion-use-auth-sources auth-source-do-cache
- "Whether to use `auth-source-search' for completion of user and host names.
-This could be disturbing, if it requires a password / passphrase,
-as for \"~/.authinfo.gpg\"."
- :group 'tramp
- :version "27.1"
- :type 'boolean)
-
-(defun tramp-parse-auth-sources (method)
- "Return a list of (user host) tuples allowed to access for METHOD.
-This function is added always in `tramp-get-completion-function'
-for all methods. Resulting data are derived from default settings."
- (and tramp-completion-use-auth-sources
- (mapcar
- (lambda (x) `(,(plist-get x :user) ,(plist-get x :host)))
- (auth-source-search
- :port method :require '(:port) :max most-positive-fixnum))))
-
-;; Generic function.
-(defun tramp-parse-group (regexp match-level skip-chars)
- "Return a (user host) tuple allowed to access.
-User is always nil."
- (let (result)
- (when (re-search-forward regexp (point-at-eol) t)
- (setq result (list nil (match-string match-level))))
- (or
- (> (skip-chars-forward skip-chars) 0)
- (forward-line 1))
- result))
-
-;; Generic function.
-(defun tramp-parse-file (filename function)
- "Return a list of (user host) tuples allowed to access.
-User is always nil."
- ;; On Windows, there are problems in completion when
- ;; `default-directory' is remote.
- (let ((default-directory (tramp-compat-temporary-file-directory)))
- (when (file-readable-p filename)
- (with-temp-buffer
- (insert-file-contents filename)
- (goto-char (point-min))
- (cl-loop while (not (eobp)) collect (funcall function))))))
-
-(defun tramp-parse-rhosts (filename)
- "Return a list of (user host) tuples allowed to access.
-Either user or host may be nil."
- (tramp-parse-file filename #'tramp-parse-rhosts-group))
-
-(defun tramp-parse-rhosts-group ()
- "Return a (user host) tuple allowed to access.
-Either user or host may be nil."
- (let ((result)
- (regexp
- (concat
- "^\\(" tramp-host-regexp "\\)"
- "\\([ \t]+" "\\(" tramp-user-regexp "\\)" "\\)?")))
- (when (re-search-forward regexp (point-at-eol) t)
- (setq result (append (list (match-string 3) (match-string 1)))))
- (forward-line 1)
- result))
-
-(defun tramp-parse-shosts (filename)
- "Return a list of (user host) tuples allowed to access.
-User is always nil."
- (tramp-parse-file filename #'tramp-parse-shosts-group))
-
-(defun tramp-parse-shosts-group ()
- "Return a (user host) tuple allowed to access.
-User is always nil."
- (tramp-parse-group (concat "^\\(" tramp-host-regexp "\\)") 1 ","))
-
-(defun tramp-parse-sconfig (filename)
- "Return a list of (user host) tuples allowed to access.
-User is always nil."
- (tramp-parse-file filename #'tramp-parse-sconfig-group))
-
-(defun tramp-parse-sconfig-group ()
- "Return a (user host) tuple allowed to access.
-User is always nil."
- (tramp-parse-group
- (concat "\\(?:^[ \t]*Host\\)" "\\|" "\\(?:^.+\\)"
- "\\|" "\\(" tramp-host-regexp "\\)")
- 1 " \t"))
-
-;; Generic function.
-(defun tramp-parse-shostkeys-sknownhosts (dirname regexp)
- "Return a list of (user host) tuples allowed to access.
-User is always nil."
- ;; On Windows, there are problems in completion when
- ;; `default-directory' is remote.
- (let* ((default-directory (tramp-compat-temporary-file-directory))
- (files (and (file-directory-p dirname) (directory-files dirname))))
- (cl-loop
- for f in files
- when (and (not (string-match "^\\.\\.?$" f)) (string-match regexp f))
- collect (list nil (match-string 1 f)))))
-
-(defun tramp-parse-shostkeys (dirname)
- "Return a list of (user host) tuples allowed to access.
-User is always nil."
- (tramp-parse-shostkeys-sknownhosts
- dirname (concat "^key_[0-9]+_\\(" tramp-host-regexp "\\)\\.pub$")))
-
-(defun tramp-parse-sknownhosts (dirname)
- "Return a list of (user host) tuples allowed to access.
-User is always nil."
- (tramp-parse-shostkeys-sknownhosts
- dirname
- (concat "^\\(" tramp-host-regexp "\\)\\.ssh-\\(dss\\|rsa\\)\\.pub$")))
-
-(defun tramp-parse-hosts (filename)
- "Return a list of (user host) tuples allowed to access.
-User is always nil."
- (tramp-parse-file filename #'tramp-parse-hosts-group))
-
-(defun tramp-parse-hosts-group ()
- "Return a (user host) tuple allowed to access.
-User is always nil."
- (tramp-parse-group
- (concat "^\\(" tramp-ipv6-regexp "\\|" tramp-host-regexp "\\)") 1 " \t"))
-
-(defun tramp-parse-passwd (filename)
- "Return a list of (user host) tuples allowed to access.
-Host is always \"localhost\"."
- (with-tramp-connection-property nil "parse-passwd"
- (if (executable-find "getent")
- (with-temp-buffer
- (when (zerop (tramp-call-process nil "getent" nil t nil "passwd"))
- (goto-char (point-min))
- (cl-loop while (not (eobp)) collect
- (tramp-parse-etc-group-group))))
- (tramp-parse-file filename #'tramp-parse-passwd-group))))
-
-(defun tramp-parse-passwd-group ()
- "Return a (user host) tuple allowed to access.
-Host is always \"localhost\"."
- (let ((result)
- (regexp (concat "^\\(" tramp-user-regexp "\\):")))
- (when (re-search-forward regexp (point-at-eol) t)
- (setq result (list (match-string 1) "localhost")))
- (forward-line 1)
- result))
-
-(defun tramp-parse-etc-group (filename)
- "Return a list of (group host) tuples allowed to access.
-Host is always \"localhost\"."
- (with-tramp-connection-property nil "parse-group"
- (if (executable-find "getent")
- (with-temp-buffer
- (when (zerop (tramp-call-process nil "getent" nil t nil "group"))
- (goto-char (point-min))
- (cl-loop while (not (eobp)) collect
- (tramp-parse-etc-group-group))))
- (tramp-parse-file filename #'tramp-parse-etc-group-group))))
-
-(defun tramp-parse-etc-group-group ()
- "Return a (group host) tuple allowed to access.
-Host is always \"localhost\"."
- (let ((result)
- (split (split-string (buffer-substring (point) (point-at-eol)) ":")))
- (when (member (user-login-name) (split-string (nth 3 split) "," 'omit))
- (setq result (list (nth 0 split) "localhost")))
- (forward-line 1)
- result))
-
-(defun tramp-parse-netrc (filename)
- "Return a list of (user host) tuples allowed to access.
-User may be nil."
- ;; The declaration is not sufficient at runtime, because netrc.el is
- ;; not autoloaded.
- (autoload 'netrc-parse "netrc")
- (mapcar
- (lambda (item)
- (and (assoc "machine" item)
- `(,(cdr (assoc "login" item)) ,(cdr (assoc "machine" item)))))
- (netrc-parse filename)))
-
-(defun tramp-parse-putty (registry-or-dirname)
- "Return a list of (user host) tuples allowed to access.
-User is always nil."
- (if (memq system-type '(windows-nt))
- (with-tramp-connection-property nil "parse-putty"
- (with-temp-buffer
- (when (zerop (tramp-call-process
- nil "reg" nil t nil "query" registry-or-dirname))
- (goto-char (point-min))
- (cl-loop while (not (eobp)) collect
- (tramp-parse-putty-group registry-or-dirname)))))
- ;; UNIX case.
- (tramp-parse-shostkeys-sknownhosts
- registry-or-dirname (concat "^\\(" tramp-host-regexp "\\)$"))))
-
-(defun tramp-parse-putty-group (registry)
- "Return a (user host) tuple allowed to access.
-User is always nil."
- (let ((result)
- (regexp (concat (regexp-quote registry) "\\\\\\(.+\\)")))
- (when (re-search-forward regexp (point-at-eol) t)
- (setq result (list nil (match-string 1))))
- (forward-line 1)
- result))
-
-;;; Common file name handler functions for different backends:
-
-(defvar tramp-handle-file-local-copy-hook nil
- "Normal hook to be run at the end of `tramp-*-handle-file-local-copy'.")
-
-(defvar tramp-handle-write-region-hook nil
- "Normal hook to be run at the end of `tramp-*-handle-write-region'.")
-
-(defun tramp-handle-access-file (filename string)
- "Like `access-file' for Tramp files."
- (unless (file-readable-p filename)
- (tramp-error
- (tramp-dissect-file-name filename) tramp-file-missing
- "%s: No such file or directory %s" string filename)))
-
-(defun tramp-handle-add-name-to-file
- (filename newname &optional ok-if-already-exists)
- "Like `add-name-to-file' for Tramp files."
- (with-parsed-tramp-file-name
- (if (tramp-tramp-file-p newname) newname filename) nil
- (unless (tramp-equal-remote filename newname)
- (tramp-error
- v 'file-error
- "add-name-to-file: %s"
- "only implemented for same method, same user, same host"))
- ;; Do the 'confirm if exists' thing.
- (when (file-exists-p newname)
- ;; What to do?
- (if (or (null ok-if-already-exists) ; not allowed to exist
- (and (numberp ok-if-already-exists)
- (not (yes-or-no-p
- (format
- "File %s already exists; make it a link anyway? "
- localname)))))
- (tramp-error v 'file-already-exists newname)
- (delete-file newname)))
- (tramp-flush-file-properties v (file-name-directory localname))
- (tramp-flush-file-properties v localname)
- (copy-file
- filename newname 'ok-if-already-exists 'keep-time
- 'preserve-uid-gid 'preserve-permissions)))
-
-(defun tramp-handle-directory-file-name (directory)
- "Like `directory-file-name' for Tramp files."
- ;; If localname component of filename is "/", leave it unchanged.
- ;; Otherwise, remove any trailing slash from localname component.
- ;; Method, host, etc, are unchanged.
- (while (with-parsed-tramp-file-name directory nil
- (and (not (zerop (length localname)))
- (eq (aref localname (1- (length localname))) ?/)
- (not (string= localname "/"))))
- (setq directory (substring directory 0 -1)))
- directory)
-
-(defun tramp-handle-directory-files (directory &optional full match nosort)
- "Like `directory-files' for Tramp files."
- (when (file-directory-p directory)
- (setq directory (file-name-as-directory (expand-file-name directory)))
- (let ((temp (nreverse (file-name-all-completions "" directory)))
- result item)
-
- (while temp
- (setq item (directory-file-name (pop temp)))
- (when (or (null match) (string-match-p match item))
- (push (if full (concat directory item) item)
- result)))
- (if nosort result (sort result #'string<)))))
-
-(defun tramp-handle-directory-files-and-attributes
- (directory &optional full match nosort id-format)
- "Like `directory-files-and-attributes' for Tramp files."
- (mapcar
- (lambda (x)
- (cons x (file-attributes
- (if full x (expand-file-name x directory)) id-format)))
- (directory-files directory full match nosort)))
-
-(defun tramp-handle-dired-uncache (dir)
- "Like `dired-uncache' for Tramp files."
- (with-parsed-tramp-file-name
- (if (file-directory-p dir) dir (file-name-directory dir)) nil
- (tramp-flush-directory-properties v localname)))
-
-(defun tramp-handle-expand-file-name (name &optional dir)
- "Like `expand-file-name' for Tramp files."
- ;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
- (setq dir (or dir default-directory "/"))
- ;; Handle empty NAME.
- (when (zerop (length name)) (setq name "."))
- ;; Unless NAME is absolute, concat DIR and NAME.
- (unless (file-name-absolute-p name)
- (setq name (concat (file-name-as-directory dir) name)))
- ;; If NAME is not a Tramp file, run the real handler.
- (if (not (tramp-tramp-file-p name))
- (tramp-run-real-handler #'expand-file-name (list name nil))
- ;; Dissect NAME.
- (with-parsed-tramp-file-name name nil
- (unless (tramp-run-real-handler #'file-name-absolute-p (list localname))
- (setq localname (concat "/" localname)))
- ;; Do normal `expand-file-name' (this does "/./" and "/../").
- ;; `default-directory' is bound, because on Windows there would
- ;; be problems with UNC shares or Cygwin mounts.
- (let ((default-directory (tramp-compat-temporary-file-directory)))
- (tramp-make-tramp-file-name
- v (tramp-drop-volume-letter
- (tramp-run-real-handler #'expand-file-name (list localname))))))))
-
-(defun tramp-handle-file-accessible-directory-p (filename)
- "Like `file-accessible-directory-p' for Tramp files."
- (and (file-directory-p filename)
- (file-readable-p filename)))
-
-(defun tramp-handle-file-directory-p (filename)
- "Like `file-directory-p' for Tramp files."
- (eq (tramp-compat-file-attribute-type
- (file-attributes (file-truename filename)))
- t))
-
-(defun tramp-handle-file-equal-p (filename1 filename2)
- "Like `file-equalp-p' for Tramp files."
- ;; Native `file-equalp-p' calls `file-truename', which requires a
- ;; remote connection. This can be avoided, if FILENAME1 and
- ;; FILENAME2 are not located on the same remote host.
- (when (string-equal
- (file-remote-p (expand-file-name filename1))
- (file-remote-p (expand-file-name filename2)))
- (tramp-run-real-handler #'file-equal-p (list filename1 filename2))))
-
-(defun tramp-handle-file-exists-p (filename)
- "Like `file-exists-p' for Tramp files."
- (not (null (file-attributes filename))))
-
-(defun tramp-handle-file-in-directory-p (filename directory)
- "Like `file-in-directory-p' for Tramp files."
- ;; Native `file-in-directory-p' calls `file-truename', which
- ;; requires a remote connection. This can be avoided, if FILENAME
- ;; and DIRECTORY are not located on the same remote host.
- (when (string-equal
- (file-remote-p (expand-file-name filename))
- (file-remote-p (expand-file-name directory)))
- (tramp-run-real-handler #'file-in-directory-p (list filename directory))))
-
-(defun tramp-handle-file-local-copy (filename)
- "Like `file-local-copy' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (unless (file-exists-p filename)
- (tramp-error
- v tramp-file-missing
- "Cannot make local copy of non-existing file `%s'" filename))
- (let ((tmpfile (tramp-compat-make-temp-file filename)))
- (copy-file filename tmpfile 'ok-if-already-exists 'keep-time)
- tmpfile)))
-
-(defun tramp-handle-file-modes (filename)
- "Like `file-modes' for Tramp files."
- (let ((truename (or (file-truename filename) filename)))
- (when (file-exists-p truename)
- (tramp-mode-string-to-int
- (tramp-compat-file-attribute-modes (file-attributes truename))))))
-
-;; Localname manipulation functions that grok Tramp localnames...
-(defun tramp-handle-file-name-as-directory (file)
- "Like `file-name-as-directory' but aware of Tramp files."
- ;; `file-name-as-directory' would be sufficient except localname is
- ;; the empty string.
- (let ((v (tramp-dissect-file-name file t)))
- ;; Run the command on the localname portion only unless we are in
- ;; completion mode.
- (tramp-make-tramp-file-name
- v (or (and (zerop (length (tramp-file-name-localname v)))
- (not (tramp-connectable-p file)))
- (tramp-run-real-handler
- #'file-name-as-directory
- (list (tramp-file-name-localname v)))))))
-
-(defun tramp-handle-file-name-case-insensitive-p (filename)
- "Like `file-name-case-insensitive-p' for Tramp files."
- ;; We make it a connection property, assuming that all file systems
- ;; on the remote host behave similar. This might be wrong for
- ;; mounted NFS directories or SMB/AFP shares; such more granular
- ;; tests will be added in case they are needed.
- (setq filename (expand-file-name filename))
- (with-parsed-tramp-file-name filename nil
- (or ;; Maybe there is a default value.
- (tramp-get-method-parameter v 'tramp-case-insensitive)
-
- ;; There isn't. So we must check, in case there's a connection already.
- (and (file-remote-p filename nil 'connected)
- (with-tramp-connection-property v "case-insensitive"
- (ignore-errors
- (with-tramp-progress-reporter v 5 "Checking case-insensitive"
- ;; The idea is to compare a file with lower case
- ;; letters with the same file with upper case letters.
- (let ((candidate
- (tramp-compat-file-name-unquote
- (directory-file-name filename)))
- tmpfile)
- ;; Check, whether we find an existing file with
- ;; lower case letters. This avoids us to create a
- ;; temporary file.
- (while (and (string-match-p
- "[a-z]" (tramp-compat-file-local-name candidate))
- (not (file-exists-p candidate)))
- (setq candidate
- (directory-file-name
- (file-name-directory candidate))))
- ;; Nothing found, so we must use a temporary file
- ;; for comparison. `make-nearby-temp-file' is added
- ;; to Emacs 26+ like `file-name-case-insensitive-p',
- ;; so there is no compatibility problem calling it.
- (unless
- (string-match-p
- "[a-z]" (tramp-compat-file-local-name candidate))
- (setq tmpfile
- (let ((default-directory
- (file-name-directory filename)))
- (tramp-compat-funcall
- 'make-nearby-temp-file "tramp."))
- candidate tmpfile))
- ;; Check for the existence of the same file with
- ;; upper case letters.
- (unwind-protect
- (file-exists-p
- (concat
- (file-remote-p candidate)
- (upcase (tramp-compat-file-local-name candidate))))
- ;; Cleanup.
- (when tmpfile (delete-file tmpfile)))))))))))
-
-(defun tramp-handle-file-name-completion
- (filename directory &optional predicate)
- "Like `file-name-completion' for Tramp files."
- (let (hits-ignored-extensions)
- (or
- (try-completion
- filename (file-name-all-completions filename directory)
- (lambda (x)
- (when (funcall (or predicate #'identity) (expand-file-name x directory))
- (not
- (and
- completion-ignored-extensions
- (string-match-p
- (concat (regexp-opt completion-ignored-extensions 'paren) "$") x)
- ;; We remember the hit.
- (push x hits-ignored-extensions))))))
- ;; No match. So we try again for ignored files.
- (try-completion filename hits-ignored-extensions))))
-
-(defun tramp-handle-file-name-directory (file)
- "Like `file-name-directory' but aware of Tramp files."
- ;; Everything except the last filename thing is the directory. We
- ;; cannot apply `with-parsed-tramp-file-name', because this expands
- ;; the remote file name parts.
- (let ((v (tramp-dissect-file-name file t)))
- ;; Run the command on the localname portion only. If this returns
- ;; nil, mark also the localname part of `v' as nil.
- (tramp-make-tramp-file-name
- v (or (tramp-run-real-handler
- #'file-name-directory (list (tramp-file-name-localname v)))
- 'noloc))))
-
-(defun tramp-handle-file-name-nondirectory (file)
- "Like `file-name-nondirectory' but aware of Tramp files."
- (with-parsed-tramp-file-name file nil
- (tramp-run-real-handler #'file-name-nondirectory (list localname))))
-
-(defun tramp-handle-file-newer-than-file-p (file1 file2)
- "Like `file-newer-than-file-p' for Tramp files."
- (cond
- ((not (file-exists-p file1)) nil)
- ((not (file-exists-p file2)) t)
- (t (time-less-p (tramp-compat-file-attribute-modification-time
- (file-attributes file2))
- (tramp-compat-file-attribute-modification-time
- (file-attributes file1))))))
-
-(defun tramp-handle-file-regular-p (filename)
- "Like `file-regular-p' for Tramp files."
- (and (file-exists-p filename)
- (eq ?-
- (aref (tramp-compat-file-attribute-modes (file-attributes filename))
- 0))))
-
-(defun tramp-handle-file-remote-p (filename &optional identification connected)
- "Like `file-remote-p' for Tramp files."
- ;; We do not want traces in the debug buffer.
- (let ((tramp-verbose (min tramp-verbose 3)))
- (when (tramp-tramp-file-p filename)
- (let* ((v (tramp-dissect-file-name filename))
- (p (tramp-get-connection-process v))
- (c (and (process-live-p p)
- (tramp-get-connection-property p "connected" nil))))
- ;; We expand the file name only, if there is already a connection.
- (with-parsed-tramp-file-name
- (if c (expand-file-name filename) filename) nil
- (and (or (not connected) c)
- (cond
- ((eq identification 'method) method)
- ;; Domain and port are appended to user and host,
- ;; respectively.
- ((eq identification 'user) (tramp-file-name-user-domain v))
- ((eq identification 'host) (tramp-file-name-host-port v))
- ((eq identification 'localname) localname)
- ((eq identification 'hop) hop)
- (t (tramp-make-tramp-file-name v 'noloc)))))))))
-
-(defun tramp-handle-file-selinux-context (_filename)
- "Like `file-selinux-context' for Tramp files."
- ;; Return nil context.
- '(nil nil nil nil))
-
-(defun tramp-handle-file-symlink-p (filename)
- "Like `file-symlink-p' for Tramp files."
- (let ((x (tramp-compat-file-attribute-type (file-attributes filename))))
- (and (stringp x) x)))
-
-(defun tramp-handle-file-truename (filename)
- "Like `file-truename' for Tramp files."
- ;; Preserve trailing "/".
- (funcall
- (if (string-equal (file-name-nondirectory filename) "")
- #'file-name-as-directory #'identity)
- (let ((result (expand-file-name filename))
- (numchase 0)
- ;; Don't make the following value larger than necessary.
- ;; People expect an error message in a timely fashion when
- ;; something is wrong; otherwise they might think that Emacs
- ;; is hung. Of course, correctness has to come first.
- (numchase-limit 20)
- symlink-target)
- (with-parsed-tramp-file-name result v1
- ;; We cache only the localname.
- (tramp-make-tramp-file-name
- v1
- (with-tramp-file-property v1 v1-localname "file-truename"
- (while (and (setq symlink-target (file-symlink-p result))
- (< numchase numchase-limit))
- (setq numchase (1+ numchase)
- result
- (with-parsed-tramp-file-name (expand-file-name result) v2
- (tramp-make-tramp-file-name
- v2
- (funcall
- (if (tramp-compat-file-name-quoted-p v2-localname)
- #'tramp-compat-file-name-quote #'identity)
-
- (if (stringp symlink-target)
- (if (file-remote-p symlink-target)
- (let (file-name-handler-alist)
- (tramp-compat-file-name-quote symlink-target))
- (expand-file-name
- symlink-target (file-name-directory v2-localname)))
- v2-localname))
- 'nohop)))
- (when (>= numchase numchase-limit)
- (tramp-error
- v1 'file-error
- "Maximum number (%d) of symlinks exceeded" numchase-limit)))
- (tramp-compat-file-local-name (directory-file-name result))))))))
-
-(defun tramp-handle-file-writable-p (filename)
- "Like `file-writable-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (with-tramp-file-property v localname "file-writable-p"
- (if (file-exists-p filename)
- (tramp-check-cached-permissions v ?w)
- ;; If file doesn't exist, check if directory is writable.
- (and (file-directory-p (file-name-directory filename))
- (file-writable-p (file-name-directory filename)))))))
-
-(defun tramp-handle-find-backup-file-name (filename)
- "Like `find-backup-file-name' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (let ((backup-directory-alist
- (if tramp-backup-directory-alist
- (mapcar
- (lambda (x)
- (cons
- (car x)
- (if (and (stringp (cdr x))
- (file-name-absolute-p (cdr x))
- (not (tramp-tramp-file-p (cdr x))))
- (tramp-make-tramp-file-name v (cdr x))
- (cdr x))))
- tramp-backup-directory-alist)
- backup-directory-alist)))
- (tramp-run-real-handler #'find-backup-file-name (list filename)))))
-
-(defun tramp-handle-insert-directory
- (filename switches &optional wildcard full-directory-p)
- "Like `insert-directory' for Tramp files."
- (unless switches (setq switches ""))
- ;; Mark trailing "/".
- (when (and (zerop (length (file-name-nondirectory filename)))
- (not full-directory-p))
- (setq switches (concat switches "F")))
- ;; Check, whether directory is accessible.
- (unless wildcard
- (access-file filename "Reading directory"))
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (with-tramp-progress-reporter v 0 (format "Opening directory %s" filename)
- ;; We must load it in order to get the advice around `insert-directory'.
- (require 'ls-lisp)
- (let (ls-lisp-use-insert-directory-program start)
- (tramp-run-real-handler
- #'insert-directory
- (list filename switches wildcard full-directory-p))
- ;; `ls-lisp' always returns full listings. We must remove
- ;; superfluous parts.
- (unless (string-match-p "l" switches)
- (save-excursion
- (goto-char (point-min))
- (while (setq start
- (text-property-not-all
- (point) (point-at-eol) 'dired-filename t))
- (delete-region
- start
- (or (text-property-any start (point-at-eol) 'dired-filename t)
- (point-at-eol)))
- (if (= (point-at-bol) (point-at-eol))
- ;; Empty line.
- (delete-region (point) (progn (forward-line) (point)))
- (forward-line)))))))))
-
-(defun tramp-handle-insert-file-contents
- (filename &optional visit beg end replace)
- "Like `insert-file-contents' for Tramp files."
- (barf-if-buffer-read-only)
- (setq filename (expand-file-name filename))
- (let (result local-copy remote-copy)
- (with-parsed-tramp-file-name filename nil
- (unwind-protect
- (if (not (file-exists-p filename))
- (tramp-error
- v tramp-file-missing
- "File `%s' not found on remote host" filename)
-
- (with-tramp-progress-reporter
- v 3 (format-message "Inserting `%s'" filename)
- (condition-case err
- (if (and (tramp-local-host-p v)
- (let (file-name-handler-alist)
- (file-readable-p localname)))
- ;; Short track: if we are on the local host, we can
- ;; run directly.
- (setq result
- (tramp-run-real-handler
- #'insert-file-contents
- (list localname visit beg end replace)))
-
- ;; When we shall insert only a part of the file, we
- ;; copy this part. This works only for the shell file
- ;; name handlers.
- (when (and (or beg end)
- (tramp-get-method-parameter
- v 'tramp-login-program))
- (setq remote-copy (tramp-make-tramp-temp-file v))
- ;; This is defined in tramp-sh.el. Let's assume
- ;; this is loaded already.
- (tramp-compat-funcall
- 'tramp-send-command
- v
- (cond
- ((and beg end)
- (format "dd bs=1 skip=%d if=%s count=%d of=%s"
- beg (tramp-shell-quote-argument localname)
- (- end beg) remote-copy))
- (beg
- (format "dd bs=1 skip=%d if=%s of=%s"
- beg (tramp-shell-quote-argument localname)
- remote-copy))
- (end
- (format "dd bs=1 count=%d if=%s of=%s"
- end (tramp-shell-quote-argument localname)
- remote-copy))))
- (setq tramp-temp-buffer-file-name nil beg nil end nil))
-
- ;; `insert-file-contents-literally' takes care to
- ;; avoid calling jka-compr.el and epa.el. By
- ;; let-binding `inhibit-file-name-operation', we
- ;; propagate that care to the `file-local-copy'
- ;; operation.
- (setq local-copy
- (let ((inhibit-file-name-operation
- (when (eq inhibit-file-name-operation
- 'insert-file-contents)
- 'file-local-copy)))
- (cond
- ((stringp remote-copy)
- (file-local-copy
- (tramp-make-tramp-file-name
- v remote-copy 'nohop)))
- ((stringp tramp-temp-buffer-file-name)
- (copy-file
- filename tramp-temp-buffer-file-name 'ok)
- tramp-temp-buffer-file-name)
- (t (file-local-copy filename)))))
-
- ;; When the file is not readable for the owner, it
- ;; cannot be inserted, even if it is readable for the
- ;; group or for everybody.
- (set-file-modes local-copy #o0600)
-
- (when (and (null remote-copy)
- (tramp-get-method-parameter
- v 'tramp-copy-keep-tmpfile))
- ;; We keep the local file for performance reasons,
- ;; useful for "rsync".
- (setq tramp-temp-buffer-file-name local-copy))
-
- ;; We must ensure that `file-coding-system-alist'
- ;; matches `local-copy'.
- (let ((file-coding-system-alist
- (tramp-find-file-name-coding-system-alist
- filename local-copy)))
- (setq result
- (insert-file-contents
- local-copy visit beg end replace))))
- (error
- (add-hook 'find-file-not-found-functions
- `(lambda () (signal ',(car err) ',(cdr err)))
- nil t)
- (signal (car err) (cdr err))))))
-
- ;; Save exit.
- (progn
- (when visit
- (setq buffer-file-name filename)
- (setq buffer-read-only (not (file-writable-p filename)))
- (set-visited-file-modtime)
- (set-buffer-modified-p nil))
- (when (and (stringp local-copy)
- (or remote-copy (null tramp-temp-buffer-file-name)))
- (delete-file local-copy))
- (when (stringp remote-copy)
- (delete-file (tramp-make-tramp-file-name v remote-copy 'nohop)))))
-
- ;; Result.
- (list (expand-file-name filename)
- (cadr result)))))
-
-(defun tramp-handle-load (file &optional noerror nomessage nosuffix
must-suffix)
- "Like `load' for Tramp files."
- (with-parsed-tramp-file-name (expand-file-name file) nil
- (unless nosuffix
- (cond ((file-exists-p (concat file ".elc"))
- (setq file (concat file ".elc")))
- ((file-exists-p (concat file ".el"))
- (setq file (concat file ".el")))))
- (when must-suffix
- ;; The first condition is always true for absolute file names.
- ;; Included for safety's sake.
- (unless (or (file-name-directory file)
- (string-match-p "\\.elc?\\'" file))
- (tramp-error
- v 'file-error
- "File `%s' does not include a `.el' or `.elc' suffix" file)))
- (unless (or noerror (file-exists-p file))
- (tramp-error
- v tramp-file-missing "Cannot load nonexistent file `%s'" file))
- (if (not (file-exists-p file))
- nil
- (let ((tramp-message-show-message (not nomessage)))
- (with-tramp-progress-reporter v 0 (format "Loading %s" file)
- (let ((local-copy (file-local-copy file)))
- (unwind-protect
- (load local-copy noerror t nosuffix must-suffix)
- (delete-file local-copy)))))
- t)))
-
-(defun tramp-handle-make-symbolic-link
- (target linkname &optional ok-if-already-exists)
- "Like `make-symbolic-link' for Tramp files.
-This is the fallback implementation for backends which do not
-support symbolic links."
- (if (tramp-tramp-file-p (expand-file-name linkname))
- (tramp-error
- (tramp-dissect-file-name (expand-file-name linkname)) 'file-error
- "make-symbolic-link not supported")
- ;; This is needed prior Emacs 26.1, where TARGET has also be
- ;; checked for a file name handler.
- (tramp-run-real-handler
- #'make-symbolic-link (list target linkname ok-if-already-exists))))
-
-(defun tramp-handle-shell-command
- (command &optional output-buffer error-buffer)
- "Like `shell-command' for Tramp files."
- (let* ((asynchronous (string-match-p "[ \t]*&[ \t]*\\'" command))
- (command (substring command 0 asynchronous))
- current-buffer-p
- (output-buffer
- (cond
- ((bufferp output-buffer) output-buffer)
- ((stringp output-buffer) (get-buffer-create output-buffer))
- (output-buffer
- (setq current-buffer-p t)
- (current-buffer))
- (t (get-buffer-create
- (if asynchronous
- "*Async Shell Command*"
- "*Shell Command Output*")))))
- (error-buffer
- (cond
- ((bufferp error-buffer) error-buffer)
- ((stringp error-buffer) (get-buffer-create error-buffer))))
- (bname (buffer-name output-buffer))
- (p (get-buffer-process output-buffer))
- buffer)
-
- ;; The following code is taken from `shell-command', slightly
- ;; adapted. Shouldn't it be factored out?
- (when p
- (cond
- ((eq async-shell-command-buffer 'confirm-kill-process)
- ;; If will kill a process, query first.
- (if (yes-or-no-p
- "A command is running in the default buffer. Kill it? ")
- (kill-process p)
- (tramp-user-error p "Shell command in progress")))
- ((eq async-shell-command-buffer 'confirm-new-buffer)
- ;; If will create a new buffer, query first.
- (if (yes-or-no-p
- "A command is running in the default buffer. Use a new buffer? ")
- (setq output-buffer (generate-new-buffer bname))
- (tramp-user-error p "Shell command in progress")))
- ((eq async-shell-command-buffer 'new-buffer)
- ;; It will create a new buffer.
- (setq output-buffer (generate-new-buffer bname)))
- ((eq async-shell-command-buffer 'confirm-rename-buffer)
- ;; If will rename the buffer, query first.
- (if (yes-or-no-p
- "A command is running in the default buffer. Rename it? ")
- (progn
- (with-current-buffer output-buffer
- (rename-uniquely))
- (setq output-buffer (get-buffer-create bname)))
- (tramp-user-error p "Shell command in progress")))
- ((eq async-shell-command-buffer 'rename-buffer)
- ;; It will rename the buffer.
- (with-current-buffer output-buffer
- (rename-uniquely))
- (setq output-buffer (get-buffer-create bname)))))
-
- (setq buffer (if (and (not asynchronous) error-buffer)
- (with-parsed-tramp-file-name default-directory nil
- (list output-buffer (tramp-make-tramp-temp-file v)))
- output-buffer))
-
- (if current-buffer-p
- (progn
- (barf-if-buffer-read-only)
- (push-mark nil t))
- (with-current-buffer output-buffer
- (setq buffer-read-only nil)
- (erase-buffer)))
-
- (if (and (not current-buffer-p) (integerp asynchronous))
- (let ((tramp-remote-process-environment
- ;; `async-shell-command-width' has been introduced with
- ;; Emacs 27.1.
- (if (natnump (bound-and-true-p async-shell-command-width))
- (cons (format "COLUMNS=%d"
- (bound-and-true-p async-shell-command-width))
- tramp-remote-process-environment)
- tramp-remote-process-environment)))
- (prog1
- ;; Run the process.
- (setq p (start-file-process-shell-command
- (buffer-name output-buffer) buffer command))
- ;; Display output.
- (with-current-buffer output-buffer
- (display-buffer output-buffer '(nil (allow-no-window . t)))
- (setq mode-line-process '(":%s"))
- (shell-mode)
- (set-process-sentinel p #'shell-command-sentinel)
- (set-process-filter p #'comint-output-filter))))
-
- (prog1
- ;; Run the process.
- (process-file-shell-command command nil buffer nil)
- ;; Insert error messages if they were separated.
- (when (listp buffer)
- (with-current-buffer error-buffer
- (insert-file-contents (cadr buffer)))
- (delete-file (cadr buffer)))
- (if current-buffer-p
- ;; This is like exchange-point-and-mark, but doesn't
- ;; activate the mark. It is cleaner to avoid activation,
- ;; even though the command loop would deactivate the mark
- ;; because we inserted text.
- (goto-char (prog1 (mark t)
- (set-marker (mark-marker) (point)
- (current-buffer))))
- ;; There's some output, display it.
- (when (with-current-buffer output-buffer (> (point-max) (point-min)))
- (display-message-or-buffer output-buffer)))))))
-
-(defun tramp-handle-start-file-process (name buffer program &rest args)
- "Like `start-file-process' for Tramp files."
- ;; `make-process' knows the `:file-error' argument since Emacs 27.1.
- (tramp-file-name-handler
- 'make-process
- :name name
- :buffer buffer
- :command (and program (cons program args))
- :noquery nil
- :file-handler t))
-
-(defun tramp-handle-substitute-in-file-name (filename)
- "Like `substitute-in-file-name' for Tramp files.
-\"//\" and \"/~\" substitute only in the local filename part."
- ;; Check, whether the local part is a quoted file name.
- (if (tramp-compat-file-name-quoted-p filename)
- filename
- ;; First, we must replace environment variables.
- (setq filename (tramp-replace-environment-variables filename))
- (with-parsed-tramp-file-name filename nil
- ;; We do not want to replace environment variables, again. "//"
- ;; has a special meaning at the beginning of a file name on
- ;; Cygwin and MS-Windows, we must remove it.
- (let (process-environment)
- ;; Ignore in LOCALNAME everything before "//" or "/~".
- (when (stringp localname)
- (if (string-match "//\\(/\\|~\\)" localname)
- (setq filename
- (replace-regexp-in-string
- "\\`/+" "/" (substitute-in-file-name localname)))
- (setq filename
- (concat (file-remote-p filename)
- (replace-regexp-in-string
- "\\`/+" "/"
- ;; We must disable cygwin-mount file name
- ;; handlers and alike.
- (tramp-run-real-handler
- #'substitute-in-file-name (list localname))))))))
- ;; "/m:h:~" does not work for completion. We use "/m:h:~/".
- (if (and (stringp localname) (string-equal "~" localname))
- (concat filename "/")
- filename))))
-
-(defconst tramp-time-dont-know '(0 0 0 1000)
- "An invalid time value, used as \"Don’t know\" value.")
-
-(defconst tramp-time-doesnt-exist '(-1 65535)
- "An invalid time value, used as \"Doesn’t exist\" value.")
-
-(defun tramp-handle-set-visited-file-modtime (&optional time-list)
- "Like `set-visited-file-modtime' for Tramp files."
- (unless (buffer-file-name)
- (error "Can't set-visited-file-modtime: buffer `%s' not visiting a file"
- (buffer-name)))
- (unless time-list
- (let ((remote-file-name-inhibit-cache t))
- (setq time-list
- (or (tramp-compat-file-attribute-modification-time
- (file-attributes (buffer-file-name)))
- tramp-time-doesnt-exist))))
- (unless (tramp-compat-time-equal-p time-list tramp-time-dont-know)
- (tramp-run-real-handler #'set-visited-file-modtime (list time-list))))
-
-(defun tramp-handle-verify-visited-file-modtime (&optional buf)
- "Like `verify-visited-file-modtime' for Tramp files.
-At the time `verify-visited-file-modtime' calls this function, we
-already know that the buffer is visiting a file and that
-`visited-file-modtime' does not return 0. Do not call this
-function directly, unless those two cases are already taken care
-of."
- (with-current-buffer (or buf (current-buffer))
- (let ((f (buffer-file-name)))
- ;; There is no file visiting the buffer, or the buffer has no
- ;; recorded last modification time, or there is no established
- ;; connection.
- (if (or (not f)
- (eq (visited-file-modtime) 0)
- (not (file-remote-p f nil 'connected)))
- t
- (let* ((remote-file-name-inhibit-cache t)
- (attr (file-attributes f))
- (modtime (tramp-compat-file-attribute-modification-time attr))
- (mt (visited-file-modtime)))
-
- (cond
- ;; File exists, and has a known modtime.
- ((and attr
- (not (tramp-compat-time-equal-p modtime tramp-time-dont-know)))
- (< (abs (tramp-time-diff modtime mt)) 2))
- ;; Modtime has the don't know value.
- (attr t)
- ;; If file does not exist, say it is not modified if and
- ;; only if that agrees with the buffer's record.
- (t (tramp-compat-time-equal-p mt tramp-time-doesnt-exist))))))))
-
-(defun tramp-handle-write-region
- (start end filename &optional append visit lockname mustbenew)
- "Like `write-region' for Tramp files."
- (setq filename (expand-file-name filename))
- (with-parsed-tramp-file-name filename nil
- (when (and mustbenew (file-exists-p filename)
- (or (eq mustbenew 'excl)
- (not
- (y-or-n-p
- (format "File %s exists; overwrite anyway? " filename)))))
- (tramp-error v 'file-already-exists filename))
-
- (let ((tmpfile (tramp-compat-make-temp-file filename)))
- (when (and append (file-exists-p filename))
- (copy-file filename tmpfile 'ok))
- ;; We say `no-message' here because we don't want the visited file
- ;; modtime data to be clobbered from the temp file. We call
- ;; `set-visited-file-modtime' ourselves later on.
- (tramp-run-real-handler
- #'write-region (list start end tmpfile append 'no-message lockname))
- (condition-case nil
- (rename-file tmpfile filename 'ok-if-already-exists)
- (error
- (delete-file tmpfile)
- (tramp-error
- v 'file-error "Couldn't write region to `%s'" filename))))
-
- (tramp-flush-file-properties v (file-name-directory localname))
- (tramp-flush-file-properties v localname)
-
- ;; Set file modification time.
- (when (or (eq visit t) (stringp visit))
- (set-visited-file-modtime
- (tramp-compat-file-attribute-modification-time
- (file-attributes filename))))
-
- ;; The end.
- (when (and (null noninteractive)
- (or (eq visit t) (null visit) (stringp visit)))
- (tramp-message v 0 "Wrote %s" filename))
- (run-hooks 'tramp-handle-write-region-hook)))
-
-;; This is used in tramp-sh.el and tramp-sudoedit.el.
-(defconst tramp-stat-marker "/////"
- "Marker in stat commands for file attributes.")
-
-(defconst tramp-stat-quoted-marker "\\/\\/\\/\\/\\/"
- "Quoted marker in stat commands for file attributes.")
-
-;; This is used in tramp-gvfs.el and tramp-sh.el.
-(defconst tramp-gio-events
- '("attribute-changed" "changed" "changes-done-hint"
- "created" "deleted" "moved" "pre-unmount" "unmounted")
- "List of events \"gio monitor\" could send.")
-
-;; This is the default handler. tramp-gvfs.el and tramp-sh.el have
-;; their own one.
-(defun tramp-handle-file-notify-add-watch (filename _flags _callback)
- "Like `file-notify-add-watch' for Tramp files."
- (setq filename (expand-file-name filename))
- (with-parsed-tramp-file-name filename nil
- (tramp-error
- v 'file-notify-error "File notification not supported for `%s'"
filename)))
-
-(defun tramp-handle-file-notify-rm-watch (proc)
- "Like `file-notify-rm-watch' for Tramp files."
- ;; The descriptor must be a process object.
- (unless (processp proc)
- (tramp-error proc 'file-notify-error "Not a valid descriptor %S" proc))
- (tramp-message proc 6 "Kill %S" proc)
- (delete-process proc))
-
-(defun tramp-handle-file-notify-valid-p (proc)
- "Like `file-notify-valid-p' for Tramp files."
- (and (process-live-p proc)
- ;; Sometimes, the process is still in status `run' when the
- ;; file or directory to be watched is deleted already.
- (with-current-buffer (process-buffer proc)
- (file-exists-p
- (concat (file-remote-p default-directory)
- (process-get proc 'watch-name))))))
-
-(defun tramp-file-notify-process-sentinel (proc event)
- "Call `file-notify-rm-watch'."
- (unless (process-live-p proc)
- (tramp-message proc 5 "Sentinel called: `%S' `%s'" proc event)
- (tramp-compat-funcall 'file-notify-rm-watch proc)))
-
-;;; Functions for establishing connection:
-
-;; The following functions are actions to be taken when seeing certain
-;; prompts from the remote host. See the variable
-;; `tramp-actions-before-shell' for usage of these functions.
-
-(defun tramp-action-login (_proc vec)
- "Send the login name."
- (let ((user (or (tramp-file-name-user vec)
- (with-tramp-connection-property vec "login-as"
- (save-window-excursion
- (let ((enable-recursive-minibuffers t))
- (pop-to-buffer (tramp-get-connection-buffer vec))
- (read-string (match-string 0))))))))
- (with-current-buffer (tramp-get-connection-buffer vec)
- (tramp-message vec 6 "\n%s" (buffer-string)))
- (tramp-message vec 3 "Sending login name `%s'" user)
- (tramp-send-string vec (concat user tramp-local-end-of-line)))
- t)
-
-(defun tramp-action-password (proc vec)
- "Query the user for a password."
- (with-current-buffer (process-buffer proc)
- (let ((enable-recursive-minibuffers t)
- (case-fold-search t))
- ;; Let's check whether a wrong password has been sent already.
- ;; Sometimes, the process returns a new password request
- ;; immediately after rejecting the previous (wrong) one.
- (unless (tramp-get-connection-property vec "first-password-request" nil)
- (tramp-clear-passwd vec))
- (goto-char (point-min))
- (tramp-check-for-regexp proc tramp-password-prompt-regexp)
- (tramp-message vec 3 "Sending %s" (match-string 1))
- ;; We don't call `tramp-send-string' in order to hide the
- ;; password from the debug buffer and the traces.
- (process-send-string
- proc (concat (tramp-read-passwd proc) tramp-local-end-of-line))
- ;; Hide password prompt.
- (narrow-to-region (point-max) (point-max))))
- t)
-
-(defun tramp-action-succeed (_proc _vec)
- "Signal success in finding shell prompt."
- (throw 'tramp-action 'ok))
-
-(defun tramp-action-permission-denied (proc _vec)
- "Signal permission denied."
- (kill-process proc)
- (throw 'tramp-action 'permission-denied))
-
-(defun tramp-action-yesno (proc vec)
- "Ask the user for confirmation using `yes-or-no-p'.
-Send \"yes\" to remote process on confirmation, abort otherwise.
-See also `tramp-action-yn'."
- (save-window-excursion
- (let ((enable-recursive-minibuffers t))
- (pop-to-buffer (tramp-get-connection-buffer vec))
- (unless (yes-or-no-p (match-string 0))
- (kill-process proc)
- (throw 'tramp-action 'permission-denied))
- (with-current-buffer (tramp-get-connection-buffer vec)
- (tramp-message vec 6 "\n%s" (buffer-string)))
- (tramp-send-string vec (concat "yes" tramp-local-end-of-line))))
- t)
-
-(defun tramp-action-yn (proc vec)
- "Ask the user for confirmation using `y-or-n-p'.
-Send \"y\" to remote process on confirmation, abort otherwise.
-See also `tramp-action-yesno'."
- (save-window-excursion
- (let ((enable-recursive-minibuffers t))
- (pop-to-buffer (tramp-get-connection-buffer vec))
- (unless (y-or-n-p (match-string 0))
- (kill-process proc)
- (throw 'tramp-action 'permission-denied))
- (with-current-buffer (tramp-get-connection-buffer vec)
- (tramp-message vec 6 "\n%s" (buffer-string)))
- (tramp-send-string vec (concat "y" tramp-local-end-of-line))))
- t)
-
-(defun tramp-action-terminal (_proc vec)
- "Tell the remote host which terminal type to use.
-The terminal type can be configured with `tramp-terminal-type'."
- (tramp-message vec 5 "Setting `%s' as terminal type." tramp-terminal-type)
- (with-current-buffer (tramp-get-connection-buffer vec)
- (tramp-message vec 6 "\n%s" (buffer-string)))
- (tramp-send-string vec (concat tramp-terminal-type tramp-local-end-of-line))
- t)
-
-(defun tramp-action-process-alive (proc _vec)
- "Check, whether a process has finished."
- (unless (process-live-p proc)
- (throw 'tramp-action 'process-died)))
-
-(defun tramp-action-out-of-band (proc vec)
- "Check, whether an out-of-band copy has finished."
- ;; There might be pending output for the exit status.
- (while (tramp-accept-process-output proc 0))
- (cond ((and (not (process-live-p proc))
- (zerop (process-exit-status proc)))
- (tramp-message vec 3 "Process has finished.")
- (throw 'tramp-action 'ok))
- ((or (and (memq (process-status proc) '(stop exit))
- (not (zerop (process-exit-status proc))))
- (eq (process-status proc) 'signal))
- ;; `scp' could have copied correctly, but set modes could have failed.
- ;; This can be ignored.
- (with-current-buffer (process-buffer proc)
- (goto-char (point-min))
- (if (re-search-forward tramp-operation-not-permitted-regexp nil t)
- (progn
- (tramp-message vec 5 "'set mode' error ignored.")
- (tramp-message vec 3 "Process has finished.")
- (throw 'tramp-action 'ok))
- (tramp-message vec 3 "Process has died.")
- (throw 'tramp-action 'out-of-band-failed))))
- (t nil)))
-
-;;; Functions for processing the actions:
-
-(defun tramp-process-one-action (proc vec actions)
- "Wait for output from the shell and perform one action.
-See `tramp-process-actions' for the format of ACTIONS."
- (let ((case-fold-search t)
- found todo item pattern action)
- (while (not found)
- ;; Reread output once all actions have been performed.
- ;; Obviously, the output was not complete.
- (while (tramp-accept-process-output proc 0))
- (setq todo actions)
- (while todo
- (setq item (pop todo))
- (setq pattern (format "\\(%s\\)\\'" (symbol-value (nth 0 item))))
- (setq action (nth 1 item))
- (tramp-message
- vec 5 "Looking for regexp \"%s\" from remote shell" pattern)
- (when (tramp-check-for-regexp proc pattern)
- (tramp-message vec 5 "Call `%s'" (symbol-name action))
- (setq found (funcall action proc vec)))))
- found))
-
-(defun tramp-process-actions (proc vec pos actions &optional timeout)
- "Perform ACTIONS until success or TIMEOUT.
-PROC and VEC indicate the remote connection to be used. POS, if
-set, is the starting point of the region to be deleted in the
-connection buffer.
-
-ACTIONS is a list of (PATTERN ACTION). The PATTERN should be a
-symbol, a variable. The value of this variable gives the regular
-expression to search for. Note that the regexp must match at the
-end of the buffer, \"\\'\" is implicitly appended to it.
-
-The ACTION should also be a symbol, but a function. When the
-corresponding PATTERN matches, the ACTION function is called.
-
-An ACTION function has two arguments (PROC VEC). If it returns
-nil, nothing has been done, and the next action shall be called.
-A non-nil return value indicates that the process output has been
-consumed, and new output shall be retrieved, before starting to
-process all ACTIONs, again. The same happens after calling the
-last ACTION.
-
-If an action determines, that all processing has been done (e.g.,
-because the shell prompt has been detected), it shall throw a
-result. The symbol `ok' means that all ACTIONs have been
-performed successfully. Any other value means an error."
- ;; Enable `auth-source', unless "emacs -Q" has been called. We must
- ;; use the "password-vector" property in case we have several hops.
- (tramp-set-connection-property
- (tramp-get-connection-property
- proc "password-vector" (process-get proc 'vector))
- "first-password-request" tramp-cache-read-persistent-data)
- (save-restriction
- (with-tramp-progress-reporter
- proc 3 "Waiting for prompts from remote shell"
- (let (exit)
- (if timeout
- (with-timeout (timeout (setq exit 'timeout))
- (while (not exit)
- (setq exit
- (catch 'tramp-action
- (tramp-process-one-action proc vec actions)))))
- (while (not exit)
- (setq exit
- (catch 'tramp-action
- (tramp-process-one-action proc vec actions)))))
- (with-current-buffer (tramp-get-connection-buffer vec)
- (widen)
- (tramp-message vec 6 "\n%s" (buffer-string)))
- (if (eq exit 'ok)
- (ignore-errors (funcall tramp-password-save-function))
- ;; Not successful.
- (tramp-clear-passwd vec)
- (delete-process proc)
- (tramp-error-with-buffer
- (tramp-get-connection-buffer vec) vec 'file-error
- (cond
- ((eq exit 'permission-denied) "Permission denied")
- ((eq exit 'out-of-band-failed)
- (format-message
- "Copy failed, see buffer `%s' for details"
- (tramp-get-connection-buffer vec)))
- ((eq exit 'process-died)
- (substitute-command-keys
- (eval-when-compile
- (concat
- "Tramp failed to connect. If this happens repeatedly, try\n"
- " `\\[tramp-cleanup-this-connection]'"))))
- ((eq exit 'timeout)
- (format-message
- "Timeout reached, see buffer `%s' for details"
- (tramp-get-connection-buffer vec)))
- (t "Login failed")))))
- (when (numberp pos)
- (with-current-buffer (tramp-get-connection-buffer vec)
- (let ((inhibit-read-only t)) (delete-region pos (point))))))))
-
-;;; Utility functions:
-
-(defun tramp-accept-process-output (proc &optional timeout)
- "Like `accept-process-output' for Tramp processes.
-This is needed in order to hide `last-coding-system-used', which is set
-for process communication also."
- (with-current-buffer (process-buffer proc)
- (let ((inhibit-read-only t)
- last-coding-system-used
- result)
- ;; JUST-THIS-ONE is set due to Bug#12145.
- (tramp-message
- proc 10 "%s %s %s %s\n%s"
- proc timeout (process-status proc)
- (with-local-quit
- (setq result (accept-process-output proc timeout nil t)))
- (buffer-string))
- result)))
-
-(defun tramp-check-for-regexp (proc regexp)
- "Check, whether REGEXP is contained in process buffer of PROC.
-Erase echoed commands if exists."
- (with-current-buffer (process-buffer proc)
- (goto-char (point-min))
-
- ;; Check whether we need to remove echo output.
- (when (and (tramp-get-connection-property proc "check-remote-echo" nil)
- (re-search-forward tramp-echoed-echo-mark-regexp nil t))
- (let ((begin (match-beginning 0)))
- (when (re-search-forward tramp-echoed-echo-mark-regexp nil t)
- ;; Discard echo from remote output.
- (tramp-set-connection-property proc "check-remote-echo" nil)
- (tramp-message proc 5 "echo-mark found")
- (forward-line 1)
- (delete-region begin (point))
- (goto-char (point-min)))))
-
- (when (or (not (tramp-get-connection-property proc "check-remote-echo"
nil))
- ;; Sometimes, the echo string is suppressed on the remote side.
- (not (string-equal
- (substring-no-properties
- tramp-echo-mark-marker
- 0 (min tramp-echo-mark-marker-length (1- (point-max))))
- (buffer-substring-no-properties
- (point-min)
- (min (+ (point-min) tramp-echo-mark-marker-length)
- (point-max))))))
- ;; No echo to be handled, now we can look for the regexp.
- ;; Sometimes, lines are much too long, and we run into a "Stack
- ;; overflow in regexp matcher". For example, //DIRED// lines of
- ;; directory listings with some thousand files. Therefore, we
- ;; look from the end.
- (goto-char (point-max))
- (ignore-errors (re-search-backward regexp nil t)))))
-
-(defun tramp-wait-for-regexp (proc timeout regexp)
- "Wait for a REGEXP to appear from process PROC within TIMEOUT seconds.
-Expects the output of PROC to be sent to the current buffer. Returns
-the string that matched, or nil. Waits indefinitely if TIMEOUT is
-nil."
- (with-current-buffer (process-buffer proc)
- (let ((found (tramp-check-for-regexp proc regexp)))
- (cond (timeout
- (with-timeout (timeout)
- (while (not found)
- (tramp-accept-process-output proc)
- (unless (process-live-p proc)
- (tramp-error-with-buffer
- nil proc 'file-error "Process has died"))
- (setq found (tramp-check-for-regexp proc regexp)))))
- (t
- (while (not found)
- (tramp-accept-process-output proc)
- (unless (process-live-p proc)
- (tramp-error-with-buffer
- nil proc 'file-error "Process has died"))
- (setq found (tramp-check-for-regexp proc regexp)))))
- (tramp-message proc 6 "\n%s" (buffer-string))
- (unless found
- (if timeout
- (tramp-error
- proc 'file-error "[[Regexp `%s' not found in %d secs]]"
- regexp timeout)
- (tramp-error proc 'file-error "[[Regexp `%s' not found]]" regexp)))
- found)))
-
-;; It seems that Tru64 Unix does not like it if long strings are sent
-;; to it in one go. (This happens when sending the Perl
-;; `file-attributes' implementation, for instance.) Therefore, we
-;; have this function which sends the string in chunks.
-(defun tramp-send-string (vec string)
- "Send the STRING via connection VEC.
-
-The STRING is expected to use Unix line-endings, but the lines sent to
-the remote host use line-endings as defined in the variable
-`tramp-rsh-end-of-line'. The communication buffer is erased before sending."
- (let* ((p (tramp-get-connection-process vec))
- (chunksize (tramp-get-connection-property p "chunksize" nil)))
- (unless p
- (tramp-error
- vec 'file-error "Can't send string to remote host -- not logged in"))
- (tramp-set-connection-property p "last-cmd-time" (current-time))
- (tramp-message vec 10 "%s" string)
- (with-current-buffer (tramp-get-connection-buffer vec)
- ;; Clean up the buffer. We cannot call `erase-buffer' because
- ;; narrowing might be in effect.
- (let ((inhibit-read-only t)) (delete-region (point-min) (point-max)))
- ;; Replace "\n" by `tramp-rsh-end-of-line'.
- (setq string
- (mapconcat
- #'identity (split-string string "\n") tramp-rsh-end-of-line))
- (unless (or (string= string "")
- (string-equal (substring string -1) tramp-rsh-end-of-line))
- (setq string (concat string tramp-rsh-end-of-line)))
- ;; Send the string.
- (with-local-quit
- (if (and chunksize (not (zerop chunksize)))
- (let ((pos 0)
- (end (length string)))
- (while (< pos end)
- (tramp-message
- vec 10 "Sending chunk from %s to %s"
- pos (min (+ pos chunksize) end))
- (process-send-string
- p (substring string pos (min (+ pos chunksize) end)))
- (setq pos (+ pos chunksize))))
- (process-send-string p string))))))
-
-(defun tramp-process-sentinel (proc event)
- "Flush file caches and remove shell prompt."
- (unless (process-live-p proc)
- (let ((vec (process-get proc 'vector))
- (prompt (tramp-get-connection-property proc "prompt" nil)))
- (when vec
- (tramp-message vec 5 "Sentinel called: `%S' `%s'" proc event)
- (tramp-flush-connection-properties proc)
- (tramp-flush-directory-properties vec ""))
- (goto-char (point-max))
- (when (and prompt (re-search-backward (regexp-quote prompt) nil t))
- (delete-region (point) (point-max))))))
-
-(defun tramp-get-inode (vec)
- "Returns the virtual inode number.
-If it doesn't exist, generate a new one."
- (with-tramp-file-property vec (tramp-file-name-localname vec) "inode"
- (setq tramp-inodes (1+ tramp-inodes))))
-
-(defun tramp-get-device (vec)
- "Returns the virtual device number.
-If it doesn't exist, generate a new one."
- (with-tramp-connection-property (tramp-get-connection-process vec) "device"
- (cons -1 (setq tramp-devices (1+ tramp-devices)))))
-
-;; Comparision of vectors is performed by `tramp-file-name-equal-p'.
-(defun tramp-equal-remote (file1 file2)
- "Check, whether the remote parts of FILE1 and FILE2 are identical.
-The check depends on method, user and host name of the files. If
-one of the components is missing, the default values are used.
-The local file name parts of FILE1 and FILE2 are not taken into
-account.
-
-Example:
-
- (tramp-equal-remote \"/ssh::/etc\" \"/-:<your host name>:/home\")
-
-would yield t. On the other hand, the following check results in nil:
-
- (tramp-equal-remote \"/sudo::/etc\" \"/su::/etc\")"
- (and (tramp-tramp-file-p file1)
- (tramp-tramp-file-p file2)
- (string-equal (file-remote-p file1) (file-remote-p file2))))
-
-(defun tramp-mode-string-to-int (mode-string)
- "Converts a ten-letter `drwxrwxrwx'-style mode string into mode bits."
- (let* (case-fold-search
- (mode-chars (string-to-vector mode-string))
- (owner-read (aref mode-chars 1))
- (owner-write (aref mode-chars 2))
- (owner-execute-or-setid (aref mode-chars 3))
- (group-read (aref mode-chars 4))
- (group-write (aref mode-chars 5))
- (group-execute-or-setid (aref mode-chars 6))
- (other-read (aref mode-chars 7))
- (other-write (aref mode-chars 8))
- (other-execute-or-sticky (aref mode-chars 9)))
- (logior
- (cond
- ((char-equal owner-read ?r) #o0400)
- ((char-equal owner-read ?-) 0)
- (t (error "Second char `%c' must be one of `r-'" owner-read)))
- (cond
- ((char-equal owner-write ?w) #o0200)
- ((char-equal owner-write ?-) 0)
- (t (error "Third char `%c' must be one of `w-'" owner-write)))
- (cond
- ((char-equal owner-execute-or-setid ?x) #o0100)
- ((char-equal owner-execute-or-setid ?S) #o4000)
- ((char-equal owner-execute-or-setid ?s) #o4100)
- ((char-equal owner-execute-or-setid ?-) 0)
- (t (error "Fourth char `%c' must be one of `xsS-'"
- owner-execute-or-setid)))
- (cond
- ((char-equal group-read ?r) #o0040)
- ((char-equal group-read ?-) 0)
- (t (error "Fifth char `%c' must be one of `r-'" group-read)))
- (cond
- ((char-equal group-write ?w) #o0020)
- ((char-equal group-write ?-) 0)
- (t (error "Sixth char `%c' must be one of `w-'" group-write)))
- (cond
- ((char-equal group-execute-or-setid ?x) #o0010)
- ((char-equal group-execute-or-setid ?S) #o2000)
- ((char-equal group-execute-or-setid ?s) #o2010)
- ((char-equal group-execute-or-setid ?-) 0)
- (t (error "Seventh char `%c' must be one of `xsS-'"
- group-execute-or-setid)))
- (cond
- ((char-equal other-read ?r) #o0004)
- ((char-equal other-read ?-) 0)
- (t (error "Eighth char `%c' must be one of `r-'" other-read)))
- (cond
- ((char-equal other-write ?w) #o0002)
- ((char-equal other-write ?-) 0)
- (t (error "Ninth char `%c' must be one of `w-'" other-write)))
- (cond
- ((char-equal other-execute-or-sticky ?x) #o0001)
- ((char-equal other-execute-or-sticky ?T) #o1000)
- ((char-equal other-execute-or-sticky ?t) #o1001)
- ((char-equal other-execute-or-sticky ?-) 0)
- (t (error "Tenth char `%c' must be one of `xtT-'"
- other-execute-or-sticky))))))
-
-(defconst tramp-file-mode-type-map
- '((0 . "-") ; Normal file (SVID-v2 and XPG2)
- (1 . "p") ; fifo
- (2 . "c") ; character device
- (3 . "m") ; multiplexed character device (v7)
- (4 . "d") ; directory
- (5 . "?") ; Named special file (XENIX)
- (6 . "b") ; block device
- (7 . "?") ; multiplexed block device (v7)
- (8 . "-") ; regular file
- (9 . "n") ; network special file (HP-UX)
- (10 . "l") ; symlink
- (11 . "?") ; ACL shadow inode (Solaris, not userspace)
- (12 . "s") ; socket
- (13 . "D") ; door special (Solaris)
- (14 . "w")) ; whiteout (BSD)
- "A list of file types returned from the `stat' system call.
-This is used to map a mode number to a permission string.")
-
-(defun tramp-file-mode-from-int (mode)
- "Turn an integer representing a file mode into an ls(1)-like string."
- (let ((type (cdr
- (assoc (logand (ash mode -12) 15) tramp-file-mode-type-map)))
- (user (logand (ash mode -6) 7))
- (group (logand (ash mode -3) 7))
- (other (logand (ash mode -0) 7))
- (suid (> (logand (ash mode -9) 4) 0))
- (sgid (> (logand (ash mode -9) 2) 0))
- (sticky (> (logand (ash mode -9) 1) 0)))
- (setq user (tramp-file-mode-permissions user suid "s"))
- (setq group (tramp-file-mode-permissions group sgid "s"))
- (setq other (tramp-file-mode-permissions other sticky "t"))
- (concat type user group other)))
-
-(defun tramp-file-mode-permissions (perm suid suid-text)
- "Convert a permission bitset into a string.
-This is used internally by `tramp-file-mode-from-int'."
- (let ((r (> (logand perm 4) 0))
- (w (> (logand perm 2) 0))
- (x (> (logand perm 1) 0)))
- (concat (or (and r "r") "-")
- (or (and w "w") "-")
- (or (and suid x suid-text) ; suid, execute
- (and suid (upcase suid-text)) ; suid, !execute
- (and x "x") "-")))) ; !suid
-
-;; This is a Tramp internal function. A general `set-file-uid-gid'
-;; outside Tramp is not needed, I believe.
-(defun tramp-set-file-uid-gid (filename &optional uid gid)
- "Set the ownership for FILENAME.
-If UID and GID are provided, these values are used; otherwise uid
-and gid of the corresponding remote or local user is taken,
-depending whether FILENAME is remote or local. Both parameters
-must be non-negative integers.
-The setgid bit of the upper directory is respected.
-If FILENAME is remote, a file name handler is called."
- (let* ((dir (file-name-directory filename))
- (modes (file-modes dir)))
- (when (and modes (not (zerop (logand modes #o2000))))
- (setq gid (tramp-compat-file-attribute-group-id (file-attributes dir)))))
-
- (let ((handler (find-file-name-handler filename 'tramp-set-file-uid-gid)))
- (if handler
- (funcall handler #'tramp-set-file-uid-gid filename uid gid)
- ;; On W32 "chown" does not work.
- (unless (memq system-type '(ms-dos windows-nt))
- (let ((uid (or (and (natnump uid) uid) (tramp-get-local-uid 'integer)))
- (gid (or (and (natnump gid) gid) (tramp-get-local-gid 'integer))))
- (tramp-call-process
- nil "chown" nil nil nil
- (format "%d:%d" uid gid) (shell-quote-argument filename)))))))
-
-(defun tramp-get-local-uid (id-format)
- "The uid of the local user, in ID-FORMAT.
-ID-FORMAT valid values are `string' and `integer'."
- ;; We use key nil for local connection properties.
- (with-tramp-connection-property nil (format "uid-%s" id-format)
- (if (equal id-format 'integer) (user-uid) (user-login-name))))
-
-(defun tramp-get-local-gid (id-format)
- "The gid of the local user, in ID-FORMAT.
-ID-FORMAT valid values are `string' and `integer'."
- ;; We use key nil for local connection properties.
- (with-tramp-connection-property nil (format "gid-%s" id-format)
- (cond
- ;; `group-gid' has been introduced with Emacs 24.4.
- ((and (fboundp 'group-gid) (equal id-format 'integer))
- (tramp-compat-funcall 'group-gid))
- ;; `group-name' has been introduced with Emacs 27.1.
- ((and (fboundp 'group-name) (equal id-format 'string))
- (tramp-compat-funcall 'group-name (tramp-compat-funcall 'group-gid)))
- ((tramp-compat-file-attribute-group-id
- (file-attributes "~/" id-format))))))
-
-(defun tramp-get-local-locale (&optional vec)
- "Determine locale, supporting UTF8 if possible.
-VEC is used for tracing."
- ;; We use key nil for local connection properties.
- (with-tramp-connection-property nil "locale"
- (let ((candidates '("en_US.utf8" "C.utf8" "en_US.UTF-8"))
- locale)
- (with-temp-buffer
- (unless (or (memq system-type '(windows-nt))
- (not (zerop (tramp-call-process
- nil "locale" nil t nil "-a"))))
- (while candidates
- (goto-char (point-min))
- (if (string-match-p
- (format "^%s\r?$" (regexp-quote (car candidates)))
- (buffer-string))
- (setq locale (car candidates)
- candidates nil)
- (setq candidates (cdr candidates))))))
- ;; Return value.
- (when vec (tramp-message vec 7 "locale %s" (or locale "C")))
- (or locale "C"))))
-
-(defun tramp-check-cached-permissions (vec access)
- "Check `file-attributes' caches for VEC.
-Return t if according to the cache access type ACCESS is known to
-be granted."
- (let ((result nil)
- (offset (cond
- ((eq ?r access) 1)
- ((eq ?w access) 2)
- ((eq ?x access) 3))))
- (dolist (suffix '("string" "integer") result)
- (setq
- result
- (or
- result
- (let ((file-attr
- (or
- (tramp-get-file-property
- vec (tramp-file-name-localname vec)
- (concat "file-attributes-" suffix) nil)
- (file-attributes
- (tramp-make-tramp-file-name vec) (intern suffix))))
- (remote-uid
- (tramp-get-connection-property
- vec (concat "uid-" suffix) nil))
- (remote-gid
- (tramp-get-connection-property
- vec (concat "gid-" suffix) nil))
- (unknown-id
- (if (string-equal suffix "string")
- tramp-unknown-id-string tramp-unknown-id-integer)))
- (and
- file-attr
- (or
- ;; Not a symlink.
- (eq t (tramp-compat-file-attribute-type file-attr))
- (null (tramp-compat-file-attribute-type file-attr)))
- (or
- ;; World accessible.
- (eq access
- (aref (tramp-compat-file-attribute-modes file-attr)
- (+ offset 6)))
- ;; User accessible and owned by user.
- (and
- (eq access
- (aref (tramp-compat-file-attribute-modes file-attr) offset))
- (or (equal remote-uid
- (tramp-compat-file-attribute-user-id file-attr))
- (equal unknown-id
- (tramp-compat-file-attribute-user-id file-attr))))
- ;; Group accessible and owned by user's principal group.
- (and
- (eq access
- (aref (tramp-compat-file-attribute-modes file-attr)
- (+ offset 3)))
- (or (equal remote-gid
- (tramp-compat-file-attribute-group-id file-attr))
- (equal unknown-id
- (tramp-compat-file-attribute-group-id
- file-attr))))))))))))
-
-(defun tramp-local-host-p (vec)
- "Return t if this points to the local host, nil otherwise.
-This handles also chrooted environments, which are not regarded as local."
- (let ((host (tramp-file-name-host vec))
- (port (tramp-file-name-port vec)))
- (and
- (stringp tramp-local-host-regexp) (stringp host)
- (string-match-p tramp-local-host-regexp host)
- ;; A port is an indication for an ssh tunnel or alike.
- (null port)
- ;; The method shall be applied to one of the shell file name
- ;; handlers. `tramp-local-host-p' is also called for "smb" and
- ;; alike, where it must fail.
- (tramp-get-method-parameter vec 'tramp-login-program)
- ;; The local temp directory must be writable for the other user.
- (file-writable-p
- (tramp-make-tramp-file-name
- vec (tramp-compat-temporary-file-directory) 'nohop))
- ;; On some systems, chown runs only for root.
- (or (zerop (user-uid))
- ;; This is defined in tramp-sh.el. Let's assume this is
- ;; loaded already.
- (zerop (tramp-compat-funcall 'tramp-get-remote-uid vec 'integer))))))
-
-(defun tramp-get-remote-tmpdir (vec)
- "Return directory for temporary files on the remote host identified by VEC."
- (with-tramp-connection-property vec "tmpdir"
- (let ((dir
- (tramp-make-tramp-file-name
- vec (or (tramp-get-method-parameter vec 'tramp-tmpdir) "/tmp"))))
- (or (and (file-directory-p dir) (file-writable-p dir)
- (tramp-compat-file-local-name dir))
- (tramp-error vec 'file-error "Directory %s not accessible" dir))
- dir)))
-
-(defun tramp-make-tramp-temp-file (vec)
- "Create a temporary file on the remote host identified by VEC.
-Return the local name of the temporary file."
- (let ((prefix (expand-file-name
- tramp-temp-name-prefix (tramp-get-remote-tmpdir vec)))
- result)
- (while (not result)
- ;; `make-temp-file' would be the natural choice for
- ;; implementation. But it calls `write-region' internally,
- ;; which also needs a temporary file - we would end in an
- ;; infinite loop.
- (setq result (make-temp-name prefix))
- (if (file-exists-p result)
- (setq result nil)
- ;; This creates the file by side effect.
- (set-file-times result)
- (set-file-modes result #o0700)))
-
- ;; Return the local part.
- (with-parsed-tramp-file-name result nil localname)))
-
-(defun tramp-delete-temp-file-function ()
- "Remove temporary files related to current buffer."
- (when (stringp tramp-temp-buffer-file-name)
- (ignore-errors (delete-file tramp-temp-buffer-file-name))))
-
-(add-hook 'kill-buffer-hook #'tramp-delete-temp-file-function)
-(add-hook 'tramp-unload-hook
- (lambda ()
- (remove-hook 'kill-buffer-hook
- #'tramp-delete-temp-file-function)))
-
-(defun tramp-handle-make-auto-save-file-name ()
- "Like `make-auto-save-file-name' for Tramp files.
-Returns a file name in `tramp-auto-save-directory' for autosaving
-this file, if that variable is non-nil."
- (when (stringp tramp-auto-save-directory)
- (setq tramp-auto-save-directory
- (expand-file-name tramp-auto-save-directory)))
- ;; Create directory.
- (unless (or (null tramp-auto-save-directory)
- (file-exists-p tramp-auto-save-directory))
- (make-directory tramp-auto-save-directory t))
-
- (let ((system-type
- (if (and (stringp tramp-auto-save-directory)
- (file-remote-p tramp-auto-save-directory))
- 'not-windows
- system-type))
- (auto-save-file-name-transforms
- (if (null tramp-auto-save-directory)
- auto-save-file-name-transforms))
- (buffer-file-name
- (if (null tramp-auto-save-directory)
- buffer-file-name
- (expand-file-name
- (tramp-subst-strs-in-string
- '(("_" . "|")
- ("/" . "_a")
- (":" . "_b")
- ("|" . "__")
- ("[" . "_l")
- ("]" . "_r"))
- (tramp-compat-file-name-unquote (buffer-file-name)))
- tramp-auto-save-directory))))
- ;; Run plain `make-auto-save-file-name'.
- (tramp-run-real-handler #'make-auto-save-file-name nil)))
-
-(defun tramp-subst-strs-in-string (alist string)
- "Replace all occurrences of the string FROM with TO in STRING.
-ALIST is of the form ((FROM . TO) ...)."
- (save-match-data
- (while alist
- (let* ((pr (car alist))
- (from (car pr))
- (to (cdr pr)))
- (while (string-match (regexp-quote from) string)
- (setq string (replace-match to t t string)))
- (setq alist (cdr alist))))
- string))
-
-(defun tramp-handle-temporary-file-directory ()
- "Like `temporary-file-directory' for Tramp files."
- (catch 'result
- (dolist (dir `(,(ignore-errors
- (tramp-get-remote-tmpdir
- (tramp-dissect-file-name default-directory)))
- ,default-directory))
- (when (and (stringp dir) (file-directory-p dir) (file-writable-p dir))
- (throw 'result (expand-file-name dir))))))
-
-(defun tramp-handle-make-nearby-temp-file (prefix &optional dir-flag suffix)
- "Like `make-nearby-temp-file' for Tramp files."
- (let ((temporary-file-directory
- (tramp-compat-temporary-file-directory-function)))
- (make-temp-file prefix dir-flag suffix)))
-
-;;; Compatibility functions section:
-
-(defun tramp-call-process
- (vec program &optional infile destination display &rest args)
- "Calls `call-process' on the local host.
-It always returns a return code. The Lisp error raised when
-PROGRAM is nil is trapped also, returning 1. Furthermore, traces
-are written with verbosity of 6."
- (let ((default-directory (tramp-compat-temporary-file-directory))
- (destination (if (eq destination t) (current-buffer) destination))
- (vec (or vec (car tramp-current-connection)))
- output error result)
- (tramp-message
- vec 6 "`%s %s' %s %s"
- program (mapconcat #'identity args " ") infile destination)
- (condition-case err
- (with-temp-buffer
- (setq result
- (apply
- #'call-process program infile (or destination t) display args))
- ;; `result' could also be an error string.
- (when (stringp result)
- (setq error result
- result 1))
- (with-current-buffer
- (if (bufferp destination) destination (current-buffer))
- (setq output (buffer-string))))
- (error
- (setq error (error-message-string err)
- result 1)))
- (if (zerop (length error))
- (tramp-message vec 6 "%d\n%s" result output)
- (tramp-message vec 6 "%d\n%s\n%s" result output error))
- result))
-
-(defun tramp-call-process-region
- (vec start end program &optional delete buffer display &rest args)
- "Calls `call-process-region' on the local host.
-It always returns a return code. The Lisp error raised when
-PROGRAM is nil is trapped also, returning 1. Furthermore, traces
-are written with verbosity of 6."
- (let ((default-directory (tramp-compat-temporary-file-directory))
- (buffer (if (eq buffer t) (current-buffer) buffer))
- result)
- (tramp-message
- vec 6 "`%s %s' %s %s %s %s"
- program (mapconcat #'identity args " ") start end delete buffer)
- (condition-case err
- (progn
- (setq result
- (apply
- #'call-process-region
- start end program delete buffer display args))
- ;; `result' could also be an error string.
- (when (stringp result)
- (signal 'file-error (list result)))
- (with-current-buffer (if (bufferp buffer) buffer (current-buffer))
- (if (zerop result)
- (tramp-message vec 6 "%d" result)
- (tramp-message vec 6 "%d\n%s" result (buffer-string)))))
- (error
- (setq result 1)
- (tramp-message vec 6 "%d\n%s" result (error-message-string err))))
- result))
-
-(defun tramp-process-lines
- (vec program &rest args)
- "Calls `process-lines' on the local host.
-If an error occurs, it returns nil. Traces are written with
-verbosity of 6."
- (let ((default-directory (tramp-compat-temporary-file-directory))
- (vec (or vec (car tramp-current-connection)))
- result)
- (if args
- (tramp-message vec 6 "%s %s" program (mapconcat #'identity args " "))
- (tramp-message vec 6 "%s" program))
- (setq result
- (condition-case err
- (apply #'process-lines program args)
- (error
- (tramp-error vec (car err) (cdr err)))))
- (tramp-message vec 6 "%s" result)
- result))
-
-(defun tramp-read-passwd (proc &optional prompt)
- "Read a password from user (compat function).
-Consults the auth-source package.
-Invokes `password-read' if available, `read-passwd' else."
- (let* ((case-fold-search t)
- (key (tramp-make-tramp-file-name
- ;; In tramp-sh.el, we must use "password-vector" due to
- ;; multi-hop.
- (tramp-get-connection-property
- proc "password-vector" (process-get proc 'vector))
- 'noloc 'nohop))
- (pw-prompt
- (or prompt
- (with-current-buffer (process-buffer proc)
- (tramp-check-for-regexp proc tramp-password-prompt-regexp)
- (format "%s for %s " (capitalize (match-string 1)) key))))
- (auth-source-creation-prompts `((secret . ,pw-prompt)))
- ;; We suspend the timers while reading the password.
- (stimers (with-timeout-suspend))
- auth-info auth-passwd)
-
- (unwind-protect
- (with-parsed-tramp-file-name key nil
- (setq tramp-password-save-function nil
- user
- (or user (tramp-get-connection-property key "login-as" nil)))
- (prog1
- (or
- ;; See if auth-sources contains something useful.
- (ignore-errors
- (and (tramp-get-connection-property
- v "first-password-request" nil)
- ;; Try with Tramp's current method.
- (setq auth-info
- (car
- (auth-source-search
- :max 1
- (and user :user)
- (if domain
- (concat
- user tramp-prefix-domain-format domain)
- user)
- :host
- (if port
- (concat
- host tramp-prefix-port-format port)
- host)
- :port method
- :require (cons :secret (and user '(:user)))
- :create t))
- tramp-password-save-function
- (plist-get auth-info :save-function)
- auth-passwd (plist-get auth-info :secret)))
- (while (functionp auth-passwd)
- (setq auth-passwd (funcall auth-passwd)))
- auth-passwd)
-
- ;; Try the password cache.
- (progn
- (setq auth-passwd (password-read pw-prompt key)
- tramp-password-save-function
- (lambda () (password-cache-add key auth-passwd)))
- auth-passwd)
-
- ;; Else, get the password interactively w/o cache.
- (read-passwd pw-prompt))
-
- (tramp-set-connection-property v "first-password-request" nil)))
-
- ;; Reenable the timers.
- (with-timeout-unsuspend stimers))))
-
-(defun tramp-clear-passwd (vec)
- "Clear password cache for connection related to VEC."
- (let ((method (tramp-file-name-method vec))
- (user-domain (tramp-file-name-user-domain vec))
- (host-port (tramp-file-name-host-port vec))
- (hop (tramp-file-name-hop vec)))
- (when hop
- ;; Clear also the passwords of the hops.
- (tramp-clear-passwd (tramp-dissect-hop-name hop)))
- (auth-source-forget
- `(:max 1 ,(and user-domain :user) ,user-domain
- :host ,host-port :port ,method))
- (password-cache-remove (tramp-make-tramp-file-name vec 'noloc 'nohop))))
-
-(defun tramp-time-diff (t1 t2)
- "Return the difference between the two times, in seconds.
-T1 and T2 are time values (as returned by `current-time' for example)."
- (float-time (time-subtract t1 t2)))
-
-(defun tramp-unquote-shell-quote-argument (s)
- "Remove quotation prefix \"/:\" from string S, and quote it then for shell."
- (shell-quote-argument (tramp-compat-file-name-unquote s)))
-
-;; Currently (as of Emacs 20.5), the function `shell-quote-argument'
-;; does not deal well with newline characters. Newline is replaced by
-;; backslash newline. But if, say, the string `a backslash newline b'
-;; is passed to a shell, the shell will expand this into "ab",
-;; completely omitting the newline. This is not what was intended.
-;; It does not appear to be possible to make the function
-;; `shell-quote-argument' work with newlines without making it
-;; dependent on the shell used. But within this package, we know that
-;; we will always use a Bourne-like shell, so we use an approach which
-;; groks newlines.
-;;
-;; The approach is simple: we call `shell-quote-argument', then
-;; massage the newline part of the result.
-;;
-;; This function should produce a string which is grokked by a Unix
-;; shell, even if the Emacs is running on Windows. Since this is the
-;; kludges section, we bind `system-type' in such a way that
-;; `shell-quote-argument' behaves as if on Unix.
-;;
-;; Thanks to Mario DeWeerd for the hint that it is sufficient for this
-;; function to work with Bourne-like shells.
-(defun tramp-shell-quote-argument (s)
- "Similar to `shell-quote-argument', but groks newlines.
-Only works for Bourne-like shells."
- (let ((system-type 'not-windows))
- (save-match-data
- (let ((result (tramp-unquote-shell-quote-argument s))
- (nl (regexp-quote (format "\\%s" tramp-rsh-end-of-line))))
- (when (and (>= (length result) 2)
- (string= (substring result 0 2) "\\~"))
- (setq result (substring result 1)))
- (while (string-match nl result)
- (setq result (replace-match (format "'%s'" tramp-rsh-end-of-line)
- t t result)))
- result))))
-
-;;; Signal handling. This works for remote processes, which have set
-;;; the process property `remote-pid'.
-
-(defun tramp-interrupt-process (&optional process _current-group)
- "Interrupt remote process PROC."
- ;; CURRENT-GROUP is not implemented yet.
- (let ((proc (cond
- ((processp process) process)
- ((bufferp process) (get-buffer-process process))
- ((stringp process) (or (get-process process)
- (get-buffer-process process)))
- ((null process) (get-buffer-process (current-buffer)))
- (t process)))
- pid)
- ;; If it's a Tramp process, send the INT signal remotely.
- (when (and (processp proc) (setq pid (process-get proc 'remote-pid)))
- (if (not (process-live-p proc))
- (tramp-error proc 'error "Process %s is not active" proc)
- (tramp-message proc 5 "Interrupt process %s with pid %s" proc pid)
- ;; This is for tramp-sh.el. Other backends do not support this (yet).
- (tramp-compat-funcall
- 'tramp-send-command
- (process-get proc 'vector)
- (format "kill -2 -%d" pid))
- ;; Wait, until the process has disappeared. If it doesn't,
- ;; fall back to the default implementation.
- (while (tramp-accept-process-output proc 0))
- (not (process-live-p proc))))))
-
-;; `interrupt-process-functions' exists since Emacs 26.1.
-(when (boundp 'interrupt-process-functions)
- (add-hook 'interrupt-process-functions #'tramp-interrupt-process)
- (add-hook
- 'tramp-unload-hook
- (lambda ()
- (remove-hook 'interrupt-process-functions #'tramp-interrupt-process))))
-
-;; Checklist for `tramp-unload-hook'
-;; - Unload all `tramp-*' packages
-;; - Reset `file-name-handler-alist'
-;; - Cleanup hooks where Tramp functions are in
-;; - Cleanup autoloads
-;;;###autoload
-(defun tramp-unload-tramp ()
- "Discard Tramp from loading remote files."
- (interactive)
- ;; ange-ftp settings must be re-enabled.
- (tramp-compat-funcall 'tramp-ftp-enable-ange-ftp)
- ;; Maybe it's not loaded yet.
- (ignore-errors (unload-feature 'tramp 'force)))
-
-(provide 'tramp)
-
-(run-hooks 'tramp--startup-hook)
-(setq tramp--startup-hook nil)
-
-;;; TODO:
-;;
-;; * Avoid screen blanking when hitting `g' in dired. (Eli Tziperman)
-;;
-;; * Better error checking. At least whenever we see something
-;; strange when doing zerop, we should kill the process and start
-;; again. (Greg Stark)
-;;
-;; * I was wondering if it would be possible to use tramp even if I'm
-;; actually using sshfs. But when I launch a command I would like
-;; to get it executed on the remote machine where the files really
-;; are. (Andrea Crotti)
-;;
-;; * Run emerge on two remote files. Bug is described here:
-;; <https://www.mail-archive.com/address@hidden/msg01041.html>.
-;; (Bug#6850)
-;;
-;; * Refactor code from different handlers. Start with
-;; *-process-file. One idea is to generalize `tramp-send-command'
-;; and friends, for most of the handlers this is the major
-;; difference between the different backends. Other handlers but
-;; *-process-file would profit from this as well.
-;;
-;; * Get rid of `shell-command'. In its primary implementation, it
-;; uses `process-file-shell-command' and
-;; `start-file-process-shell-command', which is sufficient due to
-;; connection-local `shell-file-name'.
-
-
-;;; tramp.el ends here
-
-;; Local Variables:
-;; mode: Emacs-Lisp
-;; coding: utf-8
-;; End:
diff --git a/tramp-adb.el b/tramp-adb.el
deleted file mode 120000
index 4d8b4fa..0000000
--- a/tramp-adb.el
+++ /dev/null
@@ -1 +0,0 @@
-lisp/tramp-adb.el
\ No newline at end of file
diff --git a/tramp-adb.el b/tramp-adb.el
new file mode 100644
index 0000000..008a5ce
--- /dev/null
+++ b/tramp-adb.el
@@ -0,0 +1,1320 @@
+;;; tramp-adb.el --- Functions for calling Android Debug Bridge from Tramp
-*- lexical-binding:t -*-
+
+;; Copyright (C) 2011-2019 Free Software Foundation, Inc.
+
+;; Author: Jürgen Hötzel <address@hidden>
+;; 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:
+
+;; The Android Debug Bridge "adb" must be installed on your local
+;; machine. If it is not in your $PATH, add the following form into
+;; your .emacs:
+;;
+;; (setq tramp-adb-program "/path/to/adb")
+;;
+;; Due to security it is not possible to access non-root devices.
+
+;;; Code:
+
+(require 'tramp)
+
+(defcustom tramp-adb-program "adb"
+ "Name of the Android Debug Bridge program."
+ :group 'tramp
+ :version "24.4"
+ :type 'string)
+
+(defcustom tramp-adb-connect-if-not-connected nil
+ "Try to run `adb connect' if provided device is not connected currently.
+It is used for TCP/IP devices."
+ :group 'tramp
+ :version "25.1"
+ :type 'boolean)
+
+;;;###tramp-autoload
+(defconst tramp-adb-method "adb"
+ "When this method name is used, forward all calls to Android Debug Bridge.")
+
+(defcustom tramp-adb-prompt
+
"^[[:digit:]]*|?[[:alnum:]\e;address@hidden:alnum:]]*[^#\\$]*[#\\$][[:space:]]"
+ "Regexp used as prompt in almquist shell."
+ :type 'string
+ :version "24.4"
+ :group 'tramp)
+
+(defconst tramp-adb-ls-date-regexp
+
"[[:space:]][0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9][[:space:]][0-9][0-9]:[0-9][0-9][[:space:]]"
+ "Regexp for date format in ls output.")
+
+(defconst tramp-adb-ls-toolbox-regexp
+ (concat
+ "^[[:space:]]*\\([-.[:alpha:]]+\\)" ; \1 permissions
+ "\\(?:[[:space:]]+[[:digit:]]+\\)?" ; links (Android 7/toybox)
+ "[[:space:]]*\\([^[:space:]]+\\)" ; \2 username
+ "[[:space:]]+\\([^[:space:]]+\\)" ; \3 group
+ "[[:space:]]+\\([[:digit:]]+\\)" ; \4 size
+ "[[:space:]]+\\([-[:digit:]]+[[:space:]][:[:digit:]]+\\)" ; \5 date
+ "[[:space:]]\\(.*\\)$") ; \6 filename
+ "Regexp for ls output.")
+
+;;;###tramp-autoload
+(tramp--with-startup
+ (add-to-list 'tramp-methods
+ `(,tramp-adb-method
+ (tramp-tmpdir "/data/local/tmp")
+ (tramp-default-port 5555)))
+
+ (add-to-list 'tramp-default-host-alist `(,tramp-adb-method nil ""))
+
+ (tramp-set-completion-function
+ tramp-adb-method '((tramp-adb-parse-device-names ""))))
+
+;;;###tramp-autoload
+(defconst tramp-adb-file-name-handler-alist
+ '((access-file . tramp-handle-access-file)
+ (add-name-to-file . tramp-handle-add-name-to-file)
+ ;; `byte-compiler-base-file-name' performed by default handler.
+ ;; `copy-directory' performed by default handler.
+ (copy-file . tramp-adb-handle-copy-file)
+ (delete-directory . tramp-adb-handle-delete-directory)
+ (delete-file . tramp-adb-handle-delete-file)
+ ;; `diff-latest-backup-file' performed by default handler.
+ (directory-file-name . tramp-handle-directory-file-name)
+ (directory-files . tramp-handle-directory-files)
+ (directory-files-and-attributes
+ . tramp-adb-handle-directory-files-and-attributes)
+ (dired-compress-file . ignore)
+ (dired-uncache . tramp-handle-dired-uncache)
+ (exec-path . tramp-adb-handle-exec-path)
+ (expand-file-name . tramp-handle-expand-file-name)
+ (file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
+ (file-acl . ignore)
+ (file-attributes . tramp-adb-handle-file-attributes)
+ (file-directory-p . tramp-handle-file-directory-p)
+ (file-equal-p . tramp-handle-file-equal-p)
+ ;; FIXME: This is too sloppy.
+ (file-executable-p . tramp-handle-file-exists-p)
+ (file-exists-p . tramp-handle-file-exists-p)
+ (file-in-directory-p . tramp-handle-file-in-directory-p)
+ (file-local-copy . tramp-adb-handle-file-local-copy)
+ (file-modes . tramp-handle-file-modes)
+ (file-name-all-completions . tramp-adb-handle-file-name-all-completions)
+ (file-name-as-directory . tramp-handle-file-name-as-directory)
+ (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p)
+ (file-name-completion . tramp-handle-file-name-completion)
+ (file-name-directory . tramp-handle-file-name-directory)
+ (file-name-nondirectory . tramp-handle-file-name-nondirectory)
+ ;; `file-name-sans-versions' performed by default handler.
+ (file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
+ (file-notify-add-watch . tramp-handle-file-notify-add-watch)
+ (file-notify-rm-watch . tramp-handle-file-notify-rm-watch)
+ (file-notify-valid-p . tramp-handle-file-notify-valid-p)
+ (file-ownership-preserved-p . ignore)
+ (file-readable-p . tramp-handle-file-exists-p)
+ (file-regular-p . tramp-handle-file-regular-p)
+ (file-remote-p . tramp-handle-file-remote-p)
+ (file-selinux-context . tramp-handle-file-selinux-context)
+ (file-symlink-p . tramp-handle-file-symlink-p)
+ (file-system-info . tramp-adb-handle-file-system-info)
+ (file-truename . tramp-adb-handle-file-truename)
+ (file-writable-p . tramp-adb-handle-file-writable-p)
+ (find-backup-file-name . tramp-handle-find-backup-file-name)
+ ;; `get-file-buffer' performed by default handler.
+ (insert-directory . tramp-handle-insert-directory)
+ (insert-file-contents . tramp-handle-insert-file-contents)
+ (load . tramp-handle-load)
+ (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
+ (make-directory . tramp-adb-handle-make-directory)
+ (make-directory-internal . ignore)
+ (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
+ (make-process . tramp-adb-handle-make-process)
+ (make-symbolic-link . tramp-handle-make-symbolic-link)
+ (process-file . tramp-adb-handle-process-file)
+ (rename-file . tramp-adb-handle-rename-file)
+ (set-file-acl . ignore)
+ (set-file-modes . tramp-adb-handle-set-file-modes)
+ (set-file-selinux-context . ignore)
+ (set-file-times . tramp-adb-handle-set-file-times)
+ (set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
+ (shell-command . tramp-handle-shell-command)
+ (start-file-process . tramp-handle-start-file-process)
+ (substitute-in-file-name . tramp-handle-substitute-in-file-name)
+ (temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-set-file-uid-gid . ignore)
+ (unhandled-file-name-directory . ignore)
+ (vc-registered . ignore)
+ (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
+ (write-region . tramp-adb-handle-write-region))
+ "Alist of handler functions for Tramp ADB method.")
+
+;; It must be a `defsubst' in order to push the whole code into
+;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
+;;;###tramp-autoload
+(defsubst tramp-adb-file-name-p (filename)
+ "Check if it's a filename for ADB."
+ (and (tramp-tramp-file-p filename)
+ (string= (tramp-file-name-method (tramp-dissect-file-name filename))
+ tramp-adb-method)))
+
+;;;###tramp-autoload
+(defun tramp-adb-file-name-handler (operation &rest args)
+ "Invoke the ADB handler for OPERATION.
+First arg specifies the OPERATION, second arg is a list of arguments to
+pass to the OPERATION."
+ (let ((fn (assoc operation tramp-adb-file-name-handler-alist)))
+ (if fn
+ (save-match-data (apply (cdr fn) args))
+ (tramp-run-real-handler operation args))))
+
+;;;###tramp-autoload
+(tramp--with-startup
+ (tramp-register-foreign-file-name-handler
+ #'tramp-adb-file-name-p #'tramp-adb-file-name-handler))
+
+;;;###tramp-autoload
+(defun tramp-adb-parse-device-names (_ignore)
+ "Return a list of (nil host) tuples allowed to access."
+ (delq nil
+ (mapcar
+ (lambda (line)
+ (when (string-match "^\\(\\S-+\\)[[:space:]]+device$" line)
+ ;; Replace ":" by "#".
+ `(nil ,(replace-regexp-in-string
+ ":" tramp-prefix-port-format (match-string 1 line)))))
+ (tramp-process-lines nil tramp-adb-program "devices"))))
+
+(defun tramp-adb-handle-file-system-info (filename)
+ "Like `file-system-info' for Tramp files."
+ (ignore-errors
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (tramp-message v 5 "file system info: %s" localname)
+ (tramp-adb-send-command
+ v (format "df -k %s" (tramp-shell-quote-argument localname)))
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (goto-char (point-min))
+ (forward-line)
+ (when (looking-at
+ (eval-when-compile
+ (concat "[[:space:]]*[^[:space:]]+"
+ "[[:space:]]+\\([[:digit:]]+\\)"
+ "[[:space:]]+\\([[:digit:]]+\\)"
+ "[[:space:]]+\\([[:digit:]]+\\)")))
+ ;; The values are given as 1k numbers, so we must change
+ ;; them to number of bytes.
+ (list (* 1024 (string-to-number (match-string 1)))
+ ;; The second value is the used size. We need the
+ ;; free size.
+ (* 1024 (- (string-to-number (match-string 1))
+ (string-to-number (match-string 2))))
+ (* 1024 (string-to-number (match-string 3)))))))))
+
+;; This is derived from `tramp-sh-handle-file-truename'. Maybe the
+;; code could be shared?
+(defun tramp-adb-handle-file-truename (filename)
+ "Like `file-truename' for Tramp files."
+ ;; Preserve trailing "/".
+ (funcall
+ (if (string-equal (file-name-nondirectory filename) "")
+ #'file-name-as-directory #'identity)
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (tramp-make-tramp-file-name
+ v
+ (with-tramp-file-property v localname "file-truename"
+ (let ((result nil) ; result steps in reverse order
+ (quoted (tramp-compat-file-name-quoted-p localname)))
+ (tramp-message v 4 "Finding true name for `%s'" filename)
+ (let* ((steps (split-string localname "/" 'omit))
+ (localnamedir (tramp-run-real-handler
+ 'file-name-as-directory (list localname)))
+ (is-dir (string= localname localnamedir))
+ (thisstep nil)
+ (numchase 0)
+ ;; Don't make the following value larger than
+ ;; necessary. People expect an error message in a
+ ;; timely fashion when something is wrong; otherwise
+ ;; they might think that Emacs is hung. Of course,
+ ;; correctness has to come first.
+ (numchase-limit 20)
+ symlink-target)
+ (while (and steps (< numchase numchase-limit))
+ (setq thisstep (pop steps))
+ (tramp-message
+ v 5 "Check %s"
+ (mapconcat #'identity
+ (append '("") (reverse result) (list thisstep))
+ "/"))
+ (setq symlink-target
+ (tramp-compat-file-attribute-type
+ (file-attributes
+ (tramp-make-tramp-file-name
+ v (mapconcat #'identity
+ (append
+ '("") (reverse result) (list thisstep))
+ "/")))))
+ (cond ((string= "." thisstep)
+ (tramp-message v 5 "Ignoring step `.'"))
+ ((string= ".." thisstep)
+ (tramp-message v 5 "Processing step `..'")
+ (pop result))
+ ((stringp symlink-target)
+ ;; It's a symlink, follow it.
+ (tramp-message v 5 "Follow symlink to %s" symlink-target)
+ (setq numchase (1+ numchase))
+ (when (file-name-absolute-p symlink-target)
+ (setq result nil))
+ ;; If the symlink was absolute, we'll get a string
+ ;; like "/address@hidden:/some/target"; extract the
+ ;; "/some/target" part from it.
+ (when (tramp-tramp-file-p symlink-target)
+ (unless (tramp-equal-remote filename symlink-target)
+ (tramp-error
+ v 'file-error
+ "Symlink target `%s' on wrong host" symlink-target))
+ (setq symlink-target localname))
+ (setq steps
+ (append (split-string symlink-target "/" 'omit)
+ steps)))
+ (t
+ ;; It's a file.
+ (setq result (cons thisstep result)))))
+ (when (>= numchase numchase-limit)
+ (tramp-error
+ v 'file-error
+ "Maximum number (%d) of symlinks exceeded" numchase-limit))
+ (setq result (reverse result))
+ ;; Combine list to form string.
+ (setq result
+ (if result
+ (mapconcat #'identity (cons "" result) "/")
+ "/"))
+ (when (and is-dir (or (string= "" result)
+ (not (string= (substring result -1) "/"))))
+ (setq result (concat result "/"))))
+
+ ;; Detect cycle.
+ (when (and (file-symlink-p filename)
+ (string-equal result localname))
+ (tramp-error
+ v 'file-error
+ "Apparent cycle of symbolic links for %s" filename))
+ ;; If the resulting localname looks remote, we must quote it
+ ;; for security reasons.
+ (when (or quoted (file-remote-p result))
+ (let (file-name-handler-alist)
+ (setq result (tramp-compat-file-name-quote result))))
+ (tramp-message v 4 "True name of `%s' is `%s'" localname result)
+ result))))))
+
+(defun tramp-adb-handle-file-attributes (filename &optional id-format)
+ "Like `file-attributes' for Tramp files."
+ (unless id-format (setq id-format 'integer))
+ (ignore-errors
+ (with-parsed-tramp-file-name filename nil
+ (with-tramp-file-property
+ v localname (format "file-attributes-%s" id-format)
+ (and
+ (tramp-adb-send-command-and-check
+ v (format "%s -d -l %s"
+ (tramp-adb-get-ls-command v)
+ (tramp-shell-quote-argument localname)))
+ (with-current-buffer (tramp-get-buffer v)
+ (tramp-adb-sh-fix-ls-output)
+ (cdar (tramp-do-parse-file-attributes-with-ls v id-format))))))))
+
+(defun tramp-do-parse-file-attributes-with-ls (vec &optional id-format)
+ "Parse `file-attributes' for Tramp files using the ls(1) command."
+ (with-current-buffer (tramp-get-buffer vec)
+ (goto-char (point-min))
+ (let ((file-properties nil))
+ (while (re-search-forward tramp-adb-ls-toolbox-regexp nil t)
+ (let* ((mod-string (match-string 1))
+ (is-dir (eq ?d (aref mod-string 0)))
+ (is-symlink (eq ?l (aref mod-string 0)))
+ (uid (match-string 2))
+ (gid (match-string 3))
+ (size (string-to-number (match-string 4)))
+ (date (match-string 5))
+ (name (match-string 6))
+ (symlink-target
+ (and is-symlink
+ (cadr (split-string name "\\( -> \\|\n\\)")))))
+ (push (list
+ (if is-symlink
+ (car (split-string name "\\( -> \\|\n\\)"))
+ name)
+ (or is-dir symlink-target)
+ 1 ;link-count
+ ;; no way to handle numeric ids in Androids ash
+ (if (eq id-format 'integer) 0 uid)
+ (if (eq id-format 'integer) 0 gid)
+ tramp-time-dont-know ; atime
+ (date-to-time date) ; mtime
+ tramp-time-dont-know ; ctime
+ size
+ mod-string
+ ;; fake
+ t 1
+ (tramp-get-device vec))
+ file-properties)))
+ file-properties)))
+
+(defun tramp-adb-handle-directory-files-and-attributes
+ (directory &optional full match nosort id-format)
+ "Like `directory-files-and-attributes' for Tramp files."
+ (when (file-directory-p directory)
+ (with-parsed-tramp-file-name (expand-file-name directory) nil
+ (copy-tree
+ (with-tramp-file-property
+ v localname (format "directory-files-and-attributes-%s-%s-%s-%s"
+ full match id-format nosort)
+ (with-current-buffer (tramp-get-buffer v)
+ (when (tramp-adb-send-command-and-check
+ v (format "%s -a -l %s"
+ (tramp-adb-get-ls-command v)
+ (tramp-shell-quote-argument localname)))
+ ;; We insert also filename/. and filename/.., because "ls" doesn't.
+ ;; Looks like it does include them in toybox, since Android 6.
+ (unless (re-search-backward "\\.$" nil t)
+ (narrow-to-region (point-max) (point-max))
+ (tramp-adb-send-command
+ v (format "%s -d -a -l %s %s"
+ (tramp-adb-get-ls-command v)
+ (tramp-shell-quote-argument
+ (concat (file-name-as-directory localname) "."))
+ (tramp-shell-quote-argument
+ (concat (file-name-as-directory localname) ".."))))
+ (widen)))
+ (tramp-adb-sh-fix-ls-output)
+ (let ((result (tramp-do-parse-file-attributes-with-ls
+ v (or id-format 'integer))))
+ (when full
+ (setq result
+ (mapcar
+ (lambda (x)
+ (cons (expand-file-name (car x) directory) (cdr x)))
+ result)))
+ (unless nosort
+ (setq result
+ (sort result (lambda (x y) (string< (car x) (car y))))))
+ (delq nil
+ (mapcar (lambda (x)
+ (if (or (not match) (string-match-p match (car x)))
+ x))
+ result)))))))))
+
+(defun tramp-adb-get-ls-command (vec)
+ "Determine `ls' command and its arguments."
+ (with-tramp-connection-property vec "ls"
+ (tramp-message vec 5 "Finding a suitable `ls' command")
+ (cond
+ ;; Support Android derived systems where "ls" command is provided
+ ;; by GNU Coreutils. Force "ls" to print one column and set
+ ;; time-style to imitate other "ls" flavors.
+ ((tramp-adb-send-command-and-check
+ vec "ls --time-style=long-iso /dev/null")
+ "ls -1 --time-style=long-iso")
+ ;; Can't disable coloring explicitly for toybox ls command. We
+ ;; also must force "ls" to print just one column.
+ ((tramp-adb-send-command-and-check vec "toybox") "ls -1")
+ ;; On CyanogenMod based system BusyBox is used and "ls" output
+ ;; coloring is enabled by default. So we try to disable it when
+ ;; possible.
+ ((tramp-adb-send-command-and-check vec "ls --color=never -al /dev/null")
+ "ls --color=never")
+ (t "ls"))))
+
+(defun tramp-adb--gnu-switches-to-ash (switches)
+ "Almquist shell can't handle multiple arguments.
+Convert (\"-al\") to (\"-a\" \"-l\"). Remove arguments like \"--dired\"."
+ (split-string
+ (apply #'concat
+ (mapcar (lambda (s)
+ (replace-regexp-in-string
+ "\\(.\\)" " -\\1" (replace-regexp-in-string "^-" "" s)))
+ ;; FIXME: Warning about removed switches (long and non-dash).
+ (delq nil
+ (mapcar
+ (lambda (s)
+ (and (not (string-match-p "\\(^--\\|^[^-]\\)" s)) s))
+ switches))))))
+
+(defun tramp-adb-sh-fix-ls-output (&optional sort-by-time)
+ "Insert dummy 0 in empty size columns.
+Androids \"ls\" command doesn't insert size column for directories:
+Emacs dired can't find files."
+ (save-excursion
+ ;; Insert missing size.
+ (goto-char (point-min))
+ (while
+ (search-forward-regexp
+
"[[:space:]]\\([[:space:]][0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9][[:space:]]\\)" nil
t)
+ (replace-match "0\\1" "\\1" nil)
+ ;; Insert missing "/".
+ (when (looking-at-p "[0-9][0-9]:[0-9][0-9][[:space:]]+$")
+ (end-of-line)
+ (insert "/")))
+ ;; Sort entries.
+ (let* ((lines (split-string (buffer-string) "\n" t))
+ (sorted-lines
+ (sort
+ lines
+ (if sort-by-time
+ #'tramp-adb-ls-output-time-less-p
+ #'tramp-adb-ls-output-name-less-p))))
+ (delete-region (point-min) (point-max))
+ (insert " " (mapconcat #'identity sorted-lines "\n ")))
+ ;; Add final newline.
+ (goto-char (point-max))
+ (unless (bolp) (insert "\n"))))
+
+(defun tramp-adb-ls-output-time-less-p (a b)
+ "Sort \"ls\" output by time, descending."
+ (let (time-a time-b)
+ (string-match tramp-adb-ls-date-regexp a)
+ (setq time-a (apply #'encode-time (parse-time-string (match-string 0 a))))
+ (string-match tramp-adb-ls-date-regexp b)
+ (setq time-b (apply #'encode-time (parse-time-string (match-string 0 b))))
+ (time-less-p time-b time-a)))
+
+(defun tramp-adb-ls-output-name-less-p (a b)
+ "Sort \"ls\" output by name, ascending."
+ (if (string-match directory-listing-before-filename-regexp a)
+ (let ((posa (match-end 0)))
+ (if (string-match directory-listing-before-filename-regexp b)
+ (let ((posb (match-end 0)))
+ (string-lessp (substring a posa) (substring b posb)))))))
+
+(defun tramp-adb-handle-make-directory (dir &optional parents)
+ "Like `make-directory' for Tramp files."
+ (setq dir (expand-file-name dir))
+ (with-parsed-tramp-file-name dir nil
+ (when parents
+ (let ((par (expand-file-name ".." dir)))
+ (unless (file-directory-p par)
+ (make-directory par parents))))
+ (tramp-flush-file-properties v (file-name-directory localname))
+ (tramp-flush-directory-properties v localname)
+ (unless (or (tramp-adb-send-command-and-check
+ v (format "mkdir %s" (tramp-shell-quote-argument localname)))
+ (and parents (file-directory-p dir)))
+ (tramp-error v 'file-error "Couldn't make directory %s" dir))))
+
+(defun tramp-adb-handle-delete-directory (directory &optional recursive _trash)
+ "Like `delete-directory' for Tramp files."
+ (setq directory (expand-file-name directory))
+ (with-parsed-tramp-file-name (file-truename directory) nil
+ (tramp-flush-file-properties v (file-name-directory localname))
+ (tramp-flush-directory-properties v localname))
+ (with-parsed-tramp-file-name directory nil
+ (tramp-flush-file-properties v (file-name-directory localname))
+ (tramp-flush-directory-properties v localname)
+ (tramp-adb-barf-unless-okay
+ v (format "%s %s"
+ (if recursive "rm -r" "rmdir")
+ (tramp-shell-quote-argument localname))
+ "Couldn't delete %s" directory)))
+
+(defun tramp-adb-handle-delete-file (filename &optional _trash)
+ "Like `delete-file' for Tramp files."
+ (setq filename (expand-file-name filename))
+ (with-parsed-tramp-file-name filename nil
+ (tramp-flush-file-properties v (file-name-directory localname))
+ (tramp-flush-file-properties v localname)
+ (tramp-adb-barf-unless-okay
+ v (format "rm %s" (tramp-shell-quote-argument localname))
+ "Couldn't delete %s" filename)))
+
+(defun tramp-adb-handle-file-name-all-completions (filename directory)
+ "Like `file-name-all-completions' for Tramp files."
+ (all-completions
+ filename
+ (with-parsed-tramp-file-name (expand-file-name directory) nil
+ (with-tramp-file-property v localname "file-name-all-completions"
+ (tramp-adb-send-command
+ v (format "%s -a %s"
+ (tramp-adb-get-ls-command v)
+ (tramp-shell-quote-argument localname)))
+ (mapcar
+ (lambda (f)
+ (if (file-directory-p (expand-file-name f directory))
+ (file-name-as-directory f)
+ f))
+ (with-current-buffer (tramp-get-buffer v)
+ (delete-dups
+ (append
+ ;; In older Android versions, "." and ".." are not
+ ;; included. In newer versions (toybox, since Android 6)
+ ;; they are. We fix this by `delete-dups'.
+ '("." "..")
+ (delq
+ nil
+ (mapcar
+ (lambda (l) (and (not (string-match-p "^[[:space:]]*$" l)) l))
+ (split-string (buffer-string) "\n")))))))))))
+
+(defun tramp-adb-handle-file-local-copy (filename)
+ "Like `file-local-copy' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (unless (file-exists-p (file-truename filename))
+ (tramp-error
+ v tramp-file-missing
+ "Cannot make local copy of non-existing file `%s'" filename))
+ (let ((tmpfile (tramp-compat-make-temp-file filename)))
+ (with-tramp-progress-reporter
+ v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
+ ;; "adb pull ..." does not always return an error code.
+ (when (or (tramp-adb-execute-adb-command
+ v "pull" (tramp-compat-file-name-unquote localname) tmpfile)
+ (not (file-exists-p tmpfile)))
+ (ignore-errors (delete-file tmpfile))
+ (tramp-error
+ v 'file-error "Cannot make local copy of file `%s'" filename))
+ (set-file-modes tmpfile (logior (or (file-modes filename) 0) #o0400)))
+ tmpfile)))
+
+(defun tramp-adb-handle-file-writable-p (filename)
+ "Like `file-writable-p' for Tramp files.
+But handle the case, if the \"test\" command is not available."
+ (with-parsed-tramp-file-name filename nil
+ (with-tramp-file-property v localname "file-writable-p"
+ (if (tramp-adb-find-test-command v)
+ (if (file-exists-p filename)
+ (tramp-adb-send-command-and-check
+ v (format "test -w %s" (tramp-shell-quote-argument localname)))
+ (and
+ (file-directory-p (file-name-directory filename))
+ (file-writable-p (file-name-directory filename))))
+
+ ;; Missing "test" command on Android < 4.
+ (let ((rw-path "/data/data"))
+ (tramp-message
+ v 5
+ "Not implemented yet (assuming \"/data/data\" is writable): %s"
+ localname)
+ (and (>= (length localname) (length rw-path))
+ (string= (substring localname 0 (length rw-path))
+ rw-path)))))))
+
+(defun tramp-adb-handle-write-region
+ (start end filename &optional append visit lockname mustbenew)
+ "Like `write-region' for Tramp files."
+ (setq filename (expand-file-name filename))
+ (with-parsed-tramp-file-name filename nil
+ (when (and mustbenew (file-exists-p filename)
+ (or (eq mustbenew 'excl)
+ (not
+ (y-or-n-p
+ (format "File %s exists; overwrite anyway? " filename)))))
+ (tramp-error v 'file-already-exists filename))
+
+ ;; We must also flush the cache of the directory, because
+ ;; `file-attributes' reads the values from there.
+ (tramp-flush-file-properties v (file-name-directory localname))
+ (tramp-flush-file-properties v localname)
+ (let* ((curbuf (current-buffer))
+ (tmpfile (tramp-compat-make-temp-file filename)))
+ (when (and append (file-exists-p filename))
+ (copy-file filename tmpfile 'ok)
+ (set-file-modes tmpfile (logior (or (file-modes tmpfile) 0) #o0600)))
+ (tramp-run-real-handler
+ #'write-region (list start end tmpfile append 'no-message lockname))
+ (with-tramp-progress-reporter
+ v 3 (format-message
+ "Moving tmp file `%s' to `%s'" tmpfile filename)
+ (unwind-protect
+ (when (tramp-adb-execute-adb-command
+ v "push" tmpfile (tramp-compat-file-name-unquote localname))
+ (tramp-error v 'file-error "Cannot write: `%s'" filename))
+ (delete-file tmpfile)))
+
+ (unless (equal curbuf (current-buffer))
+ (tramp-error
+ v 'file-error
+ "Buffer has changed from `%s' to `%s'" curbuf (current-buffer)))
+
+ ;; Set file modification time.
+ (when (or (eq visit t) (stringp visit))
+ (set-visited-file-modtime
+ (tramp-compat-file-attribute-modification-time
+ (file-attributes filename))))
+
+ ;; The end.
+ (when (and (null noninteractive)
+ (or (eq visit t) (null visit) (stringp visit)))
+ (tramp-message v 0 "Wrote %s" filename))
+ (run-hooks 'tramp-handle-write-region-hook))))
+
+(defun tramp-adb-handle-set-file-modes (filename mode)
+ "Like `set-file-modes' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (tramp-flush-file-properties v (file-name-directory localname))
+ (tramp-flush-file-properties v localname)
+ (tramp-adb-send-command-and-check v (format "chmod %o %s" mode
localname))))
+
+(defun tramp-adb-handle-set-file-times (filename &optional time)
+ "Like `set-file-times' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (tramp-flush-file-properties v (file-name-directory localname))
+ (tramp-flush-file-properties v localname)
+ (let ((time (if (or (null time)
+ (tramp-compat-time-equal-p time tramp-time-doesnt-exist)
+ (tramp-compat-time-equal-p time tramp-time-dont-know))
+ (current-time)
+ time))
+ (quoted-name (tramp-shell-quote-argument localname)))
+ ;; Older versions of toybox 'touch' mishandle nanoseconds and/or
+ ;; trailing "Z", so fall back on plain seconds if nanoseconds+Z
+ ;; fails. Also, fall back on old POSIX 'touch -t' if 'touch -d'
+ ;; (introduced in POSIX.1-2008) fails.
+ (tramp-adb-send-command-and-check
+ v (format (concat "touch -d %s %s 2>/dev/null || "
+ "touch -d %s %s 2>/dev/null || "
+ "touch -t %s %s")
+ (format-time-string "%Y-%m-%dT%H:%M:%S.%NZ" time t)
+ quoted-name
+ (format-time-string "%Y-%m-%dT%H:%M:%S" time t)
+ quoted-name
+ (format-time-string "%Y%m%d%H%M.%S" time t)
+ quoted-name)))))
+
+(defun tramp-adb-handle-copy-file
+ (filename newname &optional ok-if-already-exists keep-date
+ _preserve-uid-gid _preserve-extended-attributes)
+ "Like `copy-file' for Tramp files.
+PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
+ (setq filename (expand-file-name filename)
+ newname (expand-file-name newname))
+
+ (if (file-directory-p filename)
+ (copy-directory filename newname keep-date t)
+
+ (let ((t1 (tramp-tramp-file-p filename))
+ (t2 (tramp-tramp-file-p newname)))
+ (with-parsed-tramp-file-name (if t1 filename newname) nil
+ (with-tramp-progress-reporter
+ v 0 (format "Copying %s to %s" filename newname)
+
+ (if (and t1 t2 (tramp-equal-remote filename newname))
+ (let ((l1 (tramp-compat-file-local-name filename))
+ (l2 (tramp-compat-file-local-name newname)))
+ (when (and (not ok-if-already-exists)
+ (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+ ;; We must also flush the cache of the directory,
+ ;; because `file-attributes' reads the values from
+ ;; there.
+ (tramp-flush-file-properties v (file-name-directory l2))
+ (tramp-flush-file-properties v l2)
+ ;; Short track.
+ (tramp-adb-barf-unless-okay
+ v (format
+ "cp -f %s %s"
+ (tramp-shell-quote-argument l1)
+ (tramp-shell-quote-argument l2))
+ "Error copying %s to %s" filename newname))
+
+ (let ((tmpfile (file-local-copy filename)))
+
+ (if tmpfile
+ ;; Remote filename.
+ (condition-case err
+ (rename-file tmpfile newname ok-if-already-exists)
+ ((error quit)
+ (delete-file tmpfile)
+ (signal (car err) (cdr err))))
+
+ ;; Remote newname.
+ (when (and (file-directory-p newname)
+ (tramp-compat-directory-name-p newname))
+ (setq newname
+ (expand-file-name
+ (file-name-nondirectory filename) newname)))
+
+ (with-parsed-tramp-file-name newname nil
+ (when (and (not ok-if-already-exists)
+ (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+
+ ;; We must also flush the cache of the directory,
+ ;; because `file-attributes' reads the values from
+ ;; there.
+ (tramp-flush-file-properties
+ v (file-name-directory localname))
+ (tramp-flush-file-properties v localname)
+ (when (tramp-adb-execute-adb-command
+ v "push"
+ (tramp-compat-file-name-unquote filename)
+ (tramp-compat-file-name-unquote localname))
+ (tramp-error
+ v 'file-error
+ "Cannot copy `%s' `%s'" filename newname)))))))))
+
+ ;; KEEP-DATE handling.
+ (when keep-date
+ (set-file-times
+ newname
+ (tramp-compat-file-attribute-modification-time
+ (file-attributes filename))))))
+
+(defun tramp-adb-handle-rename-file
+ (filename newname &optional ok-if-already-exists)
+ "Like `rename-file' for Tramp files."
+ (setq filename (expand-file-name filename)
+ newname (expand-file-name newname))
+
+ (if (file-directory-p filename)
+ (progn
+ (copy-directory filename newname t t)
+ (delete-directory filename 'recursive))
+
+ (let ((t1 (tramp-tramp-file-p filename))
+ (t2 (tramp-tramp-file-p newname)))
+ (with-parsed-tramp-file-name (if t1 filename newname) nil
+ (with-tramp-progress-reporter
+ v 0 (format "Renaming %s to %s" filename newname)
+
+ (if (and t1 t2
+ (tramp-equal-remote filename newname)
+ (not (file-directory-p filename)))
+ (let ((l1 (tramp-compat-file-local-name filename))
+ (l2 (tramp-compat-file-local-name newname)))
+ (when (and (not ok-if-already-exists)
+ (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+ ;; We must also flush the cache of the directory, because
+ ;; `file-attributes' reads the values from there.
+ (tramp-flush-file-properties v (file-name-directory l1))
+ (tramp-flush-file-properties v l1)
+ (tramp-flush-file-properties v (file-name-directory l2))
+ (tramp-flush-file-properties v l2)
+ ;; Short track.
+ (tramp-adb-barf-unless-okay
+ v (format
+ "mv -f %s %s"
+ (tramp-shell-quote-argument l1)
+ (tramp-shell-quote-argument l2))
+ "Error renaming %s to %s" filename newname))
+
+ ;; Rename by copy.
+ (copy-file
+ filename newname ok-if-already-exists 'keep-time 'preserve-uid-gid)
+ (delete-file filename)))))))
+
+(defun tramp-adb-handle-process-file
+ (program &optional infile destination display &rest args)
+ "Like `process-file' for Tramp files."
+ ;; The implementation is not complete yet.
+ (when (and (numberp destination) (zerop destination))
+ (error "Implementation does not handle immediate return"))
+
+ (with-parsed-tramp-file-name default-directory nil
+ (let (command input tmpinput stderr tmpstderr outbuf ret)
+ ;; Compute command.
+ (setq command (mapconcat #'tramp-shell-quote-argument
+ (cons program args) " "))
+ ;; Determine input.
+ (if (null infile)
+ (setq input "/dev/null")
+ (setq infile (expand-file-name infile))
+ (if (tramp-equal-remote default-directory infile)
+ ;; INFILE is on the same remote host.
+ (setq input (with-parsed-tramp-file-name infile nil localname))
+ ;; INFILE must be copied to remote host.
+ (setq input (tramp-make-tramp-temp-file v)
+ tmpinput (tramp-make-tramp-file-name v input))
+ (copy-file infile tmpinput t)))
+ (when input (setq command (format "%s <%s" command input)))
+
+ ;; Determine output.
+ (cond
+ ;; Just a buffer.
+ ((bufferp destination)
+ (setq outbuf destination))
+ ;; A buffer name.
+ ((stringp destination)
+ (setq outbuf (get-buffer-create destination)))
+ ;; (REAL-DESTINATION ERROR-DESTINATION)
+ ((consp destination)
+ ;; output.
+ (cond
+ ((bufferp (car destination))
+ (setq outbuf (car destination)))
+ ((stringp (car destination))
+ (setq outbuf (get-buffer-create (car destination))))
+ ((car destination)
+ (setq outbuf (current-buffer))))
+ ;; stderr.
+ (cond
+ ((stringp (cadr destination))
+ (setcar (cdr destination) (expand-file-name (cadr destination)))
+ (if (tramp-equal-remote default-directory (cadr destination))
+ ;; stderr is on the same remote host.
+ (setq stderr (with-parsed-tramp-file-name
+ (cadr destination) nil localname))
+ ;; stderr must be copied to remote host. The temporary
+ ;; file must be deleted after execution.
+ (setq stderr (tramp-make-tramp-temp-file v)
+ tmpstderr (tramp-make-tramp-file-name v stderr))))
+ ;; stderr to be discarded.
+ ((null (cadr destination))
+ (setq stderr "/dev/null"))))
+ ;; 't
+ (destination
+ (setq outbuf (current-buffer))))
+ (when stderr (setq command (format "%s 2>%s" command stderr)))
+
+ ;; Send the command. It might not return in time, so we protect
+ ;; it. Call it in a subshell, in order to preserve working
+ ;; directory.
+ (condition-case nil
+ (progn
+ (setq ret
+ (if (tramp-adb-send-command-and-check
+ v
+ (format "(cd %s; %s)"
+ (tramp-shell-quote-argument localname) command))
+ ;; Set return status accordingly.
+ 0 1))
+ ;; We should add the output anyway.
+ (when outbuf
+ (with-current-buffer outbuf
+ (insert-buffer-substring (tramp-get-connection-buffer v)))
+ (when (and display (get-buffer-window outbuf t)) (redisplay))))
+ ;; When the user did interrupt, we should do it also. We use
+ ;; return code -1 as marker.
+ (quit
+ (kill-buffer (tramp-get-connection-buffer v))
+ (setq ret -1))
+ ;; Handle errors.
+ (error
+ (kill-buffer (tramp-get-connection-buffer v))
+ (setq ret 1)))
+
+ ;; Provide error file.
+ (when tmpstderr (rename-file tmpstderr (cadr destination) t))
+
+ ;; Cleanup. We remove all file cache values for the connection,
+ ;; because the remote process could have changed them.
+ (when tmpinput (delete-file tmpinput))
+
+ (unless process-file-side-effects
+ (tramp-flush-directory-properties v ""))
+
+ ;; Return exit status.
+ (if (equal ret -1)
+ (keyboard-quit)
+ ret))))
+
+;; We use BUFFER also as connection buffer during setup. Because of
+;; this, its original contents must be saved, and restored once
+;; connection has been setup.
+(defun tramp-adb-handle-make-process (&rest args)
+ "Like `make-process' for Tramp files."
+ (when args
+ (with-parsed-tramp-file-name (expand-file-name default-directory) nil
+ (let ((name (plist-get args :name))
+ (buffer (plist-get args :buffer))
+ (command (plist-get args :command))
+ (coding (plist-get args :coding))
+ (noquery (plist-get args :noquery))
+ (connection-type (plist-get args :connection-type))
+ (filter (plist-get args :filter))
+ (sentinel (plist-get args :sentinel))
+ (stderr (plist-get args :stderr)))
+ (unless (stringp name)
+ (signal 'wrong-type-argument (list #'stringp name)))
+ (unless (or (null buffer) (bufferp buffer) (stringp buffer))
+ (signal 'wrong-type-argument (list #'stringp buffer)))
+ (unless (consp command)
+ (signal 'wrong-type-argument (list #'consp command)))
+ (unless (or (null coding)
+ (and (symbolp coding) (memq coding coding-system-list))
+ (and (consp coding)
+ (memq (car coding) coding-system-list)
+ (memq (cdr coding) coding-system-list)))
+ (signal 'wrong-type-argument (list #'symbolp coding)))
+ (unless (or (null connection-type) (memq connection-type '(pipe pty)))
+ (signal 'wrong-type-argument (list #'symbolp connection-type)))
+ (unless (or (null filter) (functionp filter))
+ (signal 'wrong-type-argument (list #'functionp filter)))
+ (unless (or (null sentinel) (functionp sentinel))
+ (signal 'wrong-type-argument (list #'functionp sentinel)))
+ (unless (or (null stderr) (bufferp stderr) (stringp stderr))
+ (signal 'wrong-type-argument (list #'stringp stderr)))
+
+ (let* ((buffer
+ (if buffer
+ (get-buffer-create buffer)
+ ;; BUFFER can be nil. We use a temporary buffer.
+ (generate-new-buffer tramp-temp-buffer-name)))
+ (program (car command))
+ (args (cdr command))
+ (command
+ (format "cd %s && exec %s"
+ (tramp-shell-quote-argument localname)
+ (mapconcat #'tramp-shell-quote-argument
+ (cons program args) " ")))
+ (tramp-process-connection-type
+ (or (null program) tramp-process-connection-type))
+ (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
+ (name1 name)
+ (i 0))
+
+ (while (get-process name1)
+ ;; NAME must be unique as process name.
+ (setq i (1+ i)
+ name1 (format "%s<%d>" name i)))
+ (setq name name1)
+ ;; Set the new process properties.
+ (tramp-set-connection-property v "process-name" name)
+ (tramp-set-connection-property v "process-buffer" buffer)
+
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (unwind-protect
+ ;; We catch this event. Otherwise, `make-process'
+ ;; could be called on the local host.
+ (save-excursion
+ (save-restriction
+ ;; Activate narrowing in order to save BUFFER
+ ;; contents. Clear also the modification time;
+ ;; otherwise we might be interrupted by
+ ;; `verify-visited-file-modtime'.
+ (let ((buffer-undo-list t)
+ (inhibit-read-only t))
+ (clear-visited-file-modtime)
+ (narrow-to-region (point-max) (point-max))
+ ;; We call `tramp-adb-maybe-open-connection', in
+ ;; order to cleanup the prompt afterwards.
+ (tramp-adb-maybe-open-connection v)
+ (delete-region (point-min) (point-max))
+ ;; Send the command.
+ (let* ((p (tramp-get-connection-process v)))
+ (tramp-adb-send-command v command nil t) ; nooutput
+ ;; Set sentinel and filter.
+ (when sentinel
+ (set-process-sentinel p sentinel))
+ (when filter
+ (set-process-filter p filter))
+ ;; Set query flag and process marker for this
+ ;; process. We ignore errors, because the
+ ;; process could have finished already.
+ (ignore-errors
+ (set-process-query-on-exit-flag p (null noquery))
+ (set-marker (process-mark p) (point)))
+ ;; Read initial output. Remove the first line,
+ ;; which is the command echo.
+ (while
+ (progn
+ (goto-char (point-min))
+ (not (re-search-forward "[\n]" nil t)))
+ (tramp-accept-process-output p 0))
+ (delete-region (point-min) (point))
+ ;; Return process.
+ p))))
+
+ ;; Save exit.
+ (if (string-match-p tramp-temp-buffer-name (buffer-name))
+ (ignore-errors
+ (set-process-buffer (tramp-get-connection-process v) nil)
+ (kill-buffer (current-buffer)))
+ (set-buffer-modified-p bmp))
+ (tramp-flush-connection-property v "process-name")
+ (tramp-flush-connection-property v "process-buffer"))))))))
+
+(defun tramp-adb-handle-exec-path ()
+ "Like `exec-path' for Tramp files."
+ (append
+ (with-parsed-tramp-file-name default-directory nil
+ (with-tramp-connection-property v "remote-path"
+ (tramp-adb-send-command v "echo \\\"$PATH\\\"")
+ (split-string
+ (with-current-buffer (tramp-get-connection-buffer v)
+ ;; Read the expression.
+ (goto-char (point-min))
+ (read (current-buffer)))
+ ":" 'omit)))
+ ;; The equivalent to `exec-directory'.
+ `(,(tramp-compat-file-local-name default-directory))))
+
+(defun tramp-adb-get-device (vec)
+ "Return full host name from VEC to be used in shell execution.
+E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\"
+ a host name \"R38273882DE\" returns \"R38273882DE\"."
+ ;; Sometimes this is called before there is a connection process
+ ;; yet. In order to work with the connection cache, we flush all
+ ;; unwanted entries first.
+ (tramp-flush-connection-properties nil)
+ (with-tramp-connection-property (tramp-get-connection-process vec) "device"
+ (let* ((host (tramp-file-name-host vec))
+ (port (tramp-file-name-port-or-default vec))
+ (devices (mapcar #'cadr (tramp-adb-parse-device-names nil))))
+ (replace-regexp-in-string
+ tramp-prefix-port-format ":"
+ (cond ((member host devices) host)
+ ;; This is the case when the host is connected to the default port.
+ ((member (format "%s%s%d" host tramp-prefix-port-format port)
+ devices)
+ (format "%s:%d" host port))
+ ;; An empty host name shall be mapped as well, when there
+ ;; is exactly one entry in `devices'.
+ ((and (zerop (length host)) (= (length devices) 1))
+ (car devices))
+ ;; Try to connect device.
+ ((and tramp-adb-connect-if-not-connected
+ (not (zerop (length host)))
+ (not (tramp-adb-execute-adb-command
+ vec "connect"
+ (replace-regexp-in-string
+ tramp-prefix-port-format ":" host))))
+ ;; When new device connected, running other adb command (e.g.
+ ;; adb shell) immediately will fail. To get around this
+ ;; problem, add sleep 0.1 second here.
+ (sleep-for 0.1)
+ host)
+ (t (tramp-error
+ vec 'file-error "Could not find device %s" host)))))))
+
+(defun tramp-adb-execute-adb-command (vec &rest args)
+ "Returns nil on success error-output on failure."
+ (when (and (> (length (tramp-file-name-host vec)) 0)
+ ;; The -s switch is only available for ADB device commands.
+ (not (member (car args) '("connect" "disconnect"))))
+ (setq args (append (list "-s" (tramp-adb-get-device vec)) args)))
+ (with-temp-buffer
+ (prog1
+ (unless
+ (zerop
+ (apply #'tramp-call-process vec tramp-adb-program nil t nil args))
+ (buffer-string))
+ (tramp-message vec 6 "%s" (buffer-string)))))
+
+(defun tramp-adb-find-test-command (vec)
+ "Checks, whether the ash has a builtin \"test\" command.
+This happens for Android >= 4.0."
+ (with-tramp-connection-property vec "test"
+ (tramp-adb-send-command-and-check vec "type test")))
+
+;; Connection functions
+
+(defun tramp-adb-send-command (vec command &optional neveropen nooutput)
+ "Send the COMMAND to connection VEC."
+ (unless neveropen (tramp-adb-maybe-open-connection vec))
+ (tramp-message vec 6 "%s" command)
+ (tramp-send-string vec command)
+ (unless nooutput
+ ;; FIXME: Race condition.
+ (tramp-adb-wait-for-output (tramp-get-connection-process vec))
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (save-excursion
+ (goto-char (point-min))
+ ;; We can't use stty to disable echo of command. stty is said
+ ;; to be added to toybox 0.7.6. busybox shall have it, but this
+ ;; isn't used any longer for Android.
+ (delete-matching-lines (regexp-quote command))
+ ;; When the local machine is W32, there are still trailing ^M.
+ ;; There must be a better solution by setting the correct coding
+ ;; system, but this requires changes in core Tramp.
+ (goto-char (point-min))
+ (while (re-search-forward "\r+$" nil t)
+ (replace-match "" nil nil))))))
+
+(defun tramp-adb-send-command-and-check (vec command)
+ "Run COMMAND and check its exit status.
+Sends `echo $?' along with the COMMAND for checking the exit
+status. If COMMAND is nil, just sends `echo $?'. Returns nil if
+the exit status is not equal 0, and t otherwise."
+ (tramp-adb-send-command
+ vec (if command
+ (format "%s; echo tramp_exit_status $?" command)
+ "echo tramp_exit_status $?"))
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (goto-char (point-max))
+ (unless (re-search-backward "tramp_exit_status [0-9]+" nil t)
+ (tramp-error
+ vec 'file-error "Couldn't find exit status of `%s'" command))
+ (skip-chars-forward "^ ")
+ (prog1
+ (zerop (read (current-buffer)))
+ (let ((inhibit-read-only t))
+ (delete-region (match-beginning 0) (point-max))))))
+
+(defun tramp-adb-barf-unless-okay (vec command fmt &rest args)
+ "Run COMMAND, check exit status, throw error if exit status not okay.
+FMT and ARGS are passed to `error'."
+ (unless (tramp-adb-send-command-and-check vec command)
+ (apply #'tramp-error vec 'file-error fmt args)))
+
+(defun tramp-adb-wait-for-output (proc &optional timeout)
+ "Wait for output from remote command."
+ (unless (buffer-live-p (process-buffer proc))
+ (delete-process proc)
+ (tramp-error proc 'file-error "Process `%s' not available, try again"
proc))
+ (let ((prompt (tramp-get-connection-property proc "prompt"
tramp-adb-prompt)))
+ (with-current-buffer (process-buffer proc)
+ (if (tramp-wait-for-regexp proc timeout prompt)
+ (let ((inhibit-read-only t))
+ (goto-char (point-min))
+ ;; ADB terminal sends "^H" sequences.
+ (when (re-search-forward "<\b+" (point-at-eol) t)
+ (forward-line 1)
+ (delete-region (point-min) (point)))
+ ;; Delete the prompt.
+ (goto-char (point-min))
+ (when (re-search-forward prompt (point-at-eol) t)
+ (forward-line 1)
+ (delete-region (point-min) (point)))
+ (goto-char (point-max))
+ (re-search-backward prompt nil t)
+ (delete-region (point) (point-max)))
+ (if timeout
+ (tramp-error
+ proc 'file-error
+ "[[Remote prompt `%s' not found in %d secs]]" prompt timeout)
+ (tramp-error
+ proc 'file-error "[[Remote prompt `%s' not found]]" prompt))))))
+
+(defun tramp-adb-maybe-open-connection (vec)
+ "Maybe open a connection VEC.
+Does not do anything if a connection is already open, but re-opens the
+connection if a previous connection has died for some reason."
+ (let* ((buf (tramp-get-connection-buffer vec))
+ (p (get-buffer-process buf))
+ (host (tramp-file-name-host vec))
+ (user (tramp-file-name-user vec))
+ (device (tramp-adb-get-device vec)))
+
+ ;; Maybe we know already that "su" is not supported. We cannot
+ ;; use a connection property, because we have not checked yet
+ ;; whether it is still the same device.
+ (when (and user (not (tramp-get-file-property vec "" "su-command-p" t)))
+ (tramp-error vec 'file-error "Cannot switch to user `%s'" user))
+
+ (unless (process-live-p p)
+ ;; During completion, don't reopen a new connection. We check
+ ;; this for the process related to `tramp-buffer-name';
+ ;; otherwise `start-file-process' wouldn't run ever when
+ ;; `non-essential' is non-nil.
+ (when (and (tramp-completion-mode-p)
+ (null (get-process (tramp-buffer-name vec))))
+ (throw 'non-essential 'non-essential))
+
+ (save-match-data
+ (when (and p (processp p)) (delete-process p))
+ (if (zerop (length device))
+ (tramp-error vec 'file-error "Device %s not connected" host))
+ (with-tramp-progress-reporter vec 3 "Opening adb shell connection"
+ (let* ((coding-system-for-read 'utf-8-dos) ;is this correct?
+ (process-connection-type tramp-process-connection-type)
+ (args (if (> (length host) 0)
+ (list "-s" device "shell")
+ (list "shell")))
+ (p (let ((default-directory
+ (tramp-compat-temporary-file-directory)))
+ (apply #'start-process (tramp-get-connection-name vec) buf
+ tramp-adb-program args)))
+ (prompt (md5 (concat (prin1-to-string process-environment)
+ (current-time-string)))))
+ (tramp-message
+ vec 6 "%s" (mapconcat #'identity (process-command p) " "))
+ ;; Wait for initial prompt. On some devices, it needs an
+ ;; initial RET, in order to get it.
+ (sleep-for 0.1)
+ (tramp-send-string vec tramp-rsh-end-of-line)
+ (tramp-adb-wait-for-output p 30)
+ (unless (process-live-p p)
+ (tramp-error vec 'file-error "Terminated!"))
+
+ ;; Set sentinel and query flag. Initialize variables.
+ (set-process-sentinel p #'tramp-process-sentinel)
+ (process-put p 'vector vec)
+ (process-put p 'adjust-window-size-function #'ignore)
+ (set-process-query-on-exit-flag p nil)
+
+ ;; Change prompt.
+ (tramp-set-connection-property
+ p "prompt" (regexp-quote (format "///%s#$" prompt)))
+ (tramp-adb-send-command
+ vec (format "PS1=\"///\"\"%s\"\"#$\"" prompt))
+
+ ;; Check whether the properties have been changed. If
+ ;; yes, this is a strong indication that we must expire all
+ ;; connection properties. We start again.
+ (tramp-message vec 5 "Checking system information")
+ (tramp-adb-send-command
+ vec "echo \\\"`getprop ro.product.model` `getprop
ro.product.version` `getprop ro.build.version.release`\\\"")
+ (let ((old-getprop
+ (tramp-get-connection-property vec "getprop" nil))
+ (new-getprop
+ (tramp-set-connection-property
+ vec "getprop"
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ ;; Read the expression.
+ (goto-char (point-min))
+ (read (current-buffer))))))
+ (when (and (stringp old-getprop)
+ (not (string-equal old-getprop new-getprop)))
+ (tramp-message
+ vec 3
+ "Connection reset, because remote host changed from `%s' to
`%s'"
+ old-getprop new-getprop)
+ (tramp-cleanup-connection vec t)
+ (tramp-adb-maybe-open-connection vec)))
+
+ ;; Change user if indicated.
+ (when user
+ (tramp-adb-send-command vec (format "su %s" user))
+ (unless (tramp-adb-send-command-and-check vec nil)
+ (delete-process p)
+ (tramp-flush-file-property vec "" "su-command-p")
+ (tramp-error
+ vec 'file-error "Cannot switch to user `%s'" user)))
+
+ ;; Set connection-local variables.
+ (tramp-set-connection-local-variables vec)
+
+ ;; Mark it as connected.
+ (tramp-set-connection-property p "connected" t)))))))
+
+;; Default settings for connection-local variables.
+(defconst tramp-adb-connection-local-default-profile
+ '((shell-file-name . "/system/bin/sh")
+ (shell-command-switch . "-c"))
+ "Default connection-local variables for remote adb connections.")
+
+;; `connection-local-set-profile-variables' and
+;; `connection-local-set-profiles' exists since Emacs 26.1.
+(eval-after-load "shell"
+ '(progn
+ (tramp-compat-funcall
+ 'connection-local-set-profile-variables
+ 'tramp-adb-connection-local-default-profile
+ tramp-adb-connection-local-default-profile)
+ (tramp-compat-funcall
+ 'connection-local-set-profiles
+ `(:application tramp :protocol ,tramp-adb-method)
+ 'tramp-adb-connection-local-default-profile)))
+
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (unload-feature 'tramp-adb 'force)))
+
+(provide 'tramp-adb)
+
+;;; tramp-adb.el ends here
diff --git a/tramp-archive.el b/tramp-archive.el
deleted file mode 120000
index 37078b9..0000000
--- a/tramp-archive.el
+++ /dev/null
@@ -1 +0,0 @@
-lisp/tramp-archive.el
\ No newline at end of file
diff --git a/tramp-archive.el b/tramp-archive.el
new file mode 100644
index 0000000..e6ae73a
--- /dev/null
+++ b/tramp-archive.el
@@ -0,0 +1,666 @@
+;;; tramp-archive.el --- Tramp archive manager -*- lexical-binding:t -*-
+
+;; Copyright (C) 2017-2019 Free Software Foundation, Inc.
+
+;; Author: Michael Albinus <address@hidden>
+;; 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
+;; * ".msu", ".MSU" - Microsoft Windows Update packages
+;; * ".mtree" - BSD mtree format
+;; * ".odb" ".odf" ".odg" ".odp" ".ods" ".odt" - OpenDocument formats
+;; * ".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
+;; * ".xpi" - XPInstall Mozilla addons
+;; * ".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:address@hidden:/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:address@hidden:..." performs better than the similar
+;; "/scp:address@hidden:...". 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:
+
+(eval-when-compile (require 'cl-lib))
+;; Sometimes, compilation fails with "Variable binding depth exceeds
+;; max-specpdl-size".
+(eval-and-compile
+ (let ((max-specpdl-size (* 2 max-specpdl-size))) (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)
+
+;; We cannot check `tramp-gvfs-enabled' in loaddefs.el, because this
+;; would load Tramp. So we make a cheaper check.
+;;;###autoload
+(defvar tramp-archive-enabled (featurep 'dbusbind)
+ "Non-nil when file archive support is available.")
+
+;; After loading tramp-gvfs.el, we know it better.
+(setq tramp-archive-enabled tramp-gvfs-enabled)
+
+;; <https://github.com/libarchive/libarchive/wiki/LibarchiveFormats>
+;; Note: "arc" and "zoo" are supported by `archive-mode', but they
+;; don't work here.
+;;;###autoload
+(defconst tramp-archive-suffixes
+ ;; "cab", "lzh", "msu" 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.
+ "msu" "MSU" ;; Microsoft Windows Update packages. Not in testsuite.
+ "mtree" ;; BSD mtree format.
+ "odb" "odf" "odg" "odp" "ods" "odt" ;; OpenDocument formats. Not in
testsuite.
+ "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.
+ "xpi" ;; XPInstall Mozilla addons. 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.
+
+;;;###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).")
+
+;; The definition of `tramp-archive-file-name-regexp' contains calls
+;; to `regexp-opt', which cannot be autoloaded while loading
+;; loaddefs.el. So we use a macro, which is evaluated only when needed.
+;;;###autoload
+(progn (defmacro tramp-archive-autoload-file-name-regexp ()
+ "Regular expression matching archive file names."
+ '(concat
+ "\\`" "\\(" ".+" "\\."
+ ;; Default suffixes ...
+ (regexp-opt tramp-archive-suffixes)
+ ;; ... with compression.
+ "\\(?:" "\\." (regexp-opt tramp-archive-compression-suffixes) "\\)*"
+ "\\)" ;; \1
+ "\\(" "/" ".*" "\\)" "\\'"))) ;; \2
+
+;; In older Emacsen (prior 27.1), `tramp-archive-autoload-file-name-regexp'
+;; is not autoloaded. So we cannot expect it to be known in
+;; tramp-loaddefs.el. But it exists, when tramp-archive.el is loaded.
+;;;###tramp-autoload
+(defconst tramp-archive-file-name-regexp
+ (ignore-errors (tramp-archive-autoload-file-name-regexp))
+ "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 . tramp-archive-handle-access-file)
+ (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-directory . 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)
+ (exec-path . ignore)
+ ;; `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)
+ ;; `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-process . ignore)
+ (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 . tramp-archive-handle-temporary-file-directory)
+ ;; `tramp-set-file-uid-gid' 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 file archive method.
+Operations not mentioned here will be handled by the default Emacs
primitives.")
+
+(defsubst tramp-archive-file-name-for-operation (operation &rest args)
+ "Like `tramp-file-name-for-operation', but for archive file name syntax."
+ (cl-letf (((symbol-function #'tramp-tramp-file-p)
+ #'tramp-archive-file-name-p))
+ (apply #'tramp-file-name-for-operation operation args)))
+
+(defun tramp-archive-run-real-handler (operation args)
+ "Invoke normal file name handler for OPERATION.
+First arg specifies the OPERATION, second arg is a list of arguments to
+pass to the OPERATION."
+ (let* ((inhibit-file-name-handlers
+ `(tramp-archive-file-name-handler
+ .
+ ,(and (eq inhibit-file-name-operation operation)
+ inhibit-file-name-handlers)))
+ (inhibit-file-name-operation operation))
+ (apply operation args)))
+
+;;;###tramp-autoload
+(defun tramp-archive-file-name-handler (operation &rest args)
+ "Invoke the file archive related OPERATION.
+First arg specifies the OPERATION, second arg is a list of arguments to
+pass to the OPERATION."
+ (if (not tramp-archive-enabled)
+ ;; Unregister `tramp-archive-file-name-handler'.
+ (progn
+ (tramp-register-file-name-handlers)
+ (tramp-archive-run-real-handler operation args))
+
+ (let* ((filename (apply #'tramp-archive-file-name-for-operation
+ operation args))
+ (archive (tramp-archive-file-name-archive filename)))
+
+ ;; `filename' could be a quoted file name. Or the file
+ ;; archive could be a directory, see Bug#30293.
+ (if (or (null archive)
+ (tramp-archive-run-real-handler
+ #'file-directory-p (list archive)))
+ (tramp-archive-run-real-handler operation args)
+ ;; Now run the handler.
+ (let ((tramp-methods (cons `(,tramp-archive-method) tramp-methods))
+ (tramp-gvfs-methods tramp-archive-all-gvfs-methods)
+ ;; Set uid and gid. gvfsd-archive could do it, but it doesn't.
+ (tramp-unknown-id-integer (user-uid))
+ (tramp-unknown-id-string (user-login-name))
+ (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-archive-run-real-handler operation args)))))))
+
+;;;###autoload
+(defalias
+ 'tramp-archive-autoload-file-name-handler #'tramp-autoload-file-name-handler)
+
+;;;###autoload
+(progn (defun tramp-register-archive-file-name-handler ()
+ "Add archive file name handler to `file-name-handler-alist'."
+ (when tramp-archive-enabled
+ (add-to-list 'file-name-handler-alist
+ (cons (tramp-archive-autoload-file-name-regexp)
+ #'tramp-archive-autoload-file-name-handler))
+ (put 'tramp-archive-autoload-file-name-handler 'safe-magic t))))
+
+;;;###autoload
+(progn
+ (add-hook 'after-init-hook #'tramp-register-archive-file-name-handler)
+ (add-hook
+ 'tramp-archive-unload-hook
+ (lambda ()
+ (remove-hook
+ 'after-init-hook #'tramp-register-archive-file-name-handler))))
+
+;; In older Emacsen (prior 27.1), the autoload above does not exist.
+;; So we call it again; it doesn't hurt.
+(tramp-register-archive-file-name-handler)
+
+;; 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)))))
+
+
+;; 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)
+ ;; `tramp-archive-file-name-regexp' does not suppress quoted file names.
+ (not (tramp-compat-file-name-quoted-p name t))
+ ;; We cannot use `string-match-p', the matches are used.
+ (string-match tramp-archive-file-name-regexp name)
+ t))
+
+(defun tramp-archive-file-name-archive (name)
+ "Return archive part of NAME."
+ (and (tramp-archive-file-name-p name)
+ (match-string 1 name)))
+
+(defun tramp-archive-file-name-localname (name)
+ "Return localname part of NAME."
+ (and (tramp-archive-file-name-p name)
+ (match-string 2 name)))
+
+(defvar tramp-archive-hash (make-hash-table :test 'equal)
+ "Hash table for archive local copies.
+The hash key is the archive name. The value is a cons of the
+used `tramp-file-name' structure for tramp-gvfs, and the file
+name of a local copy, if any.")
+
+(defsubst tramp-archive-gvfs-host (archive)
+ "Return host name of ARCHIVE as used in GVFS for mounting"
+ (url-hexify-string (tramp-gvfs-url-file-name archive)))
+
+(defun tramp-archive-dissect-file-name (name)
+ "Return a `tramp-file-name' structure.
+The structure consists of the `tramp-archive-method' method, the
+hexified 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-user-error nil "Not an archive file name: \"%s\"" name))
+ (let* ((localname (tramp-archive-file-name-localname name))
+ (archive (file-truename (tramp-archive-file-name-archive name)))
+ (vec (make-tramp-file-name
+ :method tramp-archive-method :hop archive)))
+
+ (cond
+ ;; The value is already in the hash table.
+ ((gethash archive tramp-archive-hash)
+ (setq vec (car (gethash archive tramp-archive-hash))))
+
+ ;; 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)))
+ (setf (tramp-file-name-host vec) (tramp-archive-gvfs-host archive)))
+ (puthash archive (list vec) tramp-archive-hash))
+
+ ;; http://...
+ ((and url-handler-mode
+ tramp-compat-use-url-tramp-p
+ (string-match-p url-handler-regexp archive)
+ (string-match-p
+ "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)))
+ (setf (tramp-file-name-host vec) (tramp-archive-gvfs-host archive)))
+ (puthash archive (list vec) tramp-archive-hash))
+
+ ;; GVFS supported schemes.
+ ((or (tramp-gvfs-file-name-p archive)
+ (not (file-remote-p archive)))
+ (setf (tramp-file-name-host vec) (tramp-archive-gvfs-host archive))
+ (puthash archive (list vec) tramp-archive-hash))
+
+ ;; 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))
+ (copy (file-local-copy archive)))
+ (setf (tramp-file-name-host vec) (tramp-archive-gvfs-host copy))
+ (puthash archive (cons vec copy) tramp-archive-hash))))
+
+ ;; So far, `vec' handles just the mount point. Add `localname',
+ ;; which shouldn't be pushed to the hash.
+ (setf (tramp-file-name-localname vec) localname)
+ vec)))
+
+(defun tramp-archive-cleanup-hash ()
+ "Remove local copies of archives, used by GVFS."
+ (maphash
+ (lambda (key value)
+ ;; Unmount local copy.
+ (ignore-errors
+ (tramp-message (car value) 3 "Unmounting %s" (or (cdr value) key))
+ (tramp-gvfs-unmount (car value)))
+ ;; Delete local copy.
+ (ignore-errors (delete-file (cdr value)))
+ (remhash key tramp-archive-hash))
+ tramp-archive-hash)
+ (clrhash tramp-archive-hash))
+
+(add-hook 'tramp-cleanup-all-connections-hook #'tramp-archive-cleanup-hash)
+(add-hook 'kill-emacs-hook #'tramp-archive-cleanup-hash)
+(add-hook 'tramp-archive-unload-hook
+ (lambda ()
+ (remove-hook 'tramp-cleanup-all-connections-hook
+ #'tramp-archive-cleanup-hash)
+ (remove-hook 'kill-emacs-hook
+ #'tramp-archive-cleanup-hash)))
+
+(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-access-file (filename string)
+ "Like `access-file' for Tramp files."
+ (access-file (tramp-archive-gvfs-file-name filename) string))
+
+(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."
+ (file-readable-p (tramp-archive-gvfs-file-name filename)))
+
+(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-temporary-file-directory ()
+ "Like `temporary-file-directory' for file archives."
+ ;; If the default directory, the file archive, is located on a
+ ;; mounted directory, it is returned as it. Not what we want.
+ (with-parsed-tramp-archive-file-name default-directory nil
+ (let ((default-directory (file-name-directory archive)))
+ (tramp-compat-temporary-file-directory))))
+
+(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-archive-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:
+
+;; * Check, whether we could retrieve better file attributes like uid,
+;; gid, permissions. See gvfsbackendarchive.c
+;; (archive_file_set_info_from_entry), where it is commented out.
+;;
+;; * Implement write access, when possible.
+;; https://bugzilla.gnome.org/show_bug.cgi?id=589617
+
+;;; tramp-archive.el ends here
diff --git a/tramp-cache.el b/tramp-cache.el
deleted file mode 120000
index 89d2527..0000000
--- a/tramp-cache.el
+++ /dev/null
@@ -1 +0,0 @@
-lisp/tramp-cache.el
\ No newline at end of file
diff --git a/tramp-cache.el b/tramp-cache.el
new file mode 100644
index 0000000..a9ff3a7
--- /dev/null
+++ b/tramp-cache.el
@@ -0,0 +1,526 @@
+;;; tramp-cache.el --- file information caching for Tramp -*-
lexical-binding:t -*-
+
+;; Copyright (C) 2000, 2005-2019 Free Software Foundation, Inc.
+
+;; Author: Daniel Pittman <address@hidden>
+;; Michael Albinus <address@hidden>
+;; Maintainer: Michael Albinus <address@hidden>
+;; 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:
+
+;; An implementation of information caching for remote files.
+
+;; Each connection, identified by a `tramp-file-name' structure or by
+;; a process, has a unique cache. We distinguish 4 kind of caches,
+;; depending on the key:
+;;
+;; - localname is NIL. This are reusable properties. Examples:
+;; "remote-shell" identifies the POSIX shell to be called on the
+;; remote host, or "perl" is the command to be called on the remote
+;; host when starting a Perl script. These properties are saved in
+;; the file `tramp-persistency-file-name'.
+;;
+;; - localname is a string. This are temporary properties, which are
+;; related to the file localname is referring to. Examples:
+;; "file-exists-p" is t or nil, depending on the file existence, or
+;; "file-attributes" caches the result of the function
+;; `file-attributes'. These entries have a timestamp, and they
+;; expire after `remote-file-name-inhibit-cache' seconds if this
+;; variable is set.
+;;
+;; - The key is a process. This are temporary properties related to
+;; an open connection. Examples: "scripts" keeps shell script
+;; definitions already sent to the remote shell, "last-cmd-time" is
+;; the time stamp a command has been sent to the remote process.
+;;
+;; - The key is nil. This are temporary properties related to the
+;; local machine. Examples: "parse-passwd" and "parse-group" keep
+;; the results of parsing "/etc/passwd" and "/etc/group",
+;; "{uid,gid}-{integer,string}" are the local uid and gid, and
+;; "locale" is the used shell locale.
+
+;; Some properties are handled special:
+;;
+;; - "process-name", "process-buffer" and "first-password-request" are
+;; not saved in the file `tramp-persistency-file-name'.
+
+;;; Code:
+
+(require 'tramp)
+(autoload 'time-stamp-string "time-stamp")
+
+;;; -- Cache --
+
+;;;###tramp-autoload
+(defvar tramp-cache-data (make-hash-table :test #'equal)
+ "Hash table for remote files properties.")
+
+;;;###tramp-autoload
+(defcustom tramp-connection-properties nil
+ "List of static connection properties.
+Every entry has the form (REGEXP PROPERTY VALUE). The regexp
+matches remote file names. It can be nil. PROPERTY is a string,
+and VALUE the corresponding value. They are used, if there is no
+matching entry for PROPERTY in `tramp-cache-data'. For more
+details see the info pages."
+ :group 'tramp
+ :version "24.4"
+ :type '(repeat (list (choice :tag "File Name regexp" regexp (const nil))
+ (choice :tag " Property" string)
+ (choice :tag " Value" sexp))))
+
+(defcustom tramp-persistency-file-name
+ (expand-file-name (locate-user-emacs-file "tramp"))
+ "File which keeps connection history for Tramp connections."
+ :group 'tramp
+ :type 'file)
+
+(defvar tramp-cache-data-changed nil
+ "Whether persistent cache data have been changed.")
+
+(defun tramp-get-hash-table (key)
+ "Returns the hash table for KEY.
+If it doesn't exist yet, it is created and initialized with
+matching entries of `tramp-connection-properties'."
+ (or (gethash key tramp-cache-data)
+ (let ((hash
+ (puthash key (make-hash-table :test #'equal) tramp-cache-data)))
+ (when (tramp-file-name-p key)
+ (dolist (elt tramp-connection-properties)
+ (when (string-match-p
+ (or (nth 0 elt) "")
+ (tramp-make-tramp-file-name key 'noloc 'nohop))
+ (tramp-set-connection-property key (nth 1 elt) (nth 2 elt)))))
+ hash)))
+
+;;;###tramp-autoload
+(defun tramp-get-file-property (key file property default)
+ "Get the PROPERTY of FILE from the cache context of KEY.
+Returns DEFAULT if not set."
+ ;; Unify localname. Remove hop from `tramp-file-name' structure.
+ (setq file (tramp-compat-file-name-unquote file)
+ key (copy-tramp-file-name key))
+ (setf (tramp-file-name-localname key)
+ (tramp-run-real-handler #'directory-file-name (list file))
+ (tramp-file-name-hop key) nil)
+ (let* ((hash (tramp-get-hash-table key))
+ (value (when (hash-table-p hash) (gethash property hash))))
+ (if ;; We take the value only if there is any, and
+ ;; `remote-file-name-inhibit-cache' indicates that it is still
+ ;; valid. Otherwise, DEFAULT is set.
+ (and (consp value)
+ (or (null remote-file-name-inhibit-cache)
+ (and (integerp remote-file-name-inhibit-cache)
+ (time-less-p
+ ;; `current-time' can be nil once we get rid of Emacs 24.
+ (current-time)
+ (time-add
+ (car value)
+ ;; `seconds-to-time' can be removed once we get
+ ;; rid of Emacs 24.
+ (seconds-to-time remote-file-name-inhibit-cache))))
+ (and (consp remote-file-name-inhibit-cache)
+ (time-less-p
+ remote-file-name-inhibit-cache (car value)))))
+ (setq value (cdr value))
+ (setq value default))
+
+ (tramp-message key 8 "%s %s %s" file property value)
+ (when (>= tramp-verbose 10)
+ (let* ((var (intern (concat "tramp-cache-get-count-" property)))
+ (val (or (bound-and-true-p var)
+ (progn
+ (add-hook 'tramp-cache-unload-hook
+ (lambda () (makunbound var)))
+ 0))))
+ (set var (1+ val))))
+ value))
+
+;;;###tramp-autoload
+(defun tramp-set-file-property (key file property value)
+ "Set the PROPERTY of FILE to VALUE, in the cache context of KEY.
+Returns VALUE."
+ ;; Unify localname. Remove hop from `tramp-file-name' structure.
+ (setq file (tramp-compat-file-name-unquote file)
+ key (copy-tramp-file-name key))
+ (setf (tramp-file-name-localname key)
+ (tramp-run-real-handler #'directory-file-name (list file))
+ (tramp-file-name-hop key) nil)
+ (let ((hash (tramp-get-hash-table key)))
+ ;; We put the timestamp there.
+ (puthash property (cons (current-time) value) hash)
+ (tramp-message key 8 "%s %s %s" file property value)
+ (when (>= tramp-verbose 10)
+ (let* ((var (intern (concat "tramp-cache-set-count-" property)))
+ (val (or (bound-and-true-p var)
+ (progn
+ (add-hook 'tramp-cache-unload-hook
+ (lambda () (makunbound var)))
+ 0))))
+ (set var (1+ val))))
+ value))
+
+;;;###tramp-autoload
+(defun tramp-flush-file-property (key file property)
+ "Remove PROPERTY of FILE in the cache context of KEY."
+ ;; Unify localname. Remove hop from `tramp-file-name' structure.
+ (setq file (tramp-compat-file-name-unquote file)
+ key (copy-tramp-file-name key))
+ (setf (tramp-file-name-localname key)
+ (tramp-run-real-handler #'directory-file-name (list file))
+ (tramp-file-name-hop key) nil)
+ (remhash property (tramp-get-hash-table key))
+ (tramp-message key 8 "%s %s" file property)
+ (when (>= tramp-verbose 10)
+ (let ((var (intern (concat "tramp-cache-set-count-" property))))
+ (makunbound var))))
+
+;;;###tramp-autoload
+(defun tramp-flush-file-properties (key file)
+ "Remove all properties of FILE in the cache context of KEY."
+ (let* ((file (tramp-run-real-handler
+ #'directory-file-name (list file)))
+ (truename (tramp-get-file-property key file "file-truename" nil)))
+ ;; Unify localname. Remove hop from `tramp-file-name' structure.
+ (setq file (tramp-compat-file-name-unquote file)
+ key (copy-tramp-file-name key))
+ (setf (tramp-file-name-localname key) file
+ (tramp-file-name-hop key) nil)
+ (tramp-message key 8 "%s" file)
+ (remhash key tramp-cache-data)
+ ;; Remove file properties of symlinks.
+ (when (and (stringp truename)
+ (not (string-equal file (directory-file-name truename))))
+ (tramp-flush-file-properties key truename))))
+
+;;;###tramp-autoload
+(defun tramp-flush-directory-properties (key directory)
+ "Remove all properties of DIRECTORY in the cache context of KEY.
+Remove also properties of all files in subdirectories."
+ (setq directory (tramp-compat-file-name-unquote directory))
+ (let* ((directory (tramp-run-real-handler
+ #'directory-file-name (list directory)))
+ (truename (tramp-get-file-property key directory "file-truename" nil)))
+ (tramp-message key 8 "%s" directory)
+ (maphash
+ (lambda (key _value)
+ (when (and (tramp-file-name-p key)
+ (stringp (tramp-file-name-localname key))
+ (string-match-p (regexp-quote directory)
+ (tramp-file-name-localname key)))
+ (remhash key tramp-cache-data)))
+ tramp-cache-data)
+ ;; Remove file properties of symlinks.
+ (when (and (stringp truename)
+ (not (string-equal directory (directory-file-name truename))))
+ (tramp-flush-directory-properties key truename))))
+
+;; Reverting or killing a buffer should also flush file properties.
+;; They could have been changed outside Tramp. In eshell, "ls" would
+;; not show proper directory contents when a file has been copied or
+;; deleted before. We must apply `save-match-data', because it would
+;; corrupt other packages otherwise (reported from org).
+(defun tramp-flush-file-function ()
+ "Flush all Tramp cache properties from `buffer-file-name'.
+This is suppressed for temporary buffers."
+ (save-match-data
+ (unless (or (null (buffer-name))
+ (string-match-p "^\\( \\|\\*\\)" (buffer-name)))
+ (let ((bfn (if (stringp (buffer-file-name))
+ (buffer-file-name)
+ default-directory))
+ (tramp-verbose 0))
+ (when (tramp-tramp-file-p bfn)
+ (with-parsed-tramp-file-name bfn nil
+ (tramp-flush-file-properties v localname)))))))
+
+(add-hook 'before-revert-hook #'tramp-flush-file-function)
+(add-hook 'eshell-pre-command-hook #'tramp-flush-file-function)
+(add-hook 'kill-buffer-hook #'tramp-flush-file-function)
+(add-hook 'tramp-cache-unload-hook
+ (lambda ()
+ (remove-hook 'before-revert-hook
+ #'tramp-flush-file-function)
+ (remove-hook 'eshell-pre-command-hook
+ #'tramp-flush-file-function)
+ (remove-hook 'kill-buffer-hook
+ #'tramp-flush-file-function)))
+
+;;; -- Properties --
+
+;;;###tramp-autoload
+(defun tramp-get-connection-property (key property default)
+ "Get the named PROPERTY for the connection.
+KEY identifies the connection, it is either a process or a
+`tramp-file-name' structure. A special case is nil, which is
+used to cache connection properties of the local machine. If the
+value is not set for the connection, returns DEFAULT."
+ ;; Unify key by removing localname and hop from `tramp-file-name'
+ ;; structure. Work with a copy in order to avoid side effects.
+ (when (tramp-file-name-p key)
+ (setq key (copy-tramp-file-name key))
+ (setf (tramp-file-name-localname key) nil
+ (tramp-file-name-hop key) nil))
+ (let* ((hash (tramp-get-hash-table key))
+ (value
+ ;; If the key is an auxiliary process object, check whether
+ ;; the process is still alive.
+ (if (and (processp key) (not (process-live-p key)))
+ default
+ (if (hash-table-p hash)
+ (gethash property hash default)
+ default))))
+ (tramp-message key 7 "%s %s" property value)
+ value))
+
+;;;###tramp-autoload
+(defun tramp-set-connection-property (key property value)
+ "Set the named PROPERTY of a connection to VALUE.
+KEY identifies the connection, it is either a process or a
+`tramp-file-name' structure. A special case is nil, which is
+used to cache connection properties of the local machine.
+PROPERTY is set persistent when KEY is a `tramp-file-name' structure."
+ ;; Unify key by removing localname and hop from `tramp-file-name'
+ ;; structure. Work with a copy in order to avoid side effects.
+ (when (tramp-file-name-p key)
+ (setq key (copy-tramp-file-name key))
+ (setf (tramp-file-name-localname key) nil
+ (tramp-file-name-hop key) nil))
+ (let ((hash (tramp-get-hash-table key)))
+ (puthash property value hash)
+ (setq tramp-cache-data-changed t)
+ (tramp-message key 7 "%s %s" property value)
+ value))
+
+;;;###tramp-autoload
+(defun tramp-connection-property-p (key property)
+ "Check whether named PROPERTY of a connection is defined.
+KEY identifies the connection, it is either a process or a
+`tramp-file-name' structure. A special case is nil, which is
+used to cache connection properties of the local machine."
+ (not (eq (tramp-get-connection-property key property 'undef) 'undef)))
+
+;;;###tramp-autoload
+(defun tramp-flush-connection-property (key property)
+ "Remove the named PROPERTY of a connection identified by KEY.
+KEY identifies the connection, it is either a process or a
+`tramp-file-name' structure. A special case is nil, which is
+used to cache connection properties of the local machine.
+PROPERTY is set persistent when KEY is a `tramp-file-name' structure."
+ ;; Unify key by removing localname and hop from `tramp-file-name'
+ ;; structure. Work with a copy in order to avoid side effects.
+ (when (tramp-file-name-p key)
+ (setq key (copy-tramp-file-name key))
+ (setf (tramp-file-name-localname key) nil
+ (tramp-file-name-hop key) nil))
+ (remhash property (tramp-get-hash-table key))
+ (setq tramp-cache-data-changed t)
+ (tramp-message key 7 "%s" property))
+
+;;;###tramp-autoload
+(defun tramp-flush-connection-properties (key)
+ "Remove all properties identified by KEY.
+KEY identifies the connection, it is either a process or a
+`tramp-file-name' structure. A special case is nil, which is
+used to cache connection properties of the local machine."
+ ;; Unify key by removing localname and hop from `tramp-file-name'
+ ;; structure. Work with a copy in order to avoid side effects.
+ (when (tramp-file-name-p key)
+ (setq key (copy-tramp-file-name key))
+ (setf (tramp-file-name-localname key) nil
+ (tramp-file-name-hop key) nil))
+ (tramp-message
+ key 7 "%s %s" key
+ (let ((hash (gethash key tramp-cache-data))
+ properties)
+ (when (hash-table-p hash)
+ (maphash (lambda (x _y) (add-to-list 'properties x 'append)) hash))
+ properties))
+ (setq tramp-cache-data-changed t)
+ (remhash key tramp-cache-data))
+
+;;;###tramp-autoload
+(defun tramp-cache-print (table)
+ "Print hash table TABLE."
+ (when (hash-table-p table)
+ (let (result)
+ (maphash
+ (lambda (key value)
+ ;; Remove text properties from KEY and VALUE.
+ ;; `cl-struct-slot-*' functions exist since Emacs 25 only; we
+ ;; ignore errors.
+ (when (tramp-file-name-p key)
+ ;; (dolist
+ ;; (slot
+ ;; (mapcar #'car (cdr (cl-struct-slot-info 'tramp-file-name))))
+ ;; (when (stringp (cl-struct-slot-value 'tramp-file-name slot key))
+ ;; (setf (cl-struct-slot-value 'tramp-file-name slot key)
+ ;; (substring-no-properties
+ ;; (cl-struct-slot-value 'tramp-file-name slot key))))))
+ (dotimes (i (length key))
+ (when (stringp (elt key i))
+ (setf (elt key i) (substring-no-properties (elt key i))))))
+ (when (stringp key)
+ (setq key (substring-no-properties key)))
+ (when (stringp value)
+ (setq value (substring-no-properties value)))
+ ;; Dump.
+ (let ((tmp (format
+ "(%s %s)"
+ (if (processp key)
+ (prin1-to-string (prin1-to-string key))
+ (prin1-to-string key))
+ (if (hash-table-p value)
+ (tramp-cache-print value)
+ (if (or (bufferp value)
+ ;; Mutexes have entered Emacs 26.1.
+ (tramp-compat-funcall 'mutexp value))
+ (prin1-to-string (prin1-to-string value))
+ (prin1-to-string value))))))
+ (setq result (if result (concat result " " tmp) tmp))))
+ table)
+ result)))
+
+;;;###tramp-autoload
+(defun tramp-list-connections ()
+ "Return all known `tramp-file-name' structs according to `tramp-cache'."
+ (let (result tramp-verbose)
+ (maphash
+ (lambda (key _value)
+ (when (and (tramp-file-name-p key)
+ (null (tramp-file-name-localname key))
+ (tramp-connection-property-p key "process-buffer"))
+ (add-to-list 'result key)))
+ tramp-cache-data)
+ result))
+
+(defun tramp-dump-connection-properties ()
+ "Write persistent connection properties into file
`tramp-persistency-file-name'."
+ ;; We shouldn't fail, otherwise Emacs might not be able to be closed.
+ (ignore-errors
+ (when (and (hash-table-p tramp-cache-data)
+ (not (zerop (hash-table-count tramp-cache-data)))
+ tramp-cache-data-changed
+ (stringp tramp-persistency-file-name))
+ (let ((cache (copy-hash-table tramp-cache-data))
+ print-length print-level)
+ ;; Remove temporary data. If there is the key "login-as", we
+ ;; don't save either, because all other properties might
+ ;; depend on the login name, and we want to give the
+ ;; possibility to use another login name later on. Key
+ ;; "started" exists for the "ftp" method only, which must be
+ ;; be kept persistent.
+ (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)))
+ (progn
+ (remhash "process-name" value)
+ (remhash "process-buffer" value)
+ (remhash "first-password-request" value))
+ (remhash key cache)))
+ cache)
+ ;; Dump it.
+ (with-temp-file tramp-persistency-file-name
+ (insert
+ ";; -*- emacs-lisp -*-"
+ ;; `time-stamp-string' might not exist in all Emacs flavors.
+ (condition-case nil
+ (progn
+ (format
+ " <%s %s>\n"
+ (time-stamp-string "%02y/%02m/%02d %02H:%02M:%02S")
+ tramp-persistency-file-name))
+ (error "\n"))
+ ";; Tramp connection history. Don't change this file.\n"
+ ";; You can delete it, forcing Tramp to reapply the checks.\n\n"
+ (with-output-to-string
+ (pp (read (format "(%s)" (tramp-cache-print cache)))))))))))
+
+(unless noninteractive
+ (add-hook 'kill-emacs-hook #'tramp-dump-connection-properties))
+(add-hook 'tramp-cache-unload-hook
+ (lambda ()
+ (remove-hook 'kill-emacs-hook
+ #'tramp-dump-connection-properties)))
+
+;;;###tramp-autoload
+(defun tramp-parse-connection-properties (method)
+ "Return a list of (user host) tuples allowed to access for METHOD.
+This function is added always in `tramp-get-completion-function'
+for all methods. Resulting data are derived from connection history."
+ (let (res)
+ (maphash
+ (lambda (key _value)
+ (if (and (tramp-file-name-p key)
+ (string-equal method (tramp-file-name-method key))
+ (not (tramp-file-name-localname key)))
+ (push (list (tramp-file-name-user key)
+ (tramp-file-name-host key))
+ res)))
+ tramp-cache-data)
+ res))
+
+;; When "emacs -Q" has been called, both variables are nil. We do not
+;; load the persistency file then, in order to have a clean test environment.
+;;;###tramp-autoload
+(defvar tramp-cache-read-persistent-data (or init-file-user site-run-file)
+ "Whether to read persistent data at startup time.")
+
+;; Read persistent connection history.
+(when (and (stringp tramp-persistency-file-name)
+ (zerop (hash-table-count tramp-cache-data))
+ tramp-cache-read-persistent-data)
+ (condition-case err
+ (with-temp-buffer
+ (insert-file-contents tramp-persistency-file-name)
+ (let ((list (read (current-buffer)))
+ (tramp-verbose 0)
+ element key item)
+ (while (setq element (pop list))
+ (setq key (pop element))
+ (when (tramp-file-name-p key)
+ (while (setq item (pop element))
+ ;; We set only values which are not contained in
+ ;; `tramp-connection-properties'. The cache is
+ ;; initialized properly by side effect.
+ (unless (tramp-connection-property-p key (car item))
+ (tramp-set-connection-property key (pop item) (car item)))))))
+ (setq tramp-cache-data-changed nil))
+ (file-error
+ ;; Most likely because the file doesn't exist yet. No message.
+ (clrhash tramp-cache-data))
+ (error
+ ;; File is corrupted.
+ (message "Tramp persistency file `%s' is corrupted: %s"
+ tramp-persistency-file-name (error-message-string err))
+ (clrhash tramp-cache-data))))
+
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (unload-feature 'tramp-cache 'force)))
+
+(provide 'tramp-cache)
+
+;;; tramp-cache.el ends here
diff --git a/tramp-cmds.el b/tramp-cmds.el
deleted file mode 120000
index 621f682..0000000
--- a/tramp-cmds.el
+++ /dev/null
@@ -1 +0,0 @@
-lisp/tramp-cmds.el
\ No newline at end of file
diff --git a/tramp-cmds.el b/tramp-cmds.el
new file mode 100644
index 0000000..f1e1d82
--- /dev/null
+++ b/tramp-cmds.el
@@ -0,0 +1,434 @@
+;;; tramp-cmds.el --- Interactive commands for Tramp -*- lexical-binding:t -*-
+
+;; Copyright (C) 2007-2019 Free Software Foundation, Inc.
+
+;; Author: Michael Albinus <address@hidden>
+;; 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:
+
+;; This package provides all interactive commands which are related
+;; to Tramp.
+
+;;; Code:
+
+(require 'tramp)
+
+;; Pacify byte-compiler.
+(declare-function mml-mode "mml")
+(declare-function mml-insert-empty-tag "mml")
+(declare-function reporter-dump-variable "reporter")
+(defvar reporter-eval-buffer)
+(defvar reporter-prompt-for-summary-p)
+
+;;;###tramp-autoload
+(defun tramp-change-syntax (&optional syntax)
+ "Change Tramp syntax.
+SYNTAX can be one of the symbols `default' (default),
+`simplified' (ange-ftp like) or `separate' (XEmacs like)."
+ (interactive
+ (let ((input (completing-read
+ "Enter Tramp syntax: " (tramp-syntax-values) nil t
+ (symbol-name tramp-syntax))))
+ (unless (string-equal input "")
+ (list (intern input)))))
+ (when syntax
+ (customize-set-variable 'tramp-syntax syntax)))
+
+(defun tramp-list-tramp-buffers ()
+ "Return a list of all Tramp connection buffers."
+ (append
+ (all-completions
+ "*tramp" (mapcar #'list (mapcar #'buffer-name (buffer-list))))
+ (all-completions
+ "*debug tramp" (mapcar #'list (mapcar #'buffer-name (buffer-list))))))
+
+(defun tramp-list-remote-buffers ()
+ "Return a list of all buffers with remote default-directory."
+ (delq
+ nil
+ (mapcar
+ (lambda (x)
+ (with-current-buffer x (when (tramp-tramp-file-p default-directory) x)))
+ (buffer-list))))
+
+;;;###tramp-autoload
+(defvar tramp-cleanup-connection-hook nil
+ "List of functions to be called after Tramp connection is cleaned up.
+Each function is called with the current vector as argument.")
+
+;;;###tramp-autoload
+(defun tramp-cleanup-connection (vec &optional keep-debug keep-password)
+ "Flush all connection related objects.
+This includes password cache, file cache, connection cache,
+buffers. KEEP-DEBUG non-nil preserves the debug buffer.
+KEEP-PASSWORD non-nil preserves the password cache.
+When called interactively, a Tramp connection has to be selected."
+ (interactive
+ ;; When interactive, select the Tramp remote identification.
+ ;; Return nil when there is no Tramp connection.
+ (list
+ (let ((connections
+ (mapcar #'tramp-make-tramp-file-name (tramp-list-connections)))
+ name)
+
+ (when connections
+ (setq name
+ (completing-read
+ "Enter Tramp connection: " connections nil t
+ (try-completion "" connections)))
+ (and (tramp-tramp-file-p name) (tramp-dissect-file-name name))))
+ nil nil))
+
+ (if (not vec)
+ ;; Nothing to do.
+ (message "No Tramp connection found.")
+
+ ;; Flush password cache.
+ (unless keep-password (tramp-clear-passwd vec))
+
+ ;; Cleanup `tramp-current-connection'. Otherwise, we would be
+ ;; suppressed.
+ (setq tramp-current-connection nil)
+
+ ;; Flush file cache.
+ (tramp-flush-directory-properties vec "")
+
+ ;; Flush connection cache.
+ (when (processp (tramp-get-connection-process vec))
+ (tramp-flush-connection-properties (tramp-get-connection-process vec))
+ (delete-process (tramp-get-connection-process vec)))
+ (tramp-flush-connection-properties vec)
+
+ ;; Remove buffers.
+ (dolist
+ (buf (list (get-buffer (tramp-buffer-name vec))
+ (unless keep-debug
+ (get-buffer (tramp-debug-buffer-name vec)))
+ (tramp-get-connection-property vec "process-buffer" nil)))
+ (when (bufferp buf) (kill-buffer buf)))
+
+ ;; The end.
+ (run-hook-with-args 'tramp-cleanup-connection-hook vec)))
+
+;;;###tramp-autoload
+(defun tramp-cleanup-this-connection ()
+ "Flush all connection related objects of the current buffer's connection."
+ (interactive)
+ (and (tramp-tramp-file-p default-directory)
+ (tramp-cleanup-connection
+ (tramp-dissect-file-name default-directory 'noexpand))))
+
+;;;###tramp-autoload
+(defvar tramp-cleanup-all-connections-hook nil
+ "List of functions to be called after all Tramp connections are cleaned up.")
+
+;;;###tramp-autoload
+(defun tramp-cleanup-all-connections ()
+ "Flush all Tramp internal objects.
+This includes password cache, file cache, connection cache, buffers."
+ (interactive)
+
+ ;; Unlock Tramp.
+ (setq tramp-locked nil)
+
+ ;; Flush password cache.
+ (password-reset)
+
+ ;; Flush file and connection cache.
+ (clrhash tramp-cache-data)
+
+ ;; Remove ad-hoc proxies.
+ (let ((proxies tramp-default-proxies-alist))
+ (while proxies
+ (if (ignore-errors
+ (get-text-property 0 'tramp-ad-hoc (nth 2 (car proxies))))
+ (setq tramp-default-proxies-alist
+ (delete (car proxies) tramp-default-proxies-alist)
+ proxies tramp-default-proxies-alist)
+ (setq proxies (cdr proxies)))))
+ (when (and tramp-default-proxies-alist tramp-save-ad-hoc-proxies)
+ (customize-save-variable
+ 'tramp-default-proxies-alist tramp-default-proxies-alist))
+
+ ;; Remove buffers.
+ (dolist (name (tramp-list-tramp-buffers))
+ (when (bufferp (get-buffer name)) (kill-buffer name)))
+
+ ;; The end.
+ (run-hooks 'tramp-cleanup-all-connections-hook))
+
+;;;###tramp-autoload
+(defun tramp-cleanup-all-buffers ()
+ "Kill all remote buffers."
+ (interactive)
+
+ ;; Remove all Tramp related connections.
+ (tramp-cleanup-all-connections)
+
+ ;; Remove all buffers with a remote default-directory.
+ (dolist (name (tramp-list-remote-buffers))
+ (when (bufferp (get-buffer name)) (kill-buffer name))))
+
+;; Tramp version is useful in a number of situations.
+
+;;;###tramp-autoload
+(defun tramp-version (arg)
+ "Print version number of tramp.el in minibuffer or current buffer."
+ (interactive "P")
+ (if arg (insert tramp-version) (message tramp-version)))
+
+;; Make the "reporter" functionality available for making bug reports about
+;; the package. A most useful piece of code.
+
+(autoload 'reporter-submit-bug-report "reporter")
+
+;;;###tramp-autoload
+(defun tramp-bug ()
+ "Submit a bug report to the Tramp developers."
+ (interactive)
+ (catch 'dont-send
+ (let ((reporter-prompt-for-summary-p t)
+ ;; In rare cases, it could contain the password. So we make it nil.
+ tramp-password-save-function)
+ (reporter-submit-bug-report
+ tramp-bug-report-address ; to-address
+ (format "tramp (%s %s/%s)" ; package name and version
+ tramp-version tramp-repository-branch tramp-repository-version)
+ (sort
+ (delq nil (mapcar
+ (lambda (x)
+ (and x (boundp x) (cons x 'tramp-reporter-dump-variable)))
+ (append
+ (mapcar #'intern (all-completions "tramp-" obarray #'boundp))
+ ;; Non-tramp variables of interest.
+ '(shell-prompt-pattern
+ backup-by-copying
+ backup-by-copying-when-linked
+ backup-by-copying-when-mismatch
+ backup-by-copying-when-privileged-mismatch
+ backup-directory-alist
+ password-cache
+ password-cache-expiry
+ remote-file-name-inhibit-cache
+ connection-local-profile-alist
+ connection-local-criteria-alist
+ file-name-handler-alist))))
+ (lambda (x y) (string< (symbol-name (car x)) (symbol-name (car y)))))
+
+ 'tramp-load-report-modules ; pre-hook
+ 'tramp-append-tramp-buffers ; post-hook
+ (propertize
+ "\n" 'display "\
+Enter your bug report in this message, including as much detail
+as you possibly can about the problem, what you did to cause it
+and what the local and remote machines are.
+
+If you can give a simple set of instructions to make this bug
+happen reliably, please include those. Thank you for helping
+kill bugs in Tramp.
+
+Before reproducing the bug, you might apply
+
+ M-x tramp-cleanup-all-connections
+
+This allows us to investigate from a clean environment. Another
+useful thing to do is to put
+
+ (setq tramp-verbose 9)
+
+in your init file and to repeat the bug. Then, include the
+contents of the *tramp/foo* buffer and the *debug tramp/foo*
+buffer in your bug report.
+
+--bug report follows this line--
+")))))
+
+(defun tramp-reporter-dump-variable (varsym mailbuf)
+ "Pretty-print the value of the variable in symbol VARSYM."
+ (let* ((reporter-eval-buffer (symbol-value 'reporter-eval-buffer))
+ (val (with-current-buffer reporter-eval-buffer
+ (symbol-value varsym))))
+
+ (if (hash-table-p val)
+ ;; Pretty print the cache.
+ (set varsym (read (format "(%s)" (tramp-cache-print val))))
+ ;; There are non-7bit characters to be masked.
+ (when (and (stringp val)
+ (string-match-p
+ (concat "[^" (bound-and-true-p mm-7bit-chars) "]") val))
+ (with-current-buffer reporter-eval-buffer
+ (set
+ varsym
+ (format
+ "(decode-coding-string (base64-decode-string \"%s\") 'raw-text)"
+ (base64-encode-string (encode-coding-string val 'raw-text)))))))
+
+ ;; Dump variable.
+ (reporter-dump-variable varsym mailbuf)
+
+ (unless (hash-table-p val)
+ ;; Remove string quotation.
+ (forward-line -1)
+ (when (looking-at
+ (eval-when-compile
+ (concat "\\(^.*\\)" "\"" ;; \1 "
+ "\\((base64-decode-string \\)" "\\\\" ;; \2 \
+ "\\(\".*\\)" "\\\\" ;; \3 \
+ "\\(\")\\)" "\"$"))) ;; \4 "
+ (replace-match "\\1\\2\\3\\4")
+ (beginning-of-line)
+ (insert " ;; Variable encoded due to non-printable characters.\n"))
+ (forward-line 1))
+
+ ;; Reset VARSYM to old value.
+ (with-current-buffer reporter-eval-buffer
+ (set varsym val))))
+
+(defun tramp-load-report-modules ()
+ "Load needed modules for reporting."
+ (message-mode)
+ (mml-mode t))
+
+(defun tramp-append-tramp-buffers ()
+ "Append Tramp buffers and buffer local variables into the bug report."
+ (goto-char (point-max))
+
+ ;; Dump buffer local variables.
+ (insert "\nlocal variables:\n================")
+ (dolist (buffer
+ (delq nil
+ (mapcar
+ (lambda (b)
+ (when (string-match-p "\\*tramp/" (buffer-name b)) b))
+ (buffer-list))))
+ (let ((reporter-eval-buffer buffer)
+ (elbuf (get-buffer-create " *tmp-reporter-buffer*")))
+ (with-current-buffer elbuf
+ (emacs-lisp-mode)
+ (erase-buffer)
+ (insert (format "\n;; %s\n(setq-local\n" (buffer-name buffer)))
+ (lisp-indent-line)
+ (dolist
+ (varsym
+ (sort
+ (append
+ (mapcar
+ #'intern
+ (all-completions "tramp-" (buffer-local-variables buffer)))
+ ;; Non-tramp variables of interest.
+ '(connection-local-variables-alist default-directory))
+ #'string<))
+ (reporter-dump-variable varsym elbuf))
+ (lisp-indent-line)
+ (insert ")\n"))
+ (insert-buffer-substring elbuf)))
+
+ ;; Dump load-path shadows.
+ (insert "\nload-path shadows:\n==================\n")
+ (ignore-errors
+ (mapc
+ (lambda (x) (when (string-match-p "tramp" x) (insert x "\n")))
+ (split-string (list-load-path-shadows t) "\n")))
+
+ ;; Append buffers only when we are in message mode.
+ (when (and
+ (eq major-mode 'message-mode)
+ (bound-and-true-p mml-mode))
+
+ (let ((tramp-buf-regexp "\\*\\(debug \\)?tramp/")
+ (buffer-list (tramp-list-tramp-buffers))
+ (curbuf (current-buffer)))
+
+ ;; There is at least one Tramp buffer.
+ (when buffer-list
+ (switch-to-buffer (list-buffers-noselect nil))
+ (delete-other-windows)
+ (setq buffer-read-only nil)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (if (re-search-forward tramp-buf-regexp (point-at-eol) t)
+ (forward-line 1)
+ (forward-line 0)
+ (let ((start (point)))
+ (forward-line 1)
+ (kill-region start (point)))))
+ (insert "
+The buffer(s) above will be appended to this message. If you
+don't want to append a buffer because it contains sensitive data,
+or because the buffer is too large, you should delete the
+respective buffer. The buffer(s) will contain user and host
+names. Passwords will never be included there.")
+
+ (when (>= tramp-verbose 6)
+ (insert "\n\n")
+ (let ((start (point)))
+ (insert "\
+Please note that you have set `tramp-verbose' to a value of at
+least 6. Therefore, the contents of files might be included in
+the debug buffer(s).")
+ (add-text-properties start (point) '(face italic))))
+
+ (set-buffer-modified-p nil)
+ (setq buffer-read-only t)
+ (goto-char (point-min))
+
+ (if (y-or-n-p "Do you want to append the buffer(s)? ")
+ ;; OK, let's send. First we delete the buffer list.
+ (progn
+ (kill-buffer nil)
+ (switch-to-buffer curbuf)
+ (goto-char (point-max))
+ (insert (propertize "\n" 'display "\n\
+This is a special notion of the `gnus/message' package. If you
+use another mail agent (by copying the contents of this buffer)
+please ensure that the buffers are attached to your email.\n\n"))
+ (dolist (buffer buffer-list)
+ (mml-insert-empty-tag
+ 'part 'type "text/plain"
+ 'encoding "base64" 'disposition "attachment" 'buffer buffer
+ 'description buffer))
+ (set-buffer-modified-p nil))
+
+ ;; Don't send. Delete the message buffer.
+ (set-buffer curbuf)
+ (set-buffer-modified-p nil)
+ (kill-buffer nil)
+ (throw 'dont-send nil))))))
+
+(defalias 'tramp-submit-bug #'tramp-bug)
+
+(add-hook 'tramp-unload-hook
+ (lambda () (unload-feature 'tramp-cmds 'force)))
+
+(provide 'tramp-cmds)
+
+;;; TODO:
+
+;; * Clean up unused *tramp/foo* buffers after a while. (Pete Forman)
+;;
+;; * WIBNI there was an interactive command prompting for Tramp
+;; method, hostname, username and filename and translates the user
+;; input into the correct filename syntax (depending on the Emacs
+;; flavor) (Reiner Steib)
+;;
+;; * Let the user edit the connection properties interactively.
+;; Something like `gnus-server-edit-server' in Gnus' *Server* buffer.
+
+;;; tramp-cmds.el ends here
diff --git a/tramp-compat.el b/tramp-compat.el
deleted file mode 120000
index 1fe0ab2..0000000
--- a/tramp-compat.el
+++ /dev/null
@@ -1 +0,0 @@
-lisp/tramp-compat.el
\ No newline at end of file
diff --git a/tramp-compat.el b/tramp-compat.el
new file mode 100644
index 0000000..7c13adf
--- /dev/null
+++ b/tramp-compat.el
@@ -0,0 +1,330 @@
+;;; tramp-compat.el --- Tramp compatibility functions -*- lexical-binding:t
-*-
+
+;; Copyright (C) 2007-2019 Free Software Foundation, Inc.
+
+;; Author: Michael Albinus <address@hidden>
+;; 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:
+
+;; Tramp's main Emacs version for development is Emacs 27. This
+;; package provides compatibility functions for Emacs 24, Emacs 25 and
+;; Emacs 26.
+
+;;; Code:
+
+;; In Emacs 24 and 25, `tramp-unload-file-name-handlers' is not
+;; autoloaded. So we declare it here in order to avoid recursive
+;; load. This will be overwritten in tramp.el.
+(defun tramp-unload-file-name-handlers ())
+
+(require 'auth-source)
+(require 'format-spec)
+(require 'parse-time)
+(require 'shell)
+
+(declare-function tramp-handle-temporary-file-directory "tramp")
+
+;; For not existing functions, obsolete functions, or functions with a
+;; changed argument list, there are compiler warnings. We want to
+;; avoid them in cases we know what we do.
+(defmacro tramp-compat-funcall (function &rest arguments)
+ "Call FUNCTION if it exists. Do not raise compiler warnings."
+ `(when (functionp ,function)
+ (with-no-warnings (funcall ,function ,@arguments))))
+
+(defsubst tramp-compat-temporary-file-directory ()
+ "Return name of directory for temporary files.
+It is the default value of `temporary-file-directory'."
+ ;; We must return a local directory. If it is remote, we could run
+ ;; into an infloop.
+ (eval (car (get 'temporary-file-directory 'standard-value))))
+
+(defsubst tramp-compat-make-temp-file (f &optional dir-flag)
+ "Create a local temporary file (compat function).
+Add the extension of F, if existing."
+ (let* (file-name-handler-alist
+ (prefix (expand-file-name
+ (symbol-value 'tramp-temp-name-prefix)
+ (tramp-compat-temporary-file-directory)))
+ (extension (file-name-extension f t)))
+ (make-temp-file prefix dir-flag extension)))
+
+;; `temporary-file-directory' as function is introduced with Emacs 26.1.
+(defalias 'tramp-compat-temporary-file-directory-function
+ (if (fboundp 'temporary-file-directory)
+ #'temporary-file-directory
+ #'tramp-handle-temporary-file-directory))
+
+(defun tramp-compat-process-running-p (process-name)
+ "Returns t if system process PROCESS-NAME is running for `user-login-name'."
+ (when (stringp process-name)
+ (cond
+ ;; GNU Emacs 22 on w32.
+ ((fboundp 'w32-window-exists-p)
+ (tramp-compat-funcall 'w32-window-exists-p process-name process-name))
+
+ ;; GNU Emacs 23.
+ ((and (fboundp 'list-system-processes) (fboundp 'process-attributes))
+ (let (result)
+ (dolist (pid (tramp-compat-funcall 'list-system-processes) result)
+ (let ((attributes (process-attributes pid)))
+ (when (and (string-equal
+ (cdr (assoc 'user attributes)) (user-login-name))
+ (let ((comm (cdr (assoc 'comm attributes))))
+ ;; The returned command name could be truncated
+ ;; to 15 characters. Therefore, we cannot check
+ ;; for `string-equal'.
+ (and comm (string-match-p
+ (concat "^" (regexp-quote comm))
+ process-name))))
+ (setq result t)))))))))
+
+;; `default-toplevel-value' has been declared in Emacs 24.4.
+(unless (fboundp 'default-toplevel-value)
+ (defalias 'default-toplevel-value #'symbol-value))
+
+;; `file-attribute-*' are introduced in Emacs 25.1.
+
+(defalias 'tramp-compat-file-attribute-type
+ (if (fboundp 'file-attribute-type)
+ #'file-attribute-type
+ (lambda (attributes)
+ "The type field in ATTRIBUTES returned by `file-attributes'.
+The value is either t for directory, string (name linked to) for
+symbolic link, or nil."
+ (nth 0 attributes))))
+
+(defalias 'tramp-compat-file-attribute-link-number
+ (if (fboundp 'file-attribute-link-number)
+ #'file-attribute-link-number
+ (lambda (attributes)
+ "Return the number of links in ATTRIBUTES returned by `file-attributes'."
+ (nth 1 attributes))))
+
+(defalias 'tramp-compat-file-attribute-user-id
+ (if (fboundp 'file-attribute-user-id)
+ #'file-attribute-user-id
+ (lambda (attributes)
+ "The UID field in ATTRIBUTES returned by `file-attributes'.
+This is either a string or a number. If a string value cannot be
+looked up, a numeric value, either an integer or a float, is
+returned."
+ (nth 2 attributes))))
+
+(defalias 'tramp-compat-file-attribute-group-id
+ (if (fboundp 'file-attribute-group-id)
+ #'file-attribute-group-id
+ (lambda (attributes)
+ "The GID field in ATTRIBUTES returned by `file-attributes'.
+This is either a string or a number. If a string value cannot be
+looked up, a numeric value, either an integer or a float, is
+returned."
+ (nth 3 attributes))))
+
+(defalias 'tramp-compat-file-attribute-modification-time
+ (if (fboundp 'file-attribute-modification-time)
+ #'file-attribute-modification-time
+ (lambda (attributes)
+ "The modification time in ATTRIBUTES returned by `file-attributes'.
+This is the time of the last change to the file's contents, and
+is a Lisp timestamp in the style of `current-time'."
+ (nth 5 attributes))))
+
+(defalias 'tramp-compat-file-attribute-size
+ (if (fboundp 'file-attribute-size)
+ #'file-attribute-size
+ (lambda (attributes)
+ "The size (in bytes) in ATTRIBUTES returned by `file-attributes'.
+If the size is too large for a fixnum, this is a bignum in Emacs 27
+and later, and is a float in Emacs 26 and earlier."
+ (nth 7 attributes))))
+
+(defalias 'tramp-compat-file-attribute-modes
+ (if (fboundp 'file-attribute-modes)
+ #'file-attribute-modes
+ (lambda (attributes)
+ "The file modes in ATTRIBUTES returned by `file-attributes'.
+This is a string of ten letters or dashes as in ls -l."
+ (nth 8 attributes))))
+
+;; `format-message' is new in Emacs 25.1.
+(unless (fboundp 'format-message)
+ (defalias 'format-message #'format))
+
+;; `directory-name-p' is new in Emacs 25.1.
+(defalias 'tramp-compat-directory-name-p
+ (if (fboundp 'directory-name-p)
+ #'directory-name-p
+ (lambda (name)
+ "Return non-nil if NAME ends with a directory separator character."
+ (let ((len (length name))
+ (lastc ?.))
+ (if (> len 0)
+ (setq lastc (aref name (1- len))))
+ (or (= lastc ?/)
+ (and (memq system-type '(windows-nt ms-dos))
+ (= lastc ?\\)))))))
+
+;; `file-missing' is introduced in Emacs 26.1.
+(defconst tramp-file-missing
+ (if (get 'file-missing 'error-conditions) 'file-missing 'file-error)
+ "The error symbol for the `file-missing' error.")
+
+;; `file-local-name', `file-name-quoted-p', `file-name-quote' and
+;; `file-name-unquote' are introduced in Emacs 26.
+(defalias 'tramp-compat-file-local-name
+ (if (fboundp 'file-local-name)
+ #'file-local-name
+ (lambda (name)
+ "Return the local name component of NAME.
+It returns a file name which can be used directly as argument of
+`process-file', `start-file-process', or `shell-command'."
+ (or (file-remote-p name 'localname) name))))
+
+;; `file-name-quoted-p' got a second argument in Emacs 27.1.
+(defalias 'tramp-compat-file-name-quoted-p
+ (if (and
+ (fboundp 'file-name-quoted-p)
+ (equal (tramp-compat-funcall 'func-arity #'file-name-quoted-p) '(1 .
2)))
+ #'file-name-quoted-p
+ (lambda (name &optional top)
+ "Whether NAME is quoted with prefix \"/:\".
+If NAME is a remote file name and TOP is nil, check the local part of NAME."
+ (let ((file-name-handler-alist (unless top file-name-handler-alist)))
+ (string-prefix-p "/:" (tramp-compat-file-local-name name))))))
+
+(defalias 'tramp-compat-file-name-quote
+ (if (fboundp 'file-name-quote)
+ #'file-name-quote
+ (lambda (name)
+ "Add the quotation prefix \"/:\" to file NAME.
+If NAME is a remote file name, the local part of NAME is quoted."
+ (if (tramp-compat-file-name-quoted-p name)
+ name
+ (concat
+ (file-remote-p name) "/:" (tramp-compat-file-local-name name))))))
+
+(defalias 'tramp-compat-file-name-unquote
+ (if (fboundp 'file-name-unquote)
+ #'file-name-unquote
+ (lambda (name)
+ "Remove quotation prefix \"/:\" from file NAME.
+If NAME is a remote file name, the local part of NAME is unquoted."
+ (let ((localname (tramp-compat-file-local-name name)))
+ (when (tramp-compat-file-name-quoted-p localname)
+ (setq
+ localname (if (= (length localname) 2) "/" (substring localname 2))))
+ (concat (file-remote-p name) localname)))))
+
+;; `tramp-syntax' has changed its meaning in Emacs 26. We still
+;; support old settings.
+(defsubst tramp-compat-tramp-syntax ()
+ "Return proper value of `tramp-syntax'."
+ (defvar tramp-syntax)
+ (cond ((eq tramp-syntax 'ftp) 'default)
+ ((eq tramp-syntax 'sep) 'separate)
+ (t tramp-syntax)))
+
+;; `cl-struct-slot-info' has been introduced with Emacs 25.
+(defmacro tramp-compat-tramp-file-name-slots ()
+ (if (fboundp 'cl-struct-slot-info)
+ '(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 use `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.")
+
+;; Threads have entered Emacs 26.1, `main-thread' in Emacs 27.1. But
+;; then, they might not exist when Emacs is configured
+;; --without-threads.
+(defconst tramp-compat-main-thread (bound-and-true-p main-thread)
+ "The main thread of Emacs, if compiled --with-threads.")
+
+(defsubst tramp-compat-current-thread ()
+ "The current thread, or nil if compiled --without-threads."
+ (tramp-compat-funcall 'current-thread))
+
+(defsubst tramp-compat-thread-yield ()
+ "Yield the CPU to another thread."
+ (tramp-compat-funcall 'thread-yield))
+
+;; Mutexes have entered Emacs 26.1. Once we use only Emacs 26+, we
+;; must check (mutexp mutex), because the other functions might still
+;; not exist when Emacs is configured --without-threads.
+(defmacro tramp-compat-with-mutex (mutex &rest body)
+ "Invoke BODY with MUTEX held, releasing MUTEX when done.
+This is the simplest safe way to acquire and release a mutex."
+ (declare (indent 1) (debug t))
+ `(if (fboundp 'with-mutex)
+ (with-mutex ,mutex ,@body)
+ ,@body))
+
+;; `exec-path' is new in Emacs 27.1.
+(defalias 'tramp-compat-exec-path
+ (if (fboundp 'exec-path)
+ #'exec-path
+ (lambda ()
+ "List of directories to search programs to run in remote subprocesses."
+ (let ((handler (find-file-name-handler default-directory 'exec-path)))
+ (if handler
+ (funcall handler 'exec-path)
+ exec-path)))))
+
+;; `time-equal-p' has appeared in Emacs 27.1.
+(defalias 'tramp-compat-time-equal-p
+ (if (fboundp 'time-equal-p)
+ #'time-equal-p
+ (lambda (t1 t2)
+ "Return non-nil if time value T1 is equal to time value T2.
+A nil value for either argument stands for the current time."
+ (equal (or t1 (current-time)) (or t2 (current-time))))))
+
+;; `flatten-tree' has appeared in Emacs 27.1.
+(defalias 'tramp-compat-flatten-tree
+ (if (fboundp 'flatten-tree)
+ #'flatten-tree
+ (lambda (tree)
+ "Take TREE and \"flatten\" it."
+ (let (elems)
+ (setq tree (list tree))
+ (while (let ((elem (pop tree)))
+ (cond ((consp elem)
+ (setq tree (cons (car elem) (cons (cdr elem) tree))))
+ (elem
+ (push elem elems)))
+ tree))
+ (nreverse elems)))))
+
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (unload-feature 'tramp-loaddefs 'force)
+ (unload-feature 'tramp-compat 'force)))
+
+(provide 'tramp-compat)
+
+;;; TODO:
+
+;; * When we get rid of Emacs 24, replace "(mapconcat #'identity" by
+;; "(string-join".
+
+;;; tramp-compat.el ends here
diff --git a/tramp-ftp.el b/tramp-ftp.el
deleted file mode 120000
index a83af71..0000000
--- a/tramp-ftp.el
+++ /dev/null
@@ -1 +0,0 @@
-lisp/tramp-ftp.el
\ No newline at end of file
diff --git a/tramp-ftp.el b/tramp-ftp.el
new file mode 100644
index 0000000..3e06ced
--- /dev/null
+++ b/tramp-ftp.el
@@ -0,0 +1,209 @@
+;;; tramp-ftp.el --- Tramp convenience functions for Ange-FTP -*-
lexical-binding:t -*-
+
+;; Copyright (C) 2002-2019 Free Software Foundation, Inc.
+
+;; Author: Michael Albinus <address@hidden>
+;; 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:
+
+;; Convenience functions for calling Ange-FTP from Tramp.
+;; Most of them are displaced from tramp.el.
+
+;;; Code:
+
+(require 'tramp)
+
+;; Pacify byte-compiler.
+(eval-when-compile
+ (require 'custom))
+(declare-function ange-ftp-ftp-process-buffer "ange-ftp")
+(defvar ange-ftp-ftp-name-arg)
+(defvar ange-ftp-ftp-name-res)
+(defvar ange-ftp-name-format)
+
+;; Disable Ange-FTP from file-name-handler-alist.
+(defun tramp-disable-ange-ftp ()
+ "Turn Ange-FTP off.
+This is useful for unified remoting. See
+`tramp-file-name-structure' for details. Requests suitable for
+Ange-FTP will be forwarded to Ange-FTP. Also see the variables
+`tramp-ftp-method', `tramp-default-method', and
+`tramp-default-method-alist'.
+
+This function is not needed in Emacsen which include Tramp, but is
+present for backward compatibility."
+ (let ((a1 (rassq 'ange-ftp-hook-function file-name-handler-alist))
+ (a2 (rassq 'ange-ftp-completion-hook-function file-name-handler-alist)))
+ (setq file-name-handler-alist
+ (delete a1 (delete a2 file-name-handler-alist)))))
+
+(eval-after-load "ange-ftp"
+ '(tramp-disable-ange-ftp))
+
+;;;###tramp-autoload
+(defun tramp-ftp-enable-ange-ftp ()
+ "Reenable Ange-FTP, when Tramp is unloaded."
+ ;; The following code is commented out in Ange-FTP.
+
+ ;;; This regexp takes care of real ange-ftp file names (with a slash
+ ;;; and colon).
+ ;;; Don't allow the host name to end in a period--some systems use /.:
+ (or (assoc "^/[^/:]*[^/:.]:" file-name-handler-alist)
+ (setq file-name-handler-alist
+ (cons '("^/[^/:]*[^/:.]:" . ange-ftp-hook-function)
+ file-name-handler-alist)))
+
+ ;;; This regexp recognizes absolute filenames with only one component,
+ ;;; for the sake of hostname completion.
+ (or (assoc "^/[^/:]*\\'" file-name-handler-alist)
+ (setq file-name-handler-alist
+ (cons '("^/[^/:]*\\'" . ange-ftp-completion-hook-function)
+ file-name-handler-alist)))
+
+ ;;; This regexp recognizes absolute filenames with only one component
+ ;;; on Windows, for the sake of hostname completion.
+ (and (memq system-type '(ms-dos windows-nt))
+ (or (assoc "^[a-zA-Z]:/[^/:]*\\'" file-name-handler-alist)
+ (setq file-name-handler-alist
+ (cons '("^[a-zA-Z]:/[^/:]*\\'" .
+ ange-ftp-completion-hook-function)
+ file-name-handler-alist)))))
+
+(add-hook 'tramp-ftp-unload-hook #'tramp-ftp-enable-ange-ftp)
+
+;; Define FTP method ...
+;;;###tramp-autoload
+(defconst tramp-ftp-method "ftp"
+ "When this method name is used, forward all calls to Ange-FTP.")
+
+;; ... and add it to the method list.
+;;;###tramp-autoload
+(tramp--with-startup
+ (add-to-list 'tramp-methods (cons tramp-ftp-method nil))
+
+ ;; Add some defaults for `tramp-default-method-alist'.
+ (add-to-list 'tramp-default-method-alist
+ (list "\\`ftp\\." nil tramp-ftp-method))
+ (add-to-list 'tramp-default-method-alist
+ (list nil "\\`\\(anonymous\\|ftp\\)\\'" tramp-ftp-method))
+
+ ;; Add completion function for FTP method.
+ (tramp-set-completion-function
+ tramp-ftp-method
+ '((tramp-parse-netrc "~/.netrc"))))
+
+;;;###tramp-autoload
+(defun tramp-ftp-file-name-handler (operation &rest args)
+ "Invoke the Ange-FTP handler for OPERATION.
+First arg specifies the OPERATION, second arg is a list of arguments to
+pass to the OPERATION."
+ (save-match-data
+ (or (boundp 'ange-ftp-name-format)
+ (let (file-name-handler-alist) (require 'ange-ftp)))
+ (let ((ange-ftp-name-format
+ (list (nth 0 tramp-file-name-structure)
+ (nth 3 tramp-file-name-structure)
+ (nth 2 tramp-file-name-structure)
+ (nth 4 tramp-file-name-structure)))
+ ;; ange-ftp uses `ange-ftp-ftp-name-arg' and `ange-ftp-ftp-name-res'
+ ;; for optimization in `ange-ftp-ftp-name'. If Tramp wasn't active,
+ ;; there could be incorrect values from previous calls in case the
+ ;; "ftp" method is used in the Tramp file name. So we unset
+ ;; those values.
+ (ange-ftp-ftp-name-arg "")
+ (ange-ftp-ftp-name-res nil)
+ (v (tramp-dissect-file-name
+ (apply #'tramp-file-name-for-operation operation args) t)))
+ (setf (tramp-file-name-method v) tramp-ftp-method)
+ ;; Set "process-name" for thread support.
+ (tramp-set-connection-property
+ v "process-name"
+ (ange-ftp-ftp-process-buffer
+ (tramp-file-name-host v) (tramp-file-name-user v)))
+
+ (cond
+ ;; If argument is a symlink, `file-directory-p' and
+ ;; `file-exists-p' call the traversed file recursively. So we
+ ;; cannot disable the file-name-handler this case. We set the
+ ;; connection property "started" in order to put the remote
+ ;; location into the cache, which is helpful for further
+ ;; completion. We don't use `with-parsed-tramp-file-name',
+ ;; because this returns another user but the one declared in
+ ;; "~/.netrc".
+ ((memq operation '(file-directory-p file-exists-p))
+ (if (apply #'ange-ftp-hook-function operation args)
+ (tramp-set-connection-property v "started" t)
+ nil))
+
+ ;; If the second argument of `copy-file' or `rename-file' is a
+ ;; remote file name but via FTP, ange-ftp doesn't check this.
+ ;; We must copy it locally first, because there is no place in
+ ;; ange-ftp for correct handling.
+ ((and (memq operation '(copy-file rename-file))
+ (tramp-tramp-file-p (cadr args))
+ (not (tramp-ftp-file-name-p (cadr args))))
+ (let* ((filename (car args))
+ (newname (cadr args))
+ (tmpfile (tramp-compat-make-temp-file filename))
+ (args (cddr args)))
+ ;; We must set `ok-if-already-exists' to t in the first
+ ;; step, because the temp file has been created already.
+ (if (eq operation 'copy-file)
+ (apply operation filename tmpfile t (cdr args))
+ (apply operation filename tmpfile t))
+ (unwind-protect
+ (rename-file tmpfile newname (car args))
+ ;; Cleanup.
+ (ignore-errors (delete-file tmpfile)))))
+
+ ;; Normally, the handlers must be discarded.
+ (t (let* ((inhibit-file-name-handlers
+ (list 'tramp-file-name-handler
+ 'tramp-completion-file-name-handler
+ (and (eq inhibit-file-name-operation operation)
+ inhibit-file-name-handlers)))
+ (inhibit-file-name-operation operation))
+ (apply #'ange-ftp-hook-function operation args)))))))
+
+;; It must be a `defsubst' in order to push the whole code into
+;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
+;;;###tramp-autoload
+(defsubst tramp-ftp-file-name-p (filename)
+ "Check if it's a filename that should be forwarded to Ange-FTP."
+ (and (tramp-tramp-file-p filename)
+ (string= (tramp-file-name-method (tramp-dissect-file-name filename))
+ tramp-ftp-method)))
+
+;;;###tramp-autoload
+(tramp--with-startup
+ (add-to-list 'tramp-foreign-file-name-handler-alist
+ (cons #'tramp-ftp-file-name-p #'tramp-ftp-file-name-handler)))
+
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (unload-feature 'tramp-ftp 'force)))
+
+(provide 'tramp-ftp)
+
+;;; TODO:
+
+;; * There are no backup files on FTP hosts.
+
+;;; tramp-ftp.el ends here
diff --git a/tramp-gvfs.el b/tramp-gvfs.el
deleted file mode 120000
index e93fba1..0000000
--- a/tramp-gvfs.el
+++ /dev/null
@@ -1 +0,0 @@
-lisp/tramp-gvfs.el
\ No newline at end of file
diff --git a/tramp-gvfs.el b/tramp-gvfs.el
new file mode 100644
index 0000000..3810231
--- /dev/null
+++ b/tramp-gvfs.el
@@ -0,0 +1,2067 @@
+;;; tramp-gvfs.el --- Tramp access functions for GVFS daemon -*-
lexical-binding:t -*-
+
+;; Copyright (C) 2009-2019 Free Software Foundation, Inc.
+
+;; Author: Michael Albinus <address@hidden>
+;; 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 the GVFS daemon from Tramp. Tested with GVFS
+;; 1.0 (Ubuntu 8.10, Gnome 2.24). It has been reported also to run
+;; with GVFS 0.2.5 (Ubuntu 8.04, Gnome 2.22), but there is an
+;; incompatibility with the mount_info structure, which has been
+;; worked around.
+
+;; It has also been tested with GVFS 1.6 (Ubuntu 10.04, Gnome 2.30),
+;; where the default_location has been added to mount_info (see
+;; <https://bugzilla.gnome.org/show_bug.cgi?id=561998>.
+
+;; With GVFS 1.14 (Ubuntu 12.10, Gnome 3.6) the interfaces have been
+;; changed, again. So we must introspect the D-Bus interfaces.
+
+;; All actions to mount a remote location, and to retrieve mount
+;; information, are performed by D-Bus messages. File operations
+;; themselves are performed via the mounted filesystem in ~/.gvfs.
+;; Consequently, GNU Emacs with enabled D-Bus bindings is a
+;; precondition.
+
+;; The GVFS D-Bus interface is said to be unstable. There were even
+;; no introspection data before GVFS 1.14. The interface, as
+;; discovered during development time, is given in respective
+;; comments.
+
+;; The user option `tramp-gvfs-methods' contains the list of supported
+;; connection methods. Per default, these are "afp", "dav", "davs",
+;; "gdrive", "nextcloud" and "sftp".
+
+;; "gdrive" and "nextcloud" connection methods require a respective
+;; account in GNOME Online Accounts, with enabled "Files" service.
+
+;; 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
+;; retrieved by:
+;;
+;; (message
+;; "%s"
+;; (mapcar
+;; #'car
+;; (dbus-call-method
+;; :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker
+;; tramp-gvfs-interface-mounttracker "ListMountableInfo")))
+
+;; See also /usr/share/gvfs/mounts
+
+;; Note that all other connection methods are not tested, beside the
+;; ones offered for customization in `tramp-gvfs-methods'. If you
+;; request an additional connection method to be supported, please
+;; drop me a note.
+
+;; For hostname completion, information is retrieved from the zeroconf
+;; daemon (for the "afp", "dav", "davs", and "sftp" methods). The
+;; zeroconf daemon is pre-configured to discover services in the
+;; "local" domain. If another domain shall be used for discovering
+;; services, the user option `tramp-gvfs-zeroconf-domain' can be set
+;; accordingly.
+
+;; Restrictions:
+;;
+;; * Two shares of the same SMB server cannot be mounted in parallel.
+
+;;; Code:
+
+;; D-Bus support in the Emacs core can be disabled with configuration
+;; option "--without-dbus". Declare used subroutines and variables.
+(declare-function dbus-get-unique-name "dbusbind.c")
+
+(eval-when-compile (require 'cl-lib))
+(require 'tramp)
+(require 'dbus)
+(require 'url-parse)
+(require 'url-util)
+
+;; Pacify byte-compiler.
+(eval-when-compile
+ (require 'custom))
+
+(declare-function zeroconf-init "zeroconf")
+(declare-function zeroconf-list-service-types "zeroconf")
+(declare-function zeroconf-list-services "zeroconf")
+(declare-function zeroconf-service-host "zeroconf")
+(declare-function zeroconf-service-port "zeroconf")
+(declare-function zeroconf-service-txt "zeroconf")
+
+;; We don't call `dbus-ping', because this would load dbus.el.
+(defconst tramp-gvfs-enabled
+ (ignore-errors
+ (and (featurep 'dbusbind)
+ (autoload 'zeroconf-init "zeroconf")
+ (tramp-compat-funcall 'dbus-get-unique-name :system)
+ (tramp-compat-funcall 'dbus-get-unique-name :session)
+ (or (tramp-compat-process-running-p "gvfs-fuse-daemon")
+ (tramp-compat-process-running-p "gvfsd-fuse"))))
+ "Non-nil when GVFS is available.")
+
+;;;###tramp-autoload
+(defcustom tramp-gvfs-methods
+ '("afp" "dav" "davs" "gdrive" "nextcloud" "sftp")
+ "List of methods for remote files, accessed with GVFS."
+ :group 'tramp
+ :version "27.1"
+ :type '(repeat (choice (const "afp")
+ (const "dav")
+ (const "davs")
+ (const "ftp")
+ (const "gdrive")
+ (const "http")
+ (const "https")
+ (const "nextcloud")
+ (const "sftp")
+ (const "smb"))))
+
+(defconst tramp-goa-methods '("gdrive" "nextcloud")
+ "List of methods which require registration at GNOME Online Accounts.")
+
+;; Remove GNOME Online Accounts methods if not supported.
+(unless (and tramp-gvfs-enabled
+ (member tramp-goa-service (dbus-list-known-names :session)))
+ (dolist (method tramp-goa-methods)
+ (setq tramp-gvfs-methods (delete method tramp-gvfs-methods))))
+
+;; Add defaults for `tramp-default-user-alist' and `tramp-default-host-alist'.
+;;;###tramp-autoload
+(tramp--with-startup
+ (when (string-match "\\(.+\\)@\\(\\(?:gmail\\|googlemail\\)\\.com\\)"
+ user-mail-address)
+ (add-to-list 'tramp-default-user-alist
+ `("\\`gdrive\\'" nil ,(match-string 1 user-mail-address)))
+ (add-to-list 'tramp-default-host-alist
+ '("\\`gdrive\\'" nil ,(match-string 2 user-mail-address)))))
+
+(defcustom tramp-gvfs-zeroconf-domain "local"
+ "Zeroconf domain to be used for discovering services, like host names."
+ :group 'tramp
+ :version "23.2"
+ :type 'string)
+
+;; Add the methods to `tramp-methods', in order to allow minibuffer
+;; completion.
+;;;###tramp-autoload
+(when (featurep 'dbusbind)
+ (tramp--with-startup
+ (dolist (elt tramp-gvfs-methods)
+ (unless (assoc elt tramp-methods)
+ (add-to-list 'tramp-methods (cons elt nil))))))
+
+(defconst tramp-gvfs-path-tramp (concat dbus-path-emacs "/Tramp")
+ "The preceding object path for own objects.")
+
+(defconst tramp-gvfs-service-daemon "org.gtk.vfs.Daemon"
+ "The well known name of the GVFS daemon.")
+
+(defconst tramp-gvfs-path-mounttracker "/org/gtk/vfs/mounttracker"
+ "The object path of the GVFS daemon.")
+
+(defconst tramp-gvfs-interface-mounttracker "org.gtk.vfs.MountTracker"
+ "The mount tracking interface in the GVFS daemon.")
+
+;; Introspection data exist since GVFS 1.14. If there are no such
+;; data, we expect an earlier interface.
+(defconst tramp-gvfs-methods-mounttracker
+ (and tramp-gvfs-enabled
+ (dbus-introspect-get-method-names
+ :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker
+ tramp-gvfs-interface-mounttracker))
+ "The list of supported methods of the mount tracking interface.")
+
+(defconst tramp-gvfs-listmounts
+ (if (member "ListMounts" tramp-gvfs-methods-mounttracker)
+ "ListMounts"
+ "listMounts")
+ "The name of the \"listMounts\" method.
+It has been changed in GVFS 1.14.")
+
+(defconst tramp-gvfs-mountlocation
+ (if (member "MountLocation" tramp-gvfs-methods-mounttracker)
+ "MountLocation"
+ "mountLocation")
+ "The name of the \"mountLocation\" method.
+It has been changed in GVFS 1.14.")
+
+(defconst tramp-gvfs-mountlocation-signature
+ (and tramp-gvfs-enabled
+ (dbus-introspect-get-signature
+ :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker
+ tramp-gvfs-interface-mounttracker tramp-gvfs-mountlocation))
+ "The D-Bus signature of the \"mountLocation\" method.
+It has been changed in GVFS 1.14.")
+
+;; <interface name='org.gtk.vfs.MountTracker'>
+;; <method name='listMounts'>
+;; <arg name='mount_info_list'
+;; type='a{sosssssbay{aya{say}}ay}'
+;; direction='out'/>
+;; </method>
+;; <method name='mountLocation'>
+;; <arg name='mount_spec' type='{aya{say}}' direction='in'/>
+;; <arg name='dbus_id' type='s' direction='in'/>
+;; <arg name='object_path' type='o' direction='in'/>
+;; </method>
+;; <signal name='mounted'>
+;; <arg name='mount_info'
+;; type='{sosssssbay{aya{say}}ay}'/>
+;; </signal>
+;; <signal name='unmounted'>
+;; <arg name='mount_info'
+;; type='{sosssssbay{aya{say}}ay}'/>
+;; </signal>
+;; </interface>
+;;
+;; STRUCT mount_info
+;; STRING dbus_id
+;; OBJECT_PATH object_path
+;; STRING display_name
+;; STRING stable_name
+;; STRING x_content_types Since GVFS 1.0 only !!!
+;; STRING icon
+;; STRING preferred_filename_encoding
+;; BOOLEAN user_visible
+;; ARRAY BYTE fuse_mountpoint
+;; STRUCT mount_spec
+;; ARRAY BYTE mount_prefix
+;; ARRAY
+;; STRUCT mount_spec_item
+;; STRING key (type, user, domain, host, server,
+;; share, volume, port, ssl)
+;; ARRAY BYTE value
+;; ARRAY BYTE default_location Since GVFS 1.5 only !!!
+
+(defconst tramp-gvfs-interface-mountoperation "org.gtk.vfs.MountOperation"
+ "Used by the dbus-proxying implementation of GMountOperation.")
+
+;; <interface name='org.gtk.vfs.MountOperation'>
+;; <method name='askPassword'>
+;; <arg name='message' type='s' direction='in'/>
+;; <arg name='default_user' type='s' direction='in'/>
+;; <arg name='default_domain' type='s' direction='in'/>
+;; <arg name='flags' type='u' direction='in'/>
+;; <arg name='handled' type='b' direction='out'/>
+;; <arg name='aborted' type='b' direction='out'/>
+;; <arg name='password' type='s' direction='out'/>
+;; <arg name='username' type='s' direction='out'/>
+;; <arg name='domain' type='s' direction='out'/>
+;; <arg name='anonymous' type='b' direction='out'/>
+;; <arg name='password_save' type='u' direction='out'/>
+;; </method>
+;; <method name='askQuestion'>
+;; <arg name='message' type='s' direction='in'/>
+;; <arg name='choices' type='as' direction='in'/>
+;; <arg name='handled' type='b' direction='out'/>
+;; <arg name='aborted' type='b' direction='out'/>
+;; <arg name='choice' type='u' direction='out'/>
+;; </method>
+;; </interface>
+
+;; The following flags are used in "askPassword". They are defined in
+;; /usr/include/glib-2.0/gio/gioenums.h.
+
+(defconst tramp-gvfs-password-need-password 1
+ "Operation requires a password.")
+
+(defconst tramp-gvfs-password-need-username 2
+ "Operation requires a username.")
+
+(defconst tramp-gvfs-password-need-domain 4
+ "Operation requires a domain.")
+
+(defconst tramp-gvfs-password-saving-supported 8
+ "Operation supports saving settings.")
+
+(defconst tramp-gvfs-password-anonymous-supported 16
+ "Operation supports anonymous users.")
+
+;; For the time being, we just need org.goa.Account and org.goa.Files
+;; interfaces. We document the other ones, just in case.
+
+;;;###tramp-autoload
+(defconst tramp-goa-service "org.gnome.OnlineAccounts"
+ "The well known name of the GNOME Online Accounts service.")
+
+(defconst tramp-goa-path "/org/gnome/OnlineAccounts"
+ "The object path of the GNOME Online Accounts.")
+
+(defconst tramp-goa-path-accounts (concat tramp-goa-path "/Accounts")
+ "The object path of the GNOME Online Accounts accounts.")
+
+(defconst tramp-goa-interface-documents "org.gnome.OnlineAccounts.Documents"
+ "The documents interface of the GNOME Online Accounts.")
+
+;; <interface name='org.gnome.OnlineAccounts.Documents'>
+;; </interface>
+
+(defconst tramp-goa-interface-printers "org.gnome.OnlineAccounts.Printers"
+ "The printers interface of the GNOME Online Accounts.")
+
+;; <interface name='org.gnome.OnlineAccounts.Printers'>
+;; </interface>
+
+(defconst tramp-goa-interface-files "org.gnome.OnlineAccounts.Files"
+ "The files interface of the GNOME Online Accounts.")
+
+;; <interface name='org.gnome.OnlineAccounts.Files'>
+;; <property type='b' name='AcceptSslErrors' access='read'/>
+;; <property type='s' name='Uri' access='read'/>
+;; </interface>
+
+(defconst tramp-goa-interface-contacts "org.gnome.OnlineAccounts.Contacts"
+ "The contacts interface of the GNOME Online Accounts.")
+
+;; <interface name='org.gnome.OnlineAccounts.Contacts'>
+;; <property type='b' name='AcceptSslErrors' access='read'/>
+;; <property type='s' name='Uri' access='read'/>
+;; </interface>
+
+(defconst tramp-goa-interface-calendar "org.gnome.OnlineAccounts.Calendar"
+ "The calendar interface of the GNOME Online Accounts.")
+
+;; <interface name='org.gnome.OnlineAccounts.Calendar'>
+;; <property type='b' name='AcceptSslErrors' access='read'/>
+;; <property type='s' name='Uri' access='read'/>
+;; </interface>
+
+(defconst tramp-goa-interface-oauth2based
"org.gnome.OnlineAccounts.OAuth2Based"
+ "The oauth2based interface of the GNOME Online Accounts.")
+
+;; <interface name='org.gnome.OnlineAccounts.OAuth2Based'>
+;; <method name='GetAccessToken'>
+;; <arg type='s' name='access_token' direction='out'/>
+;; <arg type='i' name='expires_in' direction='out'/>
+;; </method>
+;; <property type='s' name='ClientId' access='read'/>
+;; <property type='s' name='ClientSecret' access='read'/>
+;; </interface>
+
+(defconst tramp-goa-interface-account "org.gnome.OnlineAccounts.Account"
+ "The account interface of the GNOME Online Accounts.")
+
+;; <interface name='org.gnome.OnlineAccounts.Account'>
+;; <method name='Remove'/>
+;; <method name='EnsureCredentials'>
+;; <arg type='i' name='expires_in' direction='out'/>
+;; </method>
+;; <property type='s' name='ProviderType' access='read'/>
+;; <property type='s' name='ProviderName' access='read'/>
+;; <property type='s' name='ProviderIcon' access='read'/>
+;; <property type='s' name='Id' access='read'/>
+;; <property type='b' name='IsLocked' access='read'/>
+;; <property type='b' name='IsTemporary' access='readwrite'/>
+;; <property type='b' name='AttentionNeeded' access='read'/>
+;; <property type='s' name='Identity' access='read'/>
+;; <property type='s' name='PresentationIdentity' access='read'/>
+;; <property type='b' name='MailDisabled' access='readwrite'/>
+;; <property type='b' name='CalendarDisabled' access='readwrite'/>
+;; <property type='b' name='ContactsDisabled' access='readwrite'/>
+;; <property type='b' name='ChatDisabled' access='readwrite'/>
+;; <property type='b' name='DocumentsDisabled' access='readwrite'/>
+;; <property type='b' name='MapsDisabled' access='readwrite'/>
+;; <property type='b' name='MusicDisabled' access='readwrite'/>
+;; <property type='b' name='PrintersDisabled' access='readwrite'/>
+;; <property type='b' name='PhotosDisabled' access='readwrite'/>
+;; <property type='b' name='FilesDisabled' access='readwrite'/>
+;; <property type='b' name='TicketingDisabled' access='readwrite'/>
+;; <property type='b' name='TodoDisabled' access='readwrite'/>
+;; <property type='b' name='ReadLaterDisabled' access='readwrite'/>
+;; </interface>
+
+(defconst tramp-goa-identity-regexp
+ (concat "^" "\\(" tramp-user-regexp "\\)?"
+ "@" "\\(" tramp-host-regexp "\\)?"
+ "\\(?:" ":""\\(" tramp-port-regexp "\\)" "\\)?")
+ "Regexp matching GNOME Online Accounts \"PresentationIdentity\" property.")
+
+(defconst tramp-goa-interface-mail "org.gnome.OnlineAccounts.Mail"
+ "The mail interface of the GNOME Online Accounts.")
+
+;; <interface name='org.gnome.OnlineAccounts.Mail'>
+;; <property type='s' name='EmailAddress' access='read'/>
+;; <property type='s' name='Name' access='read'/>
+;; <property type='b' name='ImapSupported' access='read'/>
+;; <property type='b' name='ImapAcceptSslErrors' access='read'/>
+;; <property type='s' name='ImapHost' access='read'/>
+;; <property type='b' name='ImapUseSsl' access='read'/>
+;; <property type='b' name='ImapUseTls' access='read'/>
+;; <property type='s' name='ImapUserName' access='read'/>
+;; <property type='b' name='SmtpSupported' access='read'/>
+;; <property type='b' name='SmtpAcceptSslErrors' access='read'/>
+;; <property type='s' name='SmtpHost' access='read'/>
+;; <property type='b' name='SmtpUseAuth' access='read'/>
+;; <property type='b' name='SmtpAuthLogin' access='read'/>
+;; <property type='b' name='SmtpAuthPlain' access='read'/>
+;; <property type='b' name='SmtpAuthXoauth2' access='read'/>
+;; <property type='b' name='SmtpUseSsl' access='read'/>
+;; <property type='b' name='SmtpUseTls' access='read'/>
+;; <property type='s' name='SmtpUserName' access='read'/>
+;; </interface>
+
+(defconst tramp-goa-interface-chat "org.gnome.OnlineAccounts.Chat"
+ "The chat interface of the GNOME Online Accounts.")
+
+;; <interface name='org.gnome.OnlineAccounts.Chat'>
+;; </interface>
+
+(defconst tramp-goa-interface-photos "org.gnome.OnlineAccounts.Photos"
+ "The photos interface of the GNOME Online Accounts.")
+
+;; <interface name='org.gnome.OnlineAccounts.Photos'>
+;; </interface>
+
+(defconst tramp-goa-path-manager (concat tramp-goa-path "/Manager")
+ "The object path of the GNOME Online Accounts manager.")
+
+(defconst tramp-goa-interface-documents "org.gnome.OnlineAccounts.Manager"
+ "The manager interface of the GNOME Online Accounts.")
+
+;; <interface name='org.gnome.OnlineAccounts.Manager'>
+;; <method name='AddAccount'>
+;; <arg type='s' name='provider' direction='in'/>
+;; <arg type='s' name='identity' direction='in'/>
+;; <arg type='s' name='presentation_identity' direction='in'/>
+;; <arg type='a{sv}' name='credentials' direction='in'/>
+;; <arg type='a{ss}' name='details' direction='in'/>
+;; <arg type='o' name='account_object_path' direction='out'/>
+;; </method>
+;; </interface>
+
+;; The basic structure for GNOME Online Accounts. We use a list :type,
+;; in order to be compatible with Emacs 24 and 25.
+(cl-defstruct (tramp-goa-name (:type list) :named) method user host port)
+
+;; "gvfs-<command>" utilities have been deprecated in GVFS 1.31.1. We
+;; must use "gio <command>" tool instead.
+(defconst tramp-gvfs-gio-mapping
+ '(("gvfs-copy" . "copy")
+ ("gvfs-info" . "info")
+ ("gvfs-ls" . "list")
+ ("gvfs-mkdir" . "mkdir")
+ ("gvfs-monitor-file" . "monitor")
+ ("gvfs-mount" . "mount")
+ ("gvfs-move" . "move")
+ ("gvfs-rm" . "remove")
+ ("gvfs-trash" . "trash"))
+ "List of cons cells, mapping \"gvfs-<command>\" to \"gio <command>\".")
+
+;; <http://www.pygtk.org/docs/pygobject/gio-constants.html>
+(defconst tramp-gvfs-file-attributes
+ '("name"
+ "type"
+ "standard::display-name"
+ "standard::symlink-target"
+ "unix::nlink"
+ "unix::uid"
+ "owner::user"
+ "unix::gid"
+ "owner::group"
+ "time::access"
+ "time::modified"
+ "time::changed"
+ "standard::size"
+ "unix::mode"
+ "access::can-read"
+ "access::can-write"
+ "access::can-execute"
+ "unix::inode"
+ "unix::device")
+ "GVFS file attributes.")
+
+(defconst tramp-gvfs-file-attributes-with-gvfs-ls-regexp
+ (concat "[[:blank:]]" (regexp-opt tramp-gvfs-file-attributes t) "=\\(.+?\\)")
+ "Regexp to parse GVFS file attributes with `gvfs-ls'.")
+
+(defconst tramp-gvfs-file-attributes-with-gvfs-info-regexp
+ (concat "^[[:blank:]]*"
+ (regexp-opt tramp-gvfs-file-attributes t)
+ ":[[:blank:]]+\\(.*\\)$")
+ "Regexp to parse GVFS file attributes with `gvfs-info'.")
+
+(defconst tramp-gvfs-file-system-attributes
+ '("filesystem::free"
+ "filesystem::size"
+ "filesystem::used")
+ "GVFS file system attributes.")
+
+(defconst tramp-gvfs-file-system-attributes-regexp
+ (concat "^[[:blank:]]*"
+ (regexp-opt tramp-gvfs-file-system-attributes t)
+ ":[[:blank:]]+\\(.*\\)$")
+ "Regexp to parse GVFS file system attributes with `gvfs-info'.")
+
+(defconst tramp-gvfs-nextcloud-default-prefix "/remote.php/webdav"
+ "Default prefix for owncloud / nextcloud methods.")
+
+(defconst tramp-gvfs-nextcloud-default-prefix-regexp
+ (concat (regexp-quote tramp-gvfs-nextcloud-default-prefix) "$")
+ "Regexp of default prefix for owncloud / nextcloud methods.")
+
+
+;; New handlers should be added here.
+;;;###tramp-autoload
+(defconst tramp-gvfs-file-name-handler-alist
+ '((access-file . tramp-handle-access-file)
+ (add-name-to-file . tramp-handle-add-name-to-file)
+ ;; `byte-compiler-base-file-name' performed by default handler.
+ ;; `copy-directory' performed by default handler.
+ (copy-file . tramp-gvfs-handle-copy-file)
+ (delete-directory . tramp-gvfs-handle-delete-directory)
+ (delete-file . tramp-gvfs-handle-delete-file)
+ ;; `diff-latest-backup-file' performed by default handler.
+ (directory-file-name . tramp-handle-directory-file-name)
+ (directory-files . tramp-handle-directory-files)
+ (directory-files-and-attributes
+ . tramp-handle-directory-files-and-attributes)
+ (dired-compress-file . ignore)
+ (dired-uncache . tramp-handle-dired-uncache)
+ (exec-path . ignore)
+ (expand-file-name . tramp-gvfs-handle-expand-file-name)
+ (file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
+ (file-acl . ignore)
+ (file-attributes . tramp-gvfs-handle-file-attributes)
+ (file-directory-p . tramp-handle-file-directory-p)
+ (file-equal-p . tramp-handle-file-equal-p)
+ (file-executable-p . tramp-gvfs-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-handle-file-local-copy)
+ (file-modes . tramp-handle-file-modes)
+ (file-name-all-completions . tramp-gvfs-handle-file-name-all-completions)
+ (file-name-as-directory . tramp-handle-file-name-as-directory)
+ (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p)
+ (file-name-completion . tramp-handle-file-name-completion)
+ (file-name-directory . tramp-handle-file-name-directory)
+ (file-name-nondirectory . tramp-handle-file-name-nondirectory)
+ ;; `file-name-sans-versions' performed by default handler.
+ (file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
+ (file-notify-add-watch . tramp-gvfs-handle-file-notify-add-watch)
+ (file-notify-rm-watch . tramp-handle-file-notify-rm-watch)
+ (file-notify-valid-p . tramp-handle-file-notify-valid-p)
+ (file-ownership-preserved-p . ignore)
+ (file-readable-p . tramp-gvfs-handle-file-readable-p)
+ (file-regular-p . tramp-handle-file-regular-p)
+ (file-remote-p . tramp-handle-file-remote-p)
+ (file-selinux-context . tramp-handle-file-selinux-context)
+ (file-symlink-p . tramp-handle-file-symlink-p)
+ (file-system-info . tramp-gvfs-handle-file-system-info)
+ (file-truename . tramp-handle-file-truename)
+ (file-writable-p . tramp-handle-file-writable-p)
+ (find-backup-file-name . tramp-handle-find-backup-file-name)
+ ;; `get-file-buffer' performed by default handler.
+ (insert-directory . tramp-handle-insert-directory)
+ (insert-file-contents . tramp-handle-insert-file-contents)
+ (load . tramp-handle-load)
+ (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
+ (make-directory . tramp-gvfs-handle-make-directory)
+ (make-directory-internal . ignore)
+ (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
+ (make-process . ignore)
+ (make-symbolic-link . tramp-handle-make-symbolic-link)
+ (process-file . ignore)
+ (rename-file . tramp-gvfs-handle-rename-file)
+ (set-file-acl . ignore)
+ (set-file-modes . ignore)
+ (set-file-selinux-context . ignore)
+ (set-file-times . ignore)
+ (set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
+ (shell-command . ignore)
+ (start-file-process . ignore)
+ (substitute-in-file-name . tramp-handle-substitute-in-file-name)
+ (temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-set-file-uid-gid . ignore)
+ (unhandled-file-name-directory . ignore)
+ (vc-registered . ignore)
+ (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
+ (write-region . tramp-handle-write-region))
+ "Alist of handler functions for Tramp GVFS method.
+Operations not mentioned here will be handled by the default Emacs
primitives.")
+
+;; It must be a `defsubst' in order to push the whole code into
+;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
+;;;###tramp-autoload
+(defsubst tramp-gvfs-file-name-p (filename)
+ "Check if it's a filename handled by the GVFS daemon."
+ (and (tramp-tramp-file-p filename)
+ (let ((method
+ (tramp-file-name-method (tramp-dissect-file-name filename))))
+ (and (stringp method) (member method tramp-gvfs-methods)))))
+
+;;;###tramp-autoload
+(defun tramp-gvfs-file-name-handler (operation &rest args)
+ "Invoke the GVFS related OPERATION.
+First arg specifies the OPERATION, second arg is a list of arguments to
+pass to the OPERATION."
+ (unless tramp-gvfs-enabled
+ (tramp-user-error nil "Package `tramp-gvfs' not supported"))
+ (let ((fn (assoc operation tramp-gvfs-file-name-handler-alist)))
+ (if fn
+ (save-match-data (apply (cdr fn) args))
+ (tramp-run-real-handler operation args))))
+
+;;;###tramp-autoload
+(when (featurep 'dbusbind)
+ (tramp--with-startup
+ (tramp-register-foreign-file-name-handler
+ #'tramp-gvfs-file-name-p #'tramp-gvfs-file-name-handler)))
+
+
+;; D-Bus helper function.
+
+(defun tramp-gvfs-dbus-string-to-byte-array (string)
+ "Like `dbus-string-to-byte-array' but add trailing \\0 if needed."
+ (dbus-string-to-byte-array
+ (if (string-match "^(aya{sv})" tramp-gvfs-mountlocation-signature)
+ (concat string (string 0)) string)))
+
+(defun tramp-gvfs-dbus-byte-array-to-string (byte-array)
+ "Like `dbus-byte-array-to-string' but remove trailing \\0 if exists.
+Return nil for null BYTE-ARRAY."
+ ;; The byte array could be a variant. Take care.
+ (let ((byte-array
+ (if (and (consp byte-array) (atom (car byte-array)))
+ byte-array (car byte-array))))
+ (and byte-array
+ (dbus-byte-array-to-string
+ (if (and (consp byte-array) (zerop (car (last byte-array))))
+ (butlast byte-array) byte-array)))))
+
+(defun tramp-gvfs-stringify-dbus-message (message)
+ "Convert a D-Bus message into readable UTF8 strings, used for traces."
+ (cond
+ ((and (consp message) (characterp (car message)))
+ (format "%S" (tramp-gvfs-dbus-byte-array-to-string message)))
+ ((and (consp message) (atom (cdr message)))
+ (cons (tramp-gvfs-stringify-dbus-message (car message))
+ (tramp-gvfs-stringify-dbus-message (cdr message))))
+ ((consp message)
+ (mapcar #'tramp-gvfs-stringify-dbus-message message))
+ ((stringp message)
+ (format "%S" message))
+ (t message)))
+
+(defun tramp-dbus-function (vec func args)
+ "Apply a D-Bus function FUNC from dbus.el.
+The call will be traced by Tramp with trace level 6."
+ (let (result)
+ (tramp-message vec 6 "%s" (cons func args))
+ (setq result (apply func args))
+ (tramp-message vec 6 "%s" result(tramp-gvfs-stringify-dbus-message result))
+ result))
+
+(defmacro with-tramp-dbus-call-method
+ (vec synchronous bus service path interface method &rest args)
+ "Apply a D-Bus call on bus BUS.
+
+If SYNCHRONOUS is non-nil, the call is synchronously. Otherwise,
+it is an asynchronous call, with `ignore' as callback function.
+
+The other arguments have the same meaning as with `dbus-call-method'
+or `dbus-call-method-asynchronously'."
+ `(let ((func (if ,synchronous
+ #'dbus-call-method #'dbus-call-method-asynchronously))
+ (args (append (list ,bus ,service ,path ,interface ,method)
+ (if ,synchronous (list ,@args) (list 'ignore ,@args)))))
+ (tramp-dbus-function ,vec func args)))
+
+(put 'with-tramp-dbus-call-method 'lisp-indent-function 2)
+(put 'with-tramp-dbus-call-method 'edebug-form-spec '(form symbolp body))
+(font-lock-add-keywords 'emacs-lisp-mode
'("\\<with-tramp-dbus-call-method\\>"))
+
+(defmacro with-tramp-dbus-get-all-properties
+ (vec bus service path interface)
+ "Return all properties of INTERFACE.
+The call will be traced by Tramp with trace level 6."
+ ;; Check, that interface exists at object path. Retrieve properties.
+ `(when (member
+ ,interface
+ (tramp-dbus-function
+ ,vec #'dbus-introspect-get-interface-names
+ (list ,bus ,service ,path)))
+ (tramp-dbus-function
+ ,vec #'dbus-get-all-properties (list ,bus ,service ,path ,interface))))
+
+(put 'with-tramp-dbus-get-all-properties 'lisp-indent-function 1)
+(put 'with-tramp-dbus-get-all-properties 'edebug-form-spec '(form symbolp
body))
+(font-lock-add-keywords 'emacs-lisp-mode
'("\\<with-tramp-dbus-get-all-properties\\>"))
+
+(defvar tramp-gvfs-dbus-event-vector nil
+ "Current Tramp file name to be used, as vector.
+It is needed when D-Bus signals or errors arrive, because there
+is no information where to trace the message.")
+
+(defun tramp-gvfs-dbus-event-error (event err)
+ "Called when a D-Bus error message arrives, see
`dbus-event-error-functions'."
+ (when tramp-gvfs-dbus-event-vector
+ (tramp-message tramp-gvfs-dbus-event-vector 6 "%S" event)
+ (tramp-error tramp-gvfs-dbus-event-vector 'file-error "%s" (cadr err))))
+
+;; `dbus-event-error-hooks' has been renamed to
+;; `dbus-event-error-functions' in Emacs 24.3.
+(add-hook
+ (if (boundp 'dbus-event-error-functions)
+ 'dbus-event-error-functions 'dbus-event-error-hooks)
+ #'tramp-gvfs-dbus-event-error)
+
+
+;; File name primitives.
+
+(defun tramp-gvfs-do-copy-or-rename-file
+ (op filename newname &optional ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes)
+ "Copy or rename a remote file.
+OP must be `copy' or `rename' and indicates the operation to perform.
+FILENAME specifies the file to copy or rename, NEWNAME is the name of
+the new file (for copy) or the new name of the file (for rename).
+OK-IF-ALREADY-EXISTS means don't barf if NEWNAME exists already.
+KEEP-DATE means to make sure that NEWNAME has the same timestamp
+as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep
+the uid and gid if both files are on the same host.
+PRESERVE-EXTENDED-ATTRIBUTES is ignored.
+
+This function is invoked by `tramp-gvfs-handle-copy-file' and
+`tramp-gvfs-handle-rename-file'. It is an error if OP is neither
+of `copy' and `rename'. FILENAME and NEWNAME must be absolute
+file names."
+ (unless (memq op '(copy rename))
+ (error "Unknown operation `%s', must be `copy' or `rename'" op))
+
+ (setq filename (file-truename filename))
+ (if (file-directory-p filename)
+ (progn
+ (copy-directory filename newname keep-date t)
+ (when (eq op 'rename) (delete-directory filename 'recursive)))
+
+ (let ((t1 (tramp-tramp-file-p filename))
+ (t2 (tramp-tramp-file-p newname))
+ (equal-remote (tramp-equal-remote filename newname))
+ (gvfs-operation (if (eq op 'copy) "gvfs-copy" "gvfs-move"))
+ (msg-operation (if (eq op 'copy) "Copying" "Renaming")))
+
+ (with-parsed-tramp-file-name (if t1 filename newname) nil
+ (when (and (not ok-if-already-exists) (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+
+ (if (or (and equal-remote
+ (tramp-get-connection-property v "direct-copy-failed" nil))
+ (and t1 (not (tramp-gvfs-file-name-p filename)))
+ (and t2 (not (tramp-gvfs-file-name-p newname))))
+
+ ;; We cannot copy or rename directly.
+ (let ((tmpfile (tramp-compat-make-temp-file filename)))
+ (if (eq op 'copy)
+ (copy-file
+ filename tmpfile t keep-date preserve-uid-gid
+ preserve-extended-attributes)
+ (rename-file filename tmpfile t))
+ (rename-file tmpfile newname ok-if-already-exists))
+
+ ;; Direct action.
+ (with-tramp-progress-reporter
+ v 0 (format "%s %s to %s" msg-operation filename newname)
+ (unless
+ (apply
+ #'tramp-gvfs-send-command v gvfs-operation
+ (append
+ (and (eq op 'copy) (or keep-date preserve-uid-gid)
+ '("--preserve"))
+ (list
+ (tramp-gvfs-url-file-name filename)
+ (tramp-gvfs-url-file-name newname))))
+
+ (if (or (not equal-remote)
+ (and equal-remote
+ (tramp-get-connection-property
+ v "direct-copy-failed" nil)))
+ ;; Propagate the error.
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (goto-char (point-min))
+ (tramp-error-with-buffer
+ nil v 'file-error
+ "%s failed, see buffer `%s' for details."
+ msg-operation (buffer-name)))
+
+ ;; Some WebDAV server, like the one from QNAP, do not
+ ;; support direct copy/move. Try a fallback.
+ (tramp-set-connection-property v "direct-copy-failed" t)
+ (tramp-gvfs-do-copy-or-rename-file
+ op filename newname ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes))))
+
+ (when (and t1 (eq op 'rename))
+ (with-parsed-tramp-file-name filename nil
+ (tramp-flush-file-properties v (file-name-directory localname))
+ (tramp-flush-file-properties v localname)))
+
+ (when t2
+ (with-parsed-tramp-file-name newname nil
+ (tramp-flush-file-properties v (file-name-directory localname))
+ (tramp-flush-file-properties v localname))))))))
+
+(defun tramp-gvfs-handle-copy-file
+ (filename newname &optional ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes)
+ "Like `copy-file' for Tramp files."
+ (setq filename (expand-file-name filename))
+ (setq newname (expand-file-name newname))
+ ;; At least one file a Tramp file?
+ (if (or (tramp-tramp-file-p filename)
+ (tramp-tramp-file-p newname))
+ (tramp-gvfs-do-copy-or-rename-file
+ 'copy filename newname ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes)
+ (tramp-run-real-handler
+ 'copy-file
+ (list filename newname ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes))))
+
+(defun tramp-gvfs-handle-delete-directory (directory &optional recursive trash)
+ "Like `delete-directory' for Tramp files."
+ (with-parsed-tramp-file-name directory nil
+ (if (and recursive (not (file-symlink-p directory)))
+ (mapc (lambda (file)
+ (if (eq t (tramp-compat-file-attribute-type
+ (file-attributes file)))
+ (delete-directory file recursive trash)
+ (delete-file file trash)))
+ (directory-files
+ directory 'full directory-files-no-dot-files-regexp))
+ (when (directory-files directory nil directory-files-no-dot-files-regexp)
+ (tramp-error
+ v 'file-error "Couldn't delete non-empty %s" directory)))
+
+ (tramp-flush-file-properties v (file-name-directory localname))
+ (tramp-flush-directory-properties v localname)
+ (unless
+ (tramp-gvfs-send-command
+ v (if (and trash delete-by-moving-to-trash) "gvfs-trash" "gvfs-rm")
+ (tramp-gvfs-url-file-name directory))
+ ;; Propagate the error.
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (goto-char (point-min))
+ (tramp-error-with-buffer
+ nil v 'file-error "Couldn't delete %s" directory)))))
+
+(defun tramp-gvfs-handle-delete-file (filename &optional trash)
+ "Like `delete-file' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (tramp-flush-file-properties v (file-name-directory localname))
+ (tramp-flush-file-properties v localname)
+ (unless
+ (tramp-gvfs-send-command
+ v (if (and trash delete-by-moving-to-trash) "gvfs-trash" "gvfs-rm")
+ (tramp-gvfs-url-file-name filename))
+ ;; Propagate the error.
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (goto-char (point-min))
+ (tramp-error-with-buffer
+ nil v 'file-error "Couldn't delete %s" filename)))))
+
+(defun tramp-gvfs-handle-expand-file-name (name &optional dir)
+ "Like `expand-file-name' for Tramp files."
+ ;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
+ (setq dir (or dir default-directory "/"))
+ ;; Handle empty NAME.
+ (when (zerop (length name)) (setq name "."))
+ ;; Unless NAME is absolute, concat DIR and NAME.
+ (unless (file-name-absolute-p name)
+ (setq name (concat (file-name-as-directory dir) name)))
+ ;; If NAME is not a Tramp file, run the real handler.
+ (if (not (tramp-tramp-file-p name))
+ (tramp-run-real-handler #'expand-file-name (list name nil))
+ ;; Dissect NAME.
+ (with-parsed-tramp-file-name name nil
+ ;; If there is a default location, expand tilde.
+ (when (string-match "\\`\\(~\\)\\(/\\|\\'\\)" localname)
+ (save-match-data
+ (tramp-gvfs-maybe-open-connection
+ (make-tramp-file-name
+ :method method :user user :domain domain
+ :host host :port port :localname "/" :hop hop)))
+ (setq localname
+ (replace-match
+ (tramp-get-connection-property v "default-location" "~")
+ nil t localname 1)))
+ ;; Tilde expansion is not possible.
+ (when (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
+ (tramp-error
+ v 'file-error
+ "Cannot expand tilde in file `%s'" name))
+ (unless (tramp-run-real-handler #'file-name-absolute-p (list localname))
+ (setq localname (concat "/" localname)))
+ ;; We do not pass "/..".
+ (if (string-match-p "^\\(afp\\|davs?\\|smb\\)$" method)
+ (when (string-match "^/[^/]+\\(/\\.\\./?\\)" localname)
+ (setq localname (replace-match "/" t t localname 1)))
+ (when (string-match "^/\\.\\./?" localname)
+ (setq localname (replace-match "/" t t localname))))
+ ;; There might be a double slash. Remove this.
+ (while (string-match "//" localname)
+ (setq localname (replace-match "/" t t localname)))
+ ;; No tilde characters in file name, do normal
+ ;; `expand-file-name' (this does "/./" and "/../").
+ (tramp-make-tramp-file-name
+ v (tramp-run-real-handler #'expand-file-name (list localname))))))
+
+(defun tramp-gvfs-get-directory-attributes (directory)
+ "Return GVFS attributes association list of all files in DIRECTORY."
+ (ignore-errors
+ ;; Don't modify `last-coding-system-used' by accident.
+ (let ((last-coding-system-used last-coding-system-used)
+ result)
+ (with-parsed-tramp-file-name directory nil
+ (with-tramp-file-property v localname "directory-attributes"
+ (tramp-message v 5 "directory gvfs attributes: %s" localname)
+ ;; Send command.
+ (tramp-gvfs-send-command
+ v "gvfs-ls" "-h" "-n" "-a"
+ (mapconcat #'identity tramp-gvfs-file-attributes ",")
+ (tramp-gvfs-url-file-name directory))
+ ;; Parse output.
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (goto-char (point-min))
+ (while (looking-at
+ (concat "^\\(.+\\)[[:blank:]]"
+ "\\([[:digit:]]+\\)[[:blank:]]"
+ "(\\(.+?\\))"
+ tramp-gvfs-file-attributes-with-gvfs-ls-regexp))
+ (let ((item (list (cons "type" (match-string 3))
+ (cons "standard::size" (match-string 2))
+ (cons "name" (match-string 1)))))
+ (goto-char (1+ (match-end 3)))
+ (while (looking-at
+ (concat
+ tramp-gvfs-file-attributes-with-gvfs-ls-regexp
+ "\\(" tramp-gvfs-file-attributes-with-gvfs-ls-regexp
+ "\\|" "$" "\\)"))
+ (push (cons (match-string 1) (match-string 2)) item)
+ (goto-char (match-end 2)))
+ ;; Add display name as head.
+ (push
+ (cons (cdr (or (assoc "standard::display-name" item)
+ (assoc "name" item)))
+ (nreverse item))
+ result))
+ (forward-line)))
+ result)))))
+
+(defun tramp-gvfs-get-root-attributes (filename &optional file-system)
+ "Return GVFS attributes association list of FILENAME.
+If FILE-SYSTEM is non-nil, return file system attributes."
+ (ignore-errors
+ ;; Don't modify `last-coding-system-used' by accident.
+ (let ((last-coding-system-used last-coding-system-used)
+ result)
+ (with-parsed-tramp-file-name filename nil
+ (with-tramp-file-property
+ v localname
+ (if file-system "file-system-attributes" "file-attributes")
+ (tramp-message
+ v 5 "file%s gvfs attributes: %s"
+ (if file-system " system" "") localname)
+ ;; Send command.
+ (if file-system
+ (tramp-gvfs-send-command
+ v "gvfs-info" "--filesystem" (tramp-gvfs-url-file-name filename))
+ (tramp-gvfs-send-command
+ v "gvfs-info" (tramp-gvfs-url-file-name filename)))
+ ;; Parse output.
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (goto-char (point-min))
+ (while (re-search-forward
+ (if file-system
+ tramp-gvfs-file-system-attributes-regexp
+ tramp-gvfs-file-attributes-with-gvfs-info-regexp)
+ nil t)
+ (push (cons (match-string 1) (match-string 2)) result))
+ result))))))
+
+(defun tramp-gvfs-get-file-attributes (filename)
+ "Return GVFS attributes association list of FILENAME."
+ (setq filename (directory-file-name (expand-file-name filename)))
+ (with-parsed-tramp-file-name filename nil
+ (setq localname (tramp-compat-file-name-unquote localname))
+ (if (or (and (string-match-p "^\\(afp\\|davs?\\|smb\\)$" method)
+ (string-match-p "^/?\\([^/]+\\)$" localname))
+ (string-equal localname "/"))
+ (tramp-gvfs-get-root-attributes filename)
+ (assoc
+ (file-name-nondirectory filename)
+ (tramp-gvfs-get-directory-attributes (file-name-directory filename))))))
+
+(defun tramp-gvfs-handle-file-attributes (filename &optional id-format)
+ "Like `file-attributes' for Tramp files."
+ (unless id-format (setq id-format 'integer))
+ (ignore-errors
+ (let ((attributes (tramp-gvfs-get-file-attributes filename))
+ dirp res-symlink-target res-numlinks res-uid res-gid res-access
+ res-mod res-change res-size res-filemodes res-inode res-device)
+ (when attributes
+ ;; ... directory or symlink
+ (setq dirp (if (equal "directory" (cdr (assoc "type" attributes))) t))
+ (setq res-symlink-target
+ (cdr (assoc "standard::symlink-target" attributes)))
+ (when (stringp res-symlink-target)
+ (setq res-symlink-target
+ ;; Parse unibyte codes "\xNN". We assume they are
+ ;; non-ASCII codepoints in the range #x80 through #xff.
+ ;; Convert them to multibyte.
+ (decode-coding-string
+ (replace-regexp-in-string
+ "\\\\x\\([[:xdigit:]]\\{2\\}\\)"
+ (lambda (x)
+ (unibyte-string (string-to-number (match-string 1 x) 16)))
+ res-symlink-target)
+ 'utf-8)))
+ ;; ... number links
+ (setq res-numlinks
+ (string-to-number
+ (or (cdr (assoc "unix::nlink" attributes)) "0")))
+ ;; ... uid and gid
+ (setq res-uid
+ (if (eq id-format 'integer)
+ (string-to-number
+ (or (cdr (assoc "unix::uid" attributes))
+ (eval-when-compile
+ (format "%s" tramp-unknown-id-integer))))
+ (or (cdr (assoc "owner::user" attributes))
+ (cdr (assoc "unix::uid" attributes))
+ tramp-unknown-id-string)))
+ (setq res-gid
+ (if (eq id-format 'integer)
+ (string-to-number
+ (or (cdr (assoc "unix::gid" attributes))
+ (eval-when-compile
+ (format "%s" tramp-unknown-id-integer))))
+ (or (cdr (assoc "owner::group" attributes))
+ (cdr (assoc "unix::gid" attributes))
+ tramp-unknown-id-string)))
+ ;; ... last access, modification and change time
+ (setq res-access
+ (seconds-to-time
+ (string-to-number
+ (or (cdr (assoc "time::access" attributes)) "0"))))
+ (setq res-mod
+ (seconds-to-time
+ (string-to-number
+ (or (cdr (assoc "time::modified" attributes)) "0"))))
+ (setq res-change
+ (seconds-to-time
+ (string-to-number
+ (or (cdr (assoc "time::changed" attributes)) "0"))))
+ ;; ... size
+ (setq res-size
+ (string-to-number
+ (or (cdr (assoc "standard::size" attributes)) "0")))
+ ;; ... file mode flags
+ (setq res-filemodes
+ (let ((n (cdr (assoc "unix::mode" attributes))))
+ (if n
+ (tramp-file-mode-from-int (string-to-number n))
+ (format
+ "%s%s%s%s------"
+ (if dirp "d" (if res-symlink-target "l" "-"))
+ (if (equal (cdr (assoc "access::can-read" attributes))
+ "FALSE")
+ "-" "r")
+ (if (equal (cdr (assoc "access::can-write" attributes))
+ "FALSE")
+ "-" "w")
+ (if (equal (cdr (assoc "access::can-execute" attributes))
+ "FALSE")
+ "-" "x")))))
+ ;; ... inode and device
+ (setq res-inode
+ (let ((n (cdr (assoc "unix::inode" attributes))))
+ (if n
+ (string-to-number n)
+ (tramp-get-inode (tramp-dissect-file-name filename)))))
+ (setq res-device
+ (let ((n (cdr (assoc "unix::device" attributes))))
+ (if n
+ (string-to-number n)
+ (tramp-get-device (tramp-dissect-file-name filename)))))
+
+ ;; Return data gathered.
+ (list
+ ;; 0. t for directory, string (name linked to) for
+ ;; symbolic link, or nil.
+ (or dirp res-symlink-target)
+ ;; 1. Number of links to file.
+ res-numlinks
+ ;; 2. File uid.
+ res-uid
+ ;; 3. File gid.
+ res-gid
+ ;; 4. Last access time, as a list of integers.
+ ;; 5. Last modification time, likewise.
+ ;; 6. Last status change time, likewise.
+ res-access res-mod res-change
+ ;; 7. Size in bytes (-1, if number is out of range).
+ res-size
+ ;; 8. File modes.
+ res-filemodes
+ ;; 9. t if file's gid would change if file were deleted
+ ;; and recreated.
+ nil
+ ;; 10. Inode number.
+ res-inode
+ ;; 11. Device number.
+ res-device
+ )))))
+
+(defun tramp-gvfs-handle-file-executable-p (filename)
+ "Like `file-executable-p' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (with-tramp-file-property v localname "file-executable-p"
+ (and (file-exists-p filename)
+ (tramp-check-cached-permissions v ?x)))))
+
+(defun tramp-gvfs-handle-file-name-all-completions (filename directory)
+ "Like `file-name-all-completions' for Tramp files."
+ (unless (string-match-p "/" filename)
+ (all-completions
+ filename
+ (with-parsed-tramp-file-name (expand-file-name directory) nil
+ (with-tramp-file-property v localname "file-name-all-completions"
+ (let ((result '("./" "../")))
+ ;; Get a list of directories and files.
+ (dolist (item (tramp-gvfs-get-directory-attributes directory) result)
+ (if (string-equal (cdr (assoc "type" item)) "directory")
+ (push (file-name-as-directory (car item)) result)
+ (push (car item) result)))))))))
+
+(defun tramp-gvfs-handle-file-notify-add-watch (file-name flags _callback)
+ "Like `file-notify-add-watch' for Tramp files."
+ (setq file-name (expand-file-name file-name))
+ (with-parsed-tramp-file-name file-name nil
+ ;; TODO: We cannot watch directories, because `gio monitor' is not
+ ;; supported for gvfs-mounted directories. However,
+ ;; `file-notify-add-watch' uses directories.
+ (when (or (not (tramp-gvfs-gio-tool-p v)) (file-directory-p file-name))
+ (tramp-error
+ v 'file-notify-error "Monitoring not supported for `%s'" file-name))
+ (let* ((default-directory (file-name-directory file-name))
+ (events
+ (cond
+ ((and (memq 'change flags) (memq 'attribute-change flags))
+ '(created changed changes-done-hint moved deleted
+ attribute-changed))
+ ((memq 'change flags)
+ '(created changed changes-done-hint moved deleted))
+ ((memq 'attribute-change flags) '(attribute-changed))))
+ (p (apply
+ #'start-process
+ "gvfs-monitor" (generate-new-buffer " *gvfs-monitor*")
+ `("gio" "monitor" ,(tramp-gvfs-url-file-name file-name)))))
+ (if (not (processp p))
+ (tramp-error
+ v 'file-notify-error "Monitoring not supported for `%s'" file-name)
+ (tramp-message
+ v 6 "Run `%s', %S" (mapconcat #'identity (process-command p) " ") p)
+ (process-put p 'vector v)
+ (process-put p 'events events)
+ (process-put p 'watch-name localname)
+ (process-put p 'adjust-window-size-function #'ignore)
+ (set-process-query-on-exit-flag p nil)
+ (set-process-filter p #'tramp-gvfs-monitor-process-filter)
+ (set-process-sentinel p #'tramp-file-notify-process-sentinel)
+ ;; There might be an error if the monitor is not supported.
+ ;; Give the filter a chance to read the output.
+ (while (tramp-accept-process-output p 0))
+ (unless (process-live-p p)
+ (tramp-error
+ p 'file-notify-error "Monitoring not supported for `%s'" file-name))
+ p))))
+
+(defun tramp-gvfs-monitor-process-filter (proc string)
+ "Read output from \"gvfs-monitor-file\" and add corresponding \
+file-notify events."
+ (let* ((events (process-get proc 'events))
+ (rest-string (process-get proc 'rest-string))
+ (dd (with-current-buffer (process-buffer proc) default-directory))
+ (ddu (regexp-quote (tramp-gvfs-url-file-name dd))))
+ (when rest-string
+ (tramp-message proc 10 "Previous string:\n%s" rest-string))
+ (tramp-message proc 6 "%S\n%s" proc string)
+ (setq string (concat rest-string string)
+ ;; Fix action names.
+ string (replace-regexp-in-string
+ "attributes changed" "attribute-changed" string)
+ string (replace-regexp-in-string
+ "changes done" "changes-done-hint" string)
+ string (replace-regexp-in-string
+ "renamed to" "moved" string))
+ ;; https://bugs.launchpad.net/bugs/1742946
+ (when
+ (string-match-p "Monitoring not supported\\|No locations given" string)
+ (delete-process proc))
+
+ (while (string-match
+ (eval-when-compile
+ (concat "^.+:"
+ "[[:space:]]\\(.+\\):"
+ "[[:space:]]" (regexp-opt tramp-gio-events t)
+ "\\([[:space:]]\\(.+\\)\\)?$"))
+ string)
+
+ (let ((file (match-string 1 string))
+ (file1 (match-string 4 string))
+ (action (intern-soft (match-string 2 string))))
+ (setq string (replace-match "" nil nil string))
+ ;; File names are returned as URL paths. We must convert them.
+ (when (string-match ddu file)
+ (setq file (replace-match dd nil nil file)))
+ (while (string-match-p "%\\([0-9A-F]\\{2\\}\\)" file)
+ (setq file (url-unhex-string file)))
+ (when (string-match ddu (or file1 ""))
+ (setq file1 (replace-match dd nil nil file1)))
+ (while (string-match-p "%\\([0-9A-F]\\{2\\}\\)" (or file1 ""))
+ (setq file1 (url-unhex-string file1)))
+ ;; Remove watch when file or directory to be watched is deleted.
+ (when (and (member action '(moved deleted))
+ (string-equal file (process-get proc 'watch-name)))
+ (delete-process proc))
+ ;; Usually, we would add an Emacs event now. Unfortunately,
+ ;; `unread-command-events' does not accept several events at
+ ;; once. Therefore, we apply the callback directly.
+ (when (member action events)
+ (tramp-compat-funcall
+ 'file-notify-callback (list proc action file file1)))))
+
+ ;; Save rest of the string.
+ (when (zerop (length string)) (setq string nil))
+ (when string (tramp-message proc 10 "Rest string:\n%s" string))
+ (process-put proc 'rest-string string)))
+
+(defun tramp-gvfs-handle-file-readable-p (filename)
+ "Like `file-readable-p' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (with-tramp-file-property v localname "file-readable-p"
+ (and (file-exists-p filename)
+ (or (tramp-check-cached-permissions v ?r)
+ ;; If the user is different from what we guess to be
+ ;; the user, we don't know. Let's check, whether
+ ;; access is restricted explicitly.
+ (and (/= (tramp-gvfs-get-remote-uid v 'integer)
+ (tramp-compat-file-attribute-user-id
+ (file-attributes filename 'integer)))
+ (not
+ (string-equal
+ "FALSE"
+ (cdr (assoc
+ "access::can-read"
+ (tramp-gvfs-get-file-attributes filename)))))))))))
+
+(defun tramp-gvfs-handle-file-system-info (filename)
+ "Like `file-system-info' for Tramp files."
+ (setq filename (directory-file-name (expand-file-name filename)))
+ (with-parsed-tramp-file-name filename nil
+ ;; We don't use cached values.
+ (tramp-flush-file-property v localname "file-system-attributes")
+ (let* ((attr (tramp-gvfs-get-root-attributes filename 'file-system))
+ (size (cdr (assoc "filesystem::size" attr)))
+ (used (cdr (assoc "filesystem::used" attr)))
+ (free (cdr (assoc "filesystem::free" attr))))
+ (when (and (stringp size) (stringp used) (stringp free))
+ (list (string-to-number size)
+ (- (string-to-number size) (string-to-number used))
+ (string-to-number free))))))
+
+(defun tramp-gvfs-handle-make-directory (dir &optional parents)
+ "Like `make-directory' for Tramp files."
+ (setq dir (directory-file-name (expand-file-name dir)))
+ (with-parsed-tramp-file-name dir nil
+ (tramp-flush-file-properties v (file-name-directory localname))
+ (tramp-flush-directory-properties v localname)
+ (save-match-data
+ (let ((ldir (file-name-directory dir)))
+ ;; Make missing directory parts. "gvfs-mkdir -p ..." does not
+ ;; work robust.
+ (when (and parents (not (file-directory-p ldir)))
+ (make-directory ldir parents))
+ ;; Just do it.
+ (unless (or (tramp-gvfs-send-command
+ v "gvfs-mkdir" (tramp-gvfs-url-file-name dir))
+ (and parents (file-directory-p dir)))
+ (tramp-error v 'file-error "Couldn't make directory %s" dir))))))
+
+(defun tramp-gvfs-handle-rename-file
+ (filename newname &optional ok-if-already-exists)
+ "Like `rename-file' for Tramp files."
+ ;; Check if both files are local -- invoke normal rename-file.
+ ;; Otherwise, use Tramp from local system.
+ (setq filename (expand-file-name filename))
+ (setq newname (expand-file-name newname))
+ ;; At least one file a Tramp file?
+ (if (or (tramp-tramp-file-p filename)
+ (tramp-tramp-file-p newname))
+ (tramp-gvfs-do-copy-or-rename-file
+ 'rename filename newname ok-if-already-exists
+ 'keep-date 'preserve-uid-gid)
+ (tramp-run-real-handler
+ #'rename-file (list filename newname ok-if-already-exists))))
+
+
+;; File name conversions.
+
+(defun tramp-gvfs-url-file-name (filename)
+ "Return FILENAME in URL syntax."
+ ;; "/" must NOT be hexified.
+ (setq filename (tramp-compat-file-name-unquote filename))
+ (let ((url-unreserved-chars (cons ?/ url-unreserved-chars))
+ result)
+ (setq
+ result
+ (url-recreate-url
+ (if (tramp-tramp-file-p filename)
+ (with-parsed-tramp-file-name filename nil
+ (when (string-equal "gdrive" method)
+ (setq method "google-drive"))
+ (when (string-equal "nextcloud" method)
+ (setq method "davs"
+ localname
+ (concat (tramp-gvfs-get-remote-prefix v) localname)))
+ (when (and user domain)
+ (setq user (concat domain ";" user)))
+ (url-parse-make-urlobj
+ method (and user (url-hexify-string user))
+ nil (and host (url-hexify-string host))
+ (if (stringp port) (string-to-number port) port)
+ (and localname (url-hexify-string localname)) nil nil t))
+ (url-parse-make-urlobj
+ "file" nil nil nil nil
+ (url-hexify-string (file-truename filename)) nil nil t))))
+ (when (tramp-tramp-file-p filename)
+ (with-parsed-tramp-file-name filename nil
+ (tramp-message v 10 "remote file `%s' is URL `%s'" filename result)))
+ result))
+
+(defun tramp-gvfs-object-path (filename)
+ "Create a D-Bus object path from FILENAME."
+ (expand-file-name (dbus-escape-as-identifier filename)
tramp-gvfs-path-tramp))
+
+(defun tramp-gvfs-file-name (object-path)
+ "Retrieve file name from D-Bus OBJECT-PATH."
+ (dbus-unescape-from-identifier
+ (replace-regexp-in-string "^.*/\\([^/]+\\)$" "\\1" object-path)))
+
+
+;; D-Bus GVFS functions.
+
+(defun tramp-gvfs-handler-askpassword (message user domain flags)
+ "Implementation for the \"org.gtk.vfs.MountOperation.askPassword\" method."
+ (let* ((filename
+ (tramp-gvfs-file-name (dbus-event-path-name last-input-event)))
+ (pw-prompt
+ (format
+ "%s for %s "
+ (if (string-match "\\([pP]assword\\|[pP]assphrase\\)" message)
+ (capitalize (match-string 1 message))
+ "Password")
+ filename))
+ password)
+
+ (condition-case nil
+ (with-parsed-tramp-file-name filename l
+ (when (and (zerop (length user))
+ (not
+ (zerop (logand flags tramp-gvfs-password-need-username))))
+ (setq user (read-string "User name: ")))
+ (when (and (zerop (length domain))
+ (not
+ (zerop (logand flags tramp-gvfs-password-need-domain))))
+ (setq domain (read-string "Domain name: ")))
+
+ (tramp-message l 6 "%S %S %S %d" message user domain flags)
+ (unless (tramp-get-connection-property l "first-password-request" nil)
+ (tramp-clear-passwd l))
+
+ (setq password (tramp-read-passwd
+ (tramp-get-connection-process l) pw-prompt))
+
+ ;; Return result.
+ (if (stringp password)
+ (list
+ t ;; password handled.
+ nil ;; no abort of D-Bus.
+ password
+ (tramp-file-name-user l)
+ domain
+ nil ;; not anonymous.
+ 0) ;; no password save.
+ ;; No password provided.
+ (list nil t "" (tramp-file-name-user l) domain nil 0)))
+
+ ;; When QUIT is raised, we shall return this information to D-Bus.
+ (quit (list nil t "" "" "" nil 0)))))
+
+(defun tramp-gvfs-handler-askquestion (message choices)
+ "Implementation for the \"org.gtk.vfs.MountOperation.askQuestion\" method."
+ (save-window-excursion
+ (let ((enable-recursive-minibuffers t)
+ (use-dialog-box (and use-dialog-box (null noninteractive)))
+ result)
+
+ (with-parsed-tramp-file-name
+ (tramp-gvfs-file-name (dbus-event-path-name last-input-event)) nil
+ (tramp-message v 6 "%S %S" message choices)
+
+ (setq result
+ (condition-case nil
+ (list
+ t ;; handled.
+ nil ;; no abort of D-Bus.
+ (with-tramp-connection-property
+ (tramp-get-connection-process v) message
+ ;; In theory, there can be several choices.
+ ;; Until now, there is only the question whether
+ ;; to accept an unknown host signature or certificate.
+ (with-temp-buffer
+ ;; Preserve message for `progress-reporter'.
+ (with-temp-message ""
+ (insert message)
+ (goto-char (point-max))
+ (if noninteractive
+ (message "%s" message)
+ (pop-to-buffer (current-buffer)))
+ (if (yes-or-no-p
+ (concat
+ (buffer-substring
+ (line-beginning-position) (point))
+ " "))
+ 0 1)))))
+
+ ;; When QUIT is raised, we shall return this
+ ;; information to D-Bus.
+ (quit (list nil t 1))))
+
+ (tramp-message v 6 "%s" result)
+
+ ;; When the choice is "no", we set a dummy fuse-mountpoint in
+ ;; order to leave the timeout.
+ (unless (zerop (cl-caddr result))
+ (tramp-set-file-property v "/" "fuse-mountpoint" "/"))
+
+ result))))
+
+(defun tramp-gvfs-handler-mounted-unmounted (mount-info)
+ "Signal handler for the \"org.gtk.vfs.MountTracker.mounted\" and
+\"org.gtk.vfs.MountTracker.unmounted\" signals."
+ (ignore-errors
+ (let ((signal-name (dbus-event-member-name last-input-event))
+ (elt mount-info))
+ ;; Jump over the first elements of the mount info. Since there
+ ;; were changes in the entries, we cannot access dedicated
+ ;; elements.
+ (while (stringp (car elt)) (setq elt (cdr elt)))
+ (let* ((fuse-mountpoint (tramp-gvfs-dbus-byte-array-to-string (cadr
elt)))
+ (mount-spec (cl-caddr elt))
+ (prefix (tramp-gvfs-dbus-byte-array-to-string (car mount-spec)))
+ (default-location (tramp-gvfs-dbus-byte-array-to-string
+ (cl-cadddr elt)))
+ (method (tramp-gvfs-dbus-byte-array-to-string
+ (cadr (assoc "type" (cadr mount-spec)))))
+ (user (tramp-gvfs-dbus-byte-array-to-string
+ (cadr (assoc "user" (cadr mount-spec)))))
+ (domain (tramp-gvfs-dbus-byte-array-to-string
+ (cadr (assoc "domain" (cadr mount-spec)))))
+ (host (tramp-gvfs-dbus-byte-array-to-string
+ (cadr (or (assoc "host" (cadr mount-spec))
+ (assoc "server" (cadr mount-spec))))))
+ (port (tramp-gvfs-dbus-byte-array-to-string
+ (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))))))
+ (when (string-match "^\\(afp\\|smb\\)" method)
+ (setq method (match-string 1 method)))
+ (when (and (string-equal "dav" method) (string-equal "true" ssl))
+ (setq method "davs"))
+ (when (and (string-equal "davs" method)
+ (string-match-p
+ tramp-gvfs-nextcloud-default-prefix-regexp prefix))
+ (setq method "nextcloud"))
+ (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)))
+ (when (member method tramp-gvfs-methods)
+ (with-parsed-tramp-file-name
+ (tramp-make-tramp-file-name method user domain host port "") nil
+ (tramp-message
+ v 6 "%s %s"
+ signal-name (tramp-gvfs-stringify-dbus-message mount-info))
+ (tramp-flush-file-property v "/" "list-mounts")
+ (if (string-equal (downcase signal-name) "unmounted")
+ (tramp-flush-file-properties v "/")
+ ;; Set mountpoint and location.
+ (tramp-set-file-property v "/" "fuse-mountpoint" fuse-mountpoint)
+ (tramp-set-connection-property
+ v "default-location" default-location))))))))
+
+(when tramp-gvfs-enabled
+ (dbus-register-signal
+ :session nil tramp-gvfs-path-mounttracker
+ tramp-gvfs-interface-mounttracker "mounted"
+ #'tramp-gvfs-handler-mounted-unmounted)
+ (dbus-register-signal
+ :session nil tramp-gvfs-path-mounttracker
+ tramp-gvfs-interface-mounttracker "Mounted"
+ #'tramp-gvfs-handler-mounted-unmounted)
+
+ (dbus-register-signal
+ :session nil tramp-gvfs-path-mounttracker
+ tramp-gvfs-interface-mounttracker "unmounted"
+ #'tramp-gvfs-handler-mounted-unmounted)
+ (dbus-register-signal
+ :session nil tramp-gvfs-path-mounttracker
+ tramp-gvfs-interface-mounttracker "Unmounted"
+ #'tramp-gvfs-handler-mounted-unmounted))
+
+(defun tramp-gvfs-connection-mounted-p (vec)
+ "Check, whether the location is already mounted."
+ (or
+ (tramp-get-file-property vec "/" "fuse-mountpoint" nil)
+ (catch 'mounted
+ (dolist
+ (elt
+ (with-tramp-file-property vec "/" "list-mounts"
+ (with-tramp-dbus-call-method vec t
+ :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker
+ tramp-gvfs-interface-mounttracker tramp-gvfs-listmounts))
+ nil)
+ ;; Jump over the first elements of the mount info. Since there
+ ;; were changes in the entries, we cannot access dedicated
+ ;; elements.
+ (while (stringp (car elt)) (setq elt (cdr elt)))
+ (let* ((fuse-mountpoint (tramp-gvfs-dbus-byte-array-to-string
+ (cadr elt)))
+ (mount-spec (cl-caddr elt))
+ (prefix (tramp-gvfs-dbus-byte-array-to-string (car mount-spec)))
+ (default-location (tramp-gvfs-dbus-byte-array-to-string
+ (cl-cadddr elt)))
+ (method (tramp-gvfs-dbus-byte-array-to-string
+ (cadr (assoc "type" (cadr mount-spec)))))
+ (user (tramp-gvfs-dbus-byte-array-to-string
+ (cadr (assoc "user" (cadr mount-spec)))))
+ (domain (tramp-gvfs-dbus-byte-array-to-string
+ (cadr (assoc "domain" (cadr mount-spec)))))
+ (host (tramp-gvfs-dbus-byte-array-to-string
+ (cadr (or (assoc "host" (cadr mount-spec))
+ (assoc "server" (cadr mount-spec))))))
+ (port (tramp-gvfs-dbus-byte-array-to-string
+ (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)))))
+ (share (tramp-gvfs-dbus-byte-array-to-string
+ (or
+ (cadr (assoc "share" (cadr mount-spec)))
+ (cadr (assoc "volume" (cadr mount-spec)))))))
+ (when (string-match "^\\(afp\\|smb\\)" method)
+ (setq method (match-string 1 method)))
+ (when (and (string-equal "dav" method) (string-equal "true" ssl))
+ (setq method "davs"))
+ (when (and (string-equal "davs" method)
+ (string-match-p
+ tramp-gvfs-nextcloud-default-prefix-regexp prefix))
+ (setq method "nextcloud"))
+ (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)))
+ (when (and
+ (string-equal method (tramp-file-name-method vec))
+ (string-equal user (tramp-file-name-user vec))
+ (string-equal domain (tramp-file-name-domain vec))
+ (string-equal host (tramp-file-name-host vec))
+ (string-equal port (tramp-file-name-port vec))
+ (string-match-p (concat "^/" (regexp-quote (or share "")))
+ (tramp-file-name-unquote-localname vec)))
+ ;; Set mountpoint and location.
+ (tramp-set-file-property vec "/" "fuse-mountpoint" fuse-mountpoint)
+ (tramp-set-connection-property
+ vec "default-location" default-location)
+ (throw 'mounted t)))))))
+
+(defun tramp-gvfs-unmount (vec)
+ "Unmount the object identified by 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))))
+ (while (tramp-gvfs-connection-mounted-p vec)
+ (read-event nil nil 0.1))
+ (tramp-flush-connection-properties vec)
+ (tramp-flush-connection-properties (tramp-get-connection-process 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})\"."
+ (if (string-match-p "^(aya{sv})" tramp-gvfs-mountlocation-signature)
+ (list :dict-entry key
+ (list :variant (tramp-gvfs-dbus-string-to-byte-array value)))
+ (list :struct key (tramp-gvfs-dbus-string-to-byte-array value))))
+
+(defun tramp-gvfs-mount-spec (vec)
+ "Return a mount-spec for \"org.gtk.vfs.MountTracker.mountLocation\"."
+ (let* ((method (tramp-file-name-method vec))
+ (user (tramp-file-name-user vec))
+ (domain (tramp-file-name-domain vec))
+ (host (tramp-file-name-host vec))
+ (port (tramp-file-name-port vec))
+ (localname (tramp-file-name-unquote-localname vec))
+ (share (when (string-match "^/?\\([^/]+\\)" localname)
+ (match-string 1 localname)))
+ (ssl (if (string-match-p "^davs\\|^nextcloud" method) "true" "false"))
+ (mount-spec
+ `(:array
+ ,@(cond
+ ((string-equal "smb" method)
+ (list (tramp-gvfs-mount-spec-entry "type" "smb-share")
+ (tramp-gvfs-mount-spec-entry "server" host)
+ (tramp-gvfs-mount-spec-entry "share" share)))
+ ((string-match-p "^dav\\|^nextcloud" method)
+ (list (tramp-gvfs-mount-spec-entry "type" "dav")
+ (tramp-gvfs-mount-spec-entry "host" host)
+ (tramp-gvfs-mount-spec-entry "ssl" ssl)))
+ ((string-equal "afp" method)
+ (list (tramp-gvfs-mount-spec-entry "type" "afp-volume")
+ (tramp-gvfs-mount-spec-entry "host" host)
+ (tramp-gvfs-mount-spec-entry "volume" share)))
+ ((string-equal "gdrive" method)
+ (list (tramp-gvfs-mount-spec-entry "type" "google-drive")
+ (tramp-gvfs-mount-spec-entry "host" host)))
+ ((string-equal "nextcloud" method)
+ (list (tramp-gvfs-mount-spec-entry "type" "owncloud")
+ (tramp-gvfs-mount-spec-entry "host" host)))
+ ((string-match-p "^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
+ (list (tramp-gvfs-mount-spec-entry "user" user)))
+ ,@(when domain
+ (list (tramp-gvfs-mount-spec-entry "domain" domain)))
+ ,@(when port
+ (list (tramp-gvfs-mount-spec-entry "port" port)))))
+ (mount-pref
+ (if (and (string-match-p "^dav" method)
+ (string-match "^/?[^/]+" localname))
+ (match-string 0 localname)
+ (tramp-gvfs-get-remote-prefix vec))))
+
+ ;; Return.
+ `(:struct ,(tramp-gvfs-dbus-string-to-byte-array mount-pref) ,mount-spec)))
+
+
+;; Connection functions.
+
+(defun tramp-gvfs-get-remote-uid (vec id-format)
+ "The uid of the remote connection VEC, in ID-FORMAT.
+ID-FORMAT valid values are `string' and `integer'."
+ (with-tramp-connection-property vec (format "uid-%s" id-format)
+ (let ((user (tramp-file-name-user vec))
+ (localname
+ (tramp-get-connection-property vec "default-location" nil)))
+ (cond
+ ((and (equal id-format 'string) user))
+ (localname
+ (tramp-compat-file-attribute-user-id
+ (file-attributes
+ (tramp-make-tramp-file-name vec localname) id-format)))
+ ((equal id-format 'integer) tramp-unknown-id-integer)
+ ((equal id-format 'string) tramp-unknown-id-string)))))
+
+(defun tramp-gvfs-get-remote-gid (vec id-format)
+ "The gid of the remote connection VEC, in ID-FORMAT.
+ID-FORMAT valid values are `string' and `integer'."
+ (with-tramp-connection-property vec (format "gid-%s" id-format)
+ (let ((localname
+ (tramp-get-connection-property vec "default-location" nil)))
+ (cond
+ (localname
+ (tramp-compat-file-attribute-group-id
+ (file-attributes
+ (tramp-make-tramp-file-name vec localname) id-format)))
+ ((equal id-format 'integer) tramp-unknown-id-integer)
+ ((equal id-format 'string) tramp-unknown-id-string)))))
+
+(defvar tramp-gvfs-get-remote-uid-gid-in-progress nil
+ "Indication, that remote uid and gid determination is in progress.")
+
+(defun tramp-gvfs-get-remote-prefix (vec)
+ "The prefix of the remote connection VEC.
+This is relevant for GNOME Online Accounts."
+ (with-tramp-connection-property vec "prefix"
+ ;; Ensure that GNOME Online Accounts are cached.
+ (when (member (tramp-file-name-method vec) tramp-goa-methods)
+ (tramp-get-goa-accounts vec))
+ (tramp-get-connection-property
+ (make-tramp-goa-name
+ :method (tramp-file-name-method vec)
+ :user (tramp-file-name-user vec)
+ :host (tramp-file-name-host vec)
+ :port (tramp-file-name-port vec))
+ "prefix" "/")))
+
+(defun tramp-gvfs-maybe-open-connection (vec)
+ "Maybe open a connection VEC.
+Does not do anything if a connection is already open, but re-opens the
+connection if a previous connection has died for some reason."
+ ;; We set the file name, in case there are incoming D-Bus signals or
+ ;; D-Bus errors.
+ (setq tramp-gvfs-dbus-event-vector vec)
+
+ ;; For password handling, we need a process bound to the connection
+ ;; buffer. Therefore, we create a dummy process. Maybe there is a
+ ;; better solution?
+ (unless (get-buffer-process (tramp-get-connection-buffer vec))
+ (let ((p (make-network-process
+ :name (tramp-buffer-name vec)
+ :buffer (tramp-get-connection-buffer vec)
+ :server t :host 'local :service t :noquery t)))
+ (process-put p 'vector vec)
+ (set-process-query-on-exit-flag p nil)))
+
+ (unless (tramp-gvfs-connection-mounted-p vec)
+ (let ((method (tramp-file-name-method vec))
+ (user (tramp-file-name-user vec))
+ (host (tramp-file-name-host vec))
+ (localname (tramp-file-name-unquote-localname vec))
+ (object-path
+ (tramp-gvfs-object-path (tramp-make-tramp-file-name vec 'noloc))))
+
+ (when (and (string-equal method "afp")
+ (string-equal localname "/"))
+ (tramp-error vec 'file-error "Filename must contain an AFP volume"))
+
+ (when (and (string-match-p "davs?" method)
+ (string-equal localname "/"))
+ (tramp-error vec 'file-error "Filename must contain a WebDAV share"))
+
+ (when (and (string-equal method "smb")
+ (string-equal localname "/"))
+ (tramp-error vec 'file-error "Filename must contain a Windows share"))
+
+ (with-tramp-progress-reporter
+ vec 3
+ (if (zerop (length user))
+ (format "Opening connection for %s using %s" host method)
+ (format "Opening connection for address@hidden using %s" user host
method))
+
+ ;; Enable `auth-source'.
+ (tramp-set-connection-property
+ vec "first-password-request" tramp-cache-read-persistent-data)
+
+ ;; There will be a callback of "askPassword" when a password is needed.
+ (dbus-register-method
+ :session dbus-service-emacs object-path
+ tramp-gvfs-interface-mountoperation "askPassword"
+ #'tramp-gvfs-handler-askpassword)
+ (dbus-register-method
+ :session dbus-service-emacs object-path
+ tramp-gvfs-interface-mountoperation "AskPassword"
+ #'tramp-gvfs-handler-askpassword)
+
+ ;; There could be a callback of "askQuestion" when adding
+ ;; fingerprints or checking certificates.
+ (dbus-register-method
+ :session dbus-service-emacs object-path
+ tramp-gvfs-interface-mountoperation "askQuestion"
+ #'tramp-gvfs-handler-askquestion)
+ (dbus-register-method
+ :session dbus-service-emacs object-path
+ tramp-gvfs-interface-mountoperation "AskQuestion"
+ #'tramp-gvfs-handler-askquestion)
+
+ ;; The call must be asynchronously, because of the "askPassword"
+ ;; or "askQuestion" callbacks.
+ (if (string-match-p "(so)$" tramp-gvfs-mountlocation-signature)
+ (with-tramp-dbus-call-method vec nil
+ :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker
+ tramp-gvfs-interface-mounttracker tramp-gvfs-mountlocation
+ (tramp-gvfs-mount-spec vec)
+ `(:struct :string ,(dbus-get-unique-name :session)
+ :object-path ,object-path))
+ (with-tramp-dbus-call-method vec nil
+ :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker
+ tramp-gvfs-interface-mounttracker tramp-gvfs-mountlocation
+ (tramp-gvfs-mount-spec vec)
+ :string (dbus-get-unique-name :session) :object-path object-path))
+
+ ;; We must wait, until the mount is applied. This will be
+ ;; indicated by the "mounted" signal, i.e. the "fuse-mountpoint"
+ ;; file property.
+ (with-timeout
+ ((or (tramp-get-method-parameter vec 'tramp-connection-timeout)
+ tramp-connection-timeout)
+ (if (zerop (length (tramp-file-name-user vec)))
+ (tramp-error
+ vec 'file-error
+ "Timeout reached mounting %s using %s" host method)
+ (tramp-error
+ vec 'file-error
+ "Timeout reached mounting address@hidden using %s" user host
method)))
+ (while (not (tramp-get-file-property vec "/" "fuse-mountpoint" nil))
+ (read-event nil nil 0.1)))
+
+ ;; If `tramp-gvfs-handler-askquestion' has returned "No", it
+ ;; is marked with the fuse-mountpoint "/". We shall react.
+ (when (string-equal
+ (tramp-get-file-property vec "/" "fuse-mountpoint" "") "/")
+ (tramp-error vec 'file-error "FUSE mount denied"))
+
+ ;; Save the password.
+ (ignore-errors (funcall tramp-password-save-function))
+
+ ;; Set connection-local variables.
+ (tramp-set-connection-local-variables vec)
+
+ ;; Mark it as connected.
+ (tramp-set-connection-property
+ (tramp-get-connection-process vec) "connected" t))))
+
+ ;; In `tramp-check-cached-permissions', the connection properties
+ ;; "{uid,gid}-{integer,string}" are used. We set them to proper values.
+ (unless tramp-gvfs-get-remote-uid-gid-in-progress
+ (let ((tramp-gvfs-get-remote-uid-gid-in-progress t))
+ (tramp-gvfs-get-remote-uid vec 'integer)
+ (tramp-gvfs-get-remote-gid vec 'integer)
+ (tramp-gvfs-get-remote-uid vec 'string)
+ (tramp-gvfs-get-remote-gid vec 'string))))
+
+(defun tramp-gvfs-gio-tool-p (vec)
+ "Check, whether the gio tool is available."
+ (with-tramp-connection-property vec "gio-tool"
+ (zerop (tramp-call-process vec "gio" nil nil nil "version"))))
+
+(defun tramp-gvfs-send-command (vec command &rest args)
+ "Send the COMMAND with its ARGS to connection VEC.
+COMMAND is a command from the gvfs-* utilities. It is replaced
+by the corresponding gio tool call if available. `call-process'
+is applied, and it returns t if the return code is zero."
+ (let* ((locale (tramp-get-local-locale vec))
+ (process-environment
+ (append
+ `(,(format "LANG=%s" locale)
+ ,(format "LANGUAGE=%s" locale)
+ ,(format "LC_ALL=%s" locale))
+ process-environment)))
+ (when (tramp-gvfs-gio-tool-p vec)
+ ;; Use gio tool.
+ (setq args (cons (cdr (assoc command tramp-gvfs-gio-mapping)) args)
+ command "gio"))
+
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (tramp-gvfs-maybe-open-connection vec)
+ (erase-buffer)
+ (or (zerop (apply #'tramp-call-process vec command nil t nil args))
+ ;; Remove information about mounted connection.
+ (and (tramp-flush-file-properties vec "/") nil)))))
+
+
+;; D-Bus GNOME Online Accounts functions.
+
+(defun tramp-get-goa-accounts (vec)
+ "Retrieve GNOME Online Accounts, and cache them.
+The hash key is a `tramp-goa-name' structure. The value is an
+alist of the properties of `tramp-goa-interface-account' and
+`tramp-goa-interface-files' of the corresponding GNOME online
+account. Additionally, a property \"prefix\" is added.
+VEC is used only for traces."
+ (dolist
+ (object-path
+ (mapcar
+ #'car
+ (tramp-dbus-function
+ vec #'dbus-get-all-managed-objects
+ `(:session ,tramp-goa-service ,tramp-goa-path))))
+ (let* ((account-properties
+ (with-tramp-dbus-get-all-properties vec
+ :session tramp-goa-service object-path
+ tramp-goa-interface-account))
+ (files-properties
+ (with-tramp-dbus-get-all-properties vec
+ :session tramp-goa-service object-path
+ tramp-goa-interface-files))
+ (identity
+ (or (cdr (assoc "PresentationIdentity" account-properties)) ""))
+ key)
+ ;; Only accounts which matter.
+ (when (and
+ (not (cdr (assoc "FilesDisabled" account-properties)))
+ (member
+ (cdr (assoc "ProviderType" account-properties))
+ '("google" "owncloud"))
+ (string-match tramp-goa-identity-regexp identity))
+ (setq key (make-tramp-goa-name
+ :method (cdr (assoc "ProviderType" account-properties))
+ :user (match-string 1 identity)
+ :host (match-string 2 identity)
+ :port (match-string 3 identity)))
+ (when (string-equal (tramp-goa-name-method key) "google")
+ (setf (tramp-goa-name-method key) "gdrive"))
+ (when (string-equal (tramp-goa-name-method key) "owncloud")
+ (setf (tramp-goa-name-method key) "nextcloud"))
+ ;; Cache all properties.
+ (dolist (prop (nconc account-properties files-properties))
+ (tramp-set-connection-property key (car prop) (cdr prop)))
+ ;; Cache "prefix".
+ (tramp-message
+ vec 10 "%s prefix %s" key
+ (tramp-set-connection-property
+ key "prefix"
+ (directory-file-name
+ (url-filename
+ (url-generic-parse-url
+ (tramp-get-connection-property key "Uri" "file:///"))))))))))
+
+
+;; D-Bus zeroconf functions.
+
+(defun tramp-zeroconf-parse-device-names (service)
+ "Return a list of (user host) tuples allowed to access."
+ (mapcar
+ (lambda (x)
+ (let ((host (zeroconf-service-host x))
+ (port (zeroconf-service-port x))
+ (text (zeroconf-service-txt x))
+ user)
+ (when port
+ (setq host (format "%s%s%d" host tramp-prefix-port-regexp port)))
+ ;; A user is marked in a TXT field like "u=guest".
+ (while text
+ (when (string-match "u=\\(.+\\)$" (car text))
+ (setq user (match-string 1 (car text))))
+ (setq text (cdr text)))
+ (list user host)))
+ (zeroconf-list-services service)))
+
+;; We use the TRIM argument of `split-string', which exist since Emacs
+;; 24.4. I mask this for older Emacs versions, there is no harm.
+(defun tramp-gvfs-parse-device-names (service)
+ "Return a list of (user host) tuples allowed to access.
+This uses \"avahi-browse\" in case D-Bus is not enabled in Avahi."
+ (let ((result
+ (ignore-errors
+ (tramp-compat-funcall
+ 'split-string
+ (shell-command-to-string (format "avahi-browse -trkp %s" service))
+ "[\n\r]+" 'omit "^\\+;.*$"))))
+ (delete-dups
+ (mapcar
+ (lambda (x)
+ (let* ((list (split-string x ";"))
+ (host (nth 6 list))
+ (text (tramp-compat-funcall
+ 'split-string (nth 9 list) "\" \"" 'omit "\""))
+ user)
+ ;; A user is marked in a TXT field like "u=guest".
+ (while text
+ (when (string-match "u=\\(.+\\)$" (car text))
+ (setq user (match-string 1 (car text))))
+ (setq text (cdr text)))
+ (list user host)))
+ result))))
+
+;; Add completion functions for AFP, DAV, DAVS, SFTP and SMB methods.
+(when tramp-gvfs-enabled
+ ;; Suppress D-Bus error messages.
+ (let (tramp-gvfs-dbus-event-vector)
+ (zeroconf-init tramp-gvfs-zeroconf-domain)
+ (if (zeroconf-list-service-types)
+ (progn
+ (tramp-set-completion-function
+ "afp" '((tramp-zeroconf-parse-device-names "_afpovertcp._tcp")))
+ (tramp-set-completion-function
+ "dav" '((tramp-zeroconf-parse-device-names "_webdav._tcp")))
+ (tramp-set-completion-function
+ "davs" '((tramp-zeroconf-parse-device-names "_webdav._tcp")))
+ (tramp-set-completion-function
+ "sftp" '((tramp-zeroconf-parse-device-names "_ssh._tcp")
+ (tramp-zeroconf-parse-device-names "_workstation._tcp")))
+ (when (member "smb" tramp-gvfs-methods)
+ (tramp-set-completion-function
+ "smb" '((tramp-zeroconf-parse-device-names "_smb._tcp")))))
+
+ (when (executable-find "avahi-browse")
+ (tramp-set-completion-function
+ "afp" '((tramp-gvfs-parse-device-names "_afpovertcp._tcp")))
+ (tramp-set-completion-function
+ "dav" '((tramp-gvfs-parse-device-names "_webdav._tcp")))
+ (tramp-set-completion-function
+ "davs" '((tramp-gvfs-parse-device-names "_webdav._tcp")))
+ (tramp-set-completion-function
+ "sftp" '((tramp-gvfs-parse-device-names "_ssh._tcp")
+ (tramp-gvfs-parse-device-names "_workstation._tcp")))
+ (when (member "smb" tramp-gvfs-methods)
+ (tramp-set-completion-function
+ "smb" '((tramp-gvfs-parse-device-names "_smb._tcp"))))))))
+
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (unload-feature 'tramp-gvfs 'force)))
+
+(provide 'tramp-gvfs)
+
+;;; TODO:
+
+;; * (Customizable) unmount when exiting Emacs. See tramp-archive.el.
+;;
+;; * Host name completion for existing mount points (afp-server,
+;; smb-server, google-drive, nextcloud) or via smb-network or network.
+;;
+;; * Check, how two shares of the same SMB server can be mounted in
+;; parallel.
+;;
+;; * What's up with ftps dns-sd afc admin computer?
+
+;;; tramp-gvfs.el ends here
diff --git a/tramp-integration.el b/tramp-integration.el
deleted file mode 120000
index a6d2e1c..0000000
--- a/tramp-integration.el
+++ /dev/null
@@ -1 +0,0 @@
-lisp/tramp-integration.el
\ No newline at end of file
diff --git a/tramp-integration.el b/tramp-integration.el
new file mode 100644
index 0000000..35d2eb3
--- /dev/null
+++ b/tramp-integration.el
@@ -0,0 +1,199 @@
+;;; tramp-integration.el --- Tramp integration into other packages -*-
lexical-binding:t -*-
+
+;; Copyright (C) 2019 Free Software Foundation, Inc.
+
+;; Author: Michael Albinus <address@hidden>
+;; 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:
+
+;; This assembles all integration of Tramp with other packages.
+
+;;; Code:
+
+(require 'tramp-compat)
+
+;; Pacify byte-compiler.
+(require 'cl-lib)
+(declare-function recentf-cleanup "recentf")
+(declare-function tramp-dissect-file-name "tramp")
+(declare-function tramp-file-name-equal-p "tramp")
+(declare-function tramp-tramp-file-p "tramp")
+(defvar eshell-path-env)
+(defvar recentf-exclude)
+(defvar tramp-current-connection)
+(defvar tramp-postfix-host-format)
+
+;;; Fontification of `read-file-name':
+
+(defvar tramp-rfn-eshadow-overlay)
+(make-variable-buffer-local 'tramp-rfn-eshadow-overlay)
+
+(defun tramp-rfn-eshadow-setup-minibuffer ()
+ "Set up a minibuffer for `file-name-shadow-mode'.
+Adds another overlay hiding filename parts according to Tramp's
+special handling of `substitute-in-file-name'."
+ (when minibuffer-completing-file-name
+ (setq tramp-rfn-eshadow-overlay
+ (make-overlay (minibuffer-prompt-end) (minibuffer-prompt-end)))
+ ;; Copy rfn-eshadow-overlay properties.
+ (let ((props (overlay-properties rfn-eshadow-overlay)))
+ (while props
+ ;; The `field' property prevents correct minibuffer
+ ;; completion; we exclude it.
+ (if (not (eq (car props) 'field))
+ (overlay-put tramp-rfn-eshadow-overlay (pop props) (pop props))
+ (pop props) (pop props))))))
+
+(add-hook 'rfn-eshadow-setup-minibuffer-hook
+ #'tramp-rfn-eshadow-setup-minibuffer)
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (remove-hook 'rfn-eshadow-setup-minibuffer-hook
+ #'tramp-rfn-eshadow-setup-minibuffer)))
+
+(defun tramp-rfn-eshadow-update-overlay-regexp ()
+ (format "[^%s/~]*\\(/\\|~\\)" tramp-postfix-host-format))
+
+;; Package rfn-eshadow is preloaded in Emacs, but for some reason,
+;; it only did (defvar rfn-eshadow-overlay) without giving it a global
+;; value, so it was only declared as dynamically-scoped within the
+;; rfn-eshadow.el file. This is now fixed in Emacs>26.1 but we still need
+;; this defvar here for older releases.
+(defvar rfn-eshadow-overlay)
+
+(defun tramp-rfn-eshadow-update-overlay ()
+ "Update `rfn-eshadow-overlay' to cover shadowed part of minibuffer input.
+This is intended to be used as a minibuffer `post-command-hook' for
+`file-name-shadow-mode'; the minibuffer should have already
+been set up by `rfn-eshadow-setup-minibuffer'."
+ ;; In remote files name, there is a shadowing just for the local part.
+ (ignore-errors
+ (let ((end (or (overlay-end rfn-eshadow-overlay)
+ (minibuffer-prompt-end)))
+ ;; We do not want to send any remote command.
+ (non-essential t))
+ (when (tramp-tramp-file-p (buffer-substring end (point-max)))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region
+ (1+ (or (string-match-p
+ (tramp-rfn-eshadow-update-overlay-regexp)
+ (buffer-string) end)
+ end))
+ (point-max))
+ (let ((rfn-eshadow-overlay tramp-rfn-eshadow-overlay)
+ (rfn-eshadow-update-overlay-hook nil)
+ file-name-handler-alist)
+ (move-overlay rfn-eshadow-overlay (point-max) (point-max))
+ (rfn-eshadow-update-overlay))))))))
+
+(add-hook 'rfn-eshadow-update-overlay-hook
+ #'tramp-rfn-eshadow-update-overlay)
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (remove-hook 'rfn-eshadow-update-overlay-hook
+ #'tramp-rfn-eshadow-update-overlay)))
+
+;;; Integration of eshell.el:
+
+;; eshell.el keeps the path in `eshell-path-env'. We must change it
+;; when `default-directory' points to another host.
+(defun tramp-eshell-directory-change ()
+ "Set `eshell-path-env' to $PATH of the host related to `default-directory'."
+ ;; Remove last element of `(exec-path)', which is `exec-directory'.
+ ;; Use `path-separator' as it does eshell.
+ (setq eshell-path-env
+ (mapconcat
+ #'identity (butlast (tramp-compat-exec-path)) path-separator)))
+
+(eval-after-load "esh-util"
+ '(progn
+ (add-hook 'eshell-mode-hook
+ #'tramp-eshell-directory-change)
+ (add-hook 'eshell-directory-change-hook
+ #'tramp-eshell-directory-change)
+ (add-hook 'tramp-integration-unload-hook
+ (lambda ()
+ (remove-hook 'eshell-mode-hook
+ #'tramp-eshell-directory-change)
+ (remove-hook 'eshell-directory-change-hook
+ #'tramp-eshell-directory-change)))))
+
+;;; Integration of recentf.el:
+
+(defun tramp-recentf-exclude-predicate (name)
+ "Predicate to exclude a remote file name from recentf.
+NAME must be equal to `tramp-current-connection'."
+ (when (file-remote-p name)
+ (tramp-file-name-equal-p
+ (tramp-dissect-file-name name) (car tramp-current-connection))))
+
+(defun tramp-recentf-cleanup (vec)
+ "Remove all file names related to VEC from recentf."
+ (when (bound-and-true-p recentf-list)
+ (let ((tramp-current-connection `(,vec))
+ (recentf-exclude '(tramp-recentf-exclude-predicate)))
+ (recentf-cleanup))))
+
+(defun tramp-recentf-cleanup-all ()
+ "Remove all remote file names from recentf."
+ (when (bound-and-true-p recentf-list)
+ (let ((recentf-exclude '(file-remote-p)))
+ (recentf-cleanup))))
+
+(eval-after-load "recentf"
+ '(progn
+ (add-hook 'tramp-cleanup-connection-hook
+ #'tramp-recentf-cleanup)
+ (add-hook 'tramp-cleanup-all-connections-hook
+ #'tramp-recentf-cleanup-all)
+ (add-hook 'tramp-integration-unload-hook
+ (lambda ()
+ (remove-hook 'tramp-cleanup-connection-hook
+ #'tramp-recentf-cleanup)
+ (remove-hook 'tramp-cleanup-all-connections-hook
+ #'tramp-recentf-cleanup-all)))))
+
+;;; Default connection-local variables for Tramp:
+
+(defconst tramp-connection-local-default-profile
+ '((shell-file-name . "/bin/sh")
+ (shell-command-switch . "-c"))
+ "Default connection-local variables for remote connections.")
+
+;; `connection-local-set-profile-variables' and
+;; `connection-local-set-profiles' exists since Emacs 26.1.
+(eval-after-load "shell"
+ '(progn
+ (tramp-compat-funcall
+ 'connection-local-set-profile-variables
+ 'tramp-connection-local-default-profile
+ tramp-connection-local-default-profile)
+ (tramp-compat-funcall
+ 'connection-local-set-profiles
+ `(:application tramp)
+ 'tramp-connection-local-default-profile)))
+
+(add-hook 'tramp-unload-hook
+ (lambda () (unload-feature 'tramp-integration 'force)))
+
+(provide 'tramp-integration)
+
+;;; tramp-integration.el ends here
diff --git a/tramp-loaddefs.el b/tramp-loaddefs.el
deleted file mode 120000
index 36f0abe..0000000
--- a/tramp-loaddefs.el
+++ /dev/null
@@ -1 +0,0 @@
-lisp/tramp-loaddefs.el
\ No newline at end of file
diff --git a/tramp-rclone.el b/tramp-rclone.el
deleted file mode 120000
index 233aa06..0000000
--- a/tramp-rclone.el
+++ /dev/null
@@ -1 +0,0 @@
-lisp/tramp-rclone.el
\ No newline at end of file
diff --git a/tramp-rclone.el b/tramp-rclone.el
new file mode 100644
index 0000000..0148116
--- /dev/null
+++ b/tramp-rclone.el
@@ -0,0 +1,608 @@
+;;; tramp-rclone.el --- Tramp access functions to cloud storages -*-
lexical-binding:t -*-
+
+;; Copyright (C) 2018-2019 Free Software Foundation, Inc.
+
+;; Author: Michael Albinus <address@hidden>
+;; 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:
+
+;; rclone is a command line program to sync files and directories to
+;; and from cloud storages. Tramp uses its mount utility to access
+;; files and directories there. The configuration of rclone for
+;; different storage systems is performed outside Tramp, see rclone(1).
+
+;; A remote file under rclone control has the form
+;; "/rclone:<remote>:/path/to/file". <remote> is the name of a
+;; storage system in rclone's configuration. Therefore, such a remote
+;; file name does not know of any user or port specification.
+
+;;; Code:
+
+(eval-when-compile (require 'cl-lib))
+(require 'tramp)
+
+;;;###tramp-autoload
+(defconst tramp-rclone-method "rclone"
+ "When this method name is used, forward all calls to rclone mounts.")
+
+(defcustom tramp-rclone-program "rclone"
+ "Name of the rclone program."
+ :group 'tramp
+ :version "27.1"
+ :type 'string)
+
+;;;###tramp-autoload
+(tramp--with-startup
+ (add-to-list 'tramp-methods
+ `(,tramp-rclone-method
+ (tramp-mount-args nil)
+ (tramp-copyto-args nil)
+ (tramp-moveto-args nil)
+ (tramp-about-args ("--full"))))
+
+ (add-to-list 'tramp-default-host-alist `(,tramp-rclone-method nil ""))
+
+ (tramp-set-completion-function
+ tramp-rclone-method '((tramp-rclone-parse-device-names ""))))
+
+
+;; New handlers should be added here.
+;;;###tramp-autoload
+(defconst tramp-rclone-file-name-handler-alist
+ '((access-file . tramp-handle-access-file)
+ (add-name-to-file . tramp-handle-add-name-to-file)
+ ;; `byte-compiler-base-file-name' performed by default handler.
+ ;; `copy-directory' performed by default handler.
+ (copy-file . tramp-rclone-handle-copy-file)
+ (delete-directory . tramp-rclone-handle-delete-directory)
+ (delete-file . tramp-rclone-handle-delete-file)
+ ;; `diff-latest-backup-file' performed by default handler.
+ (directory-file-name . tramp-handle-directory-file-name)
+ (directory-files . tramp-rclone-handle-directory-files)
+ (directory-files-and-attributes
+ . tramp-handle-directory-files-and-attributes)
+ (dired-compress-file . ignore)
+ (dired-uncache . tramp-handle-dired-uncache)
+ (exec-path . ignore)
+ (expand-file-name . tramp-handle-expand-file-name)
+ (file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
+ (file-acl . ignore)
+ (file-attributes . tramp-rclone-handle-file-attributes)
+ (file-directory-p . tramp-handle-file-directory-p)
+ (file-equal-p . tramp-handle-file-equal-p)
+ (file-executable-p . tramp-rclone-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-handle-file-local-copy)
+ (file-modes . tramp-handle-file-modes)
+ (file-name-all-completions . tramp-rclone-handle-file-name-all-completions)
+ (file-name-as-directory . tramp-handle-file-name-as-directory)
+ (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p)
+ (file-name-completion . tramp-handle-file-name-completion)
+ (file-name-directory . tramp-handle-file-name-directory)
+ (file-name-nondirectory . tramp-handle-file-name-nondirectory)
+ ;; `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-rclone-handle-file-readable-p)
+ (file-regular-p . tramp-handle-file-regular-p)
+ (file-remote-p . tramp-handle-file-remote-p)
+ (file-selinux-context . tramp-handle-file-selinux-context)
+ (file-symlink-p . tramp-handle-file-symlink-p)
+ (file-system-info . tramp-rclone-handle-file-system-info)
+ (file-truename . tramp-handle-file-truename)
+ (file-writable-p . tramp-handle-file-writable-p)
+ (find-backup-file-name . tramp-handle-find-backup-file-name)
+ ;; `get-file-buffer' performed by default handler.
+ (insert-directory . tramp-handle-insert-directory)
+ (insert-file-contents . tramp-handle-insert-file-contents)
+ (load . tramp-handle-load)
+ (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
+ (make-directory . tramp-rclone-handle-make-directory)
+ (make-directory-internal . ignore)
+ (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
+ (make-process . ignore)
+ (make-symbolic-link . tramp-handle-make-symbolic-link)
+ (process-file . ignore)
+ (rename-file . tramp-rclone-handle-rename-file)
+ (set-file-acl . ignore)
+ (set-file-modes . ignore)
+ (set-file-selinux-context . ignore)
+ (set-file-times . ignore)
+ (set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
+ (shell-command . ignore)
+ (start-file-process . ignore)
+ (substitute-in-file-name . tramp-handle-substitute-in-file-name)
+ (temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-set-file-uid-gid . ignore)
+ (unhandled-file-name-directory . ignore)
+ (vc-registered . ignore)
+ (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
+ (write-region . tramp-handle-write-region))
+ "Alist of handler functions for Tramp RCLONE method.
+Operations not mentioned here will be handled by the default Emacs
primitives.")
+
+;; It must be a `defsubst' in order to push the whole code into
+;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
+;;;###tramp-autoload
+(defsubst tramp-rclone-file-name-p (filename)
+ "Check if it's a filename for rclone."
+ (and (tramp-tramp-file-p filename)
+ (string= (tramp-file-name-method (tramp-dissect-file-name filename))
+ tramp-rclone-method)))
+
+;;;###tramp-autoload
+(defun tramp-rclone-file-name-handler (operation &rest args)
+ "Invoke the rclone handler for OPERATION.
+First arg specifies the OPERATION, second arg is a list of arguments to
+pass to the OPERATION."
+ (let ((fn (assoc operation tramp-rclone-file-name-handler-alist)))
+ (if fn
+ (save-match-data (apply (cdr fn) args))
+ (tramp-run-real-handler operation args))))
+
+;;;###tramp-autoload
+(tramp--with-startup
+ (tramp-register-foreign-file-name-handler
+ #'tramp-rclone-file-name-p #'tramp-rclone-file-name-handler))
+
+;;;###tramp-autoload
+(defun tramp-rclone-parse-device-names (_ignore)
+ "Return a list of (nil host) tuples allowed to access."
+ (with-tramp-connection-property nil "rclone-device-names"
+ (delq nil
+ (mapcar
+ (lambda (line)
+ (when (string-match "^\\(\\S-+\\):$" line)
+ `(nil ,(match-string 1 line))))
+ (tramp-process-lines nil tramp-rclone-program "listremotes")))))
+
+
+;; File name primitives.
+
+(defun tramp-rclone-do-copy-or-rename-file
+ (op filename newname &optional ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes)
+ "Copy or rename a remote file.
+OP must be `copy' or `rename' and indicates the operation to perform.
+FILENAME specifies the file to copy or rename, NEWNAME is the name of
+the new file (for copy) or the new name of the file (for rename).
+OK-IF-ALREADY-EXISTS means don't barf if NEWNAME exists already.
+KEEP-DATE means to make sure that NEWNAME has the same timestamp
+as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep
+the uid and gid if both files are on the same host.
+PRESERVE-EXTENDED-ATTRIBUTES is ignored.
+
+This function is invoked by `tramp-rclone-handle-copy-file' and
+`tramp-rclone-handle-rename-file'. It is an error if OP is neither
+of `copy' and `rename'. FILENAME and NEWNAME must be absolute
+file names."
+ (unless (memq op '(copy rename))
+ (error "Unknown operation `%s', must be `copy' or `rename'" op))
+
+ (setq filename (file-truename filename))
+ (if (file-directory-p filename)
+ (progn
+ (copy-directory filename newname keep-date t)
+ (when (eq op 'rename) (delete-directory filename 'recursive)))
+
+ (let ((t1 (tramp-tramp-file-p filename))
+ (t2 (tramp-tramp-file-p newname))
+ (rclone-operation (if (eq op 'copy) "copyto" "moveto"))
+ (msg-operation (if (eq op 'copy) "Copying" "Renaming")))
+
+ (with-parsed-tramp-file-name (if t1 filename newname) nil
+ (when (and (not ok-if-already-exists) (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+
+ (if (or (and t1 (not (tramp-rclone-file-name-p filename)))
+ (and t2 (not (tramp-rclone-file-name-p newname))))
+
+ ;; We cannot copy or rename directly.
+ (let ((tmpfile (tramp-compat-make-temp-file filename)))
+ (if (eq op 'copy)
+ (copy-file
+ filename tmpfile t keep-date preserve-uid-gid
+ preserve-extended-attributes)
+ (rename-file filename tmpfile t))
+ (rename-file tmpfile newname ok-if-already-exists))
+
+ ;; Direct action.
+ (with-tramp-progress-reporter
+ v 0 (format "%s %s to %s" msg-operation filename newname)
+ (unless (zerop
+ (tramp-rclone-send-command
+ v rclone-operation
+ (tramp-rclone-remote-file-name filename)
+ (tramp-rclone-remote-file-name newname)))
+ (tramp-error
+ v 'file-error
+ "Error %s `%s' `%s'" msg-operation filename newname)))
+
+ (when (and t1 (eq op 'rename))
+ (with-parsed-tramp-file-name filename v1
+ (tramp-flush-file-properties
+ v1 (file-name-directory v1-localname))
+ (tramp-flush-file-properties v1 v1-localname)
+ (when (tramp-rclone-file-name-p filename)
+ (tramp-rclone-flush-directory-cache v1)
+ ;; The mount point's directory cache might need time
+ ;; to flush.
+ (while (file-exists-p filename)
+ (tramp-flush-file-properties
+ v1 (file-name-directory v1-localname))
+ (tramp-flush-file-properties v1 v1-localname)))))
+
+ (when t2
+ (with-parsed-tramp-file-name newname v2
+ (tramp-flush-file-properties
+ v2 (file-name-directory v2-localname))
+ (tramp-flush-file-properties v2 v2-localname)
+ (when (tramp-rclone-file-name-p newname)
+ (tramp-rclone-flush-directory-cache v2)
+ ;; The mount point's directory cache might need time
+ ;; to flush.
+ (while (not (file-exists-p newname))
+ (tramp-flush-file-properties
+ v2 (file-name-directory v2-localname))
+ (tramp-flush-file-properties v2 v2-localname))))))))))
+
+(defun tramp-rclone-handle-copy-file
+ (filename newname &optional ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes)
+ "Like `copy-file' for Tramp files."
+ (setq filename (expand-file-name filename))
+ (setq newname (expand-file-name newname))
+ ;; At least one file a Tramp file?
+ (if (or (tramp-tramp-file-p filename)
+ (tramp-tramp-file-p newname))
+ (tramp-rclone-do-copy-or-rename-file
+ 'copy filename newname ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes)
+ (tramp-run-real-handler
+ #'copy-file
+ (list filename newname ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes))))
+
+(defun tramp-rclone-handle-delete-directory
+ (directory &optional recursive trash)
+ "Like `delete-directory' for Tramp files."
+ (with-parsed-tramp-file-name (expand-file-name directory) nil
+ (delete-directory (tramp-rclone-local-file-name directory) recursive trash)
+ (tramp-flush-file-properties v (file-name-directory localname))
+ (tramp-flush-directory-properties v localname)
+ (tramp-rclone-flush-directory-cache v)))
+
+(defun tramp-rclone-handle-delete-file (filename &optional trash)
+ "Like `delete-file' for Tramp files."
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (delete-file (tramp-rclone-local-file-name filename) trash)
+ (tramp-flush-file-properties v (file-name-directory localname))
+ (tramp-flush-file-properties v localname)
+ (tramp-rclone-flush-directory-cache v)))
+
+(defun tramp-rclone-handle-directory-files
+ (directory &optional full match nosort)
+ "Like `directory-files' for Tramp files."
+ (when (file-directory-p directory)
+ (setq directory (file-name-as-directory (expand-file-name directory)))
+ (with-parsed-tramp-file-name directory nil
+ (let ((result
+ (directory-files
+ (tramp-rclone-local-file-name directory) full match)))
+ ;; Massage the result.
+ (when full
+ (let ((local (concat "^" (regexp-quote (tramp-rclone-mount-point v))))
+ (remote (funcall (if (tramp-compat-file-name-quoted-p directory)
+ #'tramp-compat-file-name-quote #'identity)
+ (file-remote-p directory))))
+ (setq result
+ (mapcar
+ (lambda (x) (replace-regexp-in-string local remote x))
+ result))))
+ ;; Some storage systems do not return "." and "..".
+ (dolist (item '(".." "."))
+ (when (and (string-match-p (or match (regexp-quote item)) item)
+ (not
+ (member (if full (setq item (concat directory item)) item)
+ result)))
+ (setq result (cons item result))))
+ ;; Return result.
+ (if nosort result (sort result #'string<))))))
+
+(defun tramp-rclone-handle-file-attributes (filename &optional id-format)
+ "Like `file-attributes' for Tramp files."
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (with-tramp-file-property
+ v localname (format "file-attributes-%s" id-format)
+ (file-attributes (tramp-rclone-local-file-name filename) id-format))))
+
+(defun tramp-rclone-handle-file-executable-p (filename)
+ "Like `file-executable-p' for Tramp files."
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (with-tramp-file-property v localname "file-executable-p"
+ (file-executable-p (tramp-rclone-local-file-name filename)))))
+
+(defun tramp-rclone-handle-file-name-all-completions (filename directory)
+ "Like `file-name-all-completions' for Tramp files."
+ (all-completions
+ filename
+ (delete-dups
+ (append
+ (file-name-all-completions
+ filename (tramp-rclone-local-file-name directory))
+ ;; Some storage systems do not return "." and "..".
+ (let (result)
+ (dolist (item '(".." ".") result)
+ (when (string-prefix-p filename item)
+ (catch 'match
+ (dolist (elt completion-regexp-list)
+ (unless (string-match-p elt item) (throw 'match nil)))
+ (setq result (cons (concat item "/") result))))))))))
+
+(defun tramp-rclone-handle-file-readable-p (filename)
+ "Like `file-readable-p' for Tramp files."
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (with-tramp-file-property v localname "file-readable-p"
+ (file-readable-p (tramp-rclone-local-file-name filename)))))
+
+(defun tramp-rclone-handle-file-system-info (filename)
+ "Like `file-system-info' for Tramp files."
+ (ignore-errors
+ (unless (file-directory-p filename)
+ (setq filename (file-name-directory filename)))
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (tramp-message v 5 "file system info: %s" localname)
+ (tramp-rclone-send-command v "about" (concat host ":"))
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (let (total used free)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (when (looking-at "Total: [[:space:]]+\\([[:digit:]]+\\)")
+ (setq total (string-to-number (match-string 1))))
+ (when (looking-at "Used: [[:space:]]+\\([[:digit:]]+\\)")
+ (setq used (string-to-number (match-string 1))))
+ (when (looking-at "Free: [[:space:]]+\\([[:digit:]]+\\)")
+ (setq free (string-to-number (match-string 1))))
+ (forward-line))
+ (when used
+ ;; The used number of bytes is not part of the result. As
+ ;; side effect, we store it as file property.
+ (tramp-set-file-property v localname "used-bytes" used))
+ ;; Result.
+ (when (and total free)
+ (list total free (- total free))))))))
+
+(defun tramp-rclone-handle-insert-directory
+ (filename switches &optional wildcard full-directory-p)
+ "Like `insert-directory' for Tramp files."
+ (insert-directory
+ (tramp-rclone-local-file-name filename) switches wildcard full-directory-p)
+ (goto-char (point-min))
+ (while (search-forward (tramp-rclone-local-file-name filename) nil 'noerror)
+ (replace-match filename)))
+
+(defun tramp-rclone-handle-insert-file-contents
+ (filename &optional visit beg end replace)
+ "Like `insert-file-contents' for Tramp files."
+ (let ((result
+ (insert-file-contents
+ (tramp-rclone-local-file-name filename) visit beg end replace)))
+ (prog1
+ (list (expand-file-name filename) (cadr result))
+ (when visit (setq buffer-file-name filename)))))
+
+(defun tramp-rclone-handle-make-directory (dir &optional parents)
+ "Like `make-directory' for Tramp files."
+ (with-parsed-tramp-file-name (expand-file-name dir) nil
+ (make-directory (tramp-rclone-local-file-name dir) parents)
+ ;; When PARENTS is non-nil, DIR could be a chain of non-existent
+ ;; directories a/b/c/... Instead of checking, we simply flush the
+ ;; whole file cache.
+ (tramp-flush-file-properties v localname)
+ (tramp-flush-directory-properties
+ v (if parents "/" (file-name-directory localname)))
+ (tramp-rclone-flush-directory-cache v)))
+
+(defun tramp-rclone-handle-rename-file
+ (filename newname &optional ok-if-already-exists)
+ "Like `rename-file' for Tramp files."
+ (setq filename (expand-file-name filename))
+ (setq newname (expand-file-name newname))
+ ;; At least one file a Tramp file?
+ (if (or (tramp-tramp-file-p filename)
+ (tramp-tramp-file-p newname))
+ (tramp-rclone-do-copy-or-rename-file
+ 'rename filename newname ok-if-already-exists
+ 'keep-date 'preserve-uid-gid)
+ (tramp-run-real-handler
+ #'rename-file (list filename newname ok-if-already-exists))))
+
+
+;; File name conversions.
+
+(defun tramp-rclone-mount-point (vec)
+ "Return local mount point of VEC."
+ (expand-file-name
+ (concat
+ tramp-temp-name-prefix (tramp-file-name-method vec)
+ "." (tramp-file-name-host vec))
+ (tramp-compat-temporary-file-directory)))
+
+(defun tramp-rclone-mounted-p (vec)
+ "Check, whether storage system determined by VEC is mounted."
+ (when (tramp-get-connection-process vec)
+ ;; We cannot use `with-connection-property', because we don't want
+ ;; to cache a nil result.
+ (or (tramp-get-connection-property
+ (tramp-get-connection-process vec) "mounted" nil)
+ (let* ((default-directory temporary-file-directory)
+ (mount (shell-command-to-string "mount -t fuse.rclone")))
+ (tramp-message vec 6 "%s" "mount -t fuse.rclone")
+ (tramp-message vec 6 "\n%s" mount)
+ (tramp-set-connection-property
+ (tramp-get-connection-process vec) "mounted"
+ (when (string-match
+ (format
+ "^\\(%s:\\S-*\\)" (regexp-quote (tramp-file-name-host vec)))
+ mount)
+ (match-string 1 mount)))))))
+
+(defun tramp-rclone-flush-directory-cache (vec)
+ "Flush directory cache of VEC mount."
+ (let ((rclone-pid
+ ;; Identify rclone process.
+ (when (tramp-get-connection-process vec)
+ (with-tramp-connection-property
+ (tramp-get-connection-process vec) "rclone-pid"
+ (catch 'pid
+ (dolist (pid (list-system-processes)) ;; "pidof rclone" ?
+ (and (string-match-p
+ (regexp-quote
+ (format "rclone mount %s:" (tramp-file-name-host vec)))
+ (or (cdr (assoc 'args (process-attributes pid))) ""))
+ (throw 'pid pid))))))))
+ ;; Send a SIGHUP in order to flush directory cache.
+ (when rclone-pid
+ (tramp-message
+ vec 6 "Send SIGHUP %d: %s"
+ rclone-pid (cdr (assoc 'args (process-attributes rclone-pid))))
+ (signal-process rclone-pid 'SIGHUP))))
+
+(defun tramp-rclone-local-file-name (filename)
+ "Return local mount name of FILENAME."
+ (setq filename (tramp-compat-file-name-unquote (expand-file-name filename)))
+ (with-parsed-tramp-file-name filename nil
+ ;; As long as we call `tramp-rclone-maybe-open-connection' here,
+ ;; we cache the result.
+ (with-tramp-file-property v localname "local-file-name"
+ (tramp-rclone-maybe-open-connection v)
+ (let ((quoted (tramp-compat-file-name-quoted-p localname))
+ (localname (tramp-compat-file-name-unquote localname)))
+ (funcall
+ (if quoted #'tramp-compat-file-name-quote #'identity)
+ (expand-file-name
+ (if (file-name-absolute-p localname)
+ (substring localname 1) localname)
+ (tramp-rclone-mount-point v)))))))
+
+(defun tramp-rclone-remote-file-name (filename)
+ "Return FILENAME as used in the `rclone' command."
+ (setq filename (tramp-compat-file-name-unquote (expand-file-name filename)))
+ (if (tramp-rclone-file-name-p filename)
+ (with-parsed-tramp-file-name filename nil
+ ;; As long as we call `tramp-rclone-maybe-open-connection' here,
+ ;; we cache the result.
+ (with-tramp-file-property v localname "remote-file-name"
+ (tramp-rclone-maybe-open-connection v)
+ ;; TODO: This shall be handled by `expand-file-name'.
+ (setq localname
+ (replace-regexp-in-string "^\\." "" (or localname "")))
+ (format "%s%s" (tramp-rclone-mounted-p v) localname)))
+ ;; It is a local file name.
+ filename))
+
+(defun tramp-rclone-maybe-open-connection (vec)
+ "Maybe open a connection VEC.
+Does not do anything if a connection is already open, but re-opens the
+connection if a previous connection has died for some reason."
+ (let ((host (tramp-file-name-host vec)))
+ (when (rassoc `(,host) (tramp-rclone-parse-device-names nil))
+ (if (zerop (length host))
+ (tramp-error vec 'file-error "Storage %s not connected" host))
+
+ ;; During completion, don't reopen a new connection. We check
+ ;; this for the process related to `tramp-buffer-name';
+ ;; otherwise `start-file-process' wouldn't run ever when
+ ;; `non-essential' is non-nil.
+ (when (and (tramp-completion-mode-p)
+ (null (get-process (tramp-buffer-name vec))))
+ (throw 'non-essential 'non-essential))
+
+ ;; We need a process bound to the connection buffer. Therefore,
+ ;; we create a dummy process. Maybe there is a better solution?
+ (unless (get-buffer-process (tramp-get-connection-buffer vec))
+ (let ((p (make-network-process
+ :name (tramp-buffer-name vec)
+ :buffer (tramp-get-connection-buffer vec)
+ :server t :host 'local :service t :noquery t)))
+ (process-put p 'vector vec)
+ (set-process-query-on-exit-flag p nil)
+
+ ;; Set connection-local variables.
+ (tramp-set-connection-local-variables vec)))
+
+ ;; Create directory.
+ (unless (file-directory-p (tramp-rclone-mount-point vec))
+ (make-directory (tramp-rclone-mount-point vec) 'parents))
+
+ ;; Mount. This command does not return, so we use 0 as
+ ;; DESTINATION of `tramp-call-process'.
+ (unless (tramp-rclone-mounted-p vec)
+ (apply
+ #'tramp-call-process
+ vec tramp-rclone-program nil 0 nil
+ (delq nil
+ `("mount" ,(concat host ":/")
+ ,(tramp-rclone-mount-point vec)
+ ;; This could be nil.
+ ,(tramp-get-method-parameter vec 'tramp-mount-args))))
+ (while (not (file-exists-p (tramp-make-tramp-file-name vec 'localname)))
+ (tramp-cleanup-connection vec 'keep-debug 'keep-password))
+
+ ;; Mark it as connected.
+ (tramp-set-connection-property
+ (tramp-get-connection-process vec) "connected" t))))
+
+ ;; In `tramp-check-cached-permissions', the connection properties
+ ;; "{uid,gid}-{integer,string}" are used. We set them to proper values.
+ (with-tramp-connection-property
+ vec "uid-integer" (tramp-get-local-uid 'integer))
+ (with-tramp-connection-property
+ vec "gid-integer" (tramp-get-local-gid 'integer))
+ (with-tramp-connection-property
+ vec "uid-string" (tramp-get-local-uid 'string))
+ (with-tramp-connection-property
+ vec "gid-string" (tramp-get-local-gid 'string)))
+
+(defun tramp-rclone-send-command (vec &rest args)
+ "Send the COMMAND to connection VEC."
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (erase-buffer)
+ (let ((flags (tramp-get-method-parameter
+ vec (intern (format "tramp-%s-args" (car args))))))
+ (apply #'tramp-call-process
+ vec tramp-rclone-program nil t nil (append args flags)))))
+
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (unload-feature 'tramp-rclone 'force)))
+
+(provide 'tramp-rclone)
+
+;;; TODO:
+
+;; * If possible, get rid of "rclone mount". Maybe it is more
+;; performant then.
+
+;;; tramp-rclone.el ends here
diff --git a/tramp-sh.el b/tramp-sh.el
deleted file mode 120000
index e6a0c21..0000000
--- a/tramp-sh.el
+++ /dev/null
@@ -1 +0,0 @@
-lisp/tramp-sh.el
\ No newline at end of file
diff --git a/tramp-sh.el b/tramp-sh.el
new file mode 100644
index 0000000..11b1af8
--- /dev/null
+++ b/tramp-sh.el
@@ -0,0 +1,5965 @@
+;;; tramp-sh.el --- Tramp access functions for (s)sh-like connections -*-
lexical-binding:t -*-
+
+;; Copyright (C) 1998-2019 Free Software Foundation, Inc.
+
+;; (copyright statements below in code to be updated with the above notice)
+
+;; Author: Kai Großjohann <address@hidden>
+;; Michael Albinus <address@hidden>
+;; Maintainer: Michael Albinus <address@hidden>
+;; 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/>.
+
+;;; Code:
+
+(eval-when-compile (require 'cl-lib))
+(require 'tramp)
+
+(declare-function dired-remove-file "dired-aux")
+(defvar dired-compress-file-suffixes)
+(defvar vc-handled-backends)
+(defvar vc-bzr-program)
+(defvar vc-git-program)
+(defvar vc-hg-program)
+
+(defcustom tramp-inline-compress-start-size 4096
+ "The minimum size of compressing where inline transfer.
+When inline transfer, compress transferred data of file
+whose size is this value or above (up to `tramp-copy-size-limit').
+If it is nil, no compression at all will be applied."
+ :group 'tramp
+ :type '(choice (const nil) integer))
+
+(defcustom tramp-copy-size-limit 10240
+ "The maximum file size where inline copying is preferred over an \
+out-of-the-band copy.
+If it is nil, out-of-the-band copy will be used without a check."
+ :group 'tramp
+ :type '(choice (const nil) integer))
+
+;;;###tramp-autoload
+(defcustom tramp-terminal-type "dumb"
+ "Value of TERM environment variable for logging in to remote host.
+Because Tramp wants to parse the output of the remote shell, it is easily
+confused by ANSI color escape sequences and suchlike. Often, shell init
+files conditionalize this setup based on the TERM environment variable."
+ :group 'tramp
+ :type 'string)
+
+(defcustom tramp-histfile-override "~/.tramp_history"
+ "When invoking a shell, override the HISTFILE with this value.
+When setting to a string, it redirects the shell history to that
+file. Be careful when setting to \"/dev/null\"; this might
+result in undesired results when using \"bash\" as shell.
+
+The value t unsets any setting of HISTFILE, and sets both
+HISTFILESIZE and HISTSIZE to 0. If you set this variable to nil,
+however, the *override* is disabled, so the history will go to
+the default storage location, e.g. \"$HOME/.sh_history\"."
+ :group 'tramp
+ :version "25.2"
+ :type '(choice (const :tag "Do not override HISTFILE" nil)
+ (const :tag "Unset HISTFILE" t)
+ (string :tag "Redirect to a file")))
+
+;;;###tramp-autoload
+(defconst tramp-display-escape-sequence-regexp "\e[[;0-9]+m"
+ "Terminal control escape sequences for display attributes.")
+
+(defconst tramp-device-escape-sequence-regexp "\e[[0-9]+n"
+ "Terminal control escape sequences for device status.")
+
+;; ksh on OpenBSD 4.5 requires that $PS1 contains a `#' character for
+;; root users. It uses the `$' character for other users. In order
+;; to guarantee a proper prompt, we use "#$ " for the prompt.
+
+(defvar tramp-end-of-output
+ (format
+ "///%s#$"
+ (md5 (concat (prin1-to-string process-environment) (current-time-string))))
+ "String used to recognize end of output.
+The `$' character at the end is quoted; the string cannot be
+detected as prompt when being sent on echoing hosts, therefore.")
+
+;;;###tramp-autoload
+(defconst tramp-initial-end-of-output "#$ "
+ "Prompt when establishing a connection.")
+
+(defconst tramp-end-of-heredoc (md5 tramp-end-of-output)
+ "String used to recognize end of heredoc strings.")
+
+(defcustom tramp-use-ssh-controlmaster-options t
+ "Whether to use `tramp-ssh-controlmaster-options'."
+ :group 'tramp
+ :version "24.4"
+ :type 'boolean)
+
+(defvar tramp-ssh-controlmaster-options nil
+ "Which ssh Control* arguments to use.
+
+If it is a string, it should have the form
+\"-o ControlMaster=auto -o ControlPath=\\='address@hidden:%%p\\='
+-o ControlPersist=no\". Percent characters in the ControlPath
+spec must be doubled, because the string is used as format string.
+
+Otherwise, it will be auto-detected by Tramp, if
+`tramp-use-ssh-controlmaster-options' is non-nil. The value
+depends on the installed local ssh version.
+
+The string is used in `tramp-methods'.")
+
+;; Initialize `tramp-methods' with the supported methods.
+;;;###tramp-autoload
+(tramp--with-startup
+ (add-to-list 'tramp-methods
+ '("rcp"
+ (tramp-login-program "rsh")
+ (tramp-login-args (("%h") ("-l" "%u")))
+ (tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-c"))
+ (tramp-copy-program "rcp")
+ (tramp-copy-args (("-p" "%k") ("-r")))
+ (tramp-copy-keep-date t)
+ (tramp-copy-recursive t)))
+ (add-to-list 'tramp-methods
+ '("remcp"
+ (tramp-login-program "remsh")
+ (tramp-login-args (("%h") ("-l" "%u")))
+ (tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-c"))
+ (tramp-copy-program "rcp")
+ (tramp-copy-args (("-p" "%k")))
+ (tramp-copy-keep-date t)))
+ (add-to-list 'tramp-methods
+ '("scp"
+ (tramp-login-program "ssh")
+ (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
+ ("-e" "none") ("%h")))
+ (tramp-async-args (("-q")))
+ (tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-c"))
+ (tramp-copy-program "scp")
+ (tramp-copy-args (("-P" "%p") ("-p" "%k") ("-q")
("-r") ("%c")))
+ (tramp-copy-keep-date t)
+ (tramp-copy-recursive t)))
+ (add-to-list 'tramp-methods
+ '("scpx"
+ (tramp-login-program "ssh")
+ (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
+ ("-e" "none") ("-t" "-t") ("%h")
("/bin/sh")))
+ (tramp-async-args (("-q")))
+ (tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-c"))
+ (tramp-copy-program "scp")
+ (tramp-copy-args (("-P" "%p") ("-p" "%k")
+ ("-q") ("-r") ("%c")))
+ (tramp-copy-keep-date t)
+ (tramp-copy-recursive t)))
+ (add-to-list 'tramp-methods
+ '("rsync"
+ (tramp-login-program "ssh")
+ (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
+ ("-e" "none") ("%h")))
+ (tramp-async-args (("-q")))
+ (tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-c"))
+ (tramp-copy-program "rsync")
+ (tramp-copy-args (("-t" "%k") ("-p") ("-r") ("-s")
("-c")))
+ (tramp-copy-env (("RSYNC_RSH") ("ssh" "%c")))
+ (tramp-copy-keep-date t)
+ (tramp-copy-keep-tmpfile t)
+ (tramp-copy-recursive t)))
+ (add-to-list 'tramp-methods
+ '("rsh"
+ (tramp-login-program "rsh")
+ (tramp-login-args (("%h") ("-l" "%u")))
+ (tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-c"))))
+ (add-to-list 'tramp-methods
+ '("remsh"
+ (tramp-login-program "remsh")
+ (tramp-login-args (("%h") ("-l" "%u")))
+ (tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-c"))))
+ (add-to-list 'tramp-methods
+ '("ssh"
+ (tramp-login-program "ssh")
+ (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
+ ("-e" "none") ("%h")))
+ (tramp-async-args (("-q")))
+ (tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-c"))))
+ (add-to-list 'tramp-methods
+ '("sshx"
+ (tramp-login-program "ssh")
+ (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
+ ("-e" "none") ("-t" "-t") ("%h")
("/bin/sh")))
+ (tramp-async-args (("-q")))
+ (tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-c"))))
+ (add-to-list 'tramp-methods
+ '("telnet"
+ (tramp-login-program "telnet")
+ (tramp-login-args (("%h") ("%p") ("2>/dev/null")))
+ (tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-c"))))
+ (add-to-list 'tramp-methods
+ '("nc"
+ (tramp-login-program "telnet")
+ (tramp-login-args (("%h") ("%p") ("2>/dev/null")))
+ (tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-c"))
+ (tramp-copy-program "nc")
+ ;; We use "-v" for better error tracking.
+ (tramp-copy-args (("-w" "1") ("-v") ("%h") ("%r")))
+ (tramp-remote-copy-program "nc")
+ ;; We use "-p" as required for newer busyboxes. For older
+ ;; busybox/nc versions, the value must be (("-l") ("%r")).
This
+ ;; can be achieved by tweaking `tramp-connection-properties'.
+ (tramp-remote-copy-args (("-l") ("-p" "%r")
("2>/dev/null")))))
+ (add-to-list 'tramp-methods
+ '("su"
+ (tramp-login-program "su")
+ (tramp-login-args (("-") ("%u")))
+ (tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-c"))
+ (tramp-connection-timeout 10)))
+ (add-to-list 'tramp-methods
+ '("sg"
+ (tramp-login-program "sg")
+ (tramp-login-args (("-") ("%u")))
+ (tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-args ("-c"))
+ (tramp-connection-timeout 10)))
+ (add-to-list 'tramp-methods
+ '("sudo"
+ (tramp-login-program "sudo")
+ ;; The password template must be masked. Otherwise, it could
be
+ ;; interpreted as password prompt if the remote host echoes
the command.
+ (tramp-login-args (("-u" "%u") ("-s") ("-H")
+ ("-p"
"P\"\"a\"\"s\"\"s\"\"w\"\"o\"\"r\"\"d\"\":")))
+ ;; Local $SHELL could be a nasty one, like zsh or fish. Let's
override it.
+ (tramp-login-env (("SHELL") ("/bin/sh")))
+ (tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-c"))
+ (tramp-connection-timeout 10)
+ (tramp-session-timeout 300)))
+ (add-to-list 'tramp-methods
+ '("doas"
+ (tramp-login-program "doas")
+ (tramp-login-args (("-u" "%u") ("-s")))
+ (tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-args ("-c"))
+ (tramp-connection-timeout 10)
+ (tramp-session-timeout 300)))
+ (add-to-list 'tramp-methods
+ '("ksu"
+ (tramp-login-program "ksu")
+ (tramp-login-args (("%u") ("-q")))
+ (tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-c"))
+ (tramp-connection-timeout 10)))
+ (add-to-list 'tramp-methods
+ '("krlogin"
+ (tramp-login-program "krlogin")
+ (tramp-login-args (("%h") ("-l" "%u") ("-x")))
+ (tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-c"))))
+ (add-to-list 'tramp-methods
+ `("plink"
+ (tramp-login-program "plink")
+ (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh")
("-t")
+ ("%h") ("\"")
+ (,(format
+ "env 'TERM=%s'
'PROMPT_COMMAND=' 'PS1=%s'"
+ tramp-terminal-type
+ tramp-initial-end-of-output))
+ ("/bin/sh") ("\"")))
+ (tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-c"))))
+ (add-to-list 'tramp-methods
+ `("plinkx"
+ (tramp-login-program "plink")
+ (tramp-login-args (("-load") ("%h") ("-t") ("\"")
+ (,(format
+ "env 'TERM=%s'
'PROMPT_COMMAND=' 'PS1=%s'"
+ tramp-terminal-type
+ tramp-initial-end-of-output))
+ ("/bin/sh") ("\"")))
+ (tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-c"))))
+ (add-to-list 'tramp-methods
+ `("pscp"
+ (tramp-login-program "plink")
+ (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh")
("-t")
+ ("%h") ("\"")
+ (,(format
+ "env 'TERM=%s'
'PROMPT_COMMAND=' 'PS1=%s'"
+ tramp-terminal-type
+ tramp-initial-end-of-output))
+ ("/bin/sh") ("\"")))
+ (tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-c"))
+ (tramp-copy-program "pscp")
+ (tramp-copy-args (("-l" "%u") ("-P" "%p") ("-scp")
("-p" "%k")
+ ("-q") ("-r")))
+ (tramp-copy-keep-date t)
+ (tramp-copy-recursive t)))
+ (add-to-list 'tramp-methods
+ `("psftp"
+ (tramp-login-program "plink")
+ (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh")
("-t")
+ ("%h") ("\"")
+ (,(format
+ "env 'TERM=%s'
'PROMPT_COMMAND=' 'PS1=%s'"
+ tramp-terminal-type
+ tramp-initial-end-of-output))
+ ("/bin/sh") ("\"")))
+ (tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-c"))
+ (tramp-copy-program "pscp")
+ (tramp-copy-args (("-l" "%u") ("-P" "%p") ("-sftp")
("-p" "%k")
+ ("-q")))
+ (tramp-copy-keep-date t)))
+ (add-to-list 'tramp-methods
+ '("fcp"
+ (tramp-login-program "fsh")
+ (tramp-login-args (("%h") ("-l" "%u") ("sh" "-i")))
+ (tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-i") ("-c"))
+ (tramp-copy-program "fcp")
+ (tramp-copy-args (("-p" "%k")))
+ (tramp-copy-keep-date t)))
+
+ (add-to-list 'tramp-default-method-alist
+ `(,tramp-local-host-regexp "\\`root\\'" "su"))
+
+ (add-to-list 'tramp-default-user-alist
+ `(,(concat "\\`" (regexp-opt '("su" "sudo" "doas" "ksu")) "\\'")
+ nil "root"))
+ ;; Do not add "ssh" based methods, otherwise ~/.ssh/config would be ignored.
+ ;; Do not add "plink" based methods, they ask interactively for the user.
+ (add-to-list 'tramp-default-user-alist
+ `(,(concat
+ "\\`"
+ (regexp-opt
+ '("rcp" "remcp" "rsh" "telnet" "nc" "krlogin" "fcp"))
+ "\\'")
+ nil ,(user-login-name))))
+
+;;;###tramp-autoload
+(defconst tramp-completion-function-alist-rsh
+ '((tramp-parse-rhosts "/etc/hosts.equiv")
+ (tramp-parse-rhosts "~/.rhosts"))
+ "Default list of (FUNCTION FILE) pairs to be examined for rsh methods.")
+
+;;;###tramp-autoload
+(defconst tramp-completion-function-alist-ssh
+ '((tramp-parse-rhosts "/etc/hosts.equiv")
+ (tramp-parse-rhosts "/etc/shosts.equiv")
+ (tramp-parse-shosts "/etc/ssh_known_hosts")
+ (tramp-parse-sconfig "/etc/ssh_config")
+ (tramp-parse-shostkeys "/etc/ssh2/hostkeys")
+ (tramp-parse-sknownhosts "/etc/ssh2/knownhosts")
+ (tramp-parse-rhosts "~/.rhosts")
+ (tramp-parse-rhosts "~/.shosts")
+ (tramp-parse-shosts "~/.ssh/known_hosts")
+ (tramp-parse-sconfig "~/.ssh/config")
+ (tramp-parse-shostkeys "~/.ssh2/hostkeys")
+ (tramp-parse-sknownhosts "~/.ssh2/knownhosts"))
+ "Default list of (FUNCTION FILE) pairs to be examined for ssh methods.")
+
+;;;###tramp-autoload
+(defconst tramp-completion-function-alist-telnet
+ '((tramp-parse-hosts "/etc/hosts"))
+ "Default list of (FUNCTION FILE) pairs to be examined for telnet methods.")
+
+;;;###tramp-autoload
+(defconst tramp-completion-function-alist-su
+ '((tramp-parse-passwd "/etc/passwd"))
+ "Default list of (FUNCTION FILE) pairs to be examined for su methods.")
+
+;;;###tramp-autoload
+(defconst tramp-completion-function-alist-sg
+ '((tramp-parse-etc-group "/etc/group"))
+ "Default list of (FUNCTION FILE) pairs to be examined for sg methods.")
+
+;;;###tramp-autoload
+(defconst tramp-completion-function-alist-putty
+ `((tramp-parse-putty
+ ,(if (memq system-type '(windows-nt))
+ "HKEY_CURRENT_USER\\Software\\SimonTatham\\PuTTY\\Sessions"
+ "~/.putty/sessions")))
+ "Default list of (FUNCTION REGISTRY) pairs to be examined for putty
sessions.")
+
+;;;###tramp-autoload
+(tramp--with-startup
+ (tramp-set-completion-function "rcp" tramp-completion-function-alist-rsh)
+ (tramp-set-completion-function "remcp" tramp-completion-function-alist-rsh)
+ (tramp-set-completion-function "scp" tramp-completion-function-alist-ssh)
+ (tramp-set-completion-function "scpx" tramp-completion-function-alist-ssh)
+ (tramp-set-completion-function "rsync" tramp-completion-function-alist-ssh)
+ (tramp-set-completion-function "rsh" tramp-completion-function-alist-rsh)
+ (tramp-set-completion-function "remsh" tramp-completion-function-alist-rsh)
+ (tramp-set-completion-function "ssh" tramp-completion-function-alist-ssh)
+ (tramp-set-completion-function "sshx" tramp-completion-function-alist-ssh)
+ (tramp-set-completion-function
+ "telnet" tramp-completion-function-alist-telnet)
+ (tramp-set-completion-function "nc" tramp-completion-function-alist-telnet)
+ (tramp-set-completion-function "su" tramp-completion-function-alist-su)
+ (tramp-set-completion-function "sudo" tramp-completion-function-alist-su)
+ (tramp-set-completion-function "doas" tramp-completion-function-alist-su)
+ (tramp-set-completion-function "ksu" tramp-completion-function-alist-su)
+ (tramp-set-completion-function "sg" tramp-completion-function-alist-sg)
+ (tramp-set-completion-function
+ "krlogin" tramp-completion-function-alist-rsh)
+ (tramp-set-completion-function "plink" tramp-completion-function-alist-ssh)
+ (tramp-set-completion-function
+ "plinkx" tramp-completion-function-alist-putty)
+ (tramp-set-completion-function "pscp" tramp-completion-function-alist-ssh)
+ (tramp-set-completion-function "psftp" tramp-completion-function-alist-ssh)
+ (tramp-set-completion-function "fcp" tramp-completion-function-alist-ssh))
+
+;; "getconf PATH" yields:
+;; HP-UX:
/usr/bin:/usr/ccs/bin:/opt/ansic/bin:/opt/langtools/bin:/opt/fortran/bin
+;; Solaris: /usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/SUNWspro/bin
+;; GNU/Linux (Debian, Suse, RHEL): /bin:/usr/bin
+;; FreeBSD: /usr/bin:/bin:/usr/sbin:/sbin: - beware trailing ":"!
+;; Darwin: /usr/bin:/bin:/usr/sbin:/sbin
+;; IRIX64: /usr/bin
+;; QNAP QTS: ---
+;;;###tramp-autoload
+(defcustom tramp-remote-path
+ '(tramp-default-remote-path "/bin" "/usr/bin" "/sbin" "/usr/sbin"
+ "/usr/local/bin" "/usr/local/sbin" "/local/bin" "/local/freeware/bin"
+ "/local/gnu/bin" "/usr/freeware/bin" "/usr/pkg/bin" "/usr/contrib/bin"
+ "/opt/bin" "/opt/sbin" "/opt/local/bin")
+ "List of directories to search for executables on remote host.
+For every remote host, this variable will be set buffer local,
+keeping the list of existing directories on that host.
+
+You can use `~' in this list, but when searching for a shell which groks
+tilde expansion, all directory names starting with `~' will be ignored.
+
+`Default Directories' represent the list of directories given by
+the command \"getconf PATH\". It is recommended to use this
+entry on head of this list, because these are the default
+directories for POSIX compatible commands. On remote hosts which
+do not offer the getconf command (like cygwin), the value
+\"/bin:/usr/bin\" is used instead. This entry is represented in
+the list by the special value `tramp-default-remote-path'.
+
+`Private Directories' are the settings of the $PATH environment,
+as given in your `~/.profile'. This entry is represented in
+the list by the special value `tramp-own-remote-path'."
+ :group 'tramp
+ :type '(repeat (choice
+ (const :tag "Default Directories" tramp-default-remote-path)
+ (const :tag "Private Directories" tramp-own-remote-path)
+ (string :tag "Directory"))))
+
+;;;###tramp-autoload
+(defcustom tramp-remote-process-environment
+ '("ENV=''" "TMOUT=0" "LC_CTYPE=''"
+ "CDPATH=" "HISTORY=" "MAIL=" "MAILCHECK=" "MAILPATH=" "PAGER=cat"
+ "autocorrect=" "correct=")
+ "List of environment variables to be set on the remote host.
+
+Each element should be a string of the form ENVVARNAME=VALUE. An
+entry ENVVARNAME= disables the corresponding environment variable,
+which might have been set in the init files like ~/.profile.
+
+Special handling is applied to some environment variables,
+which should not be set here:
+
+The PATH environment variable should be set via `tramp-remote-path'.
+
+The TERM environment variable should be set via `tramp-terminal-type'.
+
+The INSIDE_EMACS environment variable will automatically be set
+based on the Tramp and Emacs versions, and should not be set here."
+ :group 'tramp
+ :version "26.1"
+ :type '(repeat string))
+
+;;;###tramp-autoload
+(defcustom tramp-sh-extra-args '(("/bash\\'" . "-norc -noprofile"))
+ "Alist specifying extra arguments to pass to the remote shell.
+Entries are (REGEXP . ARGS) where REGEXP is a regular expression
+matching the shell file name and ARGS is a string specifying the
+arguments.
+
+This variable is only used when Tramp needs to start up another shell
+for tilde expansion. The extra arguments should typically prevent the
+shell from reading its init file."
+ :group 'tramp
+ :type '(alist :key-type regexp :value-type string))
+
+(defconst tramp-actions-before-shell
+ '((tramp-login-prompt-regexp tramp-action-login)
+ (tramp-password-prompt-regexp tramp-action-password)
+ (tramp-wrong-passwd-regexp tramp-action-permission-denied)
+ (shell-prompt-pattern tramp-action-succeed)
+ (tramp-shell-prompt-pattern tramp-action-succeed)
+ (tramp-yesno-prompt-regexp tramp-action-yesno)
+ (tramp-yn-prompt-regexp tramp-action-yn)
+ (tramp-terminal-prompt-regexp tramp-action-terminal)
+ (tramp-process-alive-regexp tramp-action-process-alive))
+ "List of pattern/action pairs.
+Whenever a pattern matches, the corresponding action is performed.
+Each item looks like (PATTERN ACTION).
+
+The PATTERN should be a symbol, a variable. The value of this
+variable gives the regular expression to search for. Note that the
+regexp must match at the end of the buffer, \"\\'\" is implicitly
+appended to it.
+
+The ACTION should also be a symbol, but a function. When the
+corresponding PATTERN matches, the ACTION function is called.")
+
+(defconst tramp-actions-copy-out-of-band
+ '((tramp-password-prompt-regexp tramp-action-password)
+ (tramp-wrong-passwd-regexp tramp-action-permission-denied)
+ (tramp-copy-failed-regexp tramp-action-permission-denied)
+ (tramp-process-alive-regexp tramp-action-out-of-band))
+ "List of pattern/action pairs.
+This list is used for copying/renaming with out-of-band methods.
+
+See `tramp-actions-before-shell' for more info.")
+
+(defconst tramp-uudecode
+ "(echo begin 600 %t; tail -n +2) | uudecode
+cat %t
+rm -f %t"
+ "Shell function to implement `uudecode' to standard output.
+Many systems support `uudecode -o /dev/stdout' or `uudecode -o -'
+for this or `uudecode -p', but some systems don't, and for them
+we have this shell function.")
+
+(defconst tramp-perl-file-truename
+ "%s -e '
+use File::Spec;
+use Cwd \"realpath\";
+
+sub myrealpath {
+ my ($file) = @_;
+ return realpath($file) if (-e $file || -l $file);
+}
+
+sub recursive {
+ my ($volume, @dirs) = @_;
+ my $real = myrealpath(File::Spec->catpath(
+ $volume, File::Spec->catdir(@dirs), \"\"));
+ if ($real) {
+ my ($vol, $dir) = File::Spec->splitpath($real, 1);
+ return ($vol, File::Spec->splitdir($dir));
+ }
+ else {
+ my $last = pop(@dirs);
+ ($volume, @dirs) = recursive($volume, @dirs);
+ push(@dirs, $last);
+ return ($volume, @dirs);
+ }
+}
+
+$result = myrealpath($ARGV[0]);
+if (!$result) {
+ my ($vol, $dir) = File::Spec->splitpath($ARGV[0], 1);
+ ($vol, @dirs) = recursive($vol, File::Spec->splitdir($dir));
+
+ $result = File::Spec->catpath($vol, File::Spec->catdir(@dirs), \"\");
+}
+
+$result =~ s/\"/\\\\\"/g;
+print \"\\\"$result\\\"\\n\";
+' \"$1\" 2>/dev/null"
+ "Perl script to produce output suitable for use with `file-truename'
+on the remote file system.
+Escape sequence %s is replaced with name of Perl binary.
+This string is passed to `format', so percent characters need to be doubled.")
+
+(defconst tramp-perl-file-name-all-completions
+ "%s -e '
+opendir(d, $ARGV[0]) || die(\"$ARGV[0]: $!\\nfail\\n\");
address@hidden = readdir(d); closedir(d);
+foreach $f (@files) {
+ if (-d \"$ARGV[0]/$f\") {
+ print \"$f/\\n\";
+ }
+ else {
+ print \"$f\\n\";
+ }
+}
+print \"ok\\n\"
+' \"$1\" 2>/dev/null"
+ "Perl script to produce output suitable for use with
+`file-name-all-completions' on the remote file system. Escape
+sequence %s is replaced with name of Perl binary. This string is
+passed to `format', so percent characters need to be doubled.")
+
+;; Perl script to implement `file-attributes' in a Lisp `read'able
+;; output. If you are hacking on this, note that you get *no* output
+;; unless this spits out a complete line, including the '\n' at the
+;; end.
+;; The device number is returned as "-1", because there will be a virtual
+;; device number set in `tramp-sh-handle-file-attributes'.
+(defconst tramp-perl-file-attributes
+ "%s -e '
address@hidden = lstat($ARGV[0]);
+if (address@hidden) {
+ print \"nil\\n\";
+ exit 0;
+}
+if (($stat[2] & 0170000) == 0120000)
+{
+ $type = readlink($ARGV[0]);
+ $type =~ s/\"/\\\\\"/g;
+ $type = \"\\\"$type\\\"\";
+}
+elsif (($stat[2] & 0170000) == 040000)
+{
+ $type = \"t\";
+}
+else
+{
+ $type = \"nil\"
+};
+$uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) .
\"\\\"\";
+$gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) .
\"\\\"\";
+printf(
+ \"(%%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u %%u t %%u -1)\\n\",
+ $type,
+ $stat[3],
+ $uid,
+ $gid,
+ $stat[8] >> 16 & 0xffff,
+ $stat[8] & 0xffff,
+ $stat[9] >> 16 & 0xffff,
+ $stat[9] & 0xffff,
+ $stat[10] >> 16 & 0xffff,
+ $stat[10] & 0xffff,
+ $stat[7],
+ $stat[2],
+ $stat[1]
+);' \"$1\" \"$2\" 2>/dev/null"
+ "Perl script to produce output suitable for use with `file-attributes'
+on the remote file system.
+Escape sequence %s is replaced with name of Perl binary.
+This string is passed to `format', so percent characters need to be doubled.")
+
+(defconst tramp-perl-directory-files-and-attributes
+ "%s -e '
+chdir($ARGV[0]) or printf(\"\\\"Cannot change to $ARGV[0]: $''!''\\\"\\n\"),
exit();
+opendir(DIR,\".\") or printf(\"\\\"Cannot open directory $ARGV[0]:
$''!''\\\"\\n\"), exit();
address@hidden = readdir(DIR);
+closedir(DIR);
+$n = scalar(@list);
+printf(\"(\\n\");
+for($i = 0; $i < $n; $i++)
+{
+ $filename = $list[$i];
+ @stat = lstat($filename);
+ if (($stat[2] & 0170000) == 0120000)
+ {
+ $type = readlink($filename);
+ $type =~ s/\"/\\\\\"/g;
+ $type = \"\\\"$type\\\"\";
+ }
+ elsif (($stat[2] & 0170000) == 040000)
+ {
+ $type = \"t\";
+ }
+ else
+ {
+ $type = \"nil\"
+ };
+ $uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" .
getpwuid($stat[4]) . \"\\\"\";
+ $gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" .
getgrgid($stat[5]) . \"\\\"\";
+ $filename =~ s/\"/\\\\\"/g;
+ printf(
+ \"(\\\"%%s\\\" %%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u.0 %%u
t (%%u . %%u) (%%u . %%u))\\n\",
+ $filename,
+ $type,
+ $stat[3],
+ $uid,
+ $gid,
+ $stat[8] >> 16 & 0xffff,
+ $stat[8] & 0xffff,
+ $stat[9] >> 16 & 0xffff,
+ $stat[9] & 0xffff,
+ $stat[10] >> 16 & 0xffff,
+ $stat[10] & 0xffff,
+ $stat[7],
+ $stat[2],
+ $stat[1] >> 16 & 0xffff,
+ $stat[1] & 0xffff,
+ $stat[0] >> 16 & 0xffff,
+ $stat[0] & 0xffff);
+}
+printf(\")\\n\");' \"$1\" \"$2\" 2>/dev/null"
+ "Perl script implementing `directory-files-attributes' as Lisp `read'able
+output.
+Escape sequence %s is replaced with name of Perl binary.
+This string is passed to `format', so percent characters need to be doubled.")
+
+;; These two use base64 encoding.
+(defconst tramp-perl-encode-with-module
+ "%s -MMIME::Base64 -0777 -ne 'print encode_base64($_)' 2>/dev/null"
+ "Perl program to use for encoding a file.
+Escape sequence %s is replaced with name of Perl binary.
+This string is passed to `format', so percent characters need to be doubled.
+This implementation requires the MIME::Base64 Perl module to be installed
+on the remote host.")
+
+(defconst tramp-perl-decode-with-module
+ "%s -MMIME::Base64 -0777 -ne 'print decode_base64($_)' 2>/dev/null"
+ "Perl program to use for decoding a file.
+Escape sequence %s is replaced with name of Perl binary.
+This string is passed to `format', so percent characters need to be doubled.
+This implementation requires the MIME::Base64 Perl module to be installed
+on the remote host.")
+
+(defconst tramp-perl-encode
+ "%s -e '
+# This script contributed by Juanma Barranquero <address@hidden>.
+# Copyright (C) 2002-2019 Free Software Foundation, Inc.
+use strict;
+
+my %%trans = do {
+ my $i = 0;
+ map {(substr(unpack(q(B8), chr $i++), 2, 6), $_)}
+ split //,
q(ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/);
+};
+my $data;
+
+# We read in chunks of 54 bytes, to generate output lines
+# of 72 chars (plus end of line)
+while (read STDIN, $data, 54) {
+ my $pad = q();
+
+ # Only for the last chunk, and only if did not fill the last three-byte
packet
+ if (eof) {
+ my $mod = length($data) %% 3;
+ $pad = q(=) x (3 - $mod) if $mod;
+ }
+
+ # Not the fastest method, but it is simple: unpack to binary string, split
+ # by groups of 6 bits and convert back from binary to byte; then map into
+ # the translation table
+ print
+ join q(),
+ map($trans{$_},
+ (substr(unpack(q(B*), $data) . q(00000), 0, 432) =~ /....../g)),
+ $pad,
+ qq(\\n);
+}' 2>/dev/null"
+ "Perl program to use for encoding a file.
+Escape sequence %s is replaced with name of Perl binary.
+This string is passed to `format', so percent characters need to be doubled.")
+
+(defconst tramp-perl-decode
+ "%s -e '
+# This script contributed by Juanma Barranquero <address@hidden>.
+# Copyright (C) 2002-2019 Free Software Foundation, Inc.
+use strict;
+
+my %%trans = do {
+ my $i = 0;
+ map {($_, substr(unpack(q(B8), chr $i++), 2, 6))}
+ split //,
q(ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/)
+};
+
+my %%bytes = map {(unpack(q(B8), chr $_), chr $_)} 0 .. 255;
+
+binmode(\\*STDOUT);
+
+# We are going to accumulate into $pending to accept any line length
+# (we do not check they are <= 76 chars as the RFC says)
+my $pending = q();
+
+while (my $data = <STDIN>) {
+ chomp $data;
+
+ # If we find one or two =, we have reached the end and
+ # any following data is to be discarded
+ my $finished = $data =~ s/(==?).*/$1/;
+ $pending .= $data;
+
+ my $len = length($pending);
+ my $chunk = substr($pending, 0, $len & ~3);
+ $pending = substr($pending, $len & ~3 + 1);
+
+ # Easy method: translate from chars to (pregenerated) six-bit packets,
join,
+ # split in 8-bit chunks and convert back to char.
+ print join q(),
+ map $bytes{$_},
+ ((join q(), map {$trans{$_} || q()} split //, $chunk) =~ /......../g);
+
+ last if $finished;
+}' 2>/dev/null"
+ "Perl program to use for decoding a file.
+Escape sequence %s is replaced with name of Perl binary.
+This string is passed to `format', so percent characters need to be doubled.")
+
+(defconst tramp-perl-pack
+ "%s -e 'binmode STDIN; binmode STDOUT; print pack(q{u*}, join q{}, <>)'"
+ "Perl program to use for encoding a file.
+Escape sequence %s is replaced with name of Perl binary.")
+
+(defconst tramp-perl-unpack
+ "%s -e 'binmode STDIN; binmode STDOUT; print unpack(q{u*}, join q{}, <>)'"
+ "Perl program to use for decoding a file.
+Escape sequence %s is replaced with name of Perl binary.")
+
+(defconst tramp-awk-encode
+ "od -v -t x1 -A n | busybox awk '\\
+BEGIN {
+ b64 = \"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/\"
+ b16 = \"0123456789abcdef\"
+}
+{
+ for (c=1; c<=length($0); c++) {
+ d=index(b16, substr($0,c,1))
+ if (d--) {
+ for (b=1; b<=4; b++) {
+ o=o*2+int(d/8); d=(d*2)%%16
+ if (++obc==6) {
+ printf substr(b64,o+1,1)
+ if (++rc>75) { printf \"\\n\"; rc=0 }
+ obc=0; o=0
+ }
+ }
+ }
+ }
+}
+END {
+ if (obc) {
+ tail=(obc==2) ? \"==\\n\" : \"=\\n\"
+ while (obc++<6) { o=o*2 }
+ printf \"%%c\", substr(b64,o+1,1)
+ } else {
+ tail=\"\\n\"
+ }
+ printf tail
+}'"
+ "Awk program to use for encoding a file.
+This string is passed to `format', so percent characters need to be doubled.")
+
+(defconst tramp-awk-decode
+ "busybox awk '\\
+BEGIN {
+ b64 = \"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/\"
+}
+{
+ for (i=1; i<=length($0); i++) {
+ c=index(b64, substr($0,i,1))
+ if(c--) {
+ for(b=0; b<6; b++) {
+ o=o*2+int(c/32); c=(c*2)%%64
+ if(++obc==8) {
+ if (o) {
+ printf \"%%c\", o
+ } else {
+ system(\"dd if=/dev/zero bs=1 count=1 2>/dev/null\")
+ }
+ obc=0; o=0
+ }
+ }
+ }
+ }
+}'"
+ "Awk program to use for decoding a file.
+This string is passed to `format', so percent characters need to be doubled.")
+
+(defconst tramp-awk-coding-test
+ "test -c /dev/zero && \
+od -v -t x1 -A n </dev/null && \
+busybox awk '{}' </dev/null"
+ "Test command for checking `tramp-awk-encode' and `tramp-awk-decode'.")
+
+(defconst tramp-vc-registered-read-file-names
+ "echo \"(\"
+while read file; do
+ quoted=`echo \"$file\" | sed -e \"s/\\\"/\\\\\\\\\\\\\\\\\\\"/\"`
+ if %s \"$file\"; then
+ echo \"(\\\"$quoted\\\" \\\"file-exists-p\\\" t)\"
+ else
+ echo \"(\\\"$quoted\\\" \\\"file-exists-p\\\" nil)\"
+ fi
+ if %s \"$file\"; then
+ echo \"(\\\"$quoted\\\" \\\"file-readable-p\\\" t)\"
+ else
+ echo \"(\\\"$quoted\\\" \\\"file-readable-p\\\" nil)\"
+ fi
+done
+echo \")\""
+ "Script to check existence of VC related files.
+It must be send formatted with two strings; the tests for file
+existence, and file readability. Input shall be read via
+here-document, otherwise the command could exceed maximum length
+of command line.")
+
+;; New handlers should be added here.
+;;;###tramp-autoload
+(defconst tramp-sh-file-name-handler-alist
+ '((access-file . tramp-handle-access-file)
+ (add-name-to-file . tramp-sh-handle-add-name-to-file)
+ ;; `byte-compiler-base-file-name' performed by default handler.
+ (copy-directory . tramp-sh-handle-copy-directory)
+ (copy-file . tramp-sh-handle-copy-file)
+ (delete-directory . tramp-sh-handle-delete-directory)
+ (delete-file . tramp-sh-handle-delete-file)
+ ;; `diff-latest-backup-file' performed by default handler.
+ (directory-file-name . tramp-handle-directory-file-name)
+ (directory-files . tramp-handle-directory-files)
+ (directory-files-and-attributes
+ . tramp-sh-handle-directory-files-and-attributes)
+ (dired-compress-file . tramp-sh-handle-dired-compress-file)
+ (dired-uncache . tramp-handle-dired-uncache)
+ (exec-path . tramp-sh-handle-exec-path)
+ (expand-file-name . tramp-sh-handle-expand-file-name)
+ (file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
+ (file-acl . tramp-sh-handle-file-acl)
+ (file-attributes . tramp-sh-handle-file-attributes)
+ (file-directory-p . tramp-sh-handle-file-directory-p)
+ (file-equal-p . tramp-handle-file-equal-p)
+ (file-executable-p . tramp-sh-handle-file-executable-p)
+ (file-exists-p . tramp-sh-handle-file-exists-p)
+ (file-in-directory-p . tramp-handle-file-in-directory-p)
+ (file-local-copy . tramp-sh-handle-file-local-copy)
+ (file-modes . tramp-handle-file-modes)
+ (file-name-all-completions . tramp-sh-handle-file-name-all-completions)
+ (file-name-as-directory . tramp-handle-file-name-as-directory)
+ (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p)
+ (file-name-completion . tramp-handle-file-name-completion)
+ (file-name-directory . tramp-handle-file-name-directory)
+ (file-name-nondirectory . tramp-handle-file-name-nondirectory)
+ ;; `file-name-sans-versions' performed by default handler.
+ (file-newer-than-file-p . tramp-sh-handle-file-newer-than-file-p)
+ (file-notify-add-watch . tramp-sh-handle-file-notify-add-watch)
+ (file-notify-rm-watch . tramp-handle-file-notify-rm-watch)
+ (file-notify-valid-p . tramp-handle-file-notify-valid-p)
+ (file-ownership-preserved-p . tramp-sh-handle-file-ownership-preserved-p)
+ (file-readable-p . tramp-sh-handle-file-readable-p)
+ (file-regular-p . tramp-handle-file-regular-p)
+ (file-remote-p . tramp-handle-file-remote-p)
+ (file-selinux-context . tramp-sh-handle-file-selinux-context)
+ (file-symlink-p . tramp-handle-file-symlink-p)
+ (file-system-info . tramp-sh-handle-file-system-info)
+ (file-truename . tramp-sh-handle-file-truename)
+ (file-writable-p . tramp-sh-handle-file-writable-p)
+ (find-backup-file-name . tramp-handle-find-backup-file-name)
+ ;; `get-file-buffer' performed by default handler.
+ (insert-directory . tramp-sh-handle-insert-directory)
+ (insert-file-contents . tramp-handle-insert-file-contents)
+ (load . tramp-handle-load)
+ (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
+ (make-directory . tramp-sh-handle-make-directory)
+ ;; `make-directory-internal' performed by default handler.
+ (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
+ (make-process . tramp-sh-handle-make-process)
+ (make-symbolic-link . tramp-sh-handle-make-symbolic-link)
+ (process-file . tramp-sh-handle-process-file)
+ (rename-file . tramp-sh-handle-rename-file)
+ (set-file-acl . tramp-sh-handle-set-file-acl)
+ (set-file-modes . tramp-sh-handle-set-file-modes)
+ (set-file-selinux-context . tramp-sh-handle-set-file-selinux-context)
+ (set-file-times . tramp-sh-handle-set-file-times)
+ (set-visited-file-modtime . tramp-sh-handle-set-visited-file-modtime)
+ (shell-command . tramp-handle-shell-command)
+ (start-file-process . tramp-handle-start-file-process)
+ (substitute-in-file-name . tramp-handle-substitute-in-file-name)
+ (temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-set-file-uid-gid . tramp-sh-handle-set-file-uid-gid)
+ (unhandled-file-name-directory . ignore)
+ (vc-registered . tramp-sh-handle-vc-registered)
+ (verify-visited-file-modtime . tramp-sh-handle-verify-visited-file-modtime)
+ (write-region . tramp-sh-handle-write-region))
+ "Alist of handler functions.
+Operations not mentioned here will be handled by the normal Emacs functions.")
+
+;;; File Name Handler Functions:
+
+(defun tramp-sh-handle-make-symbolic-link
+ (target linkname &optional ok-if-already-exists)
+ "Like `make-symbolic-link' for Tramp files.
+If TARGET is a non-Tramp file, it is used verbatim as the target
+of the symlink. If TARGET is a Tramp file, only the localname
+component is used as the target of the symlink."
+ (if (not (tramp-tramp-file-p (expand-file-name linkname)))
+ (tramp-run-real-handler
+ #'make-symbolic-link (list target linkname ok-if-already-exists))
+
+ (with-parsed-tramp-file-name linkname nil
+ ;; If TARGET is a Tramp name, use just the localname component.
+ (when (and (tramp-tramp-file-p target)
+ (tramp-file-name-equal-p v (tramp-dissect-file-name target)))
+ (setq target
+ (tramp-file-name-localname
+ (tramp-dissect-file-name (expand-file-name target)))))
+
+ ;; If TARGET is still remote, quote it.
+ (if (tramp-tramp-file-p target)
+ (make-symbolic-link
+ (let (file-name-handler-alist) (tramp-compat-file-name-quote target))
+ linkname ok-if-already-exists)
+
+ (let ((ln (tramp-get-remote-ln v))
+ (cwd (tramp-run-real-handler
+ #'file-name-directory (list localname))))
+ (unless ln
+ (tramp-error
+ v 'file-error
+ "Making a symbolic link. ln(1) does not exist on the remote host."))
+
+ ;; Do the 'confirm if exists' thing.
+ (when (file-exists-p linkname)
+ ;; What to do?
+ (if (or (null ok-if-already-exists) ; not allowed to exist
+ (and (numberp ok-if-already-exists)
+ (not
+ (yes-or-no-p
+ (format
+ "File %s already exists; make it a link anyway? "
+ localname)))))
+ (tramp-error v 'file-already-exists localname)
+ (delete-file linkname)))
+
+ (tramp-flush-file-properties v (file-name-directory localname))
+ (tramp-flush-file-properties v localname)
+
+ ;; Right, they are on the same host, regardless of user,
+ ;; method, etc. We now make the link on the remote
+ ;; machine. This will occur as the user that TARGET belongs to.
+ (and (tramp-send-command-and-check
+ v (format "cd %s" (tramp-shell-quote-argument cwd)))
+ (tramp-send-command-and-check
+ v (format
+ "%s -sf %s %s" ln
+ (tramp-shell-quote-argument target)
+ ;; The command could exceed PATH_MAX, so we use
+ ;; relative file names. However, relative file
+ ;; names could start with "-".
+ ;; `tramp-shell-quote-argument' does not handle
+ ;; this, we must do it ourselves.
+ (tramp-shell-quote-argument
+ (concat "./" (file-name-nondirectory localname)))))))))))
+
+(defun tramp-sh-handle-file-truename (filename)
+ "Like `file-truename' for Tramp files."
+ ;; Preserve trailing "/".
+ (funcall
+ (if (string-equal (file-name-nondirectory filename) "")
+ #'file-name-as-directory #'identity)
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (tramp-make-tramp-file-name
+ v
+ (with-tramp-file-property v localname "file-truename"
+ (let ((result nil) ; result steps in reverse order
+ (quoted (tramp-compat-file-name-quoted-p localname))
+ (localname (tramp-compat-file-name-unquote localname)))
+ (tramp-message v 4 "Finding true name for `%s'" filename)
+ (cond
+ ;; Use GNU readlink --canonicalize-missing where available.
+ ((tramp-get-remote-readlink v)
+ (tramp-send-command-and-check
+ v
+ (format "%s --canonicalize-missing %s"
+ (tramp-get-remote-readlink v)
+ (tramp-shell-quote-argument localname)))
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (goto-char (point-min))
+ (setq result (buffer-substring (point-min) (point-at-eol)))))
+
+ ;; Use Perl implementation.
+ ((and (tramp-get-remote-perl v)
+ (tramp-get-connection-property v "perl-file-spec" nil)
+ (tramp-get-connection-property v "perl-cwd-realpath" nil))
+ (tramp-maybe-send-script
+ v tramp-perl-file-truename "tramp_perl_file_truename")
+ (setq result
+ (tramp-send-command-and-read
+ v
+ (format "tramp_perl_file_truename %s"
+ (tramp-shell-quote-argument localname)))))
+
+ ;; Do it yourself.
+ (t (let ((steps (split-string localname "/" 'omit))
+ (thisstep nil)
+ (numchase 0)
+ ;; Don't make the following value larger than
+ ;; necessary. People expect an error message in a
+ ;; timely fashion when something is wrong;
+ ;; otherwise they might think that Emacs is hung.
+ ;; Of course, correctness has to come first.
+ (numchase-limit 20)
+ symlink-target)
+ (while (and steps (< numchase numchase-limit))
+ (setq thisstep (pop steps))
+ (tramp-message
+ v 5 "Check %s"
+ (mapconcat #'identity
+ (append '("") (reverse result) (list thisstep))
+ "/"))
+ (setq symlink-target
+ (tramp-compat-file-attribute-type
+ (file-attributes
+ (tramp-make-tramp-file-name
+ v
+ (mapconcat #'identity
+ (append '("")
+ (reverse result)
+ (list thisstep))
+ "/")
+ 'nohop))))
+ (cond ((string= "." thisstep)
+ (tramp-message v 5 "Ignoring step `.'"))
+ ((string= ".." thisstep)
+ (tramp-message v 5 "Processing step `..'")
+ (pop result))
+ ((stringp symlink-target)
+ ;; It's a symlink, follow it.
+ (tramp-message
+ v 5 "Follow symlink to %s" symlink-target)
+ (setq numchase (1+ numchase))
+ (when (file-name-absolute-p symlink-target)
+ (setq result nil))
+ (setq steps
+ (append
+ (split-string symlink-target "/" 'omit) steps)))
+ (t
+ ;; It's a file.
+ (setq result (cons thisstep result)))))
+ (when (>= numchase numchase-limit)
+ (tramp-error
+ v 'file-error
+ "Maximum number (%d) of symlinks exceeded" numchase-limit))
+ (setq result (reverse result))
+ ;; Combine list to form string.
+ (setq result
+ (if result
+ (mapconcat #'identity (cons "" result) "/")
+ "/"))
+ (when (string= "" result)
+ (setq result "/")))))
+
+ ;; Detect cycle.
+ (when (and (file-symlink-p filename)
+ (string-equal result localname))
+ (tramp-error
+ v 'file-error
+ "Apparent cycle of symbolic links for %s" filename))
+ ;; If the resulting localname looks remote, we must quote it
+ ;; for security reasons.
+ (when (or quoted (file-remote-p result))
+ (let (file-name-handler-alist)
+ (setq result (tramp-compat-file-name-quote result))))
+ (tramp-message v 4 "True name of `%s' is `%s'" localname result)
+ result))
+ 'nohop))))
+
+;; Basic functions.
+
+(defun tramp-sh-handle-file-exists-p (filename)
+ "Like `file-exists-p' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (with-tramp-file-property v localname "file-exists-p"
+ (or (not (null (tramp-get-file-property
+ v localname "file-attributes-integer" nil)))
+ (not (null (tramp-get-file-property
+ v localname "file-attributes-string" nil)))
+ (tramp-send-command-and-check
+ v
+ (format
+ "%s %s"
+ (tramp-get-file-exists-command v)
+ (tramp-shell-quote-argument localname)))))))
+
+(defun tramp-sh-handle-file-attributes (filename &optional id-format)
+ "Like `file-attributes' for Tramp files."
+ (unless id-format (setq id-format 'integer))
+ (ignore-errors
+ ;; Don't modify `last-coding-system-used' by accident.
+ (let ((last-coding-system-used last-coding-system-used))
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (with-tramp-file-property
+ v localname (format "file-attributes-%s" id-format)
+ (tramp-convert-file-attributes
+ v
+ (or
+ (cond
+ ((tramp-get-remote-stat v)
+ (tramp-do-file-attributes-with-stat v localname id-format))
+ ((tramp-get-remote-perl v)
+ (tramp-do-file-attributes-with-perl v localname id-format))
+ (t nil))
+ ;; The scripts could fail, for example with huge file size.
+ (tramp-do-file-attributes-with-ls v localname id-format))))))))
+
+(defun tramp-sh--quoting-style-options (vec)
+ (or
+ (tramp-get-ls-command-with
+ vec "--quoting-style=literal --show-control-chars")
+ (tramp-get-ls-command-with vec "-w")
+ ""))
+
+(defun tramp-do-file-attributes-with-ls (vec localname &optional id-format)
+ "Implement `file-attributes' for Tramp files using the ls(1) command."
+ (let (symlinkp dirp
+ res-inode res-filemodes res-numlinks
+ res-uid res-gid res-size res-symlink-target)
+ (tramp-message vec 5 "file attributes with ls: %s" localname)
+ ;; We cannot send all three commands combined, it could exceed
+ ;; NAME_MAX or PATH_MAX. Happened on macOS, for example.
+ (when (or (tramp-send-command-and-check
+ vec
+ (format "%s %s"
+ (tramp-get-file-exists-command vec)
+ (tramp-shell-quote-argument localname)))
+ (tramp-send-command-and-check
+ vec
+ (format "%s -h %s"
+ (tramp-get-test-command vec)
+ (tramp-shell-quote-argument localname))))
+ (tramp-send-command
+ vec
+ (format "%s %s %s %s"
+ (tramp-get-ls-command vec)
+ (if (eq id-format 'integer) "-ildn" "-ild")
+ ;; On systems which have no quoting style, file names
+ ;; with special characters could fail.
+ (tramp-sh--quoting-style-options vec)
+ (tramp-shell-quote-argument localname)))
+ ;; Parse `ls -l' output ...
+ (with-current-buffer (tramp-get-buffer vec)
+ (when (> (buffer-size) 0)
+ (goto-char (point-min))
+ ;; ... inode
+ (setq res-inode (read (current-buffer)))
+ ;; ... file mode flags
+ (setq res-filemodes (symbol-name (read (current-buffer))))
+ ;; ... number links
+ (setq res-numlinks (read (current-buffer)))
+ ;; ... uid and gid
+ (setq res-uid (read (current-buffer)))
+ (setq res-gid (read (current-buffer)))
+ (if (eq id-format 'integer)
+ (progn
+ (unless (numberp res-uid)
+ (setq res-uid tramp-unknown-id-integer))
+ (unless (numberp res-gid)
+ (setq res-gid tramp-unknown-id-integer)))
+ (progn
+ (unless (stringp res-uid) (setq res-uid (symbol-name res-uid)))
+ (unless (stringp res-gid) (setq res-gid (symbol-name res-gid)))))
+ ;; ... size
+ (setq res-size (read (current-buffer)))
+ ;; From the file modes, figure out other stuff.
+ (setq symlinkp (eq ?l (aref res-filemodes 0)))
+ (setq dirp (eq ?d (aref res-filemodes 0)))
+ ;; If symlink, find out file name pointed to.
+ (when symlinkp
+ (search-forward "-> ")
+ (setq res-symlink-target
+ (if (looking-at-p "\"")
+ (read (current-buffer))
+ (buffer-substring (point) (point-at-eol)))))
+ ;; Return data gathered.
+ (list
+ ;; 0. t for directory, string (name linked to) for symbolic
+ ;; link, or nil.
+ (or dirp res-symlink-target)
+ ;; 1. Number of links to file.
+ res-numlinks
+ ;; 2. File uid.
+ res-uid
+ ;; 3. File gid.
+ res-gid
+ ;; 4. Last access time.
+ ;; 5. Last modification time.
+ ;; 6. Last status change time.
+ tramp-time-dont-know tramp-time-dont-know tramp-time-dont-know
+ ;; 7. Size in bytes (-1, if number is out of range).
+ res-size
+ ;; 8. File modes, as a string of ten letters or dashes as in ls -l.
+ res-filemodes
+ ;; 9. t if file's gid would change if file were deleted and
+ ;; recreated. Will be set in `tramp-convert-file-attributes'.
+ t
+ ;; 10. Inode number.
+ res-inode
+ ;; 11. Device number. Will be replaced by a virtual device number.
+ -1))))))
+
+(defun tramp-do-file-attributes-with-perl
+ (vec localname &optional id-format)
+ "Implement `file-attributes' for Tramp files using a Perl script."
+ (tramp-message vec 5 "file attributes with perl: %s" localname)
+ (tramp-maybe-send-script
+ vec tramp-perl-file-attributes "tramp_perl_file_attributes")
+ (tramp-send-command-and-read
+ vec
+ (format "tramp_perl_file_attributes %s %s"
+ (tramp-shell-quote-argument localname) id-format)))
+
+(defun tramp-do-file-attributes-with-stat
+ (vec localname &optional id-format)
+ "Implement `file-attributes' for Tramp files using stat(1) command."
+ (tramp-message vec 5 "file attributes with stat: %s" localname)
+ (tramp-send-command-and-read
+ vec
+ (format
+ (eval-when-compile
+ (concat
+ ;; On Opsware, pdksh (which is the true name of ksh there)
+ ;; doesn't parse correctly the sequence "((". Therefore, we
+ ;; add a space. Apostrophes in the stat output are masked as
+ ;; `tramp-stat-marker', in order to make a proper shell escape
+ ;; of them in file names.
+ "( (%s %s || %s -h %s) && (%s -c "
+ "'((%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' "
+ "%s | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g') || echo nil)"))
+ (tramp-get-file-exists-command vec)
+ (tramp-shell-quote-argument localname)
+ (tramp-get-test-command vec)
+ (tramp-shell-quote-argument localname)
+ (tramp-get-remote-stat vec)
+ tramp-stat-marker tramp-stat-marker
+ (if (eq id-format 'integer)
+ "%u"
+ (eval-when-compile (concat tramp-stat-marker "%U" tramp-stat-marker)))
+ (if (eq id-format 'integer)
+ "%g"
+ (eval-when-compile (concat tramp-stat-marker "%G" tramp-stat-marker)))
+ tramp-stat-marker tramp-stat-marker
+ (tramp-shell-quote-argument localname)
+ tramp-stat-quoted-marker)))
+
+(defun tramp-sh-handle-set-visited-file-modtime (&optional time-list)
+ "Like `set-visited-file-modtime' for Tramp files."
+ (unless (buffer-file-name)
+ (error "Can't set-visited-file-modtime: buffer `%s' not visiting a file"
+ (buffer-name)))
+ (if time-list
+ (tramp-run-real-handler #'set-visited-file-modtime (list time-list))
+ (let ((f (buffer-file-name))
+ coding-system-used)
+ (with-parsed-tramp-file-name f nil
+ (let* ((remote-file-name-inhibit-cache t)
+ (attr (file-attributes f))
+ (modtime (or (tramp-compat-file-attribute-modification-time attr)
+ tramp-time-doesnt-exist)))
+ (setq coding-system-used last-coding-system-used)
+ (if (not (tramp-compat-time-equal-p modtime tramp-time-dont-know))
+ (tramp-run-real-handler #'set-visited-file-modtime (list modtime))
+ (progn
+ (tramp-send-command
+ v
+ (format "%s -ild %s"
+ (tramp-get-ls-command v)
+ (tramp-shell-quote-argument localname)))
+ (setq attr (buffer-substring (point) (point-at-eol))))
+ (tramp-set-file-property
+ v localname "visited-file-modtime-ild" attr))
+ (setq last-coding-system-used coding-system-used)
+ nil)))))
+
+;; This function makes the same assumption as
+;; `tramp-sh-handle-set-visited-file-modtime'.
+(defun tramp-sh-handle-verify-visited-file-modtime (&optional buf)
+ "Like `verify-visited-file-modtime' for Tramp files.
+At the time `verify-visited-file-modtime' calls this function, we
+already know that the buffer is visiting a file and that
+`visited-file-modtime' does not return 0. Do not call this
+function directly, unless those two cases are already taken care
+of."
+ (with-current-buffer (or buf (current-buffer))
+ (let ((f (buffer-file-name)))
+ ;; There is no file visiting the buffer, or the buffer has no
+ ;; recorded last modification time, or there is no established
+ ;; connection.
+ (if (or (not f)
+ (zerop (float-time (visited-file-modtime)))
+ (not (file-remote-p f nil 'connected)))
+ t
+ (with-parsed-tramp-file-name f nil
+ (let* ((remote-file-name-inhibit-cache t)
+ (attr (file-attributes f))
+ (modtime (tramp-compat-file-attribute-modification-time attr))
+ (mt (visited-file-modtime)))
+
+ (cond
+ ;; File exists, and has a known modtime.
+ ((and attr
+ (not
+ (tramp-compat-time-equal-p modtime tramp-time-dont-know)))
+ (< (abs (tramp-time-diff modtime mt)) 2))
+ ;; Modtime has the don't know value.
+ (attr
+ (tramp-send-command
+ v
+ (format "%s -ild %s"
+ (tramp-get-ls-command v)
+ (tramp-shell-quote-argument localname)))
+ (with-current-buffer (tramp-get-buffer v)
+ (setq attr (buffer-substring (point) (point-at-eol))))
+ (equal
+ attr
+ (tramp-get-file-property
+ v localname "visited-file-modtime-ild" "")))
+ ;; If file does not exist, say it is not modified if and
+ ;; only if that agrees with the buffer's record.
+ (t (tramp-compat-time-equal-p mt tramp-time-doesnt-exist)))))))))
+
+(defun tramp-sh-handle-set-file-modes (filename mode)
+ "Like `set-file-modes' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (tramp-flush-file-properties v (file-name-directory localname))
+ (tramp-flush-file-properties v localname)
+ ;; FIXME: extract the proper text from chmod's stderr.
+ (tramp-barf-unless-okay
+ v
+ (format "chmod %o %s" mode (tramp-shell-quote-argument localname))
+ "Error while changing file's mode %s" filename)))
+
+(defun tramp-sh-handle-set-file-times (filename &optional time)
+ "Like `set-file-times' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (when (tramp-get-remote-touch v)
+ (tramp-flush-file-properties v (file-name-directory localname))
+ (tramp-flush-file-properties v localname)
+ (let ((time
+ (if (or (null time)
+ (tramp-compat-time-equal-p time tramp-time-doesnt-exist)
+ (tramp-compat-time-equal-p time tramp-time-dont-know))
+ (current-time)
+ time)))
+ (tramp-send-command-and-check
+ v (format
+ "env TZ=UTC %s %s %s"
+ (tramp-get-remote-touch v)
+ (if (tramp-get-connection-property v "touch-t" nil)
+ (format "-t %s" (format-time-string "%Y%m%d%H%M.%S" time t))
+ "")
+ (tramp-shell-quote-argument localname)))))))
+
+(defun tramp-sh-handle-set-file-uid-gid (filename &optional uid gid)
+ "Like `tramp-set-file-uid-gid' for Tramp files."
+ ;; Modern Unices allow chown only for root. So we might need
+ ;; another implementation, see `dired-do-chown'. OTOH, it is mostly
+ ;; working with su(do)? when it is needed, so it shall succeed in
+ ;; the majority of cases.
+ ;; Don't modify `last-coding-system-used' by accident.
+ (let ((last-coding-system-used last-coding-system-used))
+ (with-parsed-tramp-file-name filename nil
+ (if (and (zerop (user-uid)) (tramp-local-host-p v))
+ ;; If we are root on the local host, we can do it directly.
+ (tramp-set-file-uid-gid localname uid gid)
+ (let ((uid (or (and (natnump uid) uid)
+ (tramp-get-remote-uid v 'integer)))
+ (gid (or (and (natnump gid) gid)
+ (tramp-get-remote-gid v 'integer))))
+ (tramp-send-command
+ v (format
+ "chown %d:%d %s" uid gid
+ (tramp-shell-quote-argument localname))))))))
+
+(defun tramp-remote-selinux-p (vec)
+ "Check, whether SELINUX is enabled on the remote host."
+ (with-tramp-connection-property (tramp-get-connection-process vec)
"selinux-p"
+ (tramp-send-command-and-check vec "selinuxenabled")))
+
+(defun tramp-sh-handle-file-selinux-context (filename)
+ "Like `file-selinux-context' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (with-tramp-file-property v localname "file-selinux-context"
+ (let ((context '(nil nil nil nil))
+ (regexp (eval-when-compile
+ (concat "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\):"
+ "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\)"))))
+ (when (and (tramp-remote-selinux-p v)
+ (tramp-send-command-and-check
+ v (format
+ "%s -d -Z %s"
+ (tramp-get-ls-command v)
+ (tramp-shell-quote-argument localname))))
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (goto-char (point-min))
+ (when (re-search-forward regexp (point-at-eol) t)
+ (setq context (list (match-string 1) (match-string 2)
+ (match-string 3) (match-string 4))))))
+ ;; Return the context.
+ context))))
+
+(defun tramp-sh-handle-set-file-selinux-context (filename context)
+ "Like `set-file-selinux-context' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (when (and (consp context)
+ (tramp-remote-selinux-p v))
+ (let ((user (and (stringp (nth 0 context)) (nth 0 context)))
+ (role (and (stringp (nth 1 context)) (nth 1 context)))
+ (type (and (stringp (nth 2 context)) (nth 2 context)))
+ (range (and (stringp (nth 3 context)) (nth 3 context))))
+ (when (tramp-send-command-and-check
+ v (format "chcon %s %s %s %s %s"
+ (if user (format "--user=%s" user) "")
+ (if role (format "--role=%s" role) "")
+ (if type (format "--type=%s" type) "")
+ (if range (format "--range=%s" range) "")
+ (tramp-shell-quote-argument localname)))
+ (if (and user role type range)
+ (tramp-set-file-property
+ v localname "file-selinux-context" context)
+ (tramp-flush-file-property v localname "file-selinux-context"))
+ t)))))
+
+(defun tramp-remote-acl-p (vec)
+ "Check, whether ACL is enabled on the remote host."
+ (with-tramp-connection-property (tramp-get-connection-process vec) "acl-p"
+ (tramp-send-command-and-check vec "getfacl /")))
+
+(defun tramp-sh-handle-file-acl (filename)
+ "Like `file-acl' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (with-tramp-file-property v localname "file-acl"
+ (when (and (tramp-remote-acl-p v)
+ (tramp-send-command-and-check
+ v (format
+ "getfacl -ac %s"
+ (tramp-shell-quote-argument localname))))
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (goto-char (point-max))
+ (delete-blank-lines)
+ (when (> (point-max) (point-min))
+ (substring-no-properties (buffer-string))))))))
+
+(defun tramp-sh-handle-set-file-acl (filename acl-string)
+ "Like `set-file-acl' for Tramp files."
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (if (and (stringp acl-string) (tramp-remote-acl-p v)
+ (progn
+ (tramp-send-command
+ v (format "setfacl --set-file=- %s <<'%s'\n%s\n%s\n"
+ (tramp-shell-quote-argument localname)
+ tramp-end-of-heredoc
+ acl-string
+ tramp-end-of-heredoc))
+ (tramp-send-command-and-check v nil)))
+ ;; Success.
+ (progn
+ (tramp-set-file-property v localname "file-acl" acl-string)
+ t)
+ ;; In case of errors, we return nil.
+ (tramp-flush-file-property v localname "file-acl-string")
+ nil)))
+
+;; Simple functions using the `test' command.
+
+(defun tramp-sh-handle-file-executable-p (filename)
+ "Like `file-executable-p' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (with-tramp-file-property v localname "file-executable-p"
+ ;; Examine `file-attributes' cache to see if request can be
+ ;; satisfied without remote operation.
+ (or (tramp-check-cached-permissions v ?x)
+ (tramp-run-test "-x" filename)))))
+
+(defun tramp-sh-handle-file-readable-p (filename)
+ "Like `file-readable-p' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (with-tramp-file-property v localname "file-readable-p"
+ ;; Examine `file-attributes' cache to see if request can be
+ ;; satisfied without remote operation.
+ (or (tramp-check-cached-permissions v ?r)
+ (tramp-run-test "-r" filename)))))
+
+;; When the remote shell is started, it looks for a shell which groks
+;; tilde expansion. Here, we assume that all shells which grok tilde
+;; expansion will also provide a `test' command which groks `-nt' (for
+;; newer than). If this breaks, tell me about it and I'll try to do
+;; something smarter about it.
+(defun tramp-sh-handle-file-newer-than-file-p (file1 file2)
+ "Like `file-newer-than-file-p' for Tramp files."
+ (cond ((not (file-exists-p file1)) nil)
+ ((not (file-exists-p file2)) t)
+ (t ;; We are sure both files exist at this point. We try to
+ ;; get the mtime of both files. If they are not equal to
+ ;; the "dont-know" value, then we subtract the times and
+ ;; obtain the result.
+ (let ((fa1 (file-attributes file1))
+ (fa2 (file-attributes file2)))
+ (if (and
+ (not
+ (tramp-compat-time-equal-p
+ (tramp-compat-file-attribute-modification-time fa1)
+ tramp-time-dont-know))
+ (not
+ (tramp-compat-time-equal-p
+ (tramp-compat-file-attribute-modification-time fa2)
+ tramp-time-dont-know)))
+ (time-less-p
+ (tramp-compat-file-attribute-modification-time fa2)
+ (tramp-compat-file-attribute-modification-time fa1))
+ ;; If one of them is the dont-know value, then we can
+ ;; still try to run a shell command on the remote host.
+ ;; However, this only works if both files are Tramp
+ ;; files and both have the same method, same user, same
+ ;; host.
+ (unless (tramp-equal-remote file1 file2)
+ (with-parsed-tramp-file-name
+ (if (tramp-tramp-file-p file1) file1 file2) nil
+ (tramp-error
+ v 'file-error
+ "Files %s and %s must have same method, user, host"
+ file1 file2)))
+ (with-parsed-tramp-file-name file1 nil
+ (tramp-run-test2
+ (tramp-get-test-nt-command v) file1 file2)))))))
+
+;; Functions implemented using the basic functions above.
+
+(defun tramp-sh-handle-file-directory-p (filename)
+ "Like `file-directory-p' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ ;; `file-directory-p' is used as predicate for file name completion.
+ ;; Sometimes, when a connection is not established yet, it is
+ ;; desirable to return t immediately for "/method:foo:". It can
+ ;; be expected that this is always a directory.
+ (or (zerop (length localname))
+ (with-tramp-file-property v localname "file-directory-p"
+ (tramp-run-test "-d" filename)))))
+
+(defun tramp-sh-handle-file-writable-p (filename)
+ "Like `file-writable-p' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (with-tramp-file-property v localname "file-writable-p"
+ (if (file-exists-p filename)
+ ;; Examine `file-attributes' cache to see if request can be
+ ;; satisfied without remote operation.
+ (or (tramp-check-cached-permissions v ?w)
+ (tramp-run-test "-w" filename))
+ ;; If file doesn't exist, check if directory is writable.
+ (and (tramp-run-test "-d" (file-name-directory filename))
+ (tramp-run-test "-w" (file-name-directory filename)))))))
+
+(defun tramp-sh-handle-file-ownership-preserved-p (filename &optional group)
+ "Like `file-ownership-preserved-p' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (with-tramp-file-property v localname "file-ownership-preserved-p"
+ (let ((attributes (file-attributes filename)))
+ ;; Return t if the file doesn't exist, since it's true that no
+ ;; information would be lost by an (attempted) delete and create.
+ (or (null attributes)
+ (and
+ (= (tramp-compat-file-attribute-user-id attributes)
+ (tramp-get-remote-uid v 'integer))
+ (or (not group)
+ (= (tramp-compat-file-attribute-group-id attributes)
+ (tramp-get-remote-gid v 'integer)))))))))
+
+;; Directory listings.
+
+(defun tramp-sh-handle-directory-files-and-attributes
+ (directory &optional full match nosort id-format)
+ "Like `directory-files-and-attributes' for Tramp files."
+ (unless id-format (setq id-format 'integer))
+ (when (file-directory-p directory)
+ (setq directory (expand-file-name directory))
+ (let* ((temp
+ (copy-tree
+ (with-parsed-tramp-file-name directory nil
+ (with-tramp-file-property
+ v localname
+ (format "directory-files-and-attributes-%s" id-format)
+ (mapcar
+ (lambda (x)
+ (cons (car x) (tramp-convert-file-attributes v (cdr x))))
+ (cond
+ ((tramp-get-remote-stat v)
+ (tramp-do-directory-files-and-attributes-with-stat
+ v localname id-format))
+ ((tramp-get-remote-perl v)
+ (tramp-do-directory-files-and-attributes-with-perl
+ v localname id-format))
+ (t nil)))))))
+ result item)
+
+ (while temp
+ (setq item (pop temp))
+ (when (or (null match) (string-match-p match (car item)))
+ (when full
+ (setcar item (expand-file-name (car item) directory)))
+ (push item result)))
+
+ (or (if nosort
+ result
+ (sort result (lambda (x y) (string< (car x) (car y)))))
+ ;; The scripts could fail, for example with huge file size.
+ (tramp-handle-directory-files-and-attributes
+ directory full match nosort id-format)))))
+
+(defun tramp-do-directory-files-and-attributes-with-perl
+ (vec localname &optional id-format)
+ "Implement `directory-files-and-attributes' for Tramp files using a Perl
script."
+ (tramp-message vec 5 "directory-files-and-attributes with perl: %s"
localname)
+ (tramp-maybe-send-script
+ vec tramp-perl-directory-files-and-attributes
+ "tramp_perl_directory_files_and_attributes")
+ (let ((object
+ (tramp-send-command-and-read
+ vec
+ (format "tramp_perl_directory_files_and_attributes %s %s"
+ (tramp-shell-quote-argument localname) id-format))))
+ (when (stringp object) (tramp-error vec 'file-error object))
+ object))
+
+(defun tramp-do-directory-files-and-attributes-with-stat
+ (vec localname &optional id-format)
+ "Implement `directory-files-and-attributes' for Tramp files using stat(1)
command."
+ (tramp-message vec 5 "directory-files-and-attributes with stat: %s"
localname)
+ (tramp-send-command-and-read
+ vec
+ (format
+ (eval-when-compile
+ (concat
+ ;; We must care about file names with spaces, or starting with
+ ;; "-"; this would confuse xargs. "ls -aQ" might be a
+ ;; solution, but it does not work on all remote systems.
+ ;; Apostrophes in the stat output are masked as
+ ;; `tramp-stat-marker', in order to make a proper shell escape
+ ;; of them in file names.
+ "cd %s && echo \"(\"; (%s %s -a | "
+ "xargs %s -c "
+ "'(%s%%n%s (%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' "
+ "-- 2>/dev/null | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g'); echo \")\""))
+ (tramp-shell-quote-argument localname)
+ (tramp-get-ls-command vec)
+ ;; On systems which have no quoting style, file names with special
+ ;; characters could fail.
+ (tramp-sh--quoting-style-options vec)
+ (tramp-get-remote-stat vec)
+ tramp-stat-marker tramp-stat-marker
+ tramp-stat-marker tramp-stat-marker
+ (if (eq id-format 'integer)
+ "%u"
+ (eval-when-compile (concat tramp-stat-marker "%U" tramp-stat-marker)))
+ (if (eq id-format 'integer)
+ "%g"
+ (eval-when-compile (concat tramp-stat-marker "%G" tramp-stat-marker)))
+ tramp-stat-marker tramp-stat-marker
+ tramp-stat-quoted-marker)))
+
+;; This function should return "foo/" for directories and "bar" for
+;; files.
+(defun tramp-sh-handle-file-name-all-completions (filename directory)
+ "Like `file-name-all-completions' for Tramp files."
+ (unless (string-match-p "/" filename)
+ (all-completions
+ filename
+ (with-parsed-tramp-file-name (expand-file-name directory) nil
+ (with-tramp-file-property v localname "file-name-all-completions"
+ (let (result)
+ ;; Get a list of directories and files, including reliably
+ ;; tagging the directories with a trailing "/". Because I
+ ;; rock. address@hidden
+ (tramp-send-command
+ v
+ (if (tramp-get-remote-perl v)
+ (progn
+ (tramp-maybe-send-script
+ v tramp-perl-file-name-all-completions
+ "tramp_perl_file_name_all_completions")
+ (format "tramp_perl_file_name_all_completions %s"
+ (tramp-shell-quote-argument localname)))
+
+ (format (eval-when-compile
+ (concat
+ "(cd %s 2>&1 && %s -a 2>/dev/null"
+ " | while IFS= read f; do"
+ " if %s -d \"$f\" 2>/dev/null;"
+ " then \\echo \"$f/\"; else \\echo \"$f\"; fi; done"
+ " && \\echo ok) || \\echo fail"))
+ (tramp-shell-quote-argument localname)
+ (tramp-get-ls-command v)
+ (tramp-get-test-command v))))
+
+ ;; Now grab the output.
+ (with-current-buffer (tramp-get-buffer v)
+ (goto-char (point-max))
+
+ ;; Check result code, found in last line of output.
+ (forward-line -1)
+ (if (looking-at-p "^fail$")
+ (progn
+ ;; Grab error message from line before last line
+ ;; (it was put there by `cd 2>&1').
+ (forward-line -1)
+ (tramp-error
+ v 'file-error
+ "tramp-sh-handle-file-name-all-completions: %s"
+ (buffer-substring (point) (point-at-eol))))
+ ;; For peace of mind, if buffer doesn't end in `fail'
+ ;; then it should end in `ok'. If neither are in the
+ ;; buffer something went seriously wrong on the remote
+ ;; side.
+ (unless (looking-at-p "^ok$")
+ (tramp-error
+ v 'file-error "\
+tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'"
+ (tramp-shell-quote-argument localname) (buffer-string))))
+
+ (while (zerop (forward-line -1))
+ (push (buffer-substring (point) (point-at-eol)) result)))
+ result))))))
+
+;; cp, mv and ln
+
+(defun tramp-sh-handle-add-name-to-file
+ (filename newname &optional ok-if-already-exists)
+ "Like `add-name-to-file' for Tramp files."
+ (unless (tramp-equal-remote filename newname)
+ (with-parsed-tramp-file-name
+ (if (tramp-tramp-file-p filename) filename newname) nil
+ (tramp-error
+ v 'file-error
+ "add-name-to-file: %s"
+ "only implemented for same method, same user, same host")))
+ (with-parsed-tramp-file-name filename v1
+ (with-parsed-tramp-file-name newname v2
+ (let ((ln (when v1 (tramp-get-remote-ln v1))))
+
+ ;; Do the 'confirm if exists' thing.
+ (when (file-exists-p newname)
+ ;; What to do?
+ (if (or (null ok-if-already-exists) ; not allowed to exist
+ (and (numberp ok-if-already-exists)
+ (not (yes-or-no-p
+ (format
+ "File %s already exists; make it a link anyway? "
+ v2-localname)))))
+ (tramp-error v2 'file-already-exists newname)
+ (delete-file newname)))
+ (tramp-flush-file-properties v2 (file-name-directory v2-localname))
+ (tramp-flush-file-properties v2 v2-localname)
+ (tramp-barf-unless-okay
+ v1
+ (format "%s %s %s" ln
+ (tramp-shell-quote-argument v1-localname)
+ (tramp-shell-quote-argument v2-localname))
+ "error with add-name-to-file, see buffer `%s' for details"
+ (buffer-name))))))
+
+(defun tramp-sh-handle-copy-file
+ (filename newname &optional ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes)
+ "Like `copy-file' for Tramp files."
+ (setq filename (expand-file-name filename)
+ newname (expand-file-name newname))
+ (if (or (tramp-tramp-file-p filename)
+ (tramp-tramp-file-p newname))
+ (tramp-do-copy-or-rename-file
+ 'copy filename newname ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes)
+ (tramp-run-real-handler
+ 'copy-file
+ (list filename newname ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes))))
+
+(defun tramp-sh-handle-copy-directory
+ (dirname newname &optional keep-date parents copy-contents)
+ "Like `copy-directory' for Tramp files."
+ (let ((t1 (tramp-tramp-file-p dirname))
+ (t2 (tramp-tramp-file-p newname)))
+ (with-parsed-tramp-file-name (if t1 dirname newname) nil
+ (if (and (not copy-contents)
+ (tramp-get-method-parameter v 'tramp-copy-recursive)
+ ;; When DIRNAME and NEWNAME are remote, they must have
+ ;; the same method.
+ (or (null t1) (null t2)
+ (string-equal
+ (tramp-file-name-method (tramp-dissect-file-name dirname))
+ (tramp-file-name-method
+ (tramp-dissect-file-name newname)))))
+ ;; scp or rsync DTRT.
+ (progn
+ (when (and (file-directory-p newname)
+ (not (tramp-compat-directory-name-p newname)))
+ (tramp-error v 'file-already-exists newname))
+ (setq dirname (directory-file-name (expand-file-name dirname))
+ newname (directory-file-name (expand-file-name newname)))
+ (when (and (file-directory-p newname)
+ (not (string-equal (file-name-nondirectory dirname)
+ (file-name-nondirectory newname))))
+ (setq newname
+ (expand-file-name
+ (file-name-nondirectory dirname) newname)))
+ (unless (file-directory-p (file-name-directory newname))
+ (make-directory (file-name-directory newname) parents))
+ (tramp-do-copy-or-rename-file-out-of-band
+ 'copy dirname newname keep-date))
+
+ ;; We must do it file-wise.
+ (tramp-run-real-handler
+ 'copy-directory
+ (list dirname newname keep-date parents copy-contents)))
+
+ ;; When newname did exist, we have wrong cached values.
+ (when t2
+ (with-parsed-tramp-file-name newname nil
+ (tramp-flush-file-properties v (file-name-directory localname))
+ (tramp-flush-file-properties v localname))))))
+
+(defun tramp-sh-handle-rename-file
+ (filename newname &optional ok-if-already-exists)
+ "Like `rename-file' for Tramp files."
+ ;; Check if both files are local -- invoke normal rename-file.
+ ;; Otherwise, use Tramp from local system.
+ (setq filename (expand-file-name filename))
+ (setq newname (expand-file-name newname))
+ ;; At least one file a Tramp file?
+ (if (or (tramp-tramp-file-p filename)
+ (tramp-tramp-file-p newname))
+ (tramp-do-copy-or-rename-file
+ 'rename filename newname ok-if-already-exists
+ 'keep-time 'preserve-uid-gid)
+ (tramp-run-real-handler
+ #'rename-file (list filename newname ok-if-already-exists))))
+
+(defun tramp-do-copy-or-rename-file
+ (op filename newname &optional ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes)
+ "Copy or rename a remote file.
+OP must be `copy' or `rename' and indicates the operation to perform.
+FILENAME specifies the file to copy or rename, NEWNAME is the name of
+the new file (for copy) or the new name of the file (for rename).
+OK-IF-ALREADY-EXISTS means don't barf if NEWNAME exists already.
+KEEP-DATE means to make sure that NEWNAME has the same timestamp
+as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep
+the uid and gid if both files are on the same host.
+PRESERVE-EXTENDED-ATTRIBUTES activates selinux and acl commands.
+
+This function is invoked by `tramp-sh-handle-copy-file' and
+`tramp-sh-handle-rename-file'. It is an error if OP is neither
+of `copy' and `rename'. FILENAME and NEWNAME must be absolute
+file names."
+ (unless (memq op '(copy rename))
+ (error "Unknown operation `%s', must be `copy' or `rename'" op))
+
+ (if (and
+ (file-directory-p filename)
+ (not (tramp-equal-remote filename newname)))
+ (progn
+ (copy-directory filename newname keep-date t)
+ (when (eq op 'rename) (delete-directory filename 'recursive)))
+
+ (let ((t1 (tramp-tramp-file-p filename))
+ (t2 (tramp-tramp-file-p newname))
+ (length (tramp-compat-file-attribute-size
+ (file-attributes (file-truename filename))))
+ ;; `file-extended-attributes' exists since Emacs 24.4.
+ (attributes (and preserve-extended-attributes
+ (apply #'file-extended-attributes (list filename)))))
+
+ (with-parsed-tramp-file-name (if t1 filename newname) nil
+ (when (and (not ok-if-already-exists) (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+
+ (with-tramp-progress-reporter
+ v 0 (format "%s %s to %s"
+ (if (eq op 'copy) "Copying" "Renaming")
+ filename newname)
+
+ (cond
+ ;; Both are Tramp files.
+ ((and t1 t2)
+ (with-parsed-tramp-file-name filename v1
+ (with-parsed-tramp-file-name newname v2
+ (cond
+ ;; Shortcut: if method, host, user are the same for
+ ;; both files, we invoke `cp' or `mv' on the remote
+ ;; host directly.
+ ((tramp-equal-remote filename newname)
+ (tramp-do-copy-or-rename-file-directly
+ op filename newname
+ ok-if-already-exists keep-date preserve-uid-gid))
+
+ ;; Try out-of-band operation.
+ ((and
+ (tramp-method-out-of-band-p v1 length)
+ (tramp-method-out-of-band-p v2 length))
+ (tramp-do-copy-or-rename-file-out-of-band
+ op filename newname keep-date))
+
+ ;; No shortcut was possible. So we copy the file
+ ;; first. If the operation was `rename', we go back
+ ;; and delete the original file (if the copy was
+ ;; successful). The approach is simple-minded: we
+ ;; create a new buffer, insert the contents of the
+ ;; source file into it, then write out the buffer to
+ ;; the target file. The advantage is that it doesn't
+ ;; matter which file name handlers are used for the
+ ;; source and target file.
+ (t
+ (tramp-do-copy-or-rename-file-via-buffer
+ op filename newname keep-date))))))
+
+ ;; One file is a Tramp file, the other one is local.
+ ((or t1 t2)
+ (cond
+ ;; Fast track on local machine.
+ ((tramp-local-host-p v)
+ (tramp-do-copy-or-rename-file-directly
+ op filename newname
+ ok-if-already-exists keep-date preserve-uid-gid))
+
+ ;; If the Tramp file has an out-of-band method, the
+ ;; corresponding copy-program can be invoked.
+ ((tramp-method-out-of-band-p v length)
+ (tramp-do-copy-or-rename-file-out-of-band
+ op filename newname keep-date))
+
+ ;; Use the inline method via a Tramp buffer.
+ (t (tramp-do-copy-or-rename-file-via-buffer
+ op filename newname keep-date))))
+
+ (t
+ ;; One of them must be a Tramp file.
+ (error "Tramp implementation says this cannot happen")))
+
+ ;; Handle `preserve-extended-attributes'. We ignore possible
+ ;; errors, because ACL strings could be incompatible.
+ ;; `set-file-extended-attributes' exists since Emacs 24.4.
+ (when attributes
+ (ignore-errors
+ (apply #'set-file-extended-attributes (list newname attributes))))
+
+ ;; In case of `rename', we must flush the cache of the source file.
+ (when (and t1 (eq op 'rename))
+ (with-parsed-tramp-file-name filename v1
+ (tramp-flush-file-properties
+ v1 (file-name-directory v1-localname))
+ (tramp-flush-file-properties v1 v1-localname)))
+
+ ;; When newname did exist, we have wrong cached values.
+ (when t2
+ (with-parsed-tramp-file-name newname v2
+ (tramp-flush-file-properties
+ v2 (file-name-directory v2-localname))
+ (tramp-flush-file-properties v2 v2-localname))))))))
+
+(defun tramp-do-copy-or-rename-file-via-buffer (op filename newname keep-date)
+ "Use an Emacs buffer to copy or rename a file.
+First arg OP is either `copy' or `rename' and indicates the operation.
+FILENAME is the source file, NEWNAME the target file.
+KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME."
+ ;; Check, whether file is too large. Emacs checks in `insert-file-1'
+ ;; and `find-file-noselect', but that's not called here.
+ (abort-if-file-too-large
+ (tramp-compat-file-attribute-size (file-attributes (file-truename
filename)))
+ (symbol-name op) filename)
+ ;; We must disable multibyte, because binary data shall not be
+ ;; converted. We don't want the target file to be compressed, so we
+ ;; let-bind `jka-compr-inhibit' to t. `epa-file-handler' shall not
+ ;; be called either. We remove `tramp-file-name-handler' from
+ ;; `inhibit-file-name-handlers'; otherwise the file name handler for
+ ;; `insert-file-contents' might be deactivated in some corner cases.
+ (let ((coding-system-for-read 'binary)
+ (coding-system-for-write 'binary)
+ (jka-compr-inhibit t)
+ (inhibit-file-name-operation 'write-region)
+ (inhibit-file-name-handlers
+ (cons 'epa-file-handler
+ (remq 'tramp-file-name-handler inhibit-file-name-handlers))))
+ (with-temp-file newname
+ (set-buffer-multibyte nil)
+ (insert-file-contents-literally filename)))
+ ;; KEEP-DATE handling.
+ (when keep-date
+ (set-file-times
+ newname
+ (tramp-compat-file-attribute-modification-time
+ (file-attributes filename))))
+ ;; Set the mode.
+ (set-file-modes newname (tramp-default-file-modes filename))
+ ;; If the operation was `rename', delete the original file.
+ (unless (eq op 'copy) (delete-file filename)))
+
+(defun tramp-do-copy-or-rename-file-directly
+ (op filename newname ok-if-already-exists keep-date preserve-uid-gid)
+ "Invokes `cp' or `mv' on the remote system.
+OP must be one of `copy' or `rename', indicating `cp' or `mv',
+respectively. FILENAME specifies the file to copy or rename,
+NEWNAME is the name of the new file (for copy) or the new name of
+the file (for rename). Both files must reside on the same host.
+KEEP-DATE means to make sure that NEWNAME has the same timestamp
+as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep
+the uid and gid from FILENAME."
+ (let ((t1 (tramp-tramp-file-p filename))
+ (t2 (tramp-tramp-file-p newname))
+ (file-times (tramp-compat-file-attribute-modification-time
+ (file-attributes filename)))
+ (file-modes (tramp-default-file-modes filename)))
+ (with-parsed-tramp-file-name (if t1 filename newname) nil
+ (let* ((cmd (cond ((and (eq op 'copy) preserve-uid-gid) "cp -f -p")
+ ((eq op 'copy) "cp -f")
+ ((eq op 'rename) "mv -f")
+ (t (tramp-error
+ v 'file-error
+ "Unknown operation `%s', must be `copy' or `rename'"
+ op))))
+ (localname1 (tramp-compat-file-local-name filename))
+ (localname2 (tramp-compat-file-local-name newname))
+ (prefix (file-remote-p (if t1 filename newname)))
+ cmd-result)
+ (when (and (eq op 'copy) (file-directory-p filename))
+ (setq cmd (concat cmd " -R")))
+
+ (cond
+ ;; Both files are on a remote host, with same user.
+ ((and t1 t2)
+ (setq cmd-result
+ (tramp-send-command-and-check
+ v (format "%s %s %s" cmd
+ (tramp-shell-quote-argument localname1)
+ (tramp-shell-quote-argument localname2))))
+ (with-current-buffer (tramp-get-buffer v)
+ (goto-char (point-min))
+ (unless
+ (or
+ (and keep-date
+ ;; Mask cp -f error.
+ (re-search-forward
+ tramp-operation-not-permitted-regexp nil t))
+ cmd-result)
+ (tramp-error-with-buffer
+ nil v 'file-error
+ "Copying directly failed, see buffer `%s' for details."
+ (buffer-name)))))
+
+ ;; We are on the local host.
+ ((or t1 t2)
+ (cond
+ ;; We can do it directly.
+ ((let (file-name-handler-alist)
+ (and (file-readable-p localname1)
+ ;; No sticky bit when renaming.
+ (or (eq op 'copy)
+ (zerop
+ (logand
+ (file-modes (file-name-directory localname1)) #o1000)))
+ (file-writable-p (file-name-directory localname2))
+ (or (file-directory-p localname2)
+ (file-writable-p localname2))))
+ (if (eq op 'copy)
+ (copy-file
+ localname1 localname2 ok-if-already-exists
+ keep-date preserve-uid-gid)
+ (tramp-run-real-handler
+ #'rename-file
+ (list localname1 localname2 ok-if-already-exists))))
+
+ ;; We can do it directly with `tramp-send-command'
+ ((and (file-readable-p (concat prefix localname1))
+ (file-writable-p
+ (file-name-directory (concat prefix localname2)))
+ (or (file-directory-p (concat prefix localname2))
+ (file-writable-p (concat prefix localname2))))
+ (tramp-do-copy-or-rename-file-directly
+ op (concat prefix localname1) (concat prefix localname2)
+ ok-if-already-exists keep-date t)
+ ;; We must change the ownership to the local user.
+ (tramp-set-file-uid-gid
+ (concat prefix localname2)
+ (tramp-get-local-uid 'integer)
+ (tramp-get-local-gid 'integer)))
+
+ ;; We need a temporary file in between.
+ (t
+ ;; Create the temporary file.
+ (let ((tmpfile (tramp-compat-make-temp-file localname1)))
+ (unwind-protect
+ (progn
+ (cond
+ (t1
+ (tramp-barf-unless-okay
+ v (format
+ "%s %s %s" cmd
+ (tramp-shell-quote-argument localname1)
+ (tramp-shell-quote-argument tmpfile))
+ "Copying directly failed, see buffer `%s' for details."
+ (tramp-get-buffer v))
+ ;; We must change the ownership as remote user.
+ ;; Since this does not work reliable, we also
+ ;; give read permissions.
+ (set-file-modes (concat prefix tmpfile) #o0777)
+ (tramp-set-file-uid-gid
+ (concat prefix tmpfile)
+ (tramp-get-local-uid 'integer)
+ (tramp-get-local-gid 'integer)))
+ (t2
+ (if (eq op 'copy)
+ (copy-file
+ localname1 tmpfile t keep-date preserve-uid-gid)
+ (tramp-run-real-handler
+ #'rename-file (list localname1 tmpfile t)))
+ ;; We must change the ownership as local user.
+ ;; Since this does not work reliable, we also
+ ;; give read permissions.
+ (set-file-modes tmpfile #o0777)
+ (tramp-set-file-uid-gid
+ tmpfile
+ (tramp-get-remote-uid v 'integer)
+ (tramp-get-remote-gid v 'integer))))
+
+ ;; Move the temporary file to its destination.
+ (cond
+ (t2
+ (tramp-barf-unless-okay
+ v (format
+ "cp -f -p %s %s"
+ (tramp-shell-quote-argument tmpfile)
+ (tramp-shell-quote-argument localname2))
+ "Copying directly failed, see buffer `%s' for details."
+ (tramp-get-buffer v)))
+ (t1
+ (tramp-run-real-handler
+ #'rename-file
+ (list tmpfile localname2 ok-if-already-exists)))))
+
+ ;; Save exit.
+ (ignore-errors (delete-file tmpfile)))))))))
+
+ ;; Set the time and mode. Mask possible errors.
+ (ignore-errors
+ (when keep-date
+ (set-file-times newname file-times)
+ (set-file-modes newname file-modes))))))
+
+(defun tramp-do-copy-or-rename-file-out-of-band (op filename newname keep-date)
+ "Invoke `scp' program to copy.
+The method used must be an out-of-band method."
+ (let* ((t1 (tramp-tramp-file-p filename))
+ (t2 (tramp-tramp-file-p newname))
+ (orig-vec (tramp-dissect-file-name (if t1 filename newname)))
+ copy-program copy-args copy-env copy-keep-date listener spec
+ options source target remote-copy-program remote-copy-args)
+
+ (with-parsed-tramp-file-name (if t1 filename newname) nil
+ (if (and t1 t2)
+
+ ;; Both are Tramp files. We shall optimize it when the
+ ;; methods for FILENAME and NEWNAME are the same.
+ (let* ((dir-flag (file-directory-p filename))
+ (tmpfile (tramp-compat-make-temp-file localname dir-flag)))
+ (if dir-flag
+ (setq tmpfile
+ (expand-file-name
+ (file-name-nondirectory newname) tmpfile)))
+ (unwind-protect
+ (progn
+ (tramp-do-copy-or-rename-file-out-of-band
+ op filename tmpfile keep-date)
+ (tramp-do-copy-or-rename-file-out-of-band
+ 'rename tmpfile newname keep-date))
+ ;; Save exit.
+ (ignore-errors
+ (if dir-flag
+ (delete-directory
+ (expand-file-name ".." tmpfile) 'recursive)
+ (delete-file tmpfile)))))
+
+ ;; Check which ones of source and target are Tramp files.
+ (setq source (funcall
+ (if (and (file-directory-p filename)
+ (not (file-exists-p newname)))
+ #'file-name-as-directory
+ #'identity)
+ (if t1
+ (tramp-make-copy-program-file-name v)
+ (tramp-unquote-shell-quote-argument filename)))
+ target (if t2
+ (tramp-make-copy-program-file-name v)
+ (tramp-unquote-shell-quote-argument newname)))
+
+ ;; Check for user. There might be an interactive setting.
+ (setq user (or (tramp-file-name-user v)
+ (tramp-get-connection-property v "login-as" nil)))
+
+ ;; Check for listener port.
+ (when (tramp-get-method-parameter v 'tramp-remote-copy-args)
+ (setq listener (number-to-string (+ 50000 (random 10000))))
+ (while
+ (zerop (tramp-call-process v "nc" nil nil nil "-z" host listener))
+ (setq listener (number-to-string (+ 50000 (random 10000))))))
+
+ ;; Compose copy command.
+ (setq host (or host "")
+ user (or user "")
+ port (or port "")
+ spec (format-spec-make
+ ?t (tramp-get-connection-property
+ (tramp-get-connection-process v) "temp-file" ""))
+ options (format-spec (tramp-ssh-controlmaster-options v) spec)
+ spec (format-spec-make
+ ?h host ?u user ?p port ?r listener ?c options
+ ?k (if keep-date " " ""))
+ copy-program (tramp-get-method-parameter v 'tramp-copy-program)
+ copy-keep-date (tramp-get-method-parameter
+ v 'tramp-copy-keep-date)
+
+ copy-args
+ (delete
+ ;; " " has either been a replacement of "%k" (when
+ ;; keep-date argument is non-nil), or a replacement
+ ;; for the whole keep-date sublist.
+ " "
+ (dolist
+ (x (tramp-get-method-parameter v 'tramp-copy-args) copy-args)
+ (setq copy-args
+ (append
+ copy-args
+ (let ((y (mapcar (lambda (z) (format-spec z spec)) x)))
+ (if (member "" y) '(" ") y))))))
+
+ copy-env
+ (delq
+ nil
+ (mapcar
+ (lambda (x)
+ (setq x (mapcar (lambda (y) (format-spec y spec)) x))
+ (unless (member "" x) (mapconcat #'identity x " ")))
+ (tramp-get-method-parameter v 'tramp-copy-env)))
+
+ remote-copy-program
+ (tramp-get-method-parameter v 'tramp-remote-copy-program))
+
+ (dolist (x (tramp-get-method-parameter v 'tramp-remote-copy-args))
+ (setq remote-copy-args
+ (append
+ remote-copy-args
+ (let ((y (mapcar (lambda (z) (format-spec z spec)) x)))
+ (if (member "" y) '(" ") y)))))
+
+ ;; Check for local copy program.
+ (unless (executable-find copy-program)
+ (tramp-error
+ v 'file-error "Cannot find local copy program: %s" copy-program))
+
+ ;; Install listener on the remote side. The prompt must be
+ ;; consumed later on, when the process does not listen anymore.
+ (when remote-copy-program
+ (unless (with-tramp-connection-property
+ v (concat "remote-copy-program-" remote-copy-program)
+ (tramp-find-executable
+ v remote-copy-program (tramp-get-remote-path v)))
+ (tramp-error
+ v 'file-error
+ "Cannot find remote listener: %s" remote-copy-program))
+ (setq remote-copy-program
+ (mapconcat
+ #'identity
+ (append
+ (list remote-copy-program) remote-copy-args
+ (list (if t1 (concat "<" source) (concat ">" target)) "&"))
+ " "))
+ (tramp-send-command v remote-copy-program)
+ (with-timeout
+ (60 (tramp-error
+ v 'file-error
+ "Listener process not running on remote host: `%s'"
+ remote-copy-program))
+ (tramp-send-command v (format "netstat -l | grep -q :%s" listener))
+ (while (not (tramp-send-command-and-check v nil))
+ (tramp-send-command
+ v (format "netstat -l | grep -q :%s" listener)))))
+
+ (with-temp-buffer
+ (unwind-protect
+ ;; The default directory must be remote.
+ (let ((default-directory
+ (file-name-directory (if t1 filename newname)))
+ (process-environment (copy-sequence process-environment)))
+ ;; Set the transfer process properties.
+ (tramp-set-connection-property
+ v "process-name" (buffer-name (current-buffer)))
+ (tramp-set-connection-property
+ v "process-buffer" (current-buffer))
+ (while copy-env
+ (tramp-message
+ orig-vec 6 "%s=\"%s\"" (car copy-env) (cadr copy-env))
+ (setenv (pop copy-env) (pop copy-env)))
+ (setq
+ copy-args
+ (append
+ copy-args
+ (if remote-copy-program
+ (list (if t1 (concat ">" target) (concat "<" source)))
+ (list source target))))
+
+ ;; Use an asynchronous process. By this, password can
+ ;; be handled. We don't set a timeout, because the
+ ;; copying of large files can last longer than 60 secs.
+ (let* ((command
+ (mapconcat
+ #'identity (append (list copy-program) copy-args)
+ " "))
+ (p (let ((default-directory
+ (tramp-compat-temporary-file-directory)))
+ (start-process-shell-command
+ (tramp-get-connection-name v)
+ (tramp-get-connection-buffer v)
+ command))))
+ (tramp-message orig-vec 6 "%s" command)
+ (process-put p 'vector orig-vec)
+ (process-put p 'adjust-window-size-function #'ignore)
+ (set-process-query-on-exit-flag p nil)
+
+ ;; We must adapt `tramp-local-end-of-line' for
+ ;; sending the password.
+ (let ((tramp-local-end-of-line tramp-rsh-end-of-line))
+ (tramp-process-actions
+ p v nil tramp-actions-copy-out-of-band))))
+
+ ;; Reset the transfer process properties.
+ (tramp-flush-connection-property v "process-name")
+ (tramp-flush-connection-property v "process-buffer")
+ ;; Clear the remote prompt.
+ (when (and remote-copy-program
+ (not (tramp-send-command-and-check v nil)))
+ ;; Houston, we have a problem! Likely, the listener is
+ ;; still running, so let's clear everything (but the
+ ;; cached password).
+ (tramp-cleanup-connection v 'keep-debug 'keep-password))))
+
+ ;; Handle KEEP-DATE argument.
+ (when (and keep-date (not copy-keep-date))
+ (set-file-times
+ newname
+ (tramp-compat-file-attribute-modification-time
+ (file-attributes filename))))
+
+ ;; Set the mode.
+ (unless (and keep-date copy-keep-date)
+ (ignore-errors
+ (set-file-modes newname (tramp-default-file-modes filename)))))
+
+ ;; If the operation was `rename', delete the original file.
+ (unless (eq op 'copy)
+ (if (file-regular-p filename)
+ (delete-file filename)
+ (delete-directory filename 'recursive))))))
+
+(defun tramp-sh-handle-make-directory (dir &optional parents)
+ "Like `make-directory' for Tramp files."
+ (setq dir (expand-file-name dir))
+ (with-parsed-tramp-file-name dir nil
+ ;; When PARENTS is non-nil, DIR could be a chain of non-existent
+ ;; directories a/b/c/... Instead of checking, we simply flush the
+ ;; whole cache.
+ (tramp-flush-directory-properties
+ v (if parents "/" (file-name-directory localname)))
+ (tramp-barf-unless-okay
+ v (format "%s %s"
+ (if parents "mkdir -p" "mkdir")
+ (tramp-shell-quote-argument localname))
+ "Couldn't make directory %s" dir)))
+
+(defun tramp-sh-handle-delete-directory (directory &optional recursive trash)
+ "Like `delete-directory' for Tramp files."
+ (setq directory (expand-file-name directory))
+ (with-parsed-tramp-file-name directory nil
+ (tramp-flush-file-properties v (file-name-directory localname))
+ (tramp-flush-directory-properties v localname)
+ (tramp-barf-unless-okay
+ v (format "cd / && %s %s"
+ (or (and trash (tramp-get-remote-trash v))
+ (if recursive "rm -rf" "rmdir"))
+ (tramp-shell-quote-argument localname))
+ "Couldn't delete %s" directory)))
+
+(defun tramp-sh-handle-delete-file (filename &optional trash)
+ "Like `delete-file' for Tramp files."
+ (setq filename (expand-file-name filename))
+ (with-parsed-tramp-file-name filename nil
+ (tramp-flush-file-properties v (file-name-directory localname))
+ (tramp-flush-file-properties v localname)
+ (tramp-barf-unless-okay
+ v (format "%s %s"
+ (or (and trash (tramp-get-remote-trash v)) "rm -f")
+ (tramp-shell-quote-argument localname))
+ "Couldn't delete %s" filename)))
+
+;; Dired.
+
+(defun tramp-sh-handle-dired-compress-file (file)
+ "Like `dired-compress-file' for Tramp files."
+ ;; Code stolen mainly from dired-aux.el.
+ (with-parsed-tramp-file-name file nil
+ (tramp-flush-file-properties v localname)
+ (let ((suffixes dired-compress-file-suffixes)
+ suffix)
+ ;; See if any suffix rule matches this file name.
+ (while suffixes
+ (let (case-fold-search)
+ (if (string-match-p (car (car suffixes)) localname)
+ (setq suffix (car suffixes) suffixes nil))
+ (setq suffixes (cdr suffixes))))
+
+ (cond ((file-symlink-p file) nil)
+ ((and suffix (nth 2 suffix))
+ ;; We found an uncompression rule.
+ (with-tramp-progress-reporter
+ v 0 (format "Uncompressing %s" file)
+ (when (tramp-send-command-and-check
+ v (concat (nth 2 suffix) " "
+ (tramp-shell-quote-argument localname)))
+ (dired-remove-file file)
+ (string-match (car suffix) file)
+ (concat (substring file 0 (match-beginning 0))))))
+ (t
+ ;; We don't recognize the file as compressed, so compress it.
+ ;; Try gzip.
+ (with-tramp-progress-reporter v 0 (format "Compressing %s" file)
+ (when (tramp-send-command-and-check
+ v (concat "gzip -f "
+ (tramp-shell-quote-argument localname)))
+ (dired-remove-file file)
+ (cond ((file-exists-p (concat file ".gz"))
+ (concat file ".gz"))
+ ((file-exists-p (concat file ".z"))
+ (concat file ".z"))
+ (t nil)))))))))
+
+(defun tramp-sh-handle-insert-directory
+ (filename switches &optional wildcard full-directory-p)
+ "Like `insert-directory' for Tramp files."
+ (setq filename (expand-file-name filename))
+ (unless switches (setq switches ""))
+ ;; Check, whether directory is accessible.
+ (unless wildcard
+ (access-file filename "Reading directory"))
+ (with-parsed-tramp-file-name filename nil
+ (if (and (featurep 'ls-lisp)
+ (not (symbol-value 'ls-lisp-use-insert-directory-program)))
+ (tramp-handle-insert-directory
+ filename switches wildcard full-directory-p)
+ (when (stringp switches)
+ (setq switches (split-string switches)))
+ (when (tramp-get-ls-command-with ;FIXME: tramp-sh--quoting-style-options?
+ v "--quoting-style=literal --show-control-chars")
+ (setq switches
+ (append
+ switches '("--quoting-style=literal" "--show-control-chars"))))
+ (unless (tramp-get-ls-command-with v "--dired")
+ (setq switches (delete "--dired" switches)))
+ (when wildcard
+ (setq wildcard (tramp-run-real-handler
+ #'file-name-nondirectory (list localname)))
+ (setq localname (tramp-run-real-handler
+ #'file-name-directory (list localname))))
+ (unless (or full-directory-p (member "-d" switches))
+ (setq switches (append switches '("-d"))))
+ (setq switches (mapconcat #'tramp-shell-quote-argument switches " "))
+ (when wildcard
+ (setq switches (concat switches " " wildcard)))
+ (tramp-message
+ v 4 "Inserting directory `ls %s %s', wildcard %s, fulldir %s"
+ switches filename (if wildcard "yes" "no")
+ (if full-directory-p "yes" "no"))
+ ;; If `full-directory-p', we just say `ls -l FILENAME'.
+ ;; Else we chdir to the parent directory, then say `ls -ld BASENAME'.
+ (if full-directory-p
+ (tramp-send-command
+ v
+ (format "%s %s %s 2>/dev/null"
+ (tramp-get-ls-command v)
+ switches
+ (if wildcard
+ localname
+ (tramp-shell-quote-argument (concat localname ".")))))
+ (tramp-barf-unless-okay
+ v
+ (format "cd %s" (tramp-shell-quote-argument
+ (tramp-run-real-handler
+ #'file-name-directory (list localname))))
+ "Couldn't `cd %s'"
+ (tramp-shell-quote-argument
+ (tramp-run-real-handler #'file-name-directory (list localname))))
+ (tramp-send-command
+ v
+ (format "%s %s %s 2>/dev/null"
+ (tramp-get-ls-command v)
+ switches
+ (if (or wildcard
+ (zerop (length
+ (tramp-run-real-handler
+ #'file-name-nondirectory (list localname)))))
+ ""
+ (tramp-shell-quote-argument
+ (tramp-run-real-handler
+ #'file-name-nondirectory (list localname)))))))
+
+ (save-restriction
+ (let ((beg (point)))
+ (narrow-to-region (point) (point))
+ ;; We cannot use `insert-buffer-substring' because the Tramp
+ ;; buffer changes its contents before insertion due to calling
+ ;; `expand-file-name' and alike.
+ (insert
+ (with-current-buffer (tramp-get-buffer v)
+ (buffer-string)))
+
+ ;; Check for "--dired" output.
+ (forward-line -2)
+ (when (looking-at-p "//SUBDIRED//")
+ (forward-line -1))
+ (when (looking-at "//DIRED//\\s-+")
+ (let ((databeg (match-end 0))
+ (end (point-at-eol)))
+ ;; Now read the numeric positions of file names.
+ (goto-char databeg)
+ (while (< (point) end)
+ (let ((start (+ beg (read (current-buffer))))
+ (end (+ beg (read (current-buffer)))))
+ (if (memq (char-after end) '(?\n ?\ ))
+ ;; End is followed by \n or by " -> ".
+ (put-text-property start end 'dired-filename t))))))
+ ;; Remove trailing lines.
+ (goto-char (point-at-bol))
+ (while (looking-at "//")
+ (forward-line 1)
+ (delete-region (match-beginning 0) (point)))
+
+ ;; Some busyboxes are reluctant to discard colors.
+ (unless
+ (string-match-p "color" (tramp-get-connection-property v "ls" ""))
+ (goto-char beg)
+ (while
+ (re-search-forward tramp-display-escape-sequence-regexp nil t)
+ (replace-match "")))
+
+ ;; Decode the output, it could be multibyte.
+ (decode-coding-region
+ beg (point-max)
+ (or file-name-coding-system default-file-name-coding-system))
+
+ ;; The inserted file could be from somewhere else.
+ (when (and (not wildcard) (not full-directory-p))
+ (goto-char (point-max))
+ (when (file-symlink-p filename)
+ (goto-char (search-backward "->" beg 'noerror)))
+ (search-backward
+ (if (zerop (length (file-name-nondirectory filename)))
+ "."
+ (file-name-nondirectory filename))
+ beg 'noerror)
+ (replace-match (file-relative-name filename) t))
+
+ ;; Try to insert the amount of free space.
+ (goto-char (point-min))
+ ;; First find the line to put it on.
+ (when (re-search-forward "^\\([[:space:]]*total\\)" nil t)
+ (let ((available (get-free-disk-space ".")))
+ (when available
+ ;; Replace "total" with "total used", to avoid confusion.
+ (replace-match "\\1 used in directory")
+ (end-of-line)
+ (insert " available " available))))
+
+ (goto-char (point-max)))))))
+
+;; Canonicalization of file names.
+
+(defun tramp-sh-handle-expand-file-name (name &optional dir)
+ "Like `expand-file-name' for Tramp files.
+If the localname part of the given file name starts with \"/../\" then
+the result will be a local, non-Tramp, file name."
+ ;; If DIR is not given, use `default-directory' or "/".
+ (setq dir (or dir default-directory "/"))
+ ;; Handle empty NAME.
+ (when (zerop (length name)) (setq name "."))
+ ;; Unless NAME is absolute, concat DIR and NAME.
+ (unless (file-name-absolute-p name)
+ (setq name (concat (file-name-as-directory dir) name)))
+ ;; If connection is not established yet, run the real handler.
+ (if (not (tramp-connectable-p name))
+ (tramp-run-real-handler #'expand-file-name (list name nil))
+ ;; Dissect NAME.
+ (with-parsed-tramp-file-name name nil
+ (unless (tramp-run-real-handler #'file-name-absolute-p (list localname))
+ (setq localname (concat "~/" localname)))
+ ;; Tilde expansion if necessary. This needs a shell which
+ ;; groks tilde expansion! The function `tramp-find-shell' is
+ ;; supposed to find such a shell on the remote host. Please
+ ;; tell me about it when this doesn't work on your system.
+ (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
+ (let ((uname (match-string 1 localname))
+ (fname (match-string 2 localname)))
+ ;; We cannot simply apply "~/", because under sudo "~/" is
+ ;; expanded to the local user home directory but to the
+ ;; root home directory. On the other hand, using always
+ ;; the default user name for tilde expansion is not
+ ;; appropriate either, because ssh and companions might
+ ;; use a user name from the config file.
+ (when (and (string-equal uname "~")
+ (string-match-p "\\`su\\(do\\)?\\'" method))
+ (setq uname (concat uname user)))
+ (setq uname
+ (with-tramp-connection-property v uname
+ (tramp-send-command
+ v (format "cd %s && pwd" (tramp-shell-quote-argument uname)))
+ (with-current-buffer (tramp-get-buffer v)
+ (goto-char (point-min))
+ (buffer-substring (point) (point-at-eol)))))
+ (setq localname (concat uname fname))))
+ ;; There might be a double slash, for example when "~/"
+ ;; expands to "/". Remove this.
+ (while (string-match "//" localname)
+ (setq localname (replace-match "/" t t localname)))
+ ;; No tilde characters in file name, do normal
+ ;; `expand-file-name' (this does "/./" and "/../").
+ ;; `default-directory' is bound, because on Windows there would
+ ;; be problems with UNC shares or Cygwin mounts.
+ (let ((default-directory (tramp-compat-temporary-file-directory)))
+ (tramp-make-tramp-file-name
+ v (tramp-drop-volume-letter
+ (tramp-run-real-handler
+ #'expand-file-name (list localname))))))))
+
+;;; Remote commands:
+
+;; We use BUFFER also as connection buffer during setup. Because of
+;; this, its original contents must be saved, and restored once
+;; connection has been setup.
+(defun tramp-sh-handle-make-process (&rest args)
+ "Like `make-process' for Tramp files."
+ (when args
+ (with-parsed-tramp-file-name (expand-file-name default-directory) nil
+ (let ((name (plist-get args :name))
+ (buffer (plist-get args :buffer))
+ (command (plist-get args :command))
+ (coding (plist-get args :coding))
+ (noquery (plist-get args :noquery))
+ (connection-type (plist-get args :connection-type))
+ (filter (plist-get args :filter))
+ (sentinel (plist-get args :sentinel))
+ (stderr (plist-get args :stderr)))
+ (unless (stringp name)
+ (signal 'wrong-type-argument (list #'stringp name)))
+ (unless (or (null buffer) (bufferp buffer) (stringp buffer))
+ (signal 'wrong-type-argument (list #'stringp buffer)))
+ (unless (consp command)
+ (signal 'wrong-type-argument (list #'consp command)))
+ (unless (or (null coding)
+ (and (symbolp coding) (memq coding coding-system-list))
+ (and (consp coding)
+ (memq (car coding) coding-system-list)
+ (memq (cdr coding) coding-system-list)))
+ (signal 'wrong-type-argument (list #'symbolp coding)))
+ (unless (or (null connection-type) (memq connection-type '(pipe pty)))
+ (signal 'wrong-type-argument (list #'symbolp connection-type)))
+ (unless (or (null filter) (functionp filter))
+ (signal 'wrong-type-argument (list #'functionp filter)))
+ (unless (or (null sentinel) (functionp sentinel))
+ (signal 'wrong-type-argument (list #'functionp sentinel)))
+ (unless (or (null stderr) (bufferp stderr) (stringp stderr))
+ (signal 'wrong-type-argument (list #'stringp stderr)))
+
+ (let* ((buffer
+ (if buffer
+ (get-buffer-create buffer)
+ ;; BUFFER can be nil. We use a temporary buffer.
+ (generate-new-buffer tramp-temp-buffer-name)))
+ (stderr (and stderr (get-buffer-create stderr)))
+ (tmpstderr (and stderr (tramp-make-tramp-temp-file v)))
+ (program (car command))
+ (args (cdr command))
+ ;; When PROGRAM matches "*sh", and the first arg is
+ ;; "-c", it might be that the arguments exceed the
+ ;; command line length. Therefore, we modify the
+ ;; command.
+ (heredoc (and (stringp program)
+ (string-match-p "sh$" program)
+ (string-equal "-c" (car args))
+ (= (length args) 2)))
+ ;; When PROGRAM is nil, we just provide a tty.
+ (args (if (not heredoc) args
+ (let ((i 250))
+ (while (and (< i (length (cadr args)))
+ (string-match " " (cadr args) i))
+ (setcdr
+ args
+ (list
+ (replace-match " \\\\\n" nil nil (cadr args))))
+ (setq i (+ i 250))))
+ (cdr args)))
+ ;; Use a human-friendly prompt, for example for
+ ;; `shell'. We discard hops, if existing, that's why
+ ;; we cannot use `file-remote-p'.
+ (prompt (format "PS1=%s %s"
+ (tramp-make-tramp-file-name v nil 'nohop)
+ tramp-initial-end-of-output))
+ ;; We use as environment the difference to toplevel
+ ;; `process-environment'.
+ env uenv
+ (env (dolist (elt (cons prompt process-environment) env)
+ (or (member
+ elt (default-toplevel-value 'process-environment))
+ (if (string-match-p "=" elt)
+ (setq env (append env `(,elt)))
+ (if (tramp-get-env-with-u-option v)
+ (setq env (append `("-u" ,elt) env))
+ (setq uenv (cons elt uenv)))))))
+ (command
+ (when (stringp program)
+ (format "cd %s && %s exec %s %s env %s %s"
+ (tramp-shell-quote-argument localname)
+ (if uenv
+ (format
+ "unset %s &&"
+ (mapconcat
+ #'tramp-shell-quote-argument uenv " "))
+ "")
+ (if heredoc (format "<<'%s'" tramp-end-of-heredoc) "")
+ (if tmpstderr (format "2>'%s'" tmpstderr) "")
+ (mapconcat #'tramp-shell-quote-argument env " ")
+ (if heredoc
+ (format "%s\n(\n%s\n) </dev/tty\n%s"
+ program (car args) tramp-end-of-heredoc)
+ (mapconcat #'tramp-shell-quote-argument
+ (cons program args) " ")))))
+ (tramp-process-connection-type
+ (or (null program) tramp-process-connection-type))
+ (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
+ (name1 name)
+ (i 0)
+ ;; We do not want to raise an error when `make-process'
+ ;; has been started several times in `eshell' and
+ ;; friends.
+ tramp-current-connection
+ p)
+
+ (while (get-process name1)
+ ;; NAME must be unique as process name.
+ (setq i (1+ i)
+ name1 (format "%s<%d>" name i)))
+ (setq name name1)
+ ;; Set the new process properties.
+ (tramp-set-connection-property v "process-name" name)
+ (tramp-set-connection-property v "process-buffer" buffer)
+
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (unwind-protect
+ ;; We catch this event. Otherwise, `make-process' could
+ ;; be called on the local host.
+ (save-excursion
+ (save-restriction
+ ;; Activate narrowing in order to save BUFFER
+ ;; contents. Clear also the modification time;
+ ;; otherwise we might be interrupted by
+ ;; `verify-visited-file-modtime'.
+ (let ((buffer-undo-list t)
+ (inhibit-read-only t)
+ (mark (point-max)))
+ (clear-visited-file-modtime)
+ (narrow-to-region (point-max) (point-max))
+ ;; We call `tramp-maybe-open-connection', in
+ ;; order to cleanup the prompt afterwards.
+ (catch 'suppress
+ (tramp-maybe-open-connection v)
+ (setq p (tramp-get-connection-process v))
+ ;; Set the pid of the remote shell. This is
+ ;; needed when sending signals remotely.
+ (let ((pid (tramp-send-command-and-read v "echo $$")))
+ (process-put p 'remote-pid pid)
+ (tramp-set-connection-property p "remote-pid" pid))
+ ;; `tramp-maybe-open-connection' and
+ ;; `tramp-send-command-and-read' could have
+ ;; trashed the connection buffer. Remove this.
+ (widen)
+ (delete-region mark (point-max))
+ (narrow-to-region (point-max) (point-max))
+ ;; Now do it.
+ (if command
+ ;; Send the command.
+ (tramp-send-command v command nil t) ; nooutput
+ ;; Check, whether a pty is associated.
+ (unless (process-get p 'remote-tty)
+ (tramp-error
+ v 'file-error
+ "pty association is not supported for `%s'"
+ name))))
+ ;; Set sentinel and filter.
+ (when sentinel
+ (set-process-sentinel p sentinel))
+ (when filter
+ (set-process-filter p filter))
+ ;; Set query flag and process marker for this
+ ;; process. We ignore errors, because the
+ ;; process could have finished already.
+ (ignore-errors
+ (set-process-query-on-exit-flag p (null noquery))
+ (set-marker (process-mark p) (point)))
+ ;; Provide error buffer. This shows only
+ ;; initial error messages; messages arriving
+ ;; later on shall be inserted by `auto-revert'.
+ ;; The temporary file will still be existing.
+ ;; TODO: Write a sentinel, which deletes the
+ ;; temporary file.
+ (when tmpstderr
+ ;; We must flush them here already; otherwise
+ ;; `insert-file-contents' will fail.
+ (tramp-flush-connection-property v "process-name")
+ (tramp-flush-connection-property v "process-buffer")
+ (with-current-buffer stderr
+ (insert-file-contents
+ (tramp-make-tramp-file-name v tmpstderr) 'visit)
+ (auto-revert-mode)))
+ ;; Return process.
+ p)))
+
+ ;; Save exit.
+ (if (string-match-p tramp-temp-buffer-name (buffer-name))
+ (ignore-errors
+ (set-process-buffer p nil)
+ (kill-buffer (current-buffer)))
+ (set-buffer-modified-p bmp))
+ (tramp-flush-connection-property v "process-name")
+ (tramp-flush-connection-property v "process-buffer"))))))))
+
+(defun tramp-sh-handle-process-file
+ (program &optional infile destination display &rest args)
+ "Like `process-file' for Tramp files."
+ ;; The implementation is not complete yet.
+ (when (and (numberp destination) (zerop destination))
+ (error "Implementation does not handle immediate return"))
+
+ (with-parsed-tramp-file-name default-directory nil
+ (let (command env uenv input tmpinput stderr tmpstderr outbuf ret)
+ ;; Compute command.
+ (setq command (mapconcat #'tramp-shell-quote-argument
+ (cons program args) " "))
+ ;; We use as environment the difference to toplevel
`process-environment'.
+ (dolist (elt process-environment)
+ (or (member elt (default-toplevel-value 'process-environment))
+ (if (string-match-p "=" elt)
+ (setq env (append env `(,elt)))
+ (if (tramp-get-env-with-u-option v)
+ (setq env (append `("-u" ,elt) env))
+ (setq uenv (cons elt uenv))))))
+ (when env
+ (setq command
+ (format
+ "env %s %s"
+ (mapconcat #'tramp-shell-quote-argument env " ") command)))
+ (when uenv
+ (setq command
+ (format
+ "unset %s && %s"
+ (mapconcat #'tramp-shell-quote-argument uenv " ") command)))
+ ;; Determine input.
+ (if (null infile)
+ (setq input "/dev/null")
+ (setq infile (expand-file-name infile))
+ (if (tramp-equal-remote default-directory infile)
+ ;; INFILE is on the same remote host.
+ (setq input (with-parsed-tramp-file-name infile nil localname))
+ ;; INFILE must be copied to remote host.
+ (setq input (tramp-make-tramp-temp-file v)
+ tmpinput (tramp-make-tramp-file-name v input 'nohop))
+ (copy-file infile tmpinput t)))
+ (when input (setq command (format "%s <%s" command input)))
+
+ ;; Determine output.
+ (cond
+ ;; Just a buffer.
+ ((bufferp destination)
+ (setq outbuf destination))
+ ;; A buffer name.
+ ((stringp destination)
+ (setq outbuf (get-buffer-create destination)))
+ ;; (REAL-DESTINATION ERROR-DESTINATION)
+ ((consp destination)
+ ;; output.
+ (cond
+ ((bufferp (car destination))
+ (setq outbuf (car destination)))
+ ((stringp (car destination))
+ (setq outbuf (get-buffer-create (car destination))))
+ ((car destination)
+ (setq outbuf (current-buffer))))
+ ;; stderr.
+ (cond
+ ((stringp (cadr destination))
+ (setcar (cdr destination) (expand-file-name (cadr destination)))
+ (if (tramp-equal-remote default-directory (cadr destination))
+ ;; stderr is on the same remote host.
+ (setq stderr (with-parsed-tramp-file-name
+ (cadr destination) nil localname))
+ ;; stderr must be copied to remote host. The temporary
+ ;; file must be deleted after execution.
+ (setq stderr (tramp-make-tramp-temp-file v)
+ tmpstderr (tramp-make-tramp-file-name v stderr 'nohop))))
+ ;; stderr to be discarded.
+ ((null (cadr destination))
+ (setq stderr "/dev/null"))))
+ ;; 't
+ (destination
+ (setq outbuf (current-buffer))))
+ (when stderr (setq command (format "%s 2>%s" command stderr)))
+
+ ;; Send the command. It might not return in time, so we protect
+ ;; it. Call it in a subshell, in order to preserve working
+ ;; directory.
+ (condition-case nil
+ (unwind-protect
+ (setq ret
+ (if (tramp-send-command-and-check
+ v (format "cd %s && %s"
+ (tramp-shell-quote-argument localname)
+ command)
+ t t)
+ 0 1))
+ ;; We should add the output anyway.
+ (when outbuf
+ (with-current-buffer outbuf
+ (insert
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (buffer-string))))
+ (when (and display (get-buffer-window outbuf t)) (redisplay))))
+ ;; When the user did interrupt, we should do it also. We use
+ ;; return code -1 as marker.
+ (quit
+ (kill-buffer (tramp-get-connection-buffer v))
+ (setq ret -1))
+ ;; Handle errors.
+ (error
+ (kill-buffer (tramp-get-connection-buffer v))
+ (setq ret 1)))
+
+ ;; Provide error file.
+ (when tmpstderr (rename-file tmpstderr (cadr destination) t))
+
+ ;; Cleanup. We remove all file cache values for the connection,
+ ;; because the remote process could have changed them.
+ (when tmpinput (delete-file tmpinput))
+
+ (unless process-file-side-effects
+ (tramp-flush-directory-properties v ""))
+
+ ;; Return exit status.
+ (if (equal ret -1)
+ (keyboard-quit)
+ ret))))
+
+(defun tramp-sh-handle-exec-path ()
+ "Like `exec-path' for Tramp files."
+ (append
+ (tramp-get-remote-path (tramp-dissect-file-name default-directory))
+ ;; The equivalent to `exec-directory'.
+ `(,(tramp-compat-file-local-name default-directory))))
+
+(defun tramp-sh-handle-file-local-copy (filename)
+ "Like `file-local-copy' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (unless (file-exists-p (file-truename filename))
+ (tramp-error
+ v tramp-file-missing
+ "Cannot make local copy of non-existing file `%s'" filename))
+
+ (let* ((size (tramp-compat-file-attribute-size
+ (file-attributes (file-truename filename))))
+ (rem-enc (tramp-get-inline-coding v "remote-encoding" size))
+ (loc-dec (tramp-get-inline-coding v "local-decoding" size))
+ (tmpfile (tramp-compat-make-temp-file filename)))
+
+ (condition-case err
+ (cond
+ ;; `copy-file' handles direct copy and out-of-band methods.
+ ((or (tramp-local-host-p v)
+ (tramp-method-out-of-band-p v size))
+ (copy-file filename tmpfile 'ok-if-already-exists 'keep-time))
+
+ ;; Use inline encoding for file transfer.
+ (rem-enc
+ (with-tramp-progress-reporter
+ v 3
+ (format-message
+ "Encoding remote file `%s' with `%s'" filename rem-enc)
+ (tramp-barf-unless-okay
+ v (format rem-enc (tramp-shell-quote-argument localname))
+ "Encoding remote file failed"))
+
+ (with-tramp-progress-reporter
+ v 3 (format-message
+ "Decoding local file `%s' with `%s'" tmpfile loc-dec)
+ (if (functionp loc-dec)
+ ;; If local decoding is a function, we call it. We
+ ;; must disable multibyte, because
+ ;; `uudecode-decode-region' doesn't handle it
+ ;; correctly. Unset `file-name-handler-alist'.
+ ;; Otherwise, epa-file gets confused.
+ (let (file-name-handler-alist
+ (coding-system-for-write 'binary))
+ (with-temp-file tmpfile
+ (set-buffer-multibyte nil)
+ (insert-buffer-substring (tramp-get-buffer v))
+ (funcall loc-dec (point-min) (point-max))))
+
+ ;; If tramp-decoding-function is not defined for this
+ ;; method, we invoke tramp-decoding-command instead.
+ (let ((tmpfile2 (tramp-compat-make-temp-file filename)))
+ ;; Unset `file-name-handler-alist'. Otherwise,
+ ;; epa-file gets confused.
+ (let (file-name-handler-alist
+ (coding-system-for-write 'binary))
+ (with-current-buffer (tramp-get-buffer v)
+ (write-region
+ (point-min) (point-max) tmpfile2 nil 'no-message)))
+ (unwind-protect
+ (tramp-call-local-coding-command
+ loc-dec tmpfile2 tmpfile)
+ (delete-file tmpfile2)))))
+
+ ;; Set proper permissions.
+ (set-file-modes tmpfile (tramp-default-file-modes filename))
+ ;; Set local user ownership.
+ (tramp-set-file-uid-gid tmpfile))
+
+ ;; Oops, I don't know what to do.
+ (t (tramp-error
+ v 'file-error "Wrong method specification for `%s'" method)))
+
+ ;; Error handling.
+ ((error quit)
+ (delete-file tmpfile)
+ (signal (car err) (cdr err))))
+
+ (run-hooks 'tramp-handle-file-local-copy-hook)
+ tmpfile)))
+
+;; CCC grok LOCKNAME
+(defun tramp-sh-handle-write-region
+ (start end filename &optional append visit lockname mustbenew)
+ "Like `write-region' for Tramp files."
+ (setq filename (expand-file-name filename))
+ (with-parsed-tramp-file-name filename nil
+ (when (and mustbenew (file-exists-p filename)
+ (or (eq mustbenew 'excl)
+ (not
+ (y-or-n-p
+ (format "File %s exists; overwrite anyway? " filename)))))
+ (tramp-error v 'file-already-exists filename))
+
+ (let ((uid (or (tramp-compat-file-attribute-user-id
+ (file-attributes filename 'integer))
+ (tramp-get-remote-uid v 'integer)))
+ (gid (or (tramp-compat-file-attribute-group-id
+ (file-attributes filename 'integer))
+ (tramp-get-remote-gid v 'integer))))
+
+ (if (and (tramp-local-host-p v)
+ ;; `file-writable-p' calls `file-expand-file-name'. We
+ ;; cannot use `tramp-run-real-handler' therefore.
+ (let (file-name-handler-alist)
+ (and
+ (file-writable-p (file-name-directory localname))
+ (or (file-directory-p localname)
+ (file-writable-p localname)))))
+ ;; Short track: if we are on the local host, we can run directly.
+ (tramp-run-real-handler
+ #'write-region
+ (list start end localname append 'no-message lockname))
+
+ (let* ((modes (save-excursion (tramp-default-file-modes filename)))
+ ;; We use this to save the value of
+ ;; `last-coding-system-used' after writing the tmp
+ ;; file. At the end of the function, we set
+ ;; `last-coding-system-used' to this saved value. This
+ ;; way, any intermediary coding systems used while
+ ;; talking to the remote shell or suchlike won't hose
+ ;; this variable. This approach was snarfed from
+ ;; ange-ftp.el.
+ coding-system-used
+ ;; Write region into a tmp file. This isn't really
+ ;; needed if we use an encoding function, but currently
+ ;; we use it always because this makes the logic
+ ;; simpler. We must also set `temporary-file-directory',
+ ;; because it could point to a remote directory.
+ (temporary-file-directory
+ (tramp-compat-temporary-file-directory))
+ (tmpfile (or tramp-temp-buffer-file-name
+ (tramp-compat-make-temp-file filename))))
+
+ ;; If `append' is non-nil, we copy the file locally, and let
+ ;; the native `write-region' implementation do the job.
+ (when append (copy-file filename tmpfile 'ok))
+
+ ;; We say `no-message' here because we don't want the
+ ;; visited file modtime data to be clobbered from the temp
+ ;; file. We call `set-visited-file-modtime' ourselves later
+ ;; on. We must ensure that `file-coding-system-alist'
+ ;; matches `tmpfile'.
+ (let (file-name-handler-alist
+ (file-coding-system-alist
+ (tramp-find-file-name-coding-system-alist filename tmpfile)))
+ (condition-case err
+ (tramp-run-real-handler
+ #'write-region
+ (list start end tmpfile append 'no-message lockname))
+ ((error quit)
+ (setq tramp-temp-buffer-file-name nil)
+ (delete-file tmpfile)
+ (signal (car err) (cdr err))))
+
+ ;; Now, `last-coding-system-used' has the right value. Remember it.
+ (setq coding-system-used last-coding-system-used))
+
+ ;; The permissions of the temporary file should be set. If
+ ;; FILENAME does not exist (eq modes nil) it has been
+ ;; renamed to the backup file. This case `save-buffer'
+ ;; handles permissions.
+ ;; Ensure that it is still readable.
+ (when modes
+ (set-file-modes tmpfile (logior (or modes 0) #o0400)))
+
+ ;; This is a bit lengthy due to the different methods
+ ;; possible for file transfer. First, we check whether the
+ ;; method uses an scp program. If so, we call it.
+ ;; Otherwise, both encoding and decoding command must be
+ ;; specified. However, if the method _also_ specifies an
+ ;; encoding function, then that is used for encoding the
+ ;; contents of the tmp file.
+ (let* ((size (tramp-compat-file-attribute-size
+ (file-attributes tmpfile)))
+ (rem-dec (tramp-get-inline-coding v "remote-decoding" size))
+ (loc-enc (tramp-get-inline-coding v "local-encoding" size)))
+ (cond
+ ;; `copy-file' handles direct copy and out-of-band methods.
+ ((or (tramp-local-host-p v)
+ (tramp-method-out-of-band-p v size))
+ (if (and (not (stringp start))
+ (= (or end (point-max)) (point-max))
+ (= (or start (point-min)) (point-min))
+ (tramp-get-method-parameter v 'tramp-copy-keep-tmpfile))
+ (progn
+ (setq tramp-temp-buffer-file-name tmpfile)
+ (condition-case err
+ ;; We keep the local file for performance
+ ;; reasons, useful for "rsync".
+ (copy-file tmpfile filename t)
+ ((error quit)
+ (setq tramp-temp-buffer-file-name nil)
+ (delete-file tmpfile)
+ (signal (car err) (cdr err)))))
+ (setq tramp-temp-buffer-file-name nil)
+ ;; Don't rename, in order to keep context in SELinux.
+ (unwind-protect
+ (copy-file tmpfile filename t)
+ (delete-file tmpfile))))
+
+ ;; Use inline file transfer.
+ (rem-dec
+ ;; Encode tmpfile.
+ (unwind-protect
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ ;; Use encoding function or command.
+ (with-tramp-progress-reporter
+ v 3 (format-message
+ "Encoding local file `%s' using `%s'"
+ tmpfile loc-enc)
+ (if (functionp loc-enc)
+ ;; The following `let' is a workaround for
+ ;; the base64.el that comes with pgnus-0.84.
+ ;; If both of the following conditions are
+ ;; satisfied, it tries to write to a local
+ ;; file in default-directory, but at this
+ ;; point, default-directory is remote.
+ ;; (`call-process-region' can't write to
+ ;; remote files, it seems.) The file in
+ ;; question is a tmp file anyway.
+ (let ((coding-system-for-read 'binary)
+ (default-directory
+ (tramp-compat-temporary-file-directory)))
+ (insert-file-contents-literally tmpfile)
+ (funcall loc-enc (point-min) (point-max)))
+
+ (unless (zerop (tramp-call-local-coding-command
+ loc-enc tmpfile t))
+ (tramp-error
+ v 'file-error
+ (eval-when-compile
+ (concat "Cannot write to `%s', "
+ "local encoding command `%s' failed"))
+ filename loc-enc))))
+
+ ;; Send buffer into remote decoding command which
+ ;; writes to remote file. Because this happens on
+ ;; the remote host, we cannot use the function.
+ (with-tramp-progress-reporter
+ v 3 (format-message
+ "Decoding remote file `%s' using `%s'"
+ filename rem-dec)
+ (goto-char (point-max))
+ (unless (bolp) (newline))
+ (tramp-send-command
+ v
+ (format
+ (concat rem-dec " <<'%s'\n%s%s")
+ (tramp-shell-quote-argument localname)
+ tramp-end-of-heredoc
+ (buffer-string)
+ tramp-end-of-heredoc))
+ (tramp-barf-unless-okay
+ v nil
+ "Couldn't write region to `%s', decode using `%s' failed"
+ filename rem-dec)
+ ;; When `file-precious-flag' is set, the region is
+ ;; written to a temporary file. Check that the
+ ;; checksum is equal to that from the local tmpfile.
+ (when file-precious-flag
+ (erase-buffer)
+ (and
+ ;; cksum runs locally, if possible.
+ (zerop (tramp-call-process v "cksum" tmpfile t))
+ ;; cksum runs remotely.
+ (tramp-send-command-and-check
+ v
+ (format
+ "cksum <%s" (tramp-shell-quote-argument localname)))
+ ;; ... they are different.
+ (not
+ (string-equal
+ (buffer-string)
+ (with-current-buffer (tramp-get-buffer v)
+ (buffer-string))))
+ (tramp-error
+ v 'file-error
+ (eval-when-compile
+ (concat "Couldn't write region to `%s',"
+ " decode using `%s' failed"))
+ filename rem-dec)))))
+
+ ;; Save exit.
+ (delete-file tmpfile)))
+
+ ;; That's not expected.
+ (t
+ (tramp-error
+ v 'file-error
+ (eval-when-compile
+ (concat "Method `%s' should specify both encoding and "
+ "decoding command or an scp program"))
+ method))))
+
+ ;; Make `last-coding-system-used' have the right value.
+ (when coding-system-used
+ (set 'last-coding-system-used coding-system-used))))
+
+ (tramp-flush-file-properties v (file-name-directory localname))
+ (tramp-flush-file-properties v localname)
+
+ ;; We must protect `last-coding-system-used', now we have set it
+ ;; to its correct value.
+ (let (last-coding-system-used (need-chown t))
+ ;; Set file modification time.
+ (when (or (eq visit t) (stringp visit))
+ (let ((file-attr (file-attributes filename 'integer)))
+ (set-visited-file-modtime
+ ;; We must pass modtime explicitly, because FILENAME can
+ ;; be different from (buffer-file-name), f.e. if
+ ;; `file-precious-flag' is set.
+ (tramp-compat-file-attribute-modification-time file-attr))
+ (when (and (= (tramp-compat-file-attribute-user-id file-attr) uid)
+ (= (tramp-compat-file-attribute-group-id file-attr)
gid))
+ (setq need-chown nil))))
+
+ ;; Set the ownership.
+ (when need-chown
+ (tramp-set-file-uid-gid filename uid gid))
+ (when (and (null noninteractive)
+ (or (eq visit t) (null visit) (stringp visit)))
+ (tramp-message v 0 "Wrote %s" filename))
+ (run-hooks 'tramp-handle-write-region-hook)))))
+
+(defvar tramp-vc-registered-file-names nil
+ "List used to collect file names, which are checked during `vc-registered'.")
+
+;; VC backends check for the existence of various different special
+;; files. This is very time consuming, because every single check
+;; requires a remote command (the file cache must be invalidated).
+;; Therefore, we apply a kind of optimization. We install the file
+;; name handler `tramp-vc-file-name-handler', which does nothing but
+;; remembers all file names for which `file-exists-p' or
+;; `file-readable-p' has been applied. A first run of `vc-registered'
+;; is performed. Afterwards, a script is applied for all collected
+;; file names, using just one remote command. The result of this
+;; script is used to fill the file cache with actual values. Now we
+;; can reset the file name handlers, and we make a second run of
+;; `vc-registered', which returns the expected result without sending
+;; any other remote command.
+(defun tramp-sh-handle-vc-registered (file)
+ "Like `vc-registered' for Tramp files."
+ (when vc-handled-backends
+ (with-temp-message ""
+ (with-parsed-tramp-file-name file nil
+ (with-tramp-progress-reporter
+ v 3 (format-message "Checking `vc-registered' for %s" file)
+
+ ;; There could be new files, created by the vc backend. We
+ ;; cannot reuse the old cache entries, therefore. In
+ ;; `tramp-get-file-property', `remote-file-name-inhibit-cache'
+ ;; could also be a timestamp as `current-time' returns. This
+ ;; means invalidate all cache entries with an older timestamp.
+ (let (tramp-vc-registered-file-names
+ (remote-file-name-inhibit-cache (current-time))
+ (file-name-handler-alist
+ `((,tramp-file-name-regexp . tramp-vc-file-name-handler))))
+
+ ;; Here we collect only file names, which need an operation.
+ (tramp-with-demoted-errors
+ v "Error in 1st pass of `vc-registered': %s"
+ (tramp-run-real-handler #'vc-registered (list file)))
+ (tramp-message v 10 "\n%s" tramp-vc-registered-file-names)
+
+ ;; Send just one command, in order to fill the cache.
+ (when tramp-vc-registered-file-names
+ (tramp-maybe-send-script
+ v
+ (format tramp-vc-registered-read-file-names
+ (tramp-get-file-exists-command v)
+ (format "%s -r" (tramp-get-test-command v)))
+ "tramp_vc_registered_read_file_names")
+
+ (dolist
+ (elt
+ (ignore-errors
+ ;; We cannot use `tramp-send-command-and-read',
+ ;; because this does not cooperate well with
+ ;; heredoc documents.
+ (tramp-send-command
+ v
+ (format
+ "tramp_vc_registered_read_file_names <<'%s'\n%s\n%s\n"
+ tramp-end-of-heredoc
+ (mapconcat #'tramp-shell-quote-argument
+ tramp-vc-registered-file-names
+ "\n")
+ tramp-end-of-heredoc))
+ (with-current-buffer (tramp-get-connection-buffer v)
+ ;; Read the expression.
+ (goto-char (point-min))
+ (read (current-buffer)))))
+
+ (tramp-set-file-property
+ v (car elt) (cadr elt) (cadr (cdr elt))))))
+
+ ;; Second run. Now all `file-exists-p' or `file-readable-p'
+ ;; calls shall be answered from the file cache. We unset
+ ;; `process-file-side-effects' and `remote-file-name-inhibit-cache'
+ ;; in order to keep the cache.
+ (let ((vc-handled-backends vc-handled-backends)
+ remote-file-name-inhibit-cache process-file-side-effects)
+ ;; Reduce `vc-handled-backends' in order to minimize process calls.
+ (when (and (memq 'Bzr vc-handled-backends)
+ (boundp 'vc-bzr-program)
+ (not (with-tramp-connection-property v vc-bzr-program
+ (tramp-find-executable
+ v vc-bzr-program (tramp-get-remote-path v)))))
+ (setq vc-handled-backends (remq 'Bzr vc-handled-backends)))
+ (when (and (memq 'Git vc-handled-backends)
+ (boundp 'vc-git-program)
+ (not (with-tramp-connection-property v vc-git-program
+ (tramp-find-executable
+ v vc-git-program (tramp-get-remote-path v)))))
+ (setq vc-handled-backends (remq 'Git vc-handled-backends)))
+ (when (and (memq 'Hg vc-handled-backends)
+ (boundp 'vc-hg-program)
+ (not (with-tramp-connection-property v vc-hg-program
+ (tramp-find-executable
+ v vc-hg-program (tramp-get-remote-path v)))))
+ (setq vc-handled-backends (remq 'Hg vc-handled-backends)))
+ ;; Run.
+ (tramp-with-demoted-errors
+ v "Error in 2nd pass of `vc-registered': %s"
+ (tramp-run-real-handler #'vc-registered (list file)))))))))
+
+;;;###tramp-autoload
+(defun tramp-sh-file-name-handler (operation &rest args)
+ "Invoke remote-shell Tramp file name handler.
+Fall back to normal file name handler if no Tramp handler exists."
+ (let ((fn (assoc operation tramp-sh-file-name-handler-alist)))
+ (if fn
+ (save-match-data (apply (cdr fn) args))
+ (tramp-run-real-handler operation args))))
+
+;; This must be the last entry, because `identity' always matches.
+;;;###tramp-autoload
+(tramp--with-startup
+ (tramp-register-foreign-file-name-handler
+ #'identity #'tramp-sh-file-name-handler 'append))
+
+(defun tramp-vc-file-name-handler (operation &rest args)
+ "Invoke special file name handler, which collects files to be handled."
+ (save-match-data
+ (let ((filename
+ (tramp-replace-environment-variables
+ (apply #'tramp-file-name-for-operation operation args)))
+ (fn (assoc operation tramp-sh-file-name-handler-alist)))
+ (if (tramp-tramp-file-p filename)
+ (with-parsed-tramp-file-name filename nil
+ (cond
+ ;; That's what we want: file names, for which checks are
+ ;; applied. We assume that VC uses only `file-exists-p'
+ ;; and `file-readable-p' checks; otherwise we must extend
+ ;; the list. We do not perform any action, but return
+ ;; nil, in order to keep `vc-registered' running.
+ ((and fn (memq operation '(file-exists-p file-readable-p)))
+ (add-to-list 'tramp-vc-registered-file-names localname 'append)
+ nil)
+ ;; `process-file' and `start-file-process' shall be ignored.
+ ((and fn (eq operation 'process-file) 0))
+ ((and fn (eq operation 'start-file-process) nil))
+ ;; Tramp file name handlers like `expand-file-name'. They
+ ;; must still work.
+ (fn (save-match-data (apply (cdr fn) args)))
+ ;; Default file name handlers, we don't care.
+ (t (tramp-run-real-handler operation args))))
+
+ ;; When `tramp-mode' is not enabled, or the file name is
+ ;; quoted, we don't do anything.
+ (tramp-run-real-handler operation args)))))
+
+(defun tramp-sh-handle-file-notify-add-watch (file-name flags _callback)
+ "Like `file-notify-add-watch' for Tramp files."
+ (setq file-name (expand-file-name file-name))
+ (with-parsed-tramp-file-name file-name nil
+ (let ((default-directory (file-name-directory file-name))
+ command events filter p sequence)
+ (cond
+ ;; "inotifywait".
+ ((setq command (tramp-get-remote-inotifywait v))
+ (setq filter #'tramp-sh-inotifywait-process-filter
+ events
+ (cond
+ ((and (memq 'change flags) (memq 'attribute-change flags))
+ (eval-when-compile
+ (concat "create,modify,move,moved_from,moved_to,move_self,"
+ "delete,delete_self,attrib,ignored")))
+ ((memq 'change flags)
+ (eval-when-compile
+ (concat "create,modify,move,moved_from,moved_to,move_self,"
+ "delete,delete_self,ignored")))
+ ((memq 'attribute-change flags) "attrib,ignored"))
+ sequence `(,command "-mq" "-e" ,events ,localname)
+ ;; Make events a list of symbols.
+ events
+ (mapcar
+ (lambda (x) (intern-soft (replace-regexp-in-string "_" "-" x)))
+ (split-string events "," 'omit))))
+ ;; "gio monitor".
+ ((setq command (tramp-get-remote-gio-monitor v))
+ (setq filter #'tramp-sh-gio-monitor-process-filter
+ events
+ (cond
+ ((and (memq 'change flags) (memq 'attribute-change flags))
+ '(created changed changes-done-hint moved deleted
+ attribute-changed))
+ ((memq 'change flags)
+ '(created changed changes-done-hint moved deleted))
+ ((memq 'attribute-change flags) '(attribute-changed)))
+ sequence `(,command "monitor" ,localname)))
+ ;; "gvfs-monitor-dir".
+ ((setq command (tramp-get-remote-gvfs-monitor-dir v))
+ (setq filter #'tramp-sh-gvfs-monitor-dir-process-filter
+ events
+ (cond
+ ((and (memq 'change flags) (memq 'attribute-change flags))
+ '(created changed changes-done-hint moved deleted
+ attribute-changed))
+ ((memq 'change flags)
+ '(created changed changes-done-hint moved deleted))
+ ((memq 'attribute-change flags) '(attribute-changed)))
+ sequence `(,command ,localname)))
+ ;; None.
+ (t (tramp-error
+ v 'file-notify-error
+ "No file notification program found on %s"
+ (file-remote-p file-name))))
+ ;; Start process.
+ (setq p (apply
+ #'start-file-process
+ (file-name-nondirectory command)
+ (generate-new-buffer
+ (format " *%s*" (file-name-nondirectory command)))
+ sequence))
+ ;; Return the process object as watch-descriptor.
+ (if (not (processp p))
+ (tramp-error
+ v 'file-notify-error
+ "`%s' failed to start on remote host"
+ (mapconcat #'identity sequence " "))
+ (tramp-message v 6 "Run `%s', %S" (mapconcat #'identity sequence " ") p)
+ (process-put p 'vector v)
+ ;; Needed for process filter.
+ (process-put p 'events events)
+ (process-put p 'watch-name localname)
+ (set-process-query-on-exit-flag p nil)
+ (set-process-filter p filter)
+ (set-process-sentinel p #'tramp-file-notify-process-sentinel)
+ ;; There might be an error if the monitor is not supported.
+ ;; Give the filter a chance to read the output.
+ (while (tramp-accept-process-output p 0))
+ (unless (process-live-p p)
+ (tramp-error
+ p 'file-notify-error "Monitoring not supported for `%s'" file-name))
+ p))))
+
+(defun tramp-sh-gio-monitor-process-filter (proc string)
+ "Read output from \"gio monitor\" and add corresponding file-notify events."
+ (let ((events (process-get proc 'events))
+ (remote-prefix
+ (with-current-buffer (process-buffer proc)
+ (file-remote-p default-directory)))
+ (rest-string (process-get proc 'rest-string)))
+ (when rest-string
+ (tramp-message proc 10 "Previous string:\n%s" rest-string))
+ (tramp-message proc 6 "%S\n%s" proc string)
+ (setq string (concat rest-string string)
+ ;; Fix action names.
+ string (replace-regexp-in-string
+ "attributes changed" "attribute-changed" string)
+ string (replace-regexp-in-string
+ "changes done" "changes-done-hint" string)
+ string (replace-regexp-in-string
+ "renamed to" "moved" string))
+ ;; https://bugs.launchpad.net/bugs/1742946
+ (when
+ (string-match-p "Monitoring not supported\\|No locations given" string)
+ (delete-process proc))
+
+ ;; Delete empty lines.
+ (setq string (replace-regexp-in-string "\n\n" "\n" string))
+
+ (while (string-match
+ (eval-when-compile
+ (concat "^[^:]+:"
+ "[[:space:]]\\([^:]+\\):"
+ "[[:space:]]" (regexp-opt tramp-gio-events t)
+ "\\([[:space:]]\\([^:]+\\)\\)?$"))
+ string)
+
+ (let* ((file (match-string 1 string))
+ (file1 (match-string 4 string))
+ (object
+ (list
+ proc
+ (list
+ (intern-soft (match-string 2 string)))
+ ;; File names are returned as absolute paths. We must
+ ;; add the remote prefix.
+ (concat remote-prefix file)
+ (when file1 (concat remote-prefix file1)))))
+ (setq string (replace-match "" nil nil string))
+ ;; Remove watch when file or directory to be watched is deleted.
+ (when (and (member (cl-caadr object) '(moved deleted))
+ (string-equal file (process-get proc 'watch-name)))
+ (delete-process proc))
+ ;; Usually, we would add an Emacs event now. Unfortunately,
+ ;; `unread-command-events' does not accept several events at
+ ;; once. Therefore, we apply the handler directly.
+ (when (member (cl-caadr object) events)
+ (tramp-compat-funcall
+ 'file-notify-handle-event
+ `(file-notify ,object file-notify-callback)))))
+
+ ;; Save rest of the string.
+ (when (zerop (length string)) (setq string nil))
+ (when string (tramp-message proc 10 "Rest string:\n%s" string))
+ (process-put proc 'rest-string string)))
+
+(defun tramp-sh-gvfs-monitor-dir-process-filter (proc string)
+ "Read output from \"gvfs-monitor-dir\" and add corresponding \
+file-notify events."
+ (let ((events (process-get proc 'events))
+ (remote-prefix
+ (with-current-buffer (process-buffer proc)
+ (file-remote-p default-directory)))
+ (rest-string (process-get proc 'rest-string)))
+ (when rest-string
+ (tramp-message proc 10 "Previous string:\n%s" rest-string))
+ (tramp-message proc 6 "%S\n%s" proc string)
+ (setq string (concat rest-string string)
+ ;; Attribute change is returned in unused wording.
+ string (replace-regexp-in-string
+ "ATTRIB CHANGED" "ATTRIBUTE_CHANGED" string))
+
+ (while (string-match
+ (eval-when-compile
+ (concat "^[\n\r]*"
+ "Directory Monitor Event:[\n\r]+"
+ "Child = \\([^\n\r]+\\)[\n\r]+"
+ "\\(Other = \\([^\n\r]+\\)[\n\r]+\\)?"
+ "Event = \\([^[:blank:]]+\\)[\n\r]+"))
+ string)
+ (let* ((file (match-string 1 string))
+ (file1 (match-string 3 string))
+ (object
+ (list
+ proc
+ (list
+ (intern-soft
+ (replace-regexp-in-string
+ "_" "-" (downcase (match-string 4 string)))))
+ ;; File names are returned as absolute paths. We must
+ ;; add the remote prefix.
+ (concat remote-prefix file)
+ (when file1 (concat remote-prefix file1)))))
+ (setq string (replace-match "" nil nil string))
+ ;; Remove watch when file or directory to be watched is deleted.
+ (when (and (member (cl-caadr object) '(moved deleted))
+ (string-equal file (process-get proc 'watch-name)))
+ (delete-process proc))
+ ;; Usually, we would add an Emacs event now. Unfortunately,
+ ;; `unread-command-events' does not accept several events at
+ ;; once. Therefore, we apply the handler directly.
+ (when (member (cl-caadr object) events)
+ (tramp-compat-funcall
+ 'file-notify-handle-event
+ `(file-notify ,object file-notify-callback)))))
+
+ ;; Save rest of the string.
+ (when (zerop (length string)) (setq string nil))
+ (when string (tramp-message proc 10 "Rest string:\n%s" string))
+ (process-put proc 'rest-string string)))
+
+(defun tramp-sh-inotifywait-process-filter (proc string)
+ "Read output from \"inotifywait\" and add corresponding file-notify events."
+ (let ((events (process-get proc 'events)))
+ (tramp-message proc 6 "%S\n%s" proc string)
+ (dolist (line (split-string string "[\n\r]+" 'omit))
+ ;; Check, whether there is a problem.
+ (unless (string-match
+ (eval-when-compile
+ (concat "^[^[:blank:]]+"
+ "[[:blank:]]+\\([^[:blank:]]+\\)+"
+ "\\([[:blank:]]+\\([^\n\r]+\\)\\)?"))
+ line)
+ (tramp-error proc 'file-notify-error "%s" line))
+
+ (let ((object
+ (list
+ proc
+ (mapcar
+ (lambda (x)
+ (intern-soft
+ (replace-regexp-in-string "_" "-" (downcase x))))
+ (split-string (match-string 1 line) "," 'omit))
+ (match-string 3 line))))
+ ;; Remove watch when file or directory to be watched is deleted.
+ (when (member (cl-caadr object) '(move-self delete-self ignored))
+ (delete-process proc))
+ ;; Usually, we would add an Emacs event now. Unfortunately,
+ ;; `unread-command-events' does not accept several events at
+ ;; once. Therefore, we apply the handler directly.
+ (when (member (cl-caadr object) events)
+ (tramp-compat-funcall
+ 'file-notify-handle-event
+ `(file-notify ,object file-notify-callback)))))))
+
+(defun tramp-sh-handle-file-system-info (filename)
+ "Like `file-system-info' for Tramp files."
+ (ignore-errors
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (when (tramp-get-remote-df v)
+ (tramp-message v 5 "file system info: %s" localname)
+ (tramp-send-command
+ v (format
+ "%s %s"
+ (tramp-get-remote-df v) (tramp-shell-quote-argument localname)))
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (goto-char (point-min))
+ (forward-line)
+ (when (looking-at
+ (eval-when-compile
+ (concat "\\(?:^/[^[:space:]]*[[:space:]]\\)?"
+ "[[:space:]]*\\([[:digit:]]+\\)"
+ "[[:space:]]+\\([[:digit:]]+\\)"
+ "[[:space:]]+\\([[:digit:]]+\\)")))
+ (mapcar
+ (lambda (d)
+ (* d (tramp-get-connection-property v "df-blocksize" 0)))
+ (list (string-to-number (match-string 1))
+ ;; The second value is the used size. We need the
+ ;; free size.
+ (- (string-to-number (match-string 1))
+ (string-to-number (match-string 2)))
+ (string-to-number (match-string 3))))))))))
+
+;;; Internal Functions:
+
+(defun tramp-maybe-send-script (vec script name)
+ "Define in remote shell function NAME implemented as SCRIPT.
+Only send the definition if it has not already been done."
+ ;; We cannot let-bind (tramp-get-connection-process vec) because it
+ ;; might be nil.
+ (let ((scripts (tramp-get-connection-property
+ (tramp-get-connection-process vec) "scripts" nil)))
+ (unless (member name scripts)
+ (with-tramp-progress-reporter
+ vec 5 (format-message "Sending script `%s'" name)
+ ;; In bash, leading TABs like in `tramp-vc-registered-read-file-names'
+ ;; could result in unwanted command expansion. Avoid this.
+ (setq script (replace-regexp-in-string
+ (make-string 1 ?\t) (make-string 8 ? ) script))
+ ;; The script could contain a call of Perl. This is masked with `%s'.
+ (when (and (string-match-p "%s" script)
+ (not (tramp-get-remote-perl vec)))
+ (tramp-error vec 'file-error "No Perl available on remote host"))
+ (tramp-barf-unless-okay
+ vec
+ (format "%s () {\n%s\n}"
+ name (format script (tramp-get-remote-perl vec)))
+ "Script %s sending failed" name)
+ (tramp-set-connection-property
+ (tramp-get-connection-process vec) "scripts" (cons name scripts))))))
+
+(defun tramp-run-test (switch filename)
+ "Run `test' on the remote system, given a SWITCH and a FILENAME.
+Returns the exit code of the `test' program."
+ (with-parsed-tramp-file-name filename nil
+ (tramp-send-command-and-check
+ v
+ (format
+ "%s %s %s"
+ (tramp-get-test-command v)
+ switch
+ (tramp-shell-quote-argument localname)))))
+
+(defun tramp-run-test2 (format-string file1 file2)
+ "Run `test'-like program on the remote system, given FILE1, FILE2.
+FORMAT-STRING contains the program name, switches, and place holders.
+Returns the exit code of the `test' program. Barfs if the methods,
+hosts, or files, disagree."
+ (unless (tramp-equal-remote file1 file2)
+ (with-parsed-tramp-file-name (if (tramp-tramp-file-p file1) file1 file2)
nil
+ (tramp-error
+ v 'file-error
+ "tramp-run-test2 only implemented for same method, user, host")))
+ (with-parsed-tramp-file-name file1 v1
+ (with-parsed-tramp-file-name file1 v2
+ (tramp-send-command-and-check
+ v1
+ (format format-string
+ (tramp-shell-quote-argument v1-localname)
+ (tramp-shell-quote-argument v2-localname))))))
+
+(defun tramp-find-executable
+ (vec progname dirlist &optional ignore-tilde ignore-path)
+ "Searches for PROGNAME in $PATH and all directories mentioned in DIRLIST.
+First arg VEC specifies the connection, PROGNAME is the program
+to search for, and DIRLIST gives the list of directories to
+search. If IGNORE-TILDE is non-nil, directory names starting
+with `~' will be ignored. If IGNORE-PATH is non-nil, searches
+only in DIRLIST.
+
+Returns the absolute file name of PROGNAME, if found, and nil otherwise.
+
+This function expects to be in the right *tramp* buffer."
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (let (result)
+ ;; Check whether the executable is in $PATH. "which(1)" does not
+ ;; report always a correct error code; therefore we check the
+ ;; number of words it returns. "SunOS 5.10" (and maybe "SunOS
+ ;; 5.11") have problems with this command, we disable the call
+ ;; therefore.
+ (unless (or ignore-path
+ (string-match-p
+ (eval-when-compile (regexp-opt '("SunOS 5.10" "SunOS 5.11")))
+ (tramp-get-connection-property vec "uname" "")))
+ (tramp-send-command vec (format "which \\%s | wc -w" progname))
+ (goto-char (point-min))
+ (if (looking-at-p "^\\s-*1$")
+ (setq result (concat "\\" progname))))
+ (unless result
+ (when ignore-tilde
+ ;; Remove all ~/foo directories from dirlist.
+ (let (newdl d)
+ (while dirlist
+ (setq d (car dirlist))
+ (setq dirlist (cdr dirlist))
+ (unless (char-equal ?~ (aref d 0))
+ (setq newdl (cons d newdl))))
+ (setq dirlist (nreverse newdl))))
+ (tramp-send-command
+ vec
+ (format (eval-when-compile
+ (concat "while read d; "
+ "do if test -x $d/%s && test -f $d/%s; "
+ "then echo tramp_executable $d/%s; "
+ "break; fi; done <<'%s'\n"
+ "%s\n%s"))
+ progname progname progname
+ tramp-end-of-heredoc
+ (mapconcat #'identity dirlist "\n")
+ tramp-end-of-heredoc))
+ (goto-char (point-max))
+ (when (search-backward "tramp_executable " nil t)
+ (skip-chars-forward "^ ")
+ (skip-chars-forward " ")
+ (setq result (buffer-substring (point) (point-at-eol)))))
+ result)))
+
+;; On hydra.nixos.org, the $PATH environment variable is too long to
+;; send it. This is likely not due to PATH_MAX, but PIPE_BUF. We
+;; check it, and use a temporary file in case of. See Bug#33781.
+(defun tramp-set-remote-path (vec)
+ "Sets the remote environment PATH to existing directories.
+I.e., for each directory in `tramp-remote-path', it is tested
+whether it exists and if so, it is added to the environment
+variable PATH."
+ (let ((command
+ (format "PATH=%s; export PATH"
+ (mapconcat #'identity (tramp-get-remote-path vec) ":")))
+ (pipe-buf
+ (or (with-tramp-connection-property vec "pipe-buf"
+ (tramp-send-command-and-read
+ vec "getconf PIPE_BUF / 2>/dev/null || echo nil" 'noerror))
+ 4096))
+ tmpfile)
+ (tramp-message vec 5 "Setting $PATH environment variable")
+ (if (< (length command) pipe-buf)
+ (tramp-send-command vec command)
+ ;; Use a temporary file.
+ (setq tmpfile
+ (tramp-make-tramp-file-name vec (tramp-make-tramp-temp-file vec)))
+ (write-region command nil tmpfile)
+ (tramp-send-command
+ vec (format ". %s" (tramp-compat-file-local-name tmpfile)))
+ (delete-file tmpfile))))
+
+;; ------------------------------------------------------------
+;; -- Communication with external shell --
+;; ------------------------------------------------------------
+
+(defun tramp-find-file-exists-command (vec)
+ "Find a command on the remote host for checking if a file exists.
+Here, we are looking for a command which has zero exit status if the
+file exists and nonzero exit status otherwise."
+ (let ((existing "/")
+ (nonexistent
+ (tramp-shell-quote-argument "/ this file does not exist "))
+ result)
+ ;; The algorithm is as follows: we try a list of several commands.
+ ;; For each command, we first run `$cmd /' -- this should return
+ ;; true, as the root directory always exists. And then we run
+ ;; `$cmd /this\ file\ does\ not\ exist ', hoping that the file indeed
+ ;; does not exist. This should return false. We use the first
+ ;; command we find that seems to work.
+ ;; The list of commands to try is as follows:
+ ;; `ls -d' This works on most systems, but NetBSD 1.4
+ ;; has a bug: `ls' always returns zero exit
+ ;; status, even for files which don't exist.
+ ;; `test -e' Some Bourne shells have a `test' builtin
+ ;; which does not know the `-e' option.
+ ;; `/bin/test -e' For those, the `test' binary on disk normally
+ ;; provides the option. Alas, the binary
+ ;; is sometimes `/bin/test' and sometimes it's
+ ;; `/usr/bin/test'.
+ ;; `/usr/bin/test -e' In case `/bin/test' does not exist.
+ (unless (or
+ (ignore-errors
+ (and (setq result (format "%s -e" (tramp-get-test-command vec)))
+ (tramp-send-command-and-check
+ vec (format "%s %s" result existing))
+ (not (tramp-send-command-and-check
+ vec (format "%s %s" result nonexistent)))))
+ (ignore-errors
+ (and (setq result "/bin/test -e")
+ (tramp-send-command-and-check
+ vec (format "%s %s" result existing))
+ (not (tramp-send-command-and-check
+ vec (format "%s %s" result nonexistent)))))
+ (ignore-errors
+ (and (setq result "/usr/bin/test -e")
+ (tramp-send-command-and-check
+ vec (format "%s %s" result existing))
+ (not (tramp-send-command-and-check
+ vec (format "%s %s" result nonexistent)))))
+ (ignore-errors
+ (and (setq result (format "%s -d" (tramp-get-ls-command vec)))
+ (tramp-send-command-and-check
+ vec (format "%s %s" result existing))
+ (not (tramp-send-command-and-check
+ vec (format "%s %s" result nonexistent))))))
+ (tramp-error
+ vec 'file-error "Couldn't find command to check if file exists"))
+ result))
+
+(defun tramp-open-shell (vec shell)
+ "Opens shell SHELL."
+ (with-tramp-progress-reporter
+ vec 5 (format-message "Opening remote shell `%s'" shell)
+ ;; Find arguments for this shell.
+ (let ((alist tramp-sh-extra-args)
+ item extra-args)
+ (while (and alist (null extra-args))
+ (setq item (pop alist))
+ (when (string-match-p (car item) shell)
+ (setq extra-args (cdr item))))
+ ;; It is useful to set the prompt in the following command
+ ;; because some people have a setting for $PS1 which /bin/sh
+ ;; doesn't know about and thus /bin/sh will display a strange
+ ;; prompt. For example, if $PS1 has "${CWD}" in the value, then
+ ;; ksh will display the current working directory but /bin/sh
+ ;; will display a dollar sign. The following command line sets
+ ;; $PS1 to a sane value, and works under Bourne-ish shells as
+ ;; well as csh-like shells. We also unset the variable $ENV
+ ;; because that is read by some sh implementations (eg, bash
+ ;; when called as sh) on startup; this way, we avoid the startup
+ ;; file clobbering $PS1. $PROMPT_COMMAND is another way to set
+ ;; the prompt in /bin/bash, it must be discarded as well.
+ ;; $HISTFILE is set according to `tramp-histfile-override'.
+ ;; $TERM and $INSIDE_EMACS set here to ensure they have the
+ ;; correct values when the shell starts, not just processes
+ ;; run within the shell. (Which processes include our
+ ;; initial probes to ensure the remote shell is usable.)
+ (tramp-send-command
+ vec (format
+ (eval-when-compile
+ (concat
+ "exec env TERM='%s' INSIDE_EMACS='%s,tramp:%s' "
+ "ENV=%s %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s"))
+ tramp-terminal-type
+ emacs-version tramp-version ; INSIDE_EMACS
+ (or (getenv-internal "ENV" tramp-remote-process-environment) "")
+ (if (stringp tramp-histfile-override)
+ (format "HISTFILE=%s"
+ (tramp-shell-quote-argument tramp-histfile-override))
+ (if tramp-histfile-override
+ "HISTFILE='' HISTFILESIZE=0 HISTSIZE=0"
+ ""))
+ (tramp-shell-quote-argument tramp-end-of-output)
+ shell (or extra-args ""))
+ t)
+ ;; Check proper HISTFILE setting. We give up when not working.
+ (when (and (stringp tramp-histfile-override)
+ (file-name-directory tramp-histfile-override))
+ (tramp-barf-unless-okay
+ vec
+ (format
+ "(cd %s)"
+ (tramp-shell-quote-argument
+ (file-name-directory tramp-histfile-override)))
+ "`tramp-histfile-override' uses invalid file `%s'"
+ tramp-histfile-override)))
+
+ (tramp-set-connection-property
+ (tramp-get-connection-process vec) "remote-shell" shell)))
+
+(defun tramp-find-shell (vec)
+ "Opens a shell on the remote host which groks tilde expansion."
+ (with-current-buffer (tramp-get-buffer vec)
+ (let ((default-shell (tramp-get-method-parameter vec 'tramp-remote-shell))
+ shell)
+ (setq shell
+ (with-tramp-connection-property vec "remote-shell"
+ ;; CCC: "root" does not exist always, see my QNAP TS-459.
+ ;; Which check could we apply instead?
+ (tramp-send-command vec "echo ~root" t)
+ (if (or (string-match-p "^~root$" (buffer-string))
+ ;; The default shell (ksh93) of OpenSolaris and
+ ;; Solaris is buggy. We've got reports for
+ ;; "SunOS 5.10" and "SunOS 5.11" so far.
+ (string-match-p
+ (eval-when-compile
+ (regexp-opt '("SunOS 5.10" "SunOS 5.11")))
+ (tramp-get-connection-property vec "uname" "")))
+
+ (or (tramp-find-executable
+ vec "bash" (tramp-get-remote-path vec) t t)
+ (tramp-find-executable
+ vec "ksh" (tramp-get-remote-path vec) t t)
+ ;; Maybe it works at least for some other commands.
+ (prog1
+ default-shell
+ (tramp-message
+ vec 2
+ (eval-when-compile
+ (concat
+ "Couldn't find a remote shell which groks tilde "
+ "expansion, using `%s'"))
+ default-shell)))
+
+ default-shell)))
+
+ ;; Open a new shell if needed.
+ (unless (string-equal shell default-shell)
+ (tramp-message
+ vec 5 "Starting remote shell `%s' for tilde expansion" shell)
+ (tramp-open-shell vec shell)))))
+
+;; Utility functions.
+
+(defun tramp-barf-if-no-shell-prompt (proc timeout &rest error-args)
+ "Wait for shell prompt and barf if none appears.
+Looks at process PROC to see if a shell prompt appears in TIMEOUT
+seconds. If not, it produces an error message with the given ERROR-ARGS."
+ (let ((vec (process-get proc 'vector)))
+ (condition-case nil
+ (tramp-wait-for-regexp
+ proc timeout
+ (format
+ "\\(%s\\|%s\\)\\'" shell-prompt-pattern tramp-shell-prompt-pattern))
+ (error
+ (delete-process proc)
+ (apply #'tramp-error-with-buffer
+ (tramp-get-connection-buffer vec) vec 'file-error error-args)))))
+
+(defun tramp-open-connection-setup-interactive-shell (proc vec)
+ "Set up an interactive shell.
+Mainly sets the prompt and the echo correctly. PROC is the shell
+process to set up. VEC specifies the connection."
+ (let ((tramp-end-of-output tramp-initial-end-of-output)
+ (case-fold-search t))
+ (tramp-open-shell vec (tramp-get-method-parameter vec 'tramp-remote-shell))
+
+ ;; Disable echo expansion.
+ (tramp-message vec 5 "Setting up remote shell environment")
+ (tramp-send-command
+ vec "stty -inlcr -onlcr -echo kill '^U' erase '^H'" t)
+ ;; Check whether the echo has really been disabled. Some
+ ;; implementations, like busybox of embedded GNU/Linux, don't
+ ;; support disabling.
+ (tramp-send-command vec "echo foo" t)
+ (with-current-buffer (process-buffer proc)
+ (goto-char (point-min))
+ (when (looking-at-p "echo foo")
+ (tramp-set-connection-property proc "remote-echo" t)
+ (tramp-message vec 5 "Remote echo still on. Ok.")
+ ;; Make sure backspaces and their echo are enabled and no line
+ ;; width magic interferes with them.
+ (tramp-send-command vec "stty icanon erase ^H cols 32767" t))))
+
+ (tramp-message vec 5 "Setting shell prompt")
+ (tramp-send-command
+ vec (format "PS1=%s PS2='' PS3='' PROMPT_COMMAND=''"
+ (tramp-shell-quote-argument tramp-end-of-output))
+ t)
+
+ ;; Check whether the output of "uname -sr" has been changed. If
+ ;; yes, this is a strong indication that we must expire all
+ ;; connection properties. We start again with
+ ;; `tramp-maybe-open-connection', it will be caught there.
+ (tramp-message vec 5 "Checking system information")
+ (let ((old-uname (tramp-get-connection-property vec "uname" nil))
+ (uname
+ (tramp-set-connection-property
+ vec "uname"
+ (tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\""))))
+ (when (and (stringp old-uname) (not (string-equal old-uname uname)))
+ (tramp-message
+ vec 3
+ "Connection reset, because remote host changed from `%s' to `%s'"
+ old-uname uname)
+ ;; We want to keep the password.
+ (tramp-cleanup-connection vec t t)
+ (throw 'uname-changed (tramp-maybe-open-connection vec)))
+
+ ;; Try to set up the coding system correctly.
+ ;; CCC this can't be the right way to do it. Hm.
+ (tramp-message vec 5 "Determining coding system")
+ (with-current-buffer (process-buffer proc)
+ ;; Use MULE to select the right EOL convention for communicating
+ ;; with the process.
+ (let ((cs (or (and (memq 'utf-8-hfs (coding-system-list))
+ (string-match-p "^Darwin" uname)
+ (cons 'utf-8-hfs 'utf-8-hfs))
+ (and (memq 'utf-8 (coding-system-list))
+ (string-match-p "utf-?8" (tramp-get-remote-locale vec))
+ (cons 'utf-8 'utf-8))
+ (process-coding-system proc)
+ (cons 'undecided 'undecided)))
+ cs-decode cs-encode)
+ (when (symbolp cs) (setq cs (cons cs cs)))
+ (setq cs-decode (or (car cs) 'undecided)
+ cs-encode (or (cdr cs) 'undecided)
+ cs-encode
+ (coding-system-change-eol-conversion
+ cs-encode (if (string-match-p "^Darwin" uname) 'mac 'unix)))
+ (tramp-send-command vec "(echo foo ; echo bar)" t)
+ (goto-char (point-min))
+ (when (search-forward "\r" nil t)
+ (setq cs-decode (coding-system-change-eol-conversion cs-decode 'dos)))
+ (set-process-coding-system proc cs-decode cs-encode)
+ (tramp-message
+ vec 5 "Setting coding system to `%s' and `%s'" cs-decode cs-encode)))
+
+ (tramp-send-command vec "set +o vi +o emacs" t)
+
+ ;; Check whether the remote host suffers from buggy
+ ;; `send-process-string'. This is known for FreeBSD (see comment
+ ;; in `send_process', file process.c). I've tested sending 624
+ ;; bytes successfully, sending 625 bytes failed. Emacs makes a
+ ;; hack when this host type is detected locally. It cannot handle
+ ;; remote hosts, though.
+ (with-tramp-connection-property proc "chunksize"
+ (cond
+ ((and (integerp tramp-chunksize) (> tramp-chunksize 0))
+ tramp-chunksize)
+ (t
+ (tramp-message
+ vec 5 "Checking remote host type for `send-process-string' bug")
+ (if (string-match-p "^FreeBSD" uname) 500 0))))
+
+ ;; Set remote PATH variable.
+ (tramp-set-remote-path vec)
+
+ ;; Search for a good shell before searching for a command which
+ ;; checks if a file exists. This is done because Tramp wants to
+ ;; use "test foo; echo $?" to check if various conditions hold,
+ ;; and there are buggy /bin/sh implementations which don't execute
+ ;; the "echo $?" part if the "test" part has an error. In
+ ;; particular, the OpenSolaris /bin/sh is a problem. There are
+ ;; also other problems with /bin/sh of OpenSolaris, like
+ ;; redirection of stderr in function declarations, or changing
+ ;; HISTFILE in place. Therefore, OpenSolaris' /bin/sh is replaced
+ ;; by bash, when detected.
+ (tramp-find-shell vec)
+
+ ;; Disable unexpected output.
+ (tramp-send-command vec "mesg n 2>/dev/null; biff n 2>/dev/null" t)
+
+ ;; IRIX64 bash expands "!" even when in single quotes. This
+ ;; destroys our shell functions, we must disable it. See
+ ;;
<http://stackoverflow.com/questions/3291692/irix-bash-shell-expands-expression-in-single-quotes-yet-shouldnt>.
+ (when (string-match-p "^IRIX64" uname)
+ (tramp-send-command vec "set +H" t))
+
+ ;; Disable tab expansion.
+ (if (string-match-p "BSD\\|Darwin" uname)
+ (tramp-send-command vec "stty tabs" t)
+ (tramp-send-command vec "stty tab0" t))
+
+ ;; Set utf8 encoding. Needed for macOS, for example. This is
+ ;; non-POSIX, so we must expect errors on some systems.
+ (tramp-send-command vec "stty iutf8 2>/dev/null" t)
+
+ ;; Set `remote-tty' process property.
+ (let ((tty (tramp-send-command-and-read vec "echo \\\"`tty`\\\""
'noerror)))
+ (unless (zerop (length tty))
+ (process-put proc 'remote-tty tty)
+ (tramp-set-connection-property proc "remote-tty" tty)))
+
+ ;; Dump stty settings in the traces.
+ (when (>= tramp-verbose 9)
+ (tramp-send-command vec "stty -a" t))
+
+ ;; Set the environment.
+ (tramp-message vec 5 "Setting default environment")
+
+ (let (unset vars)
+ (dolist (item (reverse
+ (append `(,(tramp-get-remote-locale vec))
+ (copy-sequence tramp-remote-process-environment))))
+ (setq item (split-string item "=" 'omit))
+ (setcdr item (mapconcat #'identity (cdr item) "="))
+ (if (and (stringp (cdr item)) (not (string-equal (cdr item) "")))
+ (push (format "%s %s" (car item) (cdr item)) vars)
+ (push (car item) unset)))
+ (when vars
+ (tramp-send-command
+ vec
+ (format
+ "while read var val; do export $var=\"$val\"; done <<'%s'\n%s\n%s"
+ tramp-end-of-heredoc
+ (mapconcat #'identity vars "\n")
+ tramp-end-of-heredoc)
+ t))
+ (when unset
+ (tramp-send-command
+ vec (format "unset %s" (mapconcat #'identity unset " ")) t)))))
+
+;; Old text from documentation of tramp-methods:
+;; Using a uuencode/uudecode inline method is discouraged, please use one
+;; of the base64 methods instead since base64 encoding is much more
+;; reliable and the commands are more standardized between the different
+;; Unix versions. But if you can't use base64 for some reason, please
+;; note that the default uudecode command does not work well for some
+;; Unices, in particular AIX and Irix. For AIX, you might want to use
+;; the following command for uudecode:
+;;
+;; sed '/^begin/d;/^[` ]$/d;/^end/d' | iconv -f uucode -t ISO8859-1
+;;
+;; For Irix, no solution is known yet.
+
+(autoload 'uudecode-decode-region "uudecode")
+
+(defconst tramp-local-coding-commands
+ `((b64 base64-encode-region base64-decode-region)
+ (uu tramp-uuencode-region uudecode-decode-region)
+ (pack ,(format tramp-perl-pack "perl") ,(format tramp-perl-unpack "perl")))
+ "List of local coding commands for inline transfer.
+Each item is a list that looks like this:
+
+\(FORMAT ENCODING DECODING)
+
+FORMAT is a symbol describing the encoding/decoding format. It can be
+`b64' for base64 encoding, `uu' for uu encoding, or `pack' for simple packing.
+
+ENCODING and DECODING can be strings, giving commands, or symbols,
+giving functions. If they are strings, then they can contain
+the \"%s\" format specifier. If that specifier is present, the input
+file name will be put into the command line at that spot. If the
+specifier is not present, the input should be read from standard
+input.
+
+If they are functions, they will be called with two arguments, start
+and end of region, and are expected to replace the region contents
+with the encoded or decoded results, respectively.")
+
+(defconst tramp-remote-coding-commands
+ `((b64 "base64" "base64 -d -i")
+ ;; "-i" is more robust with older base64 from GNU coreutils.
+ ;; However, I don't know whether all base64 versions do supports
+ ;; this option.
+ (b64 "base64" "base64 -d")
+ (b64 "openssl enc -base64" "openssl enc -d -base64")
+ (b64 "mimencode -b" "mimencode -u -b")
+ (b64 "mmencode -b" "mmencode -u -b")
+ (b64 "recode data..base64" "recode base64..data")
+ (b64 tramp-perl-encode-with-module tramp-perl-decode-with-module)
+ (b64 tramp-perl-encode tramp-perl-decode)
+ ;; This is painful slow, so we put it on the end.
+ (b64 tramp-awk-encode tramp-awk-decode ,tramp-awk-coding-test)
+ (uu "uuencode xxx" "uudecode -o /dev/stdout" "test -c /dev/stdout")
+ (uu "uuencode xxx" "uudecode -o -")
+ (uu "uuencode xxx" "uudecode -p")
+ (uu "uuencode xxx" tramp-uudecode)
+ (pack tramp-perl-pack tramp-perl-unpack))
+ "List of remote coding commands for inline transfer.
+Each item is a list that looks like this:
+
+\(FORMAT ENCODING DECODING [TEST])
+
+FORMAT is a symbol describing the encoding/decoding format. It can be
+`b64' for base64 encoding, `uu' for uu encoding, or `pack' for simple packing.
+
+ENCODING and DECODING can be strings, giving commands, or symbols,
+giving variables. If they are strings, then they can contain
+the \"%s\" format specifier. If that specifier is present, the input
+file name will be put into the command line at that spot. If the
+specifier is not present, the input should be read from standard
+input.
+
+If they are variables, this variable is a string containing a
+Perl or Shell implementation for this functionality. This
+program will be transferred to the remote host, and it is
+available as shell function with the same name. A \"%t\" format
+specifier in the variable value denotes a temporary file.
+
+The optional TEST command can be used for further tests, whether
+ENCODING and DECODING are applicable.")
+
+(defun tramp-find-inline-encoding (vec)
+ "Find an inline transfer encoding that works.
+Goes through the list `tramp-local-coding-commands' and
+`tramp-remote-coding-commands'."
+ (save-excursion
+ (let ((local-commands tramp-local-coding-commands)
+ (magic "xyzzy")
+ (p (tramp-get-connection-process vec))
+ loc-enc loc-dec rem-enc rem-dec rem-test litem ritem found)
+ (while (and local-commands (not found))
+ (setq litem (pop local-commands))
+ (catch 'wont-work-local
+ (let ((format (nth 0 litem))
+ (remote-commands tramp-remote-coding-commands))
+ (setq loc-enc (nth 1 litem))
+ (setq loc-dec (nth 2 litem))
+ ;; If the local encoder or decoder is a string, the
+ ;; corresponding command has to work locally.
+ (if (not (stringp loc-enc))
+ (tramp-message
+ vec 5 "Checking local encoding function `%s'" loc-enc)
+ (tramp-message
+ vec 5 "Checking local encoding command `%s' for sanity" loc-enc)
+ (unless (zerop (tramp-call-local-coding-command loc-enc nil nil))
+ (throw 'wont-work-local nil)))
+ (if (not (stringp loc-dec))
+ (tramp-message
+ vec 5 "Checking local decoding function `%s'" loc-dec)
+ (tramp-message
+ vec 5 "Checking local decoding command `%s' for sanity" loc-dec)
+ (unless (zerop (tramp-call-local-coding-command loc-dec nil nil))
+ (throw 'wont-work-local nil)))
+ ;; Search for remote coding commands with the same format
+ (while (and remote-commands (not found))
+ (setq ritem (pop remote-commands))
+ (catch 'wont-work-remote
+ (when (equal format (nth 0 ritem))
+ (setq rem-enc (nth 1 ritem))
+ (setq rem-dec (nth 2 ritem))
+ (setq rem-test (nth 3 ritem))
+ ;; Check the remote test command if exists.
+ (when (stringp rem-test)
+ (tramp-message
+ vec 5 "Checking remote test command `%s'" rem-test)
+ (unless (tramp-send-command-and-check vec rem-test t)
+ (throw 'wont-work-remote nil)))
+ ;; Check if remote perl exists when necessary.
+ (when (and (symbolp rem-enc)
+ (string-match-p "perl" (symbol-name rem-enc))
+ (not (tramp-get-remote-perl vec)))
+ (throw 'wont-work-remote nil))
+ ;; Check if remote encoding and decoding commands can be
+ ;; called remotely with null input and output. This makes
+ ;; sure there are no syntax errors and the command is really
+ ;; found. Note that we do not redirect stdout to /dev/null,
+ ;; for two reasons: when checking the decoding command, we
+ ;; actually check the output it gives. And also, when
+ ;; redirecting "mimencode" output to /dev/null, then as root
+ ;; it might change the permissions of /dev/null!
+ (unless (stringp rem-enc)
+ (let ((name (symbol-name rem-enc)))
+ (while (string-match "-" name)
+ (setq name (replace-match "_" nil t name)))
+ (tramp-maybe-send-script vec (symbol-value rem-enc) name)
+ (setq rem-enc name)))
+ (tramp-message
+ vec 5
+ "Checking remote encoding command `%s' for sanity" rem-enc)
+ (unless (tramp-send-command-and-check
+ vec (format "%s </dev/null" rem-enc) t)
+ (throw 'wont-work-remote nil))
+
+ (unless (stringp rem-dec)
+ (let ((name (symbol-name rem-dec))
+ (value (symbol-value rem-dec))
+ tmpfile)
+ (while (string-match "-" name)
+ (setq name (replace-match "_" nil t name)))
+ (when (string-match-p "\\(^\\|[^%]\\)%t" value)
+ (setq tmpfile
+ (make-temp-name
+ (expand-file-name
+ tramp-temp-name-prefix
+ (tramp-get-remote-tmpdir vec)))
+ value
+ (format-spec
+ value
+ (format-spec-make
+ ?t (tramp-compat-file-local-name tmpfile)))))
+ (tramp-maybe-send-script vec value name)
+ (setq rem-dec name)))
+ (tramp-message
+ vec 5
+ "Checking remote decoding command `%s' for sanity" rem-dec)
+ (unless (tramp-send-command-and-check
+ vec
+ (format "echo %s | %s | %s" magic rem-enc rem-dec)
+ t)
+ (throw 'wont-work-remote nil))
+
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (goto-char (point-min))
+ (unless (looking-at-p (regexp-quote magic))
+ (throw 'wont-work-remote nil)))
+
+ ;; `rem-enc' and `rem-dec' could be a string meanwhile.
+ (setq rem-enc (nth 1 ritem))
+ (setq rem-dec (nth 2 ritem))
+ (setq found t)))))))
+
+ (when found
+ ;; Set connection properties. Since the commands are risky
+ ;; (due to output direction), we cache them in the process cache.
+ (tramp-message vec 5 "Using local encoding `%s'" loc-enc)
+ (tramp-set-connection-property p "local-encoding" loc-enc)
+ (tramp-message vec 5 "Using local decoding `%s'" loc-dec)
+ (tramp-set-connection-property p "local-decoding" loc-dec)
+ (tramp-message vec 5 "Using remote encoding `%s'" rem-enc)
+ (tramp-set-connection-property p "remote-encoding" rem-enc)
+ (tramp-message vec 5 "Using remote decoding `%s'" rem-dec)
+ (tramp-set-connection-property p "remote-decoding" rem-dec)))))
+
+(defun tramp-call-local-coding-command (cmd input output)
+ "Call the local encoding or decoding command.
+If CMD contains \"%s\", provide input file INPUT there in command.
+Otherwise, INPUT is passed via standard input.
+INPUT can also be nil which means `/dev/null'.
+OUTPUT can be a string (which specifies a file name), or t (which
+means standard output and thus the current buffer), or nil (which
+means discard it)."
+ (tramp-call-process
+ nil tramp-encoding-shell
+ (when (and input (not (string-match-p "%s" cmd))) input)
+ (if (eq output t) t nil)
+ nil
+ tramp-encoding-command-switch
+ (concat
+ (if (string-match-p "%s" cmd) (format cmd input) cmd)
+ (if (stringp output) (concat " >" output) ""))))
+
+(defconst tramp-inline-compress-commands
+ '(;; Suppress warnings about obsolete environment variable GZIP.
+ ("env GZIP= gzip" "env GZIP= gzip -d")
+ ("bzip2" "bzip2 -d")
+ ("xz" "xz -d")
+ ("compress" "compress -d"))
+ "List of compress and decompress commands for inline transfer.
+Each item is a list that looks like this:
+
+\(COMPRESS DECOMPRESS)
+
+COMPRESS or DECOMPRESS are strings with the respective commands.")
+
+(defun tramp-find-inline-compress (vec)
+ "Find an inline transfer compress command that works.
+Goes through the list `tramp-inline-compress-commands'."
+ (save-excursion
+ (let ((commands tramp-inline-compress-commands)
+ (magic "xyzzy")
+ (p (tramp-get-connection-process vec))
+ item compress decompress found)
+ (while (and commands (not found))
+ (catch 'next
+ (setq item (pop commands)
+ compress (nth 0 item)
+ decompress (nth 1 item))
+ (tramp-message
+ vec 5
+ "Checking local compress commands `%s', `%s' for sanity"
+ compress decompress)
+ (unless
+ (zerop
+ (tramp-call-local-coding-command
+ (format
+ "echo %s | %s | %s" magic
+ ;; Windows shells need the program file name after
+ ;; the pipe symbol be quoted if they use forward
+ ;; slashes as directory separators.
+ (mapconcat
+ #'shell-quote-argument (split-string compress) " ")
+ (mapconcat
+ #'shell-quote-argument (split-string decompress) " "))
+ nil nil))
+ (throw 'next nil))
+ (tramp-message
+ vec 5
+ "Checking remote compress commands `%s', `%s' for sanity"
+ compress decompress)
+ (unless (tramp-send-command-and-check
+ vec (format "echo %s | %s | %s" magic compress decompress) t)
+ (throw 'next nil))
+ (setq found t)))
+
+ ;; Did we find something?
+ (if found
+ (progn
+ ;; Set connection properties. Since the commands are
+ ;; risky (due to output direction), we cache them in the
+ ;; process cache.
+ (tramp-message
+ vec 5 "Using inline transfer compress command `%s'" compress)
+ (tramp-set-connection-property p "inline-compress" compress)
+ (tramp-message
+ vec 5 "Using inline transfer decompress command `%s'" decompress)
+ (tramp-set-connection-property p "inline-decompress" decompress))
+
+ (tramp-set-connection-property p "inline-compress" nil)
+ (tramp-set-connection-property p "inline-decompress" nil)
+ (tramp-message
+ vec 2 "Couldn't find an inline transfer compress command")))))
+
+(defun tramp-compute-multi-hops (vec)
+ "Expands VEC according to `tramp-default-proxies-alist'."
+ (let ((saved-tdpa tramp-default-proxies-alist)
+ (target-alist `(,vec))
+ (hops (or (tramp-file-name-hop vec) ""))
+ (item vec)
+ choices proxy)
+
+ ;; Ad-hoc proxy definitions.
+ (dolist (proxy (reverse (split-string hops tramp-postfix-hop-regexp
'omit)))
+ (let* ((host-port (tramp-file-name-host-port item))
+ (user-domain (tramp-file-name-user-domain item))
+ (proxy (concat
+ tramp-prefix-format proxy tramp-postfix-host-format))
+ (entry
+ (list (and (stringp host-port)
+ (concat "^" (regexp-quote host-port) "$"))
+ (and (stringp user-domain)
+ (concat "^" (regexp-quote user-domain) "$"))
+ (propertize proxy 'tramp-ad-hoc t))))
+ (tramp-message vec 5 "Add %S to `tramp-default-proxies-alist'" entry)
+ ;; Add the hop.
+ (add-to-list 'tramp-default-proxies-alist entry)
+ (setq item (tramp-dissect-file-name proxy))))
+ ;; Save the new value.
+ (when (and hops tramp-save-ad-hoc-proxies)
+ (customize-save-variable
+ 'tramp-default-proxies-alist tramp-default-proxies-alist))
+
+ ;; Look for proxy hosts to be passed.
+ (setq choices tramp-default-proxies-alist)
+ (while choices
+ (setq item (pop choices)
+ proxy (eval (nth 2 item)))
+ (when (and
+ ;; Host.
+ (string-match-p
+ (or (eval (nth 0 item)) "")
+ (or (tramp-file-name-host-port (car target-alist))
+ ""))
+ ;; User.
+ (string-match-p
+ (or (eval (nth 1 item)) "")
+ (or (tramp-file-name-user-domain (car target-alist))
+ "")))
+ (if (null proxy)
+ ;; No more hops needed.
+ (setq choices nil)
+ ;; Replace placeholders.
+ (setq proxy
+ (format-spec
+ proxy
+ (format-spec-make
+ ?u (or (tramp-file-name-user (car target-alist)) "")
+ ?h (or (tramp-file-name-host (car target-alist)) ""))))
+ (with-parsed-tramp-file-name proxy l
+ ;; Add the hop.
+ (push l target-alist)
+ ;; Start next search.
+ (setq choices tramp-default-proxies-alist)))))
+
+ ;; Foreign and out-of-band methods are not supported for multi-hops.
+ (when (cdr target-alist)
+ (setq choices target-alist)
+ (while (setq item (pop choices))
+ (when (or (not (tramp-get-method-parameter item 'tramp-login-program))
+ (tramp-get-method-parameter item 'tramp-copy-program))
+ (setq tramp-default-proxies-alist saved-tdpa)
+ (tramp-user-error
+ vec "Method `%s' is not supported for multi-hops."
+ (tramp-file-name-method item)))))
+
+ ;; Some methods ("su", "sg", "sudo", "doas", "ksu") do not use the
+ ;; host name in their command template. In this case, the remote
+ ;; file name must use either a local host name (first hop), or a
+ ;; host name matching the previous hop.
+ (let ((previous-host (or tramp-local-host-regexp "")))
+ (setq choices target-alist)
+ (while (setq item (pop choices))
+ (let ((host (tramp-file-name-host item)))
+ (unless
+ (or
+ ;; The host name is used for the remote shell command.
+ (member
+ '("%h") (tramp-get-method-parameter item 'tramp-login-args))
+ ;; The host name must match previous hop.
+ (string-match-p previous-host host))
+ (setq tramp-default-proxies-alist saved-tdpa)
+ (tramp-user-error
+ vec "Host name `%s' does not match `%s'" host previous-host))
+ (setq previous-host (concat "^" (regexp-quote host) "$")))))
+
+ ;; Result.
+ target-alist))
+
+(defun tramp-ssh-controlmaster-options (vec)
+ "Return the Control* arguments of the local ssh."
+ (cond
+ ;; No options to be computed.
+ ((or (null tramp-use-ssh-controlmaster-options)
+ (null (assoc "%c" (tramp-get-method-parameter vec 'tramp-login-args))))
+ "")
+
+ ;; There is already a value to be used.
+ ((stringp tramp-ssh-controlmaster-options) tramp-ssh-controlmaster-options)
+
+ ;; Determine the options.
+ (t (setq tramp-ssh-controlmaster-options "")
+ (let ((case-fold-search t))
+ (ignore-errors
+ (when (executable-find "ssh")
+ (with-tramp-progress-reporter
+ vec 4 "Computing ControlMaster options"
+ (with-temp-buffer
+ (tramp-call-process vec "ssh" nil t nil "-o" "ControlMaster")
+ (goto-char (point-min))
+ (when (search-forward-regexp "missing.+argument" nil t)
+ (setq tramp-ssh-controlmaster-options
+ "-o ControlMaster=auto")))
+ (unless (zerop (length tramp-ssh-controlmaster-options))
+ (with-temp-buffer
+ ;; We use a non-existing IP address, in order to
+ ;; avoid useless connections, and DNS timeouts.
+ ;; Setting ConnectTimeout is needed since OpenSSH 7.
+ (tramp-call-process
+ vec "ssh" nil t nil
+ "-o" "ConnectTimeout=1" "-o" "ControlPath=%C" "0.0.0.1")
+ (goto-char (point-min))
+ (setq tramp-ssh-controlmaster-options
+ (concat tramp-ssh-controlmaster-options
+ (if (search-forward-regexp "unknown.+key" nil t)
+ " -o ControlPath='address@hidden:%%p'"
+ " -o ControlPath='tramp.%%C'"))))
+ (with-temp-buffer
+ (tramp-call-process vec "ssh" nil t nil "-o" "ControlPersist")
+ (goto-char (point-min))
+ (when (search-forward-regexp "missing.+argument" nil t)
+ (setq tramp-ssh-controlmaster-options
+ (concat tramp-ssh-controlmaster-options
+ " -o ControlPersist=no")))))))))
+ tramp-ssh-controlmaster-options)))
+
+(defun tramp-timeout-session (vec)
+ "Close the connection VEC after a session timeout.
+If there is just some editing, retry it after 5 seconds."
+ (if (and tramp-locked tramp-locker
+ (tramp-file-name-equal-p vec (car tramp-current-connection)))
+ (progn
+ (tramp-message
+ vec 5 "Cannot timeout session, trying it again in %s seconds." 5)
+ (run-at-time 5 nil 'tramp-timeout-session vec))
+ (tramp-message
+ vec 3 "Timeout session %s" (tramp-make-tramp-file-name vec 'localname))
+ (tramp-cleanup-connection vec 'keep-debug)))
+
+(defun tramp-maybe-open-connection (vec)
+ "Maybe open a connection VEC.
+Does not do anything if a connection is already open, but re-opens the
+connection if a previous connection has died for some reason."
+ (let ((p (tramp-get-connection-process vec))
+ (process-name (tramp-get-connection-property vec "process-name" nil))
+ (pos (with-current-buffer (tramp-get-connection-buffer vec) (point)))
+ tmp-process-environment)
+
+ ;; If Tramp opens the same connection within a short time frame,
+ ;; there is a problem. We shall signal this.
+ (unless (or (process-live-p p)
+ (not (tramp-file-name-equal-p
+ vec (car tramp-current-connection)))
+ (time-less-p
+ ;; `current-time' can be removed once we get rid of Emacs 24.
+ (time-since (or (cdr tramp-current-connection) (current-time)))
+ ;; `seconds-to-time' can be removed once we get rid
+ ;; of Emacs 24.
+ (seconds-to-time (or tramp-connection-min-time-diff 0))))
+ (throw 'suppress 'suppress))
+
+ ;; If too much time has passed since last command was sent, look
+ ;; whether process is still alive. If it isn't, kill it. When
+ ;; using ssh, it can sometimes happen that the remote end has hung
+ ;; up but the local ssh client doesn't recognize this until it
+ ;; tries to send some data to the remote end. So that's why we
+ ;; try to send a command from time to time, then look again
+ ;; whether the process is really alive.
+ (condition-case nil
+ ;; `seconds-to-time' can be removed once we get rid of Emacs 24.
+ (when (and (time-less-p (seconds-to-time 60)
+ (time-since
+ (tramp-get-connection-property
+ p "last-cmd-time" (seconds-to-time 0))))
+ (process-live-p p))
+ (tramp-send-command vec "echo are you awake" t t)
+ (unless (and (process-live-p p)
+ (tramp-wait-for-output p 10))
+ ;; The error will be caught locally.
+ (tramp-error vec 'file-error "Awake did fail")))
+ (file-error
+ (tramp-cleanup-connection vec t)
+ (setq p nil)))
+
+ ;; New connection must be opened.
+ (condition-case err
+ (unless (process-live-p p)
+
+ ;; During completion, don't reopen a new connection. We
+ ;; check this for the process related to
+ ;; `tramp-buffer-name'; otherwise `start-file-process'
+ ;; wouldn't run ever when `non-essential' is non-nil.
+ (when (and (tramp-completion-mode-p)
+ (null (get-process (tramp-buffer-name vec))))
+ (throw 'non-essential 'non-essential))
+
+ (with-tramp-progress-reporter
+ vec 3
+ (if (zerop (length (tramp-file-name-user vec)))
+ (format "Opening connection for %s using %s"
+ (tramp-file-name-host vec)
+ (tramp-file-name-method vec))
+ (format "Opening connection for address@hidden using %s"
+ (tramp-file-name-user vec)
+ (tramp-file-name-host vec)
+ (tramp-file-name-method vec)))
+
+ (catch 'uname-changed
+ ;; Start new process.
+ (when (and p (processp p))
+ (delete-process p))
+ ;; Use a temporary `process-environment', in order not
+ ;; to penetrate local processes.
+ (let ((process-environment (copy-sequence process-environment)))
+ (setenv "TERM" tramp-terminal-type)
+ (setenv "LC_ALL" (tramp-get-local-locale vec))
+ (if (stringp tramp-histfile-override)
+ (setenv "HISTFILE" tramp-histfile-override)
+ (if tramp-histfile-override
+ (progn
+ (setenv "HISTFILE")
+ (setenv "HISTFILESIZE" "0")
+ (setenv "HISTSIZE" "0"))))
+ (setenv "PROMPT_COMMAND")
+ (setenv "PS1" tramp-initial-end-of-output)
+ (setq tmp-process-environment
+ (copy-sequence process-environment)))
+ (unless (stringp tramp-encoding-shell)
+ (tramp-error vec 'file-error "`tramp-encoding-shell' not set"))
+ (let* ((current-host (system-name))
+ (target-alist (tramp-compute-multi-hops vec))
+ ;; We will apply `tramp-ssh-controlmaster-options'
+ ;; only for the first hop.
+ (options (tramp-ssh-controlmaster-options vec))
+ (process-connection-type tramp-process-connection-type)
+ (process-adaptive-read-buffering nil)
+ ;; There are unfortunate settings for "cmdproxy" on
+ ;; W32 systems.
+ (process-coding-system-alist nil)
+ (coding-system-for-read nil)
+ ;; This must be done in order to avoid our file
+ ;; name handler.
+ (p (let ((default-directory
+ (tramp-compat-temporary-file-directory))
+ (process-environment tmp-process-environment))
+ (apply
+ #'start-process
+ (tramp-get-connection-name vec)
+ (tramp-get-connection-buffer vec)
+ (if tramp-encoding-command-interactive
+ (list tramp-encoding-shell
+ tramp-encoding-command-interactive)
+ (list tramp-encoding-shell))))))
+
+ ;; Set sentinel and query flag. Initialize variables.
+ (set-process-sentinel p #'tramp-process-sentinel)
+ (process-put p 'vector vec)
+ (process-put p 'adjust-window-size-function #'ignore)
+ (set-process-query-on-exit-flag p nil)
+ (setq tramp-current-connection (cons vec (current-time)))
+
+ (tramp-message
+ vec 6 "%s" (mapconcat #'identity (process-command p) " "))
+
+ ;; Check whether process is alive.
+ (tramp-barf-if-no-shell-prompt
+ p 10
+ "Couldn't find local shell prompt for %s" tramp-encoding-shell)
+
+ ;; Now do all the connections as specified.
+ (while target-alist
+ (let* ((hop (car target-alist))
+ (l-method (tramp-file-name-method hop))
+ (l-user (tramp-file-name-user hop))
+ (l-domain (tramp-file-name-domain hop))
+ (l-host (tramp-file-name-host hop))
+ (l-port (tramp-file-name-port hop))
+ (login-program
+ (tramp-get-method-parameter hop 'tramp-login-program))
+ (login-args
+ (tramp-get-method-parameter hop 'tramp-login-args))
+ (login-env
+ (tramp-get-method-parameter hop 'tramp-login-env))
+ (async-args
+ (tramp-get-method-parameter hop 'tramp-async-args))
+ (connection-timeout
+ (tramp-get-method-parameter
+ hop 'tramp-connection-timeout))
+ (command login-program)
+ ;; We don't create the temporary file. In
+ ;; fact, it is just a prefix for the
+ ;; ControlPath option of ssh; the real
+ ;; temporary file has another name, and it is
+ ;; created and protected by ssh. It is also
+ ;; removed by ssh when the connection is
+ ;; closed. The temporary file name is cached
+ ;; in the main connection process, therefore
+ ;; we cannot use `tramp-get-connection-process'.
+ (tmpfile
+ (with-tramp-connection-property
+ (get-process (tramp-buffer-name vec)) "temp-file"
+ (make-temp-name
+ (expand-file-name
+ tramp-temp-name-prefix
+ (tramp-compat-temporary-file-directory)))))
+ spec r-shell)
+
+ ;; Add arguments for asynchronous processes.
+ (when (and process-name async-args)
+ (setq login-args (append async-args login-args)))
+
+ ;; Check, whether there is a restricted shell.
+ (dolist (elt tramp-restricted-shell-hosts-alist)
+ (when (string-match-p elt current-host)
+ (setq r-shell t)))
+ (setq current-host l-host)
+
+ ;; Set password prompt vector.
+ (tramp-set-connection-property
+ p "password-vector"
+ (make-tramp-file-name
+ :method l-method :user l-user :domain l-domain
+ :host l-host :port l-port))
+
+ ;; Set session timeout.
+ (when (tramp-get-method-parameter
+ hop 'tramp-session-timeout)
+ (tramp-set-connection-property
+ p "session-timeout"
+ (tramp-get-method-parameter
+ hop 'tramp-session-timeout)))
+
+ ;; Add login environment.
+ (when login-env
+ (setq
+ login-env
+ (mapcar
+ (lambda (x)
+ (setq x (mapcar (lambda (y) (format-spec y spec)) x))
+ (unless (member "" x) (mapconcat #'identity x " ")))
+ login-env))
+ (while login-env
+ (setq command
+ (format
+ "%s=%s %s"
+ (pop login-env)
+ (tramp-shell-quote-argument (pop login-env))
+ command)))
+ (setq command (concat "env " command)))
+
+ ;; Replace `login-args' place holders.
+ (setq
+ l-host (or l-host "")
+ l-user (or l-user "")
+ l-port (or l-port "")
+ spec (format-spec-make ?t tmpfile)
+ options (format-spec options spec)
+ spec (format-spec-make
+ ?h l-host ?u l-user ?p l-port ?c options)
+ command
+ (concat
+ ;; We do not want to see the trailing local
+ ;; prompt in `start-file-process'.
+ (unless r-shell "exec ")
+ command " "
+ (mapconcat
+ (lambda (x)
+ (setq x (mapcar (lambda (y) (format-spec y spec)) x))
+ (unless (member "" x) (mapconcat #'identity x " ")))
+ login-args " ")
+ ;; Local shell could be a Windows COMSPEC. It
+ ;; doesn't know the ";" syntax, but we must exit
+ ;; always for `start-file-process'. It could
+ ;; also be a restricted shell, which does not
+ ;; allow "exec".
+ (when r-shell " && exit || exit")))
+
+ ;; Send the command.
+ (tramp-message vec 3 "Sending command `%s'" command)
+ (tramp-send-command vec command t t)
+ (tramp-process-actions
+ p vec
+ (min
+ pos (with-current-buffer (process-buffer p) (point-max)))
+ tramp-actions-before-shell
+ (or connection-timeout tramp-connection-timeout))
+ (tramp-message
+ vec 3 "Found remote shell prompt on `%s'" l-host))
+ ;; Next hop.
+ (setq options ""
+ target-alist (cdr target-alist)))
+
+ ;; Set connection-local variables.
+ (tramp-set-connection-local-variables vec)
+
+ ;; Activate session timeout.
+ (when (tramp-get-connection-property p "session-timeout" nil)
+ (run-at-time
+ (tramp-get-connection-property p "session-timeout" nil) nil
+ 'tramp-timeout-session vec))
+
+ ;; Make initial shell settings.
+ (tramp-open-connection-setup-interactive-shell p vec)
+
+ ;; Mark it as connected.
+ (tramp-set-connection-property p "connected" t)))))
+
+ ;; Cleanup, and propagate the signal.
+ ((error quit)
+ (tramp-cleanup-connection vec t)
+ (signal (car err) (cdr err))))))
+
+(defun tramp-send-command (vec command &optional neveropen nooutput)
+ "Send the COMMAND to connection VEC.
+Erases temporary buffer before sending the command. If optional
+arg NEVEROPEN is non-nil, never try to open the connection. This
+is meant to be used from `tramp-maybe-open-connection' only. The
+function waits for output unless NOOUTPUT is set."
+ (unless neveropen (tramp-maybe-open-connection vec))
+ (let ((p (tramp-get-connection-process vec)))
+ (when (tramp-get-connection-property p "remote-echo" nil)
+ ;; We mark the command string that it can be erased in the output buffer.
+ (tramp-set-connection-property p "check-remote-echo" t)
+ ;; If we put `tramp-echo-mark' after a trailing newline (which
+ ;; is assumed to be unquoted) `tramp-send-string' doesn't see
+ ;; that newline and adds `tramp-rsh-end-of-line' right after
+ ;; `tramp-echo-mark', so the remote shell sees two consecutive
+ ;; trailing line endings and sends two prompts after executing
+ ;; the command, which confuses `tramp-wait-for-output'.
+ (when (and (not (string= command ""))
+ (string-equal (substring command -1) "\n"))
+ (setq command (substring command 0 -1)))
+ ;; No need to restore a trailing newline here since `tramp-send-string'
+ ;; makes sure that the string ends in `tramp-rsh-end-of-line', anyway.
+ (setq command (format "%s%s%s" tramp-echo-mark command tramp-echo-mark)))
+ ;; Send the command.
+ (tramp-message vec 6 "%s" command)
+ (tramp-send-string vec command)
+ (unless nooutput (tramp-wait-for-output p))))
+
+(defun tramp-wait-for-output (proc &optional timeout)
+ "Wait for output from remote command."
+ (unless (buffer-live-p (process-buffer proc))
+ (delete-process proc)
+ (tramp-error proc 'file-error "Process `%s' not available, try again"
proc))
+ (with-current-buffer (process-buffer proc)
+ (let* (;; Initially, `tramp-end-of-output' is "#$ ". There might
+ ;; be leading escape sequences, which must be ignored.
+ ;; Busyboxes built with the EDITING_ASK_TERMINAL config
+ ;; option send also escape sequences, which must be
+ ;; ignored.
+ (regexp (format "[^#$\n]*%s\\(%s\\)?\r?$"
+ (regexp-quote tramp-end-of-output)
+ tramp-device-escape-sequence-regexp))
+ ;; Sometimes, the commands do not return a newline but a
+ ;; null byte before the shell prompt, for example "git
+ ;; ls-files -c -z ...".
+ (regexp1 (format "\\(^\\|\000\\)%s" regexp))
+ (found (tramp-wait-for-regexp proc timeout regexp1)))
+ (if found
+ (let ((inhibit-read-only t))
+ ;; A simple-minded busybox has sent " ^H" sequences.
+ ;; Delete them.
+ (goto-char (point-min))
+ (when (re-search-forward "^\\(.\b\\)+$" (point-at-eol) t)
+ (forward-line 1)
+ (delete-region (point-min) (point)))
+ ;; Delete the prompt.
+ (goto-char (point-max))
+ (re-search-backward regexp nil t)
+ (delete-region (point) (point-max)))
+ (if timeout
+ (tramp-error
+ proc 'file-error
+ "[[Remote prompt `%s' not found in %d secs]]"
+ tramp-end-of-output timeout)
+ (tramp-error
+ proc 'file-error
+ "[[Remote prompt `%s' not found]]" tramp-end-of-output)))
+ ;; Return value is whether end-of-output sentinel was found.
+ found)))
+
+(defun tramp-send-command-and-check
+ (vec command &optional subshell dont-suppress-err)
+ "Run COMMAND and check its exit status.
+Sends `echo $?' along with the COMMAND for checking the exit status.
+If COMMAND is nil, just sends `echo $?'. Returns t if the exit
+status is 0, and nil otherwise.
+
+If the optional argument SUBSHELL is non-nil, the command is
+executed in a subshell, ie surrounded by parentheses. If
+DONT-SUPPRESS-ERR is non-nil, stderr won't be sent to /dev/null."
+ (tramp-send-command
+ vec
+ (concat (if subshell "( " "")
+ command
+ (if command (if dont-suppress-err "; " " 2>/dev/null; ") "")
+ "echo tramp_exit_status $?"
+ (if subshell " )" "")))
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (goto-char (point-max))
+ (unless (re-search-backward "tramp_exit_status [0-9]+" nil t)
+ (tramp-error
+ vec 'file-error "Couldn't find exit status of `%s'" command))
+ (skip-chars-forward "^ ")
+ (prog1
+ (zerop (read (current-buffer)))
+ (let ((inhibit-read-only t))
+ (delete-region (match-beginning 0) (point-max))))))
+
+(defun tramp-barf-unless-okay (vec command fmt &rest args)
+ "Run COMMAND, check exit status, throw error if exit status not okay.
+Similar to `tramp-send-command-and-check' but accepts two more arguments
+FMT and ARGS which are passed to `error'."
+ (or (tramp-send-command-and-check vec command)
+ (apply #'tramp-error vec 'file-error fmt args)))
+
+(defun tramp-send-command-and-read (vec command &optional noerror marker)
+ "Run COMMAND and return the output, which must be a Lisp expression.
+If MARKER is a regexp, read the output after that string.
+In case there is no valid Lisp expression and NOERROR is nil, it
+raises an error."
+ (when (if noerror
+ (ignore-errors (tramp-send-command-and-check vec command))
+ (tramp-barf-unless-okay
+ vec command "`%s' returns with error" command))
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (goto-char (point-min))
+ ;; Read the marker.
+ (when (stringp marker)
+ (condition-case nil
+ (re-search-forward marker)
+ (error (unless noerror
+ (tramp-error
+ vec 'file-error
+ "`%s' does not return the marker `%s': `%s'"
+ command marker (buffer-string))))))
+ ;; Read the expression.
+ (condition-case nil
+ (prog1 (read (current-buffer))
+ ;; Error handling.
+ (when (re-search-forward "\\S-" (point-at-eol) t)
+ (error nil)))
+ (error (unless noerror
+ (tramp-error
+ vec 'file-error
+ "`%s' does not return a valid Lisp expression: `%s'"
+ command (buffer-string))))))))
+
+;; FIXME: Move to tramp.el?
+;;;###tramp-autoload
+(defun tramp-convert-file-attributes (vec attr)
+ "Convert `file-attributes' ATTR generated by perl script, stat or ls.
+Convert file mode bits to string and set virtual device number.
+Return ATTR."
+ (when attr
+ (save-match-data
+ ;; Remove color escape sequences from symlink.
+ (when (stringp (car attr))
+ (while (string-match tramp-display-escape-sequence-regexp (car attr))
+ (setcar attr (replace-match "" nil nil (car attr)))))
+ ;; Convert uid and gid. Use `tramp-unknown-id-integer' as
+ ;; indication of unusable value.
+ (when (and (numberp (nth 2 attr)) (< (nth 2 attr) 0))
+ (setcar (nthcdr 2 attr) tramp-unknown-id-integer))
+ (when (and (floatp (nth 2 attr))
+ (<= (nth 2 attr) most-positive-fixnum))
+ (setcar (nthcdr 2 attr) (round (nth 2 attr))))
+ (when (and (numberp (nth 3 attr)) (< (nth 3 attr) 0))
+ (setcar (nthcdr 3 attr) tramp-unknown-id-integer))
+ (when (and (floatp (nth 3 attr))
+ (<= (nth 3 attr) most-positive-fixnum))
+ (setcar (nthcdr 3 attr) (round (nth 3 attr))))
+ ;; Convert last access time.
+ (unless (listp (nth 4 attr))
+ (setcar (nthcdr 4 attr) (seconds-to-time (nth 4 attr))))
+ ;; Convert last modification time.
+ (unless (listp (nth 5 attr))
+ (setcar (nthcdr 5 attr) (seconds-to-time (nth 5 attr))))
+ ;; Convert last status change time.
+ (unless (listp (nth 6 attr))
+ (setcar (nthcdr 6 attr) (seconds-to-time (nth 6 attr))))
+ ;; Convert file size.
+ (when (< (nth 7 attr) 0)
+ (setcar (nthcdr 7 attr) -1))
+ (when (and (floatp (nth 7 attr))
+ (<= (nth 7 attr) most-positive-fixnum))
+ (setcar (nthcdr 7 attr) (round (nth 7 attr))))
+ ;; Convert file mode bits to string.
+ (unless (stringp (nth 8 attr))
+ (setcar (nthcdr 8 attr) (tramp-file-mode-from-int (nth 8 attr)))
+ (when (stringp (car attr))
+ (aset (nth 8 attr) 0 ?l)))
+ ;; Convert directory indication bit.
+ (when (string-match-p "^d" (nth 8 attr))
+ (setcar attr t))
+ ;; Convert symlink from `tramp-do-file-attributes-with-stat'.
+ ;; Decode also multibyte string.
+ (when (consp (car attr))
+ (setcar attr
+ (and (stringp (caar attr))
+ (string-match ".+ -> .\\(.+\\)." (caar attr))
+ (decode-coding-string
+ (match-string 1 (caar attr)) 'utf-8))))
+ ;; Set file's gid change bit.
+ (setcar (nthcdr 9 attr)
+ (if (numberp (nth 3 attr))
+ (not (= (nth 3 attr)
+ (tramp-get-remote-gid vec 'integer)))
+ (not (string-equal
+ (nth 3 attr)
+ (tramp-get-remote-gid vec 'string)))))
+ ;; Convert inode.
+ (when (floatp (nth 10 attr))
+ (setcar (nthcdr 10 attr)
+ (condition-case nil
+ (let ((high (nth 10 attr))
+ middle low)
+ (if (<= high most-positive-fixnum)
+ (floor high)
+ ;; The low 16 bits.
+ (setq low (mod high #x10000)
+ high (/ high #x10000))
+ (if (<= high most-positive-fixnum)
+ (cons (floor high) (floor low))
+ ;; The middle 24 bits.
+ (setq middle (mod high #x1000000)
+ high (/ high #x1000000))
+ (cons (floor high)
+ (cons (floor middle) (floor low))))))
+ ;; Inodes can be incredible huge. We must hide this.
+ (error (tramp-get-inode vec)))))
+ ;; Set virtual device number.
+ (setcar (nthcdr 11 attr)
+ (tramp-get-device vec)))
+ attr))
+
+(defun tramp-shell-case-fold (string)
+ "Converts STRING to shell glob pattern which ignores case."
+ (mapconcat
+ (lambda (c)
+ (if (equal (downcase c) (upcase c))
+ (vector c)
+ (format "[%c%c]" (downcase c) (upcase c))))
+ string
+ ""))
+
+(defun tramp-make-copy-program-file-name (vec)
+ "Create a file name suitable for `scp', `pscp', or `nc' and workalikes."
+ (let ((method (tramp-file-name-method vec))
+ (user (tramp-file-name-user vec))
+ (host (tramp-file-name-host vec))
+ (localname
+ (directory-file-name (tramp-file-name-unquote-localname vec))))
+ (when (string-match-p tramp-ipv6-regexp host)
+ (setq host (format "[%s]" host)))
+ (unless (string-match-p "ftp$" method)
+ (setq localname (tramp-shell-quote-argument localname)))
+ (cond
+ ((tramp-get-method-parameter vec 'tramp-remote-copy-program)
+ localname)
+ ((not (zerop (length user)))
+ (format "address@hidden:%s" user host (shell-quote-argument localname)))
+ (t (format "%s:%s" host (shell-quote-argument localname))))))
+
+(defun tramp-method-out-of-band-p (vec size)
+ "Return t if this is an out-of-band method, nil otherwise."
+ (and
+ ;; It shall be an out-of-band method.
+ (tramp-get-method-parameter vec 'tramp-copy-program)
+ ;; There must be a size, otherwise the file doesn't exist.
+ (numberp size)
+ ;; Either the file size is large enough, or (in rare cases) there
+ ;; does not exist a remote encoding.
+ (or (null tramp-copy-size-limit)
+ (> size tramp-copy-size-limit)
+ (null (tramp-get-inline-coding vec "remote-encoding" size)))))
+
+;; Variables local to connection.
+
+(defun tramp-get-remote-path (vec)
+ "Compile list of remote directories for $PATH.
+Nonexistent directories are removed from spec."
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ ;; Expand connection-local variables.
+ (tramp-set-connection-local-variables vec)
+ (with-tramp-connection-property
+ ;; When `tramp-own-remote-path' is in `tramp-remote-path', we
+ ;; cache the result for the session only. Otherwise, the
+ ;; result is cached persistently.
+ (if (memq 'tramp-own-remote-path tramp-remote-path)
+ (tramp-get-connection-process vec)
+ vec)
+ "remote-path"
+ (let* ((remote-path (copy-tree tramp-remote-path))
+ (elt1 (memq 'tramp-default-remote-path remote-path))
+ (elt2 (memq 'tramp-own-remote-path remote-path))
+ (default-remote-path
+ (when elt1
+ (or
+ (tramp-send-command-and-read
+ vec "echo \\\"`getconf PATH 2>/dev/null`\\\"" 'noerror)
+ ;; Default if "getconf" is not available.
+ (progn
+ (tramp-message
+ vec 3
+ "`getconf PATH' not successful, using default value
\"%s\"."
+ "/bin:/usr/bin")
+ "/bin:/usr/bin"))))
+ (own-remote-path
+ ;; The login shell could return more than just the $PATH
+ ;; string. So we use `tramp-end-of-heredoc' as marker.
+ (when elt2
+ (or
+ (tramp-send-command-and-read
+ vec
+ (format
+ "%s %s %s 'echo %s \\\"$PATH\\\"'"
+ (tramp-get-method-parameter vec 'tramp-remote-shell)
+ (mapconcat
+ #'identity
+ (tramp-get-method-parameter vec 'tramp-remote-shell-login)
+ " ")
+ (mapconcat
+ #'identity
+ (tramp-get-method-parameter vec 'tramp-remote-shell-args)
+ " ")
+ (tramp-shell-quote-argument tramp-end-of-heredoc))
+ 'noerror (regexp-quote tramp-end-of-heredoc))
+ (progn
+ (tramp-message
+ vec 2 "Could not retrieve `tramp-own-remote-path'")
+ nil)))))
+
+ ;; Replace place holder `tramp-default-remote-path'.
+ (when elt1
+ (setcdr elt1
+ (append
+ (split-string (or default-remote-path "") ":" 'omit)
+ (cdr elt1)))
+ (setq remote-path (delq 'tramp-default-remote-path remote-path)))
+
+ ;; Replace place holder `tramp-own-remote-path'.
+ (when elt2
+ (setcdr elt2
+ (append
+ (split-string (or own-remote-path "") ":" 'omit)
+ (cdr elt2)))
+ (setq remote-path (delq 'tramp-own-remote-path remote-path)))
+
+ ;; Remove double entries.
+ (setq elt1 remote-path)
+ (while (consp elt1)
+ (while (and (car elt1) (setq elt2 (member (car elt1) (cdr elt1))))
+ (setcar elt2 nil))
+ (setq elt1 (cdr elt1)))
+
+ ;; Remove non-existing directories.
+ (delq
+ nil
+ (mapcar
+ (lambda (x)
+ (and
+ (stringp x)
+ (file-directory-p (tramp-make-tramp-file-name vec x 'nohop))
+ x))
+ remote-path))))))
+
+(defun tramp-get-remote-locale (vec)
+ "Determine remote locale, supporting UTF8 if possible."
+ (with-tramp-connection-property vec "locale"
+ (tramp-send-command vec "locale -a")
+ (let ((candidates '("en_US.utf8" "C.utf8" "en_US.UTF-8" "C.UTF-8"))
+ locale)
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (while candidates
+ (goto-char (point-min))
+ (if (string-match-p (format "^%s\r?$" (regexp-quote (car candidates)))
+ (buffer-string))
+ (setq locale (car candidates)
+ candidates nil)
+ (setq candidates (cdr candidates)))))
+ ;; Return value.
+ (format "LC_ALL=%s" (or locale "C")))))
+
+(defun tramp-get-ls-command (vec)
+ "Determine remote `ls' command."
+ (with-tramp-connection-property vec "ls"
+ (tramp-message vec 5 "Finding a suitable `ls' command")
+ (or
+ (catch 'ls-found
+ (dolist (cmd '("ls" "gnuls" "gls"))
+ (let ((dl (tramp-get-remote-path vec))
+ result)
+ (while (and dl (setq result (tramp-find-executable vec cmd dl t t)))
+ ;; Check parameters. On busybox, "ls" output coloring is
+ ;; enabled by default sometimes. So we try to disable it
+ ;; when possible. $LS_COLORING is not supported there.
+ ;; Some "ls" versions are sensitive to the order of
+ ;; arguments, they fail when "-al" is after the
+ ;; "--color=never" argument (for example on FreeBSD).
+ (when (tramp-send-command-and-check
+ vec (format "%s -lnd /" result))
+ (when (tramp-send-command-and-check
+ vec (format
+ "%s --color=never -al /dev/null" result))
+ (setq result (concat result " --color=never")))
+ (throw 'ls-found result))
+ (setq dl (cdr dl))))))
+ (tramp-error vec 'file-error "Couldn't find a proper `ls' command"))))
+
+(defun tramp-get-ls-command-with (vec option)
+ "Return OPTION, if the remote `ls' command supports the OPTION option."
+ (with-tramp-connection-property vec (concat "ls" option)
+ (tramp-message vec 5 "Checking, whether `ls %s' works" option)
+ ;; Some "ls" versions are sensitive to the order of arguments,
+ ;; they fail when "-al" is after the "--dired" argument (for
+ ;; example on FreeBSD). Busybox does not support this kind of
+ ;; options.
+ (and
+ (not
+ (tramp-send-command-and-check
+ vec
+ (format
+ "%s --help 2>&1 | grep -iq busybox" (tramp-get-ls-command vec))))
+ (tramp-send-command-and-check
+ vec (format "%s %s -al /dev/null" (tramp-get-ls-command vec) option))
+ option)))
+
+(defun tramp-get-test-command (vec)
+ "Determine remote `test' command."
+ (with-tramp-connection-property vec "test"
+ (tramp-message vec 5 "Finding a suitable `test' command")
+ (if (tramp-send-command-and-check vec "test 0")
+ "test"
+ (tramp-find-executable vec "test" (tramp-get-remote-path vec)))))
+
+(defun tramp-get-test-nt-command (vec)
+ "Check, whether the remote `test' command supports the -nt option."
+ ;; Does `test A -nt B' work? Use abominable `find' construct if it
+ ;; doesn't. BSD/OS 4.0 wants the parentheses around the command,
+ ;; for otherwise the shell crashes.
+ (with-tramp-connection-property vec "test-nt"
+ (or
+ (progn
+ (tramp-send-command
+ vec (format "( %s / -nt / )" (tramp-get-test-command vec)))
+ (with-current-buffer (tramp-get-buffer vec)
+ (goto-char (point-min))
+ (when (looking-at-p (regexp-quote tramp-end-of-output))
+ (format "%s %%s -nt %%s" (tramp-get-test-command vec)))))
+ (progn
+ (tramp-send-command
+ vec
+ (format
+ "tramp_test_nt () {\n%s -n \"`find $1 -prune -newer $2 -print`\"\n}"
+ (tramp-get-test-command vec)))
+ "tramp_test_nt %s %s"))))
+
+(defun tramp-get-file-exists-command (vec)
+ "Determine remote command for file existing check."
+ (with-tramp-connection-property vec "file-exists"
+ (tramp-message vec 5 "Finding command to check if file exists")
+ (tramp-find-file-exists-command vec)))
+
+(defun tramp-get-remote-ln (vec)
+ "Determine remote `ln' command."
+ (with-tramp-connection-property vec "ln"
+ (tramp-message vec 5 "Finding a suitable `ln' command")
+ (tramp-find-executable vec "ln" (tramp-get-remote-path vec))))
+
+(defun tramp-get-remote-perl (vec)
+ "Determine remote `perl' command."
+ (with-tramp-connection-property vec "perl"
+ (tramp-message vec 5 "Finding a suitable `perl' command")
+ (let ((result
+ (or (tramp-find-executable vec "perl5" (tramp-get-remote-path vec))
+ (tramp-find-executable vec "perl" (tramp-get-remote-path vec)))))
+ ;; Perform a basic check.
+ (and result
+ (null (tramp-send-command-and-check
+ vec (format "%s -e 'print \"Hello\n\";'" result)))
+ (setq result nil))
+ ;; We must check also for some Perl modules.
+ (when result
+ (with-tramp-connection-property vec "perl-file-spec"
+ (tramp-send-command-and-check
+ vec (format "%s -e 'use File::Spec;'" result)))
+ (with-tramp-connection-property vec "perl-cwd-realpath"
+ (tramp-send-command-and-check
+ vec (format "%s -e 'use Cwd \"realpath\";'" result))))
+ result)))
+
+(defun tramp-get-remote-stat (vec)
+ "Determine remote `stat' command."
+ (with-tramp-connection-property vec "stat"
+ (tramp-message vec 5 "Finding a suitable `stat' command")
+ (let ((result (tramp-find-executable
+ vec "stat" (tramp-get-remote-path vec)))
+ tmp)
+ ;; Check whether stat(1) returns usable syntax. "%s" does not
+ ;; work on older AIX systems. Recent GNU stat versions (8.24?)
+ ;; use shell quoted format for "%N", we check the boundaries "`"
+ ;; and "'", therefore. See Bug#23422 in coreutils.
+ ;; Since GNU stat 8.26, environment variable QUOTING_STYLE is
+ ;; supported.
+ (when result
+ (setq result (concat "env QUOTING_STYLE=locale " result)
+ tmp (tramp-send-command-and-read
+ vec (format "%s -c '(\"%%N\" %%s)' /" result) 'noerror))
+ (unless (and (listp tmp) (stringp (car tmp))
+ (string-match-p "^\\(`/'\\|‘/’\\)$" (car tmp))
+ (integerp (cadr tmp)))
+ (setq result nil)))
+ result)))
+
+(defun tramp-get-remote-readlink (vec)
+ "Determine remote `readlink' command."
+ (with-tramp-connection-property vec "readlink"
+ (tramp-message vec 5 "Finding a suitable `readlink' command")
+ (let ((result (tramp-find-executable
+ vec "readlink" (tramp-get-remote-path vec))))
+ (when (and result
+ (tramp-send-command-and-check
+ vec (format "%s --canonicalize-missing /" result)))
+ result))))
+
+(defun tramp-get-remote-trash (vec)
+ "Determine remote `trash' command.
+This command is returned only if `delete-by-moving-to-trash' is non-nil."
+ (and delete-by-moving-to-trash
+ (with-tramp-connection-property vec "trash"
+ (tramp-message vec 5 "Finding a suitable `trash' command")
+ (tramp-find-executable vec "trash" (tramp-get-remote-path vec)))))
+
+(defun tramp-get-remote-touch (vec)
+ "Determine remote `touch' command."
+ (with-tramp-connection-property vec "touch"
+ (tramp-message vec 5 "Finding a suitable `touch' command")
+ (let ((result (tramp-find-executable
+ vec "touch" (tramp-get-remote-path vec)))
+ (tmpfile
+ (make-temp-name
+ (expand-file-name
+ tramp-temp-name-prefix (tramp-get-remote-tmpdir vec)))))
+ ;; Busyboxes do support the "-t" option only when they have been
+ ;; built with the DESKTOP config option. Let's check it.
+ (when result
+ (tramp-set-connection-property
+ vec "touch-t"
+ (tramp-send-command-and-check
+ vec
+ (format
+ "%s -t %s %s"
+ result
+ (format-time-string "%Y%m%d%H%M.%S")
+ (tramp-compat-file-local-name tmpfile))))
+ (delete-file tmpfile))
+ result)))
+
+(defun tramp-get-remote-df (vec)
+ "Determine remote `df' command."
+ (with-tramp-connection-property vec "df"
+ (tramp-message vec 5 "Finding a suitable `df' command")
+ (let ((df (tramp-find-executable vec "df" (tramp-get-remote-path vec)))
+ result)
+ (when df
+ (cond
+ ;; coreutils.
+ ((tramp-send-command-and-check
+ vec
+ (format
+ "%s /"
+ (setq result
+ (format "%s --block-size=1 --output=size,used,avail" df))))
+ (tramp-set-connection-property vec "df-blocksize" 1)
+ result)
+ ;; POSIX.1
+ ((tramp-send-command-and-check
+ vec (format "%s /" (setq result (format "%s -k" df))))
+ (tramp-set-connection-property vec "df-blocksize" 1024)
+ result))))))
+
+(defun tramp-get-remote-gio-monitor (vec)
+ "Determine remote `gio-monitor' command."
+ (with-tramp-connection-property vec "gio-monitor"
+ (tramp-message vec 5 "Finding a suitable `gio-monitor' command")
+ (tramp-find-executable vec "gio" (tramp-get-remote-path vec) t t)))
+
+(defun tramp-get-remote-gvfs-monitor-dir (vec)
+ "Determine remote `gvfs-monitor-dir' command."
+ (with-tramp-connection-property vec "gvfs-monitor-dir"
+ (tramp-message vec 5 "Finding a suitable `gvfs-monitor-dir' command")
+ ;; We distinguish "gvfs-monitor-dir.exe" from cygwin in order to
+ ;; establish better timeouts in filenotify-tests.el. Any better
+ ;; distinction approach would be welcome!
+ (or (tramp-find-executable
+ vec "gvfs-monitor-dir.exe" (tramp-get-remote-path vec) t t)
+ (tramp-find-executable
+ vec "gvfs-monitor-dir" (tramp-get-remote-path vec) t t))))
+
+(defun tramp-get-remote-inotifywait (vec)
+ "Determine remote `inotifywait' command."
+ (with-tramp-connection-property vec "inotifywait"
+ (tramp-message vec 5 "Finding a suitable `inotifywait' command")
+ (tramp-find-executable vec "inotifywait" (tramp-get-remote-path vec) t t)))
+
+(defun tramp-get-remote-id (vec)
+ "Determine remote `id' command."
+ (with-tramp-connection-property vec "id"
+ (tramp-message vec 5 "Finding POSIX `id' command")
+ (catch 'id-found
+ (dolist (cmd '("id" "gid"))
+ (let ((dl (tramp-get-remote-path vec))
+ result)
+ (while (and dl (setq result (tramp-find-executable vec cmd dl t t)))
+ ;; Check POSIX parameter.
+ (when (tramp-send-command-and-check vec (format "%s -u" result))
+ (throw 'id-found result))
+ (setq dl (cdr dl))))))))
+
+(defun tramp-get-remote-uid-with-id (vec id-format)
+ "Implement `tramp-get-remote-uid' for Tramp files using `id'."
+ (tramp-send-command-and-read
+ vec
+ (format "%s -u%s %s"
+ (tramp-get-remote-id vec)
+ (if (equal id-format 'integer) "" "n")
+ (if (equal id-format 'integer)
+ "" "| sed -e s/^/\\\"/ -e s/\\$/\\\"/"))))
+
+(defun tramp-get-remote-uid-with-perl (vec id-format)
+ "Implement `tramp-get-remote-uid' for Tramp files using a Perl script."
+ (tramp-send-command-and-read
+ vec
+ (format "%s -le '%s'"
+ (tramp-get-remote-perl vec)
+ (if (equal id-format 'integer)
+ "print $>"
+ "print \"\\\"\", scalar getpwuid($>), \"\\\"\""))))
+
+(defun tramp-get-remote-python (vec)
+ "Determine remote `python' command."
+ (with-tramp-connection-property vec "python"
+ (tramp-message vec 5 "Finding a suitable `python' command")
+ (or (tramp-find-executable vec "python" (tramp-get-remote-path vec))
+ (tramp-find-executable vec "python2" (tramp-get-remote-path vec))
+ (tramp-find-executable vec "python3" (tramp-get-remote-path vec)))))
+
+(defun tramp-get-remote-uid-with-python (vec id-format)
+ "Implement `tramp-get-remote-uid' for Tramp files using `python'."
+ (tramp-send-command-and-read
+ vec
+ (format "%s -c \"%s\""
+ (tramp-get-remote-python vec)
+ (if (equal id-format 'integer)
+ "import os; print (os.getuid())"
+ "import os, pwd; print ('\\\"' + pwd.getpwuid(os.getuid())[0] +
'\\\"')"))))
+
+(defun tramp-get-remote-uid (vec id-format)
+ "The uid of the remote connection VEC, in ID-FORMAT.
+ID-FORMAT valid values are `string' and `integer'."
+ (with-tramp-connection-property vec (format "uid-%s" id-format)
+ (let ((res
+ (ignore-errors
+ (cond
+ ((tramp-get-remote-id vec)
+ (tramp-get-remote-uid-with-id vec id-format))
+ ((tramp-get-remote-perl vec)
+ (tramp-get-remote-uid-with-perl vec id-format))
+ ((tramp-get-remote-python vec)
+ (tramp-get-remote-uid-with-python vec id-format))))))
+ ;; Ensure there is a valid result.
+ (cond
+ ((and (equal id-format 'integer) (not (integerp res)))
+ tramp-unknown-id-integer)
+ ((and (equal id-format 'string) (not (stringp res)))
+ tramp-unknown-id-string)
+ (t res)))))
+
+(defun tramp-get-remote-gid-with-id (vec id-format)
+ "Implement `tramp-get-remote-gid' for Tramp files using `id'."
+ (tramp-send-command-and-read
+ vec
+ (format "%s -g%s %s"
+ (tramp-get-remote-id vec)
+ (if (equal id-format 'integer) "" "n")
+ (if (equal id-format 'integer)
+ "" "| sed -e s/^/\\\"/ -e s/\\$/\\\"/"))))
+
+(defun tramp-get-remote-gid-with-perl (vec id-format)
+ "Implement `tramp-get-remote-gid' for Tramp files using a Perl script."
+ (tramp-send-command-and-read
+ vec
+ (format "%s -le '%s'"
+ (tramp-get-remote-perl vec)
+ (if (equal id-format 'integer)
+ "print ($)=~/(\\d+)/)"
+ "print \"\\\"\", scalar getgrgid($)), \"\\\"\""))))
+
+(defun tramp-get-remote-gid-with-python (vec id-format)
+ "Implement `tramp-get-remote-gid' for Tramp files using `python'."
+ (tramp-send-command-and-read
+ vec
+ (format "%s -c \"%s\""
+ (tramp-get-remote-python vec)
+ (if (equal id-format 'integer)
+ "import os; print (os.getgid())"
+ "import os, grp; print ('\\\"' + grp.getgrgid(os.getgid())[0] +
'\\\"')"))))
+
+(defun tramp-get-remote-gid (vec id-format)
+ "The gid of the remote connection VEC, in ID-FORMAT.
+ID-FORMAT valid values are `string' and `integer'."
+ (with-tramp-connection-property vec (format "gid-%s" id-format)
+ (let ((res
+ (ignore-errors
+ (cond
+ ((tramp-get-remote-id vec)
+ (tramp-get-remote-gid-with-id vec id-format))
+ ((tramp-get-remote-perl vec)
+ (tramp-get-remote-gid-with-perl vec id-format))
+ ((tramp-get-remote-python vec)
+ (tramp-get-remote-gid-with-python vec id-format))))))
+ ;; Ensure there is a valid result.
+ (cond
+ ((and (equal id-format 'integer) (not (integerp res)))
+ tramp-unknown-id-integer)
+ ((and (equal id-format 'string) (not (stringp res)))
+ tramp-unknown-id-string)
+ (t res)))))
+
+(defun tramp-get-env-with-u-option (vec)
+ "Check, whether the remote `env' command supports the -u option."
+ (with-tramp-connection-property vec "env-u-option"
+ (tramp-message vec 5 "Checking, whether `env -u' works")
+ ;; Option "-u" is a GNU extension.
+ (tramp-send-command-and-check
+ vec "env FOO=foo env -u FOO 2>/dev/null | grep -qv FOO" t)))
+
+;; Some predefined connection properties.
+(defun tramp-get-inline-compress (vec prop size)
+ "Return the compress command related to PROP.
+PROP is either `inline-compress' or `inline-decompress'. SIZE is
+the length of the file to be compressed.
+
+If no corresponding command is found, nil is returned."
+ (when (and (integerp tramp-inline-compress-start-size)
+ (> size tramp-inline-compress-start-size))
+ (with-tramp-connection-property (tramp-get-connection-process vec) prop
+ (tramp-find-inline-compress vec)
+ (tramp-get-connection-property
+ (tramp-get-connection-process vec) prop nil))))
+
+(defun tramp-get-inline-coding (vec prop size)
+ "Return the coding command related to PROP.
+PROP is either `remote-encoding', `remote-decoding',
+`local-encoding' or `local-decoding'.
+
+SIZE is the length of the file to be coded. Depending on SIZE,
+compression might be applied.
+
+If no corresponding command is found, nil is returned.
+Otherwise, either a string is returned which contains a `%s' mark
+to be used for the respective input or output file; or a Lisp
+function cell is returned to be applied on a buffer."
+ ;; We must catch the errors, because we want to return nil, when
+ ;; no inline coding is found.
+ (ignore-errors
+ (let ((coding
+ (with-tramp-connection-property
+ (tramp-get-connection-process vec) prop
+ (tramp-find-inline-encoding vec)
+ (tramp-get-connection-property
+ (tramp-get-connection-process vec) prop nil)))
+ (prop1 (if (string-match-p "encoding" prop)
+ "inline-compress" "inline-decompress"))
+ compress)
+ ;; The connection property might have been cached. So we must
+ ;; send the script to the remote side - maybe.
+ (when (and coding (symbolp coding) (string-match-p "remote" prop))
+ (let ((name (symbol-name coding)))
+ (while (string-match "-" name)
+ (setq name (replace-match "_" nil t name)))
+ (tramp-maybe-send-script vec (symbol-value coding) name)
+ (setq coding name)))
+ (when coding
+ ;; Check for the `compress' command.
+ (setq compress (tramp-get-inline-compress vec prop1 size))
+ ;; Return the value.
+ (cond
+ ((and compress (symbolp coding))
+ (if (string-match-p "decompress" prop1)
+ `(lambda (beg end)
+ (,coding beg end)
+ (let ((coding-system-for-write 'binary)
+ (coding-system-for-read 'binary))
+ (apply
+ #'tramp-call-process-region ',vec (point-min) (point-max)
+ (car (split-string ,compress)) t t nil
+ (cdr (split-string ,compress)))))
+ `(lambda (beg end)
+ (let ((coding-system-for-write 'binary)
+ (coding-system-for-read 'binary))
+ (apply
+ #'tramp-call-process-region ',vec beg end
+ (car (split-string ,compress)) t t nil
+ (cdr (split-string ,compress))))
+ (,coding (point-min) (point-max)))))
+ ((symbolp coding)
+ coding)
+ ((and compress (string-match-p "decoding" prop))
+ (format
+ ;; Windows shells need the program file name after
+ ;; the pipe symbol be quoted if they use forward
+ ;; slashes as directory separators.
+ (cond
+ ((and (string-match-p "local" prop)
+ (memq system-type '(windows-nt)))
+ "(%s | \"%s\")")
+ ((string-match-p "local" prop) "(%s | %s)")
+ (t "(%s | %s >%%s)"))
+ coding compress))
+ (compress
+ (format
+ ;; Windows shells need the program file name after
+ ;; the pipe symbol be quoted if they use forward
+ ;; slashes as directory separators.
+ (if (and (string-match-p "local" prop)
+ (memq system-type '(windows-nt)))
+ "(%s <%%s | \"%s\")"
+ "(%s <%%s | %s)")
+ compress coding))
+ ((string-match-p "decoding" prop)
+ (cond
+ ((string-match-p "local" prop) (format "%s" coding))
+ (t (format "%s >%%s" coding))))
+ (t
+ (format "%s <%%s" coding)))))))
+
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (unload-feature 'tramp-sh 'force)))
+
+(provide 'tramp-sh)
+
+;;; TODO:
+
+;; * Don't use globbing for directories with many files, as this is
+;; likely to produce long command lines, and some shells choke on
+;; long command lines.
+;;
+;; * Don't search for perl5 and perl. Instead, only search for perl and
+;; then look if it's the right version (with `perl -v').
+;;
+;; * When editing a remote CVS controlled file as a different user, VC
+;; gets confused about the file locking status. Try to find out why
+;; the workaround doesn't work.
+;;
+;; * WIBNI if we had a command "trampclient"? If I was editing in
+;; some shell with root privileges, it would be nice if I could
+;; just call
+;; trampclient filename.c
+;; as an editor, and the _current_ shell would connect to an Emacs
+;; server and would be used in an existing non-privileged Emacs
+;; session for doing the editing in question.
+;; That way, I need not tell Emacs my password again and be afraid
+;; that it makes it into core dumps or other ugly stuff (I had Emacs
+;; once display a just typed password in the context of a keyboard
+;; sequence prompt for a question immediately following in a shell
+;; script run within Emacs -- nasty).
+;; And if I have some ssh session running to a different computer,
+;; having the possibility of passing a local file there to a local
+;; Emacs session (in case I can arrange for a connection back) would
+;; be nice.
+;; Likely the corresponding Tramp server should not allow the
+;; equivalent of the emacsclient -eval option in order to make this
+;; reasonably unproblematic. And maybe trampclient should have some
+;; way of passing credentials, like by using an SSL socket or
+;; something. (David Kastrup)
+;;
+;; * Reconnect directly to a compliant shell without first going
+;; through the user's default shell. (Pete Forman)
+;;
+;; * Avoid the local shell entirely for starting remote processes. If
+;; so, I think even a signal, when delivered directly to the local
+;; SSH instance, would correctly be propagated to the remote process
+;; automatically; possibly SSH would have to be started with
+;; "-t". (Markus Triska)
+;;
+;; * It makes me wonder if tramp couldn't fall back to ssh when scp
+;; isn't on the remote host. (Mark A. Hershberger)
+;;
+;; * Use lsh instead of ssh. (Alfred M. Szmidt)
+;;
+;; * Optimize out-of-band copying when both methods are scp-like (not
+;; rsync).
+;;
+;; * Keep a second connection open for out-of-band methods like scp or
+;; rsync.
+;;
+;; * Implement completion for "/method:address@hidden:~<abc> TAB".
+;;
+;; * I think you could get the best of both worlds by using an
+;; approach similar to Tramp but running a little tramp-daemon on
+;; the other end, such that we can use a more efficient
+;; communication protocol (e.g. when saving a file we could locally
+;; diff it against the last version (of which the remote daemon
+;; would also keep a copy), and then only send the diff).
+;;
+;; This said, even using such a daemon it might be difficult to get
+;; good performance: part of the problem is the number of
+;; round-trips. E.g. when saving a file we have to check if the
+;; file was modified in the mean time and whether saving into a new
+;; inode would change the owner (etc...), which each require a
+;; round-trip. To get rid of these round-trips, we'd have to
+;; shortcut this code and delegate the higher-level "save file"
+;; operation to the remote server, which then has to perform those
+;; tasks but still obeying the locally set customizations about how
+;; to do each one of those tasks.
+;;
+;; We could either put higher-level ops in there (like
+;; `save-buffer'), which implies replicating the whole `save-buffer'
+;; behavior, which is a lot of work and likely to be not 100%
+;; faithful.
+;;
+;; Or we could introduce new low-level ops that are asynchronous,
+;; and then rewrite save-buffer to use them. IOW save-buffer would
+;; start with a bunch of calls like `start-getting-file-attributes'
+;; which could immediately be passed on to the remote side, and
+;; later on checks the return value of those calls as and when
+;; needed. (Stefan Monnier)
+;;
+;; * Implement detaching/re-attaching remote sessions. By this, a
+;; session could be reused after a connection loss. Use dtach, or
+;; screen, or tmux, or mosh.
+;;
+;; * Implement `:stderr' of `make-process' as pipe process.
+
+;;; tramp-sh.el ends here
diff --git a/tramp-smb.el b/tramp-smb.el
deleted file mode 120000
index 741585e..0000000
--- a/tramp-smb.el
+++ /dev/null
@@ -1 +0,0 @@
-lisp/tramp-smb.el
\ No newline at end of file
diff --git a/tramp-smb.el b/tramp-smb.el
new file mode 100644
index 0000000..9d15c05
--- /dev/null
+++ b/tramp-smb.el
@@ -0,0 +1,2112 @@
+;;; tramp-smb.el --- Tramp access functions for SMB servers -*-
lexical-binding:t -*-
+
+;; Copyright (C) 2002-2019 Free Software Foundation, Inc.
+
+;; Author: Michael Albinus <address@hidden>
+;; 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 SMB servers like SAMBA or M$ Windows from Tramp.
+
+;;; Code:
+
+(eval-when-compile (require 'cl-lib))
+(require 'tramp)
+
+;; Define SMB method ...
+;;;###tramp-autoload
+(defconst tramp-smb-method "smb"
+ "Method to connect SAMBA and M$ SMB servers.")
+
+;; ... and add it to the method list.
+;;;###tramp-autoload
+(unless (memq system-type '(cygwin windows-nt))
+ (tramp--with-startup
+ (add-to-list 'tramp-methods
+ `(,tramp-smb-method
+ ;; This is just a guess. We don't know whether the share
"C$"
+ ;; is available for public use, and whether the user has
write
+ ;; access.
+ (tramp-tmpdir "/C$/Temp")
+ ;; Another guess. We might implement a better check later
on.
+ (tramp-case-insensitive t)))))
+
+;; Add a default for `tramp-default-user-alist'. Rule: For the SMB method,
+;; the anonymous user is chosen.
+;;;###tramp-autoload
+(tramp--with-startup
+ (add-to-list 'tramp-default-user-alist
+ `(,(concat "\\`" tramp-smb-method "\\'") nil nil))
+
+ ;; Add completion function for SMB method.
+ (tramp-set-completion-function
+ tramp-smb-method
+ '((tramp-parse-netrc "~/.netrc"))))
+
+(defcustom tramp-smb-program "smbclient"
+ "Name of SMB client to run."
+ :group 'tramp
+ :type 'string)
+
+(defcustom tramp-smb-acl-program "smbcacls"
+ "Name of SMB acls to run."
+ :group 'tramp
+ :type 'string
+ :version "24.4")
+
+(defcustom tramp-smb-conf "/dev/null"
+ "Path of the smb.conf file.
+If it is nil, no smb.conf will be added to the `tramp-smb-program'
+call, letting the SMB client use the default one."
+ :group 'tramp
+ :type '(choice (const nil) (file :must-match t)))
+
+(defvar tramp-smb-version nil
+ "Version string of the SMB client.")
+
+(defconst tramp-smb-server-version
+ "Domain=\\[[^]]*\\] OS=\\[[^]]*\\] Server=\\[[^]]*\\]"
+ "Regexp of SMB server identification.")
+
+(defconst tramp-smb-prompt "^\\(smb:\\|PS\\) .+> \\|^\\s-+Server\\s-+Comment$"
+ "Regexp used as prompt in smbclient or powershell.")
+
+(defconst tramp-smb-wrong-passwd-regexp
+ (regexp-opt
+ '("NT_STATUS_LOGON_FAILURE"
+ "NT_STATUS_WRONG_PASSWORD"))
+ "Regexp for login error strings of SMB servers.")
+
+(defconst tramp-smb-errors
+ (mapconcat
+ #'identity
+ `(;; Connection error / timeout / unknown command.
+ "Connection\\( to \\S-+\\)? failed"
+ "Read from server failed, maybe it closed the connection"
+ "Call timed out: server did not respond"
+ "\\S-+: command not found"
+ "Server doesn't support UNIX CIFS calls"
+ ,(regexp-opt
+ '(;; Samba.
+ "ERRDOS"
+ "ERRHRD"
+ "ERRSRV"
+ "ERRbadfile"
+ "ERRbadpw"
+ "ERRfilexists"
+ "ERRnoaccess"
+ "ERRnomem"
+ "ERRnosuchshare"
+ ;; See /usr/include/samba-4.0/core/ntstatus.h.
+ ;; Windows 4.0 (Windows NT), Windows 5.0 (Windows 2000),
+ ;; Windows 5.1 (Windows XP), Windows 5.2 (Windows Server 2003),
+ ;; Windows 6.0 (Windows Vista), Windows 6.1 (Windows 7),
+ ;; Windows 6.3 (Windows Server 2012, Windows 10).
+ "NT_STATUS_ACCESS_DENIED"
+ "NT_STATUS_ACCOUNT_LOCKED_OUT"
+ "NT_STATUS_BAD_NETWORK_NAME"
+ "NT_STATUS_CANNOT_DELETE"
+ "NT_STATUS_CONNECTION_DISCONNECTED"
+ "NT_STATUS_CONNECTION_REFUSED"
+ "NT_STATUS_CONNECTION_RESET"
+ "NT_STATUS_DIRECTORY_NOT_EMPTY"
+ "NT_STATUS_DUPLICATE_NAME"
+ "NT_STATUS_FILE_IS_A_DIRECTORY"
+ "NT_STATUS_HOST_UNREACHABLE"
+ "NT_STATUS_IMAGE_ALREADY_LOADED"
+ "NT_STATUS_INVALID_LEVEL"
+ "NT_STATUS_INVALID_PARAMETER_MIX"
+ "NT_STATUS_IO_TIMEOUT"
+ "NT_STATUS_LOGON_FAILURE"
+ "NT_STATUS_NETWORK_ACCESS_DENIED"
+ "NT_STATUS_NOT_IMPLEMENTED"
+ "NT_STATUS_NO_LOGON_SERVERS"
+ "NT_STATUS_NO_SUCH_FILE"
+ "NT_STATUS_NO_SUCH_USER"
+ "NT_STATUS_NOT_A_DIRECTORY"
+ "NT_STATUS_OBJECT_NAME_COLLISION"
+ "NT_STATUS_OBJECT_NAME_INVALID"
+ "NT_STATUS_OBJECT_NAME_NOT_FOUND"
+ "NT_STATUS_OBJECT_PATH_SYNTAX_BAD"
+ "NT_STATUS_PASSWORD_MUST_CHANGE"
+ "NT_STATUS_RESOURCE_NAME_NOT_FOUND"
+ "NT_STATUS_REVISION_MISMATCH"
+ "NT_STATUS_SHARING_VIOLATION"
+ "NT_STATUS_TRUSTED_RELATIONSHIP_FAILURE"
+ "NT_STATUS_UNSUCCESSFUL"
+ "NT_STATUS_WRONG_PASSWORD")))
+ "\\|")
+ "Regexp for possible error strings of SMB servers.
+Used instead of analyzing error codes of commands.")
+
+(defconst tramp-smb-actions-with-share
+ '((tramp-smb-prompt tramp-action-succeed)
+ (tramp-password-prompt-regexp tramp-action-password)
+ (tramp-wrong-passwd-regexp tramp-action-permission-denied)
+ (tramp-smb-errors tramp-action-permission-denied)
+ (tramp-process-alive-regexp tramp-action-process-alive))
+ "List of pattern/action pairs.
+This list is used for login to SMB servers.
+
+See `tramp-actions-before-shell' for more info.")
+
+(defconst tramp-smb-actions-without-share
+ '((tramp-password-prompt-regexp tramp-action-password)
+ (tramp-wrong-passwd-regexp tramp-action-permission-denied)
+ (tramp-smb-errors tramp-action-permission-denied)
+ (tramp-process-alive-regexp tramp-action-out-of-band))
+ "List of pattern/action pairs.
+This list is used for login to SMB servers.
+
+See `tramp-actions-before-shell' for more info.")
+
+(defconst tramp-smb-actions-with-tar
+ '((tramp-password-prompt-regexp tramp-action-password)
+ (tramp-wrong-passwd-regexp tramp-action-permission-denied)
+ (tramp-smb-errors tramp-action-permission-denied)
+ (tramp-process-alive-regexp tramp-smb-action-with-tar))
+ "List of pattern/action pairs.
+This list is used for tar-like copy of directories.
+
+See `tramp-actions-before-shell' for more info.")
+
+(defconst tramp-smb-actions-get-acl
+ '((tramp-password-prompt-regexp tramp-action-password)
+ (tramp-wrong-passwd-regexp tramp-action-permission-denied)
+ (tramp-smb-errors tramp-action-permission-denied)
+ (tramp-process-alive-regexp tramp-smb-action-get-acl))
+ "List of pattern/action pairs.
+This list is used for smbcacls actions.
+
+See `tramp-actions-before-shell' for more info.")
+
+(defconst tramp-smb-actions-set-acl
+ '((tramp-password-prompt-regexp tramp-action-password)
+ (tramp-wrong-passwd-regexp tramp-action-permission-denied)
+ (tramp-smb-errors tramp-action-permission-denied)
+ (tramp-process-alive-regexp tramp-smb-action-set-acl))
+ "List of pattern/action pairs.
+This list is used for smbcacls actions.
+
+See `tramp-actions-before-shell' for more info.")
+
+;; New handlers should be added here.
+;;;###tramp-autoload
+(defconst tramp-smb-file-name-handler-alist
+ '((access-file . tramp-handle-access-file)
+ (add-name-to-file . tramp-smb-handle-add-name-to-file)
+ ;; `byte-compiler-base-file-name' performed by default handler.
+ (copy-directory . tramp-smb-handle-copy-directory)
+ (copy-file . tramp-smb-handle-copy-file)
+ (delete-directory . tramp-smb-handle-delete-directory)
+ (delete-file . tramp-smb-handle-delete-file)
+ ;; `diff-latest-backup-file' performed by default handler.
+ (directory-file-name . tramp-handle-directory-file-name)
+ (directory-files . tramp-smb-handle-directory-files)
+ (directory-files-and-attributes
+ . tramp-handle-directory-files-and-attributes)
+ (dired-compress-file . ignore)
+ (dired-uncache . tramp-handle-dired-uncache)
+ (exec-path . ignore)
+ (expand-file-name . tramp-smb-handle-expand-file-name)
+ (file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
+ (file-acl . tramp-smb-handle-file-acl)
+ (file-attributes . tramp-smb-handle-file-attributes)
+ (file-directory-p . tramp-handle-file-directory-p)
+ (file-file-equal-p . tramp-handle-file-equal-p)
+ (file-executable-p . tramp-handle-file-exists-p)
+ (file-exists-p . tramp-handle-file-exists-p)
+ (file-in-directory-p . tramp-handle-file-in-directory-p)
+ (file-local-copy . tramp-smb-handle-file-local-copy)
+ (file-modes . tramp-handle-file-modes)
+ (file-name-all-completions . tramp-smb-handle-file-name-all-completions)
+ (file-name-as-directory . tramp-handle-file-name-as-directory)
+ (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p)
+ (file-name-completion . tramp-handle-file-name-completion)
+ (file-name-directory . tramp-handle-file-name-directory)
+ (file-name-nondirectory . tramp-handle-file-name-nondirectory)
+ ;; `file-name-sans-versions' performed by default handler.
+ (file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
+ (file-notify-add-watch . tramp-handle-file-notify-add-watch)
+ (file-notify-rm-watch . tramp-handle-file-notify-rm-watch)
+ (file-notify-valid-p . tramp-handle-file-notify-valid-p)
+ (file-ownership-preserved-p . ignore)
+ (file-readable-p . tramp-handle-file-exists-p)
+ (file-regular-p . tramp-handle-file-regular-p)
+ (file-remote-p . tramp-handle-file-remote-p)
+ (file-selinux-context . tramp-handle-file-selinux-context)
+ (file-symlink-p . tramp-handle-file-symlink-p)
+ (file-system-info . tramp-smb-handle-file-system-info)
+ (file-truename . tramp-handle-file-truename)
+ (file-writable-p . tramp-smb-handle-file-writable-p)
+ (find-backup-file-name . tramp-handle-find-backup-file-name)
+ ;; `get-file-buffer' performed by default handler.
+ (insert-directory . tramp-smb-handle-insert-directory)
+ (insert-file-contents . tramp-handle-insert-file-contents)
+ (load . tramp-handle-load)
+ (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
+ (make-directory . tramp-smb-handle-make-directory)
+ (make-directory-internal . tramp-smb-handle-make-directory-internal)
+ (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
+ (make-process . ignore)
+ (make-symbolic-link . tramp-smb-handle-make-symbolic-link)
+ (process-file . tramp-smb-handle-process-file)
+ (rename-file . tramp-smb-handle-rename-file)
+ (set-file-acl . tramp-smb-handle-set-file-acl)
+ (set-file-modes . tramp-smb-handle-set-file-modes)
+ (set-file-selinux-context . ignore)
+ (set-file-times . ignore)
+ (set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
+ (shell-command . tramp-handle-shell-command)
+ (start-file-process . tramp-smb-handle-start-file-process)
+ (substitute-in-file-name . tramp-smb-handle-substitute-in-file-name)
+ (temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-set-file-uid-gid . ignore)
+ (unhandled-file-name-directory . ignore)
+ (vc-registered . ignore)
+ (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
+ (write-region . tramp-smb-handle-write-region))
+ "Alist of handler functions for Tramp SMB method.
+Operations not mentioned here will be handled by the default Emacs
primitives.")
+
+;; Options for remote processes via winexe.
+(defcustom tramp-smb-winexe-program "winexe"
+ "Name of winexe client to run.
+If it isn't found in the local $PATH, the absolute path of winexe
+shall be given. This is needed for remote processes."
+ :group 'tramp
+ :type 'string
+ :version "24.3")
+
+(defcustom tramp-smb-winexe-shell-command "powershell.exe"
+ "Shell to be used for processes on remote machines.
+This must be Powershell V2 compatible."
+ :group 'tramp
+ :type 'string
+ :version "24.3")
+
+(defcustom tramp-smb-winexe-shell-command-switch "-file -"
+ "Command switch used together with `tramp-smb-winexe-shell-command'.
+This can be used to disable echo etc."
+ :group 'tramp
+ :type 'string
+ :version "24.3")
+
+;; It must be a `defsubst' in order to push the whole code into
+;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
+;;;###tramp-autoload
+(defsubst tramp-smb-file-name-p (filename)
+ "Check if it's a filename for SMB servers."
+ (and (tramp-tramp-file-p filename)
+ (string= (tramp-file-name-method (tramp-dissect-file-name filename))
+ tramp-smb-method)))
+
+;;;###tramp-autoload
+(defun tramp-smb-file-name-handler (operation &rest args)
+ "Invoke the SMB related OPERATION.
+First arg specifies the OPERATION, second arg is a list of arguments to
+pass to the OPERATION."
+ (let ((fn (assoc operation tramp-smb-file-name-handler-alist)))
+ (if fn
+ (save-match-data (apply (cdr fn) args))
+ (tramp-run-real-handler operation args))))
+
+;;;###tramp-autoload
+(unless (memq system-type '(cygwin windows-nt))
+ (tramp--with-startup
+ (tramp-register-foreign-file-name-handler
+ #'tramp-smb-file-name-p #'tramp-smb-file-name-handler)))
+
+;; File name primitives.
+
+(defun tramp-smb-handle-add-name-to-file
+ (filename newname &optional ok-if-already-exists)
+ "Like `add-name-to-file' for Tramp files."
+ (unless (tramp-equal-remote filename newname)
+ (with-parsed-tramp-file-name
+ (if (tramp-tramp-file-p filename) filename newname) nil
+ (tramp-error
+ v 'file-error
+ "add-name-to-file: %s"
+ "only implemented for same method, same user, same host")))
+ (with-parsed-tramp-file-name filename v1
+ (with-parsed-tramp-file-name newname v2
+ (when (file-directory-p filename)
+ (tramp-error
+ v2 'file-error
+ "add-name-to-file: %s must not be a directory" filename))
+ ;; Do the 'confirm if exists' thing.
+ (when (file-exists-p newname)
+ ;; What to do?
+ (if (or (null ok-if-already-exists) ; not allowed to exist
+ (and (numberp ok-if-already-exists)
+ (not (yes-or-no-p
+ (format
+ "File %s already exists; make it a link anyway? "
+ v2-localname)))))
+ (tramp-error v2 'file-already-exists newname)
+ (delete-file newname)))
+ ;; We must also flush the cache of the directory, because
+ ;; `file-attributes' reads the values from there.
+ (tramp-flush-file-properties v2 (file-name-directory v2-localname))
+ (tramp-flush-file-properties v2 v2-localname)
+ (unless
+ (tramp-smb-send-command
+ v1
+ (format
+ "%s \"%s\" \"%s\""
+ (if (tramp-smb-get-cifs-capabilities v1) "link" "hardlink")
+ (tramp-smb-get-localname v1)
+ (tramp-smb-get-localname v2)))
+ (tramp-error
+ v2 'file-error
+ "error with add-name-to-file, see buffer `%s' for details"
+ (buffer-name))))))
+
+(defun tramp-smb-action-with-tar (proc vec)
+ "Untar from connection buffer."
+ (if (not (process-live-p proc))
+ (throw 'tramp-action 'process-died)
+
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (goto-char (point-min))
+ (when (search-forward-regexp tramp-smb-server-version nil t)
+ ;; There might be a hidden password prompt.
+ (widen)
+ (forward-line)
+ (tramp-message vec 6 (buffer-substring (point-min) (point)))
+ (delete-region (point-min) (point))
+ (throw 'tramp-action 'ok)))))
+
+(defun tramp-smb-handle-copy-directory
+ (dirname newname &optional keep-date parents copy-contents)
+ "Like `copy-directory' for Tramp files."
+ (if copy-contents
+ ;; We must do it file-wise.
+ (tramp-run-real-handler
+ #'copy-directory (list dirname newname keep-date parents copy-contents))
+
+ (setq dirname (expand-file-name dirname)
+ newname (expand-file-name newname))
+ (let ((t1 (tramp-tramp-file-p dirname))
+ (t2 (tramp-tramp-file-p newname)))
+ (with-parsed-tramp-file-name (if t1 dirname newname) nil
+ (with-tramp-progress-reporter
+ v 0 (format "Copying %s to %s" dirname newname)
+ (when (and (file-directory-p newname)
+ (not (tramp-compat-directory-name-p newname)))
+ (tramp-error v 'file-already-exists newname))
+ (cond
+ ;; We must use a local temporary directory.
+ ((and t1 t2)
+ (let ((tmpdir
+ (make-temp-name
+ (expand-file-name
+ tramp-temp-name-prefix
+ (tramp-compat-temporary-file-directory)))))
+ (unwind-protect
+ (progn
+ (make-directory tmpdir)
+ (copy-directory
+ dirname (file-name-as-directory tmpdir) keep-date 'parents)
+ (copy-directory
+ (expand-file-name (file-name-nondirectory dirname) tmpdir)
+ newname keep-date parents))
+ (delete-directory tmpdir 'recursive))))
+
+ ;; We can copy recursively.
+ ;; TODO: Does not work reliably.
+ (nil ;(and (or t1 t2) (tramp-smb-get-cifs-capabilities v))
+ (when (and (file-directory-p newname)
+ (not (string-equal (file-name-nondirectory dirname)
+ (file-name-nondirectory newname))))
+ (setq newname
+ (expand-file-name
+ (file-name-nondirectory dirname) newname))
+ (if t2 (setq v (tramp-dissect-file-name newname))))
+ (if (not (file-directory-p newname))
+ (make-directory newname parents))
+
+ (let* ((share (tramp-smb-get-share v))
+ (localname (file-name-as-directory
+ (replace-regexp-in-string
+ "\\\\" "/" (tramp-smb-get-localname v))))
+ (tmpdir (make-temp-name
+ (expand-file-name
+ tramp-temp-name-prefix
+ (tramp-compat-temporary-file-directory))))
+ (args (list (concat "//" host "/" share) "-E")))
+
+ (if (not (zerop (length user)))
+ (setq args (append args (list "-U" user)))
+ (setq args (append args (list "-N"))))
+
+ (when domain (setq args (append args (list "-W" domain))))
+ (when port (setq args (append args (list "-p" port))))
+ (when tramp-smb-conf
+ (setq args (append args (list "-s" tramp-smb-conf))))
+ (setq args
+ (if t1
+ ;; Source is remote.
+ (append args
+ (list "-D" (tramp-unquote-shell-quote-argument
+ localname)
+ "-c" (shell-quote-argument "tar qc - *")
+ "|" "tar" "xfC" "-"
+ (tramp-unquote-shell-quote-argument
+ tmpdir)))
+ ;; Target is remote.
+ (append (list "tar" "cfC" "-"
+ (tramp-unquote-shell-quote-argument dirname)
+ "." "|")
+ args
+ (list "-D" (tramp-unquote-shell-quote-argument
+ localname)
+ "-c" (shell-quote-argument "tar qx -")))))
+
+ (unwind-protect
+ (with-temp-buffer
+ ;; Set the transfer process properties.
+ (tramp-set-connection-property
+ v "process-name" (buffer-name (current-buffer)))
+ (tramp-set-connection-property
+ v "process-buffer" (current-buffer))
+
+ (when t1
+ ;; The smbclient tar command creates always
+ ;; complete paths. We must emulate the
+ ;; directory structure, and symlink to the real
+ ;; target.
+ (make-directory
+ (expand-file-name
+ ".." (concat tmpdir localname))
+ 'parents)
+ (make-symbolic-link
+ newname (directory-file-name (concat tmpdir localname))))
+
+ ;; Use an asynchronous processes. By this,
+ ;; password can be handled.
+ (let* ((default-directory tmpdir)
+ (p (apply
+ #'start-process
+ (tramp-get-connection-name v)
+ (tramp-get-connection-buffer v)
+ tramp-smb-program args)))
+
+ (tramp-message
+ v 6 "%s" (mapconcat #'identity (process-command p) " "))
+ (process-put p 'vector v)
+ (process-put p 'adjust-window-size-function #'ignore)
+ (set-process-query-on-exit-flag p nil)
+ (tramp-process-actions p v nil tramp-smb-actions-with-tar)
+
+ (while (process-live-p p)
+ (sit-for 0.1))
+ (tramp-message v 6 "\n%s" (buffer-string))))
+
+ ;; Reset the transfer process properties.
+ (tramp-flush-connection-property v "process-name")
+ (tramp-flush-connection-property v "process-buffer")
+ (when t1 (delete-directory tmpdir 'recursive))))
+
+ ;; Handle KEEP-DATE argument.
+ (when keep-date
+ (set-file-times
+ newname
+ (tramp-compat-file-attribute-modification-time
+ (file-attributes dirname))))
+
+ ;; Set the mode.
+ (unless keep-date
+ (set-file-modes newname (tramp-default-file-modes dirname)))
+
+ ;; When newname did exist, we have wrong cached values.
+ (when t2
+ (with-parsed-tramp-file-name newname nil
+ (tramp-flush-file-properties v (file-name-directory localname))
+ (tramp-flush-file-properties v localname))))
+
+ ;; We must do it file-wise.
+ (t
+ (tramp-run-real-handler
+ #'copy-directory (list dirname newname keep-date parents)))))))))
+
+(defun tramp-smb-handle-copy-file
+ (filename newname &optional ok-if-already-exists keep-date
+ _preserve-uid-gid _preserve-extended-attributes)
+ "Like `copy-file' for Tramp files.
+KEEP-DATE has no effect in case NEWNAME resides on an SMB server.
+PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
+ (setq filename (expand-file-name filename)
+ newname (expand-file-name newname))
+ (with-tramp-progress-reporter
+ (tramp-dissect-file-name
+ (if (tramp-tramp-file-p filename) filename newname))
+ 0 (format "Copying %s to %s" filename newname)
+
+ (if (file-directory-p filename)
+ (copy-directory filename newname keep-date 'parents 'copy-contents)
+
+ (let ((tmpfile (file-local-copy filename)))
+ (if tmpfile
+ ;; Remote filename.
+ (condition-case err
+ (rename-file tmpfile newname ok-if-already-exists)
+ ((error quit)
+ (delete-file tmpfile)
+ (signal (car err) (cdr err))))
+
+ ;; Remote newname.
+ (when (and (file-directory-p newname)
+ (tramp-compat-directory-name-p newname))
+ (setq newname
+ (expand-file-name (file-name-nondirectory filename) newname)))
+
+ (with-parsed-tramp-file-name newname nil
+ (when (and (not ok-if-already-exists)
+ (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+
+ ;; We must also flush the cache of the directory, because
+ ;; `file-attributes' reads the values from there.
+ (tramp-flush-file-properties v (file-name-directory localname))
+ (tramp-flush-file-properties v localname)
+ (unless (tramp-smb-get-share v)
+ (tramp-error
+ v 'file-error "Target `%s' must contain a share name" newname))
+ (unless (tramp-smb-send-command
+ v (format "put \"%s\" \"%s\""
+ (tramp-compat-file-name-unquote filename)
+ (tramp-smb-get-localname v)))
+ (tramp-error
+ v 'file-error "Cannot copy `%s' to `%s'" filename newname))))))
+
+ ;; KEEP-DATE handling.
+ (when keep-date
+ (set-file-times
+ newname
+ (tramp-compat-file-attribute-modification-time
+ (file-attributes filename))))))
+
+(defun tramp-smb-handle-delete-directory (directory &optional recursive _trash)
+ "Like `delete-directory' for Tramp files."
+ (setq directory (directory-file-name (expand-file-name directory)))
+ (when (file-exists-p directory)
+ (when recursive
+ (mapc
+ (lambda (file)
+ (if (file-directory-p file)
+ (delete-directory file recursive)
+ (delete-file file)))
+ ;; We do not want to delete "." and "..".
+ (directory-files directory 'full directory-files-no-dot-files-regexp)))
+
+ (with-parsed-tramp-file-name directory nil
+ ;; We must also flush the cache of the directory, because
+ ;; `file-attributes' reads the values from there.
+ (tramp-flush-file-properties v (file-name-directory localname))
+ (tramp-flush-directory-properties v localname)
+ (unless (tramp-smb-send-command
+ v (format
+ "%s \"%s\""
+ (if (tramp-smb-get-cifs-capabilities v) "posix_rmdir" "rmdir")
+ (tramp-smb-get-localname v)))
+ ;; Error.
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (goto-char (point-min))
+ (search-forward-regexp tramp-smb-errors nil t)
+ (tramp-error
+ v 'file-error "%s `%s'" (match-string 0) directory)))
+
+ ;; "rmdir" does not report an error. So we check ourselves.
+ (when (file-exists-p directory)
+ (tramp-error
+ v 'file-error "`%s' not removed." directory)))))
+
+(defun tramp-smb-handle-delete-file (filename &optional _trash)
+ "Like `delete-file' for Tramp files."
+ (setq filename (expand-file-name filename))
+ (when (file-exists-p filename)
+ (with-parsed-tramp-file-name filename nil
+ ;; We must also flush the cache of the directory, because
+ ;; `file-attributes' reads the values from there.
+ (tramp-flush-file-properties v (file-name-directory localname))
+ (tramp-flush-file-properties v localname)
+ (unless (tramp-smb-send-command
+ v (format
+ "%s \"%s\""
+ (if (tramp-smb-get-cifs-capabilities v) "posix_unlink" "rm")
+ (tramp-smb-get-localname v)))
+ ;; Error.
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (goto-char (point-min))
+ (search-forward-regexp tramp-smb-errors nil t)
+ (tramp-error
+ v 'file-error "%s `%s'" (match-string 0) filename))))))
+
+(defun tramp-smb-handle-directory-files
+ (directory &optional full match nosort)
+ "Like `directory-files' for Tramp files."
+ (let ((result (mapcar #'directory-file-name
+ (file-name-all-completions "" directory))))
+ ;; Discriminate with regexp.
+ (when match
+ (setq result
+ (delete nil
+ (mapcar (lambda (x) (when (string-match-p match x) x))
+ result))))
+ ;; Append directory.
+ (when full
+ (setq result
+ (mapcar
+ (lambda (x) (format "%s/%s" directory x))
+ result)))
+ ;; Sort them if necessary.
+ (unless nosort (setq result (sort result #'string-lessp)))
+ result))
+
+(defun tramp-smb-handle-expand-file-name (name &optional dir)
+ "Like `expand-file-name' for Tramp files."
+ ;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
+ (setq dir (or dir default-directory "/"))
+ ;; Handle empty NAME.
+ (when (zerop (length name)) (setq name "."))
+ ;; Unless NAME is absolute, concat DIR and NAME.
+ (unless (file-name-absolute-p name)
+ (setq name (concat (file-name-as-directory dir) name)))
+ ;; If NAME is not a Tramp file, run the real handler.
+ (if (not (tramp-tramp-file-p name))
+ (tramp-run-real-handler #'expand-file-name (list name nil))
+ ;; Dissect NAME.
+ (with-parsed-tramp-file-name name nil
+ ;; Tilde expansion if necessary. We use the user name as share,
+ ;; which is often the case in domains.
+ (when (string-match "\\`/?~\\([^/]*\\)" localname)
+ (setq localname
+ (replace-match
+ (if (zerop (length (match-string 1 localname)))
+ user
+ (match-string 1 localname))
+ nil nil localname)))
+ ;; Make the file name absolute.
+ (unless (tramp-run-real-handler #'file-name-absolute-p (list localname))
+ (setq localname (concat "/" localname)))
+ ;; No tilde characters in file name, do normal
+ ;; `expand-file-name' (this does "/./" and "/../").
+ (tramp-make-tramp-file-name
+ v (tramp-run-real-handler #'expand-file-name (list localname))))))
+
+(defun tramp-smb-action-get-acl (proc vec)
+ "Read ACL data from connection buffer."
+ (unless (process-live-p proc)
+ ;; Accept pending output.
+ (while (tramp-accept-process-output proc))
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ ;; There might be a hidden password prompt.
+ (widen)
+ (tramp-message vec 10 "\n%s" (buffer-string))
+ (goto-char (point-min))
+ (while (and (not (eobp)) (not (looking-at-p "^REVISION:")))
+ (forward-line)
+ (delete-region (point-min) (point)))
+ (while (and (not (eobp)) (looking-at-p "^.+:.+"))
+ (forward-line))
+ (delete-region (point) (point-max))
+ (throw 'tramp-action 'ok))))
+
+(defun tramp-smb-handle-file-acl (filename)
+ "Like `file-acl' for Tramp files."
+ (ignore-errors
+ (with-parsed-tramp-file-name filename nil
+ (with-tramp-file-property v localname "file-acl"
+ (when (executable-find tramp-smb-acl-program)
+ (let* ((share (tramp-smb-get-share v))
+ (localname (replace-regexp-in-string
+ "\\\\" "/" (tramp-smb-get-localname v)))
+ (args (list (concat "//" host "/" share) "-E")))
+
+ (if (not (zerop (length user)))
+ (setq args (append args (list "-U" user)))
+ (setq args (append args (list "-N"))))
+
+ (when domain (setq args (append args (list "-W" domain))))
+ (when port (setq args (append args (list "-p" port))))
+ (when tramp-smb-conf
+ (setq args (append args (list "-s" tramp-smb-conf))))
+ (setq
+ args
+ (append args (list (tramp-unquote-shell-quote-argument localname)
+ "2>/dev/null")))
+
+ (unwind-protect
+ (with-temp-buffer
+ ;; Set the transfer process properties.
+ (tramp-set-connection-property
+ v "process-name" (buffer-name (current-buffer)))
+ (tramp-set-connection-property
+ v "process-buffer" (current-buffer))
+
+ ;; Use an asynchronous process. By this, password can
+ ;; be handled.
+ (let ((p (apply
+ #'start-process
+ (tramp-get-connection-name v)
+ (tramp-get-connection-buffer v)
+ tramp-smb-acl-program args)))
+
+ (tramp-message
+ v 6 "%s" (mapconcat #'identity (process-command p) " "))
+ (process-put p 'vector v)
+ (process-put p 'adjust-window-size-function #'ignore)
+ (set-process-query-on-exit-flag p nil)
+ (tramp-process-actions p v nil tramp-smb-actions-get-acl)
+ (when (> (point-max) (point-min))
+ (substring-no-properties (buffer-string)))))
+
+ ;; Reset the transfer process properties.
+ (tramp-flush-connection-property v "process-name")
+ (tramp-flush-connection-property v "process-buffer"))))))))
+
+(defun tramp-smb-handle-file-attributes (filename &optional id-format)
+ "Like `file-attributes' for Tramp files."
+ (unless id-format (setq id-format 'integer))
+ (ignore-errors
+ (with-parsed-tramp-file-name filename nil
+ (with-tramp-file-property
+ v localname (format "file-attributes-%s" id-format)
+ (if (tramp-smb-get-stat-capability v)
+ (tramp-smb-do-file-attributes-with-stat v id-format)
+ ;; Reading just the filename entry via "dir localname" is not
+ ;; possible, because when filename is a directory, some
+ ;; smbclient versions return the content of the directory, and
+ ;; other versions don't. Therefore, the whole content of the
+ ;; upper directory is retrieved, and the entry of the filename
+ ;; is extracted from.
+ (let* ((entries (tramp-smb-get-file-entries
+ (file-name-directory filename)))
+ (entry (assoc (file-name-nondirectory filename) entries))
+ (uid (if (equal id-format 'string) "nobody" -1))
+ (gid (if (equal id-format 'string) "nogroup" -1))
+ (inode (tramp-get-inode v))
+ (device (tramp-get-device v)))
+
+ ;; Check result.
+ (when entry
+ (list (and (string-match-p "d" (nth 1 entry))
+ t) ;0 file type
+ -1 ;1 link count
+ uid ;2 uid
+ gid ;3 gid
+ tramp-time-dont-know ;4 atime
+ (nth 3 entry) ;5 mtime
+ tramp-time-dont-know ;6 ctime
+ (nth 2 entry) ;7 size
+ (nth 1 entry) ;8 mode
+ nil ;9 gid weird
+ inode ;10 inode number
+ device)))))))) ;11 file system number
+
+(defun tramp-smb-do-file-attributes-with-stat (vec &optional id-format)
+ "Implement `file-attributes' for Tramp files using stat command."
+ (tramp-message
+ vec 5 "file attributes with stat: %s" (tramp-file-name-localname vec))
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (let* (size id link uid gid atime mtime ctime mode inode)
+ (when (tramp-smb-send-command
+ vec (format "stat \"%s\"" (tramp-smb-get-localname vec)))
+
+ ;; Loop the listing.
+ (goto-char (point-min))
+ (unless (re-search-forward tramp-smb-errors nil t)
+ (while (not (eobp))
+ (cond
+ ((looking-at
+ "Size:\\s-+\\([0-9]+\\)\\s-+Blocks:\\s-+[0-9]+\\s-+\\(\\w+\\)")
+ (setq size (string-to-number (match-string 1))
+ id (if (string-equal "directory" (match-string 2)) t
+ (if (string-equal "symbolic" (match-string 2)) ""))))
+ ((looking-at
+ "Inode:\\s-+\\([0-9]+\\)\\s-+Links:\\s-+\\([0-9]+\\)")
+ (setq inode (string-to-number (match-string 1))
+ link (string-to-number (match-string 2))))
+ ((looking-at
+
"Access:\\s-+([0-9]+/\\(\\S-+\\))\\s-+Uid:\\s-+\\([0-9]+\\)\\s-+Gid:\\s-+\\([0-9]+\\)")
+ (setq mode (match-string 1)
+ uid (if (equal id-format 'string) (match-string 2)
+ (string-to-number (match-string 2)))
+ gid (if (equal id-format 'string) (match-string 3)
+ (string-to-number (match-string 3)))))
+ ((looking-at
+
"Access:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)")
+ (setq atime
+ (encode-time
+ (string-to-number (match-string 6)) ;; sec
+ (string-to-number (match-string 5)) ;; min
+ (string-to-number (match-string 4)) ;; hour
+ (string-to-number (match-string 3)) ;; day
+ (string-to-number (match-string 2)) ;; month
+ (string-to-number (match-string 1))))) ;; year
+ ((looking-at
+
"Modify:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)")
+ (setq mtime
+ (encode-time
+ (string-to-number (match-string 6)) ;; sec
+ (string-to-number (match-string 5)) ;; min
+ (string-to-number (match-string 4)) ;; hour
+ (string-to-number (match-string 3)) ;; day
+ (string-to-number (match-string 2)) ;; month
+ (string-to-number (match-string 1))))) ;; year
+ ((looking-at
+
"Change:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)")
+ (setq ctime
+ (encode-time
+ (string-to-number (match-string 6)) ;; sec
+ (string-to-number (match-string 5)) ;; min
+ (string-to-number (match-string 4)) ;; hour
+ (string-to-number (match-string 3)) ;; day
+ (string-to-number (match-string 2)) ;; month
+ (string-to-number (match-string 1)))))) ;; year
+ (forward-line))
+
+ ;; Resolve symlink.
+ (when (and (stringp id)
+ (tramp-smb-send-command
+ vec
+ (format "readlink \"%s\"" (tramp-smb-get-localname vec))))
+ (goto-char (point-min))
+ (and (looking-at ".+ -> \\(.+\\)")
+ (setq id (match-string 1))))
+
+ ;; Return the result.
+ (when (or id link uid gid atime mtime ctime size mode inode)
+ (list id link uid gid atime mtime ctime size mode nil inode
+ (tramp-get-device vec))))))))
+
+(defun tramp-smb-handle-file-local-copy (filename)
+ "Like `file-local-copy' for Tramp files."
+ (with-parsed-tramp-file-name (file-truename filename) nil
+ (unless (file-exists-p (file-truename filename))
+ (tramp-error
+ v tramp-file-missing
+ "Cannot make local copy of non-existing file `%s'" filename))
+ (let ((tmpfile (tramp-compat-make-temp-file filename)))
+ (with-tramp-progress-reporter
+ v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
+ (unless (tramp-smb-send-command
+ v (format "get \"%s\" \"%s\""
+ (tramp-smb-get-localname v) tmpfile))
+ ;; Oops, an error. We shall cleanup.
+ (delete-file tmpfile)
+ (tramp-error
+ v 'file-error "Cannot make local copy of file `%s'" filename)))
+ tmpfile)))
+
+;; This function should return "foo/" for directories and "bar" for
+;; files.
+(defun tramp-smb-handle-file-name-all-completions (filename directory)
+ "Like `file-name-all-completions' for Tramp files."
+ (all-completions
+ filename
+ (with-parsed-tramp-file-name (expand-file-name directory) nil
+ (with-tramp-file-property v localname "file-name-all-completions"
+ (delete-dups
+ (mapcar
+ (lambda (x)
+ (list
+ (if (string-match-p "d" (nth 1 x))
+ (file-name-as-directory (nth 0 x))
+ (nth 0 x))))
+ (tramp-smb-get-file-entries directory)))))))
+
+(defun tramp-smb-handle-file-system-info (filename)
+ "Like `file-system-info' for Tramp files."
+ (ignore-errors
+ (unless (file-directory-p filename)
+ (setq filename (file-name-directory filename)))
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (tramp-message v 5 "file system info: %s" localname)
+ (tramp-smb-send-command v (format "du %s/*" (tramp-smb-get-localname v)))
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (let (total avail blocksize)
+ (goto-char (point-min))
+ (forward-line)
+ (when (looking-at
+ (eval-when-compile
+ (concat "[[:space:]]*\\([[:digit:]]+\\)"
+ " blocks of size \\([[:digit:]]+\\)"
+ "\\. \\([[:digit:]]+\\) blocks available")))
+ (setq blocksize (string-to-number (match-string 2))
+ total (* blocksize (string-to-number (match-string 1)))
+ avail (* blocksize (string-to-number (match-string 3)))))
+ (forward-line)
+ (when (looking-at "Total number of bytes: \\([[:digit:]]+\\)")
+ ;; The used number of bytes is not part of the result. As
+ ;; side effect, we store it as file property.
+ (tramp-set-file-property
+ v localname "used-bytes" (string-to-number (match-string 1))))
+ ;; Result.
+ (when (and total avail)
+ (list total (- total avail) avail)))))))
+
+(defun tramp-smb-handle-file-writable-p (filename)
+ "Like `file-writable-p' for Tramp files."
+ (if (file-exists-p filename)
+ (string-match-p
+ "w"
+ (or (tramp-compat-file-attribute-modes (file-attributes filename)) ""))
+ (let ((dir (file-name-directory filename)))
+ (and (file-exists-p dir)
+ (file-writable-p dir)))))
+
+(defun tramp-smb-handle-insert-directory
+ (filename switches &optional wildcard full-directory-p)
+ "Like `insert-directory' for Tramp files."
+ (setq filename (expand-file-name filename))
+ (unless switches (setq switches ""))
+ ;; Mark trailing "/".
+ (when (and (zerop (length (file-name-nondirectory filename)))
+ (not full-directory-p))
+ (setq switches (concat switches "F")))
+ (if full-directory-p
+ ;; Called from `dired-add-entry'.
+ (setq filename (file-name-as-directory filename))
+ (setq filename (directory-file-name filename)))
+ ;; Check, whether directory is accessible.
+ (unless wildcard
+ (access-file filename "Reading directory"))
+ (with-parsed-tramp-file-name filename nil
+ (with-tramp-progress-reporter v 0 (format "Opening directory %s" filename)
+ (save-match-data
+ (let ((base (file-name-nondirectory filename))
+ ;; We should not destroy the cache entry.
+ (entries (copy-tree
+ (tramp-smb-get-file-entries
+ (file-name-directory filename))))
+ (avail (get-free-disk-space filename))
+ ;; `get-free-disk-space' calls `file-system-info', which
+ ;; sets file property "used-bytes" as side effect.
+ (used
+ (format
+ "%.0f"
+ (/ (tramp-get-file-property v localname "used-bytes" 0) 1024))))
+
+ (when wildcard
+ (string-match "\\." base)
+ (setq base (replace-match "\\\\." nil nil base))
+ (string-match "\\*" base)
+ (setq base (replace-match ".*" nil nil base))
+ (string-match "\\?" base)
+ (setq base (replace-match ".?" nil nil base)))
+
+ ;; Filter entries.
+ (setq entries
+ (delq
+ nil
+ (if (or wildcard (zerop (length base)))
+ ;; Check for matching entries.
+ (mapcar
+ (lambda (x)
+ (when (string-match-p
+ (format "^%s" base) (nth 0 x))
+ x))
+ entries)
+ ;; We just need the only and only entry FILENAME.
+ (list (assoc base entries)))))
+
+ ;; Sort entries.
+ (setq entries
+ (sort
+ entries
+ (lambda (x y)
+ (if (string-match-p "t" switches)
+ ;; Sort by date.
+ (time-less-p (nth 3 y) (nth 3 x))
+ ;; Sort by name.
+ (string-lessp (nth 0 x) (nth 0 y))))))
+
+ ;; Handle "-F" switch.
+ (when (string-match-p "F" switches)
+ (mapc
+ (lambda (x)
+ (unless (zerop (length (car x)))
+ (cond
+ ((char-equal ?d (string-to-char (nth 1 x)))
+ (setcar x (concat (car x) "/")))
+ ((char-equal ?x (string-to-char (nth 1 x)))
+ (setcar x (concat (car x) "*"))))))
+ entries))
+
+ ;; Insert size information.
+ (when full-directory-p
+ (insert
+ (if avail
+ (format "total used in directory %s available %s\n" used avail)
+ (format "total %s\n" used))))
+
+ ;; Print entries.
+ (mapc
+ (lambda (x)
+ (unless (zerop (length (nth 0 x)))
+ (let ((attr
+ (when (tramp-smb-get-stat-capability v)
+ (ignore-errors
+ (file-attributes
+ (expand-file-name
+ (nth 0 x) (file-name-directory filename))
+ 'string)))))
+ (when (string-match-p "l" switches)
+ (insert
+ (format
+ "%10s %3d %-8s %-8s %8s %s "
+ (or (tramp-compat-file-attribute-modes attr) (nth 1 x))
+ (or (tramp-compat-file-attribute-link-number attr) 1)
+ (or (tramp-compat-file-attribute-user-id attr) "nobody")
+ (or (tramp-compat-file-attribute-group-id attr) "nogroup")
+ (or (tramp-compat-file-attribute-size attr) (nth 2 x))
+ (format-time-string
+ (if (time-less-p
+ ;; Half a year.
+ (time-since (nth 3 x)) (days-to-time 183))
+ "%b %e %R"
+ "%b %e %Y")
+ (nth 3 x))))) ; date
+
+ ;; We mark the file name. The inserted name could be
+ ;; from somewhere else, so we use the relative file name
+ ;; of `default-directory'.
+ (let ((start (point)))
+ (insert
+ (format
+ "%s"
+ (file-relative-name
+ (expand-file-name
+ (nth 0 x) (file-name-directory filename))
+ (when full-directory-p (file-name-directory filename)))))
+ (put-text-property start (point) 'dired-filename t))
+
+ ;; Insert symlink.
+ (when (and (string-match-p "l" switches)
+ (stringp (tramp-compat-file-attribute-type attr)))
+ (insert " -> " (tramp-compat-file-attribute-type attr))))
+
+ (insert "\n")
+ (forward-line)
+ (beginning-of-line)))
+ entries))))))
+
+(defun tramp-smb-handle-make-directory (dir &optional parents)
+ "Like `make-directory' for Tramp files."
+ (setq dir (directory-file-name (expand-file-name dir)))
+ (unless (file-name-absolute-p dir)
+ (setq dir (expand-file-name dir default-directory)))
+ (with-parsed-tramp-file-name dir nil
+ (let* ((ldir (file-name-directory dir)))
+ ;; Make missing directory parts.
+ (when (and parents
+ (tramp-smb-get-share v)
+ (not (file-directory-p ldir)))
+ (make-directory ldir parents))
+ ;; Just do it.
+ (when (file-directory-p ldir)
+ (make-directory-internal dir))
+ (unless (file-directory-p dir)
+ (tramp-error v 'file-error "Couldn't make directory %s" dir)))))
+
+(defun tramp-smb-handle-make-directory-internal (directory)
+ "Like `make-directory-internal' for Tramp files."
+ (setq directory (directory-file-name (expand-file-name directory)))
+ (unless (file-name-absolute-p directory)
+ (setq directory (expand-file-name directory default-directory)))
+ (with-parsed-tramp-file-name directory nil
+ (let* ((file (tramp-smb-get-localname v)))
+ (when (file-directory-p (file-name-directory directory))
+ (tramp-smb-send-command
+ v
+ (if (tramp-smb-get-cifs-capabilities v)
+ (format "posix_mkdir \"%s\" %o" file (default-file-modes))
+ (format "mkdir \"%s\"" file)))
+ ;; We must also flush the cache of the directory, because
+ ;; `file-attributes' reads the values from there.
+ (tramp-flush-file-properties v (file-name-directory localname))
+ (tramp-flush-file-properties v localname))
+ (unless (file-directory-p directory)
+ (tramp-error v 'file-error "Couldn't make directory %s" directory)))))
+
+(defun tramp-smb-handle-make-symbolic-link
+ (target linkname &optional ok-if-already-exists)
+ "Like `make-symbolic-link' for Tramp files.
+If TARGET is a non-Tramp file, it is used verbatim as the target
+of the symlink. If TARGET is a Tramp file, only the localname
+component is used as the target of the symlink."
+ (if (not (tramp-tramp-file-p (expand-file-name linkname)))
+ (tramp-run-real-handler
+ #'make-symbolic-link (list target linkname ok-if-already-exists))
+
+ (with-parsed-tramp-file-name linkname nil
+ ;; If TARGET is a Tramp name, use just the localname component.
+ (when (and (tramp-tramp-file-p target)
+ (tramp-file-name-equal-p v (tramp-dissect-file-name target)))
+ (setq target
+ (tramp-file-name-localname
+ (tramp-dissect-file-name (expand-file-name target)))))
+
+ ;; If TARGET is still remote, quote it.
+ (if (tramp-tramp-file-p target)
+ (make-symbolic-link
+ (let (file-name-handler-alist) (tramp-compat-file-name-quote target))
+ linkname ok-if-already-exists)
+
+ ;; Do the 'confirm if exists' thing.
+ (when (file-exists-p linkname)
+ ;; What to do?
+ (if (or (null ok-if-already-exists) ; not allowed to exist
+ (and (numberp ok-if-already-exists)
+ (not (yes-or-no-p
+ (format
+ "File %s already exists; make it a link anyway? "
+ localname)))))
+ (tramp-error v 'file-already-exists localname)
+ (delete-file linkname)))
+
+ (unless (tramp-smb-get-cifs-capabilities v)
+ (tramp-error v 'file-error "make-symbolic-link not supported"))
+
+ ;; We must also flush the cache of the directory, because
+ ;; `file-attributes' reads the values from there.
+ (tramp-flush-file-properties v (file-name-directory localname))
+ (tramp-flush-file-properties v localname)
+
+ (unless
+ (tramp-smb-send-command
+ v (format "symlink \"%s\" \"%s\""
+ (tramp-compat-file-name-unquote target)
+ (tramp-smb-get-localname v)))
+ (tramp-error
+ v 'file-error
+ "error with make-symbolic-link, see buffer `%s' for details"
+ (tramp-get-connection-buffer v)))))))
+
+(defun tramp-smb-handle-process-file
+ (program &optional infile destination display &rest args)
+ "Like `process-file' for Tramp files."
+ ;; The implementation is not complete yet.
+ (when (and (numberp destination) (zerop destination))
+ (error "Implementation does not handle immediate return"))
+
+ (with-parsed-tramp-file-name default-directory nil
+ (let* ((name (file-name-nondirectory program))
+ (name1 name)
+ (i 0)
+ input tmpinput outbuf command ret)
+
+ ;; Determine input.
+ (when infile
+ (setq infile (expand-file-name infile))
+ (if (tramp-equal-remote default-directory infile)
+ ;; INFILE is on the same remote host.
+ (setq input (with-parsed-tramp-file-name infile nil localname))
+ ;; INFILE must be copied to remote host.
+ (setq input (tramp-make-tramp-temp-file v)
+ tmpinput (tramp-make-tramp-file-name v input))
+ (copy-file infile tmpinput t))
+ ;; Transform input into a filename powershell does understand.
+ (setq input (format "//%s%s" host input)))
+
+ ;; Determine output.
+ (cond
+ ;; Just a buffer.
+ ((bufferp destination)
+ (setq outbuf destination))
+ ;; A buffer name.
+ ((stringp destination)
+ (setq outbuf (get-buffer-create destination)))
+ ;; (REAL-DESTINATION ERROR-DESTINATION)
+ ((consp destination)
+ ;; output.
+ (cond
+ ((bufferp (car destination))
+ (setq outbuf (car destination)))
+ ((stringp (car destination))
+ (setq outbuf (get-buffer-create (car destination))))
+ ((car destination)
+ (setq outbuf (current-buffer))))
+ ;; stderr.
+ (tramp-message v 2 "%s" "STDERR not supported"))
+ ;; 't
+ (destination
+ (setq outbuf (current-buffer))))
+
+ ;; Construct command.
+ (setq command (mapconcat #'identity (cons program args) " ")
+ command (if input
+ (format
+ "get-content %s | & %s"
+ (tramp-smb-shell-quote-argument input) command)
+ (format "& %s" command)))
+
+ (while (get-process name1)
+ ;; NAME must be unique as process name.
+ (setq i (1+ i)
+ name1 (format "%s<%d>" name i)))
+
+ ;; Set the new process properties.
+ (tramp-set-connection-property v "process-name" name1)
+ (tramp-set-connection-property
+ v "process-buffer"
+ (or outbuf (generate-new-buffer tramp-temp-buffer-name)))
+
+ ;; Call it.
+ (condition-case nil
+ (with-current-buffer (tramp-get-connection-buffer v)
+ ;; Preserve buffer contents.
+ (narrow-to-region (point-max) (point-max))
+ (tramp-smb-call-winexe v)
+ (when (tramp-smb-get-share v)
+ (tramp-smb-send-command
+ v (format "cd \"//%s%s\"" host (file-name-directory localname))))
+ (tramp-smb-send-command v command)
+ ;; Preserve command output.
+ (narrow-to-region (point-max) (point-max))
+ (let ((p (tramp-get-connection-process v)))
+ (tramp-smb-send-command v "exit $lasterrorcode")
+ (while (process-live-p p)
+ (sleep-for 0.1)
+ (setq ret (process-exit-status p))))
+ (delete-region (point-min) (point-max))
+ (widen))
+
+ ;; When the user did interrupt, we should do it also. We use
+ ;; return code -1 as marker.
+ (quit
+ (setq ret -1))
+ ;; Handle errors.
+ (error
+ (setq ret 1)))
+
+ ;; We should redisplay the output.
+ (when (and display outbuf (get-buffer-window outbuf t)) (redisplay))
+
+ ;; Cleanup. We remove all file cache values for the connection,
+ ;; because the remote process could have changed them.
+ (tramp-flush-connection-property v "process-name")
+ (tramp-flush-connection-property v "process-buffer")
+ (when tmpinput (delete-file tmpinput))
+ (unless outbuf
+ (kill-buffer (tramp-get-connection-property v "process-buffer" nil)))
+
+ (unless process-file-side-effects
+ (tramp-flush-directory-properties v ""))
+
+ ;; Return exit status.
+ (if (equal ret -1)
+ (keyboard-quit)
+ ret))))
+
+(defun tramp-smb-handle-rename-file
+ (filename newname &optional ok-if-already-exists)
+ "Like `rename-file' for Tramp files."
+ (setq filename (expand-file-name filename)
+ newname (expand-file-name newname))
+
+ (when (and (not ok-if-already-exists)
+ (file-exists-p newname))
+ (tramp-error
+ (tramp-dissect-file-name
+ (if (tramp-tramp-file-p filename) filename newname))
+ 'file-already-exists newname))
+
+ (with-tramp-progress-reporter
+ (tramp-dissect-file-name
+ (if (tramp-tramp-file-p filename) filename newname))
+ 0 (format "Renaming %s to %s" filename newname)
+
+ (if (and (not (file-exists-p newname))
+ (tramp-equal-remote filename newname)
+ (string-equal
+ (tramp-smb-get-share (tramp-dissect-file-name filename))
+ (tramp-smb-get-share (tramp-dissect-file-name newname))))
+ ;; We can rename directly.
+ (with-parsed-tramp-file-name filename v1
+ (with-parsed-tramp-file-name newname v2
+
+ ;; We must also flush the cache of the directory, because
+ ;; `file-attributes' reads the values from there.
+ (tramp-flush-file-properties v1 (file-name-directory v1-localname))
+ (tramp-flush-file-properties v1 v1-localname)
+ (tramp-flush-file-properties v2 (file-name-directory v2-localname))
+ (tramp-flush-file-properties v2 v2-localname)
+ (unless (tramp-smb-get-share v2)
+ (tramp-error
+ v2 'file-error "Target `%s' must contain a share name" newname))
+ (unless (tramp-smb-send-command
+ v2 (format "rename \"%s\" \"%s\""
+ (tramp-smb-get-localname v1)
+ (tramp-smb-get-localname v2)))
+ (tramp-error v2 'file-error "Cannot rename `%s'" filename))))
+
+ ;; We must rename via copy.
+ (copy-file
+ filename newname ok-if-already-exists 'keep-time 'preserve-uid-gid)
+ (if (file-directory-p filename)
+ (delete-directory filename 'recursive)
+ (delete-file filename)))))
+
+(defun tramp-smb-action-set-acl (proc vec)
+ "Set ACL data."
+ (unless (process-live-p proc)
+ ;; Accept pending output.
+ (while (tramp-accept-process-output proc))
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (tramp-message vec 10 "\n%s" (buffer-string))
+ (throw 'tramp-action 'ok))))
+
+(defun tramp-smb-handle-set-file-acl (filename acl-string)
+ "Like `set-file-acl' for Tramp files."
+ (ignore-errors
+ (with-parsed-tramp-file-name filename nil
+ (tramp-flush-file-property v localname "file-acl")
+
+ (when (and (stringp acl-string) (executable-find tramp-smb-acl-program))
+ (let* ((share (tramp-smb-get-share v))
+ (localname (replace-regexp-in-string
+ "\\\\" "/" (tramp-smb-get-localname v)))
+ (args (list (concat "//" host "/" share) "-E" "-S"
+ (replace-regexp-in-string
+ "\n" "," acl-string))))
+
+ (if (not (zerop (length user)))
+ (setq args (append args (list "-U" user)))
+ (setq args (append args (list "-N"))))
+
+ (when domain (setq args (append args (list "-W" domain))))
+ (when port (setq args (append args (list "-p" port))))
+ (when tramp-smb-conf
+ (setq args (append args (list "-s" tramp-smb-conf))))
+ (setq
+ args
+ (append args (list (tramp-unquote-shell-quote-argument localname)
+ "&&" "echo" "tramp_exit_status" "0"
+ "||" "echo" "tramp_exit_status" "1")))
+
+ (unwind-protect
+ (with-temp-buffer
+ ;; Set the transfer process properties.
+ (tramp-set-connection-property
+ v "process-name" (buffer-name (current-buffer)))
+ (tramp-set-connection-property
+ v "process-buffer" (current-buffer))
+
+ ;; Use an asynchronous process. By this, password can
+ ;; be handled.
+ (let ((p (apply
+ #'start-process
+ (tramp-get-connection-name v)
+ (tramp-get-connection-buffer v)
+ tramp-smb-acl-program args)))
+
+ (tramp-message
+ v 6 "%s" (mapconcat #'identity (process-command p) " "))
+ (process-put p 'vector v)
+ (process-put p 'adjust-window-size-function #'ignore)
+ (set-process-query-on-exit-flag p nil)
+ (tramp-process-actions p v nil tramp-smb-actions-set-acl)
+ (goto-char (point-max))
+ ;; This is meant for traces, and returning from the
+ ;; function. No error is propagated outside, due to
+ ;; the `ignore-errors' closure.
+ (unless (re-search-backward "tramp_exit_status [0-9]+" nil t)
+ (tramp-error
+ v 'file-error
+ "Couldn't find exit status of `%s'" tramp-smb-acl-program))
+ (skip-chars-forward "^ ")
+ (when (zerop (read (current-buffer)))
+ ;; Success.
+ (tramp-set-file-property v localname "file-acl" acl-string)
+ t)))
+
+ ;; Reset the transfer process properties.
+ (tramp-flush-connection-property v "process-name")
+ (tramp-flush-connection-property v "process-buffer")))))))
+
+(defun tramp-smb-handle-set-file-modes (filename mode)
+ "Like `set-file-modes' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (when (tramp-smb-get-cifs-capabilities v)
+ (tramp-flush-file-properties v localname)
+ (unless (tramp-smb-send-command
+ v (format "chmod \"%s\" %o" (tramp-smb-get-localname v) mode))
+ (tramp-error
+ v 'file-error "Error while changing file's mode %s" filename)))))
+
+;; We use BUFFER also as connection buffer during setup. Because of
+;; this, its original contents must be saved, and restored once
+;; connection has been setup.
+(defun tramp-smb-handle-start-file-process (name buffer program &rest args)
+ "Like `start-file-process' for Tramp files."
+ (with-parsed-tramp-file-name default-directory nil
+ (let* ((buffer
+ (if buffer
+ (get-buffer-create buffer)
+ ;; BUFFER can be nil. We use a temporary buffer.
+ (generate-new-buffer tramp-temp-buffer-name)))
+ (command (mapconcat #'identity (cons program args) " "))
+ (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
+ (name1 name)
+ (i 0))
+ (unwind-protect
+ (save-excursion
+ (save-restriction
+ (while (get-process name1)
+ ;; NAME must be unique as process name.
+ (setq i (1+ i)
+ name1 (format "%s<%d>" name i)))
+ ;; Set the new process properties.
+ (tramp-set-connection-property v "process-name" name1)
+ (tramp-set-connection-property v "process-buffer" buffer)
+ ;; Activate narrowing in order to save BUFFER contents.
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (let ((buffer-undo-list t))
+ (narrow-to-region (point-max) (point-max))
+ (tramp-smb-call-winexe v)
+ (when (tramp-smb-get-share v)
+ (tramp-smb-send-command
+ v (format
+ "cd \"//%s%s\""
+ host (file-name-directory localname))))
+ (tramp-message v 6 "(%s); exit" command)
+ (tramp-send-string v command)))
+ ;; Return value.
+ (tramp-get-connection-process v)))
+
+ ;; Save exit.
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (if (string-match-p tramp-temp-buffer-name (buffer-name))
+ (progn
+ (set-process-buffer (tramp-get-connection-process v) nil)
+ (kill-buffer (current-buffer)))
+ (set-buffer-modified-p bmp)))
+ (tramp-flush-connection-property v "process-name")
+ (tramp-flush-connection-property v "process-buffer")))))
+
+(defun tramp-smb-handle-substitute-in-file-name (filename)
+ "Like `handle-substitute-in-file-name' for Tramp files.
+\"//\" substitutes only in the local filename part. Catches
+errors for shares like \"C$/\", which are common in Microsoft Windows."
+ ;; Check, whether the local part is a quoted file name.
+ (if (tramp-compat-file-name-quoted-p filename)
+ filename
+ (with-parsed-tramp-file-name filename nil
+ ;; Ignore in LOCALNAME everything before "//".
+ (when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)"
localname))
+ (setq filename
+ (concat (file-remote-p filename)
+ (replace-match "\\1" nil nil localname)))))
+ (condition-case nil
+ (tramp-run-real-handler #'substitute-in-file-name (list filename))
+ (error filename))))
+
+(defun tramp-smb-handle-write-region
+ (start end filename &optional append visit lockname mustbenew)
+ "Like `write-region' for Tramp files."
+ (setq filename (expand-file-name filename))
+ (with-parsed-tramp-file-name filename nil
+ (when (and mustbenew (file-exists-p filename)
+ (or (eq mustbenew 'excl)
+ (not
+ (y-or-n-p
+ (format "File %s exists; overwrite anyway? " filename)))))
+ (tramp-error v 'file-already-exists filename))
+
+ ;; We must also flush the cache of the directory, because
+ ;; `file-attributes' reads the values from there.
+ (tramp-flush-file-properties v (file-name-directory localname))
+ (tramp-flush-file-properties v localname)
+ (let ((curbuf (current-buffer))
+ (tmpfile (tramp-compat-make-temp-file filename)))
+ (when (and append (file-exists-p filename))
+ (copy-file filename tmpfile 'ok))
+ ;; We say `no-message' here because we don't want the visited file
+ ;; modtime data to be clobbered from the temp file. We call
+ ;; `set-visited-file-modtime' ourselves later on.
+ (tramp-run-real-handler
+ #'write-region (list start end tmpfile append 'no-message lockname))
+
+ (with-tramp-progress-reporter
+ v 3 (format "Moving tmp file %s to %s" tmpfile filename)
+ (unwind-protect
+ (unless (tramp-smb-send-command
+ v (format "put %s \"%s\""
+ tmpfile (tramp-smb-get-localname v)))
+ (tramp-error v 'file-error "Cannot write `%s'" filename))
+ (delete-file tmpfile)))
+
+ (unless (equal curbuf (current-buffer))
+ (tramp-error
+ v 'file-error
+ "Buffer has changed from `%s' to `%s'" curbuf (current-buffer)))
+
+ ;; Set file modification time.
+ (when (or (eq visit t) (stringp visit))
+ (set-visited-file-modtime
+ (tramp-compat-file-attribute-modification-time
+ (file-attributes filename))))
+
+ ;; The end.
+ (when (and (null noninteractive)
+ (or (eq visit t) (null visit) (stringp visit)))
+ (tramp-message v 0 "Wrote %s" filename))
+ (run-hooks 'tramp-handle-write-region-hook))))
+
+;; Internal file name functions.
+
+(defun tramp-smb-get-share (vec)
+ "Returns the share name of LOCALNAME."
+ (save-match-data
+ (let ((localname (tramp-file-name-unquote-localname vec)))
+ (when (string-match "^/?\\([^/]+\\)/" localname)
+ (match-string 1 localname)))))
+
+(defun tramp-smb-get-localname (vec)
+ "Returns the file name of LOCALNAME.
+If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"."
+ (save-match-data
+ (let ((localname (tramp-file-name-unquote-localname vec)))
+ (setq
+ localname
+ (if (string-match "^/?[^/]+\\(/.*\\)" localname)
+ ;; There is a share, separated by "/".
+ (if (not (tramp-smb-get-cifs-capabilities vec))
+ (mapconcat
+ (lambda (x) (if (equal x ?/) "\\" (char-to-string x)))
+ (match-string 1 localname) "")
+ (match-string 1 localname))
+ ;; There is just a share.
+ (if (string-match "^/?\\([^/]+\\)$" localname)
+ (match-string 1 localname)
+ "")))
+
+ ;; Sometimes we have discarded `substitute-in-file-name'.
+ (when (string-match "\\(\\$\\$\\)\\(/\\|$\\)" localname)
+ (setq localname (replace-match "$" nil nil localname 1)))
+
+ ;; A period followed by a space, or trailing periods and spaces,
+ ;; are not supported.
+ (when (string-match-p "\\. \\|\\.$\\| $" localname)
+ (tramp-error
+ vec 'file-error
+ "Invalid file name %s" (tramp-make-tramp-file-name vec localname)))
+
+ localname)))
+
+;; Share names of a host are cached. It is very unlikely that the
+;; shares do change during connection.
+(defun tramp-smb-get-file-entries (directory)
+ "Read entries which match DIRECTORY.
+Either the shares are listed, or the `dir' command is executed.
+Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)."
+ ;; If CIFS capabilities are enabled, symlinks are not listed
+ ;; by `dir'. This is a consequence of
+ ;; <https://www.samba.org/samba/news/symlink_attack.html>. See also
+ ;; <https://bugzilla.samba.org/show_bug.cgi?id=5116>.
+ (with-parsed-tramp-file-name (file-name-as-directory directory) nil
+ (setq localname (or localname "/"))
+ (with-tramp-file-property v localname "file-entries"
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (let* ((share (tramp-smb-get-share v))
+ (cache (tramp-get-connection-property v "share-cache" nil))
+ res entry)
+
+ (if (and (not share) cache)
+ ;; Return cached shares.
+ (setq res cache)
+
+ ;; Read entries.
+ (if share
+ (tramp-smb-send-command
+ v (format "dir \"%s*\"" (tramp-smb-get-localname v)))
+ ;; `tramp-smb-maybe-open-connection' lists also the share names.
+ (tramp-smb-maybe-open-connection v))
+
+ ;; Loop the listing.
+ (goto-char (point-min))
+ (if (re-search-forward tramp-smb-errors nil t)
+ (tramp-error v 'file-error "%s `%s'" (match-string 0) directory)
+ (while (not (eobp))
+ (setq entry (tramp-smb-read-file-entry share))
+ (forward-line)
+ (when entry (push entry res))))
+
+ ;; Cache share entries.
+ (unless share
+ (tramp-set-connection-property v "share-cache" res)))
+
+ ;; Add directory itself.
+ (push '("" "drwxrwxrwx" 0 (0 0)) res)
+
+ ;; Return entries.
+ (delq nil res))))))
+
+;; Return either a share name (if SHARE is nil), or a file name.
+;;
+;; If shares are listed, the following format is expected:
+;;
+;; Disk| - leading spaces
+;; [^|]+| - share name, 14 char
+;; .* - comment
+;;
+;; Entries provided by smbclient DIR aren't fully regular.
+;; They should have the format
+;;
+;; \s-\{2,2} - leading spaces
+;; \S-\(.*\S-\)\s-* - file name, 30 chars, left bound
+;; \s-+[ADHRSV]* - permissions, 7 chars, right bound
+;; \s- - space delimiter
+;; \s-+[0-9]+ - size, 8 chars, right bound
+;; \s-\{2,2\} - space delimiter
+;; \w\{3,3\} - weekday
+;; \s- - space delimiter
+;; \w\{3,3\} - month
+;; \s- - space delimiter
+;; [ 12][0-9] - day
+;; \s- - space delimiter
+;; [0-9]\{2,2\}:[0-9]\{2,2\}:[0-9]\{2,2\} - time
+;; \s- - space delimiter
+;; [0-9]\{4,4\} - year
+;;
+;; samba/src/client.c (http://samba.org/doxygen/samba/client_8c-source.html)
+;; has function display_finfo:
+;;
+;; d_printf(" %-30s%7.7s %8.0f %s",
+;; finfo->name,
+;; attrib_string(finfo->mode),
+;; (double)finfo->size,
+;; asctime(LocalTime(&t)));
+;;
+;; in Samba 1.9, there's the following code:
+;;
+;; DEBUG(0,(" %-30s%7.7s%10d %s",
+;; CNV_LANG(finfo->name),
+;; attrib_string(finfo->mode),
+;; finfo->size,
+;; asctime(LocalTime(&t))));
+;;
+;; Problems:
+;; * Modern regexp constructs, like spy groups and counted repetitions, aren't
+;; available in older Emacsen.
+;; * The length of constructs (file name, size) might exceed the default.
+;; * File names might contain spaces.
+;; * Permissions might be empty.
+;;
+;; So we try to analyze backwards.
+(defun tramp-smb-read-file-entry (share)
+ "Parse entry in SMB output buffer.
+If SHARE is result, entries are of type dir. Otherwise, shares are listed.
+Result is the list (LOCALNAME MODE SIZE MTIME)."
+;; We are called from `tramp-smb-get-file-entries', which sets the
+;; current buffer.
+ (let ((line (buffer-substring (point) (point-at-eol)))
+ localname mode size month day hour min sec year mtime)
+
+ (if (not share)
+
+ ;; Read share entries.
+ (when (string-match "^Disk|\\([^|]+\\)|" line)
+ (setq localname (match-string 1 line)
+ mode "dr-xr-xr-x"
+ size 0))
+
+ ;; Real listing.
+ (cl-block nil
+
+ ;; year.
+ (if (string-match "\\([0-9]+\\)$" line)
+ (setq year (string-to-number (match-string 1 line))
+ line (substring line 0 -5))
+ (cl-return))
+
+ ;; time.
+ (if (string-match "\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)$" line)
+ (setq hour (string-to-number (match-string 1 line))
+ min (string-to-number (match-string 2 line))
+ sec (string-to-number (match-string 3 line))
+ line (substring line 0 -9))
+ (cl-return))
+
+ ;; day.
+ (if (string-match "\\([0-9]+\\)$" line)
+ (setq day (string-to-number (match-string 1 line))
+ line (substring line 0 -3))
+ (cl-return))
+
+ ;; month.
+ (if (string-match "\\(\\w+\\)$" line)
+ (setq month (match-string 1 line)
+ line (substring line 0 -4))
+ (cl-return))
+
+ ;; weekday.
+ (if (string-match-p "\\(\\w+\\)$" line)
+ (setq line (substring line 0 -5))
+ (cl-return))
+
+ ;; size.
+ (if (string-match "\\([0-9]+\\)$" line)
+ (let ((length (- (max 10 (1+ (length (match-string 1 line)))))))
+ (setq size (string-to-number (match-string 1 line)))
+ (when (string-match
+ "\\([ACDEHNORrsSTV]+\\)" (substring line length))
+ (setq length (+ length (match-end 0))))
+ (setq line (substring line 0 length)))
+ (cl-return))
+
+ ;; mode: ARCHIVE, COMPRESSED, DIRECTORY, ENCRYPTED, HIDDEN,
+ ;; NONINDEXED, NORMAL, OFFLINE, READONLY,
+ ;; REPARSE_POINT, SPARSE, SYSTEM, TEMPORARY, VOLID.
+
+ (if (string-match "\\([ACDEHNORrsSTV]+\\)?$" line)
+ (setq
+ mode (or (match-string 1 line) "")
+ mode (format
+ "%s%s"
+ (if (string-match-p "D" mode) "d" "-")
+ (mapconcat
+ (lambda (_x) "") " "
+ (concat "r" (if (string-match-p "R" mode) "-" "w") "x")))
+ line (substring line 0 -6))
+ (cl-return))
+
+ ;; localname.
+ (if (string-match "^\\s-+\\(\\S-\\(.*\\S-\\)?\\)\\s-*$" line)
+ (setq localname (match-string 1 line))
+ (cl-return))))
+
+ (when (and localname mode size)
+ (setq mtime
+ (if (and sec min hour day month year)
+ (encode-time
+ sec min hour day
+ (cdr (assoc (downcase month) parse-time-months))
+ year)
+ tramp-time-dont-know))
+ (list localname mode size mtime))))
+
+(defun tramp-smb-get-cifs-capabilities (vec)
+ "Check, whether the SMB server supports POSIX commands."
+ ;; When we are not logged in yet, we return nil.
+ (if (process-live-p (tramp-get-connection-process vec))
+ (with-tramp-connection-property
+ (tramp-get-connection-process vec) "cifs-capabilities"
+ (save-match-data
+ (when (tramp-smb-send-command vec "posix")
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (goto-char (point-min))
+ (when
+ (re-search-forward "Server supports CIFS capabilities" nil t)
+ (member
+ "pathnames"
+ (split-string
+ (buffer-substring (point) (point-at-eol)) nil 'omit)))))))))
+
+(defun tramp-smb-get-stat-capability (vec)
+ "Check, whether the SMB server supports the STAT command."
+ ;; When we are not logged in yet, we return nil.
+ (if (and (tramp-smb-get-share vec)
+ (process-live-p (tramp-get-connection-process vec)))
+ (with-tramp-connection-property
+ (tramp-get-connection-process vec) "stat-capability"
+ (tramp-smb-send-command vec "stat \"/\""))))
+
+
+;; Connection functions.
+
+(defun tramp-smb-send-command (vec command)
+ "Send the COMMAND to connection VEC.
+Returns nil if there has been an error message from smbclient."
+ (tramp-smb-maybe-open-connection vec)
+ (tramp-message vec 6 "%s" command)
+ (tramp-send-string vec command)
+ (tramp-smb-wait-for-output vec))
+
+(defun tramp-smb-maybe-open-connection (vec &optional argument)
+ "Maybe open a connection to HOST, log in as USER, using `tramp-smb-program'.
+Does not do anything if a connection is already open, but re-opens the
+connection if a previous connection has died for some reason.
+If ARGUMENT is non-nil, use it as argument for
+`tramp-smb-winexe-program', and suppress any checks."
+ (let* ((share (tramp-smb-get-share vec))
+ (buf (tramp-get-connection-buffer vec))
+ (p (get-buffer-process buf)))
+
+ ;; Check whether we still have the same smbclient version.
+ ;; Otherwise, we must delete the connection cache, because
+ ;; capabilities migh have changed.
+ (unless (or argument (processp p))
+ (let ((default-directory (tramp-compat-temporary-file-directory))
+ (command (concat tramp-smb-program " -V")))
+
+ (unless tramp-smb-version
+ (unless (executable-find tramp-smb-program)
+ (tramp-error
+ vec 'file-error
+ "Cannot find command %s in %s" tramp-smb-program exec-path))
+ (setq tramp-smb-version (shell-command-to-string command))
+ (tramp-message vec 6 command)
+ (tramp-message vec 6 "\n%s" tramp-smb-version)
+ (if (string-match "[ \t\n\r]+\\'" tramp-smb-version)
+ (setq tramp-smb-version
+ (replace-match "" nil nil tramp-smb-version))))
+
+ (unless (string-equal
+ tramp-smb-version
+ (tramp-get-connection-property
+ vec "smbclient-version" tramp-smb-version))
+ (tramp-flush-directory-properties vec "")
+ (tramp-flush-connection-properties vec))
+
+ (tramp-set-connection-property
+ vec "smbclient-version" tramp-smb-version)))
+
+ ;; If too much time has passed since last command was sent, look
+ ;; whether there has been an error message; maybe due to
+ ;; connection timeout.
+ (with-current-buffer buf
+ (goto-char (point-min))
+ ;; `seconds-to-time' can be removed once we get rid of Emacs 24.
+ (when (and (time-less-p (seconds-to-time 60)
+ (time-since
+ (tramp-get-connection-property
+ p "last-cmd-time" (seconds-to-time 0))))
+ (process-live-p p)
+ (re-search-forward tramp-smb-errors nil t))
+ (delete-process p)
+ (setq p nil)))
+
+ ;; Check whether it is still the same share.
+ (unless (and (process-live-p p)
+ (or argument
+ (string-equal
+ share
+ (tramp-get-connection-property p "smb-share" ""))))
+
+ ;; During completion, don't reopen a new connection. We
+ ;; check this for the process related to
+ ;; `tramp-buffer-name'; otherwise `start-file-process'
+ ;; wouldn't run ever when `non-essential' is non-nil.
+ (when (and (tramp-completion-mode-p)
+ (null (get-process (tramp-buffer-name vec))))
+ (throw 'non-essential 'non-essential))
+
+ (save-match-data
+ ;; There might be unread output from checking for share names.
+ (when buf (with-current-buffer buf (erase-buffer)))
+ (when (and p (processp p)) (delete-process p))
+
+ (let* ((user (tramp-file-name-user vec))
+ (host (tramp-file-name-host vec))
+ (domain (tramp-file-name-domain vec))
+ (port (tramp-file-name-port vec))
+ args)
+
+ (cond
+ (argument
+ (setq args (list (concat "//" host))))
+ (share
+ (setq args (list (concat "//" host "/" share))))
+ (t
+ (setq args (list "-g" "-L" host ))))
+
+ (if (not (zerop (length user)))
+ (setq args (append args (list "-U" user)))
+ (setq args (append args (list "-N"))))
+
+ (when domain (setq args (append args (list "-W" domain))))
+ (when port (setq args (append args (list "-p" port))))
+ (when tramp-smb-conf
+ (setq args (append args (list "-s" tramp-smb-conf))))
+ (when argument
+ (setq args (append args (list argument))))
+
+ ;; OK, let's go.
+ (with-tramp-progress-reporter
+ vec 3
+ (format "Opening connection for //%s%s/%s"
+ (if (not (zerop (length user))) (concat user "@") "")
+ host (or share ""))
+
+ (let* ((coding-system-for-read nil)
+ (process-connection-type tramp-process-connection-type)
+ (p (let ((default-directory
+ (tramp-compat-temporary-file-directory)))
+ (apply #'start-process
+ (tramp-get-connection-name vec)
+ (tramp-get-connection-buffer vec)
+ (if argument
+ tramp-smb-winexe-program tramp-smb-program)
+ args))))
+
+ (tramp-message
+ vec 6 "%s" (mapconcat #'identity (process-command p) " "))
+ (process-put p 'vector vec)
+ (process-put p 'adjust-window-size-function #'ignore)
+ (set-process-query-on-exit-flag p nil)
+
+ (condition-case err
+ (let (tramp-message-show-message)
+ ;; Play login scenario.
+ (tramp-process-actions
+ p vec nil
+ (if (or argument share)
+ tramp-smb-actions-with-share
+ tramp-smb-actions-without-share))
+
+ ;; Check server version.
+ ;; FIXME: With recent smbclient versions, this
+ ;; information isn't printed anymore.
+ ;; (unless argument
+ ;; (with-current-buffer (tramp-get-connection-buffer vec)
+ ;; (goto-char (point-min))
+ ;; (search-forward-regexp tramp-smb-server-version nil t)
+ ;; (let ((smbserver-version (match-string 0)))
+ ;; (unless
+ ;; (string-equal
+ ;; smbserver-version
+ ;; (tramp-get-connection-property
+ ;; vec "smbserver-version" smbserver-version))
+ ;; (tramp-flush-directory-properties vec "")
+ ;; (tramp-flush-connection-properties vec))
+ ;; (tramp-set-connection-property
+ ;; vec "smbserver-version" smbserver-version))))
+
+ ;; Set chunksize to 1. smbclient reads its input
+ ;; character by character; if we send the string
+ ;; at once, it is read painfully slow.
+ (tramp-set-connection-property p "smb-share" share)
+ (tramp-set-connection-property p "chunksize" 1)
+
+ ;; Set connection-local variables.
+ (tramp-set-connection-local-variables vec)
+
+ ;; Mark it as connected.
+ (tramp-set-connection-property p "connected" t))
+
+ ;; Check for the error reason. If it was due to wrong
+ ;; password, reestablish the connection. We cannot
+ ;; handle this in `tramp-process-actions', because
+ ;; smbclient does not ask for the password, again.
+ (error
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (goto-char (point-min))
+ (if (and (bound-and-true-p auth-sources)
+ (search-forward-regexp
+ tramp-smb-wrong-passwd-regexp nil t))
+ ;; Disable `auth-source' and `password-cache'.
+ (let (auth-sources)
+ (tramp-message
+ vec 3 "Retry connection with new password")
+ (tramp-cleanup-connection vec t)
+ (tramp-smb-maybe-open-connection vec argument))
+ ;; Propagate the error.
+ (signal (car err) (cdr err)))))))))))))
+
+;; We don't use timeouts. If needed, the caller shall wrap around.
+(defun tramp-smb-wait-for-output (vec)
+ "Wait for output from smbclient command.
+Removes smb prompt. Returns nil if an error message has appeared."
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (let ((p (get-buffer-process (current-buffer)))
+ (inhibit-read-only t))
+
+ ;; Read pending output.
+ (while (not (re-search-forward tramp-smb-prompt nil t))
+ (while (tramp-accept-process-output p 0)
+ (goto-char (point-min))))
+ (tramp-message vec 6 "\n%s" (buffer-string))
+
+ ;; Remove prompt.
+ (goto-char (point-min))
+ (when (re-search-forward tramp-smb-prompt nil t)
+ (goto-char (point-max))
+ (re-search-backward tramp-smb-prompt nil t)
+ (delete-region (point) (point-max)))
+
+ ;; Return value is whether no error message has appeared.
+ (goto-char (point-min))
+ (not (re-search-forward tramp-smb-errors nil t)))))
+
+(defun tramp-smb-kill-winexe-function ()
+ "Send SIGKILL to the winexe process."
+ (ignore-errors
+ (let ((p (get-buffer-process (current-buffer))))
+ (when (process-live-p p)
+ (signal-process (process-id p) 'SIGINT)))))
+
+(defun tramp-smb-call-winexe (vec)
+ "Apply a remote command, if possible, using `tramp-smb-winexe-program'."
+ ;; Check for program.
+ (unless (executable-find tramp-smb-winexe-program)
+ (tramp-error
+ vec 'file-error "Cannot find program: %s" tramp-smb-winexe-program))
+
+ ;; winexe does not supports ports.
+ (when (tramp-file-name-port vec)
+ (tramp-error vec 'file-error "Port not supported for remote processes"))
+
+ (tramp-smb-maybe-open-connection
+ vec
+ (format
+ "%s %s"
+ tramp-smb-winexe-shell-command tramp-smb-winexe-shell-command-switch))
+
+ (set (make-local-variable 'kill-buffer-hook)
+ '(tramp-smb-kill-winexe-function))
+
+ ;; Suppress "^M". Shouldn't we specify utf8?
+ (set-process-coding-system (tramp-get-connection-process vec) 'raw-text-dos)
+
+ ;; Set width to 128. This avoids mixing prompt and long error messages.
+ (tramp-smb-send-command vec "$rawui = (Get-Host).UI.RawUI")
+ (tramp-smb-send-command vec "$bufsize = $rawui.BufferSize")
+ (tramp-smb-send-command vec "$winsize = $rawui.WindowSize")
+ (tramp-smb-send-command vec "$bufsize.Width = 128")
+ (tramp-smb-send-command vec "$winsize.Width = 128")
+ (tramp-smb-send-command vec "$rawui.BufferSize = $bufsize")
+ (tramp-smb-send-command vec "$rawui.WindowSize = $winsize"))
+
+(defun tramp-smb-shell-quote-argument (s)
+ "Similar to `shell-quote-argument', but uses windows cmd syntax."
+ (let ((system-type 'ms-dos))
+ (tramp-unquote-shell-quote-argument s)))
+
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (unload-feature 'tramp-smb 'force)))
+
+(provide 'tramp-smb)
+
+;;; TODO:
+
+;; * Return more comprehensive file permission string.
+;;
+;; * Try to remove the inclusion of dummy "" directory. Seems to be at
+;; several places, especially in `tramp-smb-handle-insert-directory'.
+;;
+;; * Ignore case in file names.
+
+;;; tramp-smb.el ends here
diff --git a/tramp-sudoedit.el b/tramp-sudoedit.el
deleted file mode 120000
index c37f128..0000000
--- a/tramp-sudoedit.el
+++ /dev/null
@@ -1 +0,0 @@
-lisp/tramp-sudoedit.el
\ No newline at end of file
diff --git a/tramp-sudoedit.el b/tramp-sudoedit.el
new file mode 100644
index 0000000..0d9e04d
--- /dev/null
+++ b/tramp-sudoedit.el
@@ -0,0 +1,893 @@
+;;; tramp-sudoedit.el --- Functions for accessing under root permissions -*-
lexical-binding:t -*-
+
+;; Copyright (C) 2018-2019 Free Software Foundation, Inc.
+
+;; Author: Michael Albinus <address@hidden>
+;; 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:
+
+;; The "sudoedit" Tramp method allows to edit a file as a different
+;; user on the local host. Contrary to the "sudo" method, all magic
+;; file name functions are implemented by single "sudo ..." commands.
+;; The purpose is to make editing such a file as secure as possible;
+;; there must be no session running in the Emacs background which
+;; could be attacked from inside Emacs.
+
+;; Consequently, external processes are not implemented.
+
+;;; Code:
+
+(require 'tramp)
+
+;;;###tramp-autoload
+(defconst tramp-sudoedit-method "sudoedit"
+ "When this method name is used, call sudoedit for editing a file.")
+
+;;;###tramp-autoload
+(tramp--with-startup
+ (add-to-list 'tramp-methods
+ `(,tramp-sudoedit-method
+ (tramp-sudo-login (("sudo") ("-u" "%u") ("-S") ("-H")
+ ("-p" "Password:") ("--")))))
+
+ (add-to-list 'tramp-default-user-alist '("\\`sudoedit\\'" nil "root"))
+
+ (tramp-set-completion-function
+ tramp-sudoedit-method tramp-completion-function-alist-su))
+
+(defconst tramp-sudoedit-sudo-actions
+ '((tramp-password-prompt-regexp tramp-action-password)
+ (tramp-wrong-passwd-regexp tramp-action-permission-denied)
+ (tramp-process-alive-regexp tramp-sudoedit-action-sudo))
+ "List of pattern/action pairs.
+This list is used for sudo calls.
+
+See `tramp-actions-before-shell' for more info.")
+
+;;;###tramp-autoload
+(defconst tramp-sudoedit-file-name-handler-alist
+ '((access-file . tramp-handle-access-file)
+ (add-name-to-file . tramp-sudoedit-handle-add-name-to-file)
+ (byte-compiler-base-file-name . ignore)
+ ;; `copy-directory' performed by default handler.
+ (copy-file . tramp-sudoedit-handle-copy-file)
+ (delete-directory . tramp-sudoedit-handle-delete-directory)
+ (delete-file . tramp-sudoedit-handle-delete-file)
+ (diff-latest-backup-file . ignore)
+ ;; `directory-file-name' performed by default handler.
+ (directory-files . tramp-handle-directory-files)
+ (directory-files-and-attributes
+ . tramp-handle-directory-files-and-attributes)
+ (dired-compress-file . ignore)
+ (dired-uncache . tramp-handle-dired-uncache)
+ (exec-path . ignore)
+ (expand-file-name . tramp-sudoedit-handle-expand-file-name)
+ (file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
+ (file-acl . tramp-sudoedit-handle-file-acl)
+ (file-attributes . tramp-sudoedit-handle-file-attributes)
+ (file-directory-p . tramp-handle-file-directory-p)
+ (file-equal-p . tramp-handle-file-equal-p)
+ (file-executable-p . tramp-sudoedit-handle-file-executable-p)
+ (file-exists-p . tramp-sudoedit-handle-file-exists-p)
+ (file-in-directory-p . tramp-handle-file-in-directory-p)
+ (file-local-copy . tramp-handle-file-local-copy)
+ (file-modes . tramp-handle-file-modes)
+ (file-name-all-completions
+ . tramp-sudoedit-handle-file-name-all-completions)
+ (file-name-as-directory . tramp-handle-file-name-as-directory)
+ (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p)
+ (file-name-completion . tramp-handle-file-name-completion)
+ (file-name-directory . tramp-handle-file-name-directory)
+ (file-name-nondirectory . tramp-handle-file-name-nondirectory)
+ ;; `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-sudoedit-handle-file-readable-p)
+ (file-regular-p . tramp-handle-file-regular-p)
+ (file-remote-p . tramp-handle-file-remote-p)
+ (file-selinux-context . tramp-sudoedit-handle-file-selinux-context)
+ (file-symlink-p . tramp-handle-file-symlink-p)
+ (file-system-info . tramp-sudoedit-handle-file-system-info)
+ (file-truename . tramp-sudoedit-handle-file-truename)
+ (file-writable-p . tramp-sudoedit-handle-file-writable-p)
+ (find-backup-file-name . tramp-handle-find-backup-file-name)
+ ;; `get-file-buffer' performed by default handler.
+ (insert-directory . tramp-handle-insert-directory)
+ (insert-file-contents . tramp-handle-insert-file-contents)
+ (load . tramp-handle-load)
+ (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
+ (make-directory . tramp-sudoedit-handle-make-directory)
+ (make-directory-internal . ignore)
+ (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
+ (make-process . ignore)
+ (make-symbolic-link . tramp-sudoedit-handle-make-symbolic-link)
+ (process-file . ignore)
+ (rename-file . tramp-sudoedit-handle-rename-file)
+ (set-file-acl . tramp-sudoedit-handle-set-file-acl)
+ (set-file-modes . tramp-sudoedit-handle-set-file-modes)
+ (set-file-selinux-context . tramp-sudoedit-handle-set-file-selinux-context)
+ (set-file-times . tramp-sudoedit-handle-set-file-times)
+ (set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
+ (shell-command . ignore)
+ (start-file-process . ignore)
+ (substitute-in-file-name . tramp-handle-substitute-in-file-name)
+ (temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-set-file-uid-gid . tramp-sudoedit-handle-set-file-uid-gid)
+ (unhandled-file-name-directory . ignore)
+ (vc-registered . ignore)
+ (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
+ (write-region . tramp-sudoedit-handle-write-region))
+ "Alist of handler functions for Tramp SUDOEDIT method.")
+
+;; It must be a `defsubst' in order to push the whole code into
+;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
+;;;###tramp-autoload
+(defsubst tramp-sudoedit-file-name-p (filename)
+ "Check if it's a filename for SUDOEDIT."
+ (and (tramp-tramp-file-p filename)
+ (string= (tramp-file-name-method (tramp-dissect-file-name filename))
+ tramp-sudoedit-method)))
+
+;;;###tramp-autoload
+(defun tramp-sudoedit-file-name-handler (operation &rest args)
+ "Invoke the SUDOEDIT handler for OPERATION.
+First arg specifies the OPERATION, second arg is a list of arguments to
+pass to the OPERATION."
+ (let ((fn (assoc operation tramp-sudoedit-file-name-handler-alist)))
+ (if fn
+ (save-match-data (apply (cdr fn) args))
+ (tramp-run-real-handler operation args))))
+
+;;;###tramp-autoload
+(tramp--with-startup
+ (tramp-register-foreign-file-name-handler
+ #'tramp-sudoedit-file-name-p #'tramp-sudoedit-file-name-handler))
+
+
+;; File name primitives.
+
+(defun tramp-sudoedit-handle-add-name-to-file
+ (filename newname &optional ok-if-already-exists)
+ "Like `add-name-to-file' for Tramp files."
+ (unless (tramp-equal-remote filename newname)
+ (with-parsed-tramp-file-name
+ (if (tramp-tramp-file-p filename) filename newname) nil
+ (tramp-error
+ v 'file-error
+ "add-name-to-file: %s"
+ "only implemented for same method, same user, same host")))
+ (with-parsed-tramp-file-name filename v1
+ (with-parsed-tramp-file-name newname v2
+ ;; Do the 'confirm if exists' thing.
+ (when (file-exists-p newname)
+ ;; What to do?
+ (if (or (null ok-if-already-exists) ; not allowed to exist
+ (and (numberp ok-if-already-exists)
+ (not (yes-or-no-p
+ (format
+ "File %s already exists; make it a link anyway? "
+ v2-localname)))))
+ (tramp-error v2 'file-already-exists newname)
+ (delete-file newname)))
+ (tramp-flush-file-properties v2 (file-name-directory v2-localname))
+ (tramp-flush-file-properties v2 v2-localname)
+ (unless
+ (tramp-sudoedit-send-command
+ v1 "ln"
+ (tramp-compat-file-name-unquote v1-localname)
+ (tramp-compat-file-name-unquote v2-localname))
+ (tramp-error
+ v1 'file-error
+ "error with add-name-to-file, see buffer `%s' for details"
+ (buffer-name))))))
+
+(defun tramp-sudoedit-do-copy-or-rename-file
+ (op filename newname &optional ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes)
+ "Copy or rename a remote file.
+OP must be `copy' or `rename' and indicates the operation to perform.
+FILENAME specifies the file to copy or rename, NEWNAME is the name of
+the new file (for copy) or the new name of the file (for rename).
+OK-IF-ALREADY-EXISTS means don't barf if NEWNAME exists already.
+KEEP-DATE means to make sure that NEWNAME has the same timestamp
+as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep
+the uid and gid if both files are on the same host.
+PRESERVE-EXTENDED-ATTRIBUTES activates selinux and acl commands.
+
+This function is invoked by `tramp-sudoedit-handle-copy-file' and
+`tramp-sudoedit-handle-rename-file'. It is an error if OP is
+neither of `copy' and `rename'. FILENAME and NEWNAME must be
+absolute file names."
+ (unless (memq op '(copy rename))
+ (error "Unknown operation `%s', must be `copy' or `rename'" op))
+
+ (setq filename (file-truename filename))
+ (if (file-directory-p filename)
+ (progn
+ (copy-directory filename newname keep-date t)
+ (when (eq op 'rename) (delete-directory filename 'recursive)))
+
+ (let ((t1 (tramp-sudoedit-file-name-p filename))
+ (t2 (tramp-sudoedit-file-name-p newname))
+ (file-times (tramp-compat-file-attribute-modification-time
+ (file-attributes filename)))
+ (file-modes (tramp-default-file-modes filename))
+ ;; `file-extended-attributes' exists since Emacs 24.4.
+ (attributes (and preserve-extended-attributes
+ (apply #'file-extended-attributes (list filename))))
+ (sudoedit-operation
+ (cond
+ ((and (eq op 'copy) preserve-uid-gid) '("cp" "-f" "-p"))
+ ((eq op 'copy) '("cp" "-f"))
+ ((eq op 'rename) '("mv" "-f"))))
+ (msg-operation (if (eq op 'copy) "Copying" "Renaming")))
+
+ (with-parsed-tramp-file-name (if t1 filename newname) nil
+ (when (and (not ok-if-already-exists) (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+
+ (if (or (and (file-remote-p filename) (not t1))
+ (and (file-remote-p newname) (not t2)))
+ ;; We cannot copy or rename directly.
+ (let ((tmpfile (tramp-compat-make-temp-file filename)))
+ (if (eq op 'copy)
+ (copy-file filename tmpfile t)
+ (rename-file filename tmpfile t))
+ (rename-file tmpfile newname ok-if-already-exists))
+
+ ;; Direct action.
+ (with-tramp-progress-reporter
+ v 0 (format "%s %s to %s" msg-operation filename newname)
+ (unless (tramp-sudoedit-send-command
+ v sudoedit-operation
+ (tramp-compat-file-name-unquote
+ (tramp-compat-file-local-name filename))
+ (tramp-compat-file-name-unquote
+ (tramp-compat-file-local-name newname)))
+ (tramp-error
+ v 'file-error
+ "Error %s `%s' `%s'" msg-operation filename newname))))
+
+ ;; When `newname' is local, we must change the ownership to
+ ;; the local user.
+ (unless (file-remote-p newname)
+ (tramp-set-file-uid-gid
+ (concat (file-remote-p filename) newname)
+ (tramp-get-local-uid 'integer)
+ (tramp-get-local-gid 'integer)))
+
+ ;; Set the time and mode. Mask possible errors.
+ (when keep-date
+ (ignore-errors
+ (set-file-times newname file-times)
+ (set-file-modes newname file-modes)))
+
+ ;; Handle `preserve-extended-attributes'. We ignore possible
+ ;; errors, because ACL strings could be incompatible.
+ ;; `set-file-extended-attributes' exists since Emacs 24.4.
+ (when attributes
+ (ignore-errors
+ (apply #'set-file-extended-attributes (list newname attributes))))
+
+ (when (and t1 (eq op 'rename))
+ (with-parsed-tramp-file-name filename v1
+ (tramp-flush-file-properties
+ v1 (file-name-directory v1-localname))
+ (tramp-flush-file-properties v1 v1-localname)))
+
+ (when t2
+ (with-parsed-tramp-file-name newname v2
+ (tramp-flush-file-properties
+ v2 (file-name-directory v2-localname))
+ (tramp-flush-file-properties v2 v2-localname)))))))
+
+(defun tramp-sudoedit-handle-copy-file
+ (filename newname &optional ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes)
+ "Like `copy-file' for Tramp files."
+ (setq filename (expand-file-name filename))
+ (setq newname (expand-file-name newname))
+ ;; At least one file a Tramp file?
+ (if (or (tramp-tramp-file-p filename)
+ (tramp-tramp-file-p newname))
+ (tramp-sudoedit-do-copy-or-rename-file
+ 'copy filename newname ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes)
+ (tramp-run-real-handler
+ #'copy-file
+ (list filename newname ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes))))
+
+(defun tramp-sudoedit-handle-delete-directory
+ (directory &optional recursive trash)
+ "Like `delete-directory' for Tramp files."
+ (setq directory (expand-file-name directory))
+ (with-parsed-tramp-file-name directory nil
+ (tramp-flush-file-properties v (file-name-directory localname))
+ (tramp-flush-directory-properties v localname)
+ (unless
+ (tramp-sudoedit-send-command
+ v (or (and trash "trash")
+ (if recursive '("rm" "-rf") "rmdir"))
+ (tramp-compat-file-name-unquote localname))
+ (tramp-error v 'file-error "Couldn't delete %s" directory))))
+
+(defun tramp-sudoedit-handle-delete-file (filename &optional trash)
+ "Like `delete-file' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (tramp-flush-file-properties v (file-name-directory localname))
+ (tramp-flush-file-properties v localname)
+ (unless
+ (tramp-sudoedit-send-command
+ v (if (and trash delete-by-moving-to-trash) "trash" "rm")
+ (tramp-compat-file-name-unquote localname))
+ ;; Propagate the error.
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (goto-char (point-min))
+ (tramp-error-with-buffer
+ nil v 'file-error "Couldn't delete %s" filename)))))
+
+(defun tramp-sudoedit-handle-expand-file-name (name &optional dir)
+ "Like `expand-file-name' for Tramp files.
+If the localname part of the given file name starts with \"/../\" then
+the result will be a local, non-Tramp, file name."
+ ;; If DIR is not given, use `default-directory' or "/".
+ (setq dir (or dir default-directory "/"))
+ ;; Handle empty NAME.
+ (when (zerop (length name)) (setq name "."))
+ ;; Unless NAME is absolute, concat DIR and NAME.
+ (unless (file-name-absolute-p name)
+ (setq name (concat (file-name-as-directory dir) name)))
+ (with-parsed-tramp-file-name name nil
+ ;; Tilde expansion if necessary. We cannot accept "~/", because
+ ;; under sudo "~/" is expanded to the local user home directory
+ ;; but to the root home directory.
+ (when (zerop (length localname))
+ (setq localname "~"))
+ (unless (file-name-absolute-p localname)
+ (setq localname (format "~%s/%s" user localname)))
+ (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
+ (let ((uname (match-string 1 localname))
+ (fname (match-string 2 localname)))
+ (when (string-equal uname "~")
+ (setq uname (concat uname user)))
+ (setq localname (concat uname fname))))
+ ;; Do normal `expand-file-name' (this does "~user/", "/./" and "/../").
+ (tramp-make-tramp-file-name v (expand-file-name localname))))
+
+(defun tramp-sudoedit-remote-acl-p (vec)
+ "Check, whether ACL is enabled on the remote host."
+ (with-tramp-connection-property (tramp-get-connection-process vec) "acl-p"
+ (zerop (tramp-call-process vec "getfacl" nil nil nil "/"))))
+
+(defun tramp-sudoedit-handle-file-acl (filename)
+ "Like `file-acl' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (with-tramp-file-property v localname "file-acl"
+ (let ((result (and (tramp-sudoedit-remote-acl-p v)
+ (tramp-sudoedit-send-command-string
+ v "getfacl" "-acp"
+ (tramp-compat-file-name-unquote localname)))))
+ ;; The acl string must have a trailing \n, which is not
+ ;; provided by `tramp-sudoedit-send-command-string'. Add it.
+ (and (stringp result) (concat result "\n"))))))
+
+(defun tramp-sudoedit-handle-file-attributes (filename &optional id-format)
+ "Like `file-attributes' for Tramp files."
+ (unless id-format (setq id-format 'integer))
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (with-tramp-file-property
+ v localname (format "file-attributes-%s" id-format)
+ (tramp-message v 5 "file attributes: %s" localname)
+ (ignore-errors
+ (tramp-convert-file-attributes
+ v
+ (tramp-sudoedit-send-command-and-read
+ v "env" "QUOTING_STYLE=locale" "stat" "-c"
+ (format
+ ;; Apostrophes in the stat output are masked as
+ ;; `tramp-stat-marker', in order to make a proper shell
+ ;; escape of them in file names.
+ "((%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)"
+ tramp-stat-marker tramp-stat-marker
+ (if (eq id-format 'integer)
+ "%u"
+ (eval-when-compile
+ (concat tramp-stat-marker "%U" tramp-stat-marker)))
+ (if (eq id-format 'integer)
+ "%g"
+ (eval-when-compile
+ (concat tramp-stat-marker "%G" tramp-stat-marker)))
+ tramp-stat-marker tramp-stat-marker)
+ (tramp-compat-file-name-unquote localname)))))))
+
+(defun tramp-sudoedit-handle-file-executable-p (filename)
+ "Like `file-executable-p' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (with-tramp-file-property v localname "file-executable-p"
+ (tramp-sudoedit-send-command
+ v "test" "-x" (tramp-compat-file-name-unquote localname)))))
+
+(defun tramp-sudoedit-handle-file-exists-p (filename)
+ "Like `file-exists-p' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (with-tramp-file-property v localname "file-exists-p"
+ (tramp-sudoedit-send-command
+ v "test" "-e" (tramp-compat-file-name-unquote localname)))))
+
+(defun tramp-sudoedit-handle-file-name-all-completions (filename directory)
+ "Like `file-name-all-completions' for Tramp files."
+ (all-completions
+ filename
+ (with-parsed-tramp-file-name (expand-file-name directory) nil
+ (with-tramp-file-property v localname "file-name-all-completions"
+ (tramp-sudoedit-send-command
+ v "ls" "-a1" "--quoting-style=literal" "--show-control-chars"
+ (if (zerop (length localname))
+ "" (tramp-compat-file-name-unquote localname)))
+ (mapcar
+ (lambda (f)
+ (if (file-directory-p (expand-file-name f directory))
+ (file-name-as-directory f)
+ f))
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (delq
+ nil
+ (mapcar
+ (lambda (l) (and (not (string-match-p "^[[:space:]]*$" l)) l))
+ (split-string (buffer-string) "\n" 'omit)))))))))
+
+(defun tramp-sudoedit-handle-file-readable-p (filename)
+ "Like `file-readable-p' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (with-tramp-file-property v localname "file-readable-p"
+ (tramp-sudoedit-send-command
+ v "test" "-r" (tramp-compat-file-name-unquote localname)))))
+
+(defun tramp-sudoedit-handle-set-file-modes (filename mode)
+ "Like `set-file-modes' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (tramp-flush-file-properties v (file-name-directory localname))
+ (tramp-flush-file-properties v localname)
+ (unless (tramp-sudoedit-send-command
+ v "chmod" (format "%o" mode)
+ (tramp-compat-file-name-unquote localname))
+ (tramp-error
+ v 'file-error "Error while changing file's mode %s" filename))))
+
+(defun tramp-sudoedit-remote-selinux-p (vec)
+ "Check, whether SELINUX is enabled on the remote host."
+ (with-tramp-connection-property (tramp-get-connection-process vec)
"selinux-p"
+ (zerop (tramp-call-process vec "selinuxenabled"))))
+
+(defun tramp-sudoedit-handle-file-selinux-context (filename)
+ "Like `file-selinux-context' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (with-tramp-file-property v localname "file-selinux-context"
+ (let ((context '(nil nil nil nil))
+ (regexp (eval-when-compile
+ (concat "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\):"
+ "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\)"))))
+ (when (and (tramp-sudoedit-remote-selinux-p v)
+ (tramp-sudoedit-send-command
+ v "ls" "-d" "-Z"
+ (tramp-compat-file-name-unquote localname)))
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (goto-char (point-min))
+ (when (re-search-forward regexp (point-at-eol) t)
+ (setq context (list (match-string 1) (match-string 2)
+ (match-string 3) (match-string 4))))))
+ ;; Return the context.
+ context))))
+
+(defun tramp-sudoedit-handle-file-system-info (filename)
+ "Like `file-system-info' for Tramp files."
+ (ignore-errors
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (tramp-message v 5 "file system info: %s" localname)
+ (when (tramp-sudoedit-send-command
+ v "df" "--block-size=1" "--output=size,used,avail"
+ (tramp-compat-file-name-unquote localname)))
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (goto-char (point-min))
+ (forward-line)
+ (when (looking-at
+ (eval-when-compile
+ (concat "[[:space:]]*\\([[:digit:]]+\\)"
+ "[[:space:]]+\\([[:digit:]]+\\)"
+ "[[:space:]]+\\([[:digit:]]+\\)")))
+ (list (string-to-number (match-string 1))
+ ;; The second value is the used size. We need the
+ ;; free size.
+ (- (string-to-number (match-string 1))
+ (string-to-number (match-string 2)))
+ (string-to-number (match-string 3))))))))
+
+(defun tramp-sudoedit-handle-set-file-times (filename &optional time)
+ "Like `set-file-times' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (tramp-flush-file-properties v (file-name-directory localname))
+ (tramp-flush-file-properties v localname)
+ (let ((time
+ (if (or (null time)
+ (tramp-compat-time-equal-p time tramp-time-doesnt-exist)
+ (tramp-compat-time-equal-p time tramp-time-dont-know))
+ (current-time)
+ time)))
+ (tramp-sudoedit-send-command
+ v "env" "TZ=UTC" "touch" "-t"
+ (format-time-string "%Y%m%d%H%M.%S" time t)
+ (tramp-compat-file-name-unquote localname)))))
+
+(defun tramp-sudoedit-handle-file-truename (filename)
+ "Like `file-truename' for Tramp files."
+ ;; Preserve trailing "/".
+ (funcall
+ (if (string-equal (file-name-nondirectory filename) "")
+ #'file-name-as-directory #'identity)
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (tramp-make-tramp-file-name
+ v
+ (with-tramp-file-property v localname "file-truename"
+ (let ((quoted (tramp-compat-file-name-quoted-p localname))
+ (localname (tramp-compat-file-name-unquote localname))
+ result)
+ (tramp-message v 4 "Finding true name for `%s'" filename)
+ (setq result (tramp-sudoedit-send-command-string
+ v "readlink" "--canonicalize-missing" localname))
+ ;; Detect cycle.
+ (when (and (file-symlink-p filename)
+ (string-equal result localname))
+ (tramp-error
+ v 'file-error
+ "Apparent cycle of symbolic links for %s" filename))
+ ;; If the resulting localname looks remote, we must quote it
+ ;; for security reasons.
+ (when (or quoted (file-remote-p result))
+ (let (file-name-handler-alist)
+ (setq result (tramp-compat-file-name-quote result))))
+ (tramp-message v 4 "True name of `%s' is `%s'" localname result)
+ result))
+ 'nohop))))
+
+(defun tramp-sudoedit-handle-file-writable-p (filename)
+ "Like `file-writable-p' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (with-tramp-file-property v localname "file-writable-p"
+ (if (file-exists-p filename)
+ (tramp-sudoedit-send-command
+ v "test" "-w" (tramp-compat-file-name-unquote localname))
+ (let ((dir (file-name-directory filename)))
+ (and (file-exists-p dir)
+ (file-writable-p dir)))))))
+
+(defun tramp-sudoedit-handle-make-directory (dir &optional parents)
+ "Like `make-directory' for Tramp files."
+ (setq dir (expand-file-name dir))
+ (with-parsed-tramp-file-name dir nil
+ ;; When PARENTS is non-nil, DIR could be a chain of non-existent
+ ;; directories a/b/c/... Instead of checking, we simply flush the
+ ;; whole cache.
+ (tramp-flush-directory-properties
+ v (if parents "/" (file-name-directory localname)))
+ (unless (tramp-sudoedit-send-command
+ v (if parents '("mkdir" "-p") "mkdir")
+ (tramp-compat-file-name-unquote localname))
+ (tramp-error v 'file-error "Couldn't make directory %s" dir))))
+
+(defun tramp-sudoedit-handle-make-symbolic-link
+ (target linkname &optional ok-if-already-exists)
+ "Like `make-symbolic-link' for Tramp files.
+If TARGET is a non-Tramp file, it is used verbatim as the target
+of the symlink. If TARGET is a Tramp file, only the localname
+component is used as the target of the symlink."
+ (if (not (tramp-tramp-file-p (expand-file-name linkname)))
+ (tramp-run-real-handler
+ #'make-symbolic-link (list target linkname ok-if-already-exists))
+
+ (with-parsed-tramp-file-name linkname nil
+ ;; If TARGET is a Tramp name, use just the localname component.
+ (when (and (tramp-tramp-file-p target)
+ (tramp-file-name-equal-p v (tramp-dissect-file-name target)))
+ (setq target
+ (tramp-file-name-localname
+ (tramp-dissect-file-name (expand-file-name target)))))
+
+ ;; If TARGET is still remote, quote it.
+ (if (tramp-tramp-file-p target)
+ (make-symbolic-link
+ (let (file-name-handler-alist) (tramp-compat-file-name-quote target))
+ linkname ok-if-already-exists)
+
+ ;; Do the 'confirm if exists' thing.
+ (when (file-exists-p linkname)
+ ;; What to do?
+ (if (or (null ok-if-already-exists) ; not allowed to exist
+ (and (numberp ok-if-already-exists)
+ (not
+ (yes-or-no-p
+ (format
+ "File %s already exists; make it a link anyway? "
+ localname)))))
+ (tramp-error v 'file-already-exists localname)
+ (delete-file linkname)))
+
+ (tramp-flush-file-properties v (file-name-directory localname))
+ (tramp-flush-file-properties v localname)
+ (tramp-sudoedit-send-command
+ v "ln" "-sf"
+ (tramp-compat-file-name-unquote target)
+ (tramp-compat-file-name-unquote localname))))))
+
+(defun tramp-sudoedit-handle-rename-file
+ (filename newname &optional ok-if-already-exists)
+ "Like `rename-file' for Tramp files."
+ (setq filename (expand-file-name filename))
+ (setq newname (expand-file-name newname))
+ ;; At least one file a Tramp file?
+ (if (or (tramp-tramp-file-p filename)
+ (tramp-tramp-file-p newname))
+ (tramp-sudoedit-do-copy-or-rename-file
+ 'rename filename newname ok-if-already-exists
+ 'keep-date 'preserve-uid-gid)
+ (tramp-run-real-handler
+ 'rename-file (list filename newname ok-if-already-exists))))
+
+(defun tramp-sudoedit-handle-set-file-acl (filename acl-string)
+ "Like `set-file-acl' for Tramp files."
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (when (and (stringp acl-string) (tramp-sudoedit-remote-acl-p v))
+ ;; Massage `acl-string'.
+ (setq acl-string
+ (mapconcat #'identity (split-string acl-string "\n" 'omit) ","))
+ (prog1
+ (tramp-sudoedit-send-command
+ v "setfacl" "-m"
+ acl-string (tramp-compat-file-name-unquote localname))
+ (tramp-flush-file-property v localname "file-acl")))))
+
+(defun tramp-sudoedit-handle-set-file-selinux-context (filename context)
+ "Like `set-file-selinux-context' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (when (and (consp context)
+ (tramp-sudoedit-remote-selinux-p v))
+ (let ((user (and (stringp (nth 0 context)) (nth 0 context)))
+ (role (and (stringp (nth 1 context)) (nth 1 context)))
+ (type (and (stringp (nth 2 context)) (nth 2 context)))
+ (range (and (stringp (nth 3 context)) (nth 3 context))))
+ (when (tramp-sudoedit-send-command
+ v "chcon"
+ (when user (format "--user=%s" user))
+ (when role (format "--role=%s" role))
+ (when type (format "--type=%s" type))
+ (when range (format "--range=%s" range))
+ (tramp-compat-file-name-unquote localname))
+ (if (and user role type range)
+ (tramp-set-file-property
+ v localname "file-selinux-context" context)
+ (tramp-flush-file-property v localname "file-selinux-context"))
+ t)))))
+
+(defun tramp-sudoedit-get-remote-uid (vec id-format)
+ "The uid of the remote connection VEC, in ID-FORMAT.
+ID-FORMAT valid values are `string' and `integer'."
+ (with-tramp-connection-property vec (format "uid-%s" id-format)
+ (if (equal id-format 'integer)
+ (tramp-sudoedit-send-command-and-read vec "id" "-u")
+ (tramp-sudoedit-send-command-string vec "id" "-un"))))
+
+(defun tramp-sudoedit-get-remote-gid (vec id-format)
+ "The gid of the remote connection VEC, in ID-FORMAT.
+ID-FORMAT valid values are `string' and `integer'."
+ (with-tramp-connection-property vec (format "gid-%s" id-format)
+ (if (equal id-format 'integer)
+ (tramp-sudoedit-send-command-and-read vec "id" "-g")
+ (tramp-sudoedit-send-command-string vec "id" "-gn"))))
+
+(defun tramp-sudoedit-handle-set-file-uid-gid (filename &optional uid gid)
+ "Like `tramp-set-file-uid-gid' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (tramp-sudoedit-send-command
+ v "chown"
+ (format "%d:%d"
+ (or uid (tramp-sudoedit-get-remote-uid v 'integer))
+ (or gid (tramp-sudoedit-get-remote-gid v 'integer)))
+ (tramp-compat-file-name-unquote
+ (tramp-compat-file-local-name filename)))))
+
+(defun tramp-sudoedit-handle-write-region
+ (start end filename &optional append visit lockname mustbenew)
+ "Like `write-region' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (let ((uid (or (tramp-compat-file-attribute-user-id
+ (file-attributes filename 'integer))
+ (tramp-sudoedit-get-remote-uid v 'integer)))
+ (gid (or (tramp-compat-file-attribute-group-id
+ (file-attributes filename 'integer))
+ (tramp-sudoedit-get-remote-gid v 'integer)))
+ (modes (tramp-default-file-modes filename)))
+ (prog1
+ (tramp-handle-write-region
+ start end filename append visit lockname mustbenew)
+
+ ;; Set the ownership and modes. This is not performed in
+ ;; `tramp-handle-write-region'.
+ (unless (and (= (tramp-compat-file-attribute-user-id
+ (file-attributes filename 'integer))
+ uid)
+ (= (tramp-compat-file-attribute-group-id
+ (file-attributes filename 'integer))
+ gid))
+ (tramp-set-file-uid-gid filename uid gid))
+ (set-file-modes filename modes)))))
+
+
+;; Internal functions.
+
+;; Used in `tramp-sudoedit-sudo-actions'.
+(defun tramp-sudoedit-action-sudo (proc vec)
+ "Check, whether a sudo process has finished.
+Remove unneeded output."
+ ;; There might be pending output for the exit status.
+ (unless (process-live-p proc)
+ (while (tramp-accept-process-output proc 0))
+ ;; Delete narrowed region, it would be in the way reading a Lisp form.
+ (goto-char (point-min))
+ (widen)
+ (delete-region (point-min) (point))
+ ;; Delete empty lines.
+ (goto-char (point-min))
+ (while (and (not (eobp)) (= (point) (point-at-eol)))
+ (forward-line))
+ (delete-region (point-min) (point))
+ (tramp-message vec 3 "Process has finished.")
+ (throw 'tramp-action 'ok)))
+
+(defun tramp-sudoedit-maybe-open-connection (vec)
+ "Maybe open a connection VEC.
+Does not do anything if a connection is already open, but re-opens the
+connection if a previous connection has died for some reason."
+ ;; We need a process bound to the connection buffer. Therefore, we
+ ;; create a dummy process. Maybe there is a better solution?
+ (unless (tramp-get-connection-process vec)
+
+ ;; During completion, don't reopen a new connection. We check
+ ;; this for the process related to `tramp-buffer-name'; otherwise
+ ;; `start-file-process' wouldn't run ever when `non-essential' is
+ ;; non-nil.
+ (when (and (tramp-completion-mode-p)
+ (null (get-process (tramp-buffer-name vec))))
+ (throw 'non-essential 'non-essential))
+
+ (let ((p (make-network-process
+ :name (tramp-buffer-name vec)
+ :buffer (tramp-get-connection-buffer vec)
+ :server t :host 'local :service t :noquery t)))
+ (process-put p 'vector vec)
+ (set-process-query-on-exit-flag p nil)
+
+ ;; Set connection-local variables.
+ (tramp-set-connection-local-variables vec)
+
+ ;; Mark it as connected.
+ (tramp-set-connection-property p "connected" t))
+
+ ;; In `tramp-check-cached-permissions', the connection properties
+ ;; "{uid,gid}-{integer,string}" are used. We set them to proper values.
+ (tramp-sudoedit-get-remote-uid vec 'integer)
+ (tramp-sudoedit-get-remote-gid vec 'integer)
+ (tramp-sudoedit-get-remote-uid vec 'string)
+ (tramp-sudoedit-get-remote-gid vec 'string)))
+
+(defun tramp-sudoedit-send-command (vec &rest args)
+ "Send commands ARGS to connection VEC.
+If an element of ARGS is a list, it will be flattened. If an
+element of ARGS is nil, it will be deleted.
+Erases temporary buffer before sending the command. Returns nil
+in case of error, t otherwise."
+ (tramp-sudoedit-maybe-open-connection vec)
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (erase-buffer)
+ (let* ((login (tramp-get-method-parameter vec 'tramp-sudo-login))
+ (host (or (tramp-file-name-host vec) ""))
+ (user (or (tramp-file-name-user vec) ""))
+ (spec (format-spec-make ?h host ?u user))
+ (args (append
+ (tramp-compat-flatten-tree
+ (mapcar
+ (lambda (x)
+ (setq x (mapcar (lambda (y) (format-spec y spec)) x))
+ (unless (member "" x) x))
+ login))
+ (tramp-compat-flatten-tree (delq nil args))))
+ (delete-exited-processes t)
+ (process-connection-type tramp-process-connection-type)
+ (p (apply #'start-process
+ (tramp-get-connection-name vec) (current-buffer) args))
+ ;; We suppress the messages `Waiting for prompts from remote shell'.
+ (tramp-verbose (if (= tramp-verbose 3) 2 tramp-verbose))
+ ;; We do not want to save the password.
+ auth-source-save-behavior)
+ (tramp-message vec 6 "%s" (mapconcat #'identity (process-command p) " "))
+ ;; Avoid process status message in output buffer.
+ (set-process-sentinel p #'ignore)
+ (process-put p 'vector vec)
+ (process-put p 'adjust-window-size-function #'ignore)
+ (set-process-query-on-exit-flag p nil)
+ (tramp-process-actions p vec nil tramp-sudoedit-sudo-actions)
+ (tramp-message vec 6 "%s\n%s" (process-exit-status p) (buffer-string))
+ (prog1
+ (zerop (process-exit-status p))
+ (delete-process p)))))
+
+(defun tramp-sudoedit-send-command-and-read (vec &rest args)
+ "Run command ARGS and return the output, which must be a Lisp expression.
+In case there is no valid Lisp expression, it raises an error."
+ (when (apply #'tramp-sudoedit-send-command vec args)
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ ;; Replace stat marker.
+ (goto-char (point-min))
+ (when (search-forward tramp-stat-marker nil t)
+ (goto-char (point-min))
+ (while (search-forward "\"" nil t)
+ (replace-match "\\\"" nil 'literal))
+ (goto-char (point-min))
+ (while (search-forward tramp-stat-marker nil t)
+ (replace-match "\"")))
+ ;; Read the expression.
+ (tramp-message vec 6 "\n%s" (buffer-string))
+ (goto-char (point-min))
+ (condition-case nil
+ (prog1 (read (current-buffer))
+ ;; Error handling.
+ (when (re-search-forward "\\S-" (point-at-eol) t)
+ (error nil)))
+ (error (tramp-error
+ vec 'file-error
+ "`%s' does not return a valid Lisp expression: `%s'"
+ (car args) (buffer-string)))))))
+
+(defun tramp-sudoedit-send-command-string (vec &rest args)
+ "Run command ARGS and return the output as astring."
+ (when (apply #'tramp-sudoedit-send-command vec args)
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (tramp-message vec 6 "\n%s" (buffer-string))
+ (goto-char (point-max))
+ ;(delete-blank-lines)
+ (while (looking-back "[ \t\n]+" nil 'greedy)
+ (delete-region (match-beginning 0) (point)))
+ (when (> (point-max) (point-min))
+ (substring-no-properties (buffer-string))))))
+
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (unload-feature 'tramp-sudoedit 'force)))
+
+(provide 'tramp-sudoedit)
+
+;;; TODO:
+
+;; * Fix *-selinux functions. Likely, this is due to wrong file
+;; ownership after `write-region' and/or `copy-file'.
+
+;;; tramp-sudoedit.el ends here
diff --git a/tramp-uu.el b/tramp-uu.el
deleted file mode 120000
index ede7188..0000000
--- a/tramp-uu.el
+++ /dev/null
@@ -1 +0,0 @@
-lisp/tramp-uu.el
\ No newline at end of file
diff --git a/tramp-uu.el b/tramp-uu.el
new file mode 100644
index 0000000..c12a4eb
--- /dev/null
+++ b/tramp-uu.el
@@ -0,0 +1,101 @@
+;;; tramp-uu.el --- uuencode in Lisp -*- lexical-binding:t -*-
+
+;; Copyright (C) 2002-2019 Free Software Foundation, Inc.
+
+;; Author: Kai Großjohann <address@hidden>
+;; Maintainer: Michael Albinus <address@hidden>
+;; Keywords: comm, terminals
+;; 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:
+
+;; An implementation of "uuencode" in Lisp. Uses the function
+;; base64-encode-region which is built-in to modern Emacsen.
+
+;;; Code:
+
+(defconst tramp-uu-b64-alphabet
+ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
+ "Mapping from base64-encoded character to the byte it represents.")
+
+(defconst tramp-uu-b64-char-to-byte
+ (let ((i 0))
+ (mapcar (lambda (c)
+ (prog1
+ (cons c i)
+ (setq i (1+ i))))
+ tramp-uu-b64-alphabet))
+ "Alist of mapping from base64 character to its byte.")
+
+(defun tramp-uu-byte-to-uu-char (byte)
+ "Return the character encoding BYTE."
+ (if (zerop byte) ?` (+ byte 32)))
+
+(defun tramp-uu-b64-char-to-byte (char)
+ "Return the byte that is encoded as CHAR."
+ (cdr (assq char tramp-uu-b64-char-to-byte)))
+
+;;;###tramp-autoload
+(defun tramp-uuencode-region (beg end)
+ "UU-encode the region between BEG and END."
+ ;; First we base64 encode the region, then we transmogrify that into
+ ;; uu encoding.
+ (let ((len (base64-encode-region beg end t))
+ i c)
+ (save-excursion
+ (goto-char beg)
+ (setq i 0)
+ (while (< i len)
+ (setq c (char-after (point)))
+ (delete-char 1)
+ (if (equal c ?=)
+ ;; "=" means padding. Insert "`" instead. Not counted for length.
+ (progn (insert "`") (setq len (1- len)))
+ (insert (tramp-uu-byte-to-uu-char (tramp-uu-b64-char-to-byte c)))
+ (setq i (1+ i)))
+ ;; Every 60 characters, add "M" at beginning of line (as
+ ;; length byte) and insert a newline.
+ (when (zerop (% i 60))
+ (save-excursion
+ (beginning-of-line)
+ (insert (char-to-string (+ 32 (/ (* 3 60) 4)))))
+ (insert "\n")))
+ ;; If there is something leftover, we compute the length byte
+ ;; for that stuff and insert it and a trailing newline.
+ (unless (zerop (% i 60))
+ (save-excursion
+ (beginning-of-line)
+ (insert (char-to-string (+ 32 (% (- end beg) 45)))))
+ (insert "\n"))
+ ;; Why is there always a "`" line at the end?
+ (insert "`\nend\n")
+ (goto-char beg)
+ (insert "begin 600 xxx\n"))))
+
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (unload-feature 'tramp-uu 'force)))
+
+(provide 'tramp-uu)
+
+;;; tramp-uu.el ends here
+
+;; Local Variables:
+;; mode: Emacs-Lisp
+;; coding: utf-8
+;; End:
diff --git a/tramp.el b/tramp.el
deleted file mode 120000
index 8e80b4f..0000000
--- a/tramp.el
+++ /dev/null
@@ -1 +0,0 @@
-lisp/tramp.el
\ No newline at end of file
diff --git a/tramp.el b/tramp.el
new file mode 100644
index 0000000..58f956f
--- /dev/null
+++ b/tramp.el
@@ -0,0 +1,4975 @@
+;;; tramp.el --- Transparent Remote Access, Multiple Protocol -*-
lexical-binding:t -*-
+
+;; Copyright (C) 1998-2019 Free Software Foundation, Inc.
+
+;; Author: Kai Großjohann <address@hidden>
+;; Michael Albinus <address@hidden>
+;; Maintainer: Michael Albinus <address@hidden>
+;; Keywords: comm, processes
+;; Package: tramp
+;; Version: 0
+;; Package-Requires: ((emacs "24.1"))
+;; URL: https://savannah.gnu.org/projects/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:
+
+;; This package provides remote file editing, similar to ange-ftp.
+;; The difference is that ange-ftp uses FTP to transfer files between
+;; the local and the remote host, whereas tramp.el uses a combination
+;; of rsh and rcp or other work-alike programs, such as ssh/scp.
+;;
+;; For more detailed instructions, please see the info file.
+;;
+;; Notes:
+;; -----
+;;
+;; Also see the todo list at the bottom of this file.
+;;
+;; The current version of Tramp can be retrieved from the following URL:
+;; https://ftp.gnu.org/gnu/tramp/
+;;
+;; There's a mailing list for this, as well. Its name is:
+;; address@hidden
+;; You can use the Web to subscribe, under the following URL:
+;; https://lists.gnu.org/mailman/listinfo/tramp-devel
+;;
+;; For the adventurous, the current development sources are available
+;; via Git. You can find instructions about this at the following URL:
+;; https://savannah.gnu.org/projects/tramp/
+;;
+;; Don't forget to put on your asbestos longjohns, first!
+
+;;; Code:
+
+(require 'tramp-compat)
+(require 'tramp-integration)
+(require 'trampver)
+
+;; Pacify byte-compiler.
+(require 'cl-lib)
+(declare-function netrc-parse "netrc")
+(defvar auto-save-file-name-transforms)
+(defvar ls-lisp-use-insert-directory-program)
+(defvar outline-regexp)
+
+;;; User Customizable Internal Variables:
+
+(defgroup tramp nil
+ "Edit remote files with a combination of ssh, scp, etc."
+ :group 'files
+ :group 'comm
+ :link '(custom-manual "(tramp)Top")
+ :version "22.1")
+
+(eval-and-compile ;; So it's also available in tramp-loaddefs.el!
+ (defvar tramp--startup-hook nil
+ "Forms to be executed at the end of tramp.el.")
+
+ (defmacro tramp--with-startup (&rest body)
+ "Schedule BODY to be executed at the end of tramp.el."
+ `(add-hook 'tramp--startup-hook (lambda () ,@body))))
+
+(require 'tramp-loaddefs)
+
+;; Maybe we need once a real Tramp mode, with key bindings etc.
+;;;###autoload
+(defcustom tramp-mode t
+ "Whether Tramp is enabled.
+If it is set to nil, all remote file names are used literally."
+ :group 'tramp
+ :type 'boolean)
+
+(defcustom tramp-verbose 3
+ "Verbosity level for Tramp messages.
+Any level x includes messages for all levels 1 .. x-1. The levels are
+
+ 0 silent (no tramp messages at all)
+ 1 errors
+ 2 warnings
+ 3 connection to remote hosts (default level)
+ 4 activities
+ 5 internal
+ 6 sent and received strings
+ 7 file caching
+ 8 connection properties
+ 9 test commands
+10 traces (huge)."
+ :group 'tramp
+ :type 'integer)
+
+(defcustom tramp-backup-directory-alist nil
+ "Alist of filename patterns and backup directory names.
+Each element looks like (REGEXP . DIRECTORY), with the same meaning like
+in `backup-directory-alist'. If a Tramp file is backed up, and DIRECTORY
+is a local file name, the backup directory is prepended with Tramp file
+name prefix \(method, user, host) of file.
+
+\(setq tramp-backup-directory-alist backup-directory-alist)
+
+gives the same backup policy for Tramp files on their hosts like the
+policy for local files."
+ :group 'tramp
+ :type '(repeat (cons (regexp :tag "Regexp matching filename")
+ (directory :tag "Backup directory name"))))
+
+(defcustom tramp-auto-save-directory nil
+ "Put auto-save files in this directory, if set.
+The idea is to use a local directory so that auto-saving is faster.
+This setting has precedence over `auto-save-file-name-transforms'."
+ :group 'tramp
+ :type '(choice (const :tag "Use default" nil)
+ (directory :tag "Auto save directory name")))
+
+(defcustom tramp-encoding-shell
+ (or (tramp-compat-funcall 'w32-shell-name) "/bin/sh")
+ "Use this program for encoding and decoding commands on the local host.
+This shell is used to execute the encoding and decoding command on the
+local host, so if you want to use `~' in those commands, you should
+choose a shell here which groks tilde expansion. `/bin/sh' normally
+does not understand tilde expansion.
+
+For encoding and decoding, commands like the following are executed:
+
+ /bin/sh -c COMMAND < INPUT > OUTPUT
+
+This variable can be used to change the \"/bin/sh\" part. See the
+variable `tramp-encoding-command-switch' for the \"-c\" part.
+
+If the shell must be forced to be interactive, see
+`tramp-encoding-command-interactive'.
+
+Note that this variable is not used for remote commands. There are
+mechanisms in tramp.el which automatically determine the right shell to
+use for the remote host."
+ :group 'tramp
+ :type '(file :must-match t))
+
+(defcustom tramp-encoding-command-switch
+ (if (tramp-compat-funcall 'w32-shell-dos-semantics) "/c" "-c")
+ "Use this switch together with `tramp-encoding-shell' for local commands.
+See the variable `tramp-encoding-shell' for more information."
+ :group 'tramp
+ :type 'string)
+
+(defcustom tramp-encoding-command-interactive
+ (unless (tramp-compat-funcall 'w32-shell-dos-semantics) "-i")
+ "Use this switch together with `tramp-encoding-shell' for interactive shells.
+See the variable `tramp-encoding-shell' for more information."
+ :version "24.1"
+ :group 'tramp
+ :type '(choice (const nil) string))
+
+(defvar tramp-methods nil
+ "Alist of methods for remote files.
+This is a list of entries of the form (NAME PARAM1 PARAM2 ...).
+Each NAME stands for a remote access method. Each PARAM is a
+pair of the form (KEY VALUE). The following KEYs are defined:
+
+ * `tramp-remote-shell'
+ This specifies the shell to use on the remote host. This
+ MUST be a Bourne-like shell. It is normally not necessary to
+ set this to any value other than \"/bin/sh\": Tramp wants to
+ use a shell which groks tilde expansion, but it can search
+ for it. Also note that \"/bin/sh\" exists on all Unixen,
+ this might not be true for the value that you decide to use.
+ You Have Been Warned.
+
+ * `tramp-remote-shell-login'
+ This specifies the arguments to let `tramp-remote-shell' run
+ as a login shell. It defaults to (\"-l\"), but some shells,
+ like ksh, require another argument. See
+ `tramp-connection-properties' for a way to overwrite the
+ default value.
+
+ * `tramp-remote-shell-args'
+ For implementation of `shell-command', this specifies the
+ arguments to let `tramp-remote-shell' run a single command.
+
+ * `tramp-login-program'
+ This specifies the name of the program to use for logging in to the
+ remote host. This may be the name of rsh or a workalike program,
+ or the name of telnet or a workalike, or the name of su or a workalike.
+
+ * `tramp-login-args'
+ This specifies the list of arguments to pass to the above
+ mentioned program. Please note that this is a list of list of arguments,
+ that is, normally you don't want to put \"-a -b\" or \"-f foo\"
+ here. Instead, you want a list (\"-a\" \"-b\"), or (\"-f\" \"foo\").
+ There are some patterns: \"%h\" in this list is replaced by the host
+ name, \"%u\" is replaced by the user name, \"%p\" is replaced by the
+ port number, and \"%%\" can be used to obtain a literal percent character.
+ If a list containing \"%h\", \"%u\" or \"%p\" is unchanged during
+ expansion (i.e. no host or no user specified), this list is not used as
+ argument. By this, arguments like (\"-l\" \"%u\") are optional.
+ \"%t\" is replaced by the temporary file name produced with
+ `tramp-make-tramp-temp-file'. \"%k\" indicates the keep-date
+ parameter of a program, if exists. \"%c\" adds additional
+ `tramp-ssh-controlmaster-options' options for the first hop.
+ The existence of `tramp-login-args', combined with the absence of
+ `tramp-copy-args', is an indication that the method is capable of
+ multi-hops.
+
+ * `tramp-login-env'
+ A list of environment variables and their values, which will
+ be set when calling `tramp-login-program'.
+
+ * `tramp-async-args'
+ When an asynchronous process is started, we know already that
+ the connection works. Therefore, we can pass additional
+ parameters to suppress diagnostic messages, in order not to
+ tamper the process output.
+
+ * `tramp-copy-program'
+ This specifies the name of the program to use for remotely copying
+ the file; this might be the absolute filename of scp or the name of
+ a workalike program. It is always applied on the local host.
+
+ * `tramp-copy-args'
+ This specifies the list of parameters to pass to the above mentioned
+ program, the hints for `tramp-login-args' also apply here.
+
+ * `tramp-copy-env'
+ A list of environment variables and their values, which will
+ be set when calling `tramp-copy-program'.
+
+ * `tramp-remote-copy-program'
+ The listener program to be applied on remote side, if needed.
+
+ * `tramp-remote-copy-args'
+ The list of parameters to pass to the listener program, the hints
+ for `tramp-login-args' also apply here. Additionally, \"%r\" could
+ be used here and in `tramp-copy-args'. It denotes a randomly
+ chosen port for the remote listener.
+
+ * `tramp-copy-keep-date'
+ This specifies whether the copying program when the preserves the
+ timestamp of the original file.
+
+ * `tramp-copy-keep-tmpfile'
+ This specifies whether a temporary local file shall be kept
+ for optimization reasons (useful for \"rsync\" methods).
+
+ * `tramp-copy-recursive'
+ Whether the operation copies directories recursively.
+
+ * `tramp-default-port'
+ The default port of a method.
+
+ * `tramp-tmpdir'
+ A directory on the remote host for temporary files. If not
+ specified, \"/tmp\" is taken as default.
+
+ * `tramp-connection-timeout'
+ This is the maximum time to be spent for establishing a connection.
+ In general, the global default value shall be used, but for
+ some methods, like \"su\" or \"sudo\", a shorter timeout
+ might be desirable.
+
+ * `tramp-session-timeout'
+ How long a Tramp connection keeps open before being disconnected.
+ This is useful for methods like \"su\" or \"sudo\", which
+ shouldn't run an open connection in the background forever.
+
+ * `tramp-case-insensitive'
+ Whether the remote file system handles file names case insensitive.
+ Only a non-nil value counts, the default value nil means to
+ perform further checks on the remote host. See
+ `tramp-connection-properties' for a way to overwrite this.
+
+ * `tramp-mount-args'
+ * `tramp-copyto-args'
+ * `tramp-moveto-args'
+ * `tramp-about-args'
+ These parameters, a list of list like `tramp-login-args', are used
+ for the \"rclone\" method, and are appended to the respective
+ \"rclone\" commands. In general, they shouldn't be changed inside
+ `tramp-methods'; it is recommended to change their values via
+ `tramp-connection-properties'. Unlike `tramp-login-args' there is
+ no pattern replacement.
+
+What does all this mean? Well, you should specify `tramp-login-program'
+for all methods; this program is used to log in to the remote site. Then,
+there are two ways to actually transfer the files between the local and the
+remote side. One way is using an additional scp-like program. If you want
+to do this, set `tramp-copy-program' in the method.
+
+Another possibility for file transfer is inline transfer, i.e. the
+file is passed through the same buffer used by `tramp-login-program'. In
+this case, the file contents need to be protected since the
+`tramp-login-program' might use escape codes or the connection might not
+be eight-bit clean. Therefore, file contents are encoded for transit.
+See the variables `tramp-local-coding-commands' and
+`tramp-remote-coding-commands' for details.
+
+So, to summarize: if the method is an out-of-band method, then you
+must specify `tramp-copy-program' and `tramp-copy-args'. If it is an
+inline method, then these two parameters should be nil.
+
+Notes:
+
+When using `su' or `sudo' the phrase \"open connection to a remote
+host\" sounds strange, but it is used nevertheless, for consistency.
+No connection is opened to a remote host, but `su' or `sudo' is
+started on the local host. You should specify a remote host
+`localhost' or the name of the local host. Another host name is
+useful only in combination with `tramp-default-proxies-alist'.")
+
+(defcustom tramp-default-method
+ ;; An external copy method seems to be preferred, because it performs
+ ;; much better for large files, and it hasn't too serious delays
+ ;; for small files. But it must be ensured that there aren't
+ ;; permanent password queries. Either a password agent like
+ ;; "ssh-agent" or "Pageant" shall run, or the optional
+ ;; password-cache.el or auth-sources.el packages shall be active for
+ ;; password caching. If we detect that the user is running OpenSSH
+ ;; 4.0 or newer, we could reuse the connection, which calls also for
+ ;; an external method.
+ (cond
+ ;; PuTTY is installed. We don't take it, if it is installed on a
+ ;; non-windows system, or pscp from the pssh (parallel ssh) package
+ ;; is found.
+ ((and (eq system-type 'windows-nt) (executable-find "pscp")) "pscp")
+ ;; There is an ssh installation.
+ ((executable-find "scp") "scp")
+ ;; Fallback.
+ (t "ftp"))
+ "Default method to use for transferring files.
+See `tramp-methods' for possibilities.
+Also see `tramp-default-method-alist'."
+ :group 'tramp
+ :type 'string)
+
+(defcustom tramp-default-method-alist nil
+ "Default method to use for specific host/user pairs.
+This is an alist of items (HOST USER METHOD). The first matching item
+specifies the method to use for a file name which does not specify a
+method. HOST and USER are regular expressions or nil, which is
+interpreted as a regular expression which always matches. If no entry
+matches, the variable `tramp-default-method' takes effect.
+
+If the file name does not specify the user, lookup is done using the
+empty string for the user name.
+
+See `tramp-methods' for a list of possibilities for METHOD."
+ :group 'tramp
+ :type '(repeat (list (choice :tag "Host regexp" regexp sexp)
+ (choice :tag "User regexp" regexp sexp)
+ (choice :tag "Method name" string (const nil)))))
+
+(defconst tramp-default-method-marker "-"
+ "Marker for default method in remote file names.")
+
+(defcustom tramp-default-user nil
+ "Default user to use for transferring files.
+It is nil by default; otherwise settings in configuration files like
+\"~/.ssh/config\" would be overwritten. Also see `tramp-default-user-alist'.
+
+This variable is regarded as obsolete, and will be removed soon."
+ :group 'tramp
+ :type '(choice (const nil) string))
+
+(defcustom tramp-default-user-alist nil
+ "Default user to use for specific method/host pairs.
+This is an alist of items (METHOD HOST USER). The first matching item
+specifies the user to use for a file name which does not specify a
+user. METHOD and HOST are regular expressions or nil, which is
+interpreted as a regular expression which always matches. If no entry
+matches, the variable `tramp-default-user' takes effect.
+
+If the file name does not specify the method, lookup is done using the
+empty string for the method name."
+ :group 'tramp
+ :type '(repeat (list (choice :tag "Method regexp" regexp sexp)
+ (choice :tag " Host regexp" regexp sexp)
+ (choice :tag " User name" string (const nil)))))
+
+(defcustom tramp-default-host (system-name)
+ "Default host to use for transferring files.
+Useful for su and sudo methods mostly."
+ :group 'tramp
+ :type 'string)
+
+(defcustom tramp-default-host-alist nil
+ "Default host to use for specific method/user pairs.
+This is an alist of items (METHOD USER HOST). The first matching item
+specifies the host to use for a file name which does not specify a
+host. METHOD and USER are regular expressions or nil, which is
+interpreted as a regular expression which always matches. If no entry
+matches, the variable `tramp-default-host' takes effect.
+
+If the file name does not specify the method, lookup is done using the
+empty string for the method name."
+ :group 'tramp
+ :version "24.4"
+ :type '(repeat (list (choice :tag "Method regexp" regexp sexp)
+ (choice :tag " User regexp" regexp sexp)
+ (choice :tag " Host name" string (const nil)))))
+
+(defcustom tramp-default-proxies-alist nil
+ "Route to be followed for specific host/user pairs.
+This is an alist of items (HOST USER PROXY). The first matching
+item specifies the proxy to be passed for a file name located on
+a remote target matching address@hidden HOST and USER are regular
+expressions, which could also cover a domain (USER%DOMAIN) or
+port (HOST#PORT). PROXY must be a Tramp filename without a
+localname part. Method and user name on PROXY are optional,
+which is interpreted with the default values.
+
+PROXY can contain the patterns %h and %u, which are replaced by
+the strings matching HOST or USER (without DOMAIN and PORT parts),
+respectively.
+
+If an entry is added while parsing ad-hoc hop definitions, PROXY
+carries the non-nil text property `tramp-ad-hoc'.
+
+HOST, USER or PROXY could also be Lisp forms, which will be
+evaluated. The result must be a string or nil, which is
+interpreted as a regular expression which always matches."
+ :group 'tramp
+ :type '(repeat (list (choice :tag "Host regexp" regexp sexp)
+ (choice :tag "User regexp" regexp sexp)
+ (choice :tag " Proxy name" string (const nil)))))
+
+(defcustom tramp-save-ad-hoc-proxies nil
+ "Whether to save ad-hoc proxies persistently."
+ :group 'tramp
+ :version "24.3"
+ :type 'boolean)
+
+(defcustom tramp-restricted-shell-hosts-alist
+ (when (memq system-type '(windows-nt))
+ (list (concat "\\`" (regexp-quote (system-name)) "\\'")))
+ "List of hosts, which run a restricted shell.
+This is a list of regular expressions, which denote hosts running
+a registered shell like \"rbash\". Those hosts can be used as
+proxies only, see `tramp-default-proxies-alist'. If the local
+host runs a registered shell, it shall be added to this list, too."
+ :version "24.3"
+ :group 'tramp
+ :type '(repeat (regexp :tag "Host regexp")))
+
+(defcustom tramp-local-host-regexp
+ (concat
+ "\\`"
+ (regexp-opt
+ (list "localhost" "localhost6" (system-name) "127.0.0.1" "::1") t)
+ "\\'")
+ "Host names which are regarded as local host.
+If the local host runs a chrooted environment, set this to nil."
+ :version "27.1"
+ :group 'tramp
+ :type '(choice (const :tag "Chrooted environment" nil)
+ (regexp :tag "Host regexp")))
+
+(defvar tramp-completion-function-alist nil
+ "Alist of methods for remote files.
+This is a list of entries of the form \(NAME PAIR1 PAIR2 ...).
+Each NAME stands for a remote access method. Each PAIR is of the form
+\(FUNCTION FILE). FUNCTION is responsible to extract user names and host
+names from FILE for completion. The following predefined FUNCTIONs exists:
+
+ * `tramp-parse-rhosts' for \"~/.rhosts\" like files,
+ * `tramp-parse-shosts' for \"~/.ssh/known_hosts\" like files,
+ * `tramp-parse-sconfig' for \"~/.ssh/config\" like files,
+ * `tramp-parse-shostkeys' for \"~/.ssh2/hostkeys/*\" like files,
+ * `tramp-parse-sknownhosts' for \"~/.ssh2/knownhosts/*\" like files,
+ * `tramp-parse-hosts' for \"/etc/hosts\" like files,
+ * `tramp-parse-passwd' for \"/etc/passwd\" like files.
+ * `tramp-parse-etc-group' for \"/etc/group\" like files.
+ * `tramp-parse-netrc' for \"~/.netrc\" like files.
+ * `tramp-parse-putty' for PuTTY registered sessions.
+
+FUNCTION can also be a user defined function. For more details see
+the info pages.")
+
+(defconst tramp-echo-mark-marker "_echo"
+ "String marker to surround echoed commands.")
+
+(defconst tramp-echo-mark-marker-length (length tramp-echo-mark-marker)
+ "String length of `tramp-echo-mark-marker'.")
+
+(defconst tramp-echo-mark
+ (concat tramp-echo-mark-marker
+ (make-string tramp-echo-mark-marker-length ?\b))
+ "String mark to be transmitted around shell commands.
+Used to separate their echo from the output they produce. This
+will only be used if we cannot disable remote echo via stty.
+This string must have no effect on the remote shell except for
+producing some echo which can later be detected by
+`tramp-echoed-echo-mark-regexp'. Using `tramp-echo-mark-marker',
+followed by an equal number of backspaces to erase them will
+usually suffice.")
+
+(defconst tramp-echoed-echo-mark-regexp
+ (format "%s\\(\b\\( \b\\)?\\)\\{%d\\}"
+ tramp-echo-mark-marker tramp-echo-mark-marker-length)
+ "Regexp which matches `tramp-echo-mark' as it gets echoed by
+the remote shell.")
+
+(defcustom tramp-local-end-of-line
+ (if (memq system-type '(windows-nt)) "\r\n" "\n")
+ "String used for end of line in local processes."
+ :version "24.1"
+ :group 'tramp
+ :type 'string)
+
+(defcustom tramp-rsh-end-of-line "\n"
+ "String used for end of line in rsh connections.
+I don't think this ever needs to be changed, so please tell me about it
+if you need to change this."
+ :group 'tramp
+ :type 'string)
+
+(defcustom tramp-login-prompt-regexp
+ ".*\\(user\\|login\\)\\( .*\\)?: *"
+ "Regexp matching login-like prompts.
+The regexp should match at end of buffer.
+
+Sometimes the prompt is reported to look like \"login as:\"."
+ :group 'tramp
+ :type 'regexp)
+
+(defcustom tramp-shell-prompt-pattern
+ ;; Allow a prompt to start right after a ^M since it indeed would be
+ ;; displayed at the beginning of the line (and Zsh uses it). This
+ ;; regexp works only for GNU Emacs.
+ ;; Allow also [] style prompts. They can appear only during
+ ;; connection initialization; Tramp redefines the prompt afterwards.
+ (concat "\\(?:^\\|\r\\)"
+ "[^]#$%>\n]*#?[]#$%>] *\\(\e\\[[0-9;]*[a-zA-Z] *\\)*")
+ "Regexp to match prompts from remote shell.
+Normally, Tramp expects you to configure `shell-prompt-pattern'
+correctly, but sometimes it happens that you are connecting to a
+remote host which sends a different kind of shell prompt. Therefore,
+Tramp recognizes things matched by `shell-prompt-pattern' as prompt,
+and also things matched by this variable. The default value of this
+variable is similar to the default value of `shell-prompt-pattern',
+which should work well in many cases.
+
+This regexp must match both `tramp-initial-end-of-output' and
+`tramp-end-of-output'."
+ :group 'tramp
+ :type 'regexp)
+
+(defcustom tramp-password-prompt-regexp
+ (format "^.*\\(%s\\).*:address@hidden *"
+ ;; `password-word-equivalents' has been introduced with Emacs 24.4.
+ (regexp-opt (or (bound-and-true-p password-word-equivalents)
+ '("password" "passphrase"))))
+ "Regexp matching password-like prompts.
+The regexp should match at end of buffer.
+
+The `sudo' program appears to insert a `^@' character into the prompt."
+ :version "24.4"
+ :group 'tramp
+ :type 'regexp)
+
+(defcustom tramp-wrong-passwd-regexp
+ (concat "^.*"
+ ;; These strings should be on the last line
+ (regexp-opt '("Permission denied"
+ "Login incorrect"
+ "Login Incorrect"
+ "Connection refused"
+ "Connection closed"
+ "Timeout, server not responding."
+ "Sorry, try again."
+ "Name or service not known"
+ "Host key verification failed."
+ "No supported authentication methods left to try!")
+ t)
+ ".*"
+ "\\|"
+ "^.*\\("
+ ;; Here comes a list of regexes, separated by \\|
+ "Received signal [0-9]+"
+ "\\).*")
+ "Regexp matching a `login failed' message.
+The regexp should match at end of buffer."
+ :group 'tramp
+ :type 'regexp)
+
+(defcustom tramp-yesno-prompt-regexp
+ (concat
+ (regexp-opt
+ '("Are you sure you want to continue connecting (yes/no)?"
+ "Are you sure you want to continue connecting (yes/no/[fingerprint])?")
+ t)
+ "\\s-*")
+ "Regular expression matching all yes/no queries which need to be confirmed.
+The confirmation should be done with yes or no.
+The regexp should match at end of buffer.
+See also `tramp-yn-prompt-regexp'."
+ :group 'tramp
+ :type 'regexp)
+
+(defcustom tramp-yn-prompt-regexp
+ (concat
+ (regexp-opt '("Store key in cache? (y/n)"
+ "Update cached key? (y/n, Return cancels connection)")
+ t)
+ "\\s-*")
+ "Regular expression matching all y/n queries which need to be confirmed.
+The confirmation should be done with y or n.
+The regexp should match at end of buffer.
+See also `tramp-yesno-prompt-regexp'."
+ :group 'tramp
+ :type 'regexp)
+
+(defcustom tramp-terminal-prompt-regexp
+ (concat "\\("
+ "TERM = (.*)"
+ "\\|"
+ "Terminal type\\? \\[.*\\]"
+ "\\)\\s-*")
+ "Regular expression matching all terminal setting prompts.
+The regexp should match at end of buffer.
+The answer will be provided by `tramp-action-terminal', which see."
+ :group 'tramp
+ :type 'regexp)
+
+(defcustom tramp-operation-not-permitted-regexp
+ (concat "\\(" "preserving times.*" "\\|" "set mode" "\\)" ":\\s-*"
+ (regexp-opt '("Operation not permitted") t))
+ "Regular expression matching keep-date problems in (s)cp operations.
+Copying has been performed successfully already, so this message can
+be ignored safely."
+ :group 'tramp
+ :type 'regexp)
+
+(defcustom tramp-copy-failed-regexp
+ (concat "\\(.+: "
+ (regexp-opt '("Permission denied"
+ "not a regular file"
+ "is a directory"
+ "No such file or directory")
+ t)
+ "\\)\\s-*")
+ "Regular expression matching copy problems in (s)cp operations."
+ :group 'tramp
+ :type 'regexp)
+
+(defcustom tramp-process-alive-regexp
+ ""
+ "Regular expression indicating a process has finished.
+In fact this expression is empty by intention, it will be used only to
+check regularly the status of the associated process.
+The answer will be provided by `tramp-action-process-alive',
+`tramp-action-out-of-band', which see."
+ :group 'tramp
+ :type 'regexp)
+
+(defconst tramp-temp-name-prefix "tramp."
+ "Prefix to use for temporary files.
+If this is a relative file name (such as \"tramp.\"), it is considered
+relative to the directory name returned by the function
+`tramp-compat-temporary-file-directory' (which see). It may also be an
+absolute file name; don't forget to include a prefix for the filename
+part, though.")
+
+(defconst tramp-temp-buffer-name " *tramp temp*"
+ "Buffer name for a temporary buffer.
+It shall be used in combination with `generate-new-buffer-name'.")
+
+(defvar tramp-temp-buffer-file-name nil
+ "File name of a persistent local temporary file.
+Useful for \"rsync\" like methods.")
+(make-variable-buffer-local 'tramp-temp-buffer-file-name)
+(put 'tramp-temp-buffer-file-name 'permanent-local t)
+
+(defcustom tramp-syntax 'default
+ "Tramp filename syntax to be used.
+
+It can have the following values:
+
+ `default' -- Default syntax
+ `simplified' -- Ange-FTP like syntax
+ `separate' -- Syntax as defined for XEmacs originally
+
+Do not change the value by `setq', it must be changed only via
+Customize. See also `tramp-change-syntax'."
+ :group 'tramp
+ :version "26.1"
+ :package-version '(Tramp . "2.3.3")
+ :type '(choice (const :tag "Default" default)
+ (const :tag "Ange-FTP" simplified)
+ (const :tag "XEmacs" separate))
+ :require 'tramp
+ :initialize #'custom-initialize-default
+ :set #'tramp-set-syntax)
+
+(defun tramp-set-syntax (symbol value)
+ "Set SYMBOL to value VALUE.
+Used in user option `tramp-syntax'. There are further variables
+to be set, depending on VALUE."
+ ;; Check allowed values.
+ (unless (memq value (tramp-syntax-values))
+ (tramp-user-error "Wrong `tramp-syntax' %s" value))
+ ;; Cleanup existing buffers.
+ (unless (eq (symbol-value symbol) value)
+ (tramp-cleanup-all-buffers))
+ ;; Set the value:
+ (set-default symbol value)
+ ;; Reset the depending variables.
+ (with-no-warnings
+ (setq tramp-prefix-format (tramp-build-prefix-format)
+ tramp-prefix-regexp (tramp-build-prefix-regexp)
+ tramp-method-regexp (tramp-build-method-regexp)
+ tramp-postfix-method-format (tramp-build-postfix-method-format)
+ tramp-postfix-method-regexp (tramp-build-postfix-method-regexp)
+ tramp-prefix-ipv6-format (tramp-build-prefix-ipv6-format)
+ tramp-prefix-ipv6-regexp (tramp-build-prefix-ipv6-regexp)
+ tramp-postfix-ipv6-format (tramp-build-postfix-ipv6-format)
+ tramp-postfix-ipv6-regexp (tramp-build-postfix-ipv6-regexp)
+ tramp-postfix-host-format (tramp-build-postfix-host-format)
+ tramp-postfix-host-regexp (tramp-build-postfix-host-regexp)
+ tramp-remote-file-name-spec-regexp
+ (tramp-build-remote-file-name-spec-regexp)
+ tramp-file-name-structure (tramp-build-file-name-structure)
+ tramp-file-name-regexp (tramp-build-file-name-regexp)
+ tramp-completion-file-name-regexp
+ (tramp-build-completion-file-name-regexp)))
+ ;; Rearrange file name handlers.
+ (tramp-register-file-name-handlers))
+
+;; Initialize the Tramp syntax variables. We want to override initial
+;; value of `tramp-file-name-regexp'. Other Tramp syntax variables
+;; must be initialized as well to proper values. We do not call
+;; `custom-set-variable', this would load Tramp via custom.el.
+(tramp--with-startup
+ (tramp-set-syntax 'tramp-syntax (tramp-compat-tramp-syntax)))
+
+(defun tramp-syntax-values ()
+ "Return possible values of `tramp-syntax', a list"
+ (let ((values (cdr (get 'tramp-syntax 'custom-type))))
+ (setq values (mapcar #'last values)
+ values (mapcar #'car values))
+ values))
+
+(defun tramp-lookup-syntax (alist)
+ "Look up a syntax string in ALIST according to `tramp-compat-tramp-syntax.'
+Raise an error if `tramp-syntax' is invalid."
+ (or (cdr (assq (tramp-compat-tramp-syntax) alist))
+ (error "Wrong `tramp-syntax' %s" tramp-syntax)))
+
+(defconst tramp-prefix-format-alist
+ '((default . "/")
+ (simplified . "/")
+ (separate . "/["))
+ "Alist mapping Tramp syntax to strings beginning Tramp file names.")
+
+(defun tramp-build-prefix-format ()
+ (tramp-lookup-syntax tramp-prefix-format-alist))
+
+(defvar tramp-prefix-format nil ;Initialized when defining `tramp-syntax'!
+ "String matching the very beginning of Tramp file names.
+Used in `tramp-make-tramp-file-name'.")
+
+(defun tramp-build-prefix-regexp ()
+ (concat "^" (regexp-quote tramp-prefix-format)))
+
+(defvar tramp-prefix-regexp nil ;Initialized when defining `tramp-syntax'!
+ "Regexp matching the very beginning of Tramp file names.
+Should always start with \"^\". Derived from `tramp-prefix-format'.")
+
+(defconst tramp-method-regexp-alist
+ '((default . "[a-zA-Z0-9-]+")
+ (simplified . "")
+ (separate . "[a-zA-Z0-9-]*"))
+ "Alist mapping Tramp syntax to regexps matching methods identifiers.")
+
+(defun tramp-build-method-regexp ()
+ (tramp-lookup-syntax tramp-method-regexp-alist))
+
+(defvar tramp-method-regexp nil ;Initialized when defining `tramp-syntax'!
+ "Regexp matching methods identifiers.
+The `ftp' syntax does not support methods.")
+
+(defconst tramp-postfix-method-format-alist
+ '((default . ":")
+ (simplified . "")
+ (separate . "/"))
+ "Alist mapping Tramp syntax to the delimiter after the method.")
+
+(defun tramp-build-postfix-method-format ()
+ (tramp-lookup-syntax tramp-postfix-method-format-alist))
+
+(defvar tramp-postfix-method-format nil ;Init'd when defining `tramp-syntax'!
+ "String matching delimiter between method and user or host names.
+The `ftp' syntax does not support methods.
+Used in `tramp-make-tramp-file-name'.")
+
+(defun tramp-build-postfix-method-regexp ()
+ (regexp-quote tramp-postfix-method-format))
+
+(defvar tramp-postfix-method-regexp nil ;Init'd when defining `tramp-syntax'!
+ "Regexp matching delimiter between method and user or host names.
+Derived from `tramp-postfix-method-format'.")
+
+(defconst tramp-user-regexp "[^/|: \t]+"
+ "Regexp matching user names.")
+
+(defconst tramp-prefix-domain-format "%"
+ "String matching delimiter between user and domain names.")
+
+(defconst tramp-prefix-domain-regexp (regexp-quote tramp-prefix-domain-format)
+ "Regexp matching delimiter between user and domain names.
+Derived from `tramp-prefix-domain-format'.")
+
+(defconst tramp-domain-regexp "[a-zA-Z0-9_.-]+"
+ "Regexp matching domain names.")
+
+(defconst tramp-user-with-domain-regexp
+ (concat "\\(" tramp-user-regexp "\\)"
+ tramp-prefix-domain-regexp
+ "\\(" tramp-domain-regexp "\\)")
+ "Regexp matching user names with domain names.")
+
+(defconst tramp-postfix-user-format "@"
+ "String matching delimiter between user and host names.
+Used in `tramp-make-tramp-file-name'.")
+
+(defconst tramp-postfix-user-regexp (regexp-quote tramp-postfix-user-format)
+ "Regexp matching delimiter between user and host names.
+Derived from `tramp-postfix-user-format'.")
+
+(defconst tramp-host-regexp "[a-zA-Z0-9_.%-]+"
+ "Regexp matching host names.")
+
+(defconst tramp-prefix-ipv6-format-alist
+ '((default . "[")
+ (simplified . "[")
+ (separate . ""))
+ "Alist mapping Tramp syntax to strings prefixing IPv6 addresses.")
+
+(defun tramp-build-prefix-ipv6-format ()
+ (tramp-lookup-syntax tramp-prefix-ipv6-format-alist))
+
+(defvar tramp-prefix-ipv6-format nil ;Initialized when defining `tramp-syntax'!
+ "String matching left hand side of IPv6 addresses.
+Used in `tramp-make-tramp-file-name'.")
+
+(defun tramp-build-prefix-ipv6-regexp ()
+ (regexp-quote tramp-prefix-ipv6-format))
+
+(defvar tramp-prefix-ipv6-regexp nil ;Initialized when defining `tramp-syntax'!
+ "Regexp matching left hand side of IPv6 addresses.
+Derived from `tramp-prefix-ipv6-format'.")
+
+;; The following regexp is a bit sloppy. But it shall serve our
+;; purposes. It covers also IPv4 mapped IPv6 addresses, like in
+;; "::ffff:192.168.0.1".
+(defconst tramp-ipv6-regexp "\\(?:[a-zA-Z0-9]*:\\)+[a-zA-Z0-9.]+"
+ "Regexp matching IPv6 addresses.")
+
+(defconst tramp-postfix-ipv6-format-alist
+ '((default . "]")
+ (simplified . "]")
+ (separate . ""))
+ "Alist mapping Tramp syntax to suffix for IPv6 addresses.")
+
+(defun tramp-build-postfix-ipv6-format ()
+ (tramp-lookup-syntax tramp-postfix-ipv6-format-alist))
+
+(defvar tramp-postfix-ipv6-format nil ;Initialized when defining
`tramp-syntax'!
+ "String matching right hand side of IPv6 addresses.
+Used in `tramp-make-tramp-file-name'.")
+
+(defun tramp-build-postfix-ipv6-regexp ()
+ (regexp-quote tramp-postfix-ipv6-format))
+
+(defvar tramp-postfix-ipv6-regexp nil ;Initialized when defining
`tramp-syntax'!
+ "Regexp matching right hand side of IPv6 addresses.
+Derived from `tramp-postfix-ipv6-format'.")
+
+(defconst tramp-prefix-port-format "#"
+ "String matching delimiter between host names and port numbers.")
+
+(defconst tramp-prefix-port-regexp (regexp-quote tramp-prefix-port-format)
+ "Regexp matching delimiter between host names and port numbers.
+Derived from `tramp-prefix-port-format'.")
+
+(defconst tramp-port-regexp "[0-9]+"
+ "Regexp matching port numbers.")
+
+(defconst tramp-host-with-port-regexp
+ (concat "\\(" tramp-host-regexp "\\)"
+ tramp-prefix-port-regexp
+ "\\(" tramp-port-regexp "\\)")
+ "Regexp matching host names with port numbers.")
+
+(defconst tramp-postfix-hop-format "|"
+ "String matching delimiter after ad-hoc hop definitions.")
+
+(defconst tramp-postfix-hop-regexp (regexp-quote tramp-postfix-hop-format)
+ "Regexp matching delimiter after ad-hoc hop definitions.
+Derived from `tramp-postfix-hop-format'.")
+
+(defconst tramp-postfix-host-format-alist
+ '((default . ":")
+ (simplified . ":")
+ (separate . "]"))
+ "Alist mapping Tramp syntax to strings between host and local names.")
+
+(defun tramp-build-postfix-host-format ()
+ (tramp-lookup-syntax tramp-postfix-host-format-alist))
+
+(defvar tramp-postfix-host-format nil ;Initialized when defining
`tramp-syntax'!
+ "String matching delimiter between host names and localnames.
+Used in `tramp-make-tramp-file-name'.")
+
+(defun tramp-build-postfix-host-regexp ()
+ (regexp-quote tramp-postfix-host-format))
+
+(defvar tramp-postfix-host-regexp nil ;Initialized when defining
`tramp-syntax'!
+ "Regexp matching delimiter between host names and localnames.
+Derived from `tramp-postfix-host-format'.")
+
+(defconst tramp-localname-regexp "[^\n\r]*\\'"
+ "Regexp matching localnames.")
+
+(defconst tramp-unknown-id-string "UNKNOWN"
+ "String used to denote an unknown user or group")
+
+(defconst tramp-unknown-id-integer -1
+ "Integer used to denote an unknown user or group")
+
+;;; File name format:
+
+(defun tramp-build-remote-file-name-spec-regexp ()
+ "Construct a regexp matching a Tramp file name for a Tramp syntax.
+It is expected, that `tramp-syntax' has the proper value."
+ (concat
+ "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
+ "\\(?:" "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp "\\)?"
+ "\\(" "\\(?:" tramp-host-regexp "\\|"
+ tramp-prefix-ipv6-regexp "\\(?:" tramp-ipv6-regexp "\\)?"
+ tramp-postfix-ipv6-regexp "\\)"
+ "\\(?:" tramp-prefix-port-regexp tramp-port-regexp "\\)?" "\\)?"))
+
+(defvar tramp-remote-file-name-spec-regexp
+ nil ;Initialized when defining `tramp-syntax'!
+ "Regular expression matching a Tramp file name between prefix and postfix.")
+
+(defun tramp-build-file-name-structure ()
+ "Construct the Tramp file name structure for a Tramp syntax.
+It is expected, that `tramp-syntax' has the proper value.
+See `tramp-file-name-structure'."
+ (list
+ (concat
+ tramp-prefix-regexp
+ "\\(" "\\(?:" tramp-remote-file-name-spec-regexp
+ tramp-postfix-hop-regexp "\\)+" "\\)?"
+ tramp-remote-file-name-spec-regexp tramp-postfix-host-regexp
+ "\\(" tramp-localname-regexp "\\)")
+ 5 6 7 8 1))
+
+(defvar tramp-file-name-structure nil ;Initialized when defining
`tramp-syntax'!
+ "List of six elements (REGEXP METHOD USER HOST FILE HOP), detailing \
+the Tramp file name structure.
+
+The first element REGEXP is a regular expression matching a Tramp file
+name. The regex should contain parentheses around the method name,
+the user name, the host name, and the file name parts.
+
+The second element METHOD is a number, saying which pair of
+parentheses matches the method name. The third element USER is
+similar, but for the user name. The fourth element HOST is similar,
+but for the host name. The fifth element FILE is for the file name.
+The last element HOP is the ad-hoc hop definition, which could be a
+cascade of several hops.
+
+These numbers are passed directly to `match-string', which see. That
+means the opening parentheses are counted to identify the pair.
+
+See also `tramp-file-name-regexp'.")
+
+(defun tramp-build-file-name-regexp ()
+ (car tramp-file-name-structure))
+
+;;;###autoload
+(defconst tramp-initial-file-name-regexp "\\`/.+:.*:"
+ "Value for `tramp-file-name-regexp' for autoload.
+It must match the initial `tramp-syntax' settings.")
+
+;;;###autoload
+(defvar tramp-file-name-regexp tramp-initial-file-name-regexp
+ "Regular expression matching file names handled by Tramp.
+This regexp should match Tramp file names but no other file
+names. When calling `tramp-register-file-name-handlers', the
+initial value is overwritten by the car of `tramp-file-name-structure'.")
+
+;;;###autoload
+(defcustom tramp-ignored-file-name-regexp nil
+ "Regular expression matching file names that are not under Tramp’s control."
+ :version "27.1"
+ :group 'tramp
+ :type '(choice (const nil) regexp))
+
+(defconst tramp-completion-file-name-regexp-default
+ (concat
+ "\\`/\\("
+ ;; Optional multi hop.
+ "\\([^/|:]+:[^/|:]*|\\)*"
+ ;; Last hop.
+ (if (memq system-type '(cygwin windows-nt))
+ ;; The method is either "-", or at least two characters.
+ "\\(-\\|[^/|:]\\{2,\\}\\)"
+ ;; At least one character for method.
+ "[^/|:]+")
+ ;; Method separator, user name and host name.
+ "\\(:[^/|:]*\\)?"
+ "\\)?\\'")
+ "Value for `tramp-completion-file-name-regexp' for default remoting.
+See `tramp-file-name-structure' for more explanations.
+
+On W32 systems, the volume letter must be ignored.")
+
+(defconst tramp-completion-file-name-regexp-simplified
+ (concat
+ "\\`/\\("
+ ;; Optional multi hop.
+ "\\([^/|:]*|\\)*"
+ ;; Last hop.
+ (if (memq system-type '(cygwin windows-nt))
+ ;; At least two characters.
+ "[^/|:]\\{2,\\}"
+ ;; At least one character.
+ "[^/|:]+")
+ "\\)?\\'")
+ "Value for `tramp-completion-file-name-regexp' for simplified style remoting.
+See `tramp-file-name-structure' for more explanations.
+
+On W32 systems, the volume letter must be ignored.")
+
+(defconst tramp-completion-file-name-regexp-separate
+ "\\`/\\(\\[[^]]*\\)?\\'"
+ "Value for `tramp-completion-file-name-regexp' for separate remoting.
+See `tramp-file-name-structure' for more explanations.")
+
+(defconst tramp-completion-file-name-regexp-alist
+ `((default . ,tramp-completion-file-name-regexp-default)
+ (simplified . ,tramp-completion-file-name-regexp-simplified)
+ (separate . ,tramp-completion-file-name-regexp-separate))
+ "Alist mapping incomplete Tramp file names.")
+
+(defun tramp-build-completion-file-name-regexp ()
+ (tramp-lookup-syntax tramp-completion-file-name-regexp-alist))
+
+(defvar tramp-completion-file-name-regexp
+ nil ;Initialized when defining `tramp-syntax'!
+ "Regular expression matching file names handled by Tramp completion.
+This regexp should match partial Tramp file names only.
+
+Please note that the entry in `file-name-handler-alist' is made when
+this file \(tramp.el) is loaded. This means that this variable must be set
+before loading tramp.el. Alternatively, `file-name-handler-alist' can be
+updated after changing this variable.
+
+Also see `tramp-file-name-structure'.")
+
+;;;###autoload
+(defconst tramp-autoload-file-name-regexp
+ (concat
+ "\\`/"
+ (if (memq system-type '(cygwin windows-nt))
+ ;; The method is either "-", or at least two characters.
+ "\\(-\\|[^/|:]\\{2,\\}\\)"
+ ;; At least one character for method.
+ "[^/|:]+")
+ ":")
+ "Regular expression matching file names handled by Tramp autoload.
+It must match the initial `tramp-syntax' settings. It should not
+match file names at root of the underlying local file system,
+like \"/sys\" or \"/C:\".")
+
+;; Chunked sending kludge. We set this to 500 for black-listed constellations
+;; known to have a bug in `process-send-string'; some ssh connections appear
+;; to drop bytes when data is sent too quickly. There is also a connection
+;; buffer local variable, which is computed depending on remote host properties
+;; when `tramp-chunksize' is zero or nil.
+(defcustom tramp-chunksize (when (memq system-type '(hpux)) 500)
+;; Parentheses in docstring starting at beginning of line are escaped.
+;; Fontification is messed up when
+;; `open-paren-in-column-0-is-defun-start' set to t.
+ "If non-nil, chunksize for sending input to local process.
+It is necessary only on systems which have a buggy `process-send-string'
+implementation. The necessity, whether this variable must be set, can be
+checked via the following code:
+
+ (with-temp-buffer
+ (let* ((user \"xxx\") (host \"yyy\")
+ (init 0) (step 50)
+ (sent init) (received init))
+ (while (= sent received)
+ (setq sent (+ sent step))
+ (erase-buffer)
+ (let ((proc (start-process (buffer-name) (current-buffer)
+ \"ssh\" \"-l\" user host \"wc\" \"-c\")))
+ (when (process-live-p proc)
+ (process-send-string proc (make-string sent ?\\ ))
+ (process-send-eof proc)
+ (process-send-eof proc))
+ (while (not (progn (goto-char (point-min))
+ (re-search-forward \"\\\\w+\" (point-max) t)))
+ (accept-process-output proc 1))
+ (when (process-live-p proc)
+ (setq received (string-to-number (match-string 0)))
+ (delete-process proc)
+ (message \"Bytes sent: %s\\tBytes received: %s\" sent received)
+ (sit-for 0))))
+ (if (> sent (+ init step))
+ (message \"You should set `tramp-chunksize' to a maximum of %s\"
+ (- sent step))
+ (message \"Test does not work\")
+ (display-buffer (current-buffer))
+ (sit-for 30))))
+
+In the Emacs normally running Tramp, evaluate the above code
+\(replace \"xxx\" and \"yyy\" by the remote user and host name,
+respectively). You can do this, for example, by pasting it into
+the `*scratch*' buffer and then hitting C-j with the cursor after the
+last closing parenthesis. Note that it works only if you have configured
+\"ssh\" to run without password query, see ssh-agent(1).
+
+You will see the number of bytes sent successfully to the remote host.
+If that number exceeds 1000, you can stop the execution by hitting
+C-g, because your Emacs is likely clean.
+
+When it is necessary to set `tramp-chunksize', you might consider to
+use an out-of-the-band method \(like \"scp\") instead of an internal one
+\(like \"ssh\"), because setting `tramp-chunksize' to non-nil decreases
+performance.
+
+If your Emacs is buggy, the code stops and gives you an indication
+about the value `tramp-chunksize' should be set. Maybe you could just
+experiment a bit, e.g. changing the values of `init' and `step'
+in the third line of the code.
+
+Please raise a bug report via \"M-x tramp-bug\" if your system needs
+this variable to be set as well."
+ :group 'tramp
+ :type '(choice (const nil) integer))
+
+;; Logging in to a remote host normally requires obtaining a pty. But
+;; Emacs on macOS has process-connection-type set to nil by default,
+;; so on those systems Tramp doesn't obtain a pty. Here, we allow
+;; for an override of the system default.
+(defcustom tramp-process-connection-type t
+ "Overrides `process-connection-type' for connections from Tramp.
+Tramp binds `process-connection-type' to the value given here before
+opening a connection to a remote host."
+ :group 'tramp
+ :type '(choice (const nil) (const t) (const pty)))
+
+(defcustom tramp-connection-timeout 60
+ "Defines the max time to wait for establishing a connection (in seconds).
+This can be overwritten for different connection types in `tramp-methods'.
+
+The timeout does not include the time reading a password."
+ :group 'tramp
+ :version "24.4"
+ :type 'integer)
+
+(defcustom tramp-connection-min-time-diff 5
+ "Defines seconds between two consecutive connection attempts.
+This is necessary as self defense mechanism, in order to avoid
+yo-yo connection attempts when the remote host is unavailable.
+
+A value of 0 or nil suppresses this check. This might be
+necessary, when several out-of-order copy operations are
+performed, or when several asynchronous processes will be started
+in a short time frame. In those cases it is recommended to
+let-bind this variable."
+ :group 'tramp
+ :version "24.4"
+ :type '(choice (const nil) integer))
+
+(defcustom tramp-completion-reread-directory-timeout 10
+ "Defines seconds since last remote command before rereading a directory.
+A remote directory might have changed its contents. In order to
+make it visible during file name completion in the minibuffer,
+Tramp flushes its cache and rereads the directory contents when
+more than `tramp-completion-reread-directory-timeout' seconds
+have been gone since last remote command execution. A value of t
+would require an immediate reread during filename completion, nil
+means to use always cached values for the directory contents."
+ :group 'tramp
+ :type '(choice (const nil) (const t) integer))
+
+;;; Internal Variables:
+
+(defvar tramp-current-connection nil
+ "Last connection timestamp.")
+
+(defvar tramp-password-save-function nil
+ "Password save function.
+Will be called once the password has been verified by successful
+authentication.")
+
+(defconst tramp-completion-file-name-handler-alist
+ '((file-name-all-completions
+ . tramp-completion-handle-file-name-all-completions)
+ (file-name-completion . tramp-completion-handle-file-name-completion))
+ "Alist of completion handler functions.
+Used for file names matching `tramp-completion-file-name-regexp'.
+Operations not mentioned here will be handled by Tramp's file
+name handler functions, or the normal Emacs functions.")
+
+;; Handlers for foreign methods, like FTP or SMB, shall be plugged here.
+(defvar tramp-foreign-file-name-handler-alist nil
+ "Alist of elements (FUNCTION . HANDLER) for foreign methods handled
specially.
+If (FUNCTION FILENAME) returns non-nil, then all I/O on that file is done by
+calling HANDLER.")
+
+;;; Internal functions which must come first:
+
+;; Conversion functions between external representation and
+;; internal data structure. Convenience functions for internal
+;; data structure.
+
+;; The basic structure for remote file names. We use a list :type,
+;; in order to be compatible with Emacs 24 and 25.
+(cl-defstruct (tramp-file-name (:type list) :named)
+ method user domain host port localname hop)
+
+(defun tramp-file-name-user-domain (vec)
+ "Return user and domain components of VEC."
+ (when (or (tramp-file-name-user vec) (tramp-file-name-domain vec))
+ (concat (tramp-file-name-user vec)
+ (and (tramp-file-name-domain vec)
+ tramp-prefix-domain-format)
+ (tramp-file-name-domain vec))))
+
+(defun tramp-file-name-host-port (vec)
+ "Return host and port components of VEC."
+ (when (or (tramp-file-name-host vec) (tramp-file-name-port vec))
+ (concat (tramp-file-name-host vec)
+ (and (tramp-file-name-port vec)
+ tramp-prefix-port-format)
+ (tramp-file-name-port vec))))
+
+(defun tramp-file-name-port-or-default (vec)
+ "Return port component of VEC.
+If nil, return `tramp-default-port'."
+ (or (tramp-file-name-port vec)
+ (tramp-get-method-parameter vec 'tramp-default-port)))
+
+;; Comparision of file names is performed by `tramp-equal-remote'.
+(defun tramp-file-name-equal-p (vec1 vec2)
+ "Check, whether VEC1 and VEC2 denote the same `tramp-file-name'."
+ (and (tramp-file-name-p vec1) (tramp-file-name-p vec2)
+ (string-equal (tramp-file-name-method vec1)
+ (tramp-file-name-method vec2))
+ (string-equal (tramp-file-name-user-domain vec1)
+ (tramp-file-name-user-domain vec2))
+ (string-equal (tramp-file-name-host-port vec1)
+ (tramp-file-name-host-port vec2))))
+
+(defun tramp-get-method-parameter (vec param)
+ "Return the method parameter PARAM.
+If VEC is a vector, check first in connection properties.
+Afterwards, check in `tramp-methods'. If the `tramp-methods'
+entry does not exist, return nil."
+ (let ((hash-entry
+ (replace-regexp-in-string "^tramp-" "" (symbol-name param))))
+ (if (tramp-connection-property-p vec hash-entry)
+ ;; We use the cached property.
+ (tramp-get-connection-property vec hash-entry nil)
+ ;; Use the static value from `tramp-methods'.
+ (let ((methods-entry
+ (assoc param (assoc (tramp-file-name-method vec) tramp-methods))))
+ (when methods-entry (cadr methods-entry))))))
+
+;; The localname can be quoted with "/:". Extract this.
+(defun tramp-file-name-unquote-localname (vec)
+ "Return unquoted localname component of VEC."
+ (tramp-compat-file-name-unquote (tramp-file-name-localname vec)))
+
+(defun tramp-tramp-file-p (name)
+ "Return t if NAME is a string with Tramp file name syntax."
+ (and tramp-mode (stringp name)
+ ;; No "/:" and "/c:". This is not covered by `tramp-file-name-regexp'.
+ (not (string-match-p
+ (if (memq system-type '(cygwin windows-nt))
+ "^/[[:alpha:]]?:" "^/:")
+ name))
+ ;; Excluded file names.
+ (or (null tramp-ignored-file-name-regexp)
+ (not (string-match-p tramp-ignored-file-name-regexp name)))
+ (string-match-p tramp-file-name-regexp name)
+ t))
+
+(defun tramp-find-method (method user host)
+ "Return the right method string to use.
+This is METHOD, if non-nil. Otherwise, do a lookup in
+`tramp-default-method-alist' and `tramp-default-method'."
+ (when (and method
+ (or (string-equal method "")
+ (string-equal method tramp-default-method-marker)))
+ (setq method nil))
+ (let ((result
+ (or method
+ (let ((choices tramp-default-method-alist)
+ lmethod item)
+ (while choices
+ (setq item (pop choices))
+ (when (and (string-match-p (or (nth 0 item) "") (or host ""))
+ (string-match-p (or (nth 1 item) "") (or user "")))
+ (setq lmethod (nth 2 item))
+ (setq choices nil)))
+ lmethod)
+ tramp-default-method)))
+ ;; We must mark, whether a default value has been used.
+ (if (or method (null result))
+ result
+ (propertize result 'tramp-default t))))
+
+(defun tramp-find-user (method user host)
+ "Return the right user string to use.
+This is USER, if non-nil. Otherwise, do a lookup in
+`tramp-default-user-alist' and `tramp-default-user'."
+ (let ((result
+ (or user
+ (let ((choices tramp-default-user-alist)
+ luser item)
+ (while choices
+ (setq item (pop choices))
+ (when (and (string-match-p (or (nth 0 item) "") (or method ""))
+ (string-match-p (or (nth 1 item) "") (or host "")))
+ (setq luser (nth 2 item))
+ (setq choices nil)))
+ luser)
+ tramp-default-user)))
+ ;; We must mark, whether a default value has been used.
+ (if (or user (null result))
+ result
+ (propertize result 'tramp-default t))))
+
+(defun tramp-find-host (method user host)
+ "Return the right host string to use.
+This is HOST, if non-nil. Otherwise, do a lookup in
+`tramp-default-host-alist' and `tramp-default-host'."
+ (let ((result
+ (or (and (> (length host) 0) host)
+ (let ((choices tramp-default-host-alist)
+ lhost item)
+ (while choices
+ (setq item (pop choices))
+ (when (and (string-match-p (or (nth 0 item) "") (or method ""))
+ (string-match-p (or (nth 1 item) "") (or user "")))
+ (setq lhost (nth 2 item))
+ (setq choices nil)))
+ lhost)
+ tramp-default-host)))
+ ;; We must mark, whether a default value has been used.
+ (if (or (> (length host) 0) (null result))
+ result
+ (propertize result 'tramp-default t))))
+
+(defun tramp-dissect-file-name (name &optional nodefault)
+ "Return a `tramp-file-name' structure of NAME, a remote file name.
+The structure consists of method, user, domain, host, port,
+localname (file name on remote host), and hop.
+
+Unless NODEFAULT is non-nil, method, user and host are expanded
+to their default values. For the other file name parts, no
+default values are used."
+ (save-match-data
+ (unless (tramp-tramp-file-p name)
+ (tramp-user-error nil "Not a Tramp file name: \"%s\"" name))
+ (if (not (string-match (nth 0 tramp-file-name-structure) name))
+ (error "`tramp-file-name-structure' didn't match!")
+ (let ((method (match-string (nth 1 tramp-file-name-structure) name))
+ (user (match-string (nth 2 tramp-file-name-structure) name))
+ (host (match-string (nth 3 tramp-file-name-structure) name))
+ (localname (match-string (nth 4 tramp-file-name-structure) name))
+ (hop (match-string (nth 5 tramp-file-name-structure) name))
+ domain port v)
+ (when user
+ (when (string-match tramp-user-with-domain-regexp user)
+ (setq domain (match-string 2 user)
+ user (match-string 1 user))))
+
+ (when host
+ (when (string-match tramp-host-with-port-regexp host)
+ (setq port (match-string 2 host)
+ host (match-string 1 host)))
+ (when (string-match tramp-prefix-ipv6-regexp host)
+ (setq host (replace-match "" nil t host)))
+ (when (string-match tramp-postfix-ipv6-regexp host)
+ (setq host (replace-match "" nil t host))))
+
+ (unless nodefault
+ (when hop
+ (setq v (tramp-dissect-hop-name hop)
+ hop (and hop (tramp-make-tramp-hop-name v))))
+ (let ((tramp-default-host
+ (or (and v (not (string-match-p "%h" (tramp-file-name-host v)))
+ (tramp-file-name-host v))
+ tramp-default-host)))
+ (setq method (tramp-find-method method user host)
+ user (tramp-find-user method user host)
+ host (tramp-find-host method user host)
+ hop
+ (and hop
+ (format-spec hop (format-spec-make ?h host ?u user))))))
+
+ ;; Return result.
+ (prog1
+ (setq v (make-tramp-file-name
+ :method method :user user :domain domain :host host
+ :port port :localname localname :hop hop))
+ ;; Only some methods from tramp-sh.el do support multi-hops.
+ (when (and
+ hop
+ (or (not (tramp-get-method-parameter v 'tramp-login-program))
+ (tramp-get-method-parameter v 'tramp-copy-program)))
+ (tramp-user-error
+ v "Method `%s' is not supported for multi-hops." method)))))))
+
+(defun tramp-dissect-hop-name (name &optional nodefault)
+ "Return a `tramp-file-name' structure of `hop' part of NAME.
+See `tramp-dissect-file-name' for details."
+ (let ((v (tramp-dissect-file-name
+ (concat tramp-prefix-format
+ (replace-regexp-in-string
+ (concat tramp-postfix-hop-regexp "$")
+ tramp-postfix-host-format name))
+ nodefault)))
+ ;; Only some methods from tramp-sh.el do support multi-hops.
+ (when (or (not (tramp-get-method-parameter v 'tramp-login-program))
+ (tramp-get-method-parameter v 'tramp-copy-program))
+ (tramp-user-error
+ v "Method `%s' is not supported for multi-hops."
+ (tramp-file-name-method v)))
+ ;; Return result.
+ v))
+
+(defun tramp-buffer-name (vec)
+ "A name for the connection buffer VEC."
+ (let ((method (tramp-file-name-method vec))
+ (user-domain (tramp-file-name-user-domain vec))
+ (host-port (tramp-file-name-host-port vec)))
+ (if (not (zerop (length user-domain)))
+ (format "*tramp/%s address@hidden" method user-domain host-port)
+ (format "*tramp/%s %s*" method host-port))))
+
+(defun tramp-make-tramp-file-name (&rest args)
+ "Construct a Tramp file name from ARGS.
+
+ARGS could have two different signatures. The first one is of
+type (VEC &optional LOCALNAME HOP).
+If LOCALNAME is nil, the value in VEC is used. If it is a
+symbol, a null localname will be used. Otherwise, LOCALNAME is
+expected to be a string, which will be used.
+If HOP is nil, the value in VEC is used. If it is a symbol, a
+null hop will be used. Otherwise, HOP is expected to be a
+string, which will be used.
+
+The other signature exists for backward compatibility. It has
+the form (METHOD USER DOMAIN HOST PORT LOCALNAME &optional HOP)."
+ (let (method user domain host port localname hop)
+ (cond
+ ((tramp-file-name-p (car args))
+ (setq method (tramp-file-name-method (car args))
+ user (tramp-file-name-user (car args))
+ domain (tramp-file-name-domain (car args))
+ host (tramp-file-name-host (car args))
+ port (tramp-file-name-port (car args))
+ localname (tramp-file-name-localname (car args))
+ hop (tramp-file-name-hop (car args)))
+ (when (cadr args)
+ (setq localname (and (stringp (cadr args)) (cadr args))))
+ (when (cl-caddr args)
+ (setq hop (and (stringp (cl-caddr args)) (cl-caddr args)))))
+
+ (t (setq method (nth 0 args)
+ user (nth 1 args)
+ domain (nth 2 args)
+ host (nth 3 args)
+ port (nth 4 args)
+ localname (nth 5 args)
+ hop (nth 6 args))))
+
+ ;; Unless `tramp-syntax' is `simplified', we need a method.
+ (when (and (not (zerop (length tramp-postfix-method-format)))
+ (zerop (length method)))
+ (signal 'wrong-type-argument (list #'stringp method)))
+ (concat tramp-prefix-format hop
+ (unless (zerop (length tramp-postfix-method-format))
+ (concat method tramp-postfix-method-format))
+ user
+ (unless (zerop (length domain))
+ (concat tramp-prefix-domain-format domain))
+ (unless (zerop (length user))
+ tramp-postfix-user-format)
+ (when host
+ (if (string-match-p tramp-ipv6-regexp host)
+ (concat
+ tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)
+ host))
+ (unless (zerop (length port))
+ (concat tramp-prefix-port-format port))
+ tramp-postfix-host-format
+ localname)))
+
+(defun tramp-make-tramp-hop-name (vec)
+ "Construct a Tramp hop name from VEC."
+ (replace-regexp-in-string
+ tramp-prefix-regexp ""
+ (replace-regexp-in-string
+ (concat tramp-postfix-host-regexp "$") tramp-postfix-hop-format
+ (tramp-make-tramp-file-name vec 'noloc))))
+
+(defun tramp-completion-make-tramp-file-name (method user host localname)
+ "Construct a Tramp file name from METHOD, USER, HOST and LOCALNAME.
+It must not be a complete Tramp file name, but as long as there are
+necessary only. This function will be used in file name completion."
+ (concat tramp-prefix-format
+ (unless (or (zerop (length method))
+ (zerop (length tramp-postfix-method-format)))
+ (concat method tramp-postfix-method-format))
+ (unless (zerop (length user))
+ (concat user tramp-postfix-user-format))
+ (unless (zerop (length host))
+ (concat
+ (if (string-match-p tramp-ipv6-regexp host)
+ (concat
+ tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)
+ host)
+ tramp-postfix-host-format))
+ (when localname localname)))
+
+(defun tramp-get-buffer (vec)
+ "Get the connection buffer to be used for VEC."
+ (or (get-buffer (tramp-buffer-name vec))
+ (with-current-buffer (get-buffer-create (tramp-buffer-name vec))
+ ;; We use the existence of connection property "process-buffer"
+ ;; as indication, whether a connection is active.
+ (tramp-set-connection-property
+ vec "process-buffer"
+ (tramp-get-connection-property vec "process-buffer" nil))
+ (setq buffer-undo-list t
+ default-directory (tramp-make-tramp-file-name vec 'noloc 'nohop))
+ (current-buffer))))
+
+(defun tramp-get-connection-buffer (vec)
+ "Get the connection buffer to be used for VEC.
+In case a second asynchronous communication has been started, it is different
+from `tramp-get-buffer'."
+ (or (tramp-get-connection-property vec "process-buffer" nil)
+ (tramp-get-buffer vec)))
+
+(defun tramp-get-connection-name (vec)
+ "Get the connection name to be used for VEC.
+In case a second asynchronous communication has been started, it is different
+from the default one."
+ (or (tramp-get-connection-property vec "process-name" nil)
+ (tramp-buffer-name vec)))
+
+(defun tramp-get-connection-process (vec)
+ "Get the connection process to be used for VEC.
+In case a second asynchronous communication has been started, it is different
+from the default one."
+ (and (tramp-file-name-p vec) (get-process (tramp-get-connection-name vec))))
+
+(defun tramp-set-connection-local-variables (vec)
+ "Set connection-local variables in the connection buffer used for VEC.
+If connection-local variables are not supported by this Emacs
+version, the function does nothing."
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ ;; `hack-connection-local-variables-apply' exists since Emacs 26.1.
+ (tramp-compat-funcall
+ 'hack-connection-local-variables-apply
+ `(:application tramp
+ :protocol ,(tramp-file-name-method vec)
+ :user ,(tramp-file-name-user-domain vec)
+ :machine ,(tramp-file-name-host-port vec)))))
+
+(defun tramp-set-connection-local-variables-for-buffer ()
+ "Set connection-local variables in the current buffer.
+If connection-local variables are not supported by this Emacs
+version, the function does nothing."
+ (when (file-remote-p default-directory)
+ ;; `hack-connection-local-variables-apply' exists since Emacs 26.1.
+ (tramp-compat-funcall
+ 'hack-connection-local-variables-apply
+ `(:application tramp
+ :protocol ,(file-remote-p default-directory 'method)
+ :user ,(file-remote-p default-directory 'user)
+ :machine ,(file-remote-p default-directory 'host)))))
+
+(defun tramp-debug-buffer-name (vec)
+ "A name for the debug buffer for VEC."
+ (let ((method (tramp-file-name-method vec))
+ (user-domain (tramp-file-name-user-domain vec))
+ (host-port (tramp-file-name-host-port vec)))
+ (if (not (zerop (length user-domain)))
+ (format "*debug tramp/%s address@hidden" method user-domain host-port)
+ (format "*debug tramp/%s %s*" method host-port))))
+
+(defconst tramp-debug-outline-regexp
+ (concat
+ "[0-9]+:[0-9]+:[0-9]+\\.[0-9]+ " ;; Timestamp.
+ "\\(?:\\(#<thread .+>\\) \\)?" ;; Thread.
+ "[a-z0-9-]+ (\\([0-9]+\\)) #") ;; Function name, verbosity.
+ "Used for highlighting Tramp debug buffers in `outline-mode'.")
+
+(defconst tramp-debug-font-lock-keywords
+ '(list
+ (concat "^\\(?:" tramp-debug-outline-regexp "\\).+")
+ '(1 font-lock-warning-face t t)
+ '(0 (outline-font-lock-face) keep t))
+ "Used for highlighting Tramp debug buffers in `outline-mode'.")
+
+(defun tramp-debug-outline-level ()
+ "Return the depth to which a statement is nested in the outline.
+Point must be at the beginning of a header line.
+
+The outline level is equal to the verbosity of the Tramp message."
+ (1+ (string-to-number (match-string 2))))
+
+(defun tramp-get-debug-buffer (vec)
+ "Get the debug buffer for VEC."
+ (with-current-buffer
+ (get-buffer-create (tramp-debug-buffer-name vec))
+ (when (bobp)
+ (setq buffer-undo-list t)
+ ;; Activate `outline-mode'. This runs `text-mode-hook' and
+ ;; `outline-mode-hook'. We must prevent that local processes
+ ;; die. Yes: I've seen `flyspell-mode', which starts "ispell".
+ (let ((default-directory (tramp-compat-temporary-file-directory)))
+ (outline-mode))
+ (set (make-local-variable 'outline-level) 'tramp-debug-outline-level)
+ (set (make-local-variable 'font-lock-keywords)
+ `(t (eval ,tramp-debug-font-lock-keywords)
+ ,(eval tramp-debug-font-lock-keywords)))
+ ;; Do not edit the debug buffer.
+ (use-local-map special-mode-map))
+ (current-buffer)))
+
+(defsubst tramp-debug-message (vec fmt-string &rest arguments)
+ "Append message to debug buffer.
+Message is formatted with FMT-STRING as control string and the remaining
+ARGUMENTS to actually emit the message (if applicable)."
+ (with-current-buffer (tramp-get-debug-buffer vec)
+ (goto-char (point-max))
+ ;; Headline.
+ (when (bobp)
+ (insert
+ (format
+ ";; Emacs: %s Tramp: %s -*- mode: outline; -*-"
+ emacs-version tramp-version))
+ (when (>= tramp-verbose 10)
+ (let ((tramp-verbose 0))
+ (insert
+ (format
+ "\n;; Location: %s Git: %s/%s"
+ (locate-library "tramp")
+ (or tramp-repository-branch "")
+ (or tramp-repository-version ""))))))
+ (unless (bolp)
+ (insert "\n"))
+ ;; Timestamp.
+ (let ((now (current-time)))
+ (insert (format-time-string "%T." now))
+ (insert (format "%06d " (nth 2 now))))
+ ;; Threads.
+ (unless (or (null tramp-compat-main-thread)
+ (eq (tramp-compat-current-thread) tramp-compat-main-thread))
+ (insert (format "%s " (tramp-compat-current-thread))))
+ ;; Calling Tramp function. We suppress compat and trace functions
+ ;; from being displayed.
+ (let ((btn 1) btf fn)
+ (while (not fn)
+ (setq btf (nth 1 (backtrace-frame btn)))
+ (if (not btf)
+ (setq fn "")
+ (when (symbolp btf)
+ (setq fn (symbol-name btf))
+ (unless
+ (and
+ (string-match-p "^tramp" fn)
+ (not
+ (string-match-p
+ (eval-when-compile
+ (concat
+ "^"
+ (regexp-opt
+ '("tramp-backtrace"
+ "tramp-compat-funcall"
+ "tramp-condition-case-unless-debug"
+ "tramp-debug-message"
+ "tramp-error"
+ "tramp-error-with-buffer"
+ "tramp-message"
+ "tramp-user-error")
+ t)
+ "$"))
+ fn)))
+ (setq fn nil)))
+ (setq btn (1+ btn))))
+ ;; The following code inserts filename and line number. Should
+ ;; be inactive by default, because it is time consuming.
+; (let ((ffn (find-function-noselect (intern fn))))
+; (insert
+; (format
+; "%s:%d: "
+; (file-name-nondirectory (buffer-file-name (car ffn)))
+; (with-current-buffer (car ffn)
+; (1+ (count-lines (point-min) (cdr ffn)))))))
+ (insert (format "%s " fn)))
+ ;; The message.
+ (insert (apply #'format-message fmt-string arguments))))
+
+(defvar tramp-message-show-message (null noninteractive)
+ "Show Tramp message in the minibuffer.
+This variable is used to suppress progress reporter output, and
+to disable messages from `tramp-error'. Those messages are
+visible anyway, because an error is raised.")
+
+(defsubst tramp-message (vec-or-proc level fmt-string &rest arguments)
+ "Emit a message depending on verbosity level.
+VEC-OR-PROC identifies the Tramp buffer to use. It can be either a
+vector or a process. LEVEL says to be quiet if `tramp-verbose' is
+less than LEVEL. The message is emitted only if `tramp-verbose' is
+greater than or equal to LEVEL.
+
+The message is also logged into the debug buffer when `tramp-verbose'
+is greater than or equal 4.
+
+Calls functions `message' and `tramp-debug-message' with FMT-STRING as
+control string and the remaining ARGUMENTS to actually emit the message (if
+applicable)."
+ (ignore-errors
+ (when (<= level tramp-verbose)
+ ;; Display only when there is a minimum level.
+ (when (and tramp-message-show-message (<= level 3))
+ (apply #'message
+ (concat
+ (cond
+ ((= level 0) "")
+ ((= level 1) "")
+ ((= level 2) "Warning: ")
+ (t "Tramp: "))
+ fmt-string)
+ arguments))
+ ;; Log only when there is a minimum level.
+ (when (>= tramp-verbose 4)
+ (let ((tramp-verbose 0))
+ ;; Append connection buffer for error messages.
+ (when (= level 1)
+ (with-current-buffer
+ (if (processp vec-or-proc)
+ (process-buffer vec-or-proc)
+ (tramp-get-connection-buffer vec-or-proc))
+ (setq fmt-string (concat fmt-string "\n%s")
+ arguments (append arguments (list (buffer-string))))))
+ ;; Translate proc to vec.
+ (when (processp vec-or-proc)
+ (setq vec-or-proc (process-get vec-or-proc 'vector))))
+ ;; Do it.
+ (when (tramp-file-name-p vec-or-proc)
+ (apply #'tramp-debug-message
+ vec-or-proc
+ (concat (format "(%d) # " level) fmt-string)
+ arguments))))))
+
+(defsubst tramp-backtrace (&optional vec-or-proc)
+ "Dump a backtrace into the debug buffer.
+If VEC-OR-PROC is nil, the buffer *debug tramp* is used. This
+function is meant for debugging purposes."
+ (when (>= tramp-verbose 10)
+ (if vec-or-proc
+ (tramp-message
+ vec-or-proc 10 "\n%s" (with-output-to-string (backtrace)))
+ (with-output-to-temp-buffer "*debug tramp*" (backtrace)))))
+
+(defsubst tramp-error (vec-or-proc signal fmt-string &rest arguments)
+ "Emit an error.
+VEC-OR-PROC identifies the connection to use, SIGNAL is the
+signal identifier to be raised, remaining arguments passed to
+`tramp-message'. Finally, signal SIGNAL is raised."
+ (let (tramp-message-show-message)
+ (tramp-backtrace vec-or-proc)
+ (unless arguments
+ ;; FMT-STRING could be just a file name, as in
+ ;; `file-already-exists' errors. It could contain the ?\%
+ ;; character, as in smb domain spec.
+ (setq arguments (list fmt-string)
+ fmt-string "%s"))
+ (when vec-or-proc
+ (tramp-message
+ vec-or-proc 1 "%s"
+ (error-message-string
+ (list signal
+ (get signal 'error-message)
+ (apply #'format-message fmt-string arguments)))))
+ (signal signal (list (apply #'format-message fmt-string arguments)))))
+
+(defsubst tramp-error-with-buffer
+ (buf vec-or-proc signal fmt-string &rest arguments)
+ "Emit an error, and show BUF.
+If BUF is nil, show the connection buf. Wait for 30\", or until
+an input event arrives. The other arguments are passed to `tramp-error'."
+ (save-window-excursion
+ (let* ((buf (or (and (bufferp buf) buf)
+ (and (processp vec-or-proc) (process-buffer vec-or-proc))
+ (and (tramp-file-name-p vec-or-proc)
+ (tramp-get-connection-buffer vec-or-proc))))
+ (vec (or (and (tramp-file-name-p vec-or-proc) vec-or-proc)
+ (and buf (with-current-buffer buf
+ (tramp-dissect-file-name default-directory))))))
+ (unwind-protect
+ (apply #'tramp-error vec-or-proc signal fmt-string arguments)
+ ;; Save exit.
+ (when (and buf
+ tramp-message-show-message
+ (not (zerop tramp-verbose))
+ ;; Do not show when flagged from outside.
+ (not (tramp-completion-mode-p))
+ ;; Show only when Emacs has started already.
+ (current-message))
+ (let ((enable-recursive-minibuffers t))
+ ;; `tramp-error' does not show messages. So we must do it
+ ;; ourselves.
+ (apply #'message fmt-string arguments)
+ ;; Show buffer.
+ (pop-to-buffer buf)
+ (discard-input)
+ (sit-for 30)))
+ ;; Reset timestamp. It would be wrong after waiting for a while.
+ (when (tramp-file-name-equal-p vec (car tramp-current-connection))
+ (setcdr tramp-current-connection (current-time)))))))
+
+;; We must make it a defun, because it is used earlier already.
+(defun tramp-user-error (vec-or-proc fmt-string &rest arguments)
+ "Signal a pilot error."
+ (unwind-protect
+ (apply
+ #'tramp-error vec-or-proc
+ ;; `user-error' has appeared in Emacs 24.3.
+ (if (fboundp 'user-error) 'user-error 'error) fmt-string arguments)
+ ;; Save exit.
+ (when (and tramp-message-show-message
+ (not (zerop tramp-verbose))
+ ;; Do not show when flagged from outside.
+ (not (tramp-completion-mode-p))
+ ;; Show only when Emacs has started already.
+ (current-message))
+ (let ((enable-recursive-minibuffers t))
+ ;; `tramp-error' does not show messages. So we must do it ourselves.
+ (apply #'message fmt-string arguments)
+ (discard-input)
+ (sit-for 30)
+ ;; Reset timestamp. It would be wrong after waiting for a while.
+ (when
+ (tramp-file-name-equal-p vec-or-proc (car tramp-current-connection))
+ (setcdr tramp-current-connection (current-time)))))))
+
+(defmacro tramp-with-demoted-errors (vec-or-proc format &rest body)
+ "Execute BODY while redirecting the error message to `tramp-message'.
+BODY is executed like wrapped by `with-demoted-errors'. FORMAT
+is a format-string containing a %-sequence meaning to substitute
+the resulting error message."
+ (declare (debug (symbolp body))
+ (indent 2))
+ (let ((err (make-symbol "err")))
+ `(condition-case-unless-debug ,err
+ (progn ,@body)
+ (error (tramp-message ,vec-or-proc 3 ,format ,err) nil))))
+
+(defmacro with-parsed-tramp-file-name (filename var &rest body)
+ "Parse a Tramp filename and make components available in the body.
+
+First arg FILENAME is evaluated and dissected into its components.
+Second arg VAR is a symbol. It is used as a variable name to hold
+the filename structure. It is also used as a prefix for the variables
+holding the components. For example, if VAR is the symbol `foo', then
+`foo' will be bound to the whole structure, `foo-method' will be bound to
+the method component, and so on for `foo-user', `foo-domain', `foo-host',
+`foo-port', `foo-localname', `foo-hop'.
+
+Remaining args are Lisp expressions to be evaluated (inside an implicit
+`progn').
+
+If VAR is nil, then we bind `v' to the structure and `method', `user',
+`domain', `host', `port', `localname', `hop' to the components."
+ (let ((bindings
+ (mapcar (lambda (elem)
+ `(,(if var (intern (format "%s-%s" var elem)) elem)
+ (,(intern (format "tramp-file-name-%s" elem))
+ ,(or var 'v))))
+ `,(tramp-compat-tramp-file-name-slots))))
+ `(let* ((,(or var 'v) (tramp-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)))
+
+(put 'with-parsed-tramp-file-name 'lisp-indent-function 2)
+(put 'with-parsed-tramp-file-name 'edebug-form-spec '(form symbolp body))
+(font-lock-add-keywords 'emacs-lisp-mode
'("\\<with-parsed-tramp-file-name\\>"))
+
+(defun tramp-progress-reporter-update (reporter &optional value)
+ "Report progress of an operation for Tramp."
+ (let* ((parameters (cdr reporter))
+ (message (aref parameters 3)))
+ (when (string-match-p message (or (current-message) ""))
+ (progress-reporter-update reporter value))))
+
+(defmacro with-tramp-progress-reporter (vec level message &rest body)
+ "Executes BODY, spinning a progress reporter with MESSAGE.
+If LEVEL does not fit for visible messages, there are only traces
+without a visible progress reporter."
+ (declare (indent 3) (debug t))
+ `(progn
+ (tramp-message ,vec ,level "%s..." ,message)
+ (let ((cookie "failed")
+ (tm
+ ;; We start a pulsing progress reporter after 3 seconds.
+ (when (and tramp-message-show-message
+ ;; Display only when there is a minimum level.
+ (<= ,level (min tramp-verbose 3)))
+ (let ((pr (make-progress-reporter ,message nil nil)))
+ (when pr
+ (run-at-time
+ 3 0.1 #'tramp-progress-reporter-update pr))))))
+ (unwind-protect
+ ;; Execute the body.
+ (prog1 (progn ,@body) (setq cookie "done"))
+ ;; Stop progress reporter.
+ (if tm (cancel-timer tm))
+ (tramp-message ,vec ,level "%s...%s" ,message cookie)))))
+
+(font-lock-add-keywords
+ 'emacs-lisp-mode '("\\<with-tramp-progress-reporter\\>"))
+
+(defmacro with-tramp-file-property (vec file property &rest body)
+ "Check in Tramp cache for PROPERTY, otherwise execute BODY and set cache.
+FILE must be a local file name on a connection identified via VEC."
+ `(if (file-name-absolute-p ,file)
+ (let ((value (tramp-get-file-property ,vec ,file ,property 'undef)))
+ (when (eq value 'undef)
+ ;; We cannot pass @body as parameter to
+ ;; `tramp-set-file-property' because it mangles our
+ ;; debug messages.
+ (setq value (progn ,@body))
+ (tramp-set-file-property ,vec ,file ,property value))
+ value)
+ ,@body))
+
+(put 'with-tramp-file-property 'lisp-indent-function 3)
+(put 'with-tramp-file-property 'edebug-form-spec t)
+(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-file-property\\>"))
+
+(defmacro with-tramp-connection-property (key property &rest body)
+ "Check in Tramp for property PROPERTY, otherwise executes BODY and set."
+ `(let ((value (tramp-get-connection-property ,key ,property 'undef)))
+ (when (eq value 'undef)
+ ;; We cannot pass ,@body as parameter to
+ ;; `tramp-set-connection-property' because it mangles our debug
+ ;; messages.
+ (setq value (progn ,@body))
+ (tramp-set-connection-property ,key ,property value))
+ value))
+
+(put 'with-tramp-connection-property 'lisp-indent-function 2)
+(put 'with-tramp-connection-property 'edebug-form-spec t)
+(font-lock-add-keywords
+ 'emacs-lisp-mode '("\\<with-tramp-connection-property\\>"))
+
+(defun tramp-drop-volume-letter (name)
+ "Cut off unnecessary drive letter from file NAME.
+The functions `tramp-*-handle-expand-file-name' call `expand-file-name'
+locally on a remote file name. When the local system is a W32 system
+but the remote system is Unix, this introduces a superfluous drive
+letter into the file name. This function removes it."
+ (save-match-data
+ (funcall
+ (if (tramp-compat-file-name-quoted-p name)
+ #'tramp-compat-file-name-quote #'identity)
+ (let ((name (tramp-compat-file-name-unquote name)))
+ (if (string-match "\\`[a-zA-Z]:/" name)
+ (replace-match "/" nil t name)
+ name)))))
+
+;;; Config Manipulation Functions:
+
+(defun tramp-set-completion-function (method function-list)
+ "Sets the list of completion functions for METHOD.
+FUNCTION-LIST is a list of entries of the form (FUNCTION FILE).
+The FUNCTION is intended to parse FILE according its syntax.
+It might be a predefined FUNCTION, or a user defined FUNCTION.
+For the list of predefined FUNCTIONs see `tramp-completion-function-alist'.
+
+Example:
+
+ (tramp-set-completion-function
+ \"ssh\"
+ \\='((tramp-parse-sconfig \"/etc/ssh_config\")
+ (tramp-parse-sconfig \"~/.ssh/config\")))"
+ (let ((r function-list)
+ (v function-list))
+ (setq tramp-completion-function-alist
+ (delete (assoc method tramp-completion-function-alist)
+ tramp-completion-function-alist))
+
+ (while v
+ ;; Remove double entries.
+ (when (member (car v) (cdr v))
+ (setcdr v (delete (car v) (cdr v))))
+ ;; Check for function and file or registry key.
+ (unless (and (functionp (nth 0 (car v)))
+ (cond
+ ;; Windows registry.
+ ((string-match-p "^HKEY_CURRENT_USER" (nth 1 (car v)))
+ (and (memq system-type '(cygwin windows-nt))
+ (zerop
+ (tramp-call-process
+ v "reg" nil nil nil "query" (nth 1 (car v))))))
+ ;; Zeroconf service type.
+ ((string-match-p
+ "^_[[:alpha:]]+\\._[[:alpha:]]+$" (nth 1 (car v))))
+ ;; Configuration file.
+ (t (file-exists-p (nth 1 (car v))))))
+ (setq r (delete (car v) r)))
+ (setq v (cdr v)))
+
+ (when r
+ (add-to-list 'tramp-completion-function-alist
+ (cons method r)))))
+
+(defun tramp-get-completion-function (method)
+ "Returns a list of completion functions for METHOD.
+For definition of that list see `tramp-set-completion-function'."
+ (append
+ `(;; Default settings are taken into account.
+ (tramp-parse-default-user-host ,method)
+ ;; Hits from auth-sources.
+ (tramp-parse-auth-sources ,method)
+ ;; Hosts visited once shall be remembered.
+ (tramp-parse-connection-properties ,method))
+ ;; The method related defaults.
+ (cdr (assoc method tramp-completion-function-alist))))
+
+;; Inodes don't exist for some file systems. Therefore we must
+;; generate virtual ones. Used in `find-buffer-visiting'. The method
+;; applied might be not so efficient (Ange-FTP uses hashes). But
+;; performance isn't the major issue given that file transfer will
+;; take time.
+(defvar tramp-inodes 0
+ "Keeps virtual inodes numbers.")
+
+;; Devices must distinguish physical file systems. The device numbers
+;; provided by "lstat" aren't unique, because we operate on different hosts.
+;; So we use virtual device numbers, generated by Tramp. Both Ange-FTP and
+;; EFS use device number "-1". In order to be different, we use device number
+;; (-1 . x), whereby "x" is unique for a given (method user host).
+(defvar tramp-devices 0
+ "Keeps virtual device numbers.")
+
+(defun tramp-default-file-modes (filename)
+ "Return file modes of FILENAME as integer.
+If the file modes of FILENAME cannot be determined, return the
+value of `default-file-modes', without execute permissions."
+ (or (file-modes filename)
+ (logand (default-file-modes) #o0666)))
+
+(defun tramp-replace-environment-variables (filename)
+ "Replace environment variables in FILENAME.
+Return the string with the replaced variables."
+ (or (ignore-errors
+ ;; Optional arg has been introduced with Emacs 24.4.
+ (tramp-compat-funcall 'substitute-env-vars filename 'only-defined))
+ ;; We need an own implementation.
+ (save-match-data
+ (let ((idx (string-match "\\$\\(\\w+\\)" filename)))
+ ;; `$' is coded as `$$'.
+ (when (and idx
+ (or (zerop idx) (not (eq ?$ (aref filename (1- idx)))))
+ (getenv (match-string 1 filename)))
+ (setq filename
+ (replace-match
+ (substitute-in-file-name (match-string 0 filename))
+ t nil filename)))
+ filename))))
+
+(defun tramp-find-file-name-coding-system-alist (filename tmpname)
+ "Like `find-operation-coding-system' for Tramp filenames.
+Tramp's `insert-file-contents' and `write-region' work over
+temporary file names. If `file-coding-system-alist' contains an
+expression, which matches more than the file name suffix, the
+coding system might not be determined. This function repairs it."
+ (let (result)
+ (dolist (elt file-coding-system-alist (nreverse result))
+ (when (and (consp elt) (string-match-p (car elt) filename))
+ ;; We found a matching entry in `file-coding-system-alist'.
+ ;; So we add a similar entry, but with the temporary file name
+ ;; as regexp.
+ (push (cons (regexp-quote tmpname) (cdr elt)) result)))))
+
+(defun tramp-run-real-handler (operation args)
+ "Invoke normal file name handler for OPERATION.
+First arg specifies the OPERATION, second arg is a list of arguments to
+pass to the OPERATION."
+ (let* ((inhibit-file-name-handlers
+ `(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
+ .
+ ,(and (eq inhibit-file-name-operation operation)
+ inhibit-file-name-handlers)))
+ (inhibit-file-name-operation operation))
+ (apply operation args)))
+
+;; We handle here all file primitives. Most of them have the file
+;; name as first parameter; nevertheless we check for them explicitly
+;; in order to be signaled if a new primitive appears. This
+;; scenario is needed because there isn't a way to decide by
+;; syntactical means whether a foreign method must be called. It would
+;; ease the life if `file-name-handler-alist' would support a decision
+;; function as well but regexp only.
+(defun tramp-file-name-for-operation (operation &rest args)
+ "Return file name related to OPERATION file primitive.
+ARGS are the arguments OPERATION has been called with.
+
+It does not always return a Tramp file name, for example if the
+first argument of `expand-file-name' is absolute and not remote.
+Must be handled by the callers."
+ (cond
+ ;; FILE resp DIRECTORY.
+ ((member operation
+ '(access-file byte-compiler-base-file-name delete-directory
+ delete-file diff-latest-backup-file directory-file-name
+ directory-files directory-files-and-attributes
+ dired-compress-file dired-uncache file-acl
+ file-accessible-directory-p file-attributes
+ file-directory-p file-executable-p file-exists-p
+ file-local-copy file-modes file-name-as-directory
+ file-name-directory file-name-nondirectory
+ file-name-sans-versions file-notify-add-watch
+ file-ownership-preserved-p file-readable-p
+ file-regular-p file-remote-p file-selinux-context
+ file-symlink-p file-truename file-writable-p
+ find-backup-file-name get-file-buffer
+ insert-directory insert-file-contents load
+ make-directory make-directory-internal set-file-acl
+ set-file-modes set-file-selinux-context set-file-times
+ substitute-in-file-name unhandled-file-name-directory
+ vc-registered
+ ;; Emacs 26+ only.
+ file-name-case-insensitive-p
+ ;; Emacs 27+ only.
+ file-system-info
+ ;; Tramp internal magic file name function.
+ tramp-set-file-uid-gid))
+ (if (file-name-absolute-p (nth 0 args))
+ (nth 0 args)
+ default-directory))
+ ;; FILE DIRECTORY resp FILE1 FILE2.
+ ((member operation
+ '(add-name-to-file copy-directory copy-file
+ file-equal-p file-in-directory-p
+ file-name-all-completions file-name-completion
+ ;; Starting with Emacs 26.1, just the 2nd argument of
+ ;; `make-symbolic-link' matters. For backward
+ ;; compatibility, we still accept the first argument as
+ ;; file name to be checked. Handled properly in
+ ;; `tramp-handle-*-make-symbolic-link'.
+ file-newer-than-file-p make-symbolic-link rename-file))
+ (cond
+ ((tramp-tramp-file-p (nth 0 args)) (nth 0 args))
+ ((tramp-tramp-file-p (nth 1 args)) (nth 1 args))
+ (t default-directory)))
+ ;; FILE DIRECTORY resp FILE1 FILE2.
+ ((eq operation 'expand-file-name)
+ (cond
+ ((file-name-absolute-p (nth 0 args)) (nth 0 args))
+ ((tramp-tramp-file-p (nth 1 args)) (nth 1 args))
+ (t default-directory)))
+ ;; START END FILE.
+ ((eq operation 'write-region)
+ (if (file-name-absolute-p (nth 2 args))
+ (nth 2 args)
+ default-directory))
+ ;; BUFFER.
+ ((member operation
+ '(make-auto-save-file-name
+ set-visited-file-modtime verify-visited-file-modtime))
+ (buffer-file-name
+ (if (bufferp (nth 0 args)) (nth 0 args) (current-buffer))))
+ ;; COMMAND.
+ ((member operation
+ '(process-file shell-command start-file-process
+ ;; Emacs 26+ only.
+ make-nearby-temp-file temporary-file-directory
+ ;; Emacs 27+ only.
+ exec-path make-process))
+ default-directory)
+ ;; PROC.
+ ((member operation
+ '(file-notify-rm-watch
+ ;; Emacs 25+ only.
+ file-notify-valid-p))
+ (when (processp (nth 0 args))
+ (with-current-buffer (process-buffer (nth 0 args))
+ default-directory)))
+ ;; Unknown file primitive.
+ (t (error "unknown file I/O primitive: %s" operation))))
+
+(defun tramp-find-foreign-file-name-handler (filename &optional _operation)
+ "Return foreign file name handler if exists."
+ (when (tramp-tramp-file-p filename)
+ (let ((handler tramp-foreign-file-name-handler-alist)
+ elt res)
+ (while handler
+ (setq elt (car handler)
+ handler (cdr handler))
+ (when (funcall (car elt) filename)
+ (setq handler nil
+ res (cdr elt))))
+ res)))
+
+(defvar tramp-debug-on-error nil
+ "Like `debug-on-error' but used Tramp internal.")
+
+(defmacro tramp-condition-case-unless-debug
+ (var bodyform &rest handlers)
+ "Like `condition-case-unless-debug' but `tramp-debug-on-error'."
+ (declare (debug condition-case) (indent 2))
+ `(let ((debug-on-error tramp-debug-on-error))
+ (condition-case-unless-debug ,var ,bodyform ,@handlers)))
+
+;; In Emacs, there is some concurrency due to timers. If a timer
+;; interrupts Tramp and wishes to use the same connection buffer as
+;; the "main" Emacs, then garbage might occur in the connection
+;; buffer. Therefore, we need to make sure that a timer does not use
+;; the same connection buffer as the "main" Emacs. We implement a
+;; cheap global lock, instead of locking each connection buffer
+;; separately. The global lock is based on two variables,
+;; `tramp-locked' and `tramp-locker'. `tramp-locked' is set to true
+;; (with setq) to indicate a lock. But Tramp also calls itself during
+;; processing of a single file operation, so we need to allow
+;; recursive calls. That's where the `tramp-locker' variable comes in
+;; -- it is let-bound to t during the execution of the current
+;; handler. So if `tramp-locked' is t and `tramp-locker' is also t,
+;; then we should just proceed because we have been called
+;; recursively. But if `tramp-locker' is nil, then we are a timer
+;; interrupting the "main" Emacs, and then we signal an error.
+
+(defvar tramp-locked nil
+ "If non-nil, then Tramp is currently busy.
+Together with `tramp-locker', this implements a locking mechanism
+preventing reentrant calls of Tramp.")
+
+(defvar tramp-locker nil
+ "If non-nil, then a caller has locked Tramp.
+Together with `tramp-locked', this implements a locking mechanism
+preventing reentrant calls of Tramp.")
+
+;; Mutexes have entered Emacs 26.1.
+(defvar tramp-mutex (tramp-compat-funcall 'make-mutex "tramp")
+ "Global mutex for Tramp threads.")
+
+(defun tramp-get-mutex (vec)
+ "Return the mutex locking Tramp threads for VEC."
+ (let ((p (tramp-get-connection-process vec)))
+ (if p
+ (with-tramp-connection-property p "mutex"
+ (tramp-compat-funcall 'make-mutex (process-name p)))
+ tramp-mutex)))
+
+;; Main function.
+(defun tramp-file-name-handler (operation &rest args)
+ "Invoke Tramp file name handler.
+Falls back to normal file name handler if no Tramp file name handler exists.
+If Emacs is compiled --with-threads, the body is protected by a mutex."
+ (let ((filename (apply #'tramp-file-name-for-operation operation args)))
+ (if (tramp-tramp-file-p filename)
+ (save-match-data
+ (setq filename (tramp-replace-environment-variables filename))
+ (with-parsed-tramp-file-name filename nil
+ ;; Give other threads a chance.
+ (tramp-compat-thread-yield)
+ ;; The mutex allows concurrent run of operations. It
+ ;; guarantees, that the threads are not mixed.
+ (tramp-compat-with-mutex (tramp-get-mutex v)
+ (let ((completion (tramp-completion-mode-p))
+ (foreign
+ (tramp-find-foreign-file-name-handler filename operation))
+ result)
+ ;; Call the backend function.
+ (if foreign
+ (tramp-condition-case-unless-debug err
+ (let ((sf (symbol-function foreign))
+ p)
+ ;; Some packages set the default directory to
+ ;; a remote path, before respective Tramp
+ ;; packages are already loaded. This results
+ ;; in recursive loading. Therefore, we load
+ ;; the Tramp packages locally.
+ (when (autoloadp sf)
+ (let ((default-directory
+ (tramp-compat-temporary-file-directory))
+ file-name-handler-alist)
+ (load (cadr sf) 'noerror 'nomessage)))
+ ;; (tramp-message
+ ;; v 4 "Running `%s'..." (cons operation args))
+ ;; Switch process thread.
+ (when (and tramp-mutex
+ (setq p (tramp-get-connection-process v)))
+ (tramp-compat-funcall
+ 'set-process-thread p (tramp-compat-current-thread)))
+ ;; If `non-essential' is non-nil, Tramp shall
+ ;; not open a new connection.
+ ;; If Tramp detects that it shouldn't continue
+ ;; to work, it throws the `suppress' event.
+ ;; This could happen for example, when Tramp
+ ;; tries to open the same connection twice in
+ ;; a short time frame.
+ ;; In both cases, we try the default handler
+ ;; then.
+ (setq result
+ (catch 'non-essential
+ (catch 'suppress
+ (when (and tramp-locked (not tramp-locker))
+ (setq tramp-locked nil)
+ (tramp-error
+ (car-safe tramp-current-connection)
+ 'file-error
+ "Forbidden reentrant call of Tramp"))
+ (let ((tl tramp-locked))
+ (setq tramp-locked t)
+ (unwind-protect
+ (let ((tramp-locker t))
+ (apply foreign operation args))
+ (setq tramp-locked tl))))))
+ ;; (tramp-message
+ ;; v 4 "Running `%s'...`%s'" (cons operation args)
result)
+ (cond
+ ((eq result 'non-essential)
+ (tramp-message
+ v 5 "Non-essential received in operation %s"
+ (cons operation args))
+ (tramp-run-real-handler operation args))
+ ((eq result 'suppress)
+ (let (tramp-message-show-message)
+ (tramp-message
+ v 1 "Suppress received in operation %s"
+ (cons operation args))
+ (tramp-cleanup-connection v t)
+ (tramp-run-real-handler operation args)))
+ (t result)))
+
+ ;; Trace that somebody has interrupted the operation.
+ ((debug quit)
+ (let (tramp-message-show-message)
+ (tramp-message
+ v 1 "Interrupt received in operation %s"
+ (cons operation args)))
+ ;; Propagate the signal.
+ (signal (car err) (cdr err)))
+
+ ;; When we are in completion mode, some failed
+ ;; operations shall return at least a default
+ ;; value in order to give the user a chance to
+ ;; correct the file name in the minibuffer. In
+ ;; order to get a full backtrace, one could
+ ;; apply (setq tramp-debug-on-error t)
+ (error
+ (cond
+ ((and completion (zerop (length localname))
+ (memq operation
+ '(file-exists-p file-directory-p)))
+ t)
+ ((and completion (zerop (length localname))
+ (memq operation
+ '(expand-file-name file-name-as-directory)))
+ filename)
+ ;; Propagate the error.
+ (t (signal (car err) (cdr err))))))
+
+ ;; Nothing to do for us. However, since we are in
+ ;; `tramp-mode', we must suppress the volume letter
+ ;; on MS Windows.
+ (setq result (tramp-run-real-handler operation args))
+ (if (stringp result)
+ (tramp-drop-volume-letter result)
+ result))))))
+
+ ;; When `tramp-mode' is not enabled, or the file name is quoted,
+ ;; we don't do anything.
+ (tramp-run-real-handler operation args))))
+
+(defun tramp-completion-file-name-handler (operation &rest args)
+ "Invoke Tramp file name completion handler.
+Falls back to normal file name handler if no Tramp file name handler exists."
+ (let ((fn (assoc operation tramp-completion-file-name-handler-alist)))
+ (if (and fn tramp-mode)
+ (save-match-data (apply (cdr fn) args))
+ (tramp-run-real-handler operation args))))
+
+;;;###autoload
+(progn (defun tramp-autoload-file-name-handler (operation &rest args)
+ "Load Tramp file name handler, and perform OPERATION."
+ (tramp-unload-file-name-handlers)
+ (if tramp-mode
+ (let ((default-directory temporary-file-directory))
+ (load "tramp" 'noerror 'nomessage)))
+ (apply operation args)))
+
+;; `tramp-autoload-file-name-handler' must be registered before
+;; evaluation of site-start and init files, because there might exist
+;; remote files already, f.e. files kept via recentf-mode.
+;;;###autoload
+(progn (defun tramp-register-autoload-file-name-handlers ()
+ "Add Tramp file name handlers to `file-name-handler-alist' during autoload."
+ (add-to-list 'file-name-handler-alist
+ (cons tramp-autoload-file-name-regexp
+ 'tramp-autoload-file-name-handler))
+ (put 'tramp-autoload-file-name-handler 'safe-magic t)))
+
+;;;###autoload (tramp-register-autoload-file-name-handlers)
+
+(defun tramp-use-absolute-autoload-file-names ()
+ "Change Tramp autoload objects to use absolute file names.
+This avoids problems during autoload, when `load-path' contains
+remote file names."
+ ;; We expect all other Tramp files in the same directory as tramp.el.
+ (let* ((dir (expand-file-name (file-name-directory (locate-library
"tramp"))))
+ (files-regexp
+ (format
+ "^%s$"
+ (regexp-opt
+ (mapcar
+ #'file-name-sans-extension
+ (directory-files dir nil "^tramp.+\\.elc?$"))
+ 'paren))))
+ (mapatoms
+ (lambda (atom)
+ (when (and (functionp atom)
+ (autoloadp (symbol-function atom))
+ (string-match-p files-regexp (cadr (symbol-function atom))))
+ (ignore-errors
+ (setf (cadr (symbol-function atom))
+ (expand-file-name (cadr (symbol-function atom)) dir))))))))
+
+(tramp--with-startup (tramp-use-absolute-autoload-file-names))
+
+(defun tramp-register-file-name-handlers ()
+ "Add Tramp file name handlers to `file-name-handler-alist'."
+ ;; Remove autoloaded handlers from file name handler alist. Useful,
+ ;; if `tramp-syntax' has been changed.
+ (tramp-unload-file-name-handlers)
+
+ ;; Add the handlers. We do not add anything to the `operations'
+ ;; 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))
+ (put 'tramp-file-name-handler 'safe-magic t)
+
+ (add-to-list 'file-name-handler-alist
+ (cons tramp-completion-file-name-regexp
+ #'tramp-completion-file-name-handler))
+ (put 'tramp-completion-file-name-handler 'safe-magic t)
+ ;; Mark `operations' the handler is responsible for.
+ (put 'tramp-completion-file-name-handler 'operations
+ (mapcar #'car tramp-completion-file-name-handler-alist))
+
+ (when (bound-and-true-p tramp-archive-enabled)
+ (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))
+ (let ((entry (rassoc fnh file-name-handler-alist)))
+ (when entry
+ (setq file-name-handler-alist
+ (cons entry (delete entry file-name-handler-alist)))))))
+
+(tramp--with-startup (tramp-register-file-name-handlers))
+
+(defun tramp-register-foreign-file-name-handler
+ (func handler &optional append)
+ "Register (FUNC . HANDLER) in `tramp-foreign-file-name-handler-alist'.
+FUNC is the function, which determines whether HANDLER is to be called.
+Add operations defined in `HANDLER-alist' to `tramp-file-name-handler'."
+ (add-to-list
+ 'tramp-foreign-file-name-handler-alist `(,func . ,handler) append)
+ ;; Mark `operations' the handler is responsible for.
+ (put 'tramp-file-name-handler
+ 'operations
+ (delete-dups
+ (append
+ (get 'tramp-file-name-handler 'operations)
+ (mapcar
+ #'car
+ (symbol-value (intern (concat (symbol-name handler) "-alist"))))))))
+
+(defun tramp-exists-file-name-handler (operation &rest args)
+ "Check, whether OPERATION runs a file name handler."
+ ;; The file name handler is determined on base of either an
+ ;; argument, `buffer-file-name', or `default-directory'.
+ (ignore-errors
+ (let* ((buffer-file-name "/")
+ (default-directory "/")
+ (fnha file-name-handler-alist)
+ (check-file-name-operation operation)
+ (file-name-handler-alist
+ (list
+ (cons "/"
+ (lambda (operation &rest args)
+ "Returns OPERATION if it is the one to be checked."
+ (if (equal check-file-name-operation operation)
+ operation
+ (let ((file-name-handler-alist fnha))
+ (apply operation args))))))))
+ (equal (apply operation args) operation))))
+
+;;;###autoload
+(progn (defun tramp-unload-file-name-handlers ()
+ "Unload Tramp file name handlers from `file-name-handler-alist'."
+ (dolist (fnh file-name-handler-alist)
+ (when (and (symbolp (cdr fnh))
+ (string-prefix-p "tramp-" (symbol-name (cdr fnh))))
+ (setq file-name-handler-alist (delq fnh file-name-handler-alist))))))
+
+(add-hook 'tramp-unload-hook #'tramp-unload-file-name-handlers)
+
+;;; File name handler functions for completion mode:
+
+;;;###autoload
+(defvar tramp-completion-mode nil
+ "If non-nil, external packages signal that they are in file name
completion.")
+(make-obsolete-variable 'tramp-completion-mode 'non-essential "26.1")
+
+(defun tramp-completion-mode-p ()
+ "Check, whether method / user name / host name completion is active."
+ (or
+ ;; Signal from outside.
+ non-essential
+ ;; This variable has been obsoleted in Emacs 26.
+ tramp-completion-mode))
+
+(defun tramp-connectable-p (filename)
+ "Check, whether it is possible to connect the remote host w/o side-effects.
+This is true, if either the remote host is already connected, or if we are
+not in completion mode."
+ (let (tramp-verbose)
+ (and (tramp-tramp-file-p filename)
+ (or (not (tramp-completion-mode-p))
+ (process-live-p
+ (tramp-get-connection-process
+ (tramp-dissect-file-name filename)))))))
+
+;; Method, host name and user name completion.
+;; `tramp-completion-dissect-file-name' returns a list of
+;; `tramp-file-name' structures. For all of them we return possible
+;; completions.
+(defun tramp-completion-handle-file-name-all-completions (filename directory)
+ "Like `file-name-all-completions' for partial Tramp files."
+ (let ((fullname
+ (tramp-drop-volume-letter (expand-file-name filename directory)))
+ hop result result1)
+
+ ;; Suppress hop from completion.
+ (when (string-match
+ (concat
+ tramp-prefix-regexp
+ "\\(" "\\(" tramp-remote-file-name-spec-regexp
+ tramp-postfix-hop-regexp
+ "\\)+" "\\)")
+ fullname)
+ (setq hop (match-string 1 fullname)
+ fullname (replace-match "" nil nil fullname 1)))
+
+ ;; Possible completion structures.
+ (dolist (elt (tramp-completion-dissect-file-name fullname))
+ (let* ((method (tramp-file-name-method elt))
+ (user (tramp-file-name-user elt))
+ (host (tramp-file-name-host elt))
+ (localname (tramp-file-name-localname elt))
+ (m (tramp-find-method method user host))
+ all-user-hosts)
+
+ (unless localname ;; Nothing to complete.
+
+ (if (or user host)
+
+ ;; Method dependent user / host combinations.
+ (progn
+ (mapc
+ (lambda (x)
+ (setq all-user-hosts
+ (append all-user-hosts
+ (funcall (nth 0 x) (nth 1 x)))))
+ (tramp-get-completion-function m))
+
+ (setq result
+ (append result
+ (mapcar
+ (lambda (x)
+ (tramp-get-completion-user-host
+ method user host (nth 0 x) (nth 1 x)))
+ (delq nil all-user-hosts)))))
+
+ ;; Possible methods.
+ (setq result
+ (append result (tramp-get-completion-methods m)))))))
+
+ ;; Unify list, add hop, remove nil elements.
+ (dolist (elt result)
+ (when elt
+ (string-match tramp-prefix-regexp elt)
+ (setq elt (replace-match (concat tramp-prefix-format hop) nil nil elt))
+ (push
+ (substring elt (length (tramp-drop-volume-letter directory)))
+ result1)))
+
+ ;; Complete local parts.
+ (append
+ result1
+ (ignore-errors
+ (tramp-run-real-handler
+ 'file-name-all-completions (list filename directory))))))
+
+;; Method, host name and user name completion for a file.
+(defun tramp-completion-handle-file-name-completion
+ (filename directory &optional predicate)
+ "Like `file-name-completion' for Tramp files."
+ (try-completion
+ filename
+ (mapcar #'list (file-name-all-completions filename directory))
+ (when (and predicate
+ (tramp-connectable-p (expand-file-name filename directory)))
+ (lambda (x) (funcall predicate (expand-file-name (car x) directory))))))
+
+;; I misuse a little bit the `tramp-file-name' structure in order to
+;; handle completion possibilities for partial methods / user names /
+;; host names. Return value is a list of `tramp-file-name' structures
+;; according to possible completions. If "localname" is non-nil it
+;; means there shouldn't be a completion anymore.
+
+;; Expected results:
+
+;; "/x" "/[x"
+;; ["x" nil nil nil]
+
+;; "/x:" "/[x/" "/x:y" "/[x/y" "/x:y:" "/[x/y]"
+;; ["x" nil "" nil] ["x" nil "y" nil] ["x" nil "y" ""]
+;; ["x" "" nil nil] ["x" "y" nil nil]
+
+;; "/x:y@""/[x/y@" "/x:address@hidden" "/[x/address@hidden"
"/x:address@hidden:" "/[x/address@hidden"
+;;["x" "y" nil nil] ["x" "y" "z" nil] ["x" "y" "z" ""]
+(defun tramp-completion-dissect-file-name (name)
+ "Returns a list of `tramp-file-name' structures.
+They are collected by `tramp-completion-dissect-file-name1'."
+ (let* ((x-nil "\\|\\(\\)")
+ (tramp-completion-ipv6-regexp
+ (format
+ "[^%s]*"
+ (if (zerop (length tramp-postfix-ipv6-format))
+ tramp-postfix-host-format
+ tramp-postfix-ipv6-format)))
+ ;; "/method" "/[method"
+ (tramp-completion-file-name-structure1
+ (list
+ (concat
+ tramp-prefix-regexp
+ "\\(" tramp-method-regexp x-nil "\\)$")
+ 1 nil nil nil))
+ ;; "/method:user" "/[method/user"
+ (tramp-completion-file-name-structure2
+ (list
+ (concat
+ tramp-prefix-regexp
+ "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
+ "\\(" tramp-user-regexp x-nil "\\)$")
+ 1 2 nil nil))
+ ;; "/method:host" "/[method/host"
+ (tramp-completion-file-name-structure3
+ (list
+ (concat
+ tramp-prefix-regexp
+ "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
+ "\\(" tramp-host-regexp x-nil "\\)$")
+ 1 nil 2 nil))
+ ;; "/method:[ipv6" "/[method/ipv6"
+ (tramp-completion-file-name-structure4
+ (list
+ (concat
+ tramp-prefix-regexp
+ "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
+ tramp-prefix-ipv6-regexp
+ "\\(" tramp-completion-ipv6-regexp x-nil "\\)$")
+ 1 nil 2 nil))
+ ;; "/method:address@hidden" "/[method/address@hidden"
+ (tramp-completion-file-name-structure5
+ (list
+ (concat
+ tramp-prefix-regexp
+ "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
+ "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
+ "\\(" tramp-host-regexp x-nil "\\)$")
+ 1 2 3 nil))
+ ;; "/method:address@hidden" "/[method/address@hidden"
+ (tramp-completion-file-name-structure6
+ (list
+ (concat
+ tramp-prefix-regexp
+ "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
+ "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
+ tramp-prefix-ipv6-regexp
+ "\\(" tramp-completion-ipv6-regexp x-nil "\\)$")
+ 1 2 3 nil)))
+ (delq
+ nil
+ (mapcar
+ (lambda (structure) (tramp-completion-dissect-file-name1 structure name))
+ (list
+ tramp-completion-file-name-structure1
+ tramp-completion-file-name-structure2
+ tramp-completion-file-name-structure3
+ tramp-completion-file-name-structure4
+ tramp-completion-file-name-structure5
+ tramp-completion-file-name-structure6)))))
+
+(defun tramp-completion-dissect-file-name1 (structure name)
+ "Returns a `tramp-file-name' structure matching STRUCTURE.
+The structure consists of remote method, remote user,
+remote host and localname (filename on remote host)."
+ (save-match-data
+ (when (string-match (nth 0 structure) name)
+ (make-tramp-file-name
+ :method (and (nth 1 structure)
+ (match-string (nth 1 structure) name))
+ :user (and (nth 2 structure)
+ (match-string (nth 2 structure) name))
+ :host (and (nth 3 structure)
+ (match-string (nth 3 structure) name))))))
+
+;; This function returns all possible method completions, adding the
+;; trailing method delimiter.
+(defun tramp-get-completion-methods (partial-method)
+ "Returns all method completions for PARTIAL-METHOD."
+ (mapcar
+ (lambda (method)
+ (and method
+ (string-match-p (concat "^" (regexp-quote partial-method)) method)
+ (tramp-completion-make-tramp-file-name method nil nil nil)))
+ (mapcar #'car tramp-methods)))
+
+;; Compares partial user and host names with possible completions.
+(defun tramp-get-completion-user-host
+ (method partial-user partial-host user host)
+ "Returns the most expanded string for user and host name completion.
+PARTIAL-USER must match USER, PARTIAL-HOST must match HOST."
+ (cond
+
+ ((and partial-user partial-host)
+ (if (and host
+ (string-match-p (concat "^" (regexp-quote partial-host)) host)
+ (string-equal partial-user (or user partial-user)))
+ (setq user partial-user)
+ (setq user nil
+ host nil)))
+
+ (partial-user
+ (setq host nil)
+ (unless
+ (and user
+ (string-match-p (concat "^" (regexp-quote partial-user)) user))
+ (setq user nil)))
+
+ (partial-host
+ (setq user nil)
+ (unless
+ (and host
+ (string-match-p (concat "^" (regexp-quote partial-host)) host))
+ (setq host nil)))
+
+ (t (setq user nil
+ host nil)))
+
+ (unless (zerop (+ (length user) (length host)))
+ (tramp-completion-make-tramp-file-name method user host nil)))
+
+(defun tramp-parse-default-user-host (method)
+ "Return a list of (user host) tuples allowed to access for METHOD.
+This function is added always in `tramp-get-completion-function'
+for all methods. Resulting data are derived from default settings."
+ `((,(tramp-find-user method nil nil) ,(tramp-find-host method nil nil))))
+
+(defcustom tramp-completion-use-auth-sources auth-source-do-cache
+ "Whether to use `auth-source-search' for completion of user and host names.
+This could be disturbing, if it requires a password / passphrase,
+as for \"~/.authinfo.gpg\"."
+ :group 'tramp
+ :version "27.1"
+ :type 'boolean)
+
+(defun tramp-parse-auth-sources (method)
+ "Return a list of (user host) tuples allowed to access for METHOD.
+This function is added always in `tramp-get-completion-function'
+for all methods. Resulting data are derived from default settings."
+ (and tramp-completion-use-auth-sources
+ (mapcar
+ (lambda (x) `(,(plist-get x :user) ,(plist-get x :host)))
+ (auth-source-search
+ :port method :require '(:port) :max most-positive-fixnum))))
+
+;; Generic function.
+(defun tramp-parse-group (regexp match-level skip-chars)
+ "Return a (user host) tuple allowed to access.
+User is always nil."
+ (let (result)
+ (when (re-search-forward regexp (point-at-eol) t)
+ (setq result (list nil (match-string match-level))))
+ (or
+ (> (skip-chars-forward skip-chars) 0)
+ (forward-line 1))
+ result))
+
+;; Generic function.
+(defun tramp-parse-file (filename function)
+ "Return a list of (user host) tuples allowed to access.
+User is always nil."
+ ;; On Windows, there are problems in completion when
+ ;; `default-directory' is remote.
+ (let ((default-directory (tramp-compat-temporary-file-directory)))
+ (when (file-readable-p filename)
+ (with-temp-buffer
+ (insert-file-contents filename)
+ (goto-char (point-min))
+ (cl-loop while (not (eobp)) collect (funcall function))))))
+
+(defun tramp-parse-rhosts (filename)
+ "Return a list of (user host) tuples allowed to access.
+Either user or host may be nil."
+ (tramp-parse-file filename #'tramp-parse-rhosts-group))
+
+(defun tramp-parse-rhosts-group ()
+ "Return a (user host) tuple allowed to access.
+Either user or host may be nil."
+ (let ((result)
+ (regexp
+ (concat
+ "^\\(" tramp-host-regexp "\\)"
+ "\\([ \t]+" "\\(" tramp-user-regexp "\\)" "\\)?")))
+ (when (re-search-forward regexp (point-at-eol) t)
+ (setq result (append (list (match-string 3) (match-string 1)))))
+ (forward-line 1)
+ result))
+
+(defun tramp-parse-shosts (filename)
+ "Return a list of (user host) tuples allowed to access.
+User is always nil."
+ (tramp-parse-file filename #'tramp-parse-shosts-group))
+
+(defun tramp-parse-shosts-group ()
+ "Return a (user host) tuple allowed to access.
+User is always nil."
+ (tramp-parse-group (concat "^\\(" tramp-host-regexp "\\)") 1 ","))
+
+(defun tramp-parse-sconfig (filename)
+ "Return a list of (user host) tuples allowed to access.
+User is always nil."
+ (tramp-parse-file filename #'tramp-parse-sconfig-group))
+
+(defun tramp-parse-sconfig-group ()
+ "Return a (user host) tuple allowed to access.
+User is always nil."
+ (tramp-parse-group
+ (concat "\\(?:^[ \t]*Host\\)" "\\|" "\\(?:^.+\\)"
+ "\\|" "\\(" tramp-host-regexp "\\)")
+ 1 " \t"))
+
+;; Generic function.
+(defun tramp-parse-shostkeys-sknownhosts (dirname regexp)
+ "Return a list of (user host) tuples allowed to access.
+User is always nil."
+ ;; On Windows, there are problems in completion when
+ ;; `default-directory' is remote.
+ (let* ((default-directory (tramp-compat-temporary-file-directory))
+ (files (and (file-directory-p dirname) (directory-files dirname))))
+ (cl-loop
+ for f in files
+ when (and (not (string-match "^\\.\\.?$" f)) (string-match regexp f))
+ collect (list nil (match-string 1 f)))))
+
+(defun tramp-parse-shostkeys (dirname)
+ "Return a list of (user host) tuples allowed to access.
+User is always nil."
+ (tramp-parse-shostkeys-sknownhosts
+ dirname (concat "^key_[0-9]+_\\(" tramp-host-regexp "\\)\\.pub$")))
+
+(defun tramp-parse-sknownhosts (dirname)
+ "Return a list of (user host) tuples allowed to access.
+User is always nil."
+ (tramp-parse-shostkeys-sknownhosts
+ dirname
+ (concat "^\\(" tramp-host-regexp "\\)\\.ssh-\\(dss\\|rsa\\)\\.pub$")))
+
+(defun tramp-parse-hosts (filename)
+ "Return a list of (user host) tuples allowed to access.
+User is always nil."
+ (tramp-parse-file filename #'tramp-parse-hosts-group))
+
+(defun tramp-parse-hosts-group ()
+ "Return a (user host) tuple allowed to access.
+User is always nil."
+ (tramp-parse-group
+ (concat "^\\(" tramp-ipv6-regexp "\\|" tramp-host-regexp "\\)") 1 " \t"))
+
+(defun tramp-parse-passwd (filename)
+ "Return a list of (user host) tuples allowed to access.
+Host is always \"localhost\"."
+ (with-tramp-connection-property nil "parse-passwd"
+ (if (executable-find "getent")
+ (with-temp-buffer
+ (when (zerop (tramp-call-process nil "getent" nil t nil "passwd"))
+ (goto-char (point-min))
+ (cl-loop while (not (eobp)) collect
+ (tramp-parse-etc-group-group))))
+ (tramp-parse-file filename #'tramp-parse-passwd-group))))
+
+(defun tramp-parse-passwd-group ()
+ "Return a (user host) tuple allowed to access.
+Host is always \"localhost\"."
+ (let ((result)
+ (regexp (concat "^\\(" tramp-user-regexp "\\):")))
+ (when (re-search-forward regexp (point-at-eol) t)
+ (setq result (list (match-string 1) "localhost")))
+ (forward-line 1)
+ result))
+
+(defun tramp-parse-etc-group (filename)
+ "Return a list of (group host) tuples allowed to access.
+Host is always \"localhost\"."
+ (with-tramp-connection-property nil "parse-group"
+ (if (executable-find "getent")
+ (with-temp-buffer
+ (when (zerop (tramp-call-process nil "getent" nil t nil "group"))
+ (goto-char (point-min))
+ (cl-loop while (not (eobp)) collect
+ (tramp-parse-etc-group-group))))
+ (tramp-parse-file filename #'tramp-parse-etc-group-group))))
+
+(defun tramp-parse-etc-group-group ()
+ "Return a (group host) tuple allowed to access.
+Host is always \"localhost\"."
+ (let ((result)
+ (split (split-string (buffer-substring (point) (point-at-eol)) ":")))
+ (when (member (user-login-name) (split-string (nth 3 split) "," 'omit))
+ (setq result (list (nth 0 split) "localhost")))
+ (forward-line 1)
+ result))
+
+(defun tramp-parse-netrc (filename)
+ "Return a list of (user host) tuples allowed to access.
+User may be nil."
+ ;; The declaration is not sufficient at runtime, because netrc.el is
+ ;; not autoloaded.
+ (autoload 'netrc-parse "netrc")
+ (mapcar
+ (lambda (item)
+ (and (assoc "machine" item)
+ `(,(cdr (assoc "login" item)) ,(cdr (assoc "machine" item)))))
+ (netrc-parse filename)))
+
+(defun tramp-parse-putty (registry-or-dirname)
+ "Return a list of (user host) tuples allowed to access.
+User is always nil."
+ (if (memq system-type '(windows-nt))
+ (with-tramp-connection-property nil "parse-putty"
+ (with-temp-buffer
+ (when (zerop (tramp-call-process
+ nil "reg" nil t nil "query" registry-or-dirname))
+ (goto-char (point-min))
+ (cl-loop while (not (eobp)) collect
+ (tramp-parse-putty-group registry-or-dirname)))))
+ ;; UNIX case.
+ (tramp-parse-shostkeys-sknownhosts
+ registry-or-dirname (concat "^\\(" tramp-host-regexp "\\)$"))))
+
+(defun tramp-parse-putty-group (registry)
+ "Return a (user host) tuple allowed to access.
+User is always nil."
+ (let ((result)
+ (regexp (concat (regexp-quote registry) "\\\\\\(.+\\)")))
+ (when (re-search-forward regexp (point-at-eol) t)
+ (setq result (list nil (match-string 1))))
+ (forward-line 1)
+ result))
+
+;;; Common file name handler functions for different backends:
+
+(defvar tramp-handle-file-local-copy-hook nil
+ "Normal hook to be run at the end of `tramp-*-handle-file-local-copy'.")
+
+(defvar tramp-handle-write-region-hook nil
+ "Normal hook to be run at the end of `tramp-*-handle-write-region'.")
+
+(defun tramp-handle-access-file (filename string)
+ "Like `access-file' for Tramp files."
+ (unless (file-readable-p filename)
+ (tramp-error
+ (tramp-dissect-file-name filename) tramp-file-missing
+ "%s: No such file or directory %s" string filename)))
+
+(defun tramp-handle-add-name-to-file
+ (filename newname &optional ok-if-already-exists)
+ "Like `add-name-to-file' for Tramp files."
+ (with-parsed-tramp-file-name
+ (if (tramp-tramp-file-p newname) newname filename) nil
+ (unless (tramp-equal-remote filename newname)
+ (tramp-error
+ v 'file-error
+ "add-name-to-file: %s"
+ "only implemented for same method, same user, same host"))
+ ;; Do the 'confirm if exists' thing.
+ (when (file-exists-p newname)
+ ;; What to do?
+ (if (or (null ok-if-already-exists) ; not allowed to exist
+ (and (numberp ok-if-already-exists)
+ (not (yes-or-no-p
+ (format
+ "File %s already exists; make it a link anyway? "
+ localname)))))
+ (tramp-error v 'file-already-exists newname)
+ (delete-file newname)))
+ (tramp-flush-file-properties v (file-name-directory localname))
+ (tramp-flush-file-properties v localname)
+ (copy-file
+ filename newname 'ok-if-already-exists 'keep-time
+ 'preserve-uid-gid 'preserve-permissions)))
+
+(defun tramp-handle-directory-file-name (directory)
+ "Like `directory-file-name' for Tramp files."
+ ;; If localname component of filename is "/", leave it unchanged.
+ ;; Otherwise, remove any trailing slash from localname component.
+ ;; Method, host, etc, are unchanged.
+ (while (with-parsed-tramp-file-name directory nil
+ (and (not (zerop (length localname)))
+ (eq (aref localname (1- (length localname))) ?/)
+ (not (string= localname "/"))))
+ (setq directory (substring directory 0 -1)))
+ directory)
+
+(defun tramp-handle-directory-files (directory &optional full match nosort)
+ "Like `directory-files' for Tramp files."
+ (when (file-directory-p directory)
+ (setq directory (file-name-as-directory (expand-file-name directory)))
+ (let ((temp (nreverse (file-name-all-completions "" directory)))
+ result item)
+
+ (while temp
+ (setq item (directory-file-name (pop temp)))
+ (when (or (null match) (string-match-p match item))
+ (push (if full (concat directory item) item)
+ result)))
+ (if nosort result (sort result #'string<)))))
+
+(defun tramp-handle-directory-files-and-attributes
+ (directory &optional full match nosort id-format)
+ "Like `directory-files-and-attributes' for Tramp files."
+ (mapcar
+ (lambda (x)
+ (cons x (file-attributes
+ (if full x (expand-file-name x directory)) id-format)))
+ (directory-files directory full match nosort)))
+
+(defun tramp-handle-dired-uncache (dir)
+ "Like `dired-uncache' for Tramp files."
+ (with-parsed-tramp-file-name
+ (if (file-directory-p dir) dir (file-name-directory dir)) nil
+ (tramp-flush-directory-properties v localname)))
+
+(defun tramp-handle-expand-file-name (name &optional dir)
+ "Like `expand-file-name' for Tramp files."
+ ;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
+ (setq dir (or dir default-directory "/"))
+ ;; Handle empty NAME.
+ (when (zerop (length name)) (setq name "."))
+ ;; Unless NAME is absolute, concat DIR and NAME.
+ (unless (file-name-absolute-p name)
+ (setq name (concat (file-name-as-directory dir) name)))
+ ;; If NAME is not a Tramp file, run the real handler.
+ (if (not (tramp-tramp-file-p name))
+ (tramp-run-real-handler #'expand-file-name (list name nil))
+ ;; Dissect NAME.
+ (with-parsed-tramp-file-name name nil
+ (unless (tramp-run-real-handler #'file-name-absolute-p (list localname))
+ (setq localname (concat "/" localname)))
+ ;; Do normal `expand-file-name' (this does "/./" and "/../").
+ ;; `default-directory' is bound, because on Windows there would
+ ;; be problems with UNC shares or Cygwin mounts.
+ (let ((default-directory (tramp-compat-temporary-file-directory)))
+ (tramp-make-tramp-file-name
+ v (tramp-drop-volume-letter
+ (tramp-run-real-handler #'expand-file-name (list localname))))))))
+
+(defun tramp-handle-file-accessible-directory-p (filename)
+ "Like `file-accessible-directory-p' for Tramp files."
+ (and (file-directory-p filename)
+ (file-readable-p filename)))
+
+(defun tramp-handle-file-directory-p (filename)
+ "Like `file-directory-p' for Tramp files."
+ (eq (tramp-compat-file-attribute-type
+ (file-attributes (file-truename filename)))
+ t))
+
+(defun tramp-handle-file-equal-p (filename1 filename2)
+ "Like `file-equalp-p' for Tramp files."
+ ;; Native `file-equalp-p' calls `file-truename', which requires a
+ ;; remote connection. This can be avoided, if FILENAME1 and
+ ;; FILENAME2 are not located on the same remote host.
+ (when (string-equal
+ (file-remote-p (expand-file-name filename1))
+ (file-remote-p (expand-file-name filename2)))
+ (tramp-run-real-handler #'file-equal-p (list filename1 filename2))))
+
+(defun tramp-handle-file-exists-p (filename)
+ "Like `file-exists-p' for Tramp files."
+ (not (null (file-attributes filename))))
+
+(defun tramp-handle-file-in-directory-p (filename directory)
+ "Like `file-in-directory-p' for Tramp files."
+ ;; Native `file-in-directory-p' calls `file-truename', which
+ ;; requires a remote connection. This can be avoided, if FILENAME
+ ;; and DIRECTORY are not located on the same remote host.
+ (when (string-equal
+ (file-remote-p (expand-file-name filename))
+ (file-remote-p (expand-file-name directory)))
+ (tramp-run-real-handler #'file-in-directory-p (list filename directory))))
+
+(defun tramp-handle-file-local-copy (filename)
+ "Like `file-local-copy' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (unless (file-exists-p filename)
+ (tramp-error
+ v tramp-file-missing
+ "Cannot make local copy of non-existing file `%s'" filename))
+ (let ((tmpfile (tramp-compat-make-temp-file filename)))
+ (copy-file filename tmpfile 'ok-if-already-exists 'keep-time)
+ tmpfile)))
+
+(defun tramp-handle-file-modes (filename)
+ "Like `file-modes' for Tramp files."
+ (let ((truename (or (file-truename filename) filename)))
+ (when (file-exists-p truename)
+ (tramp-mode-string-to-int
+ (tramp-compat-file-attribute-modes (file-attributes truename))))))
+
+;; Localname manipulation functions that grok Tramp localnames...
+(defun tramp-handle-file-name-as-directory (file)
+ "Like `file-name-as-directory' but aware of Tramp files."
+ ;; `file-name-as-directory' would be sufficient except localname is
+ ;; the empty string.
+ (let ((v (tramp-dissect-file-name file t)))
+ ;; Run the command on the localname portion only unless we are in
+ ;; completion mode.
+ (tramp-make-tramp-file-name
+ v (or (and (zerop (length (tramp-file-name-localname v)))
+ (not (tramp-connectable-p file)))
+ (tramp-run-real-handler
+ #'file-name-as-directory
+ (list (tramp-file-name-localname v)))))))
+
+(defun tramp-handle-file-name-case-insensitive-p (filename)
+ "Like `file-name-case-insensitive-p' for Tramp files."
+ ;; We make it a connection property, assuming that all file systems
+ ;; on the remote host behave similar. This might be wrong for
+ ;; mounted NFS directories or SMB/AFP shares; such more granular
+ ;; tests will be added in case they are needed.
+ (setq filename (expand-file-name filename))
+ (with-parsed-tramp-file-name filename nil
+ (or ;; Maybe there is a default value.
+ (tramp-get-method-parameter v 'tramp-case-insensitive)
+
+ ;; There isn't. So we must check, in case there's a connection already.
+ (and (file-remote-p filename nil 'connected)
+ (with-tramp-connection-property v "case-insensitive"
+ (ignore-errors
+ (with-tramp-progress-reporter v 5 "Checking case-insensitive"
+ ;; The idea is to compare a file with lower case
+ ;; letters with the same file with upper case letters.
+ (let ((candidate
+ (tramp-compat-file-name-unquote
+ (directory-file-name filename)))
+ tmpfile)
+ ;; Check, whether we find an existing file with
+ ;; lower case letters. This avoids us to create a
+ ;; temporary file.
+ (while (and (string-match-p
+ "[a-z]" (tramp-compat-file-local-name candidate))
+ (not (file-exists-p candidate)))
+ (setq candidate
+ (directory-file-name
+ (file-name-directory candidate))))
+ ;; Nothing found, so we must use a temporary file
+ ;; for comparison. `make-nearby-temp-file' is added
+ ;; to Emacs 26+ like `file-name-case-insensitive-p',
+ ;; so there is no compatibility problem calling it.
+ (unless
+ (string-match-p
+ "[a-z]" (tramp-compat-file-local-name candidate))
+ (setq tmpfile
+ (let ((default-directory
+ (file-name-directory filename)))
+ (tramp-compat-funcall
+ 'make-nearby-temp-file "tramp."))
+ candidate tmpfile))
+ ;; Check for the existence of the same file with
+ ;; upper case letters.
+ (unwind-protect
+ (file-exists-p
+ (concat
+ (file-remote-p candidate)
+ (upcase (tramp-compat-file-local-name candidate))))
+ ;; Cleanup.
+ (when tmpfile (delete-file tmpfile)))))))))))
+
+(defun tramp-handle-file-name-completion
+ (filename directory &optional predicate)
+ "Like `file-name-completion' for Tramp files."
+ (let (hits-ignored-extensions)
+ (or
+ (try-completion
+ filename (file-name-all-completions filename directory)
+ (lambda (x)
+ (when (funcall (or predicate #'identity) (expand-file-name x directory))
+ (not
+ (and
+ completion-ignored-extensions
+ (string-match-p
+ (concat (regexp-opt completion-ignored-extensions 'paren) "$") x)
+ ;; We remember the hit.
+ (push x hits-ignored-extensions))))))
+ ;; No match. So we try again for ignored files.
+ (try-completion filename hits-ignored-extensions))))
+
+(defun tramp-handle-file-name-directory (file)
+ "Like `file-name-directory' but aware of Tramp files."
+ ;; Everything except the last filename thing is the directory. We
+ ;; cannot apply `with-parsed-tramp-file-name', because this expands
+ ;; the remote file name parts.
+ (let ((v (tramp-dissect-file-name file t)))
+ ;; Run the command on the localname portion only. If this returns
+ ;; nil, mark also the localname part of `v' as nil.
+ (tramp-make-tramp-file-name
+ v (or (tramp-run-real-handler
+ #'file-name-directory (list (tramp-file-name-localname v)))
+ 'noloc))))
+
+(defun tramp-handle-file-name-nondirectory (file)
+ "Like `file-name-nondirectory' but aware of Tramp files."
+ (with-parsed-tramp-file-name file nil
+ (tramp-run-real-handler #'file-name-nondirectory (list localname))))
+
+(defun tramp-handle-file-newer-than-file-p (file1 file2)
+ "Like `file-newer-than-file-p' for Tramp files."
+ (cond
+ ((not (file-exists-p file1)) nil)
+ ((not (file-exists-p file2)) t)
+ (t (time-less-p (tramp-compat-file-attribute-modification-time
+ (file-attributes file2))
+ (tramp-compat-file-attribute-modification-time
+ (file-attributes file1))))))
+
+(defun tramp-handle-file-regular-p (filename)
+ "Like `file-regular-p' for Tramp files."
+ (and (file-exists-p filename)
+ (eq ?-
+ (aref (tramp-compat-file-attribute-modes (file-attributes filename))
+ 0))))
+
+(defun tramp-handle-file-remote-p (filename &optional identification connected)
+ "Like `file-remote-p' for Tramp files."
+ ;; We do not want traces in the debug buffer.
+ (let ((tramp-verbose (min tramp-verbose 3)))
+ (when (tramp-tramp-file-p filename)
+ (let* ((v (tramp-dissect-file-name filename))
+ (p (tramp-get-connection-process v))
+ (c (and (process-live-p p)
+ (tramp-get-connection-property p "connected" nil))))
+ ;; We expand the file name only, if there is already a connection.
+ (with-parsed-tramp-file-name
+ (if c (expand-file-name filename) filename) nil
+ (and (or (not connected) c)
+ (cond
+ ((eq identification 'method) method)
+ ;; Domain and port are appended to user and host,
+ ;; respectively.
+ ((eq identification 'user) (tramp-file-name-user-domain v))
+ ((eq identification 'host) (tramp-file-name-host-port v))
+ ((eq identification 'localname) localname)
+ ((eq identification 'hop) hop)
+ (t (tramp-make-tramp-file-name v 'noloc)))))))))
+
+(defun tramp-handle-file-selinux-context (_filename)
+ "Like `file-selinux-context' for Tramp files."
+ ;; Return nil context.
+ '(nil nil nil nil))
+
+(defun tramp-handle-file-symlink-p (filename)
+ "Like `file-symlink-p' for Tramp files."
+ (let ((x (tramp-compat-file-attribute-type (file-attributes filename))))
+ (and (stringp x) x)))
+
+(defun tramp-handle-file-truename (filename)
+ "Like `file-truename' for Tramp files."
+ ;; Preserve trailing "/".
+ (funcall
+ (if (string-equal (file-name-nondirectory filename) "")
+ #'file-name-as-directory #'identity)
+ (let ((result (expand-file-name filename))
+ (numchase 0)
+ ;; Don't make the following value larger than necessary.
+ ;; People expect an error message in a timely fashion when
+ ;; something is wrong; otherwise they might think that Emacs
+ ;; is hung. Of course, correctness has to come first.
+ (numchase-limit 20)
+ symlink-target)
+ (with-parsed-tramp-file-name result v1
+ ;; We cache only the localname.
+ (tramp-make-tramp-file-name
+ v1
+ (with-tramp-file-property v1 v1-localname "file-truename"
+ (while (and (setq symlink-target (file-symlink-p result))
+ (< numchase numchase-limit))
+ (setq numchase (1+ numchase)
+ result
+ (with-parsed-tramp-file-name (expand-file-name result) v2
+ (tramp-make-tramp-file-name
+ v2
+ (funcall
+ (if (tramp-compat-file-name-quoted-p v2-localname)
+ #'tramp-compat-file-name-quote #'identity)
+
+ (if (stringp symlink-target)
+ (if (file-remote-p symlink-target)
+ (let (file-name-handler-alist)
+ (tramp-compat-file-name-quote symlink-target))
+ (expand-file-name
+ symlink-target (file-name-directory v2-localname)))
+ v2-localname))
+ 'nohop)))
+ (when (>= numchase numchase-limit)
+ (tramp-error
+ v1 'file-error
+ "Maximum number (%d) of symlinks exceeded" numchase-limit)))
+ (tramp-compat-file-local-name (directory-file-name result))))))))
+
+(defun tramp-handle-file-writable-p (filename)
+ "Like `file-writable-p' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (with-tramp-file-property v localname "file-writable-p"
+ (if (file-exists-p filename)
+ (tramp-check-cached-permissions v ?w)
+ ;; If file doesn't exist, check if directory is writable.
+ (and (file-directory-p (file-name-directory filename))
+ (file-writable-p (file-name-directory filename)))))))
+
+(defun tramp-handle-find-backup-file-name (filename)
+ "Like `find-backup-file-name' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (let ((backup-directory-alist
+ (if tramp-backup-directory-alist
+ (mapcar
+ (lambda (x)
+ (cons
+ (car x)
+ (if (and (stringp (cdr x))
+ (file-name-absolute-p (cdr x))
+ (not (tramp-tramp-file-p (cdr x))))
+ (tramp-make-tramp-file-name v (cdr x))
+ (cdr x))))
+ tramp-backup-directory-alist)
+ backup-directory-alist)))
+ (tramp-run-real-handler #'find-backup-file-name (list filename)))))
+
+(defun tramp-handle-insert-directory
+ (filename switches &optional wildcard full-directory-p)
+ "Like `insert-directory' for Tramp files."
+ (unless switches (setq switches ""))
+ ;; Mark trailing "/".
+ (when (and (zerop (length (file-name-nondirectory filename)))
+ (not full-directory-p))
+ (setq switches (concat switches "F")))
+ ;; Check, whether directory is accessible.
+ (unless wildcard
+ (access-file filename "Reading directory"))
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (with-tramp-progress-reporter v 0 (format "Opening directory %s" filename)
+ ;; We must load it in order to get the advice around `insert-directory'.
+ (require 'ls-lisp)
+ (let (ls-lisp-use-insert-directory-program start)
+ (tramp-run-real-handler
+ #'insert-directory
+ (list filename switches wildcard full-directory-p))
+ ;; `ls-lisp' always returns full listings. We must remove
+ ;; superfluous parts.
+ (unless (string-match-p "l" switches)
+ (save-excursion
+ (goto-char (point-min))
+ (while (setq start
+ (text-property-not-all
+ (point) (point-at-eol) 'dired-filename t))
+ (delete-region
+ start
+ (or (text-property-any start (point-at-eol) 'dired-filename t)
+ (point-at-eol)))
+ (if (= (point-at-bol) (point-at-eol))
+ ;; Empty line.
+ (delete-region (point) (progn (forward-line) (point)))
+ (forward-line)))))))))
+
+(defun tramp-handle-insert-file-contents
+ (filename &optional visit beg end replace)
+ "Like `insert-file-contents' for Tramp files."
+ (barf-if-buffer-read-only)
+ (setq filename (expand-file-name filename))
+ (let (result local-copy remote-copy)
+ (with-parsed-tramp-file-name filename nil
+ (unwind-protect
+ (if (not (file-exists-p filename))
+ (tramp-error
+ v tramp-file-missing
+ "File `%s' not found on remote host" filename)
+
+ (with-tramp-progress-reporter
+ v 3 (format-message "Inserting `%s'" filename)
+ (condition-case err
+ (if (and (tramp-local-host-p v)
+ (let (file-name-handler-alist)
+ (file-readable-p localname)))
+ ;; Short track: if we are on the local host, we can
+ ;; run directly.
+ (setq result
+ (tramp-run-real-handler
+ #'insert-file-contents
+ (list localname visit beg end replace)))
+
+ ;; When we shall insert only a part of the file, we
+ ;; copy this part. This works only for the shell file
+ ;; name handlers.
+ (when (and (or beg end)
+ (tramp-get-method-parameter
+ v 'tramp-login-program))
+ (setq remote-copy (tramp-make-tramp-temp-file v))
+ ;; This is defined in tramp-sh.el. Let's assume
+ ;; this is loaded already.
+ (tramp-compat-funcall
+ 'tramp-send-command
+ v
+ (cond
+ ((and beg end)
+ (format "dd bs=1 skip=%d if=%s count=%d of=%s"
+ beg (tramp-shell-quote-argument localname)
+ (- end beg) remote-copy))
+ (beg
+ (format "dd bs=1 skip=%d if=%s of=%s"
+ beg (tramp-shell-quote-argument localname)
+ remote-copy))
+ (end
+ (format "dd bs=1 count=%d if=%s of=%s"
+ end (tramp-shell-quote-argument localname)
+ remote-copy))))
+ (setq tramp-temp-buffer-file-name nil beg nil end nil))
+
+ ;; `insert-file-contents-literally' takes care to
+ ;; avoid calling jka-compr.el and epa.el. By
+ ;; let-binding `inhibit-file-name-operation', we
+ ;; propagate that care to the `file-local-copy'
+ ;; operation.
+ (setq local-copy
+ (let ((inhibit-file-name-operation
+ (when (eq inhibit-file-name-operation
+ 'insert-file-contents)
+ 'file-local-copy)))
+ (cond
+ ((stringp remote-copy)
+ (file-local-copy
+ (tramp-make-tramp-file-name
+ v remote-copy 'nohop)))
+ ((stringp tramp-temp-buffer-file-name)
+ (copy-file
+ filename tramp-temp-buffer-file-name 'ok)
+ tramp-temp-buffer-file-name)
+ (t (file-local-copy filename)))))
+
+ ;; When the file is not readable for the owner, it
+ ;; cannot be inserted, even if it is readable for the
+ ;; group or for everybody.
+ (set-file-modes local-copy #o0600)
+
+ (when (and (null remote-copy)
+ (tramp-get-method-parameter
+ v 'tramp-copy-keep-tmpfile))
+ ;; We keep the local file for performance reasons,
+ ;; useful for "rsync".
+ (setq tramp-temp-buffer-file-name local-copy))
+
+ ;; We must ensure that `file-coding-system-alist'
+ ;; matches `local-copy'.
+ (let ((file-coding-system-alist
+ (tramp-find-file-name-coding-system-alist
+ filename local-copy)))
+ (setq result
+ (insert-file-contents
+ local-copy visit beg end replace))))
+ (error
+ (add-hook 'find-file-not-found-functions
+ `(lambda () (signal ',(car err) ',(cdr err)))
+ nil t)
+ (signal (car err) (cdr err))))))
+
+ ;; Save exit.
+ (progn
+ (when visit
+ (setq buffer-file-name filename)
+ (setq buffer-read-only (not (file-writable-p filename)))
+ (set-visited-file-modtime)
+ (set-buffer-modified-p nil))
+ (when (and (stringp local-copy)
+ (or remote-copy (null tramp-temp-buffer-file-name)))
+ (delete-file local-copy))
+ (when (stringp remote-copy)
+ (delete-file (tramp-make-tramp-file-name v remote-copy 'nohop)))))
+
+ ;; Result.
+ (list (expand-file-name filename)
+ (cadr result)))))
+
+(defun tramp-handle-load (file &optional noerror nomessage nosuffix
must-suffix)
+ "Like `load' for Tramp files."
+ (with-parsed-tramp-file-name (expand-file-name file) nil
+ (unless nosuffix
+ (cond ((file-exists-p (concat file ".elc"))
+ (setq file (concat file ".elc")))
+ ((file-exists-p (concat file ".el"))
+ (setq file (concat file ".el")))))
+ (when must-suffix
+ ;; The first condition is always true for absolute file names.
+ ;; Included for safety's sake.
+ (unless (or (file-name-directory file)
+ (string-match-p "\\.elc?\\'" file))
+ (tramp-error
+ v 'file-error
+ "File `%s' does not include a `.el' or `.elc' suffix" file)))
+ (unless (or noerror (file-exists-p file))
+ (tramp-error
+ v tramp-file-missing "Cannot load nonexistent file `%s'" file))
+ (if (not (file-exists-p file))
+ nil
+ (let ((tramp-message-show-message (not nomessage)))
+ (with-tramp-progress-reporter v 0 (format "Loading %s" file)
+ (let ((local-copy (file-local-copy file)))
+ (unwind-protect
+ (load local-copy noerror t nosuffix must-suffix)
+ (delete-file local-copy)))))
+ t)))
+
+(defun tramp-handle-make-symbolic-link
+ (target linkname &optional ok-if-already-exists)
+ "Like `make-symbolic-link' for Tramp files.
+This is the fallback implementation for backends which do not
+support symbolic links."
+ (if (tramp-tramp-file-p (expand-file-name linkname))
+ (tramp-error
+ (tramp-dissect-file-name (expand-file-name linkname)) 'file-error
+ "make-symbolic-link not supported")
+ ;; This is needed prior Emacs 26.1, where TARGET has also be
+ ;; checked for a file name handler.
+ (tramp-run-real-handler
+ #'make-symbolic-link (list target linkname ok-if-already-exists))))
+
+(defun tramp-handle-shell-command
+ (command &optional output-buffer error-buffer)
+ "Like `shell-command' for Tramp files."
+ (let* ((asynchronous (string-match-p "[ \t]*&[ \t]*\\'" command))
+ (command (substring command 0 asynchronous))
+ current-buffer-p
+ (output-buffer
+ (cond
+ ((bufferp output-buffer) output-buffer)
+ ((stringp output-buffer) (get-buffer-create output-buffer))
+ (output-buffer
+ (setq current-buffer-p t)
+ (current-buffer))
+ (t (get-buffer-create
+ (if asynchronous
+ "*Async Shell Command*"
+ "*Shell Command Output*")))))
+ (error-buffer
+ (cond
+ ((bufferp error-buffer) error-buffer)
+ ((stringp error-buffer) (get-buffer-create error-buffer))))
+ (bname (buffer-name output-buffer))
+ (p (get-buffer-process output-buffer))
+ buffer)
+
+ ;; The following code is taken from `shell-command', slightly
+ ;; adapted. Shouldn't it be factored out?
+ (when p
+ (cond
+ ((eq async-shell-command-buffer 'confirm-kill-process)
+ ;; If will kill a process, query first.
+ (if (yes-or-no-p
+ "A command is running in the default buffer. Kill it? ")
+ (kill-process p)
+ (tramp-user-error p "Shell command in progress")))
+ ((eq async-shell-command-buffer 'confirm-new-buffer)
+ ;; If will create a new buffer, query first.
+ (if (yes-or-no-p
+ "A command is running in the default buffer. Use a new buffer? ")
+ (setq output-buffer (generate-new-buffer bname))
+ (tramp-user-error p "Shell command in progress")))
+ ((eq async-shell-command-buffer 'new-buffer)
+ ;; It will create a new buffer.
+ (setq output-buffer (generate-new-buffer bname)))
+ ((eq async-shell-command-buffer 'confirm-rename-buffer)
+ ;; If will rename the buffer, query first.
+ (if (yes-or-no-p
+ "A command is running in the default buffer. Rename it? ")
+ (progn
+ (with-current-buffer output-buffer
+ (rename-uniquely))
+ (setq output-buffer (get-buffer-create bname)))
+ (tramp-user-error p "Shell command in progress")))
+ ((eq async-shell-command-buffer 'rename-buffer)
+ ;; It will rename the buffer.
+ (with-current-buffer output-buffer
+ (rename-uniquely))
+ (setq output-buffer (get-buffer-create bname)))))
+
+ (setq buffer (if (and (not asynchronous) error-buffer)
+ (with-parsed-tramp-file-name default-directory nil
+ (list output-buffer (tramp-make-tramp-temp-file v)))
+ output-buffer))
+
+ (if current-buffer-p
+ (progn
+ (barf-if-buffer-read-only)
+ (push-mark nil t))
+ (with-current-buffer output-buffer
+ (setq buffer-read-only nil)
+ (erase-buffer)))
+
+ (if (and (not current-buffer-p) (integerp asynchronous))
+ (let ((tramp-remote-process-environment
+ ;; `async-shell-command-width' has been introduced with
+ ;; Emacs 27.1.
+ (if (natnump (bound-and-true-p async-shell-command-width))
+ (cons (format "COLUMNS=%d"
+ (bound-and-true-p async-shell-command-width))
+ tramp-remote-process-environment)
+ tramp-remote-process-environment)))
+ (prog1
+ ;; Run the process.
+ (setq p (start-file-process-shell-command
+ (buffer-name output-buffer) buffer command))
+ ;; Display output.
+ (with-current-buffer output-buffer
+ (display-buffer output-buffer '(nil (allow-no-window . t)))
+ (setq mode-line-process '(":%s"))
+ (shell-mode)
+ (set-process-sentinel p #'shell-command-sentinel)
+ (set-process-filter p #'comint-output-filter))))
+
+ (prog1
+ ;; Run the process.
+ (process-file-shell-command command nil buffer nil)
+ ;; Insert error messages if they were separated.
+ (when (listp buffer)
+ (with-current-buffer error-buffer
+ (insert-file-contents (cadr buffer)))
+ (delete-file (cadr buffer)))
+ (if current-buffer-p
+ ;; This is like exchange-point-and-mark, but doesn't
+ ;; activate the mark. It is cleaner to avoid activation,
+ ;; even though the command loop would deactivate the mark
+ ;; because we inserted text.
+ (goto-char (prog1 (mark t)
+ (set-marker (mark-marker) (point)
+ (current-buffer))))
+ ;; There's some output, display it.
+ (when (with-current-buffer output-buffer (> (point-max) (point-min)))
+ (display-message-or-buffer output-buffer)))))))
+
+(defun tramp-handle-start-file-process (name buffer program &rest args)
+ "Like `start-file-process' for Tramp files."
+ ;; `make-process' knows the `:file-error' argument since Emacs 27.1.
+ (tramp-file-name-handler
+ 'make-process
+ :name name
+ :buffer buffer
+ :command (and program (cons program args))
+ :noquery nil
+ :file-handler t))
+
+(defun tramp-handle-substitute-in-file-name (filename)
+ "Like `substitute-in-file-name' for Tramp files.
+\"//\" and \"/~\" substitute only in the local filename part."
+ ;; Check, whether the local part is a quoted file name.
+ (if (tramp-compat-file-name-quoted-p filename)
+ filename
+ ;; First, we must replace environment variables.
+ (setq filename (tramp-replace-environment-variables filename))
+ (with-parsed-tramp-file-name filename nil
+ ;; We do not want to replace environment variables, again. "//"
+ ;; has a special meaning at the beginning of a file name on
+ ;; Cygwin and MS-Windows, we must remove it.
+ (let (process-environment)
+ ;; Ignore in LOCALNAME everything before "//" or "/~".
+ (when (stringp localname)
+ (if (string-match "//\\(/\\|~\\)" localname)
+ (setq filename
+ (replace-regexp-in-string
+ "\\`/+" "/" (substitute-in-file-name localname)))
+ (setq filename
+ (concat (file-remote-p filename)
+ (replace-regexp-in-string
+ "\\`/+" "/"
+ ;; We must disable cygwin-mount file name
+ ;; handlers and alike.
+ (tramp-run-real-handler
+ #'substitute-in-file-name (list localname))))))))
+ ;; "/m:h:~" does not work for completion. We use "/m:h:~/".
+ (if (and (stringp localname) (string-equal "~" localname))
+ (concat filename "/")
+ filename))))
+
+(defconst tramp-time-dont-know '(0 0 0 1000)
+ "An invalid time value, used as \"Don’t know\" value.")
+
+(defconst tramp-time-doesnt-exist '(-1 65535)
+ "An invalid time value, used as \"Doesn’t exist\" value.")
+
+(defun tramp-handle-set-visited-file-modtime (&optional time-list)
+ "Like `set-visited-file-modtime' for Tramp files."
+ (unless (buffer-file-name)
+ (error "Can't set-visited-file-modtime: buffer `%s' not visiting a file"
+ (buffer-name)))
+ (unless time-list
+ (let ((remote-file-name-inhibit-cache t))
+ (setq time-list
+ (or (tramp-compat-file-attribute-modification-time
+ (file-attributes (buffer-file-name)))
+ tramp-time-doesnt-exist))))
+ (unless (tramp-compat-time-equal-p time-list tramp-time-dont-know)
+ (tramp-run-real-handler #'set-visited-file-modtime (list time-list))))
+
+(defun tramp-handle-verify-visited-file-modtime (&optional buf)
+ "Like `verify-visited-file-modtime' for Tramp files.
+At the time `verify-visited-file-modtime' calls this function, we
+already know that the buffer is visiting a file and that
+`visited-file-modtime' does not return 0. Do not call this
+function directly, unless those two cases are already taken care
+of."
+ (with-current-buffer (or buf (current-buffer))
+ (let ((f (buffer-file-name)))
+ ;; There is no file visiting the buffer, or the buffer has no
+ ;; recorded last modification time, or there is no established
+ ;; connection.
+ (if (or (not f)
+ (eq (visited-file-modtime) 0)
+ (not (file-remote-p f nil 'connected)))
+ t
+ (let* ((remote-file-name-inhibit-cache t)
+ (attr (file-attributes f))
+ (modtime (tramp-compat-file-attribute-modification-time attr))
+ (mt (visited-file-modtime)))
+
+ (cond
+ ;; File exists, and has a known modtime.
+ ((and attr
+ (not (tramp-compat-time-equal-p modtime tramp-time-dont-know)))
+ (< (abs (tramp-time-diff modtime mt)) 2))
+ ;; Modtime has the don't know value.
+ (attr t)
+ ;; If file does not exist, say it is not modified if and
+ ;; only if that agrees with the buffer's record.
+ (t (tramp-compat-time-equal-p mt tramp-time-doesnt-exist))))))))
+
+(defun tramp-handle-write-region
+ (start end filename &optional append visit lockname mustbenew)
+ "Like `write-region' for Tramp files."
+ (setq filename (expand-file-name filename))
+ (with-parsed-tramp-file-name filename nil
+ (when (and mustbenew (file-exists-p filename)
+ (or (eq mustbenew 'excl)
+ (not
+ (y-or-n-p
+ (format "File %s exists; overwrite anyway? " filename)))))
+ (tramp-error v 'file-already-exists filename))
+
+ (let ((tmpfile (tramp-compat-make-temp-file filename)))
+ (when (and append (file-exists-p filename))
+ (copy-file filename tmpfile 'ok))
+ ;; We say `no-message' here because we don't want the visited file
+ ;; modtime data to be clobbered from the temp file. We call
+ ;; `set-visited-file-modtime' ourselves later on.
+ (tramp-run-real-handler
+ #'write-region (list start end tmpfile append 'no-message lockname))
+ (condition-case nil
+ (rename-file tmpfile filename 'ok-if-already-exists)
+ (error
+ (delete-file tmpfile)
+ (tramp-error
+ v 'file-error "Couldn't write region to `%s'" filename))))
+
+ (tramp-flush-file-properties v (file-name-directory localname))
+ (tramp-flush-file-properties v localname)
+
+ ;; Set file modification time.
+ (when (or (eq visit t) (stringp visit))
+ (set-visited-file-modtime
+ (tramp-compat-file-attribute-modification-time
+ (file-attributes filename))))
+
+ ;; The end.
+ (when (and (null noninteractive)
+ (or (eq visit t) (null visit) (stringp visit)))
+ (tramp-message v 0 "Wrote %s" filename))
+ (run-hooks 'tramp-handle-write-region-hook)))
+
+;; This is used in tramp-sh.el and tramp-sudoedit.el.
+(defconst tramp-stat-marker "/////"
+ "Marker in stat commands for file attributes.")
+
+(defconst tramp-stat-quoted-marker "\\/\\/\\/\\/\\/"
+ "Quoted marker in stat commands for file attributes.")
+
+;; This is used in tramp-gvfs.el and tramp-sh.el.
+(defconst tramp-gio-events
+ '("attribute-changed" "changed" "changes-done-hint"
+ "created" "deleted" "moved" "pre-unmount" "unmounted")
+ "List of events \"gio monitor\" could send.")
+
+;; This is the default handler. tramp-gvfs.el and tramp-sh.el have
+;; their own one.
+(defun tramp-handle-file-notify-add-watch (filename _flags _callback)
+ "Like `file-notify-add-watch' for Tramp files."
+ (setq filename (expand-file-name filename))
+ (with-parsed-tramp-file-name filename nil
+ (tramp-error
+ v 'file-notify-error "File notification not supported for `%s'"
filename)))
+
+(defun tramp-handle-file-notify-rm-watch (proc)
+ "Like `file-notify-rm-watch' for Tramp files."
+ ;; The descriptor must be a process object.
+ (unless (processp proc)
+ (tramp-error proc 'file-notify-error "Not a valid descriptor %S" proc))
+ (tramp-message proc 6 "Kill %S" proc)
+ (delete-process proc))
+
+(defun tramp-handle-file-notify-valid-p (proc)
+ "Like `file-notify-valid-p' for Tramp files."
+ (and (process-live-p proc)
+ ;; Sometimes, the process is still in status `run' when the
+ ;; file or directory to be watched is deleted already.
+ (with-current-buffer (process-buffer proc)
+ (file-exists-p
+ (concat (file-remote-p default-directory)
+ (process-get proc 'watch-name))))))
+
+(defun tramp-file-notify-process-sentinel (proc event)
+ "Call `file-notify-rm-watch'."
+ (unless (process-live-p proc)
+ (tramp-message proc 5 "Sentinel called: `%S' `%s'" proc event)
+ (tramp-compat-funcall 'file-notify-rm-watch proc)))
+
+;;; Functions for establishing connection:
+
+;; The following functions are actions to be taken when seeing certain
+;; prompts from the remote host. See the variable
+;; `tramp-actions-before-shell' for usage of these functions.
+
+(defun tramp-action-login (_proc vec)
+ "Send the login name."
+ (let ((user (or (tramp-file-name-user vec)
+ (with-tramp-connection-property vec "login-as"
+ (save-window-excursion
+ (let ((enable-recursive-minibuffers t))
+ (pop-to-buffer (tramp-get-connection-buffer vec))
+ (read-string (match-string 0))))))))
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (tramp-message vec 6 "\n%s" (buffer-string)))
+ (tramp-message vec 3 "Sending login name `%s'" user)
+ (tramp-send-string vec (concat user tramp-local-end-of-line)))
+ t)
+
+(defun tramp-action-password (proc vec)
+ "Query the user for a password."
+ (with-current-buffer (process-buffer proc)
+ (let ((enable-recursive-minibuffers t)
+ (case-fold-search t))
+ ;; Let's check whether a wrong password has been sent already.
+ ;; Sometimes, the process returns a new password request
+ ;; immediately after rejecting the previous (wrong) one.
+ (unless (tramp-get-connection-property vec "first-password-request" nil)
+ (tramp-clear-passwd vec))
+ (goto-char (point-min))
+ (tramp-check-for-regexp proc tramp-password-prompt-regexp)
+ (tramp-message vec 3 "Sending %s" (match-string 1))
+ ;; We don't call `tramp-send-string' in order to hide the
+ ;; password from the debug buffer and the traces.
+ (process-send-string
+ proc (concat (tramp-read-passwd proc) tramp-local-end-of-line))
+ ;; Hide password prompt.
+ (narrow-to-region (point-max) (point-max))))
+ t)
+
+(defun tramp-action-succeed (_proc _vec)
+ "Signal success in finding shell prompt."
+ (throw 'tramp-action 'ok))
+
+(defun tramp-action-permission-denied (proc _vec)
+ "Signal permission denied."
+ (kill-process proc)
+ (throw 'tramp-action 'permission-denied))
+
+(defun tramp-action-yesno (proc vec)
+ "Ask the user for confirmation using `yes-or-no-p'.
+Send \"yes\" to remote process on confirmation, abort otherwise.
+See also `tramp-action-yn'."
+ (save-window-excursion
+ (let ((enable-recursive-minibuffers t))
+ (pop-to-buffer (tramp-get-connection-buffer vec))
+ (unless (yes-or-no-p (match-string 0))
+ (kill-process proc)
+ (throw 'tramp-action 'permission-denied))
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (tramp-message vec 6 "\n%s" (buffer-string)))
+ (tramp-send-string vec (concat "yes" tramp-local-end-of-line))))
+ t)
+
+(defun tramp-action-yn (proc vec)
+ "Ask the user for confirmation using `y-or-n-p'.
+Send \"y\" to remote process on confirmation, abort otherwise.
+See also `tramp-action-yesno'."
+ (save-window-excursion
+ (let ((enable-recursive-minibuffers t))
+ (pop-to-buffer (tramp-get-connection-buffer vec))
+ (unless (y-or-n-p (match-string 0))
+ (kill-process proc)
+ (throw 'tramp-action 'permission-denied))
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (tramp-message vec 6 "\n%s" (buffer-string)))
+ (tramp-send-string vec (concat "y" tramp-local-end-of-line))))
+ t)
+
+(defun tramp-action-terminal (_proc vec)
+ "Tell the remote host which terminal type to use.
+The terminal type can be configured with `tramp-terminal-type'."
+ (tramp-message vec 5 "Setting `%s' as terminal type." tramp-terminal-type)
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (tramp-message vec 6 "\n%s" (buffer-string)))
+ (tramp-send-string vec (concat tramp-terminal-type tramp-local-end-of-line))
+ t)
+
+(defun tramp-action-process-alive (proc _vec)
+ "Check, whether a process has finished."
+ (unless (process-live-p proc)
+ (throw 'tramp-action 'process-died)))
+
+(defun tramp-action-out-of-band (proc vec)
+ "Check, whether an out-of-band copy has finished."
+ ;; There might be pending output for the exit status.
+ (while (tramp-accept-process-output proc 0))
+ (cond ((and (not (process-live-p proc))
+ (zerop (process-exit-status proc)))
+ (tramp-message vec 3 "Process has finished.")
+ (throw 'tramp-action 'ok))
+ ((or (and (memq (process-status proc) '(stop exit))
+ (not (zerop (process-exit-status proc))))
+ (eq (process-status proc) 'signal))
+ ;; `scp' could have copied correctly, but set modes could have failed.
+ ;; This can be ignored.
+ (with-current-buffer (process-buffer proc)
+ (goto-char (point-min))
+ (if (re-search-forward tramp-operation-not-permitted-regexp nil t)
+ (progn
+ (tramp-message vec 5 "'set mode' error ignored.")
+ (tramp-message vec 3 "Process has finished.")
+ (throw 'tramp-action 'ok))
+ (tramp-message vec 3 "Process has died.")
+ (throw 'tramp-action 'out-of-band-failed))))
+ (t nil)))
+
+;;; Functions for processing the actions:
+
+(defun tramp-process-one-action (proc vec actions)
+ "Wait for output from the shell and perform one action.
+See `tramp-process-actions' for the format of ACTIONS."
+ (let ((case-fold-search t)
+ found todo item pattern action)
+ (while (not found)
+ ;; Reread output once all actions have been performed.
+ ;; Obviously, the output was not complete.
+ (while (tramp-accept-process-output proc 0))
+ (setq todo actions)
+ (while todo
+ (setq item (pop todo))
+ (setq pattern (format "\\(%s\\)\\'" (symbol-value (nth 0 item))))
+ (setq action (nth 1 item))
+ (tramp-message
+ vec 5 "Looking for regexp \"%s\" from remote shell" pattern)
+ (when (tramp-check-for-regexp proc pattern)
+ (tramp-message vec 5 "Call `%s'" (symbol-name action))
+ (setq found (funcall action proc vec)))))
+ found))
+
+(defun tramp-process-actions (proc vec pos actions &optional timeout)
+ "Perform ACTIONS until success or TIMEOUT.
+PROC and VEC indicate the remote connection to be used. POS, if
+set, is the starting point of the region to be deleted in the
+connection buffer.
+
+ACTIONS is a list of (PATTERN ACTION). The PATTERN should be a
+symbol, a variable. The value of this variable gives the regular
+expression to search for. Note that the regexp must match at the
+end of the buffer, \"\\'\" is implicitly appended to it.
+
+The ACTION should also be a symbol, but a function. When the
+corresponding PATTERN matches, the ACTION function is called.
+
+An ACTION function has two arguments (PROC VEC). If it returns
+nil, nothing has been done, and the next action shall be called.
+A non-nil return value indicates that the process output has been
+consumed, and new output shall be retrieved, before starting to
+process all ACTIONs, again. The same happens after calling the
+last ACTION.
+
+If an action determines, that all processing has been done (e.g.,
+because the shell prompt has been detected), it shall throw a
+result. The symbol `ok' means that all ACTIONs have been
+performed successfully. Any other value means an error."
+ ;; Enable `auth-source', unless "emacs -Q" has been called. We must
+ ;; use the "password-vector" property in case we have several hops.
+ (tramp-set-connection-property
+ (tramp-get-connection-property
+ proc "password-vector" (process-get proc 'vector))
+ "first-password-request" tramp-cache-read-persistent-data)
+ (save-restriction
+ (with-tramp-progress-reporter
+ proc 3 "Waiting for prompts from remote shell"
+ (let (exit)
+ (if timeout
+ (with-timeout (timeout (setq exit 'timeout))
+ (while (not exit)
+ (setq exit
+ (catch 'tramp-action
+ (tramp-process-one-action proc vec actions)))))
+ (while (not exit)
+ (setq exit
+ (catch 'tramp-action
+ (tramp-process-one-action proc vec actions)))))
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (widen)
+ (tramp-message vec 6 "\n%s" (buffer-string)))
+ (if (eq exit 'ok)
+ (ignore-errors (funcall tramp-password-save-function))
+ ;; Not successful.
+ (tramp-clear-passwd vec)
+ (delete-process proc)
+ (tramp-error-with-buffer
+ (tramp-get-connection-buffer vec) vec 'file-error
+ (cond
+ ((eq exit 'permission-denied) "Permission denied")
+ ((eq exit 'out-of-band-failed)
+ (format-message
+ "Copy failed, see buffer `%s' for details"
+ (tramp-get-connection-buffer vec)))
+ ((eq exit 'process-died)
+ (substitute-command-keys
+ (eval-when-compile
+ (concat
+ "Tramp failed to connect. If this happens repeatedly, try\n"
+ " `\\[tramp-cleanup-this-connection]'"))))
+ ((eq exit 'timeout)
+ (format-message
+ "Timeout reached, see buffer `%s' for details"
+ (tramp-get-connection-buffer vec)))
+ (t "Login failed")))))
+ (when (numberp pos)
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (let ((inhibit-read-only t)) (delete-region pos (point))))))))
+
+;;; Utility functions:
+
+(defun tramp-accept-process-output (proc &optional timeout)
+ "Like `accept-process-output' for Tramp processes.
+This is needed in order to hide `last-coding-system-used', which is set
+for process communication also."
+ (with-current-buffer (process-buffer proc)
+ (let ((inhibit-read-only t)
+ last-coding-system-used
+ result)
+ ;; JUST-THIS-ONE is set due to Bug#12145.
+ (tramp-message
+ proc 10 "%s %s %s %s\n%s"
+ proc timeout (process-status proc)
+ (with-local-quit
+ (setq result (accept-process-output proc timeout nil t)))
+ (buffer-string))
+ result)))
+
+(defun tramp-check-for-regexp (proc regexp)
+ "Check, whether REGEXP is contained in process buffer of PROC.
+Erase echoed commands if exists."
+ (with-current-buffer (process-buffer proc)
+ (goto-char (point-min))
+
+ ;; Check whether we need to remove echo output.
+ (when (and (tramp-get-connection-property proc "check-remote-echo" nil)
+ (re-search-forward tramp-echoed-echo-mark-regexp nil t))
+ (let ((begin (match-beginning 0)))
+ (when (re-search-forward tramp-echoed-echo-mark-regexp nil t)
+ ;; Discard echo from remote output.
+ (tramp-set-connection-property proc "check-remote-echo" nil)
+ (tramp-message proc 5 "echo-mark found")
+ (forward-line 1)
+ (delete-region begin (point))
+ (goto-char (point-min)))))
+
+ (when (or (not (tramp-get-connection-property proc "check-remote-echo"
nil))
+ ;; Sometimes, the echo string is suppressed on the remote side.
+ (not (string-equal
+ (substring-no-properties
+ tramp-echo-mark-marker
+ 0 (min tramp-echo-mark-marker-length (1- (point-max))))
+ (buffer-substring-no-properties
+ (point-min)
+ (min (+ (point-min) tramp-echo-mark-marker-length)
+ (point-max))))))
+ ;; No echo to be handled, now we can look for the regexp.
+ ;; Sometimes, lines are much too long, and we run into a "Stack
+ ;; overflow in regexp matcher". For example, //DIRED// lines of
+ ;; directory listings with some thousand files. Therefore, we
+ ;; look from the end.
+ (goto-char (point-max))
+ (ignore-errors (re-search-backward regexp nil t)))))
+
+(defun tramp-wait-for-regexp (proc timeout regexp)
+ "Wait for a REGEXP to appear from process PROC within TIMEOUT seconds.
+Expects the output of PROC to be sent to the current buffer. Returns
+the string that matched, or nil. Waits indefinitely if TIMEOUT is
+nil."
+ (with-current-buffer (process-buffer proc)
+ (let ((found (tramp-check-for-regexp proc regexp)))
+ (cond (timeout
+ (with-timeout (timeout)
+ (while (not found)
+ (tramp-accept-process-output proc)
+ (unless (process-live-p proc)
+ (tramp-error-with-buffer
+ nil proc 'file-error "Process has died"))
+ (setq found (tramp-check-for-regexp proc regexp)))))
+ (t
+ (while (not found)
+ (tramp-accept-process-output proc)
+ (unless (process-live-p proc)
+ (tramp-error-with-buffer
+ nil proc 'file-error "Process has died"))
+ (setq found (tramp-check-for-regexp proc regexp)))))
+ (tramp-message proc 6 "\n%s" (buffer-string))
+ (unless found
+ (if timeout
+ (tramp-error
+ proc 'file-error "[[Regexp `%s' not found in %d secs]]"
+ regexp timeout)
+ (tramp-error proc 'file-error "[[Regexp `%s' not found]]" regexp)))
+ found)))
+
+;; It seems that Tru64 Unix does not like it if long strings are sent
+;; to it in one go. (This happens when sending the Perl
+;; `file-attributes' implementation, for instance.) Therefore, we
+;; have this function which sends the string in chunks.
+(defun tramp-send-string (vec string)
+ "Send the STRING via connection VEC.
+
+The STRING is expected to use Unix line-endings, but the lines sent to
+the remote host use line-endings as defined in the variable
+`tramp-rsh-end-of-line'. The communication buffer is erased before sending."
+ (let* ((p (tramp-get-connection-process vec))
+ (chunksize (tramp-get-connection-property p "chunksize" nil)))
+ (unless p
+ (tramp-error
+ vec 'file-error "Can't send string to remote host -- not logged in"))
+ (tramp-set-connection-property p "last-cmd-time" (current-time))
+ (tramp-message vec 10 "%s" string)
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ ;; Clean up the buffer. We cannot call `erase-buffer' because
+ ;; narrowing might be in effect.
+ (let ((inhibit-read-only t)) (delete-region (point-min) (point-max)))
+ ;; Replace "\n" by `tramp-rsh-end-of-line'.
+ (setq string
+ (mapconcat
+ #'identity (split-string string "\n") tramp-rsh-end-of-line))
+ (unless (or (string= string "")
+ (string-equal (substring string -1) tramp-rsh-end-of-line))
+ (setq string (concat string tramp-rsh-end-of-line)))
+ ;; Send the string.
+ (with-local-quit
+ (if (and chunksize (not (zerop chunksize)))
+ (let ((pos 0)
+ (end (length string)))
+ (while (< pos end)
+ (tramp-message
+ vec 10 "Sending chunk from %s to %s"
+ pos (min (+ pos chunksize) end))
+ (process-send-string
+ p (substring string pos (min (+ pos chunksize) end)))
+ (setq pos (+ pos chunksize))))
+ (process-send-string p string))))))
+
+(defun tramp-process-sentinel (proc event)
+ "Flush file caches and remove shell prompt."
+ (unless (process-live-p proc)
+ (let ((vec (process-get proc 'vector))
+ (prompt (tramp-get-connection-property proc "prompt" nil)))
+ (when vec
+ (tramp-message vec 5 "Sentinel called: `%S' `%s'" proc event)
+ (tramp-flush-connection-properties proc)
+ (tramp-flush-directory-properties vec ""))
+ (goto-char (point-max))
+ (when (and prompt (re-search-backward (regexp-quote prompt) nil t))
+ (delete-region (point) (point-max))))))
+
+(defun tramp-get-inode (vec)
+ "Returns the virtual inode number.
+If it doesn't exist, generate a new one."
+ (with-tramp-file-property vec (tramp-file-name-localname vec) "inode"
+ (setq tramp-inodes (1+ tramp-inodes))))
+
+(defun tramp-get-device (vec)
+ "Returns the virtual device number.
+If it doesn't exist, generate a new one."
+ (with-tramp-connection-property (tramp-get-connection-process vec) "device"
+ (cons -1 (setq tramp-devices (1+ tramp-devices)))))
+
+;; Comparision of vectors is performed by `tramp-file-name-equal-p'.
+(defun tramp-equal-remote (file1 file2)
+ "Check, whether the remote parts of FILE1 and FILE2 are identical.
+The check depends on method, user and host name of the files. If
+one of the components is missing, the default values are used.
+The local file name parts of FILE1 and FILE2 are not taken into
+account.
+
+Example:
+
+ (tramp-equal-remote \"/ssh::/etc\" \"/-:<your host name>:/home\")
+
+would yield t. On the other hand, the following check results in nil:
+
+ (tramp-equal-remote \"/sudo::/etc\" \"/su::/etc\")"
+ (and (tramp-tramp-file-p file1)
+ (tramp-tramp-file-p file2)
+ (string-equal (file-remote-p file1) (file-remote-p file2))))
+
+(defun tramp-mode-string-to-int (mode-string)
+ "Converts a ten-letter `drwxrwxrwx'-style mode string into mode bits."
+ (let* (case-fold-search
+ (mode-chars (string-to-vector mode-string))
+ (owner-read (aref mode-chars 1))
+ (owner-write (aref mode-chars 2))
+ (owner-execute-or-setid (aref mode-chars 3))
+ (group-read (aref mode-chars 4))
+ (group-write (aref mode-chars 5))
+ (group-execute-or-setid (aref mode-chars 6))
+ (other-read (aref mode-chars 7))
+ (other-write (aref mode-chars 8))
+ (other-execute-or-sticky (aref mode-chars 9)))
+ (logior
+ (cond
+ ((char-equal owner-read ?r) #o0400)
+ ((char-equal owner-read ?-) 0)
+ (t (error "Second char `%c' must be one of `r-'" owner-read)))
+ (cond
+ ((char-equal owner-write ?w) #o0200)
+ ((char-equal owner-write ?-) 0)
+ (t (error "Third char `%c' must be one of `w-'" owner-write)))
+ (cond
+ ((char-equal owner-execute-or-setid ?x) #o0100)
+ ((char-equal owner-execute-or-setid ?S) #o4000)
+ ((char-equal owner-execute-or-setid ?s) #o4100)
+ ((char-equal owner-execute-or-setid ?-) 0)
+ (t (error "Fourth char `%c' must be one of `xsS-'"
+ owner-execute-or-setid)))
+ (cond
+ ((char-equal group-read ?r) #o0040)
+ ((char-equal group-read ?-) 0)
+ (t (error "Fifth char `%c' must be one of `r-'" group-read)))
+ (cond
+ ((char-equal group-write ?w) #o0020)
+ ((char-equal group-write ?-) 0)
+ (t (error "Sixth char `%c' must be one of `w-'" group-write)))
+ (cond
+ ((char-equal group-execute-or-setid ?x) #o0010)
+ ((char-equal group-execute-or-setid ?S) #o2000)
+ ((char-equal group-execute-or-setid ?s) #o2010)
+ ((char-equal group-execute-or-setid ?-) 0)
+ (t (error "Seventh char `%c' must be one of `xsS-'"
+ group-execute-or-setid)))
+ (cond
+ ((char-equal other-read ?r) #o0004)
+ ((char-equal other-read ?-) 0)
+ (t (error "Eighth char `%c' must be one of `r-'" other-read)))
+ (cond
+ ((char-equal other-write ?w) #o0002)
+ ((char-equal other-write ?-) 0)
+ (t (error "Ninth char `%c' must be one of `w-'" other-write)))
+ (cond
+ ((char-equal other-execute-or-sticky ?x) #o0001)
+ ((char-equal other-execute-or-sticky ?T) #o1000)
+ ((char-equal other-execute-or-sticky ?t) #o1001)
+ ((char-equal other-execute-or-sticky ?-) 0)
+ (t (error "Tenth char `%c' must be one of `xtT-'"
+ other-execute-or-sticky))))))
+
+(defconst tramp-file-mode-type-map
+ '((0 . "-") ; Normal file (SVID-v2 and XPG2)
+ (1 . "p") ; fifo
+ (2 . "c") ; character device
+ (3 . "m") ; multiplexed character device (v7)
+ (4 . "d") ; directory
+ (5 . "?") ; Named special file (XENIX)
+ (6 . "b") ; block device
+ (7 . "?") ; multiplexed block device (v7)
+ (8 . "-") ; regular file
+ (9 . "n") ; network special file (HP-UX)
+ (10 . "l") ; symlink
+ (11 . "?") ; ACL shadow inode (Solaris, not userspace)
+ (12 . "s") ; socket
+ (13 . "D") ; door special (Solaris)
+ (14 . "w")) ; whiteout (BSD)
+ "A list of file types returned from the `stat' system call.
+This is used to map a mode number to a permission string.")
+
+(defun tramp-file-mode-from-int (mode)
+ "Turn an integer representing a file mode into an ls(1)-like string."
+ (let ((type (cdr
+ (assoc (logand (ash mode -12) 15) tramp-file-mode-type-map)))
+ (user (logand (ash mode -6) 7))
+ (group (logand (ash mode -3) 7))
+ (other (logand (ash mode -0) 7))
+ (suid (> (logand (ash mode -9) 4) 0))
+ (sgid (> (logand (ash mode -9) 2) 0))
+ (sticky (> (logand (ash mode -9) 1) 0)))
+ (setq user (tramp-file-mode-permissions user suid "s"))
+ (setq group (tramp-file-mode-permissions group sgid "s"))
+ (setq other (tramp-file-mode-permissions other sticky "t"))
+ (concat type user group other)))
+
+(defun tramp-file-mode-permissions (perm suid suid-text)
+ "Convert a permission bitset into a string.
+This is used internally by `tramp-file-mode-from-int'."
+ (let ((r (> (logand perm 4) 0))
+ (w (> (logand perm 2) 0))
+ (x (> (logand perm 1) 0)))
+ (concat (or (and r "r") "-")
+ (or (and w "w") "-")
+ (or (and suid x suid-text) ; suid, execute
+ (and suid (upcase suid-text)) ; suid, !execute
+ (and x "x") "-")))) ; !suid
+
+;; This is a Tramp internal function. A general `set-file-uid-gid'
+;; outside Tramp is not needed, I believe.
+(defun tramp-set-file-uid-gid (filename &optional uid gid)
+ "Set the ownership for FILENAME.
+If UID and GID are provided, these values are used; otherwise uid
+and gid of the corresponding remote or local user is taken,
+depending whether FILENAME is remote or local. Both parameters
+must be non-negative integers.
+The setgid bit of the upper directory is respected.
+If FILENAME is remote, a file name handler is called."
+ (let* ((dir (file-name-directory filename))
+ (modes (file-modes dir)))
+ (when (and modes (not (zerop (logand modes #o2000))))
+ (setq gid (tramp-compat-file-attribute-group-id (file-attributes dir)))))
+
+ (let ((handler (find-file-name-handler filename 'tramp-set-file-uid-gid)))
+ (if handler
+ (funcall handler #'tramp-set-file-uid-gid filename uid gid)
+ ;; On W32 "chown" does not work.
+ (unless (memq system-type '(ms-dos windows-nt))
+ (let ((uid (or (and (natnump uid) uid) (tramp-get-local-uid 'integer)))
+ (gid (or (and (natnump gid) gid) (tramp-get-local-gid 'integer))))
+ (tramp-call-process
+ nil "chown" nil nil nil
+ (format "%d:%d" uid gid) (shell-quote-argument filename)))))))
+
+(defun tramp-get-local-uid (id-format)
+ "The uid of the local user, in ID-FORMAT.
+ID-FORMAT valid values are `string' and `integer'."
+ ;; We use key nil for local connection properties.
+ (with-tramp-connection-property nil (format "uid-%s" id-format)
+ (if (equal id-format 'integer) (user-uid) (user-login-name))))
+
+(defun tramp-get-local-gid (id-format)
+ "The gid of the local user, in ID-FORMAT.
+ID-FORMAT valid values are `string' and `integer'."
+ ;; We use key nil for local connection properties.
+ (with-tramp-connection-property nil (format "gid-%s" id-format)
+ (cond
+ ;; `group-gid' has been introduced with Emacs 24.4.
+ ((and (fboundp 'group-gid) (equal id-format 'integer))
+ (tramp-compat-funcall 'group-gid))
+ ;; `group-name' has been introduced with Emacs 27.1.
+ ((and (fboundp 'group-name) (equal id-format 'string))
+ (tramp-compat-funcall 'group-name (tramp-compat-funcall 'group-gid)))
+ ((tramp-compat-file-attribute-group-id
+ (file-attributes "~/" id-format))))))
+
+(defun tramp-get-local-locale (&optional vec)
+ "Determine locale, supporting UTF8 if possible.
+VEC is used for tracing."
+ ;; We use key nil for local connection properties.
+ (with-tramp-connection-property nil "locale"
+ (let ((candidates '("en_US.utf8" "C.utf8" "en_US.UTF-8"))
+ locale)
+ (with-temp-buffer
+ (unless (or (memq system-type '(windows-nt))
+ (not (zerop (tramp-call-process
+ nil "locale" nil t nil "-a"))))
+ (while candidates
+ (goto-char (point-min))
+ (if (string-match-p
+ (format "^%s\r?$" (regexp-quote (car candidates)))
+ (buffer-string))
+ (setq locale (car candidates)
+ candidates nil)
+ (setq candidates (cdr candidates))))))
+ ;; Return value.
+ (when vec (tramp-message vec 7 "locale %s" (or locale "C")))
+ (or locale "C"))))
+
+(defun tramp-check-cached-permissions (vec access)
+ "Check `file-attributes' caches for VEC.
+Return t if according to the cache access type ACCESS is known to
+be granted."
+ (let ((result nil)
+ (offset (cond
+ ((eq ?r access) 1)
+ ((eq ?w access) 2)
+ ((eq ?x access) 3))))
+ (dolist (suffix '("string" "integer") result)
+ (setq
+ result
+ (or
+ result
+ (let ((file-attr
+ (or
+ (tramp-get-file-property
+ vec (tramp-file-name-localname vec)
+ (concat "file-attributes-" suffix) nil)
+ (file-attributes
+ (tramp-make-tramp-file-name vec) (intern suffix))))
+ (remote-uid
+ (tramp-get-connection-property
+ vec (concat "uid-" suffix) nil))
+ (remote-gid
+ (tramp-get-connection-property
+ vec (concat "gid-" suffix) nil))
+ (unknown-id
+ (if (string-equal suffix "string")
+ tramp-unknown-id-string tramp-unknown-id-integer)))
+ (and
+ file-attr
+ (or
+ ;; Not a symlink.
+ (eq t (tramp-compat-file-attribute-type file-attr))
+ (null (tramp-compat-file-attribute-type file-attr)))
+ (or
+ ;; World accessible.
+ (eq access
+ (aref (tramp-compat-file-attribute-modes file-attr)
+ (+ offset 6)))
+ ;; User accessible and owned by user.
+ (and
+ (eq access
+ (aref (tramp-compat-file-attribute-modes file-attr) offset))
+ (or (equal remote-uid
+ (tramp-compat-file-attribute-user-id file-attr))
+ (equal unknown-id
+ (tramp-compat-file-attribute-user-id file-attr))))
+ ;; Group accessible and owned by user's principal group.
+ (and
+ (eq access
+ (aref (tramp-compat-file-attribute-modes file-attr)
+ (+ offset 3)))
+ (or (equal remote-gid
+ (tramp-compat-file-attribute-group-id file-attr))
+ (equal unknown-id
+ (tramp-compat-file-attribute-group-id
+ file-attr))))))))))))
+
+(defun tramp-local-host-p (vec)
+ "Return t if this points to the local host, nil otherwise.
+This handles also chrooted environments, which are not regarded as local."
+ (let ((host (tramp-file-name-host vec))
+ (port (tramp-file-name-port vec)))
+ (and
+ (stringp tramp-local-host-regexp) (stringp host)
+ (string-match-p tramp-local-host-regexp host)
+ ;; A port is an indication for an ssh tunnel or alike.
+ (null port)
+ ;; The method shall be applied to one of the shell file name
+ ;; handlers. `tramp-local-host-p' is also called for "smb" and
+ ;; alike, where it must fail.
+ (tramp-get-method-parameter vec 'tramp-login-program)
+ ;; The local temp directory must be writable for the other user.
+ (file-writable-p
+ (tramp-make-tramp-file-name
+ vec (tramp-compat-temporary-file-directory) 'nohop))
+ ;; On some systems, chown runs only for root.
+ (or (zerop (user-uid))
+ ;; This is defined in tramp-sh.el. Let's assume this is
+ ;; loaded already.
+ (zerop (tramp-compat-funcall 'tramp-get-remote-uid vec 'integer))))))
+
+(defun tramp-get-remote-tmpdir (vec)
+ "Return directory for temporary files on the remote host identified by VEC."
+ (with-tramp-connection-property vec "tmpdir"
+ (let ((dir
+ (tramp-make-tramp-file-name
+ vec (or (tramp-get-method-parameter vec 'tramp-tmpdir) "/tmp"))))
+ (or (and (file-directory-p dir) (file-writable-p dir)
+ (tramp-compat-file-local-name dir))
+ (tramp-error vec 'file-error "Directory %s not accessible" dir))
+ dir)))
+
+(defun tramp-make-tramp-temp-file (vec)
+ "Create a temporary file on the remote host identified by VEC.
+Return the local name of the temporary file."
+ (let ((prefix (expand-file-name
+ tramp-temp-name-prefix (tramp-get-remote-tmpdir vec)))
+ result)
+ (while (not result)
+ ;; `make-temp-file' would be the natural choice for
+ ;; implementation. But it calls `write-region' internally,
+ ;; which also needs a temporary file - we would end in an
+ ;; infinite loop.
+ (setq result (make-temp-name prefix))
+ (if (file-exists-p result)
+ (setq result nil)
+ ;; This creates the file by side effect.
+ (set-file-times result)
+ (set-file-modes result #o0700)))
+
+ ;; Return the local part.
+ (with-parsed-tramp-file-name result nil localname)))
+
+(defun tramp-delete-temp-file-function ()
+ "Remove temporary files related to current buffer."
+ (when (stringp tramp-temp-buffer-file-name)
+ (ignore-errors (delete-file tramp-temp-buffer-file-name))))
+
+(add-hook 'kill-buffer-hook #'tramp-delete-temp-file-function)
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (remove-hook 'kill-buffer-hook
+ #'tramp-delete-temp-file-function)))
+
+(defun tramp-handle-make-auto-save-file-name ()
+ "Like `make-auto-save-file-name' for Tramp files.
+Returns a file name in `tramp-auto-save-directory' for autosaving
+this file, if that variable is non-nil."
+ (when (stringp tramp-auto-save-directory)
+ (setq tramp-auto-save-directory
+ (expand-file-name tramp-auto-save-directory)))
+ ;; Create directory.
+ (unless (or (null tramp-auto-save-directory)
+ (file-exists-p tramp-auto-save-directory))
+ (make-directory tramp-auto-save-directory t))
+
+ (let ((system-type
+ (if (and (stringp tramp-auto-save-directory)
+ (file-remote-p tramp-auto-save-directory))
+ 'not-windows
+ system-type))
+ (auto-save-file-name-transforms
+ (if (null tramp-auto-save-directory)
+ auto-save-file-name-transforms))
+ (buffer-file-name
+ (if (null tramp-auto-save-directory)
+ buffer-file-name
+ (expand-file-name
+ (tramp-subst-strs-in-string
+ '(("_" . "|")
+ ("/" . "_a")
+ (":" . "_b")
+ ("|" . "__")
+ ("[" . "_l")
+ ("]" . "_r"))
+ (tramp-compat-file-name-unquote (buffer-file-name)))
+ tramp-auto-save-directory))))
+ ;; Run plain `make-auto-save-file-name'.
+ (tramp-run-real-handler #'make-auto-save-file-name nil)))
+
+(defun tramp-subst-strs-in-string (alist string)
+ "Replace all occurrences of the string FROM with TO in STRING.
+ALIST is of the form ((FROM . TO) ...)."
+ (save-match-data
+ (while alist
+ (let* ((pr (car alist))
+ (from (car pr))
+ (to (cdr pr)))
+ (while (string-match (regexp-quote from) string)
+ (setq string (replace-match to t t string)))
+ (setq alist (cdr alist))))
+ string))
+
+(defun tramp-handle-temporary-file-directory ()
+ "Like `temporary-file-directory' for Tramp files."
+ (catch 'result
+ (dolist (dir `(,(ignore-errors
+ (tramp-get-remote-tmpdir
+ (tramp-dissect-file-name default-directory)))
+ ,default-directory))
+ (when (and (stringp dir) (file-directory-p dir) (file-writable-p dir))
+ (throw 'result (expand-file-name dir))))))
+
+(defun tramp-handle-make-nearby-temp-file (prefix &optional dir-flag suffix)
+ "Like `make-nearby-temp-file' for Tramp files."
+ (let ((temporary-file-directory
+ (tramp-compat-temporary-file-directory-function)))
+ (make-temp-file prefix dir-flag suffix)))
+
+;;; Compatibility functions section:
+
+(defun tramp-call-process
+ (vec program &optional infile destination display &rest args)
+ "Calls `call-process' on the local host.
+It always returns a return code. The Lisp error raised when
+PROGRAM is nil is trapped also, returning 1. Furthermore, traces
+are written with verbosity of 6."
+ (let ((default-directory (tramp-compat-temporary-file-directory))
+ (destination (if (eq destination t) (current-buffer) destination))
+ (vec (or vec (car tramp-current-connection)))
+ output error result)
+ (tramp-message
+ vec 6 "`%s %s' %s %s"
+ program (mapconcat #'identity args " ") infile destination)
+ (condition-case err
+ (with-temp-buffer
+ (setq result
+ (apply
+ #'call-process program infile (or destination t) display args))
+ ;; `result' could also be an error string.
+ (when (stringp result)
+ (setq error result
+ result 1))
+ (with-current-buffer
+ (if (bufferp destination) destination (current-buffer))
+ (setq output (buffer-string))))
+ (error
+ (setq error (error-message-string err)
+ result 1)))
+ (if (zerop (length error))
+ (tramp-message vec 6 "%d\n%s" result output)
+ (tramp-message vec 6 "%d\n%s\n%s" result output error))
+ result))
+
+(defun tramp-call-process-region
+ (vec start end program &optional delete buffer display &rest args)
+ "Calls `call-process-region' on the local host.
+It always returns a return code. The Lisp error raised when
+PROGRAM is nil is trapped also, returning 1. Furthermore, traces
+are written with verbosity of 6."
+ (let ((default-directory (tramp-compat-temporary-file-directory))
+ (buffer (if (eq buffer t) (current-buffer) buffer))
+ result)
+ (tramp-message
+ vec 6 "`%s %s' %s %s %s %s"
+ program (mapconcat #'identity args " ") start end delete buffer)
+ (condition-case err
+ (progn
+ (setq result
+ (apply
+ #'call-process-region
+ start end program delete buffer display args))
+ ;; `result' could also be an error string.
+ (when (stringp result)
+ (signal 'file-error (list result)))
+ (with-current-buffer (if (bufferp buffer) buffer (current-buffer))
+ (if (zerop result)
+ (tramp-message vec 6 "%d" result)
+ (tramp-message vec 6 "%d\n%s" result (buffer-string)))))
+ (error
+ (setq result 1)
+ (tramp-message vec 6 "%d\n%s" result (error-message-string err))))
+ result))
+
+(defun tramp-process-lines
+ (vec program &rest args)
+ "Calls `process-lines' on the local host.
+If an error occurs, it returns nil. Traces are written with
+verbosity of 6."
+ (let ((default-directory (tramp-compat-temporary-file-directory))
+ (vec (or vec (car tramp-current-connection)))
+ result)
+ (if args
+ (tramp-message vec 6 "%s %s" program (mapconcat #'identity args " "))
+ (tramp-message vec 6 "%s" program))
+ (setq result
+ (condition-case err
+ (apply #'process-lines program args)
+ (error
+ (tramp-error vec (car err) (cdr err)))))
+ (tramp-message vec 6 "%s" result)
+ result))
+
+(defun tramp-read-passwd (proc &optional prompt)
+ "Read a password from user (compat function).
+Consults the auth-source package.
+Invokes `password-read' if available, `read-passwd' else."
+ (let* ((case-fold-search t)
+ (key (tramp-make-tramp-file-name
+ ;; In tramp-sh.el, we must use "password-vector" due to
+ ;; multi-hop.
+ (tramp-get-connection-property
+ proc "password-vector" (process-get proc 'vector))
+ 'noloc 'nohop))
+ (pw-prompt
+ (or prompt
+ (with-current-buffer (process-buffer proc)
+ (tramp-check-for-regexp proc tramp-password-prompt-regexp)
+ (format "%s for %s " (capitalize (match-string 1)) key))))
+ (auth-source-creation-prompts `((secret . ,pw-prompt)))
+ ;; We suspend the timers while reading the password.
+ (stimers (with-timeout-suspend))
+ auth-info auth-passwd)
+
+ (unwind-protect
+ (with-parsed-tramp-file-name key nil
+ (setq tramp-password-save-function nil
+ user
+ (or user (tramp-get-connection-property key "login-as" nil)))
+ (prog1
+ (or
+ ;; See if auth-sources contains something useful.
+ (ignore-errors
+ (and (tramp-get-connection-property
+ v "first-password-request" nil)
+ ;; Try with Tramp's current method.
+ (setq auth-info
+ (car
+ (auth-source-search
+ :max 1
+ (and user :user)
+ (if domain
+ (concat
+ user tramp-prefix-domain-format domain)
+ user)
+ :host
+ (if port
+ (concat
+ host tramp-prefix-port-format port)
+ host)
+ :port method
+ :require (cons :secret (and user '(:user)))
+ :create t))
+ tramp-password-save-function
+ (plist-get auth-info :save-function)
+ auth-passwd (plist-get auth-info :secret)))
+ (while (functionp auth-passwd)
+ (setq auth-passwd (funcall auth-passwd)))
+ auth-passwd)
+
+ ;; Try the password cache.
+ (progn
+ (setq auth-passwd (password-read pw-prompt key)
+ tramp-password-save-function
+ (lambda () (password-cache-add key auth-passwd)))
+ auth-passwd)
+
+ ;; Else, get the password interactively w/o cache.
+ (read-passwd pw-prompt))
+
+ (tramp-set-connection-property v "first-password-request" nil)))
+
+ ;; Reenable the timers.
+ (with-timeout-unsuspend stimers))))
+
+(defun tramp-clear-passwd (vec)
+ "Clear password cache for connection related to VEC."
+ (let ((method (tramp-file-name-method vec))
+ (user-domain (tramp-file-name-user-domain vec))
+ (host-port (tramp-file-name-host-port vec))
+ (hop (tramp-file-name-hop vec)))
+ (when hop
+ ;; Clear also the passwords of the hops.
+ (tramp-clear-passwd (tramp-dissect-hop-name hop)))
+ (auth-source-forget
+ `(:max 1 ,(and user-domain :user) ,user-domain
+ :host ,host-port :port ,method))
+ (password-cache-remove (tramp-make-tramp-file-name vec 'noloc 'nohop))))
+
+(defun tramp-time-diff (t1 t2)
+ "Return the difference between the two times, in seconds.
+T1 and T2 are time values (as returned by `current-time' for example)."
+ (float-time (time-subtract t1 t2)))
+
+(defun tramp-unquote-shell-quote-argument (s)
+ "Remove quotation prefix \"/:\" from string S, and quote it then for shell."
+ (shell-quote-argument (tramp-compat-file-name-unquote s)))
+
+;; Currently (as of Emacs 20.5), the function `shell-quote-argument'
+;; does not deal well with newline characters. Newline is replaced by
+;; backslash newline. But if, say, the string `a backslash newline b'
+;; is passed to a shell, the shell will expand this into "ab",
+;; completely omitting the newline. This is not what was intended.
+;; It does not appear to be possible to make the function
+;; `shell-quote-argument' work with newlines without making it
+;; dependent on the shell used. But within this package, we know that
+;; we will always use a Bourne-like shell, so we use an approach which
+;; groks newlines.
+;;
+;; The approach is simple: we call `shell-quote-argument', then
+;; massage the newline part of the result.
+;;
+;; This function should produce a string which is grokked by a Unix
+;; shell, even if the Emacs is running on Windows. Since this is the
+;; kludges section, we bind `system-type' in such a way that
+;; `shell-quote-argument' behaves as if on Unix.
+;;
+;; Thanks to Mario DeWeerd for the hint that it is sufficient for this
+;; function to work with Bourne-like shells.
+(defun tramp-shell-quote-argument (s)
+ "Similar to `shell-quote-argument', but groks newlines.
+Only works for Bourne-like shells."
+ (let ((system-type 'not-windows))
+ (save-match-data
+ (let ((result (tramp-unquote-shell-quote-argument s))
+ (nl (regexp-quote (format "\\%s" tramp-rsh-end-of-line))))
+ (when (and (>= (length result) 2)
+ (string= (substring result 0 2) "\\~"))
+ (setq result (substring result 1)))
+ (while (string-match nl result)
+ (setq result (replace-match (format "'%s'" tramp-rsh-end-of-line)
+ t t result)))
+ result))))
+
+;;; Signal handling. This works for remote processes, which have set
+;;; the process property `remote-pid'.
+
+(defun tramp-interrupt-process (&optional process _current-group)
+ "Interrupt remote process PROC."
+ ;; CURRENT-GROUP is not implemented yet.
+ (let ((proc (cond
+ ((processp process) process)
+ ((bufferp process) (get-buffer-process process))
+ ((stringp process) (or (get-process process)
+ (get-buffer-process process)))
+ ((null process) (get-buffer-process (current-buffer)))
+ (t process)))
+ pid)
+ ;; If it's a Tramp process, send the INT signal remotely.
+ (when (and (processp proc) (setq pid (process-get proc 'remote-pid)))
+ (if (not (process-live-p proc))
+ (tramp-error proc 'error "Process %s is not active" proc)
+ (tramp-message proc 5 "Interrupt process %s with pid %s" proc pid)
+ ;; This is for tramp-sh.el. Other backends do not support this (yet).
+ (tramp-compat-funcall
+ 'tramp-send-command
+ (process-get proc 'vector)
+ (format "kill -2 -%d" pid))
+ ;; Wait, until the process has disappeared. If it doesn't,
+ ;; fall back to the default implementation.
+ (while (tramp-accept-process-output proc 0))
+ (not (process-live-p proc))))))
+
+;; `interrupt-process-functions' exists since Emacs 26.1.
+(when (boundp 'interrupt-process-functions)
+ (add-hook 'interrupt-process-functions #'tramp-interrupt-process)
+ (add-hook
+ 'tramp-unload-hook
+ (lambda ()
+ (remove-hook 'interrupt-process-functions #'tramp-interrupt-process))))
+
+;; Checklist for `tramp-unload-hook'
+;; - Unload all `tramp-*' packages
+;; - Reset `file-name-handler-alist'
+;; - Cleanup hooks where Tramp functions are in
+;; - Cleanup autoloads
+;;;###autoload
+(defun tramp-unload-tramp ()
+ "Discard Tramp from loading remote files."
+ (interactive)
+ ;; ange-ftp settings must be re-enabled.
+ (tramp-compat-funcall 'tramp-ftp-enable-ange-ftp)
+ ;; Maybe it's not loaded yet.
+ (ignore-errors (unload-feature 'tramp 'force)))
+
+(provide 'tramp)
+
+(run-hooks 'tramp--startup-hook)
+(setq tramp--startup-hook nil)
+
+;;; TODO:
+;;
+;; * Avoid screen blanking when hitting `g' in dired. (Eli Tziperman)
+;;
+;; * Better error checking. At least whenever we see something
+;; strange when doing zerop, we should kill the process and start
+;; again. (Greg Stark)
+;;
+;; * I was wondering if it would be possible to use tramp even if I'm
+;; actually using sshfs. But when I launch a command I would like
+;; to get it executed on the remote machine where the files really
+;; are. (Andrea Crotti)
+;;
+;; * Run emerge on two remote files. Bug is described here:
+;; <https://www.mail-archive.com/address@hidden/msg01041.html>.
+;; (Bug#6850)
+;;
+;; * Refactor code from different handlers. Start with
+;; *-process-file. One idea is to generalize `tramp-send-command'
+;; and friends, for most of the handlers this is the major
+;; difference between the different backends. Other handlers but
+;; *-process-file would profit from this as well.
+;;
+;; * Get rid of `shell-command'. In its primary implementation, it
+;; uses `process-file-shell-command' and
+;; `start-file-process-shell-command', which is sufficient due to
+;; connection-local `shell-file-name'.
+
+
+;;; tramp.el ends here
+
+;; Local Variables:
+;; mode: Emacs-Lisp
+;; coding: utf-8
+;; End:
diff --git a/tramp.info b/tramp.info
new file mode 100644
index 0000000..0d026cb
--- /dev/null
+++ b/tramp.info
@@ -0,0 +1,4597 @@
+This is tramp, produced by makeinfo version 6.5 from tramp.texi.
+
+Copyright © 1999–2019 Free Software Foundation, Inc.
+
+ Permission is granted to copy, distribute and/or modify this
+ document under the terms of the GNU Free Documentation License,
+ Version 1.3 or any later version published by the Free Software
+ Foundation; with no Invariant Sections, with the Front-Cover Texts
+ being “A GNU Manual”, and with the Back-Cover Texts as in (a)
+ below. A copy of the license is included in the section entitled
+ “GNU Free Documentation License”.
+
+ (a) The FSF’s Back-Cover Text is: “You have the freedom to copy and
+ modify this GNU manual.”
+INFO-DIR-SECTION Emacs network features
+START-INFO-DIR-ENTRY
+* Tramp: (tramp). Transparent Remote Access, Multiple Protocol
+ Emacs remote file access via ssh and scp.
+END-INFO-DIR-ENTRY
+
+
+File: tramp, Node: Top, Next: Overview, Prev: (dir), Up: (dir)
+
+TRAMP 2.4.2-pre User Manual
+***************************
+
+This file documents TRAMP 2.4.2-pre, a remote file editing package for
+Emacs.
+
+ TRAMP stands for “Transparent Remote (file) Access, Multiple
+Protocol”. This package provides remote file editing, similar to Ange
+FTP.
+
+ The difference is that Ange FTP uses FTP to transfer files between
+the local and the remote host, whereas TRAMP uses a combination of ‘rsh’
+and ‘rcp’ or other work-alike programs, such as ‘ssh’/‘scp’.
+
+ You can find the latest version of this document on the web at
+<https://www.gnu.org/software/tramp/>.
+
+ There is a mailing list for TRAMP, available at
+<address@hidden>, and archived at the TRAMP Mail Archive
+(https://lists.gnu.org/r/tramp-devel/).
+
+ Copyright © 1999–2019 Free Software Foundation, Inc.
+
+ Permission is granted to copy, distribute and/or modify this
+ document under the terms of the GNU Free Documentation License,
+ Version 1.3 or any later version published by the Free Software
+ Foundation; with no Invariant Sections, with the Front-Cover Texts
+ being “A GNU Manual”, and with the Back-Cover Texts as in (a)
+ below. A copy of the license is included in the section entitled
+ “GNU Free Documentation License”.
+
+ (a) The FSF’s Back-Cover Text is: “You have the freedom to copy and
+ modify this GNU manual.”
+
+* Menu:
+
+* Overview:: What TRAMP can and cannot do.
+
+For the end user:
+
+* Obtaining TRAMP:: How to obtain TRAMP.
+* Installation:: Installing TRAMP with your Emacs.
+* Quick Start Guide:: Short introduction how to use TRAMP.
+* Configuration:: Configuring TRAMP for use.
+* Usage:: An overview of the operation of TRAMP.
+* Bug Reports:: Reporting Bugs and Problems.
+* Frequently Asked Questions:: Questions and answers from the mailing list.
+
+For the developer:
+
+* Files directories and localnames::
+ How file names, directories and localnames
+ are mangled and managed.
+* Traces and Profiles:: How to Customize Traces.
+
+* GNU Free Documentation License:: The license for this documentation.
+* Function Index:: TRAMP functions.
+* Variable Index:: User options and variables.
+* Concept Index:: An item for each concept.
+
+ — The Detailed Node Listing —
+
+Installing TRAMP with your Emacs
+
+* System Requirements:: Prerequisites for TRAMP installation.
+* Basic Installation:: Installation steps.
+* Installation parameters:: Parameters in order to control installation.
+* Testing:: A test suite for TRAMP.
+* Load paths:: How to plug-in TRAMP into your environment.
+
+Configuring TRAMP for use
+
+* Connection types:: Types of connections to remote hosts.
+* Inline methods:: Inline methods.
+* External methods:: External methods.
+* GVFS based methods:: GVFS based external methods.
+* Default Method:: Selecting a default method.
+* Default User:: Selecting a default user.
+* Default Host:: Selecting a default host.
+* Multi-hops:: Connecting to a remote host using multiple
hops.
+* Firewalls:: Passing firewalls.
+* Customizing Methods:: Using Non-Standard Methods.
+* Customizing Completion:: Selecting config files for user/host name
completion.
+* Password handling:: Reusing passwords for several connections.
+* Connection caching:: Reusing connection related information.
+* Predefined connection information::
+ Setting own connection related information.
+* Remote programs:: How TRAMP finds and uses programs on the
remote host.
+* Remote shell setup:: Remote shell setup hints.
+* Android shell setup:: Android shell setup hints.
+* Auto-save and Backup:: Auto-save and Backup.
+* Windows setup hints:: Issues with Cygwin ssh.
+
+Using TRAMP
+
+* File name syntax:: TRAMP file name conventions.
+* Change file name syntax:: Alternative file name syntax.
+* File name completion:: File name completion.
+* 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
+
+* Localname deconstruction:: Breaking a localname into its components.
+* External packages:: Integration with external Lisp packages.
+
+
+
+File: tramp, Node: Overview, Next: Obtaining TRAMP, Up: Top
+
+1 An overview of TRAMP
+**********************
+
+TRAMP is for transparently accessing remote files from within Emacs.
+TRAMP enables an easy, convenient, and consistent interface to remote
+files as if they are local files. TRAMP’s transparency extends to
+editing, version control, and ‘dired’.
+
+ TRAMP can access remote hosts using any number of access methods,
+such as ‘rsh’, ‘rlogin’, ‘telnet’, and related programs. If these
+programs can successfully pass ASCII characters, TRAMP can use them.
+TRAMP does not require or mandate 8-bit clean connections.
+
+ TRAMP’s most common access method is through ‘ssh’, a more secure
+alternative to ‘ftp’ and other older access methods.
+
+ TRAMP on MS Windows operating systems is integrated with the PuTTY
+package, and uses the ‘plink’ program.
+
+ TRAMP mostly operates transparently in the background using the
+connection programs. As long as these programs enable remote login and
+can use the terminal, TRAMP can adapt them for seamless and transparent
+access.
+
+ TRAMP temporarily transfers a remote file’s contents to the local
+host editing and related operations. TRAMP can also transfer files
+between hosts using standard Emacs interfaces, a benefit of direct
+integration of TRAMP in Emacs.
+
+ TRAMP can transfer files using any number of available host programs
+for remote files, such as ‘rcp’, ‘scp’, ‘rsync’ or (under MS Windows)
+‘pscp’. TRAMP provides easy ways to specify these programs and
+customize them to specific files, hosts, or access methods.
+
+ For faster small-size file transfers, TRAMP supports encoded
+transfers directly through the shell using ‘mimencode’ or ‘uuencode’
+provided such tools are available on the remote host.
+
+TRAMP behind the scenes
+.......................
+
+Accessing a remote file through TRAMP entails a series of actions, many
+of which are transparent to the user. Yet some actions may require user
+response (such as entering passwords or completing file names). One
+typical scenario, opening a file on a remote host, is presented here to
+illustrate the steps involved:
+
+ ‘C-x C-f’ to initiate find-file, enter part of the TRAMP file name,
+then hit ‘<TAB>’ for completion. If this is the first time connection
+to that host, here’s what happens:
+
+ • TRAMP invokes ‘telnet HOST’ or ‘rsh HOST -l USER’ and establishes
+ an external process to connect to the remote host. TRAMP
+ communicates with the process through an Emacs buffer, which also
+ shows output from the remote host.
+
+ • The remote host may prompt for a login name (for ‘telnet’, for
+ example) in the buffer. If on the other hand, the login name was
+ included in the file name portion, TRAMP sends the login name
+ followed by a newline.
+
+ • The remote host may then prompt for a password or pass phrase (for
+ ‘rsh’ or for ‘telnet’). TRAMP displays the password prompt in the
+ minibuffer. TRAMP then sends whatever is entered to the remote
+ host, followed by a newline.
+
+ • TRAMP now waits for either the shell prompt or a failed login
+ message.
+
+ If TRAMP does not receive any messages within a timeout period (a
+ minute, for example), then TRAMP responds with an error message
+ about not finding the remote shell prompt. If any messages from
+ the remote host, TRAMP displays them in the buffer.
+
+ For any ‘login failed’ message from the remote host, TRAMP aborts
+ the login attempt, and repeats the login steps again.
+
+ • Upon successful login and TRAMP recognizes the shell prompt from
+ the remote host, TRAMP prepares the shell environment by turning
+ off echoing, setting shell prompt, and other housekeeping chores.
+
+ *Note* that for the remote shell, TRAMP invokes ‘/bin/sh’. The
+ remote host must recognize ‘exec /bin/sh’ and execute the
+ appropriate shell. This shell must support Bourne shell syntax.
+
+ • TRAMP executes ‘cd’ and ‘ls’ commands to find which files exist on
+ the remote host. TRAMP sometimes uses ‘echo’ with globbing. TRAMP
+ checks if a file or directory is writable with ‘test’. After each
+ command, TRAMP parses the output from the remote host for
+ completing the next operation.
+
+ • After remote file name completion, TRAMP transfers the file
+ contents from the remote host.
+
+ For inline transfers, TRAMP sends a command, such as ‘mimencode -b
+ /path/to/remote/file’, waits until the output has accumulated in
+ the buffer, decodes that output to produce the file’s contents.
+
+ For external transfers, TRAMP sends a command as follows:
+ rcp address@hidden:/path/to/remote/file /tmp/tramp.4711
+ TRAMP reads the local temporary file ‘/tmp/tramp.4711’ into a
+ buffer, and then deletes the temporary file.
+
+ • Edit, modify, change the buffer contents as normal, and then save
+ the buffer with ‘C-x C-s’.
+
+ • TRAMP transfers the buffer contents to the remote host in a reverse
+ of the process using the appropriate inline or external program.
+
+ I hope this has provided you with a basic overview of what happens
+behind the scenes when you open a file with TRAMP.
+
+
+File: tramp, Node: Obtaining TRAMP, Next: Installation, Prev: Overview,
Up: Top
+
+2 Obtaining TRAMP
+*****************
+
+TRAMP is included as part of Emacs (since Emacs 22.1).
+
+ TRAMP is also freely packaged for download on the Internet at
+<https://ftp.gnu.org/gnu/tramp/>.
+
+ TRAMP development versions are available on Git servers. Development
+versions contain new and incomplete features.
+
+ One way to obtain from Git server is to visit the Savannah project
+page at the following URL and then clicking on the Git link in the
+navigation bar at the top.
+
+<https://savannah.gnu.org/projects/tramp/>
+
+Another way is to follow the terminal session below:
+
+ $ cd ~/emacs
+ $ git clone git://git.savannah.gnu.org/tramp.git
+
+From behind a firewall:
+
+ $ git config --global http.proxy http://user:address@hidden:8080
+ $ git clone https://git.savannah.gnu.org/r/tramp.git
+
+TRAMP developers:
+
+ $ git clone address@hidden:/srv/git/tramp.git
+
+After one of the above commands, ‘~/emacs/tramp’ will containing the
+latest version of TRAMP.
+
+To fetch updates from the repository, use git pull:
+
+ $ cd ~/emacs/tramp
+ $ git pull
+
+Run ‘autoconf’ as follows to generate an up-to-date ‘configure’ script:
+
+ $ cd ~/emacs/tramp
+ $ autoconf
+
+
+File: tramp, Node: Installation, Next: Quick Start Guide, Prev: Obtaining
TRAMP, Up: Top
+
+3 Installing TRAMP into Emacs
+*****************************
+
+TRAMP is part of Emacs since version 22. If you use the version that
+comes with your Emacs, the following information is not necessary.
+
+* Menu:
+
+* System Requirements::
+* Basic Installation::
+* Installation parameters::
+* Testing::
+* Load paths::
+
+
+File: tramp, Node: System Requirements, Next: Basic Installation, Up:
Installation
+
+3.1 System Requirements
+=======================
+
+For installation, it requires at least the following program versions:
+
+ • GNU Autoconf 2.50 if sources are taken from GIT
+ • GNU make 3.76
+ • GNU texinfo 4.6
+
+ On MS Windows, you need Posix programs for installation. These and
+other useful Posix utilities can be obtained from one of several
+projects:
+
+ • <http://www.mingw.org/msys.shtml> ( MSYS )
+ • <http://www.cygwin.com/> ( Cygwin )
+ • <http://unxutils.sourceforge.net/> ( UnxUtils )
+ • <http://gnuwin32.sourceforge.net/> ( GnuWin32 )
+
+
+File: tramp, Node: Basic Installation, Next: Installation parameters, Prev:
System Requirements, Up: Installation
+
+3.2 Basic Installation
+======================
+
+Installing TRAMP into your Emacs is a relatively easy process, at least
+compared to rebuilding your machine from scratch. ;)
+
+ Seriously, though, the installation should be a fairly simple matter.
+The easiest way to proceed is as follows:
+
+ • Choose a directory, say ‘~/emacs/’. Change into that directory and
+ unpack the tarball. This will give you a directory
+ ‘~/emacs/tramp-2.4.2-pre/’ which contains subdirectories ‘lisp’ for
+ the Lisp code, ‘texi’ for the documentation, and ‘test’ for code
+ running TRAMP’s test suite. Make a symbolic link:
+
+ $ ln -s tramp-2.4.2-pre tramp
+
+ • ‘cd’ to ‘~/emacs/tramp/’. If you’ve taken TRAMP from the GIT
+ sources, type ‘autoconf’ in order to get an up-to-date ‘configure’
+ script.
+
+ • Type ‘./configure’ to configure TRAMP for your system.
+
+ Running ‘configure’ takes a while. While running, it prints some
+ messages telling which features it is checking for.
+
+ • Type ‘make’ to build the byte-compiled Lisp files as well as the
+ Info manual.
+
+ • Type ‘make install’ to install the TRAMP Lisp files and Info
+ manual.
+
+ • You can remove the byte-compiled Lisp files and the Info manual
+ from the source directory by typing ‘make clean’. To also remove
+ the files that ‘configure’ created, type ‘make distclean’.
+
+ • NOTE: If you run into problems running the example ‘make’ command,
+ don’t despair. You can still byte compile the ‘*.el’ files by
+ opening Emacs in ‘dired’ (‘C-x d’) mode, at ‘~/emacs/tramp/lisp’.
+ Mark the lisp files with ‘m’, then press ‘B’ to byte compile your
+ selections.
+
+ Something similar can be done to create the info manual. Just
+ change to directory ‘~/emacs/tramp/texi’ and load the ‘tramp.texi’
+ file in Emacs. Then press ‘M-x texinfo-format-buffer <RET>’ to
+ generate ‘~/emacs/tramp/info/tramp’.
+
+
+File: tramp, Node: Installation parameters, Next: Testing, Prev: Basic
Installation, Up: Installation
+
+3.3 Parameters in order to control installation
+===============================================
+
+By default, ‘make install’ will install TRAMP’s files in
+‘/usr/local/share/emacs/site-lisp’ and ‘/usr/local/share/info’. You can
+specify an installation prefix other than ‘/usr/local’ by giving
+‘configure’ the option ‘--prefix=PATH’. On GNU/Linux systems, it has
+been reported useful to apply
+
+ $ ./configure --prefix=/usr
+
+ If your installed copy of Emacs is named something other than
+‘emacs’, you will need to tell ‘make’ where to find it so that it can
+correctly byte-compile the TRAMP sources.
+
+ For example, to pass the Emacs command to be called:
+
+ $ ./configure --with-emacs=emacs24
+
+ If you specify the absolute path of the command, it must not contain
+whitespaces. If you need it, the corresponding path shall be appended
+to the ‘PATH’ environment variable.
+
+ Also, the ‘--prefix=PATH’ option to ‘configure’ may not be general
+enough to set the paths you want. If not, you can declare the
+directories Lisp and Info files should be installed.
+
+ For example, to put the Lisp files in ‘$HOME/elisp’ and the Info file
+in ‘$HOME/info’, you would type:
+
+ $ ./configure --with-lispdir=$HOME/elisp --infodir=$HOME/info
+
+ On MS Windows, given Emacs is installed at ‘C:/Program Files/Emacs’,
+you should apply
+
+ $ ./configure \
+ --with-lispdir='C:/Program Files/Emacs/share/emacs/site-lisp' \
+ --infodir='C:/Program Files/Emacs/share/info'
+
+or in Emacs versions prior 24.4
+
+ $ ./configure \
+ --with-lispdir='C:/Program Files/Emacs/site-lisp' \
+ --infodir='C:/Program Files/Emacs/info'
+
+ ‘make’ supports the ‘DESTDIR’ environment variable for staged
+installation; *note (standards)Command Variables:::
+
+ $ make DESTDIR=/tmp install
+
+ Running ‘configure’ might result in errors or warnings. The output
+explains in detail what’s going wrong.
+
+ In case of errors, it is mandatory to fix them before continuation.
+This can be missing or wrong versions of ‘emacs’, Emacs packages,
+‘make’, or ‘makeinfo’.
+
+ Warnings let ‘configure’ (and the whole installation process)
+continue, but parts of TRAMP aren’t installed. This can happen with
+missing or wrong versions of ‘texi2dvi’ or ‘install-info’. Here you can
+decide yourself whether you want to renounce on the related feature
+(‘tramp.dvi’ file for printed output, TRAMP entry in Info’s ‘dir’ file),
+or whether you want to adapt your ‘PATH’ environment variable, and rerun
+‘configure’. An alternative is calling the missed parts manually later
+on.
+
+
+File: tramp, Node: Testing, Next: Load paths, Prev: Installation
parameters, Up: Installation
+
+3.4 A test suite for TRAMP
+==========================
+
+TRAMP comes with an own test suite. This requires at least Emacs 24.4.
+In order to run this test suite, you call
+
+ $ make check
+
+ This test suite uses a mock-up connection method for the tests. This
+means, that no real connection is established, and no password is
+required for the tests. You can change this default behaviour by
+tweaking the environment variable ‘REMOTE_TEMPORARY_FILE_DIRECTORY’:
+
+ $ env REMOTE_TEMPORARY_FILE_DIRECTORY=/sudo::/tmp make check
+
+ If you are using MS Windows, the mock-up trick does not work, and you
+must change the default anyway.
+
+ The makefile contains an environment variable ‘TRAMP_TEST_ARGS’,
+which could be used for changing connection properties:
+
+ $ make TRAMP_TEST_ARGS=--eval\ \\\"\(add-to-list\
\'tramp-connection-properties\ \(list\ nil\ \\\\\\\"remote-shell\\\\\\\"\
\\\\\\\"/bin/bash\\\\\\\"\)\)\\\" check
+
+ If there are errors in that test suite you could not cover yourself,
+you might send a *note bug report: Bug Reports.
+
+
+File: tramp, Node: Load paths, Prev: Testing, Up: Installation
+
+3.5 How to plug-in TRAMP into your environment
+==============================================
+
+If you don’t install TRAMP into the intended directories, but prefer to
+use from the source directory, you need to add the following lines into
+your ‘.emacs’:
+
+ (add-to-list 'load-path "~/emacs/tramp/lisp/")
+ (require 'tramp)
+
+ If the environment variable ‘INFOPATH’ is set, add the directory
+‘~/emacs/tramp/info/’ to it. Else, add the directory to
+‘Info-directory-list’, as follows:
+
+ (add-to-list 'Info-directory-list "~/emacs/tramp/info/")
+
+
+File: tramp, Node: Quick Start Guide, Next: Configuration, Prev:
Installation, Up: Top
+
+4 Short introduction how to use TRAMP
+*************************************
+
+TRAMP extends the Emacs file name syntax by a remote component. A
+remote file name looks always like ‘/method:address@hidden:/path/to/file’.
+
+ You can use remote files exactly like ordinary files, that means you
+could open a file or directory by ‘C-x C-f
+/method:address@hidden:/path/to/file <RET>’, edit the file, and save it. You
+can also mix local files and remote files in file operations with two
+arguments, like ‘copy-file’ or ‘rename-file’. And finally, you can run
+even processes on a remote host, when the buffer you call the process
+from has a remote ‘default-directory’.
+
+4.1 File name syntax
+====================
+
+Remote file names are prepended by the ‘method’, ‘user’ and ‘host’
+parts. All of them, and also the local file name part, are optional, in
+case of a missing part a default value is assumed. The default value
+for an empty local file name part is the remote user’s home directory.
+The shortest remote file name is ‘/-::’, therefore. The ‘-’ notation
+for the default host is used for syntactical reasons, *note Default
+Host::.
+
+ The ‘method’ part describes the connection method used to reach the
+remote host, see below.
+
+ The ‘user’ part is the user name for accessing the remote host. For
+the ‘smb’ method, this could also require a domain name, in this case it
+is written as ‘user%domain’.
+
+ The ‘host’ part must be a host name which could be resolved on your
+local host. It could be a short host name, a fully qualified domain
+name, an IPv4 or IPv6 address, *note File name syntax::. Some
+connection methods support also a notation of the port to be used, in
+this case it is written as ‘host#port’.
+
+4.2 Using ‘ssh’ and ‘plink’
+===========================
+
+If your local host runs an SSH client, and the remote host runs an SSH
+server, the simplest remote file name is ‘/ssh:address@hidden:/path/to/file’.
+The remote file name ‘/ssh::’ opens a remote connection to yourself on
+the local host, and is taken often for testing TRAMP.
+
+ On MS Windows, PuTTY is often used as SSH client. Its ‘plink’ method
+can be used there to open a connection to a remote host running an ‘ssh’
+server: ‘/plink:address@hidden:/path/to/file’.
+
+4.3 Using ‘su’, ‘sudo’ and ‘sg’
+===============================
+
+Sometimes, it is necessary to work on your local host under different
+permissions. For this, you could use the ‘su’ or ‘sudo’ connection
+method. Both methods use ‘root’ as default user name and the return
+value of ‘(system-name)’ as default host name. Therefore, it is
+convenient to open a file as ‘/sudo::/path/to/file’.
+
+ The method ‘sg’ stands for “switch group”; the changed group must be
+used here as user name. The default host name is the same.
+
+4.4 Combining ‘ssh’ or ‘plink’ with ‘su’ or ‘sudo’
+==================================================
+
+If the ‘su’ or ‘sudo’ option shall be performed on another host, it
+could be comnbined with a leading ‘ssh’ or ‘plink’ option. That means,
+TRAMP connects first to the other host with non-administrative
+credentials, and changes to administrative credentials on that host
+afterwards. In a simple case, the syntax looks like
+‘/ssh:address@hidden|sudo::/path/to/file’. *Note Ad-hoc multi-hops::.
+
+4.5 Using ‘sudoedit’
+====================
+
+The ‘sudoedit’ method is similar to the ‘sudo’ method. However, it is a
+different implementation: it does not keep an open session running in
+the background. This is for security reasons; on the backside this
+method is less performant than the ‘sudo’ method, it is restricted to
+the ‘localhost’ only, and it does not support external processes.
+
+4.6 Using ‘smbclient’
+=====================
+
+In order to access a remote MS Windows host or Samba server, the
+‘smbclient’ client is used. The remote file name syntax is
+‘/smb:address@hidden:/path/to/file’. The first part of the local file
+name is the share exported by the remote host, ‘path’ in this example.
+
+4.7 Using GVFS-based methods
+============================
+
+On systems, which have installed the virtual file system for the GNOME
+Desktop (GVFS), its offered methods could be used by TRAMP. Examples
+are ‘/sftp:address@hidden:/path/to/file’, ‘/afp:address@hidden:/path/to/file’
+(accessing Apple’s AFP file system), ‘/dav:address@hidden:/path/to/file’ and
+‘/davs:address@hidden:/path/to/file’ (for WebDAV shares).
+
+4.8 Using GNOME Online Accounts based methods
+=============================================
+
+GVFS-based methods include also GNOME Online Accounts, which support the
+‘Files’ service. These are the Google Drive file system, and the
+OwnCloud/NextCloud file system. The file name syntax is here always
+‘/gdrive:address@hidden:/path/to/file’ (address@hidden stands
+here for your Google Drive account), or
+‘/nextcloud:address@hidden:/path/to/file’ (‘8081’ stands for the port
+number) for OwnCloud/NextCloud files.
+
+4.9 Using Android
+=================
+
+An Android device, which is connected via USB to your local host, can be
+accessed via the ‘adb’ command. No user or host name is needed. The
+file name syntax is ‘/adb::/path/to/file’.
+
+4.10 Using ‘rclone’
+===================
+
+A convenient way to access system storages is the ‘rclone’ program. If
+you have configured a storage in ‘rclone’ under a name ‘storage’ (for
+example), you could access it via the remote file name syntax
+‘/rclone:storage:/path/to/file’. User names are not needed.
+
+
+File: tramp, Node: Configuration, Next: Usage, Prev: Quick Start Guide,
Up: Top
+
+5 Configuring TRAMP
+*******************
+
+TRAMP is initially configured to use the ‘scp’ program to connect to the
+remote host. Just type ‘C-x C-f’ and then enter file name
+‘/scp:address@hidden:/path/to/file’. For details, *Note Default Method::,
+*Note Default User::, *Note Default Host::.
+
+ For problems related to the behavior of the remote shell, *Note
+Remote shell setup::.
+
+ For changing the connection type and file access method from the
+defaults to one of several other options, *Note Connection types::.
+
+ *Note* that some user options described in these examples are not
+auto loaded by Emacs. All examples require TRAMP is installed and
+loaded:
+
+ (customize-set-variable 'tramp-verbose 6 "Enable remote command traces")
+
+ For functions used to configure TRAMP, the following clause might be
+used in your init file:
+
+ (with-eval-after-load 'tramp (tramp-change-syntax 'simplified))
+
+* Menu:
+
+* Connection types:: Types of connections to remote hosts.
+* Inline methods:: Inline methods.
+* External methods:: External methods.
+* GVFS based methods:: GVFS based external methods.
+* Default Method:: Selecting a default method.
+ Here we also try to help those who
+ don’t have the foggiest which method
+ is right for them.
+* Default User:: Selecting a default user.
+* Default Host:: Selecting a default host.
+* Multi-hops:: Connecting to a remote host using multiple
hops.
+* Firewalls:: Passing firewalls.
+* Customizing Methods:: Using Non-Standard Methods.
+* Customizing Completion:: Selecting config files for user/host name
completion.
+* Password handling:: Reusing passwords for several connections.
+* Connection caching:: Reusing connection related information.
+* Predefined connection information::
+ Setting own connection related information.
+* Remote programs:: How TRAMP finds and uses programs on the
remote host.
+* Remote shell setup:: Remote shell setup hints.
+* Android shell setup:: Android shell setup hints.
+* Auto-save and Backup:: Auto-save and Backup.
+* Windows setup hints:: Issues with Cygwin ssh.
+
+
+File: tramp, Node: Connection types, Next: Inline methods, Up: Configuration
+
+5.1 Types of connections to remote hosts
+========================================
+
+“Inline method” and “external method” are the two basic types of access
+methods. While they both use the same remote shell access programs,
+such as ‘rsh’, ‘ssh’, or ‘telnet’, they differ in the file access
+methods. Choosing the right method becomes important for editing files,
+transferring large files, or operating on a large number of files.
+
+ The performance of the external methods is generally better than that
+of the inline methods, at least for large files. This is caused by the
+need to encode and decode the data when transferring inline.
+
+ The one exception to this rule are the ‘scp’-based access methods.
+While these methods do see better performance when actually transferring
+files, the overhead of the cryptographic negotiation at startup may
+drown out the improvement in file transfer times.
+
+ External methods should be configured such a way that they don’t
+require a password (with ‘ssh-agent’, or such alike). Modern ‘scp’
+implementations offer options to reuse existing ‘ssh’ connections, which
+will be enabled by default if available. If it isn’t possible, you
+should consider *note Password handling::, otherwise you will be
+prompted for a password every copy action.
+
+
+File: tramp, Node: Inline methods, Next: External methods, Prev: Connection
types, Up: Configuration
+
+5.2 Inline methods
+==================
+
+Inline methods use the same login connection to transfer file contents.
+Inline methods are quick and easy for small files. They depend on the
+availability of suitable encoding and decoding programs on the remote
+host. For local source and destination, TRAMP may use built-in
+equivalents of such programs in Emacs.
+
+ Inline methods can work in situations where an external transfer
+program is unavailable. Inline methods also work when transferring
+files between different _user identities_ on the same host.
+
+ TRAMP checks the remote host for the availability and usability of
+‘mimencode’ (part of the ‘metamail’ package) or ‘uuencode’. TRAMP uses
+the first reliable command it finds. TRAMP’s search path can be
+customized, see *note Remote programs::.
+
+ In case both ‘mimencode’ and ‘uuencode’ are unavailable, TRAMP first
+transfers a small Perl program to the remote host, and then tries that
+program for encoding and decoding.
+
+ To increase transfer speeds for large text files, use compression
+before encoding. The user option ‘tramp-inline-compress-start-size’
+specifies the file size for such optimization.
+
+‘rsh’
+
+ ‘rsh’ is an option for connecting to hosts within local networks
+ since ‘rsh’ is not as secure as other methods.
+
+‘ssh’
+
+ ‘ssh’ is a more secure option than others to connect to a remote
+ host.
+
+ ‘ssh’ can also take extra parameters as port numbers. For example,
+ a host on port 42 is specified as ‘host#42’ (the real host name, a
+ hash sign, then a port number). It is the same as passing ‘-p 42’
+ to the ‘ssh’ command.
+
+‘telnet’
+
+ Connecting to a remote host with ‘telnet’ is as insecure as the
+ ‘rsh’ method.
+
+‘su’
+
+ Instead of connecting to a remote host, ‘su’ program allows editing
+ as another user. The host can be either ‘localhost’ or the host
+ returned by the function ‘(system-name)’. See *note Multi-hops::
+ for an exception to this behavior.
+
+‘sudo’
+
+ Similar to ‘su’ method, ‘sudo’ uses ‘sudo’. ‘sudo’ must have
+ sufficient rights to start a shell.
+
+ For security reasons, a ‘sudo’ connection is disabled after a
+ predefined timeout (5 minutes per default). This can be changed,
+ see *note Predefined connection information::.
+
+‘doas’
+
+ This method is used on OpenBSD like the ‘sudo’ command. Like the
+ ‘sudo’ method, a ‘doas’ connection is disabled after a predefined
+ timeout.
+
+‘sg’
+
+ The ‘sg’ program allows editing as different group. The host can
+ be either ‘localhost’ or the host returned by the function
+ ‘(system-name)’. The user name must be specified, but it denotes a
+ group name. See *note Multi-hops:: for an exception to this
+ behavior.
+
+‘sshx’
+
+ Works like ‘ssh’ but without the extra authentication prompts.
+ ‘sshx’ uses ‘ssh -t -t HOST -l USER /bin/sh’ to open a connection
+ with a “standard” login shell.
+
+ *Note* that ‘sshx’ does not bypass authentication questions. For
+ example, if the host key of the remote host is not known, ‘sshx’
+ will still ask “Are you sure you want to continue connecting?”.
+ TRAMP cannot handle such questions. Connections will have to be
+ setup where logins can proceed without such questions.
+
+ ‘sshx’ is useful for MS Windows users when ‘ssh’ triggers an error
+ about allocating a pseudo tty. This happens due to missing shell
+ prompts that confuses TRAMP.
+
+ ‘sshx’ supports the ‘-p’ argument.
+
+‘krlogin’
+
+ This method is also similar to ‘ssh’. It uses the ‘krlogin -x’
+ command only for remote host login.
+
+‘ksu’
+
+ This is another method from the Kerberos suite. It behaves like
+ ‘su’.
+
+‘plink’
+
+ ‘plink’ method is for MS Windows users with the PuTTY
+ implementation of SSH. It uses ‘plink -ssh’ to log in to the
+ remote host.
+
+ Check the ‘Share SSH connections if possible’ control for that
+ session.
+
+ ‘plink’ method supports the ‘-P’ argument.
+
+‘plinkx’
+
+ Another method using PuTTY on MS Windows with session names instead
+ of host names. ‘plinkx’ calls ‘plink -load SESSION -t’. User
+ names and port numbers must be defined in the session.
+
+ Check the ‘Share SSH connections if possible’ control for that
+ session.
+
+
+File: tramp, Node: External methods, Next: GVFS based methods, Prev: Inline
methods, Up: Configuration
+
+5.3 External methods
+====================
+
+External methods operate over multiple channels, using the remote shell
+connection for some actions while delegating file transfers to an
+external transfer program.
+
+ External methods save on the overhead of encoding and decoding of
+inline methods.
+
+ Since external methods have the overhead of opening a new channel,
+files smaller than ‘tramp-copy-size-limit’ still use inline methods.
+
+‘rcp’
+
+ This method uses the ‘rsh’ and ‘rcp’ commands to connect to the
+ remote host and transfer files. This is the fastest access method
+ available.
+
+ The alternative method ‘remcp’ uses the ‘remsh’ and ‘rcp’ commands.
+
+‘scp’
+
+ Using a combination of ‘ssh’ to connect and ‘scp’ to transfer is
+ the most secure. While the performance is good, it is slower than
+ the inline methods for smaller files. Though there is no overhead
+ of encoding and decoding of the inline methods, ‘scp’’s
+ cryptographic handshake negates those speed gains.
+
+ ‘ssh’-based methods support ‘-p’ feature for specifying port
+ numbers. For example, ‘host#42’ passes ‘-p 42’ in the argument
+ list to ‘ssh’, and ‘-P 42’ in the argument list to ‘scp’.
+
+‘rsync’
+
+ ‘ssh’ command to connect in combination with ‘rsync’ command to
+ transfer is similar to the ‘scp’ method.
+
+ ‘rsync’ performs much better than ‘scp’ when transferring files
+ that exist on both hosts. However, this advantage is lost if the
+ file exists only on one side of the connection.
+
+ This method supports the ‘-p’ argument.
+
+‘scpx’
+
+ ‘scpx’ is useful to avoid login shell questions. It is similar in
+ performance to ‘scp’. ‘scpx’ uses ‘ssh -t -t HOST -l USER /bin/sh’
+ to open a connection.
+
+ ‘scpx’ is useful for MS Windows users when ‘ssh’ triggers an error
+ about allocating a pseudo tty. This happens due to missing shell
+ prompts that confuses TRAMP.
+
+ This method supports the ‘-p’ argument.
+
+‘pscp’
+‘psftp’
+
+ These methods are similar to ‘scp’ or ‘sftp’, but they use the
+ ‘plink’ command to connect to the remote host, and they use ‘pscp’
+ or ‘psftp’ for transferring the files. These programs are part of
+ PuTTY, an SSH implementation for MS Windows.
+
+ Check the ‘Share SSH connections if possible’ control for that
+ session.
+
+ These methods support the ‘-P’ argument.
+
+‘fcp’
+
+ This method is similar to ‘scp’, but uses ‘fsh’ to connect and
+ ‘fcp’ to transfer files. ‘fsh/fcp’, a front-end for ‘ssh’, reuse
+ ‘ssh’ session by submitting several commands. This avoids the
+ startup overhead due to ‘scp’’s secure connection. Inline methods
+ have similar benefits.
+
+ The command used for this connection is: ‘fsh HOST -l USER /bin/sh
+ -i’
+
+ ‘fsh’ has no inline method since the multiplexing it offers is not
+ useful for TRAMP. ‘fsh’ connects to remote host and TRAMP keeps
+ that one connection open.
+
+‘nc’
+
+ Using ‘telnet’ to connect and ‘nc’ to transfer files is sometimes
+ the only combination suitable for accessing routers or NAS hosts.
+ These dumb devices have severely restricted local shells, such as
+ the ‘busybox’ and do not host any other encode or decode programs.
+
+‘sudoedit’
+
+ The ‘sudoedit’ method allows to edit a file as a different user on
+ the local host. You could regard this as TRAMP’s implementation of
+ the ‘sudoedit’. Contrary to the ‘sudo’ method, all magic file name
+ functions are implemented by single ‘sudo ...’ commands. The
+ purpose is to make editing such a file as secure as possible; there
+ must be no session running in the Emacs background which could be
+ attacked from inside Emacs.
+
+ Consequently, external processes are not implemented.
+
+ The host name of such remote file names must represent the local
+ host. Since the default value is already proper, it is recommended
+ not to use any host name in the remote file name, like
+ ‘/sudoedit::/path/to/file’ or ‘/sudoedit:user@:/path/to/file’.
+
+ Like the ‘sudo’ method, a ‘sudoedit’ password expires after a
+ predefined timeout.
+
+‘ftp’
+
+ When TRAMP uses ‘ftp’, it forwards requests to whatever ftp program
+ is specified by Ange FTP. This external program must be capable of
+ servicing requests from TRAMP.
+
+‘smb’
+
+ This non-native TRAMP method connects via the Server Message Block
+ (SMB) networking protocol to hosts running file servers that are
+ typically based on Samba or MS Windows.
+
+ Using ‘smbclient’ requires a few tweaks when working with TRAMP:
+
+ The first directory in the localname must be a share name on the
+ remote host.
+
+ Since some SMB share names end in the ‘$’ character, TRAMP must use
+ ‘$$’ when specifying those shares to avoid environment variable
+ substitutions.
+
+ When TRAMP is not specific about the share name or uses the generic
+ remote directory ‘/’, ‘smbclient’ returns all available shares.
+
+ Since SMB authentication is based on each SMB share, TRAMP prompts
+ for a password even when accessing a different share on the same
+ SMB host. This prompting can be suppressed by *note Password
+ handling::.
+
+ To accommodate user name/domain name syntax required by MS Windows
+ authorization, TRAMP provides for an extended syntax in
+ ‘user%domain’ format (where ‘user’ is the user name, ‘%’ is the
+ percent symbol, and ‘domain’ is the MS Windows domain name). An
+ example:
+
+ /smb:address@hidden:/daniel$$/.emacs
+
+ where user ‘daniel’ connects as a domain user to the SMB host
+ ‘melancholia’ in the MS Windows domain ‘BIZARRE’ to edit ‘.emacs’
+ located in the home directory (share ‘daniel$’).
+
+ Alternatively, for local WINS users (as opposed to domain users),
+ substitute the domain name with the name of the local host in
+ UPPERCASE as shown here:
+
+ /smb:address@hidden:/daniel$$/.emacs
+
+ where user ‘daniel’ connects as local user to the SMB host
+ ‘melancholia’ in the local domain ‘MELANCHOLIA’ to edit ‘.emacs’
+ located in the home directory (share ‘daniel$’).
+
+ The domain name and user name are optional for ‘smbclient’
+ authentication. When user name is not specified, ‘smbclient’ uses
+ the anonymous user (without prompting for password). This behavior
+ is unlike other TRAMP methods, where local user name is
+ substituted.
+
+ The ‘smb’ method is unavailable if Emacs is run under a local user
+ authentication context in MS Windows. However such users can still
+ access remote files using UNC file names instead of TRAMP:
+
+ //melancholia/daniel$$/.emacs
+
+ UNC file name specification does not allow the specification of a
+ different user name for authentication like the ‘smbclient’ can.
+
+‘adb’
+
+ This method uses Android Debug Bridge program for accessing Android
+ devices. The Android Debug Bridge must be installed locally for
+ TRAMP to work. Some GNU/Linux distributions provide Android Debug
+ Bridge as an installation package. Alternatively, the program is
+ installed as part of the Android SDK. TRAMP finds the ‘adb’
+ program either via the ‘PATH’ environment variable or the absolute
+ path set in the user option ‘tramp-adb-program’.
+
+ TRAMP connects to Android devices with ‘adb’ only when the user
+ option ‘tramp-adb-connect-if-not-connected’ is not ‘nil’.
+ Otherwise, the connection must be established outside Emacs.
+
+ TRAMP does not require a host name part of the remote file name
+ when a single Android device is connected to ‘adb’. TRAMP instead
+ uses ‘/adb::’ as the default name. ‘adb devices’ shows available
+ host names.
+
+ ‘adb’ method normally does not need user name to authenticate on
+ the Android device because it runs under the ‘adbd’ process. But
+ when a user name is specified, however, TRAMP applies an ‘su’ in
+ the syntax. When authentication does not succeed, especially on
+ un-rooted Android devices, TRAMP displays login errors.
+
+ For Android devices connected through TCP/IP, a port number can be
+ specified using ‘device#42’ host name syntax or TRAMP can use the
+ default value as declared in ‘adb’ command. Port numbers are not
+ applicable to Android devices connected through USB.
+
+‘rclone’
+
+ The program ‘rclone’ allows to access different system storages in
+ the cloud, see <https://rclone.org/> for a list of supported
+ systems. If the ‘rclone’ program isn’t found in your ‘PATH’
+ environment variable, you can tell TRAMP its absolute path via the
+ user option ‘tramp-rclone-program’.
+
+ A system storage must be configured via the ‘rclone config’
+ command, outside Emacs. If you have configured a storage in
+ ‘rclone’ under a name ‘storage’ (for example), you could access it
+ via the remote file name
+
+ /rclone:storage:/path/to/file
+
+ User names are part of the ‘rclone’ configuration, and not needed
+ in the remote file name. If a user name is contained in the remote
+ file name, it is ignored.
+
+ Internally, TRAMP mounts the remote system storage at location
+ ‘/tmp/tramp.rclone.storage’, with ‘storage’ being the name of the
+ configured system storage.
+
+ Optional flags to the different ‘rclone’ operations could be passed
+ as connection property, *Note Predefined connection information::.
+ Supported properties are ‘mount-args’, ‘copyto-args’ and
+ ‘moveto-args’.
+
+ Access via ‘rclone’ is slow. If you have an alternative method for
+ accessing the system storage, you shall prefer this. *note GVFS
+ based methods:: for example, methods ‘gdrive’ and ‘nextcloud’.
+
+ *Note*: The ‘rclone’ method is experimental, don’t use it in
+ production systems!
+
+
+File: tramp, Node: GVFS based methods, Next: Default Method, Prev: External
methods, Up: Configuration
+
+5.4 GVFS based external methods
+===============================
+
+GVFS is the virtual file system for the GNOME Desktop,
+<https://en.wikipedia.org/wiki/GVFS>. Remote files on GVFS are mounted
+locally through FUSE and TRAMP uses this locally mounted directory
+internally.
+
+ Emacs uses the D-Bus mechanism to communicate with GVFS. Emacs must
+have the message bus system, D-Bus integration active, *note D-Bus:
+(dbus)Top.
+
+‘afp’
+
+ This method is for connecting to remote hosts with the Apple Filing
+ Protocol for accessing files on macOS volumes. TRAMP access syntax
+ requires a leading volume (share) name, for example:
+ ‘/afp:address@hidden:/volume’.
+
+‘dav’
+‘davs’
+
+ ‘dav’ method provides access to WebDAV files and directories based
+ on standard protocols, such as HTTP. ‘davs’ does the same but with
+ SSL encryption. Both methods support the port numbers.
+
+ Paths being part of the WebDAV volume to be mounted by GVFS, as it
+ is common for OwnCloud or NextCloud file names, are not supported
+ by these methods. See method ‘nextcloud’ for handling them.
+
+‘gdrive’
+
+ Via the ‘gdrive’ method it is possible to access your Google Drive
+ online storage. User and host name of the remote file name are
+ your email address of the Google Drive credentials, like
+ ‘/gdrive:address@hidden:/’. These credentials must be
+ populated in your ‘Online Accounts’ application outside Emacs.
+
+ Since Google Drive uses cryptic blob file names internally, TRAMP
+ works with the ‘display-name’ of the files. This could produce
+ unexpected behavior in case two files in the same directory have
+ the same ‘display-name’, such a situation must be avoided.
+
+‘nextcloud’
+
+ As the name indicates, the method ‘nextcloud’ allows you to access
+ OwnCloud or NextCloud hosted files and directories. Like the
+ ‘gdrive’ method, your credentials must be populated in your ‘Online
+ Accounts’ application outside Emacs. The method supports port
+ numbers.
+
+‘sftp’
+
+ This method uses ‘sftp’ in order to securely access remote hosts.
+ ‘sftp’ is a more secure option for connecting to hosts that for
+ security reasons refuse ‘ssh’ connections.
+
+ -- User Option: tramp-gvfs-methods
+ This user option is a list of external methods for GVFS. By
+ default, this list includes ‘afp’, ‘dav’, ‘davs’, ‘gdrive’,
+ ‘nextcloud’ and ‘sftp’. Other methods to include are ‘ftp’,
+ ‘http’, ‘https’ and ‘smb’. These methods are not intended to be
+ used directly as GVFS based method. Instead, they are added here
+ for the benefit of *note Archive file names::.
+
+
+File: tramp, Node: Default Method, Next: Default User, Prev: GVFS based
methods, Up: Configuration
+
+5.5 Selecting a default method
+==============================
+
+In a remote file name, the use of a default method is indicated by the
+pseudo method ‘-’, *note File name syntax::.
+
+ -- User Option: tramp-default-method
+ Default method is for transferring files. The user option
+ ‘tramp-default-method’ sets it. TRAMP uses this user option to
+ determine the default method for remote file names that do not have
+ one specified.
+
+ (customize-set-variable 'tramp-default-method "ssh")
+
+ -- User Option: tramp-default-method-alist
+ Default methods for transferring files can be customized for
+ specific user and host combinations through the user option
+ ‘tramp-default-method-alist’.
+
+ For example, the following two lines specify to use the ‘ssh’
+ method for all user names matching ‘john’ and the ‘rsync’ method
+ for all host names matching ‘lily’. The third line specifies to
+ use the ‘su’ method for the user ‘root’ on the host ‘localhost’.
+
+ (add-to-list 'tramp-default-method-alist '("" "john" "ssh"))
+ (add-to-list 'tramp-default-method-alist '("lily" "" "rsync"))
+ (add-to-list 'tramp-default-method-alist
+ '("\\`localhost\\'" "\\`root\\'" "su"))
+
+External methods performance faster for large files. *note Inline
+methods::. *note External methods::.
+
+ Choosing the access method also depends on the security environment.
+For example, ‘rsh’ and ‘telnet’ methods that use clear text password
+transfers are inappropriate for over the Internet connections. Secure
+remote connections should use ‘ssh’ that provide encryption.
+
+5.5.1 Which method to use?
+--------------------------
+
+TRAMP provides maximum number of choices for maximum flexibility.
+Choosing which method depends on the hosts, clients, network speeds, and
+the security context.
+
+ Start by using an inline method.
+
+ External methods might be more efficient for large files, but most
+TRAMP users edit small files more often than large files.
+
+ Enable compression, ‘tramp-inline-compress-start-size’, for a
+performance boost for large files.
+
+ Since ‘ssh’ has become the most common method of remote host access
+and it has the most reasonable security protocols, use ‘ssh’ method.
+Typical ‘ssh’ usage to edit the ‘/etc/motd’ file on the otherhost:
+
+ C-x C-f /ssh:address@hidden:/etc/motd <RET>
+
+ If ‘ssh’ is unavailable for whatever reason, look for other obvious
+options. For MS Windows, try the ‘plink’ method. For Kerberos, try
+‘krlogin’.
+
+ For editing local files as ‘su’ or ‘sudo’ methods, try the shortened
+syntax of ‘root’:
+
+ C-x C-f /su::/etc/motd <RET>
+
+ For editing large files, ‘scp’ is faster than ‘ssh’. ‘pscp’ is
+faster than ‘plink’. But this speed improvement is not always true.
+
+
+File: tramp, Node: Default User, Next: Default Host, Prev: Default Method,
Up: Configuration
+
+5.6 Selecting a default user
+============================
+
+ -- User Option: tramp-default-user
+ A TRAMP file name can omit the user name part since TRAMP
+ substitutes the currently logged-in user name. However this
+ substitution can be overridden with ‘tramp-default-user’. For
+ example:
+
+ (customize-set-variable 'tramp-default-user "root")
+
+ -- User Option: tramp-default-user-alist
+ Instead of a single default user, ‘tramp-default-user-alist’ allows
+ multiple default user values based on access method or host name
+ combinations. The alist can hold multiple values. For example, to
+ use the ‘john’ as the default user for the domain ‘somewhere.else’
+ only:
+
+ (add-to-list 'tramp-default-user-alist
+ '("ssh" ".*\\.somewhere\\.else\\'" "john"))
+
+ A Caution: TRAMP will override any default user specified in the
+ configuration files outside Emacs, such as ‘~/.ssh/config’. To
+ stop TRAMP from applying the default value, set the corresponding
+ alist entry to nil:
+
+ (add-to-list 'tramp-default-user-alist
+ '("ssh" "\\`here\\.somewhere\\.else\\'" nil))
+
+ The last entry in ‘tramp-default-user-alist’ should be reserved for
+ catch-all or most often used login.
+
+ (add-to-list 'tramp-default-user-alist
+ '(nil nil "jonas") t)
+
+
+File: tramp, Node: Default Host, Next: Multi-hops, Prev: Default User, Up:
Configuration
+
+5.7 Selecting a default host
+============================
+
+ -- User Option: tramp-default-host
+ When host name is omitted, TRAMP substitutes the value from the
+ ‘tramp-default-host’ user option. It is initially populated with
+ the local host name where Emacs is running. The default method,
+ default user and default host can be overridden as follows:
+
+ (custom-set-variables
+ '(tramp-default-method "ssh")
+ '(tramp-default-user "john")
+ '(tramp-default-host "target"))
+
+ With all defaults set, ‘/-::’ will connect TRAMP to John’s home
+ directory on ‘target’ via ‘ssh’.
+
+ -- User Option: tramp-default-host-alist
+ Instead of a single default host, ‘tramp-default-host-alist’ allows
+ multiple default host values based on access method or user name
+ combinations. The alist can hold multiple values. While
+ ‘tramp-default-host’ is sufficient in most cases, some methods,
+ like ‘adb’, require defaults overwritten.
+
+
+File: tramp, Node: Multi-hops, Next: Firewalls, Prev: Default Host, Up:
Configuration
+
+5.8 Connecting to a remote host using multiple hops
+===================================================
+
+Multi-hops are methods to reach hosts behind firewalls or to reach the
+outside world from inside a bastion host. With multi-hops, TRAMP can
+negotiate these hops with the appropriate user/host authentication at
+each hop. All methods until now have been the single hop kind, where
+the start and end points of the connection did not have intermediate
+check points.
+
+ -- User Option: tramp-default-proxies-alist
+ ‘tramp-default-proxies-alist’ specifies proxy hosts to pass
+ through. This user option is list of triples consisting of ‘(HOST
+ USER PROXY)’.
+
+ The first match is the proxy host through which passes the file
+ name and the target host matching address@hidden HOST and USER are
+ regular expressions or ‘nil’, interpreted as a regular expression
+ which always matches.
+
+ PROXY is a literal TRAMP file name whose local name part is
+ ignored, and the method and user name parts are optional.
+
+ The method must be an inline method (*note Inline methods::). If
+ PROXY is ‘nil’, no additional hop is required reaching address@hidden
+
+ For example, to pass through the host ‘bastion.your.domain’ as user
+ ‘bird’ to reach remote hosts outside the local domain:
+
+ (add-to-list 'tramp-default-proxies-alist
+ '("\\." nil "/ssh:address@hidden:"))
+ (add-to-list 'tramp-default-proxies-alist
+ '("\\.your\\.domain\\'" nil nil))
+
+ *Note*: ‘add-to-list’ adds elements at the beginning of a list.
+ Therefore, most relevant rules must come last in the list.
+
+ Proxy hosts can be cascaded in the alist. If there is another host
+ called ‘jump.your.domain’, which is the only host allowed to
+ connect to ‘bastion.your.domain’, then:
+
+ (add-to-list 'tramp-default-proxies-alist
+ '("\\`bastion\\.your\\.domain\\'"
+ "\\`bird\\'"
+ "/ssh:jump.your.domain:"))
+
+ PROXY can take patterns ‘%h’ or ‘%u’ for HOST or USER respectively.
+ Ports or domains, if they are part of a hop file name, are not
+ expanded by those patterns.
+
+ To login as ‘root’ on remote hosts in the domain ‘your.domain’, but
+ login as ‘root’ is disabled for non-local access, then use this
+ alist entry:
+
+ (add-to-list 'tramp-default-proxies-alist
+ '("\\.your\\.domain\\'" "\\`root\\'" "/ssh:%h:"))
+
+ Opening ‘/sudo:randomhost.your.domain:’ first connects to
+ ‘randomhost.your.domain’ via ‘ssh’ under your account name, and
+ then performs ‘sudo -u root’ on that host.
+
+ It is key for the ‘sudo’ method in the above example to be applied
+ on the host after reaching it and not on the local host. TRAMP
+ checks therefore, that the host name for such hops matches the host
+ name of the previous hop.
+
+ HOST, USER and PROXY can also take Lisp forms. These forms when
+ evaluated must return either a string or ‘nil’.
+
+ To generalize (from the previous example): For all hosts, except my
+ local one, first connect via ‘ssh’, and then apply ‘sudo -u root’:
+
+ (add-to-list 'tramp-default-proxies-alist
+ '(nil "\\`root\\'" "/ssh:%h:"))
+ (add-to-list 'tramp-default-proxies-alist
+ '((regexp-quote (system-name)) nil nil))
+
+ Passing through hops involves dealing with restricted shells, such as
+‘rbash’. If TRAMP is made aware, then it would use them for proxies
+only.
+
+ -- User Option: tramp-restricted-shell-hosts-alist
+ An alist of regular expressions of hosts running restricted shells,
+ such as ‘rbash’. TRAMP will then use them only as proxies.
+
+ To specify the bastion host from the example above as running a
+ restricted shell:
+
+ (add-to-list 'tramp-restricted-shell-hosts-alist
+ "\\`bastion\\.your\\.domain\\'")
+
+
+File: tramp, Node: Firewalls, Next: Customizing Methods, Prev: Multi-hops,
Up: Configuration
+
+5.9 Passing firewalls
+=====================
+
+Sometimes, it is not possible to reach a remote host directly. A
+firewall might be in the way, which could be passed via a proxy server.
+
+ Both ssh and PuTTY support such proxy settings, using an HTTP tunnel
+via the ‘CONNECT’ command (conforming to RFC 2616, 2817 specifications).
+Proxy servers using HTTP 1.1 or later protocol support this command.
+
+5.9.1 Tunneling with ssh
+------------------------
+
+With ssh, you could use the ‘ProxyCommand’ entry in ‘~/.ssh/config’:
+
+ Host host.other.domain
+ ProxyCommand nc -X connect -x proxy.your.domain:3128 %h %p
+
+ ‘nc’ is BSD’s netcat program, which establishes HTTP tunnels. Any
+other program with such a feature could be used as well.
+
+ In the example, opening ‘/ssh:host.your.domain:’ passes the HTTP
+proxy server ‘proxy.your.domain’ on port 3128.
+
+5.9.2 Tunneling with PuTTY
+--------------------------
+
+PuTTY does not need an external program, HTTP tunnel support is
+built-in. In the PuTTY config program, create a session for
+‘host.your.domain’. In the ‘Connection/Data’ entry, select the ‘HTTP’
+option, and add ‘proxy.your.domain’ as ‘Proxy hostname’, and 3128 as
+‘Port’.
+
+ Opening ‘/plinkx:host.your.domain:’ passes the HTTP proxy server
+‘proxy.your.domain’ on port 3128.
+
+
+File: tramp, Node: Customizing Methods, Next: Customizing Completion, Prev:
Firewalls, Up: Configuration
+
+5.10 Using Non-Standard Methods
+===============================
+
+The ‘tramp-methods’ variable currently has an exhaustive list of
+predefined methods. Any part of this list can be modified with more
+suitable settings. Refer to the Lisp documentation of that variable,
+accessible with ‘C-h v tramp-methods <RET>’.
+
+ In the ELPA archives, there are several examples of such extensions.
+They can be installed with Emacs’ Package Manager. This includes
+
+‘docker-tramp’
+ Integration for Docker containers. A container is accessed via
+ ‘/docker:address@hidden:/path/to/file’, where ‘user’ is the
+ (optional) user that you want to use, and ‘container’ is the id or
+ name of the container.
+
+‘kubernetes-tramp’
+ Integration for Docker containers deployed in a Kubernetes cluster.
+ It is derived from ‘docker-tramp’. A container is accessed via
+ ‘/kubectl:address@hidden:/path/to/file’, ‘user’ and ‘container’
+ have the same meaning as in ‘docker-tramp’.
+
+‘lxc-tramp’
+ Integration for LXC containers. A container is accessed via
+ ‘/lxc:container:/path/to/file’, ‘container’ has the same meaning as
+ in ‘docker-tramp’. A ‘user’ specification is ignored.
+
+‘lxd-tramp’
+ Integration for LXD containers. A container is accessed via
+ ‘/lxd:address@hidden:/path/to/file’, ‘user’ and ‘container’ have
+ the same meaning as in ‘docker-tramp’.
+
+‘magit-tramp’
+ Browing git repositories with ‘magit’. A versioned file is
+ accessed via ‘/git:address@hidden:/path/to/file’. ‘rev’ is a git
+ revision, and ‘root-dir’ is a virtual host name for the root
+ directory, specified in ‘magit-tramp-hosts-alist’.
+
+‘tramp-hdfs’
+ Access of a hadoop/hdfs file system. A file is accessed via
+ ‘/hdfs:address@hidden:/path/to/file’, where ‘user’ is the user that you
+ want to use, and ‘node’ is the name of the hadoop server.
+
+‘vagrant-tramp’
+ Convenience method to access vagrant boxes. It is often used in
+ multi-hop file names like ‘/vagrant:box|sudo:box:/path/to/file’,
+ where ‘box’ is the name of the vagrant box.
+
+
+File: tramp, Node: Customizing Completion, Next: Password handling, Prev:
Customizing Methods, Up: Configuration
+
+5.11 Selecting config files for user/host name completion
+=========================================================
+
+‘tramp-completion-function-alist’ uses predefined files for user and
+host name completion (*note File name completion::). For each method,
+it keeps a set of configuration files and a function that can parse that
+file. Each entry in ‘tramp-completion-function-alist’ is of the form
+(METHOD PAIR1 PAIR2 ...).
+
+ Each PAIR is composed of (FUNCTION FILE). FUNCTION is responsible
+for extracting user names and host names from FILE for completion.
+There are two functions which access this variable:
+
+ -- Function: tramp-get-completion-function method
+ This function returns the list of completion functions for METHOD.
+
+ Example:
+ (tramp-get-completion-function "rsh")
+
+ ⇒ ((tramp-parse-rhosts "/etc/hosts.equiv")
+ (tramp-parse-rhosts "~/.rhosts"))
+
+ -- Function: tramp-set-completion-function method function-list
+ This function sets FUNCTION-LIST as list of completion functions
+ for METHOD.
+
+ Example:
+ (tramp-set-completion-function "ssh"
+ '((tramp-parse-sconfig "/etc/ssh_config")
+ (tramp-parse-sconfig "~/.ssh/config")))
+
+ ⇒ ((tramp-parse-sconfig "/etc/ssh_config")
+ (tramp-parse-sconfig "~/.ssh/config"))
+
+ The following predefined functions parsing configuration files exist:
+
+‘tramp-parse-rhosts’
+
+ This function parses files which are syntactical equivalent to
+ ‘~/.rhosts’. It returns both host names and user names, if
+ specified.
+
+‘tramp-parse-shosts’
+
+ This function parses files which are syntactical equivalent to
+ ‘~/.ssh/known_hosts’. Since there are no user names specified in
+ such files, it can return host names only.
+
+‘tramp-parse-sconfig’
+
+ This function returns the host nicknames defined by ‘Host’ entries
+ in ‘~/.ssh/config’ style files.
+
+‘tramp-parse-shostkeys’
+
+ SSH2 parsing of directories ‘/etc/ssh2/hostkeys/*’ and
+ ‘~/ssh2/hostkeys/*’. Hosts are coded in file names
+ ‘hostkey_PORTNUMBER_HOST-NAME.pub’. User names are always ‘nil’.
+
+‘tramp-parse-sknownhosts’
+
+ Another SSH2 style parsing of directories like
+ ‘/etc/ssh2/knownhosts/*’ and ‘~/ssh2/knownhosts/*’. This case,
+ hosts names are coded in file names ‘HOST-NAME.ALGORITHM.pub’.
+ User names are always ‘nil’.
+
+‘tramp-parse-hosts’
+
+ A function dedicated to ‘/etc/hosts’ for host names.
+
+‘tramp-parse-passwd’
+
+ A function which parses ‘/etc/passwd’ for user names.
+
+‘tramp-parse-etc-group’
+
+ A function which parses ‘/etc/group’ for group names.
+
+‘tramp-parse-netrc’
+
+ A function which parses ‘~/.netrc’ and ‘~/.authinfo’-style files.
+
+ To keep a custom file with custom data in a custom structure, a
+custom function has to be provided. This function must meet the
+following conventions:
+
+ -- Function: my-tramp-parse file
+ FILE must be either a file on the host, or ‘nil’. The function
+ must return a list of (USER HOST), which are taken as candidates
+ for completion for user and host names.
+
+ Example:
+ (my-tramp-parse "~/.my-tramp-hosts")
+
+ ⇒ ((nil "toto") ("daniel" "melancholia"))
+
+
+File: tramp, Node: Password handling, Next: Connection caching, Prev:
Customizing Completion, Up: Configuration
+
+5.12 Reusing passwords for several connections
+==============================================
+
+To avoid repeated prompts for passwords, consider native caching
+mechanisms, such as ‘ssh-agent’ for ‘ssh’-like methods, or ‘pageant’ for
+‘plink’-like methods.
+
+ TRAMP offers alternatives when native solutions cannot meet the need.
+
+5.12.1 Using an authentication file
+-----------------------------------
+
+The package ‘auth-source.el’, originally developed for No Gnus, reads
+passwords from different sources, *Note auth-source: (auth)Help for
+users. The default authentication file is ‘~/.authinfo.gpg’, but this
+can be changed via the user option ‘auth-sources’.
+
+A typical entry in the authentication file:
+
+ machine melancholia port scp login daniel password geheim
+
+ The port can take any TRAMP method (*note Inline methods::, *note
+External methods::). Omitting port values matches all TRAMP methods.
+Domain and ports, as used in TRAMP file name syntax, must be appended to
+the machine and login items:
+
+ machine melancholia#4711 port davs login daniel%BIZARRE password geheim
+
+ If there doesn’t exist a proper entry, the password is read
+interactively. After successful login (verification of the password),
+it is offered to save a corresponding entry for further use by
+‘auth-source’ backends which support this. This could be changed by
+setting the user option ‘auth-source-save-behavior’ to ‘nil’.
+
+ Set ‘auth-source-debug’ to ‘t’ to debug messages.
+
+ *Note* that ‘auth-source.el’ is not used for ‘ftp’ connections,
+because TRAMP passes the work to Ange FTP. If you want, for example,
+use your ‘~/.authinfo.gpg’ authentication file, you must customize
+‘ange-ftp-netrc-filename’:
+
+ (customize-set-variable 'ange-ftp-netrc-filename "~/.authinfo.gpg")
+
+5.12.2 Caching passwords
+------------------------
+
+TRAMP can cache passwords as entered and reuse when needed for the same
+user or host name independent of the access method.
+
+ ‘password-cache-expiry’ sets the duration (in seconds) the passwords
+are remembered. Passwords are never saved permanently nor can they
+extend beyond the lifetime of the current Emacs session. Set
+‘password-cache-expiry’ to ‘nil’ to disable expiration.
+
+ Set ‘password-cache’ to ‘nil’ to disable password caching.
+
+
+File: tramp, Node: Connection caching, Next: Predefined connection
information, Prev: Password handling, Up: Configuration
+
+5.13 Reusing connection related information
+===========================================
+
+For faster initial connection times, TRAMP stores previous connection
+properties in a file specified by the user option
+‘tramp-persistency-file-name’.
+
+ The default file name for ‘tramp-persistency-file-name’ is
+‘~/.emacs.d/tramp’.
+
+ TRAMP reads this file during Emacs startup, and writes to it when
+exiting Emacs. Delete this file for TRAMP to recreate a new one on next
+Emacs startup.
+
+ Set ‘tramp-persistency-file-name’ to ‘nil’ to disable storing
+connections persistently.
+
+ When TRAMP detects a change in the operating system version in a
+remote host (via the command ‘uname -sr’), it flushes all connection
+related information for that host and creates a new entry.
+
+
+File: tramp, Node: Predefined connection information, Next: Remote programs,
Prev: Connection caching, Up: Configuration
+
+5.14 Setting own connection related information
+===============================================
+
+For more precise customization, parameters specified by ‘tramp-methods’
+can be overwritten manually.
+
+ Set ‘tramp-connection-properties’ to manually override
+‘tramp-methods’. Properties in this list are in the form ‘(REGEXP
+PROPERTY VALUE)’. REGEXP matches remote file names. Use ‘nil’ to match
+all. PROPERTY is the property’s name, and VALUE is the property’s
+value.
+
+ PROPERTY is any method specific parameter contained in
+‘tramp-methods’. The parameter key in ‘tramp-methods’ is a symbol name
+‘tramp-<foo>’. To overwrite that property, use the string ‘<foo>’ for
+PROPERTY. For example, this changes the remote shell:
+
+ (add-to-list 'tramp-connection-properties
+ (list (regexp-quote "/ssh:address@hidden:")
+ "remote-shell" "/bin/ksh"))
+
+ (add-to-list 'tramp-connection-properties
+ (list (regexp-quote "/ssh:address@hidden:")
+ "remote-shell-login" '("-")))
+
+ The parameters ‘tramp-remote-shell’ and ‘tramp-remote-shell-login’ in
+‘tramp-methods’ now have new values for the remote host.
+
+ A common use case is to override the session timeout of a connection,
+that is the time (in seconds) after a connection is disabled, and must
+be reestablished. This can be set for any connection; for the ‘sudo’
+and ‘doas’ methods there exist predefined values. A value of ‘nil’
+disables this feature. For example:
+
+ (add-to-list 'tramp-connection-properties
+ (list (regexp-quote "/sudo:address@hidden:")
+ "session-timeout" 30))
+
+‘system-name’ stands here for the host returned by the function
+‘(system-name)’.
+
+ PROPERTY could also be any property found in
+‘tramp-persistency-file-name’.
+
+ To get around how restricted shells randomly drop connections, set
+the special property ‘busybox’. For example:
+
+ (add-to-list 'tramp-connection-properties
+ (list (regexp-quote "/ssh:address@hidden:")
+ "busybox" t))
+
+
+File: tramp, Node: Remote programs, Next: Remote shell setup, Prev:
Predefined connection information, Up: Configuration
+
+5.15 How TRAMP finds and uses programs on the remote host
+=========================================================
+
+TRAMP requires access to and rights to several commands on remote hosts:
+‘ls’, ‘test’, ‘find’ and ‘cat’.
+
+ Besides there are other required programs for *note Inline methods::
+and *note External methods:: of connection.
+
+ To improve performance and accuracy of remote file access, TRAMP uses
+‘perl’ (or ‘perl5’) and ‘grep’ when available.
+
+ -- User Option: tramp-remote-path
+ ‘tramp-remote-path’ specifies which remote directory paths TRAMP
+ can search for *note Remote programs::.
+
+ TRAMP uses standard defaults, such as ‘/bin’ and ‘/usr/bin’, which
+ are reasonable for most hosts. To accommodate differences in hosts
+ and paths, for example, ‘/bin:/usr/bin’ on Debian GNU/Linux or
+ ‘/usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/SUNWspro/bin’ on Solaris,
+ TRAMP queries the remote host with ‘getconf PATH’ and updates the
+ symbol ‘tramp-default-remote-path’.
+
+ For instances where hosts keep obscure locations for paths for
+ security reasons, manually add such paths to local ‘.emacs’ as
+ shown below for TRAMP to use when connecting.
+
+ (add-to-list 'tramp-remote-path "/usr/local/perl/bin")
+
+ Another way to find the remote path is to use the path assigned to
+ the remote user by the remote host. TRAMP does not normally retain
+ this remote path after login. However, ‘tramp-own-remote-path’
+ preserves the path value, which can be used to update
+ ‘tramp-remote-path’.
+
+ (add-to-list 'tramp-remote-path 'tramp-own-remote-path)
+
+ *Note* that this works only if your remote ‘/bin/sh’ shell supports
+ the login argument ‘-l’.
+
+ Starting with Emacs 26, ‘tramp-remote-path’ can be set per host via
+connection-local variables, *Note (emacs)Connection Variables::. You
+could define your own search directories like this:
+
+ (connection-local-set-profile-variables 'remote-path-with-bin
+ '((tramp-remote-path . ("~/bin" tramp-default-remote-path))))
+
+ (connection-local-set-profile-variables 'remote-path-with-apply-pub-bin
+ '((tramp-remote-path . ("/appli/pub/bin" tramp-default-remote-path))))
+
+ (connection-local-set-profiles
+ '(:application tramp :machine "randomhost") 'remote-path-with-bin)
+
+ (connection-local-set-profiles
+ '(:application tramp :user "anotheruser" :machine "anotherhost")
+ 'remote-path-with-apply-pub-bin)
+
+ When remote search paths are changed, local TRAMP caches must be
+recomputed. To force TRAMP to recompute afresh, call ‘M-x
+tramp-cleanup-this-connection <RET>’ or friends (*note Cleanup remote
+connections::).
+
+
+File: tramp, Node: Remote shell setup, Next: Android shell setup, Prev:
Remote programs, Up: Configuration
+
+5.16 Remote shell setup hints
+=============================
+
+TRAMP checks for the availability of standard programs in the usual
+locations. Common tactics include successively trying ‘test -e’,
+‘/usr/bin/test -e’, and ‘/bin/test -e’. ‘ls -d’ is another approach.
+But these approaches do not help with these new login patterns.
+
+ When TRAMP encounters two-factor logins or additional challenge
+questions, such as entering birth date or security code or passphrase,
+TRAMP needs a few more configuration steps to accommodate them.
+
+ The difference between a password prompt and a passphrase prompt is
+that the password for completing the login while the passphrase is for
+authorizing access to local authentication information, such as the ssh
+key.
+
+ There is no one configuration to accommodate all the variations in
+login security, especially not the exotic ones. However, TRAMP provides
+a few tweaks to address the most common ones.
+
+‘tramp-shell-prompt-pattern’
+
+ ‘tramp-shell-prompt-pattern’ is for remote login shell prompt,
+ which may not be the same as the local login shell prompt,
+ ‘shell-prompt-pattern’. Since most hosts use identical prompts,
+ TRAMP sets a similar default value for both prompts.
+
+‘tramp-password-prompt-regexp’
+‘tramp-wrong-passwd-regexp’
+
+ TRAMP uses ‘tramp-password-prompt-regexp’ to distinguish between
+ prompts for passwords and prompts for passphrases. By default,
+ ‘tramp-password-prompt-regexp’ handles the detection in English
+ language environments. See a localization example below:
+
+ (customize-set-variable
+ 'tramp-password-prompt-regexp
+ (concat
+ "^.*"
+ (regexp-opt
+ '("passphrase" "Passphrase"
+ ;; English
+ "password" "Password"
+ ;; Deutsch
+ "passwort" "Passwort"
+ ;; Français
+ "mot de passe" "Mot de passe")
+ t)
+ ".*:\0? *"))
+
+ Similar localization may be necessary for handling wrong password
+ prompts, for which TRAMP uses ‘tramp-wrong-passwd-regexp’.
+
+‘tramp-terminal-type’
+
+ TRAMP uses the user option ‘tramp-terminal-type’ to set the remote
+ environment variable ‘TERM’ for the shells it runs. Per default,
+ it is ‘"dumb"’, but this could be changed. A dumb terminal is best
+ suited to run the background sessions of TRAMP. However, running
+ interactive remote shells might require a different setting. This
+ could be achieved by tweaking the ‘TERM’ environment variable in
+ ‘process-environment’.
+
+ (let ((process-environment
+ (cons "TERM=xterm-256color" process-environment)))
+ (shell))
+
+Determining a TRAMP session
+
+ Sometimes, it is needed to identify whether a shell runs under
+ TRAMP control. The setting of environment variable ‘TERM’ will
+ help:
+
+ if test "$TERM" = "dumb"; then
+ ...
+ fi
+
+ Another possibility is to check the environment variable
+ ‘INSIDE_EMACS’. Like for all subprocesses of Emacs, this is set to
+ the version of the parent Emacs process, *Note (emacs)Interactive
+ Shell::. TRAMP adds its own package version to this string, which
+ could be used for further tests in an inferior shell. The string
+ of that environment variable looks always like
+
+ echo $INSIDE_EMACS
+ ⇒ 26.2,tramp:2.3.4
+
+‘tset’ and other questions
+
+ To suppress inappropriate prompts for terminal type, TRAMP sets the
+ ‘TERM’ environment variable before the remote login process begins
+ via the user option ‘tramp-terminal-type’ (see above). This will
+ silence common ‘tset’ related prompts.
+
+ TRAMP’s strategy for handling such prompts (commonly triggered from
+ login scripts on remote hosts) is to set the environment variables
+ so that no prompts interrupt the shell initialization process.
+
+ An alternative approach is to configure TRAMP with strings that can
+ identify such questions using ‘tramp-actions-before-shell’.
+ Example:
+
+ (defconst my-tramp-prompt-regexp
+ (concat (regexp-opt '("Enter the birth date of your mother:") t)
+ "\\s-*")
+ "Regular expression matching my login prompt question.")
+
+ (defun my-tramp-action (proc vec)
+ "Enter \"19000101\" in order to give a correct answer."
+ (save-window-excursion
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (tramp-message vec 6 "\n%s" (buffer-string))
+ (tramp-send-string vec "19000101"))))
+
+ (add-to-list 'tramp-actions-before-shell
+ '(my-tramp-prompt-regexp my-tramp-action))
+
+Conflicting names for users and variables in ‘.profile’
+
+ When a user name is the same as a variable name in a local file,
+ such as ‘.profile’, then TRAMP may send incorrect values for
+ environment variables. To avoid incorrect values, change the local
+ variable name to something different from the user name. For
+ example, if the user name is ‘FRUMPLE’, then change the variable
+ name to ‘FRUMPLE_DIR’.
+
+Non-Bourne commands in ‘.profile’
+
+ When the remote host’s ‘.profile’ is also used for shells other
+ than Bourne shell, then some incompatible syntaxes for commands in
+ ‘.profile’ may trigger errors in Bourne shell on the host and may
+ not complete client’s TRAMP connections.
+
+ One example of a Bourne shell incompatible syntax in ‘.profile’:
+ using ‘export FOO=bar’ instead of ‘FOO=bar; export FOO’. After
+ remote login, TRAMP will trigger an error during its execution of
+ ‘/bin/sh’ on the remote host because Bourne shell does not
+ recognize the export command as entered in ‘.profile’.
+
+ Likewise, (‘~’) character in paths will cause errors because Bourne
+ shell does not do (‘~’) character expansions.
+
+ One approach to avoiding these incompatibilities is to make all
+ commands in ‘~/.shrc’ and ‘~/.profile’ Bourne shell compatible so
+ TRAMP can complete connections to that remote. To accommodate
+ using non-Bourne shells on that remote, use other shell-specific
+ config files. For example, bash can use ‘~/.bash_profile’ and
+ ignore ‘.profile’.
+
+Interactive shell prompt
+
+ TRAMP redefines the remote shell prompt internally for robust
+ parsing. This redefinition affects the looks of a prompt in an
+ interactive remote shell through commands, such as ‘M-x shell
+ <RET>’. Such prompts, however, can be reset to something more
+ readable and recognizable using these environment variables.
+
+ TRAMP sets the ‘INSIDE_EMACS’ environment variable in the startup
+ script file ‘~/.emacs_SHELLNAME’.
+
+ ‘SHELLNAME’ is ‘bash’ or equivalent shell names. Change it by
+ setting the environment variable ‘ESHELL’ in the ‘.emacs’ as
+ follows:
+
+ (setenv "ESHELL" "bash")
+
+ Then re-set the prompt string in ‘~/.emacs_SHELLNAME’ as follows:
+
+ # Reset the prompt for remote TRAMP shells.
+ if [ "${INSIDE_EMACS/*tramp*/tramp}" == "tramp" ] ; then
+ PS1="address@hidden \w]$ "
+ fi
+
+ *Note (emacs)Interactive Shell::.
+
+‘busybox’ / ‘nc’
+
+ TRAMP’s ‘nc’ method uses the ‘nc’ command to install and execute a
+ listener as follows (see ‘tramp-methods’):
+
+ $ nc -l -p 42
+
+ The above command-line syntax has changed with ‘busybox’ versions.
+ If ‘nc’ refuses the ‘-p’ parameter, then overwrite as follows:
+
+ (add-to-list
+ 'tramp-connection-properties
+ `(,(regexp-quote "192.168.0.1")
+ "remote-copy-args" (("-l") ("%r"))))
+
+ where ‘192.168.0.1’ is the remote host IP address (*note Predefined
+ connection information::).
+
+
+File: tramp, Node: Android shell setup, Next: Auto-save and Backup, Prev:
Remote shell setup, Up: Configuration
+
+5.17 Android shell setup hints
+==============================
+
+TRAMP uses the ‘adb’ method to access Android devices. Android devices
+provide a restricted shell access through an USB connection. The local
+host must have the ‘adb’ program installed. Usually, it is sufficient
+to open the file ‘/adb::/’. Then you can navigate in the filesystem via
+‘dired’.
+
+ Alternatively, applications such as ‘Termux’ or ‘SSHDroid’ that run
+‘sshd’ process on the Android device can accept any ‘ssh’-based methods
+provided these settings are adjusted:
+
+ • ‘sh’ must be specified for remote shell since Android devices do
+ not provide ‘/bin/sh’. ‘sh’ will then invoke whatever shell is
+ installed on the device with this setting:
+
+ (add-to-list 'tramp-connection-properties
+ (list (regexp-quote "192.168.0.26") "remote-shell" "sh"))
+
+ where ‘192.168.0.26’ is the Android device’s IP address. (*note
+ Predefined connection information::).
+
+ • TRAMP requires preserving ‘PATH’ environment variable from user
+ settings. Android devices prefer ‘/system/xbin’ path over
+ ‘/system/bin’. Both of these are set as follows:
+
+ (add-to-list 'tramp-remote-path 'tramp-own-remote-path)
+ (add-to-list 'tramp-remote-path "/system/xbin")
+
+ • When the Android device is not ‘rooted’, specify a writable
+ directory for temporary files:
+
+ (add-to-list 'tramp-remote-process-environment "TMPDIR=$HOME")
+
+ • Open a remote connection with the command ‘C-x C-f
+ /ssh:192.168.0.26#2222: <RET>’, where ‘sshd’ is listening on port
+ ‘2222’.
+
+ To add a corresponding entry to the ‘~/.ssh/config’ file
+ (recommended), use this:
+
+ Host android
+ HostName 192.168.0.26
+ User root
+ Port 2222
+
+ To use the host name ‘android’ instead of the IP address shown in
+ the previous example, fix the connection properties as follows:
+
+ (add-to-list 'tramp-connection-properties
+ (list (regexp-quote "android") "remote-shell" "sh"))
+
+ Open a remote connection with a more concise command ‘C-x C-f
+ /ssh:android: <RET>’.
+
+
+File: tramp, Node: Auto-save and Backup, Next: Windows setup hints, Prev:
Android shell setup, Up: Configuration
+
+5.18 Auto-save and Backup configuration
+=======================================
+
+To avoid TRAMP from saving backup files owned by ‘root’ to locations
+accessible to others, default backup settings in
+‘backup-directory-alist’ have to be altered.
+
+ Here’s a scenario where files could be inadvertently exposed. Emacs
+by default writes backup files to the same directory as the original
+files unless changed to another location, such as ‘~/.emacs.d/backups/’.
+Such a directory will also be used by default by TRAMP when using, say,
+a restricted file ‘/su:address@hidden:/etc/secretfile’. The backup file
+of the secretfile is now owned by the user logged in from TRAMP and not
+‘root’.
+
+ When ‘backup-directory-alist’ is ‘nil’ (the default), such problems
+do not occur.
+
+ To “turn off” the backup feature for remote files and stop TRAMP from
+saving to the backup directory, use this:
+
+ (add-to-list 'backup-directory-alist
+ (cons tramp-file-name-regexp nil))
+
+Disabling backups can be targeted to just the ‘su’ and ‘sudo’ methods:
+
+ (setq backup-enable-predicate
+ (lambda (name)
+ (and (normal-backup-enable-predicate name)
+ (not
+ (let ((method (file-remote-p name 'method)))
+ (when (stringp method)
+ (member method '("su" "sudo"))))))))
+
+ Another option is to create better backup file naming with user and
+host names prefixed to the file name. For example, transforming
+‘/etc/secretfile’ to
+‘~/.emacs.d/backups/!su:address@hidden:!etc!secretfile’, set the TRAMP
+user option ‘tramp-backup-directory-alist’ from the existing user option
+‘backup-directory-alist’.
+
+ Then TRAMP backs up to a file name that is transformed with a prefix
+consisting of the DIRECTORY name. This file name prefixing happens only
+when the DIRECTORY is an absolute local file name.
+
+Example:
+
+ (add-to-list 'backup-directory-alist
+ (cons "." "~/.emacs.d/backups/"))
+ (customize-set-variable
+ 'tramp-backup-directory-alist backup-directory-alist)
+
+The backup file name of ‘/su:address@hidden:/etc/secretfile’ would be
+‘/su:address@hidden:~/.emacs.d/backups/!su:address@hidden:!etc!secretfile~’
+
+ Just as for backup files, similar issues of file naming affect
+auto-saving remote files. Auto-saved files are saved in the directory
+specified by the user option ‘auto-save-file-name-transforms’. By
+default this is set to the local temporary directory. But in some
+versions of Debian GNU/Linux, this points to the source directory where
+the Emacs was compiled. Reset such values to a valid directory.
+
+ Set ‘auto-save-file-name-transforms’ to ‘nil’ to save auto-saved
+files to the same directory as the original file.
+
+ Alternatively, set the user option ‘tramp-auto-save-directory’ to
+direct all auto saves to that location.
+
+
+File: tramp, Node: Windows setup hints, Prev: Auto-save and Backup, Up:
Configuration
+
+5.19 Issues with Cygwin ssh
+===========================
+
+This section is incomplete. Please share your solutions.
+
+ Cygwin’s ‘ssh’ works only with a Cygwin version of Emacs. To check
+for compatibility: type ‘M-x eshell <RET>’, and start ‘ssh test.host
+<RET>’. Incompatibilities trigger this message:
+
+ Pseudo-terminal will not be allocated because stdin is not a terminal.
+
+ Some older versions of Cygwin’s ‘ssh’ work with the ‘sshx’ access
+method. Consult Cygwin’s FAQ at <https://cygwin.com/faq/> for details.
+
+ On the Emacs Wiki (https://www.emacswiki.org/emacs/SshWithNTEmacs) it
+is explained how to use the helper program ‘fakecygpty’ to fix this
+problem.
+
+ When using the ‘scpx’ access method, Emacs may call ‘scp’ with MS
+Windows file naming, such as ‘c:/foo’. But the version of ‘scp’ that is
+installed with Cygwin does not know about MS Windows file naming, which
+causes it to incorrectly look for a host named ‘c’.
+
+ A workaround: write a wrapper script for ‘scp’ to convert Windows
+file names to Cygwin file names.
+
+ When using the ‘ssh-agent’ on MS Windows for password-less
+interaction, ‘ssh’ methods depend on the environment variable
+‘SSH_AUTH_SOCK’. But this variable is not set when Emacs is started
+from a Desktop shortcut and authentication fails.
+
+ One workaround is to use an MS Windows based SSH Agent, such as
+Pageant. It is part of the Putty Suite of tools.
+
+ The fallback is to start Emacs from a shell.
+
+
+File: tramp, Node: Usage, Next: Bug Reports, Prev: Configuration, Up: Top
+
+6 Using TRAMP
+*************
+
+TRAMP operates transparently, accessing remote files as if they are
+local. However, TRAMP employs a formalized remote file naming syntax to
+perform its functions transparently. This syntax consists of many parts
+specifying access methods, authentication, host names, and file names.
+Ange FTP uses a similar syntax.
+
+ Unlike opening local files in Emacs, which are instantaneous, opening
+remote files in TRAMP is slower at first. Sometimes there is a
+noticeable delay before the prompts for passwords or authentication
+appear in the minibuffer. Hitting ‘<RET>’ or other keys during this gap
+will be processed by Emacs. This type-ahead facility is a feature of
+Emacs that may cause missed prompts when using TRAMP.
+
+* Menu:
+
+* File name syntax:: TRAMP file name conventions.
+* Change file name syntax:: Alternative file name syntax.
+* File name completion:: File name completion.
+* 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.
+
+
+File: tramp, Node: File name syntax, Next: Change file name syntax, Up:
Usage
+
+6.1 TRAMP file name conventions
+===============================
+
+‘/method:host:/path/to/file’ opens file /PATH/TO/FILE on the remote host
+HOST, using the method METHOD.
+
+‘/ssh:melancholia:.emacs’
+ For the file ‘.emacs’ located in the home directory, on the host
+ ‘melancholia’, using method ‘ssh’.
+
+‘/ssh:melancholia.danann.net:.emacs’
+ For the file ‘.emacs’ specified using the fully qualified domain
+ name of the host.
+
+‘/ssh:melancholia:~/.emacs’
+ For the file ‘.emacs’ specified using the ‘~’, which is expanded.
+
+‘/ssh:melancholia:~daniel/.emacs’
+ For the file ‘.emacs’ located in ‘daniel’’s home directory on the
+ host, ‘melancholia’. The ‘~<user>’ construct is expanded to the
+ home directory of that user on the remote host.
+
+‘/ssh:melancholia:/etc/squid.conf’
+ For the file ‘/etc/squid.conf’ on the host ‘melancholia’.
+
+ HOST can take IPv4 or IPv6 address, as in ‘/ssh:127.0.0.1:.emacs’ or
+‘/ssh:[::1]:.emacs’. For syntactical reasons, IPv6 addresses must be
+embedded in square brackets ‘[’ and ‘]’.
+
+ By default, TRAMP will use the current local user name as the remote
+user name for log in to the remote host. Specifying a different name
+using the proper syntax will override this default behavior:
+
+ /method:address@hidden:path/to/file
+
+ ‘/ssh:address@hidden:.emacs’ is for file ‘.emacs’ in ‘daniel’’s
+home directory on the host, ‘melancholia’, accessing via method ‘ssh’.
+
+ For specifying port numbers, affix ‘#<port>’ to the host name. For
+example: ‘/ssh:address@hidden:.emacs’.
+
+ All method, user name, host name, port number and local name parts
+are optional, *Note Default Method::, *Note Default User::, *Note
+Default Host::. For syntactical reasons, the default method must be
+indicated by the pseudo method ‘-’.
+
+
+File: tramp, Node: Change file name syntax, Next: File name completion,
Prev: File name syntax, Up: Usage
+
+6.2 Alternative file name syntax
+================================
+
+The syntax described in *note File name syntax:: is the ‘default’
+syntax, which is active after Emacs startup. However, this can be
+changed.
+
+ -- Command: tramp-change-syntax syntax
+ This command changes the syntax TRAMP uses for remote file names.
+ Beside the ‘default’ value, SYNTAX can be
+
+ • ‘simplified’
+
+ The remote file name syntax is similar to the syntax used by
+ Ange FTP. A remote file name has the form
+ ‘/address@hidden:path/to/file’. The address@hidden part is
optional, and
+ the method is determined by *note Default Method::.
+
+ • ‘separate’
+
+ The remote file name syntax is similar to the syntax used by
+ XEmacs. A remote file name has the form
+ ‘/[method/address@hidden/to/file’. The ‘method’ and address@hidden
+ parts are optional.
+
+ -- Variable: tramp-file-name-regexp
+ This variable keeps a regexp which matches the selected remote file
+ name syntax. Its value changes after every call of
+ ‘tramp-change-syntax’. However, it is not recommended to use this
+ variable in external packages, a call of ‘file-remote-p’ is much
+ more appropriate. *note (elisp)Magic File Names::.
+
+
+File: tramp, Node: File name completion, Next: Ad-hoc multi-hops, Prev:
Change file name syntax, Up: Usage
+
+6.3 File name completion
+========================
+
+TRAMP can complete the following TRAMP file name components: method
+names, user names, host names, and file names located on remote hosts.
+Enable this by activating partial completion in ‘.emacs’. *Note
+(emacs)Completion Options::.
+
+ For example, type ‘C-x C-f / s <TAB>’, TRAMP completion choices show
+up as
+
+ sbin/ scp: scpx: sftp: sg:
+ smb: srv/ ssh: sshx: su:
+ sudo: sys/
+
+ ‘ssh:’ is a possible completion for the respective method, and
+‘sbin/’ stands for the directory ‘/sbin’ on your local host.
+
+ Type ‘s h :’ for the minibuffer completion to ‘/ssh:’. Typing
+‘<TAB>’ shows host names TRAMP extracts from ‘~/.ssh/config’ file, for
+example.
+
+ ssh:127.0.0.1: ssh:192.168.0.1:
+ ssh:[::1]: ssh:localhost:
+ ssh:melancholia.danann.net: ssh:melancholia:
+
+ Choose a host from the above list and then continue to complete file
+names on that host.
+
+ When the configuration (*note Customizing Completion::) includes user
+names, then the completion lists will account for the user names as
+well.
+
+ Results from ‘auth-sources’ search (*note Using an authentication
+file::) are added to the completion candidates. This search could be
+annoying, for example due to a passphrase request of the
+‘~/.authinfo.gpg’ authentication file. The user option
+‘tramp-completion-use-auth-sources’ controls, whether such a search is
+performed during completion.
+
+ Remote hosts previously visited or hosts whose connections are kept
+persistently (*note Connection caching::) will be included in the
+completion lists.
+
+ After remote host name completion comes completion of file names on
+the remote host. It works the same as with local host file completion
+except that killing with double-slash ‘//’ kills only the file name part
+of the TRAMP file name syntax. A triple-slash stands for the default
+behavior. *Note (emacs)Minibuffer File::.
+
+Example:
+
+ C-x C-f /ssh:melancholia:/usr/local/bin//etc <TAB>
+ ⊣ /ssh:melancholia:/etc
+
+ C-x C-f /ssh:melancholia://etc <TAB>
+ ⊣ /ssh:melancholia:/etc
+
+ C-x C-f /ssh:melancholia:/usr/local/bin///etc <TAB>
+ ⊣ /etc
+
+ During file name completion, remote directory contents are re-read
+regularly to account for any changes in the filesystem that may affect
+the completion candidates. Such re-reads can account for changes to the
+file system by applications outside Emacs (*note Connection caching::).
+
+ -- User Option: tramp-completion-reread-directory-timeout
+ The timeout is number of seconds since last remote command for
+ rereading remote directory contents. A value of 0 re-reads
+ immediately during file name completion, ‘nil’ uses cached
+ directory contents.
+
+
+File: tramp, Node: Ad-hoc multi-hops, Next: Remote processes, Prev: File
name completion, Up: Usage
+
+6.4 Declaring multiple hops in the file name
+============================================
+
+TRAMP file name syntax can accommodate ad-hoc specification of multiple
+proxies without using ‘tramp-default-proxies-alist’ configuration setup
+(*note Multi-hops::).
+
+ Each proxy is specified using the same syntax as the remote host
+specification minus the file name part. Each hop is separated by a ‘|’.
+Chain the proxies from the starting host to the destination remote host
+name and file name. For example, hopping over a single proxy
address@hidden to a remote file on address@hidden:
+
+ C-x C-f /ssh:address@hidden|ssh:address@hidden:/path <RET>
+
+ Each involved method must be an inline method (*note Inline
+methods::).
+
+ TRAMP adds the ad-hoc definitions on the fly to
+‘tramp-default-proxies-alist’ and is available for re-use during that
+Emacs session. Subsequent TRAMP connections to the same remote host can
+then use the shortcut form: ‘/ssh:address@hidden:/path’. Ad-hoc
+definitions are removed from ‘tramp-default-proxies-alist’ via the
+command ‘M-x tramp-cleanup-all-connections <RET>’ (*note Cleanup remote
+connections::).
+
+ -- User Option: tramp-save-ad-hoc-proxies
+ For ad-hoc definitions to be saved automatically in
+ ‘tramp-default-proxies-alist’ for future Emacs sessions, set
+ ‘tramp-save-ad-hoc-proxies’ to non-‘nil’.
+
+ (customize-set-variable 'tramp-save-ad-hoc-proxies t)
+
+ Ad-hoc proxies can take patterns ‘%h’ or ‘%u’ like in
+‘tramp-default-proxies-alist’. The following file name expands to user
+‘root’ on host ‘remotehost’, starting with an ‘ssh’ session on host
+‘remotehost’: ‘/ssh:%h|su:remotehost:’.
+
+ On the other hand, if a trailing hop does not specifiy a host name,
+the host name of the previous hop is reused. Therefore, the following
+file name is equivalent to the previous example: ‘/ssh:remotehost|su::’.
+
+
+File: tramp, Node: Remote processes, Next: Cleanup remote connections,
Prev: Ad-hoc multi-hops, Up: Usage
+
+6.5 Integration with other Emacs packages
+=========================================
+
+TRAMP supports starting new running processes on the remote host for
+discovering remote file names. Emacs packages on the remote host need
+no specific modifications for TRAMP’s use.
+
+ This type of integration does not work with the ‘ftp’ method, and
+does not support the pty association as specified in
+‘start-file-process’.
+
+ ‘process-file’ and ‘start-file-process’ work on the remote host when
+the variable ‘default-directory’ is remote:
+
+ (let ((default-directory "/ssh:remote.host:"))
+ (start-file-process "grep" (get-buffer-create "*grep*")
+ "/bin/sh" "-c" "grep -e tramp *"))
+
+ Remote processes do not apply to GVFS (see *note GVFS based
+methods::) because the remote file system is mounted on the local host
+and TRAMP just accesses by changing the ‘default-directory’.
+
+ TRAMP starts a remote process when a command is executed in a remote
+file or directory buffer. As of now, these packages have been
+integrated to work with TRAMP: ‘compile.el’ (commands like ‘compile’ and
+‘grep’) and ‘gud.el’ (‘gdb’ or ‘perldb’).
+
+ For TRAMP to find the command on the remote, it must be accessible
+through the default search path as setup by TRAMP upon first connection.
+Alternatively, use an absolute path or extend ‘tramp-remote-path’ (see
+*note Remote programs::):
+
+ (add-to-list 'tramp-remote-path "~/bin")
+ (add-to-list 'tramp-remote-path "/appli/pub/bin")
+
+ Customize user option ‘tramp-remote-process-environment’ to suit the
+remote program’s environment for the remote host.
+‘tramp-remote-process-environment’ is a list of strings structured
+similar to ‘process-environment’, where each element is a string of the
+form ‘ENVVARNAME=VALUE’.
+
+ To avoid any conflicts with local host environment variables set
+through local configuration files, such as ‘~/.profile’, use
+‘ENVVARNAME=’ to unset them for the remote environment.
+
+Use ‘add-to-list’ to add entries:
+
+ (add-to-list 'tramp-remote-process-environment "JAVA_HOME=/opt/java")
+
+ Modifying or deleting already existing values in the
+‘tramp-remote-process-environment’ list may not be feasible on
+restricted remote hosts. For example, some system administrators
+disallow changing ‘HISTORY’ environment variable. To accommodate such
+restrictions when using TRAMP, fix the
+‘tramp-remote-process-environment’ by the following code in the local
+‘.emacs’ file:
+
+ (let ((process-environment tramp-remote-process-environment))
+ (setenv "HISTORY" nil)
+ (setq tramp-remote-process-environment process-environment))
+
+ Setting the ‘ENV’ environment variable instructs some shells to read
+an initialization file. Per default, TRAMP has disabled this. You
+could overwrite this behavior by evaluating
+
+ (let ((process-environment tramp-remote-process-environment))
+ (setenv "ENV" "$HOME/.profile")
+ (setq tramp-remote-process-environment process-environment))
+
+ In addition to ‘tramp-remote-process-environment’, you can set
+environment variables for individual remote process calls by let-binding
+‘process-environment’. TRAMP applies any entries not present in the
+global default value of ‘process-environment’ (overriding
+‘tramp-remote-process-environment’ settings, if they conflict). For
+example:
+
+ (let ((process-environment (cons "HGPLAIN=1" process-environment)))
+ (process-file ...))
+
+ Let-binding in this way works regardless of whether the process to be
+called is local or remote, since TRAMP would add just the ‘HGPLAIN’
+setting and local processes would take whole value of
+‘process-environment’ along with the new value of ‘HGPLAIN’.
+
+ For integrating other Emacs packages so TRAMP can execute remotely,
+please file a bug report. *Note Bug Reports::.
+
+6.5.1 Running remote programs that create local X11 windows
+-----------------------------------------------------------
+
+To allow a remote program to create an X11 window on the local host, set
+the ‘DISPLAY’ environment variable for the remote host as follows in the
+local ‘.emacs’ file:
+
+ (add-to-list 'tramp-remote-process-environment
+ (format "DISPLAY=%s" (getenv "DISPLAY")))
+
+‘(getenv "DISPLAY")’ should return a recognizable name for the local
+host that the remote host can redirect X11 window interactions. If
+querying for a recognizable name is not possible for whatever reason,
+then replace ‘(getenv "DISPLAY")’ with a hard-coded, fixed name. Note
+that using ‘:0’ for X11 display name here will not work as expected.
+
+ An alternate approach is specify ‘ForwardX11 yes’ or
+‘ForwardX11Trusted yes’ in ‘~/.ssh/config’ on the local host.
+
+6.5.2 Running ‘shell’ on a remote host
+--------------------------------------
+
+Set ‘explicit-shell-file-name’ to the appropriate shell name when using
+TRAMP between two hosts with different operating systems, such as
+‘windows-nt’ and ‘gnu/linux’. This option ensures the correct name of
+the remote shell program.
+
+ When ‘explicit-shell-file-name’ is equal to ‘nil’, calling ‘shell’
+interactively will prompt for a shell name.
+
+ Starting with Emacs 26, you could use connection-local variables for
+setting different values of ‘explicit-shell-file-name’ for different
+remote hosts. *Note (emacs)Connection Variables::.
+
+ (connection-local-set-profile-variables
+ 'remote-bash
+ '((explicit-shell-file-name . "/bin/bash")
+ (explicit-bash-args . ("-i"))))
+
+ (connection-local-set-profile-variables
+ 'remote-ksh
+ '((explicit-shell-file-name . "/bin/ksh")
+ (explicit-ksh-args . ("-i"))))
+
+ (connection-local-set-profiles
+ '(:application tramp :protocol "ssh" :machine "localhost")
+ 'remote-bash)
+
+ (connection-local-set-profiles
+ `(:application tramp :protocol "sudo"
+ :user "root" :machine ,(system-name))
+ 'remote-ksh)
+
+6.5.3 Running ‘shell-command’ on a remote host
+----------------------------------------------
+
+‘shell-command’ executes commands synchronously or asynchronously on
+remote hosts and displays output in buffers on the local host. Example:
+
+ C-x C-f /sudo:: <RET>
+ M-& tail -f /var/log/syslog.log <RET>
+
+ ‘tail’ command outputs continuously to the local buffer, ‘*Async
+Shell Command*’
+
+ ‘M-x auto-revert-tail-mode <RET>’ runs similarly showing continuous
+output.
+
+ ‘shell-command’ uses the variables ‘shell-file-name’ and
+‘shell-command-switch’ in order to determine which shell to run. For
+remote hosts, their default values are ‘/bin/sh’ and ‘-c’, respectively
+(except for the ‘adb’ method, which uses ‘/system/bin/sh’). Like the
+variables in the previous section, these variables can be changed via
+connection-local variables.
+
+ If Emacs supports the variable ‘async-shell-command-width’ (since
+Emacs 27.1), TRAMP cares about its value for asynchronous shell
+commands. It specifies the number of display columns for command
+output. For synchronous shell commands, a similar effect can be
+achieved by adding the environment variable ‘COLUMNS’ to
+‘tramp-remote-process-environment’.
+
+6.5.4 Running ‘eshell’ on a remote host
+---------------------------------------
+
+TRAMP is integrated into ‘eshell.el’, which enables interactive eshell
+sessions on remote hosts at the command prompt. You must add the module
+‘em-tramp’ to ‘eshell-modules-list’. Here’s a sample interaction after
+opening ‘M-x eshell <RET>’ on a remote host:
+
+ ~ $ cd /sudo::/etc <RET>
+ /sudo:address@hidden:/etc $ hostname <RET>
+ host
+ /sudo:address@hidden:/etc $ id <RET>
+ uid=0(root) gid=0(root) groups=0(root)
+ /sudo:address@hidden:/etc $ find-file shadow <RET>
+ #<buffer shadow>
+ /sudo:address@hidden:/etc $
+
+ ‘eshell’ added custom ‘su’ and ‘sudo’ commands that set the default
+directory correctly for the ‘*eshell*’ buffer. TRAMP silently updates
+‘tramp-default-proxies-alist’ with an entry for this directory (*note
+Multi-hops::):
+
+ ~ $ cd /ssh:address@hidden:/etc <RET>
+ /ssh:address@hidden:/etc $ find-file shadow <RET>
+ File is not readable: /ssh:address@hidden:/etc/shadow
+ /ssh:address@hidden:/etc $ sudo find-file shadow <RET>
+ #<buffer shadow>
+
+ /ssh:address@hidden:/etc $ su - <RET>
+ /su:address@hidden:/root $ id <RET>
+ uid=0(root) gid=0(root) groups=0(root)
+ /su:address@hidden:/root $
+
+6.5.5 Running a debugger on a remote host
+-----------------------------------------
+
+‘gud.el’ provides a unified interface to symbolic debuggers (*note
+(emacs)Debuggers::). TRAMP can run debug on remote hosts by calling
+‘gdb’ with a remote file name:
+
+ M-x gdb <RET>
+ Run gdb (like this): gdb -i=mi /ssh:host:~/myprog <RET>
+
+ Since the remote ‘gdb’ and ‘gdb-inferior’ processes do not belong to
+the same process group on the remote host, there will be a warning,
+which can be ignored:
+
+ &"warning: GDB: Failed to set controlling terminal: Operation not
permitted\n"
+
+As consequence, there will be restrictions in I/O of the process to be
+debugged.
+
+ Relative file names are based on the remote default directory. When
+‘myprog.pl’ exists in ‘/ssh:host:/home/user’, valid calls include:
+
+ M-x perldb <RET>
+ Run perldb (like this): perl -d myprog.pl <RET>
+
+ Just the local part of a remote file name, such as ‘perl -d
+/home/user/myprog.pl’, is not possible.
+
+ Arguments of the program to be debugged must be literal, can take
+relative or absolute paths, but not remote paths.
+
+6.5.6 Running remote processes on MS Windows hosts
+--------------------------------------------------
+
+‘winexe’ runs processes on a remote MS Windows host, and TRAMP can use
+it for ‘process-file’ and ‘start-file-process’.
+
+ ‘tramp-smb-winexe-program’ specifies the local ‘winexe’ command.
+Powershell V2.0 on the remote host is required to run processes
+triggered from TRAMP.
+
+ ‘explicit-shell-file-name’ and ‘explicit-*-args’ have to be set
+properly so ‘M-x shell <RET>’ can open a proper remote shell on a MS
+Windows host. To open ‘cmd’, set it as follows:
+
+ (setq explicit-shell-file-name "cmd"
+ explicit-cmd-args '("/q"))
+
+To open ‘powershell’ as a remote shell, use this:
+
+ (setq explicit-shell-file-name "powershell"
+ explicit-powershell-args '("-file" "-"))
+
+
+File: tramp, Node: Cleanup remote connections, Next: Archive file names,
Prev: Remote processes, Up: Usage
+
+6.6 Cleanup remote connections
+==============================
+
+TRAMP provides several ways to flush remote connections.
+
+ -- Command: tramp-cleanup-connection vec
+ This command flushes all connection related objects. ‘vec’ is the
+ internal representation of a remote connection. When called
+ interactively, this command lists active remote connections in the
+ minibuffer. Each connection is of the format ‘/method:address@hidden:’.
+ Flushing remote connections also cleans the password cache (*note
+ Password handling::), file cache, connection cache (*note
+ Connection caching::), recentf cache (*note (emacs)File
+ Conveniences::), and connection buffers.
+
+ -- Command: tramp-cleanup-this-connection
+ Flushes only the current buffer’s remote connection objects, the
+ same as in ‘tramp-cleanup-connection’.
+
+ -- Command: tramp-cleanup-all-connections
+ Flushes all active remote connection objects, the same as in
+ ‘tramp-cleanup-connection’. This command removes also ad-hoc proxy
+ definitions (*note Ad-hoc multi-hops::).
+
+ -- Command: tramp-cleanup-all-buffers
+ Just as for ‘tramp-cleanup-all-connections’, all remote connections
+ and ad-hoc proxy definition are cleaned up in addition to killing
+ buffers related to that remote connection.
+
+
+File: tramp, Node: Archive file names, Prev: Cleanup remote connections,
Up: Usage
+
+6.7 Archive file names
+======================
+
+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), *note GVFS based methods::.
+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 *note magic file name operations: (elisp)Magic File
+Names, 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
+
+ • ‘.msu’, ‘.MSU’ — Microsoft Windows Update packages
+
+ • ‘.mtree’ — BSD mtree format
+
+ • ‘.odb’, ‘.odf’, ‘.odg’, ‘.odp’, ‘.ods’, ‘.odt’ — OpenDocument
+ formats
+
+ • ‘.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
+
+ • ‘.xpi’ — XPInstall Mozilla addons
+
+ • ‘.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:address@hidden:/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’ perform better, because no
+local copy of the file archive must be downloaded first. For example,
+‘/sftp:address@hidden:...’ performs better than the similar
+‘/scp:address@hidden:...’. See the constant ‘tramp-archive-all-gvfs-methods’
+for a complete list of ‘tramp-gvfs’ 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
+
+ (progn
+ (url-handler-mode 1)
+ (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
+
+ (progn
+ (url-handler-mode 1)
+ (find-file
+
"http://ftp.debian.org/debian/pool/main/c/coreutils/coreutils_8.28-1_amd64.deb/control.tar.gz/control"))
+
+
+File: tramp, Node: Bug Reports, Next: Frequently Asked Questions, Prev:
Usage, Up: Top
+
+7 Reporting Bugs and Problems
+*****************************
+
+TRAMP’s development team is actively engaged in solving bugs and
+problems and looks to feature requests and suggestions.
+
+ TRAMP’s mailing list is the place for more advice and information on
+working with TRAMP, solving problems, discussing, and general
+discussions about TRAMP.
+
+ TRAMP’s mailing list is moderated but even non-subscribers can post
+for moderator approval. Sometimes this approval step may take as long
+as 48 hours due to public holidays.
+
+ <address@hidden> is the mailing list. Messages sent to this
+address go to all the subscribers. This is _not_ the address to send
+subscription requests to.
+
+ To subscribe to the mailing list, visit: the TRAMP Mail Subscription
+Page (https://lists.gnu.org/mailman/listinfo/tramp-devel/).
+
+ Before sending a bug report, run the test suite first *note
+Testing::.
+
+ Check if the bug or problem is already addressed in *Note Frequently
+Asked Questions::.
+
+ Run ‘M-x tramp-bug <RET>’ to generate a buffer with details of the
+system along with the details of the TRAMP installation. Please include
+these details with the bug report.
+
+ The bug report must describe in as excruciating detail as possible
+the steps required to reproduce the problem. These details must include
+the setup of the remote host and any special or unique conditions that
+exist.
+
+ Include a minimal test case that reproduces the problem. This will
+help the development team find the best solution and avoid unrelated
+detours.
+
+ To exclude cache-related problems, flush all caches before running
+the test, *note Cleanup remote connections::.
+
+ When including TRAMP’s messages in the bug report, increase the
+verbosity level to 6 (*note Traces: Traces and Profiles.) in the
+‘~/.emacs’ file before repeating steps to the bug. Include the contents
+of the ‘*tramp/foo*’ and ‘*debug tramp/foo*’ buffers with the bug
+report. Both buffers could contain non-ASCII characters which are
+relevant for analysis, append the buffers as attachments to the bug
+report.
+
+ *Note* that a verbosity level greater than 6 is not necessary at this
+stage. Also note that a verbosity level of 6 or greater, the contents
+of files and directories will be included in the debug buffer.
+Passwords typed in TRAMP will never be included there.
+
+
+File: tramp, Node: Frequently Asked Questions, Next: Files directories and
localnames, Prev: Bug Reports, Up: Top
+
+8 Frequently Asked Questions
+****************************
+
+ • Where is the latest TRAMP?
+
+ TRAMP is available at the GNU URL:
+
+ <https://ftp.gnu.org/gnu/tramp/>
+
+ TRAMP’s GNU project page is located here:
+
+ <https://savannah.gnu.org/projects/tramp/>
+
+ • Which systems does it work on?
+
+ 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,
+ TRAMP has equal success connecting to other platforms, such as MS
+ Windows 7/8/10.
+
+ • How to speed up TRAMP?
+
+ TRAMP does many things in the background, some of which depends on
+ network speeds, response speeds of remote hosts, and authentication
+ delays. During these operations, TRAMP’s responsiveness slows
+ down. Some suggestions within the scope of TRAMP’s settings
+ include:
+
+ Use an external method, such as ‘scp’, which are faster than
+ internal methods.
+
+ Keep the file ‘tramp-persistency-file-name’, which is where TRAMP
+ caches remote information about hosts and files. Caching is
+ enabled by default. Don’t disable it.
+
+ Set ‘remote-file-name-inhibit-cache’ to ‘nil’ if remote files are
+ not independently updated outside TRAMP’s control. That cache
+ cleanup will be necessary if the remote directories or files are
+ updated independent of TRAMP.
+
+ Set ‘tramp-completion-reread-directory-timeout’ to ‘nil’ to speed
+ up completions, *note File name completion::.
+
+ Disable version control to avoid delays:
+
+ (setq vc-ignore-dir-regexp
+ (format "\\(%s\\)\\|\\(%s\\)"
+ vc-ignore-dir-regexp
+ tramp-file-name-regexp))
+
+ If this is too radical, because you want to use version control
+ remotely, trim ‘vc-handled-backends’ to just those you care about,
+ for example:
+
+ (setq vc-handled-backends '(SVN Git))
+
+ Disable excessive traces. Set ‘tramp-verbose’ to 3 or lower,
+ default being 3. Increase trace levels temporarily when hunting
+ for bugs.
+
+ • TRAMP does not connect to the remote host
+
+ Three main reasons for why TRAMP does not connect to the remote
+ host:
+
+ − Unknown characters in the prompt
+
+ TRAMP needs a clean recognizable prompt on the remote host for
+ accurate parsing. Shell prompts that contain escape sequences
+ for coloring cause parsing problems. *note Remote shell
+ setup:: for customizing prompt detection using regular
+ expressions.
+
+ To check if the remote host’s prompt is being recognized, use
+ this test: switch to TRAMP connection buffer ‘*tramp/foo*’,
+ put the cursor at the top of the buffer, and then apply the
+ following expression:
+
+ M-: (re-search-forward (concat tramp-shell-prompt-pattern "$"))
<RET>
+
+ If the cursor has not moved to the prompt at the bottom of the
+ buffer, then TRAMP has failed to recognize the prompt.
+
+ When using zsh on remote hosts, disable zsh line editor
+ because zsh uses left-hand side and right-hand side prompts in
+ parallel. Add the following line to ‘~/.zshrc’:
+
+ [[ $TERM == "dumb" ]] && unsetopt zle && PS1='$ ' && return
+
+ This uses the default value of ‘tramp-terminal-type’,
+ ‘"dumb"’, as value of the ‘TERM’ environment variable. If you
+ want to use another value for ‘TERM’, change
+ ‘tramp-terminal-type’ and this line accordingly.
+
+ When using fish shell on remote hosts, disable fancy
+ formatting by adding the following to
+ ‘~/.config/fish/config.fish’:
+
+ function fish_prompt
+ if test $TERM = "dumb"
+ echo "\$ "
+ else
+ ...
+ end
+ end
+
+ When using WinSSHD on remote hosts, TRAMP does not recognize
+ the strange prompt settings.
+
+ A similar problem exist with the iTerm2 shell integration,
+ which sends proprietary escape codes when starting a shell.
+ This can be suppressed by changing the respective integration
+ snippet in your ‘~/.profile’ like this:
+
+ [ $TERM = "dumb" ] || \
+ test -e "${HOME}/.iterm2_shell_integration.bash" && \
+ source "${HOME}/.iterm2_shell_integration.bash"
+
+ And finally, bash’s readline should not use key bindings like
+ ‘C-j’ to commands. Disable this in your ‘~/.inputrc’:
+
+ $if term=dumb
+ # Don't bind Control-J or it messes up TRAMP.
+ $else
+ "\C-j": next-history
+ $endif
+
+ − Echoed characters after login
+
+ TRAMP suppresses echos from remote hosts with the ‘stty -echo’
+ command. But sometimes it is too late to suppress welcome
+ messages from the remote host containing harmful control
+ characters. Using ‘sshx’ or ‘scpx’ methods can avoid this
+ problem because they allocate a pseudo tty. *Note Inline
+ methods::.
+
+ − TRAMP stops transferring strings longer than 500 characters
+
+ Set ‘tramp-chunksize’ to 500 to get around this problem, which
+ is related to faulty implementation of ‘process-send-string’
+ on HP-UX, FreeBSD and Tru64 Unix systems. Consult the
+ documentation for ‘tramp-chunksize’ to see when this is
+ necessary.
+
+ Set ‘file-precious-flag’ to ‘t’ for files accessed by TRAMP so
+ the file contents are checked using checksum by first saving
+ to a temporary file. *note (elisp)Saving Buffers::.
+
+ (add-hook
+ 'find-file-hook
+ (lambda ()
+ (when (file-remote-p default-directory)
+ (set (make-local-variable 'file-precious-flag) t))))
+
+ • TRAMP fails in a chrooted environment
+
+ When connecting to a local host, TRAMP uses some internal
+ optimizations. They fail, when there is a chrooted environment.
+ In order to disable those optimizations, set user option
+ ‘tramp-local-host-regexp’ to ‘nil’.
+
+ • TRAMP does not recognize if a ‘ssh’ session hangs
+
+ ‘ssh’ sessions on the local host hang when the network is down.
+ TRAMP cannot safely detect such hangs. The network configuration
+ for ‘ssh’ can be configured to kill such hangs with the following
+ command in the ‘~/.ssh/config’:
+
+ Host *
+ ServerAliveInterval 5
+
+ • TRAMP does not use default ‘ssh’ ‘ControlPath’
+
+ TRAMP overwrites ‘ControlPath’ settings when initiating ‘ssh’
+ sessions. TRAMP does this to fend off a stall if a master session
+ opened outside the Emacs session is no longer open. That is why
+ TRAMP prompts for the password again even if there is an ‘ssh’
+ already open.
+
+ Some ‘ssh’ versions support a ‘ControlPersist’ option, which allows
+ you to set the ‘ControlPath’ provided the variable
+ ‘tramp-ssh-controlmaster-options’ is customized as follows:
+
+ (customize-set-variable
+ 'tramp-ssh-controlmaster-options
+ (concat
+ "-o ControlPath=/tmp/address@hidden:%%p "
+ "-o ControlMaster=auto -o ControlPersist=yes"))
+
+ Note how "%r", "%h" and "%p" must be encoded as "%%r", "%%h" and
+ "%%p".
+
+ If the ‘~/.ssh/config’ is configured appropriately for the above
+ behavior, then any changes to ‘ssh’ can be suppressed with this
+ ‘nil’ setting:
+
+ (customize-set-variable 'tramp-use-ssh-controlmaster-options nil)
+
+ • File name completion does not work with TRAMP
+
+ ANSI escape sequences from the remote shell may cause errors in
+ TRAMP’s parsing of remote buffers.
+
+ To test if this is the case, open a remote shell and check if the
+ output of ‘ls’ is in color.
+
+ To disable ANSI escape sequences from the remote hosts, disable
+ ‘--color=yes’ or ‘--color=auto’ in the remote host’s ‘.bashrc’ or
+ ‘.profile’. Turn this alias on and off to see if file name
+ completion works.
+
+ • File name completion does not work in directories with large number
+ of files
+
+ This may be related to globbing, which is the use of shell’s
+ ability to expand wild card specifications, such as ‘*.c’. For
+ directories with large number of files, globbing might exceed the
+ shell’s limit on length of command lines and hang. TRAMP uses
+ globbing.
+
+ To test if globbing hangs, open a shell on the remote host and then
+ run ‘ls -d * ..?* > /dev/null’.
+
+ When testing, ensure the remote shell is the same shell (‘/bin/sh’,
+ ‘ksh’ or ‘bash’), that TRAMP uses when connecting to that host.
+
+ • How to get notified after TRAMP completes file transfers?
+
+ Make Emacs beep after reading from or writing to the remote host
+ with the following code in ‘~/.emacs’.
+
+ (defadvice tramp-handle-write-region
+ (after tramp-write-beep-advice activate)
+ "Make TRAMP beep after writing a file."
+ (interactive)
+ (beep))
+
+ (defadvice tramp-handle-do-copy-or-rename-file
+ (after tramp-copy-beep-advice activate)
+ "Make TRAMP beep after copying a file."
+ (interactive)
+ (beep))
+
+ (defadvice tramp-handle-insert-file-contents
+ (after tramp-insert-beep-advice activate)
+ "Make TRAMP beep after inserting a file."
+ (interactive)
+ (beep))
+
+ • How to get a Visual Warning when working with ‘root’ privileges?
+ Host indication in the mode line?
+
+ Install ‘tramp-theme’ from GNU ELPA via Emacs’ Package Manager.
+ Enable it via ‘M-x load-theme <RET> tramp <RET>’. Further
+ customization is explained in user option
+ ‘tramp-theme-face-remapping-alist’.
+
+ • Remote host does not understand default options for directory
+ listing
+
+ Emacs computes the ‘dired’ options based on the local host but if
+ the remote host cannot understand the same ‘ls’ command, then set
+ them with a hook as follows:
+
+ (add-hook
+ 'dired-before-readin-hook
+ (lambda ()
+ (when (file-remote-p default-directory)
+ (setq dired-actual-switches "-al"))))
+
+ • Why is ‘~/.sh_history’ on the remote host growing?
+
+ Due to the remote shell saving tilde expansions triggered by TRAMP,
+ the history file is probably growing rapidly. TRAMP can suppress
+ this behavior with the user option ‘tramp-histfile-override’. When
+ set to ‘t’, environment variable ‘HISTFILE’ is unset, and
+ environment variables ‘HISTFILESIZE’ and ‘HISTSIZE’ are set to 0.
+ Don’t use this with ‘bash’ 5.0.0. There is a bug in ‘bash’ which
+ lets ‘bash’ die.
+
+ Alternatively, ‘tramp-histfile-override’ could be a string.
+ Environment variable ‘HISTFILE’ is set to this file name then. Be
+ careful when setting to ‘/dev/null’; this might result in undesired
+ results when using ‘bash’ as remote shell.
+
+ Another approach is to disable TRAMP’s handling of the ‘HISTFILE’
+ at all by setting ‘tramp-histfile-override’ to ‘nil’. In this
+ case, saving history could be turned off by putting this shell code
+ in ‘.bashrc’ or ‘.kshrc’:
+
+ if [ -f $HOME/.sh_history ] ; then
+ /bin/rm $HOME/.sh_history
+ fi
+ if [ "${HISTFILE-unset}" != "unset" ] ; then
+ unset HISTFILE
+ fi
+ if [ "${HISTSIZE-unset}" != "unset" ] ; then
+ unset HISTSIZE
+ fi
+
+ For ‘ssh’-based method, add the following line to your
+ ‘~/.ssh/environment’:
+
+ HISTFILE=/dev/null
+
+ • How to shorten long file names when typing in TRAMP?
+
+ Adapt several of these approaches to reduce typing. If the full
+ name is ‘/ssh:address@hidden:/opt/news/etc’, then:
+
+ 1. Use simplified syntax:
+
+ If you always apply the default method (*note Default
+ Method::), you could use the simplified TRAMP syntax (*note
+ Change file name syntax::):
+
+ (customize-set-variable 'tramp-default-method "ssh")
+ (tramp-change-syntax 'simplified)
+
+ The reduced typing: ‘C-x C-f
+ /address@hidden:/opt/news/etc <RET>’.
+
+ 2. Use default values for method name and user name:
+
+ You can define default methods and user names for hosts,
+ (*note Default Method::, *note Default User::):
+
+ (custom-set-variables
+ '(tramp-default-method "ssh")
+ '(tramp-default-user "news"))
+
+ The reduced typing: ‘C-x C-f /-:news.my.domain:/opt/news/etc
+ <RET>’.
+
+ *Note* that there are some useful shortcuts already.
+ Accessing your local host as ‘root’ user, is possible just by
+ ‘C-x C-f /su:: <RET>’.
+
+ 3. Use configuration options of the access method:
+
+ Programs used for access methods already offer powerful
+ configurations (*note Customizing Completion::). For ‘ssh’,
+ configure the file ‘~/.ssh/config’:
+
+ Host xy
+ HostName news.my.domain
+ User news
+
+ The reduced typing: ‘C-x C-f /ssh:xy:/opt/news/etc <RET>’.
+
+ Depending on the number of files in the directories, host
+ names completion can further reduce key strokes: ‘C-x C-f
+ /ssh:x <TAB>’.
+
+ 4. Use environment variables to expand long strings
+
+ For long file names, set up environment variables that are
+ expanded in the minibuffer. Environment variables are set
+ either outside Emacs or inside Emacs with Lisp:
+
+ (setenv "xy" "/ssh:address@hidden:/opt/news/etc/")
+
+ The reduced typing: ‘C-x C-f $xy <RET>’.
+
+ *Note* that file name cannot be edited here because the
+ environment variables are not expanded during editing in the
+ minibuffer.
+
+ 5. Define own keys:
+
+ Redefine another key sequence in Emacs for ‘C-x C-f’:
+
+ (global-set-key
+ [(control x) (control y)]
+ (lambda ()
+ (interactive)
+ (find-file
+ (read-file-name
+ "Find TRAMP file: "
+ "/ssh:address@hidden:/opt/news/etc/"))))
+
+ Simply typing ‘C-x C-y’ would prepare minibuffer editing of
+ file name.
+
+ See the Emacs Wiki (https://www.emacswiki.org/emacs/TrampMode)
+ for a more comprehensive example.
+
+ 6. Define own abbreviation (1):
+
+ Abbreviation list expansion can be used to reduce typing long
+ file names:
+
+ (add-to-list
+ 'directory-abbrev-alist
+ '("^/xy" . "/ssh:address@hidden:/opt/news/etc/"))
+
+ The reduced typing: ‘C-x C-f /xy <RET>’.
+
+ *Note* that file name cannot be edited here because the
+ abbreviations are not expanded during editing in the
+ minibuffer. Furthermore, the abbreviation is not expanded
+ during <TAB> completion.
+
+ 7. Define own abbreviation (2):
+
+ The ‘abbrev-mode’ gives additional flexibility for editing in
+ the minibuffer:
+
+ (define-abbrev-table 'my-tramp-abbrev-table
+ '(("xy" "/ssh:address@hidden:/opt/news/etc/")))
+
+ (add-hook
+ 'minibuffer-setup-hook
+ (lambda ()
+ (abbrev-mode 1)
+ (setq local-abbrev-table my-tramp-abbrev-table)))
+
+ (defadvice minibuffer-complete
+ (before my-minibuffer-complete activate)
+ (expand-abbrev))
+
+ ;; If you use partial-completion-mode
+ (defadvice PC-do-completion
+ (before my-PC-do-completion activate)
+ (expand-abbrev))
+
+ The reduced typing: ‘C-x C-f xy <TAB>’.
+
+ The minibuffer expands for further editing.
+
+ 8. Use bookmarks:
+
+ Use bookmarks to save TRAMP file names. *note
+ (emacs)Bookmarks::.
+
+ Upon visiting a location with TRAMP, save it as a bookmark
+ with ‘<menu-bar> <edit> <bookmarks> <set>’.
+
+ To revisit that bookmark: ‘<menu-bar> <edit> <bookmarks>
+ <jump>’.
+
+ 9. Use recent files:
+
+ ‘recentf’ remembers visited places. *note (emacs)File
+ Conveniences::.
+
+ Keep remote file names in the recent list without have to
+ check for their accessibility through remote access:
+
+ (recentf-mode 1)
+
+ Reaching recently opened files: ‘<menu-bar> <file> <Open
+ Recent>’.
+
+ 10. Use filecache:
+
+ Since ‘filecache’ remembers visited places, add the remote
+ directory to the cache:
+
+ (eval-after-load "filecache"
+ '(file-cache-add-directory
+ "/ssh:address@hidden:/opt/news/etc/"))
+
+ Then use directory completion in the minibuffer with ‘C-x C-f
+ C-<TAB>’.
+
+ 11. Use bbdb:
+
+ ‘bbdb’ has a built-in feature for Ange FTP files, which also
+ works for TRAMP file names. *note Storing FTP sites in the
+ BBDB: (bbdb)bbdb-ftp.
+
+ Load ‘bbdb’ in Emacs:
+
+ (require 'bbdb)
+ (bbdb-initialize)
+
+ Create a BBDB entry with ‘M-x bbdb-create-ftp-site <RET>’.
+ Then specify a method and user name where needed. Examples:
+
+ M-x bbdb-create-ftp-site <RET>
+ Ftp Site: news.my.domain <RET>
+ Ftp Directory: /opt/news/etc/ <RET>
+ Ftp Username: ssh:news <RET>
+ Company: <RET>
+ Additional Comments: <RET>
+
+ In BBDB buffer, access an entry by pressing the key ‘F’.
+
+ Thanks to TRAMP users for contributing to these recipes.
+
+ • Why saved multi-hop file names do not work in a new Emacs session?
+
+ When saving ad-hoc multi-hop TRAMP file names (*note Ad-hoc
+ multi-hops::) via bookmarks, recent files, filecache, bbdb, or
+ another package, use the full ad-hoc file name including all hops,
+ like ‘/ssh:address@hidden|ssh:news.my.domain:/opt/news/etc’.
+
+ Alternatively, when saving abbreviated multi-hop file names
+ ‘/ssh:address@hidden:/opt/news/etc’, the user option
+ ‘tramp-save-ad-hoc-proxies’ must be set non-‘nil’ value.
+
+ • How to connect to a remote Emacs session using TRAMP?
+
+ Configure Emacs Client (*note (emacs)Emacs Server::).
+
+ Then on the remote host, start the Emacs Server:
+
+ (require 'server)
+ (setq server-host (system-name)
+ server-use-tcp t)
+ (server-start)
+
+ If ‘(system-name)’ of the remote host cannot be resolved on the
+ local host, use IP address instead.
+
+ Copy from the remote host the resulting file
+ ‘~/.emacs.d/server/server’ to the local host, to the same location.
+
+ Then start Emacs Client from the command line:
+
+ emacsclient /ssh:address@hidden:/file/to/edit
+
+ ‘user’ and ‘host’ refer to the local host.
+
+ To make Emacs Client an editor for other programs, use a wrapper
+ script ‘emacsclient.sh’:
+
+ #!/bin/sh
+ emacsclient /ssh:$(whoami)@$(hostname --fqdn):$1
+
+ Then change the environment variable ‘EDITOR’ to point to the
+ wrapper script:
+
+ export EDITOR=/path/to/emacsclient.sh
+
+ • How to determine whether a buffer is remote?
+
+ The buffer-local variable ‘default-directory’ tells this. If the
+ form ‘(file-remote-p default-directory)’ returns non-‘nil’, the
+ buffer is remote. See the optional arguments of ‘file-remote-p’
+ for determining details of the remote connection.
+
+ • How to disable other packages from calling TRAMP?
+
+ There are packages that call TRAMP without the user ever entering a
+ remote file name. Even without applying a remote file syntax, some
+ packages enable TRAMP on their own. How can users disable such
+ features.
+
+ − ‘ido.el’
+
+ Disable TRAMP file name completion:
+
+ (customize-set-variable 'ido-enable-tramp-completion nil)
+
+ − ‘rlogin.el’
+
+ Disable remote directory tracking mode:
+
+ (rlogin-directory-tracking-mode -1)
+
+ • How to disable TRAMP?
+
+ − To keep Ange FTP as default the remote files access package,
+ set this in ‘.emacs’:
+
+ (customize-set-variable 'tramp-default-method "ftp")
+
+ − To disable both TRAMP (and Ange FTP), set ‘tramp-mode’ to
+ ‘nil’ in ‘.emacs’. *Note*, that we don’t use
+ ‘customize-set-variable’, in order to avoid loading TRAMP.
+
+ (setq tramp-mode nil)
+
+ − To deactivate TRAMP for some look-alike remote file names, set
+ ‘tramp-ignored-file-name-regexp’ to a proper regexp in
+ ‘.emacs’. *Note*, that we don’t use ‘customize-set-variable’,
+ in order to avoid loading TRAMP.
+
+ (setq tramp-ignored-file-name-regexp "\\`/ssh:example\\.com:")
+
+ This is needed, if you mount for example a virtual file system
+ on your local host’s root directory as ‘/ssh:example.com:’.
+
+ − To unload TRAMP, type ‘M-x tramp-unload-tramp <RET>’.
+ Unloading TRAMP resets Ange FTP plugins also.
+
+
+File: tramp, Node: Files directories and localnames, Next: Traces and
Profiles, Prev: Frequently Asked Questions, Up: Top
+
+9 How file names, directories and localnames are mangled and managed
+********************************************************************
+
+* Menu:
+
+* Localname deconstruction:: Splitting a localname into its component parts.
+* External packages:: Integrating with external Lisp packages.
+
+
+File: tramp, Node: Localname deconstruction, Next: External packages, Up:
Files directories and localnames
+
+9.1 Splitting a localname into its component parts
+==================================================
+
+TRAMP package redefines lisp functions ‘file-name-directory’ and
+‘file-name-nondirectory’ to accommodate the unique file naming syntax
+that TRAMP requires.
+
+ The replacements dissect the file name, use the original handler for
+the localname, take that result, and then re-build the TRAMP file name.
+By relying on the original handlers for localnames, TRAMP benefits from
+platform specific hacks to the original handlers.
+
+
+File: tramp, Node: External packages, Prev: Localname deconstruction, Up:
Files directories and localnames
+
+9.2 Integrating with external Lisp packages
+===========================================
+
+9.2.1 File name completion.
+---------------------------
+
+Sometimes, it is not convenient to open a new connection to a remote
+host, including entering the password and alike. For example, this is
+nasty for packages providing file name completion. Such a package could
+signal to TRAMP, that they don’t want it to establish a new connection.
+Use the variable ‘non-essential’ temporarily and bind it to non-‘nil’
+value.
+
+ (let ((non-essential t))
+ ...)
+
+9.2.2 File attributes cache.
+----------------------------
+
+Keeping a local cache of remote file attributes in sync with the remote
+host is a time-consuming operation. Flushing and re-querying these
+attributes can tax TRAMP to a grinding halt on busy remote servers.
+
+ To get around these types of slow-downs in TRAMP’s responsiveness,
+set the ‘process-file-side-effects’ to ‘nil’ to stop TRAMP from flushing
+the cache. This is helpful in situations where callers to
+‘process-file’ know there are no file attribute changes. The let-bind
+form to accomplish this:
+
+ (let (process-file-side-effects)
+ ...)
+
+ For asynchronous processes, TRAMP uses a process sentinel to flush
+file attributes cache. When callers to ‘start-file-process’ know
+beforehand no file attribute changes are expected, then the process
+sentinel should be set to the default state. In cases where the caller
+defines its own process sentinel, TRAMP’s process sentinel is
+overwritten. The caller can still flush the file attributes cache in
+its process sentinel with this code:
+
+ (unless (memq (process-status proc) '(run open))
+ (dired-uncache remote-directory))
+
+ Since TRAMP traverses subdirectories starting with the
+root-directory, it is most likely sufficient to make the
+‘default-directory’ of the process buffer as the root directory.
+
+
+File: tramp, Node: Traces and Profiles, Next: GNU Free Documentation
License, Prev: Files directories and localnames, Up: Top
+
+10 How to Customize Traces
+**************************
+
+TRAMP messages are raised with verbosity levels ranging from 0 to 10.
+TRAMP does not display all messages; only those with a verbosity level
+less than or equal to ‘tramp-verbose’.
+
+ The verbosity levels are
+
+ 0 silent (no TRAMP messages at all)
+ 1 errors
+ 2 warnings
+ 3 connection to remote hosts (default verbosity)
+ 4 activities
+ 5 internal
+ 6 sent and received strings
+ 7 file caching
+ 8 connection properties
+ 9 test commands
+10 traces (huge)
+
+ With ‘tramp-verbose’ greater than or equal to 4, messages are also
+written to a TRAMP debug buffer. Such debug buffers are essential to
+bug and problem analyses. For TRAMP bug reports, set the
+‘tramp-verbose’ level to 6 (*note Bug Reports::).
+
+ The debug buffer is in *note (emacs)Outline Mode::. In this buffer,
+messages can be filtered by their level. To see messages up to
+verbosity level 5, enter ‘C-u 6 C-c C-q’. Other navigation keys are
+described in *note (emacs)Outline Visibility::.
+
+ TRAMP handles errors internally. But to get a Lisp backtrace, both
+the error and the signal have to be set as follows:
+
+ (setq debug-on-error t
+ debug-on-signal t)
+
+ If ‘tramp-verbose’ is greater than or equal to 10, Lisp backtraces
+are also added to the TRAMP debug buffer in case of errors.
+
+ To enable stepping through TRAMP function call traces, they have to
+be specifically enabled as shown in this code:
+
+ (require 'trace)
+ (dolist (elt (all-completions "tramp-" obarray 'functionp))
+ (trace-function-background (intern elt)))
+ (untrace-function 'tramp-read-passwd)
+
+ The buffer ‘*trace-output*’ contains the output from the function
+call traces. Disable ‘tramp-read-passwd’ to stop password strings from
+being written to ‘*trace-output*’.
+
+
+File: tramp, Node: GNU Free Documentation License, Next: Function Index,
Prev: Traces and Profiles, Up: Top
+
+Appendix A GNU Free Documentation License
+*****************************************
+
+ Version 1.3, 3 November 2008
+
+ Copyright © 2000, 2001, 2002, 2007, 2008, 2009 Free Software Foundation,
Inc.
+ <http://fsf.org/>
+
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ 0. PREAMBLE
+
+ The purpose of this License is to make a manual, textbook, or other
+ functional and useful document “free” in the sense of freedom: to
+ assure everyone the effective freedom to copy and redistribute it,
+ with or without modifying it, either commercially or
+ noncommercially. Secondarily, this License preserves for the
+ author and publisher a way to get credit for their work, while not
+ being considered responsible for modifications made by others.
+
+ This License is a kind of “copyleft”, which means that derivative
+ works of the document must themselves be free in the same sense.
+ It complements the GNU General Public License, which is a copyleft
+ license designed for free software.
+
+ We have designed this License in order to use it for manuals for
+ free software, because free software needs free documentation: a
+ free program should come with manuals providing the same freedoms
+ that the software does. But this License is not limited to
+ software manuals; it can be used for any textual work, regardless
+ of subject matter or whether it is published as a printed book. We
+ recommend this License principally for works whose purpose is
+ instruction or reference.
+
+ 1. APPLICABILITY AND DEFINITIONS
+
+ This License applies to any manual or other work, in any medium,
+ that contains a notice placed by the copyright holder saying it can
+ be distributed under the terms of this License. Such a notice
+ grants a world-wide, royalty-free license, unlimited in duration,
+ to use that work under the conditions stated herein. The
+ “Document”, below, refers to any such manual or work. Any member
+ of the public is a licensee, and is addressed as “you”. You accept
+ the license if you copy, modify or distribute the work in a way
+ requiring permission under copyright law.
+
+ A “Modified Version” of the Document means any work containing the
+ Document or a portion of it, either copied verbatim, or with
+ modifications and/or translated into another language.
+
+ A “Secondary Section” is a named appendix or a front-matter section
+ of the Document that deals exclusively with the relationship of the
+ publishers or authors of the Document to the Document’s overall
+ subject (or to related matters) and contains nothing that could
+ fall directly within that overall subject. (Thus, if the Document
+ is in part a textbook of mathematics, a Secondary Section may not
+ explain any mathematics.) The relationship could be a matter of
+ historical connection with the subject or with related matters, or
+ of legal, commercial, philosophical, ethical or political position
+ regarding them.
+
+ The “Invariant Sections” are certain Secondary Sections whose
+ titles are designated, as being those of Invariant Sections, in the
+ notice that says that the Document is released under this License.
+ If a section does not fit the above definition of Secondary then it
+ is not allowed to be designated as Invariant. The Document may
+ contain zero Invariant Sections. If the Document does not identify
+ any Invariant Sections then there are none.
+
+ The “Cover Texts” are certain short passages of text that are
+ listed, as Front-Cover Texts or Back-Cover Texts, in the notice
+ that says that the Document is released under this License. A
+ Front-Cover Text may be at most 5 words, and a Back-Cover Text may
+ be at most 25 words.
+
+ A “Transparent” copy of the Document means a machine-readable copy,
+ represented in a format whose specification is available to the
+ general public, that is suitable for revising the document
+ straightforwardly with generic text editors or (for images composed
+ of pixels) generic paint programs or (for drawings) some widely
+ available drawing editor, and that is suitable for input to text
+ formatters or for automatic translation to a variety of formats
+ suitable for input to text formatters. A copy made in an otherwise
+ Transparent file format whose markup, or absence of markup, has
+ been arranged to thwart or discourage subsequent modification by
+ readers is not Transparent. An image format is not Transparent if
+ used for any substantial amount of text. A copy that is not
+ “Transparent” is called “Opaque”.
+
+ Examples of suitable formats for Transparent copies include plain
+ ASCII without markup, Texinfo input format, LaTeX input format,
+ SGML or XML using a publicly available DTD, and standard-conforming
+ simple HTML, PostScript or PDF designed for human modification.
+ Examples of transparent image formats include PNG, XCF and JPG.
+ Opaque formats include proprietary formats that can be read and
+ edited only by proprietary word processors, SGML or XML for which
+ the DTD and/or processing tools are not generally available, and
+ the machine-generated HTML, PostScript or PDF produced by some word
+ processors for output purposes only.
+
+ The “Title Page” means, for a printed book, the title page itself,
+ plus such following pages as are needed to hold, legibly, the
+ material this License requires to appear in the title page. For
+ works in formats which do not have any title page as such, “Title
+ Page” means the text near the most prominent appearance of the
+ work’s title, preceding the beginning of the body of the text.
+
+ The “publisher” means any person or entity that distributes copies
+ of the Document to the public.
+
+ A section “Entitled XYZ” means a named subunit of the Document
+ whose title either is precisely XYZ or contains XYZ in parentheses
+ following text that translates XYZ in another language. (Here XYZ
+ stands for a specific section name mentioned below, such as
+ “Acknowledgements”, “Dedications”, “Endorsements”, or “History”.)
+ To “Preserve the Title” of such a section when you modify the
+ Document means that it remains a section “Entitled XYZ” according
+ to this definition.
+
+ The Document may include Warranty Disclaimers next to the notice
+ which states that this License applies to the Document. These
+ Warranty Disclaimers are considered to be included by reference in
+ this License, but only as regards disclaiming warranties: any other
+ implication that these Warranty Disclaimers may have is void and
+ has no effect on the meaning of this License.
+
+ 2. VERBATIM COPYING
+
+ You may copy and distribute the Document in any medium, either
+ commercially or noncommercially, provided that this License, the
+ copyright notices, and the license notice saying this License
+ applies to the Document are reproduced in all copies, and that you
+ add no other conditions whatsoever to those of this License. You
+ may not use technical measures to obstruct or control the reading
+ or further copying of the copies you make or distribute. However,
+ you may accept compensation in exchange for copies. If you
+ distribute a large enough number of copies you must also follow the
+ conditions in section 3.
+
+ You may also lend copies, under the same conditions stated above,
+ and you may publicly display copies.
+
+ 3. COPYING IN QUANTITY
+
+ If you publish printed copies (or copies in media that commonly
+ have printed covers) of the Document, numbering more than 100, and
+ the Document’s license notice requires Cover Texts, you must
+ enclose the copies in covers that carry, clearly and legibly, all
+ these Cover Texts: Front-Cover Texts on the front cover, and
+ Back-Cover Texts on the back cover. Both covers must also clearly
+ and legibly identify you as the publisher of these copies. The
+ front cover must present the full title with all words of the title
+ equally prominent and visible. You may add other material on the
+ covers in addition. Copying with changes limited to the covers, as
+ long as they preserve the title of the Document and satisfy these
+ conditions, can be treated as verbatim copying in other respects.
+
+ If the required texts for either cover are too voluminous to fit
+ legibly, you should put the first ones listed (as many as fit
+ reasonably) on the actual cover, and continue the rest onto
+ adjacent pages.
+
+ If you publish or distribute Opaque copies of the Document
+ numbering more than 100, you must either include a machine-readable
+ Transparent copy along with each Opaque copy, or state in or with
+ each Opaque copy a computer-network location from which the general
+ network-using public has access to download using public-standard
+ network protocols a complete Transparent copy of the Document, free
+ of added material. If you use the latter option, you must take
+ reasonably prudent steps, when you begin distribution of Opaque
+ copies in quantity, to ensure that this Transparent copy will
+ remain thus accessible at the stated location until at least one
+ year after the last time you distribute an Opaque copy (directly or
+ through your agents or retailers) of that edition to the public.
+
+ It is requested, but not required, that you contact the authors of
+ the Document well before redistributing any large number of copies,
+ to give them a chance to provide you with an updated version of the
+ Document.
+
+ 4. MODIFICATIONS
+
+ You may copy and distribute a Modified Version of the Document
+ under the conditions of sections 2 and 3 above, provided that you
+ release the Modified Version under precisely this License, with the
+ Modified Version filling the role of the Document, thus licensing
+ distribution and modification of the Modified Version to whoever
+ possesses a copy of it. In addition, you must do these things in
+ the Modified Version:
+
+ A. Use in the Title Page (and on the covers, if any) a title
+ distinct from that of the Document, and from those of previous
+ versions (which should, if there were any, be listed in the
+ History section of the Document). You may use the same title
+ as a previous version if the original publisher of that
+ version gives permission.
+
+ B. List on the Title Page, as authors, one or more persons or
+ entities responsible for authorship of the modifications in
+ the Modified Version, together with at least five of the
+ principal authors of the Document (all of its principal
+ authors, if it has fewer than five), unless they release you
+ from this requirement.
+
+ C. State on the Title page the name of the publisher of the
+ Modified Version, as the publisher.
+
+ D. Preserve all the copyright notices of the Document.
+
+ E. Add an appropriate copyright notice for your modifications
+ adjacent to the other copyright notices.
+
+ F. Include, immediately after the copyright notices, a license
+ notice giving the public permission to use the Modified
+ Version under the terms of this License, in the form shown in
+ the Addendum below.
+
+ G. Preserve in that license notice the full lists of Invariant
+ Sections and required Cover Texts given in the Document’s
+ license notice.
+
+ H. Include an unaltered copy of this License.
+
+ I. Preserve the section Entitled “History”, Preserve its Title,
+ and add to it an item stating at least the title, year, new
+ authors, and publisher of the Modified Version as given on the
+ Title Page. If there is no section Entitled “History” in the
+ Document, create one stating the title, year, authors, and
+ publisher of the Document as given on its Title Page, then add
+ an item describing the Modified Version as stated in the
+ previous sentence.
+
+ J. Preserve the network location, if any, given in the Document
+ for public access to a Transparent copy of the Document, and
+ likewise the network locations given in the Document for
+ previous versions it was based on. These may be placed in the
+ “History” section. You may omit a network location for a work
+ that was published at least four years before the Document
+ itself, or if the original publisher of the version it refers
+ to gives permission.
+
+ K. For any section Entitled “Acknowledgements” or “Dedications”,
+ Preserve the Title of the section, and preserve in the section
+ all the substance and tone of each of the contributor
+ acknowledgements and/or dedications given therein.
+
+ L. Preserve all the Invariant Sections of the Document, unaltered
+ in their text and in their titles. Section numbers or the
+ equivalent are not considered part of the section titles.
+
+ M. Delete any section Entitled “Endorsements”. Such a section
+ may not be included in the Modified Version.
+
+ N. Do not retitle any existing section to be Entitled
+ “Endorsements” or to conflict in title with any Invariant
+ Section.
+
+ O. Preserve any Warranty Disclaimers.
+
+ If the Modified Version includes new front-matter sections or
+ appendices that qualify as Secondary Sections and contain no
+ material copied from the Document, you may at your option designate
+ some or all of these sections as invariant. To do this, add their
+ titles to the list of Invariant Sections in the Modified Version’s
+ license notice. These titles must be distinct from any other
+ section titles.
+
+ You may add a section Entitled “Endorsements”, provided it contains
+ nothing but endorsements of your Modified Version by various
+ parties—for example, statements of peer review or that the text has
+ been approved by an organization as the authoritative definition of
+ a standard.
+
+ You may add a passage of up to five words as a Front-Cover Text,
+ and a passage of up to 25 words as a Back-Cover Text, to the end of
+ the list of Cover Texts in the Modified Version. Only one passage
+ of Front-Cover Text and one of Back-Cover Text may be added by (or
+ through arrangements made by) any one entity. If the Document
+ already includes a cover text for the same cover, previously added
+ by you or by arrangement made by the same entity you are acting on
+ behalf of, you may not add another; but you may replace the old
+ one, on explicit permission from the previous publisher that added
+ the old one.
+
+ The author(s) and publisher(s) of the Document do not by this
+ License give permission to use their names for publicity for or to
+ assert or imply endorsement of any Modified Version.
+
+ 5. COMBINING DOCUMENTS
+
+ You may combine the Document with other documents released under
+ this License, under the terms defined in section 4 above for
+ modified versions, provided that you include in the combination all
+ of the Invariant Sections of all of the original documents,
+ unmodified, and list them all as Invariant Sections of your
+ combined work in its license notice, and that you preserve all
+ their Warranty Disclaimers.
+
+ The combined work need only contain one copy of this License, and
+ multiple identical Invariant Sections may be replaced with a single
+ copy. If there are multiple Invariant Sections with the same name
+ but different contents, make the title of each such section unique
+ by adding at the end of it, in parentheses, the name of the
+ original author or publisher of that section if known, or else a
+ unique number. Make the same adjustment to the section titles in
+ the list of Invariant Sections in the license notice of the
+ combined work.
+
+ In the combination, you must combine any sections Entitled
+ “History” in the various original documents, forming one section
+ Entitled “History”; likewise combine any sections Entitled
+ “Acknowledgements”, and any sections Entitled “Dedications”. You
+ must delete all sections Entitled “Endorsements.”
+
+ 6. COLLECTIONS OF DOCUMENTS
+
+ You may make a collection consisting of the Document and other
+ documents released under this License, and replace the individual
+ copies of this License in the various documents with a single copy
+ that is included in the collection, provided that you follow the
+ rules of this License for verbatim copying of each of the documents
+ in all other respects.
+
+ You may extract a single document from such a collection, and
+ distribute it individually under this License, provided you insert
+ a copy of this License into the extracted document, and follow this
+ License in all other respects regarding verbatim copying of that
+ document.
+
+ 7. AGGREGATION WITH INDEPENDENT WORKS
+
+ A compilation of the Document or its derivatives with other
+ separate and independent documents or works, in or on a volume of a
+ storage or distribution medium, is called an “aggregate” if the
+ copyright resulting from the compilation is not used to limit the
+ legal rights of the compilation’s users beyond what the individual
+ works permit. When the Document is included in an aggregate, this
+ License does not apply to the other works in the aggregate which
+ are not themselves derivative works of the Document.
+
+ If the Cover Text requirement of section 3 is applicable to these
+ copies of the Document, then if the Document is less than one half
+ of the entire aggregate, the Document’s Cover Texts may be placed
+ on covers that bracket the Document within the aggregate, or the
+ electronic equivalent of covers if the Document is in electronic
+ form. Otherwise they must appear on printed covers that bracket
+ the whole aggregate.
+
+ 8. TRANSLATION
+
+ Translation is considered a kind of modification, so you may
+ distribute translations of the Document under the terms of section
+ 4. Replacing Invariant Sections with translations requires special
+ permission from their copyright holders, but you may include
+ translations of some or all Invariant Sections in addition to the
+ original versions of these Invariant Sections. You may include a
+ translation of this License, and all the license notices in the
+ Document, and any Warranty Disclaimers, provided that you also
+ include the original English version of this License and the
+ original versions of those notices and disclaimers. In case of a
+ disagreement between the translation and the original version of
+ this License or a notice or disclaimer, the original version will
+ prevail.
+
+ If a section in the Document is Entitled “Acknowledgements”,
+ “Dedications”, or “History”, the requirement (section 4) to
+ Preserve its Title (section 1) will typically require changing the
+ actual title.
+
+ 9. TERMINATION
+
+ You may not copy, modify, sublicense, or distribute the Document
+ except as expressly provided under this License. Any attempt
+ otherwise to copy, modify, sublicense, or distribute it is void,
+ and will automatically terminate your rights under this License.
+
+ However, if you cease all violation of this License, then your
+ license from a particular copyright holder is reinstated (a)
+ provisionally, unless and until the copyright holder explicitly and
+ finally terminates your license, and (b) permanently, if the
+ copyright holder fails to notify you of the violation by some
+ reasonable means prior to 60 days after the cessation.
+
+ Moreover, your license from a particular copyright holder is
+ reinstated permanently if the copyright holder notifies you of the
+ violation by some reasonable means, this is the first time you have
+ received notice of violation of this License (for any work) from
+ that copyright holder, and you cure the violation prior to 30 days
+ after your receipt of the notice.
+
+ Termination of your rights under this section does not terminate
+ the licenses of parties who have received copies or rights from you
+ under this License. If your rights have been terminated and not
+ permanently reinstated, receipt of a copy of some or all of the
+ same material does not give you any rights to use it.
+
+ 10. FUTURE REVISIONS OF THIS LICENSE
+
+ The Free Software Foundation may publish new, revised versions of
+ the GNU Free Documentation License from time to time. Such new
+ versions will be similar in spirit to the present version, but may
+ differ in detail to address new problems or concerns. See
+ <http://www.gnu.org/copyleft/>.
+
+ Each version of the License is given a distinguishing version
+ number. If the Document specifies that a particular numbered
+ version of this License “or any later version” applies to it, you
+ have the option of following the terms and conditions either of
+ that specified version or of any later version that has been
+ published (not as a draft) by the Free Software Foundation. If the
+ Document does not specify a version number of this License, you may
+ choose any version ever published (not as a draft) by the Free
+ Software Foundation. If the Document specifies that a proxy can
+ decide which future versions of this License can be used, that
+ proxy’s public statement of acceptance of a version permanently
+ authorizes you to choose that version for the Document.
+
+ 11. RELICENSING
+
+ “Massive Multiauthor Collaboration Site” (or “MMC Site”) means any
+ World Wide Web server that publishes copyrightable works and also
+ provides prominent facilities for anybody to edit those works. A
+ public wiki that anybody can edit is an example of such a server.
+ A “Massive Multiauthor Collaboration” (or “MMC”) contained in the
+ site means any set of copyrightable works thus published on the MMC
+ site.
+
+ “CC-BY-SA” means the Creative Commons Attribution-Share Alike 3.0
+ license published by Creative Commons Corporation, a not-for-profit
+ corporation with a principal place of business in San Francisco,
+ California, as well as future copyleft versions of that license
+ published by that same organization.
+
+ “Incorporate” means to publish or republish a Document, in whole or
+ in part, as part of another Document.
+
+ An MMC is “eligible for relicensing” if it is licensed under this
+ License, and if all works that were first published under this
+ License somewhere other than this MMC, and subsequently
+ incorporated in whole or in part into the MMC, (1) had no cover
+ texts or invariant sections, and (2) were thus incorporated prior
+ to November 1, 2008.
+
+ The operator of an MMC Site may republish an MMC contained in the
+ site under CC-BY-SA on the same site at any time before August 1,
+ 2009, provided the MMC is eligible for relicensing.
+
+ADDENDUM: How to use this License for your documents
+====================================================
+
+To use this License in a document you have written, include a copy of
+the License in the document and put the following copyright and license
+notices just after the title page:
+
+ Copyright (C) YEAR YOUR NAME.
+ Permission is granted to copy, distribute and/or modify this document
+ under the terms of the GNU Free Documentation License, Version 1.3
+ or any later version published by the Free Software Foundation;
+ with no Invariant Sections, no Front-Cover Texts, and no Back-Cover
+ Texts. A copy of the license is included in the section entitled ``GNU
+ Free Documentation License''.
+
+ If you have Invariant Sections, Front-Cover Texts and Back-Cover
+Texts, replace the “with...Texts.” line with this:
+
+ with the Invariant Sections being LIST THEIR TITLES, with
+ the Front-Cover Texts being LIST, and with the Back-Cover Texts
+ being LIST.
+
+ If you have Invariant Sections without Cover Texts, or some other
+combination of the three, merge those two alternatives to suit the
+situation.
+
+ If your document contains nontrivial examples of program code, we
+recommend releasing these examples in parallel under your choice of free
+software license, such as the GNU General Public License, to permit
+their use in free software.
+
+
+File: tramp, Node: Function Index, Next: Variable Index, Prev: GNU Free
Documentation License, Up: Top
+
+Function Index
+**************
+
+ [index ]
+* Menu:
+
+* my-tramp-parse: Customizing Completion.
+ (line 89)
+* tramp-bug: Bug Reports. (line 27)
+* tramp-change-syntax: Change file name syntax.
+ (line 10)
+* tramp-cleanup-all-buffers: Cleanup remote connections.
+ (line 27)
+* tramp-cleanup-all-connections: Cleanup remote connections.
+ (line 22)
+* tramp-cleanup-connection: Cleanup remote connections.
+ (line 8)
+* tramp-cleanup-this-connection: Cleanup remote connections.
+ (line 18)
+* tramp-get-completion-function: Customizing Completion.
+ (line 16)
+* tramp-parse-etc-group: Customizing Completion.
+ (line 78)
+* tramp-parse-hosts: Customizing Completion.
+ (line 70)
+* tramp-parse-netrc: Customizing Completion.
+ (line 82)
+* tramp-parse-passwd: Customizing Completion.
+ (line 74)
+* tramp-parse-rhosts: Customizing Completion.
+ (line 40)
+* tramp-parse-sconfig: Customizing Completion.
+ (line 52)
+* tramp-parse-shostkeys: Customizing Completion.
+ (line 57)
+* tramp-parse-shosts: Customizing Completion.
+ (line 46)
+* tramp-parse-sknownhosts: Customizing Completion.
+ (line 63)
+* tramp-set-completion-function: Customizing Completion.
+ (line 25)
+
+
+File: tramp, Node: Variable Index, Next: Concept Index, Prev: Function
Index, Up: Top
+
+Variable Index
+**************
+
+ [index ]
+* Menu:
+
+* ange-ftp-netrc-filename: Password handling. (line 39)
+* async-shell-command-width: Remote processes. (line 165)
+* auth-source-debug: Password handling. (line 37)
+* auth-source-save-behavior: Password handling. (line 31)
+* auth-sources: Password handling. (line 15)
+* auto-save-file-name-transforms: Auto-save and Backup.
+ (line 58)
+* backup-directory-alist: Auto-save and Backup.
+ (line 6)
+* COLUMNS, environment variable: Remote processes. (line 165)
+* DESTDIR, environment variable: Installation parameters.
+ (line 48)
+* DISPLAY, environment variable: Remote processes. (line 93)
+* EDITOR, environment variable: Frequently Asked Questions.
+ (line 536)
+* ENV, environment variable: Remote processes. (line 64)
+* ESHELL, environment variable: Remote shell setup. (line 155)
+* HGPLAIN, environment variable: Remote processes. (line 82)
+* HISTFILE, environment variable: Frequently Asked Questions.
+ (line 277)
+* HISTFILESIZE, environment variable: Frequently Asked Questions.
+ (line 277)
+* HISTORY, environment variable: Remote processes. (line 52)
+* HISTSIZE, environment variable: Frequently Asked Questions.
+ (line 277)
+* INFOPATH, environment variable: Load paths. (line 13)
+* INSIDE_EMACS, environment variable: Remote shell setup. (line 72)
+* INSIDE_EMACS, environment variable <1>: Remote shell setup. (line 155)
+* non-essential: External packages. (line 9)
+* password-cache: Password handling. (line 57)
+* password-cache-expiry: Password handling. (line 52)
+* PATH, environment variable: External methods. (line 182)
+* remote-file-name-inhibit-cache: Frequently Asked Questions.
+ (line 40)
+* REMOTE_TEMPORARY_FILE_DIRECTORY, environment variable: Testing.
+ (line 11)
+* shell-command-switch: Remote processes. (line 158)
+* shell-file-name: Remote processes. (line 158)
+* SHELLNAME, environment variable: Remote shell setup. (line 155)
+* SSH_AUTH_SOCK, environment variable: Windows setup hints. (line 29)
+* TERM, environment variable: Remote shell setup. (line 58)
+* TERM, environment variable <1>: Remote shell setup. (line 72)
+* tramp-actions-before-shell: Remote shell setup. (line 102)
+* tramp-adb-connect-if-not-connected: External methods. (line 190)
+* tramp-adb-program: External methods. (line 182)
+* tramp-archive-all-gvfs-methods: Archive file names. (line 90)
+* tramp-archive-compression-suffixes: Archive file names. (line 82)
+* tramp-archive-suffixes: Archive file names. (line 27)
+* tramp-auto-save-directory: Auto-save and Backup.
+ (line 68)
+* tramp-backup-directory-alist: Auto-save and Backup.
+ (line 37)
+* tramp-completion-function-alist: Customizing Completion.
+ (line 6)
+* tramp-completion-reread-directory-timeout: File name completion.
+ (line 69)
+* tramp-completion-use-auth-sources: File name completion.
+ (line 36)
+* tramp-connection-properties: Predefined connection information.
+ (line 9)
+* tramp-default-host: Default Host. (line 6)
+* tramp-default-host-alist: Default Host. (line 20)
+* tramp-default-method: Default Method. (line 9)
+* tramp-default-method-alist: Default Method. (line 17)
+* tramp-default-proxies-alist: Multi-hops. (line 13)
+* tramp-default-remote-path: Remote programs. (line 19)
+* tramp-default-user: Default User. (line 6)
+* tramp-default-user-alist: Default User. (line 14)
+* tramp-file-name-regexp: Change file name syntax.
+ (line 28)
+* tramp-gvfs-methods: GVFS based methods. (line 60)
+* tramp-histfile-override: Frequently Asked Questions.
+ (line 277)
+* tramp-ignored-file-name-regexp: Frequently Asked Questions.
+ (line 580)
+* tramp-inline-compress-start-size: Inline methods. (line 25)
+* tramp-local-host-regexp: Frequently Asked Questions.
+ (line 161)
+* tramp-methods: Customizing Methods. (line 6)
+* tramp-mode: Frequently Asked Questions.
+ (line 574)
+* tramp-own-remote-path: Remote programs. (line 32)
+* tramp-password-prompt-regexp: Remote shell setup. (line 33)
+* tramp-persistency-file-name: Connection caching. (line 6)
+* tramp-rclone-program: External methods. (line 212)
+* tramp-remote-path: Remote programs. (line 15)
+* tramp-remote-process-environment: Remote processes. (line 38)
+* tramp-restricted-shell-hosts-alist: Multi-hops. (line 84)
+* tramp-save-ad-hoc-proxies: Ad-hoc multi-hops. (line 29)
+* tramp-shell-prompt-pattern: Remote shell setup. (line 25)
+* tramp-ssh-controlmaster-options: Frequently Asked Questions.
+ (line 184)
+* tramp-terminal-type: Remote shell setup. (line 58)
+* tramp-theme-face-remapping-alist: Frequently Asked Questions.
+ (line 257)
+* tramp-use-ssh-controlmaster-options: Frequently Asked Questions.
+ (line 197)
+* tramp-wrong-passwd-regexp: Remote shell setup. (line 33)
+* TRAMP_TEST_ARGS, environment variable: Testing. (line 21)
+
+
+File: tramp, Node: Concept Index, Prev: Variable Index, Up: Top
+
+Concept Index
+*************
+
+ [index ]
+* Menu:
+
+* .login file: Remote shell setup. (line 6)
+* .profile file: Remote shell setup. (line 6)
+* 7z file archive suffix: Archive file names. (line 33)
+* adb method: Quick Start Guide. (line 115)
+* adb method <1>: External methods. (line 181)
+* afp method: Quick Start Guide. (line 95)
+* afp method <1>: GVFS based methods. (line 16)
+* alternative file name syntax: Change file name syntax.
+ (line 6)
+* android: Quick Start Guide. (line 115)
+* android (with adb method): External methods. (line 181)
+* android shell setup for ssh: Android shell setup. (line 6)
+* apk file archive suffix: Archive file names. (line 35)
+* ar file archive suffix: Archive file names. (line 37)
+* archive file names: Archive file names. (line 6)
+* archive method: Archive file names. (line 6)
+* auto-save: Auto-save and Backup.
+ (line 6)
+* backup: Auto-save and Backup.
+ (line 6)
+* base-64 encoding: Inline methods. (line 16)
+* behind the scenes: Overview. (line 44)
+* bug reports: Bug Reports. (line 6)
+* cab file archive suffix: Archive file names. (line 39)
+* CAB file archive suffix: Archive file names. (line 39)
+* caching: Connection caching. (line 6)
+* change file name syntax: Change file name syntax.
+ (line 6)
+* choosing the right method: Default Method. (line 43)
+* cleanup: Cleanup remote connections.
+ (line 6)
+* compile: Remote processes. (line 6)
+* configuration: Configuration. (line 6)
+* connection types, overview: Connection types. (line 6)
+* cpio file archive suffix: Archive file names. (line 41)
+* create your own methods: Customizing Methods. (line 6)
+* customizing completion: Customizing Completion.
+ (line 6)
+* customizing methods: Customizing Methods. (line 6)
+* cygwin and fakecygpty: Windows setup hints. (line 17)
+* cygwin and ssh-agent: Windows setup hints. (line 29)
+* cygwin, issues: Windows setup hints. (line 6)
+* dav method: Quick Start Guide. (line 95)
+* dav method <1>: GVFS based methods. (line 24)
+* davs method: Quick Start Guide. (line 95)
+* davs method <1>: GVFS based methods. (line 24)
+* dbus: GVFS based methods. (line 6)
+* deb file archive suffix: Archive file names. (line 43)
+* default configuration: Configuration. (line 6)
+* default host: Default Host. (line 6)
+* default method: Default Method. (line 6)
+* default user: Default User. (line 6)
+* depot file archive suffix: Archive file names. (line 45)
+* details of operation: Overview. (line 44)
+* doas method: Inline methods. (line 66)
+* docker method: Customizing Methods. (line 15)
+* eshell: Remote processes. (line 175)
+* exe file archive suffix: Archive file names. (line 47)
+* external methods: External methods. (line 6)
+* fakecygpty and cygwin: Windows setup hints. (line 17)
+* FAQ: Frequently Asked Questions.
+ (line 6)
+* fcp method: External methods. (line 73)
+* file archive suffix 7z: Archive file names. (line 33)
+* file archive suffix apk: Archive file names. (line 35)
+* file archive suffix ar: Archive file names. (line 37)
+* file archive suffix cab: Archive file names. (line 39)
+* file archive suffix CAB: Archive file names. (line 39)
+* file archive suffix cpio: Archive file names. (line 41)
+* file archive suffix deb: Archive file names. (line 43)
+* file archive suffix depot: Archive file names. (line 45)
+* file archive suffix exe: Archive file names. (line 47)
+* file archive suffix iso: Archive file names. (line 49)
+* file archive suffix jar: Archive file names. (line 51)
+* file archive suffix lzh: Archive file names. (line 53)
+* file archive suffix LZH: Archive file names. (line 53)
+* file archive suffix msu: Archive file names. (line 55)
+* file archive suffix MSU: Archive file names. (line 55)
+* file archive suffix mtree: Archive file names. (line 57)
+* file archive suffix odb: Archive file names. (line 60)
+* file archive suffix odf: Archive file names. (line 60)
+* file archive suffix odg: Archive file names. (line 60)
+* file archive suffix odp: Archive file names. (line 60)
+* file archive suffix ods: Archive file names. (line 60)
+* file archive suffix odt: Archive file names. (line 60)
+* file archive suffix pax: Archive file names. (line 62)
+* file archive suffix rar: Archive file names. (line 64)
+* file archive suffix rpm: Archive file names. (line 66)
+* file archive suffix shar: Archive file names. (line 68)
+* file archive suffix tar: Archive file names. (line 71)
+* file archive suffix tbz: Archive file names. (line 71)
+* file archive suffix tgz: Archive file names. (line 71)
+* file archive suffix tlz: Archive file names. (line 71)
+* file archive suffix txz: Archive file names. (line 71)
+* file archive suffix warc: Archive file names. (line 72)
+* file archive suffix xar: Archive file names. (line 74)
+* file archive suffix xpi: Archive file names. (line 76)
+* file archive suffix xps: Archive file names. (line 78)
+* file archive suffix zip: Archive file names. (line 80)
+* file archive suffix ZIP: Archive file names. (line 80)
+* file archives: Archive file names. (line 6)
+* file name completion: File name completion.
+ (line 6)
+* file name examples: File name syntax. (line 6)
+* file name syntax: Quick Start Guide. (line 20)
+* file name syntax <1>: File name syntax. (line 6)
+* frequently asked questions: Frequently Asked Questions.
+ (line 6)
+* fsh (with fcp method): External methods. (line 73)
+* fsh method: External methods. (line 83)
+* ftp method: External methods. (line 115)
+* gdb: Remote processes. (line 208)
+* gdrive method: Quick Start Guide. (line 104)
+* gdrive method <1>: GVFS based methods. (line 34)
+* git method: Customizing Methods. (line 37)
+* GNOME Online Accounts: Quick Start Guide. (line 104)
+* GNOME Online Accounts <1>: GVFS based methods. (line 47)
+* google drive: Quick Start Guide. (line 104)
+* google drive <1>: GVFS based methods. (line 34)
+* gud.el: Remote processes. (line 208)
+* gvfs based methods: Quick Start Guide. (line 95)
+* gvfs based methods <1>: GVFS based methods. (line 6)
+* hdfs method: Customizing Methods. (line 43)
+* how it works: Overview. (line 44)
+* http tunnel: Firewalls. (line 6)
+* inline methods: Inline methods. (line 6)
+* installation: Installation. (line 6)
+* installation <1>: Installation parameters.
+ (line 6)
+* installation <2>: Testing. (line 6)
+* installation <3>: Load paths. (line 6)
+* iso file archive suffix: Archive file names. (line 49)
+* jar file archive suffix: Archive file names. (line 51)
+* kerberos (with krlogin method): Inline methods. (line 98)
+* kerberos (with ksu method): Inline methods. (line 103)
+* krlogin method: Inline methods. (line 98)
+* ksu method: Inline methods. (line 103)
+* kubectl method: Customizing Methods. (line 21)
+* lxc method: Customizing Methods. (line 27)
+* lxd method: Customizing Methods. (line 32)
+* lzh file archive suffix: Archive file names. (line 53)
+* LZH file archive suffix: Archive file names. (line 53)
+* method adb: Quick Start Guide. (line 115)
+* method adb <1>: External methods. (line 181)
+* method afp: Quick Start Guide. (line 95)
+* method afp <1>: GVFS based methods. (line 16)
+* method archive: Archive file names. (line 6)
+* method dav: Quick Start Guide. (line 95)
+* method dav <1>: GVFS based methods. (line 24)
+* method davs: Quick Start Guide. (line 95)
+* method davs <1>: GVFS based methods. (line 24)
+* method doas: Inline methods. (line 66)
+* method docker: Customizing Methods. (line 15)
+* method fcp: External methods. (line 73)
+* method fsh: External methods. (line 83)
+* method ftp: External methods. (line 115)
+* method gdrive: Quick Start Guide. (line 104)
+* method gdrive <1>: GVFS based methods. (line 34)
+* method git: Customizing Methods. (line 37)
+* method hdfs: Customizing Methods. (line 43)
+* method krlogin: Inline methods. (line 98)
+* method ksu: Inline methods. (line 103)
+* method kubectl: Customizing Methods. (line 21)
+* method lxc: Customizing Methods. (line 27)
+* method lxd: Customizing Methods. (line 32)
+* method nc: External methods. (line 88)
+* method nextcloud: Quick Start Guide. (line 104)
+* method nextcloud <1>: GVFS based methods. (line 47)
+* method plink: Quick Start Guide. (line 44)
+* method plink <1>: Quick Start Guide. (line 68)
+* method plink <2>: Inline methods. (line 108)
+* method plinkx: Inline methods. (line 119)
+* method pscp: External methods. (line 61)
+* method psftp: External methods. (line 61)
+* method rclone: Quick Start Guide. (line 122)
+* method rclone <1>: External methods. (line 211)
+* method rcp: External methods. (line 17)
+* method rsh: Inline methods. (line 30)
+* method rsync: External methods. (line 37)
+* method scp: External methods. (line 25)
+* method scpx: External methods. (line 48)
+* method scpx with cygwin: Windows setup hints. (line 21)
+* method sftp: Quick Start Guide. (line 95)
+* method sftp <1>: GVFS based methods. (line 55)
+* method sg: Quick Start Guide. (line 56)
+* method sg <1>: Inline methods. (line 72)
+* method smb: Quick Start Guide. (line 87)
+* method smb <1>: External methods. (line 121)
+* method ssh: Quick Start Guide. (line 44)
+* method ssh <1>: Quick Start Guide. (line 68)
+* method ssh <2>: Inline methods. (line 35)
+* method sshx: Inline methods. (line 80)
+* method sshx with cygwin: Windows setup hints. (line 8)
+* method su: Quick Start Guide. (line 56)
+* method su <1>: Quick Start Guide. (line 68)
+* method su <2>: Inline methods. (line 50)
+* method sudo: Quick Start Guide. (line 56)
+* method sudo <1>: Quick Start Guide. (line 68)
+* method sudo <2>: Inline methods. (line 57)
+* method sudoedit: Quick Start Guide. (line 78)
+* method sudoedit <1>: External methods. (line 95)
+* method telnet: Inline methods. (line 45)
+* method vagrant: Customizing Methods. (line 48)
+* methods, external: External methods. (line 6)
+* methods, gvfs: Quick Start Guide. (line 95)
+* methods, gvfs <1>: GVFS based methods. (line 6)
+* methods, inline: Inline methods. (line 6)
+* mimencode: Inline methods. (line 16)
+* ms windows (with smb method): Quick Start Guide. (line 87)
+* ms windows (with smb method) <1>: External methods. (line 121)
+* msu file archive suffix: Archive file names. (line 55)
+* MSU file archive suffix: Archive file names. (line 55)
+* mtree file archive suffix: Archive file names. (line 57)
+* multi-hop: Multi-hops. (line 6)
+* multi-hop, ad-hoc: Ad-hoc multi-hops. (line 6)
+* nc method: External methods. (line 88)
+* nc unix command: Remote shell setup. (line 180)
+* nextcloud: Quick Start Guide. (line 104)
+* nextcloud <1>: GVFS based methods. (line 47)
+* nextcloud method: Quick Start Guide. (line 104)
+* nextcloud method <1>: GVFS based methods. (line 47)
+* obtaining TRAMP: Obtaining TRAMP. (line 6)
+* odb file archive suffix: Archive file names. (line 60)
+* odf file archive suffix: Archive file names. (line 60)
+* odg file archive suffix: Archive file names. (line 60)
+* odp file archive suffix: Archive file names. (line 60)
+* ods file archive suffix: Archive file names. (line 60)
+* odt file archive suffix: Archive file names. (line 60)
+* overview: Overview. (line 6)
+* passwords: Password handling. (line 6)
+* pax file archive suffix: Archive file names. (line 62)
+* perldb: Remote processes. (line 208)
+* plink (with pscp method): External methods. (line 61)
+* plink (with psftp method): External methods. (line 61)
+* plink method: Quick Start Guide. (line 44)
+* plink method <1>: Quick Start Guide. (line 68)
+* plink method <2>: Inline methods. (line 108)
+* plinkx method: Inline methods. (line 119)
+* powershell: Remote processes. (line 239)
+* proxy hosts: Multi-hops. (line 6)
+* proxy hosts, ad-hoc: Ad-hoc multi-hops. (line 6)
+* proxy hosts, http tunnel: Firewalls. (line 6)
+* pscp method: External methods. (line 61)
+* psftp method: External methods. (line 61)
+* putty (with pscp method): External methods. (line 61)
+* putty (with psftp method): External methods. (line 61)
+* quick start guide: Quick Start Guide. (line 6)
+* rar file archive suffix: Archive file names. (line 64)
+* rclone method: Quick Start Guide. (line 122)
+* rclone method <1>: External methods. (line 211)
+* rcp method: External methods. (line 17)
+* recompile: Remote processes. (line 6)
+* remote shell setup: Remote shell setup. (line 6)
+* rpm file archive suffix: Archive file names. (line 66)
+* rsh (with rcp method): External methods. (line 17)
+* rsh method: Inline methods. (line 30)
+* rsync method: External methods. (line 37)
+* scp method: External methods. (line 25)
+* scpx method: External methods. (line 48)
+* scpx method with cygwin: Windows setup hints. (line 21)
+* selecting config files: Customizing Completion.
+ (line 6)
+* separate syntax: Change file name syntax.
+ (line 21)
+* sftp method: Quick Start Guide. (line 95)
+* sftp method <1>: GVFS based methods. (line 55)
+* sg method: Quick Start Guide. (line 56)
+* sg method <1>: Inline methods. (line 72)
+* shar file archive suffix: Archive file names. (line 68)
+* shell: Remote processes. (line 112)
+* shell init files: Remote shell setup. (line 6)
+* shell-command: Remote processes. (line 146)
+* simplified syntax: Change file name syntax.
+ (line 14)
+* smb method: Quick Start Guide. (line 87)
+* smb method <1>: External methods. (line 121)
+* smbclient: Quick Start Guide. (line 87)
+* smbclient <1>: External methods. (line 121)
+* ssh (with rsync method): External methods. (line 37)
+* ssh (with scp method): External methods. (line 25)
+* ssh (with scpx method): External methods. (line 48)
+* ssh method: Quick Start Guide. (line 44)
+* ssh method <1>: Quick Start Guide. (line 68)
+* ssh method <2>: Inline methods. (line 35)
+* sshx method: Inline methods. (line 80)
+* sshx method with cygwin: Windows setup hints. (line 8)
+* SSH_AUTH_SOCK and emacs on ms windows: Windows setup hints. (line 29)
+* su method: Quick Start Guide. (line 56)
+* su method <1>: Quick Start Guide. (line 68)
+* su method <2>: Inline methods. (line 50)
+* sudo method: Quick Start Guide. (line 56)
+* sudo method <1>: Quick Start Guide. (line 68)
+* sudo method <2>: Inline methods. (line 57)
+* sudoedit method: Quick Start Guide. (line 78)
+* sudoedit method <1>: External methods. (line 95)
+* tar file archive suffix: Archive file names. (line 71)
+* tbz file archive suffix: Archive file names. (line 71)
+* telnet (with nc method): External methods. (line 88)
+* telnet method: Inline methods. (line 45)
+* testing: Testing. (line 6)
+* tgz file archive suffix: Archive file names. (line 71)
+* tlz file archive suffix: Archive file names. (line 71)
+* TRAMP theme: Frequently Asked Questions.
+ (line 257)
+* tset unix command: Remote shell setup. (line 92)
+* txz file archive suffix: Archive file names. (line 71)
+* type-ahead: Usage. (line 12)
+* unix command nc: Remote shell setup. (line 180)
+* unix command tset: Remote shell setup. (line 92)
+* using non-standard methods: Customizing Methods. (line 6)
+* using TRAMP: Usage. (line 6)
+* uuencode: Inline methods. (line 16)
+* vagrant method: Customizing Methods. (line 48)
+* warc file archive suffix: Archive file names. (line 72)
+* winexe: Remote processes. (line 239)
+* xar file archive suffix: Archive file names. (line 74)
+* xpi file archive suffix: Archive file names. (line 76)
+* xps file archive suffix: Archive file names. (line 78)
+* zip file archive suffix: Archive file names. (line 80)
+* ZIP file archive suffix: Archive file names. (line 80)
+
+
+
+Tag Table:
+Node: Top928
+Node: Overview5794
+Node: Obtaining TRAMP11123
+Node: Installation12411
+Node: System Requirements12818
+Node: Basic Installation13490
+Node: Installation parameters15669
+Node: Testing18466
+Node: Load paths19628
+Node: Quick Start Guide20269
+Ref: Quick Start Guide: File name syntax21038
+Ref: Quick Start Guide: ssh and plink methods22140
+Ref: Quick Start Guide: su, sudo and sg methods22684
+Ref: Quick Start Guide: ssh, plink, su, sudo and sg methods23248
+Ref: Quick Start Guide: sudoedit method23778
+Ref: Quick Start Guide: smb method24189
+Ref: Quick Start Guide: GVFS-based methods24520
+Ref: Quick Start Guide: GNOME Online Accounts based methods24932
+Ref: Quick Start Guide: Android25474
+Ref: Quick Start Guide: rclone method25706
+Node: Configuration26033
+Node: Connection types28500
+Node: Inline methods29909
+Node: External methods34567
+Node: GVFS based methods45081
+Node: Default Method47966
+Node: Default User50978
+Node: Default Host52496
+Node: Multi-hops53623
+Node: Firewalls57810
+Node: Customizing Methods59262
+Node: Customizing Completion61597
+Node: Password handling65082
+Ref: Using an authentication file65547
+Ref: Caching passwords67049
+Node: Connection caching67567
+Node: Predefined connection information68492
+Node: Remote programs70832
+Node: Remote shell setup73748
+Node: Android shell setup81953
+Node: Auto-save and Backup84335
+Node: Windows setup hints87405
+Node: Usage89020
+Node: File name syntax90313
+Node: Change file name syntax92315
+Node: File name completion93741
+Node: Ad-hoc multi-hops96809
+Node: Remote processes98870
+Ref: Running a debugger on a remote host107619
+Node: Cleanup remote connections109589
+Node: Archive file names111032
+Node: Bug Reports115386
+Node: Frequently Asked Questions117838
+Node: Files directories and localnames140114
+Node: Localname deconstruction140545
+Node: External packages141193
+Node: Traces and Profiles143233
+Node: GNU Free Documentation License145199
+Node: Function Index170565
+Node: Variable Index173164
+Node: Concept Index180407
+
+End Tag Table
+
+
+Local Variables:
+coding: utf-8
+End:
diff --git a/trampver.el b/trampver.el
deleted file mode 120000
index b39883c..0000000
--- a/trampver.el
+++ /dev/null
@@ -1 +0,0 @@
-lisp/trampver.el
\ No newline at end of file