[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/tramp d982d7e: Sync with Tramp repository
|
From: |
Michael Albinus |
|
Subject: |
[elpa] externals/tramp d982d7e: Sync with Tramp repository |
|
Date: |
Tue, 22 Dec 2020 08:52:52 -0500 (EST) |
branch: externals/tramp
commit d982d7e8eb698dc9ec4a591b3e1845c4502e74fa
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>
Sync with Tramp repository
---
.elpaignore | 2 -
.gitignore | 2 +
Makefile | 9 +
test/tramp-tests.el | 995 +++++++++++++++++++++----------
texi/Makefile | 4 +-
texi/tramp.texi | 469 ++++++++++++---
texi/trampver.texi | 5 +-
tramp-adb.el | 783 ++++++++++++-------------
tramp-archive.el | 27 +-
tramp-cache.el | 256 ++++----
tramp-cmds.el | 74 +--
tramp-compat.el | 193 +++---
tramp-crypt.el | 844 ++++++++++++++++++++++++++
tramp-ftp.el | 22 +-
tramp-gvfs.el | 875 +++++++++++++++++++--------
tramp-integration.el | 34 +-
tramp-loaddefs.el | 686 ----------------------
tramp-rclone.el | 38 +-
tramp-sh.el | 1591 +++++++++++++++++++++++++-------------------------
tramp-smb.el | 295 +++++-----
tramp-sudoedit.el | 138 ++---
tramp-uu.el | 5 -
tramp.el | 1222 ++++++++++++++++++++++++--------------
tramp.info | 489 ----------------
trampver.el | 28 +-
25 files changed, 5082 insertions(+), 4004 deletions(-)
diff --git a/.elpaignore b/.elpaignore
index 002a1eb..549c258 100644
--- a/.elpaignore
+++ b/.elpaignore
@@ -2,6 +2,4 @@
.elpaignore
.git
.gitignore
-Makefile
-texi/Makefile
README-GIT
diff --git a/.gitignore b/.gitignore
index c4d5650..d10581e 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,3 +1,5 @@
tramp-autoloads.el
+tramp-loaddefs.el
tramp-pkg.el
*.elc
+tramp.info
diff --git a/Makefile b/Makefile
index c2276c3..3199227 100644
--- a/Makefile
+++ b/Makefile
@@ -18,8 +18,10 @@
EMACS = emacs -Q -batch -L .
LISP_FILES = $(wildcard *.el)
+CLEAN_FILES = .\\\#* \\\#* .*~ *~ *.elc *.log
SOURCE_DIR = ~/src/tramp
+
.PHONY: all autoloads check info sync test
.SUFFIXES: .el
@@ -40,6 +42,12 @@ info:
check test: autoloads
$(MAKE) -C test "TRAMP_TEST_ARGS=$(TRAMP_TEST_ARGS)" all
+clean:
+ $(RM) $(CLEAN_FILES)
+ for a in texi test; do \
+ $(MAKE) -C $$a clean; \
+ done
+
# This target is for the maintainer only.
sync:
cp -p $(SOURCE_DIR)/lisp/tramp-adb.el tramp-adb.el
@@ -47,6 +55,7 @@ sync:
cp -p $(SOURCE_DIR)/lisp/tramp-cache.el tramp-cache.el
cp -p $(SOURCE_DIR)/lisp/tramp-cmds.el tramp-cmds.el
cp -p $(SOURCE_DIR)/lisp/tramp-compat.el tramp-compat.el
+ cp -p $(SOURCE_DIR)/lisp/tramp-crypt.el tramp-crypt.el
cp -p $(SOURCE_DIR)/lisp/tramp-ftp.el tramp-ftp.el
cp -p $(SOURCE_DIR)/lisp/tramp-gvfs.el tramp-gvfs.el
cp -p $(SOURCE_DIR)/lisp/tramp-integration.el tramp-integration.el
diff --git a/test/tramp-tests.el b/test/tramp-tests.el
index d2cbc86..13bbb02 100644
--- a/test/tramp-tests.el
+++ b/test/tramp-tests.el
@@ -4,18 +4,20 @@
;; Author: Michael Albinus <michael.albinus@gmx.de>
-;; This program is free software: you can redistribute it and/or
+;; 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.
;;
-;; This program is distributed in the hope that it will be useful, but
+;; 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 this program. If not, see `https://www.gnu.org/licenses/'.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -43,6 +45,7 @@
(require 'dired)
(require 'ert)
(require 'ert-x)
+(require 'trace)
(require 'tramp)
(require 'vc)
(require 'vc-bzr)
@@ -50,14 +53,13 @@
(require 'vc-hg)
(declare-function tramp-find-executable "tramp-sh")
+(declare-function tramp-get-remote-chmod-h "tramp-sh")
(declare-function tramp-get-remote-gid "tramp-sh")
(declare-function tramp-get-remote-path "tramp-sh")
(declare-function tramp-get-remote-perl "tramp-sh")
(declare-function tramp-get-remote-stat "tramp-sh")
(declare-function tramp-list-tramp-buffers "tramp-cmds")
-(declare-function tramp-method-out-of-band-p "tramp-sh")
(declare-function tramp-smb-get-localname "tramp-smb")
-(declare-function tramp-time-diff "tramp")
(defvar ange-ftp-make-backup-files)
(defvar auto-save-file-name-transforms)
(defvar tramp-connection-properties)
@@ -68,8 +70,6 @@
(defvar tramp-remote-path)
(defvar tramp-remote-process-environment)
-;; Needed for Emacs 24.
-(defvar inhibit-message)
;; Needed for Emacs 25.
(defvar connection-local-criteria-alist)
(defvar connection-local-profile-alist)
@@ -98,25 +98,30 @@
'("mock"
(tramp-login-program "sh")
(tramp-login-args (("-i")))
+ (tramp-direct-async-args (("-c")))
(tramp-remote-shell "/bin/sh")
(tramp-remote-shell-args ("-c"))
(tramp-connection-timeout 10)))
(add-to-list
'tramp-default-host-alist
`("\\`mock\\'" nil ,(system-name)))
- ;; Emacs' Makefile sets $HOME to a nonexistent value. Needed in
- ;; batch mode only, therefore.
+ ;; Emacs's Makefile sets $HOME to a nonexistent value. Needed
+ ;; in batch mode only, therefore.
(unless (and (null noninteractive) (file-directory-p "~/"))
(setenv "HOME" temporary-file-directory))
(format "/mock::%s" temporary-file-directory)))
"Temporary directory for Tramp tests.")
+(defconst tramp-test-vec
+ (and (file-remote-p tramp-test-temporary-file-directory)
+ (tramp-dissect-file-name tramp-test-temporary-file-directory))
+ "The used `tramp-file-name' structure.")
+
(setq auth-source-save-behavior nil
password-cache-expiry nil
remote-file-name-inhibit-cache nil
tramp-cache-read-persistent-data t ;; For auth-sources.
tramp-copy-size-limit nil
- tramp-message-show-message nil
tramp-persistency-file-name nil
tramp-verbose 0)
@@ -144,9 +149,7 @@ being the result.")
(when (cdr tramp--test-enabled-checked)
;; Cleanup connection.
(ignore-errors
- (tramp-cleanup-connection
- (tramp-dissect-file-name tramp-test-temporary-file-directory)
- nil 'keep-password)))
+ (tramp-cleanup-connection tramp-test-vec nil 'keep-password)))
;; Return result.
(cdr tramp--test-enabled-checked))
@@ -177,38 +180,46 @@ This shall used dynamically bound only.")
(defmacro tramp--test-instrument-test-case (verbose &rest body)
"Run BODY with `tramp-verbose' equal VERBOSE.
Print the content of the Tramp connection and debug buffers, if
-`tramp-verbose' is greater than 3. `should-error' is not handled
-properly. BODY shall not contain a timeout."
+`tramp-verbose' is greater than 3. Print traces if `tramp-verbose'
+is greater than 10.
+`should-error' is not handled properly. BODY shall not contain a timeout."
(declare (indent 1) (debug (natnump body)))
- `(let ((tramp-verbose (max (or ,verbose 0) (or tramp-verbose 0)))
- (tramp-message-show-message t)
- (debug-ignored-errors
- (append
- '("^make-symbolic-link not supported$"
- "^error with add-name-to-file")
- debug-ignored-errors))
- inhibit-message)
+ `(let* ((tramp-verbose (max (or ,verbose 0) (or tramp-verbose 0)))
+ (trace-buffer
+ (when (> tramp-verbose 10) (generate-new-buffer " *temp*")))
+ (debug-ignored-errors
+ (append
+ '("^make-symbolic-link not supported$"
+ "^error with add-name-to-file")
+ debug-ignored-errors))
+ inhibit-message)
+ (when trace-buffer
+ (dolist (elt (all-completions "tramp-" obarray 'functionp))
+ (trace-function-background (intern elt))))
(unwind-protect
(let ((tramp--test-instrument-test-case-p t)) ,@body)
;; Unwind forms.
+ (when trace-buffer
+ (untrace-all))
(when (and (null tramp--test-instrument-test-case-p) (> tramp-verbose
3))
- (dolist (buf (tramp-list-tramp-buffers))
+ (dolist
+ (buf (if trace-buffer
+ (cons (get-buffer trace-buffer)
(tramp-list-tramp-buffers))
+ (tramp-list-tramp-buffers)))
(with-current-buffer buf
- (message ";; %s\n%s" buf (buffer-string))))))))
+ (message ";; %s\n%s" buf (buffer-string)))))
+ (when trace-buffer
+ (kill-buffer trace-buffer)))))
(defsubst tramp--test-message (fmt-string &rest arguments)
"Emit a message into ERT *Messages*."
(tramp--test-instrument-test-case 0
- (apply
- #'tramp-message
- (tramp-dissect-file-name tramp-test-temporary-file-directory) 0
- fmt-string arguments)))
+ (apply #'tramp-message tramp-test-vec 0 fmt-string arguments)))
(defsubst tramp--test-backtrace ()
"Dump a backtrace into ERT *Messages*."
(tramp--test-instrument-test-case 10
- (tramp-backtrace
- (tramp-dissect-file-name tramp-test-temporary-file-directory))))
+ (tramp-backtrace tramp-test-vec)))
(defmacro tramp--test-print-duration (message &rest body)
"Run BODY and print a message with duration, prompted by MESSAGE."
@@ -1970,9 +1981,9 @@ properly. BODY shall not contain a timeout."
;; Host names must match rules in case the command template of a
;; method doesn't use them.
(dolist (m '("su" "sg" "sudo" "doas" "ksu"))
- (let ((vec (tramp-dissect-file-name tramp-test-temporary-file-directory))
- tramp-connection-properties tramp-default-proxies-alist)
- (ignore-errors (tramp-cleanup-connection vec nil 'keep-password))
+ (let (tramp-connection-properties tramp-default-proxies-alist)
+ (ignore-errors
+ (tramp-cleanup-connection tramp-test-vec nil 'keep-password))
;; Single hop. The host name must match `tramp-local-host-regexp'.
(should-error
(find-file (format "/%s:foo:" m))
@@ -1992,16 +2003,17 @@ properly. BODY shall not contain a timeout."
(skip-unless (tramp--test-enabled))
;; Multi hops are allowed for inline methods only.
- (should-error
- (file-remote-p "/ssh:user1@host1|method:user2@host2:/path/to/file")
- :type 'user-error)
- (should-error
- (file-remote-p "/method:user1@host1|ssh:user2@host2:/path/to/file")
- :type 'user-error)
+ (let (non-essential)
+ (should-error
+ (expand-file-name "/ssh:user1@host1|method:user2@host2:/path/to/file")
+ :type 'user-error)
+ (should-error
+ (expand-file-name "/method:user1@host1|ssh:user2@host2:/path/to/file")
+ :type 'user-error))
;; Samba does not support file names with periods followed by
;; spaces, and trailing periods or spaces.
- (when (tramp-smb-file-name-p tramp-test-temporary-file-directory)
+ (when (tramp--test-smb-p)
(dolist (file '("foo." "foo. bar" "foo "))
(should-error
(tramp-smb-get-localname
@@ -2013,8 +2025,12 @@ properly. BODY shall not contain a timeout."
"Check `substitute-in-file-name'."
(skip-unless (eq tramp-syntax 'default))
- ;; Suppress method name check.
- (let ((tramp-methods (cons '("method") tramp-methods)))
+ ;; Suppress method name check. We cannot use the string "foo" as
+ ;; user name, because (substitute-in-string "/~foo") returns
+ ;; different values depending on the existence of user "foo" (see
+ ;; Bug#43052).
+ (let ((tramp-methods (cons '("method") tramp-methods))
+ (foo (downcase (md5 (current-time-string)))))
(should
(string-equal (substitute-in-file-name "/method:host:///foo") "/foo"))
(should
@@ -2043,39 +2059,43 @@ properly. BODY shall not contain a timeout."
"/method:host:/:/path//foo"))
;; Forwhatever reasons, the following tests let Emacs crash for
- ;; Emacs 24 and Emacs 25, occasionally. No idea what's up.
+ ;; Emacs 25, occasionally. No idea what's up.
(when (tramp--test-emacs26-p)
(should
- (string-equal (substitute-in-file-name "/method:host://~foo") "/~foo"))
+ (string-equal
+ (substitute-in-file-name (concat "/method:host://~" foo))
+ (concat "/~" foo)))
(should
(string-equal
- (substitute-in-file-name "/method:host:/~foo") "/method:host:/~foo"))
+ (substitute-in-file-name (concat "/method:host:/~" foo))
+ (concat "/method:host:/~" foo)))
(should
(string-equal
- (substitute-in-file-name "/method:host:/path//~foo") "/~foo"))
+ (substitute-in-file-name (concat "/method:host:/path//~" foo))
+ (concat "/~" foo)))
;; (substitute-in-file-name "/path/~foo") expands only for a local
;; user "foo" to "/~foo"". Otherwise, it doesn't expand.
(should
(string-equal
- (substitute-in-file-name "/method:host:/path/~foo")
- "/method:host:/path/~foo"))
+ (substitute-in-file-name (concat "/method:host:/path/~" foo))
+ (concat "/method:host:/path/~" foo)))
;; Quoting local part.
(should
(string-equal
- (substitute-in-file-name "/method:host:/://~foo")
- "/method:host:/://~foo"))
+ (substitute-in-file-name (concat "/method:host:/://~" foo))
+ (concat "/method:host:/://~" foo)))
(should
(string-equal
- (substitute-in-file-name
- "/method:host:/:/~foo") "/method:host:/:/~foo"))
+ (substitute-in-file-name (concat "/method:host:/:/~" foo))
+ (concat "/method:host:/:/~" foo)))
(should
(string-equal
- (substitute-in-file-name "/method:host:/:/path//~foo")
- "/method:host:/:/path//~foo"))
+ (substitute-in-file-name (concat "/method:host:/:/path//~" foo))
+ (concat "/method:host:/:/path//~" foo)))
(should
(string-equal
- (substitute-in-file-name "/method:host:/:/path/~foo")
- "/method:host:/:/path/~foo")))
+ (substitute-in-file-name (concat "/method:host:/:/path/~" foo))
+ (concat "/method:host:/:/path/~" foo))))
(let (process-environment)
(should
@@ -2215,11 +2235,10 @@ This checks also `file-name-as-directory',
`file-name-directory',
;; Bug#10085.
(when (tramp--test-enabled) ;; Packages like tramp-gvfs.el might be disabled.
- (dolist (n-e '(nil t))
+ (dolist (non-essential '(nil t))
;; We must clear `tramp-default-method'. On hydra, it is "ftp",
;; which ruins the tests.
- (let ((non-essential n-e)
- (tramp-default-method
+ (let ((tramp-default-method
(file-remote-p tramp-test-temporary-file-directory 'method))
(host (file-remote-p tramp-test-temporary-file-directory 'host)))
(dolist
@@ -2235,7 +2254,7 @@ This checks also `file-name-as-directory',
`file-name-directory',
(should
(string-equal
(file-name-as-directory file)
- (if (tramp-completion-mode-p)
+ (if non-essential
file (concat file (if (tramp--test-ange-ftp-p) "/" "./")))))
(should (string-equal (file-name-directory file) file))
(should (string-equal (file-name-nondirectory file) "")))))))
@@ -2250,7 +2269,28 @@ This checks also `file-name-as-directory',
`file-name-directory',
(write-region "foo" nil tmp-name)
(should (file-exists-p tmp-name))
(delete-file tmp-name)
- (should-not (file-exists-p tmp-name)))))
+ (should-not (file-exists-p tmp-name))
+
+ ;; Trashing files doesn't work for crypted remote files.
+ (unless (tramp--test-crypt-p)
+ (let ((trash-directory (tramp--test-make-temp-name 'local quoted))
+ (delete-by-moving-to-trash t))
+ (make-directory trash-directory)
+ (should-not (file-exists-p tmp-name))
+ (write-region "foo" nil tmp-name)
+ (should (file-exists-p tmp-name))
+ (delete-file tmp-name 'trash)
+ (should-not (file-exists-p tmp-name))
+ (should
+ (or (file-exists-p
+ (expand-file-name
+ (file-name-nondirectory tmp-name) trash-directory))
+ ;; Gdrive.
+ (file-symlink-p
+ (expand-file-name
+ (file-name-nondirectory tmp-name) trash-directory))))
+ (delete-directory trash-directory 'recursive)
+ (should-not (file-exists-p trash-directory)))))))
(ert-deftest tramp-test08-file-local-copy ()
"Check `file-local-copy'."
@@ -2293,16 +2333,25 @@ This checks also `file-name-as-directory',
`file-name-directory',
(unwind-protect
(with-temp-buffer
(write-region "foo" nil tmp-name)
- (insert-file-contents tmp-name)
- (should (string-equal (buffer-string) "foo"))
- (insert-file-contents tmp-name)
- (should (string-equal (buffer-string) "foofoo"))
+ (let ((point (point)))
+ (insert-file-contents tmp-name)
+ (should (string-equal (buffer-string) "foo"))
+ (should (= point (point))))
+ (goto-char (1+ (point)))
+ (let ((point (point)))
+ (insert-file-contents tmp-name)
+ (should (string-equal (buffer-string) "ffoooo"))
+ (should (= point (point))))
;; Insert partly.
- (insert-file-contents tmp-name nil 1 3)
- (should (string-equal (buffer-string) "oofoofoo"))
+ (let ((point (point)))
+ (insert-file-contents tmp-name nil 1 3)
+ (should (string-equal (buffer-string) "foofoooo"))
+ (should (= point (point))))
;; Replace.
- (insert-file-contents tmp-name nil nil nil 'replace)
- (should (string-equal (buffer-string) "foo"))
+ (let ((point (point)))
+ (insert-file-contents tmp-name nil nil nil 'replace)
+ (should (string-equal (buffer-string) "foo"))
+ (should (= point (point))))
;; Error case.
(delete-file tmp-name)
(should-error
@@ -2380,7 +2429,7 @@ This checks also `file-name-as-directory',
`file-name-directory',
;; Check message.
;; Macro `ert-with-message-capture' was introduced in Emacs 26.1.
(with-no-warnings (when (symbol-plist 'ert-with-message-capture)
- (let ((tramp-message-show-message t))
+ (let (inhibit-message)
(dolist
(noninteractive (unless (tramp--test-ange-ftp-p) '(nil t)))
(dolist (visit '(nil t "string" no-message))
@@ -2406,7 +2455,7 @@ This checks also `file-name-as-directory',
`file-name-directory',
(should-error
(cl-letf (((symbol-function #'y-or-n-p) #'ignore)
;; Ange-FTP.
- ((symbol-function 'yes-or-no-p) 'ignore))
+ ((symbol-function #'yes-or-no-p) #'ignore))
(write-region "foo" nil tmp-name nil nil nil 'mustbenew))
:type 'file-already-exists)
(should-error
@@ -2733,7 +2782,53 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(delete-directory tmp-name1)
:type 'file-error)
(delete-directory tmp-name1 'recursive)
- (should-not (file-directory-p tmp-name1)))))
+ (should-not (file-directory-p tmp-name1))
+
+ ;; Trashing directories works only since Emacs 27.1. It doesn't
+ ;; work for crypted remote directories and for ange-ftp.
+ (when (and (not (tramp--test-crypt-p)) (not (tramp--test-ftp-p))
+ (tramp--test-emacs27-p))
+ (let ((trash-directory (tramp--test-make-temp-name 'local quoted))
+ (delete-by-moving-to-trash t))
+ (make-directory trash-directory)
+ ;; Delete empty directory.
+ (make-directory tmp-name1)
+ (should (file-directory-p tmp-name1))
+ (delete-directory tmp-name1 nil 'trash)
+ (should-not (file-directory-p tmp-name1))
+ (should
+ (file-exists-p
+ (expand-file-name
+ (file-name-nondirectory tmp-name1) trash-directory)))
+ (delete-directory trash-directory 'recursive)
+ (should-not (file-exists-p trash-directory))
+ ;; Delete non-empty directory.
+ (make-directory tmp-name1)
+ (should (file-directory-p tmp-name1))
+ (write-region "foo" nil (expand-file-name "bla" tmp-name1))
+ (should (file-exists-p (expand-file-name "bla" tmp-name1)))
+ (make-directory tmp-name2)
+ (should (file-directory-p tmp-name2))
+ (write-region "foo" nil (expand-file-name "bla" tmp-name2))
+ (should (file-exists-p (expand-file-name "bla" tmp-name2)))
+ (should-error
+ (delete-directory tmp-name1 nil 'trash)
+ ;; tramp-rclone.el calls the local `delete-directory'.
+ ;; This raises another error.
+ :type (if (tramp--test-rclone-p) 'error 'file-error))
+ (delete-directory tmp-name1 'recursive 'trash)
+ (should-not (file-directory-p tmp-name1))
+ (should
+ (file-exists-p
+ (format
+ "%s/%s/bla" trash-directory (file-name-nondirectory tmp-name1))))
+ (should
+ (file-exists-p
+ (format
+ "%s/%s/%s/bla" trash-directory (file-name-nondirectory tmp-name1)
+ (file-name-nondirectory tmp-name2))))
+ (delete-directory trash-directory 'recursive)
+ (should-not (file-exists-p trash-directory)))))))
(ert-deftest tramp-test15-copy-directory ()
"Check `copy-directory'."
@@ -2833,7 +2928,15 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
'("bla" "foo")))
(should (equal (directory-files
tmp-name1 'full directory-files-no-dot-files-regexp)
- `(,tmp-name2 ,tmp-name3))))
+ `(,tmp-name2 ,tmp-name3)))
+ ;; Check the COUNT arg. It exists since Emacs 28.
+ (when (tramp--test-emacs28-p)
+ (with-no-warnings
+ (should
+ (equal
+ (directory-files
+ tmp-name1 nil directory-files-no-dot-files-regexp nil 1)
+ '("bla"))))))
;; Cleanup.
(ignore-errors (delete-directory tmp-name1 'recursive))))))
@@ -2910,6 +3013,9 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
;; (this is performed by `dired'). If FULL is nil, it shows just
;; one file. So we refrain from testing.
(skip-unless (not (tramp--test-ange-ftp-p)))
+ ;; `insert-directory' of crypted remote directories works only since
+ ;; Emacs 27.1.
+ (skip-unless (or (not (tramp--test-crypt-p)) (tramp--test-emacs27-p)))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(let* ((tmp-name1
@@ -2980,6 +3086,8 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-rsync-p)))
+ ;; Wildcards are not supported in tramp-crypt.el.
+ (skip-unless (not (tramp--test-crypt-p)))
;; Since Emacs 26.1.
(skip-unless (fboundp 'insert-directory-wildcard-in-dir-p))
@@ -3129,8 +3237,7 @@ This tests also `access-file', `file-readable-p',
(setq test-file-ownership-preserved-p
(= (tramp-compat-file-attribute-group-id
(file-attributes tmp-name1))
- (tramp-get-remote-gid
- (tramp-dissect-file-name tmp-name1) 'integer)))
+ (tramp-get-remote-gid tramp-test-vec 'integer)))
(delete-file tmp-name1))
(should-error
@@ -3347,7 +3454,14 @@ They might differ only in time attributes or directory
size."
(file-attributes (car elt)) (cdr elt))))
(setq attr (directory-files-and-attributes tmp-name2 nil "\\`b"))
- (should (equal (mapcar #'car attr) '("bar" "boz"))))
+ (should (equal (mapcar #'car attr) '("bar" "boz")))
+
+ ;; Check the COUNT arg. It exists since Emacs 28.
+ (when (tramp--test-emacs28-p)
+ (with-no-warnings
+ (setq attr (directory-files-and-attributes
+ tmp-name2 nil "\\`b" nil nil 1))
+ (should (equal (mapcar #'car attr) '("bar"))))))
;; Cleanup.
(ignore-errors (delete-directory tmp-name1 'recursive))))))
@@ -3365,25 +3479,80 @@ This tests also `file-executable-p', `file-writable-p'
and `set-file-modes'."
"ftp" (file-remote-p tramp-test-temporary-file-directory 'method)))))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
- (let ((tmp-name (tramp--test-make-temp-name nil quoted)))
+ (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
+ (tmp-name2 (tramp--test-make-temp-name nil quoted)))
+
(unwind-protect
(progn
- (write-region "foo" nil tmp-name)
- (should (file-exists-p tmp-name))
- (set-file-modes tmp-name #o777)
- (should (= (file-modes tmp-name) #o777))
- (should (file-executable-p tmp-name))
- (should (file-writable-p tmp-name))
- (set-file-modes tmp-name #o444)
- (should (= (file-modes tmp-name) #o444))
- (should-not (file-executable-p tmp-name))
+ (write-region "foo" nil tmp-name1)
+ (should (file-exists-p tmp-name1))
+ (set-file-modes tmp-name1 #o777)
+ (should (= (file-modes tmp-name1) #o777))
+ (should (file-executable-p tmp-name1))
+ (should (file-writable-p tmp-name1))
+ (set-file-modes tmp-name1 #o444)
+ (should (= (file-modes tmp-name1) #o444))
+ (should-not (file-executable-p tmp-name1))
;; A file is always writable for user "root".
(unless (zerop (tramp-compat-file-attribute-user-id
- (file-attributes tmp-name)))
- (should-not (file-writable-p tmp-name))))
+ (file-attributes tmp-name1)))
+ (should-not (file-writable-p tmp-name1)))
+ ;; Check the NOFOLLOW arg. It exists since Emacs 28. For
+ ;; regular files, there shouldn't be a difference.
+ (when (tramp--test-emacs28-p)
+ (with-no-warnings
+ (set-file-modes tmp-name1 #o222 'nofollow)
+ (should (= (file-modes tmp-name1 'nofollow) #o222)))))
;; Cleanup.
- (ignore-errors (delete-file tmp-name))))))
+ (ignore-errors (delete-file tmp-name1)))
+
+ ;; Check the NOFOLLOW arg. It exists since Emacs 28. It is
+ ;; implemented for tramp-gvfs.el and tramp-sh.el. However,
+ ;; tramp-gvfs,el does not support creating symbolic links. And
+ ;; in tramp-sh.el, we must ensure that the remote chmod command
+ ;; supports the "-h" argument.
+ (when (and (tramp--test-emacs28-p) (tramp--test-sh-p)
+ (tramp-get-remote-chmod-h tramp-test-vec))
+ (unwind-protect
+ (with-no-warnings
+ (write-region "foo" nil tmp-name1)
+ (should (file-exists-p tmp-name1))
+ (make-symbolic-link tmp-name1 tmp-name2)
+ (should
+ (string-equal
+ (funcall
+ (if quoted #'tramp-compat-file-name-unquote #'identity)
+ (file-remote-p tmp-name1 'localname))
+ (file-symlink-p tmp-name2)))
+ ;; Both report the modes of `tmp-name1'.
+ (should
+ (= (file-modes tmp-name1) (file-modes tmp-name2)))
+ ;; `tmp-name1' is a regular file. NOFOLLOW doesn't matter.
+ (should
+ (= (file-modes tmp-name1) (file-modes tmp-name1 'nofollow)))
+ ;; `tmp-name2' is a symbolic link. It has different permissions.
+ (should-not
+ (= (file-modes tmp-name2) (file-modes tmp-name2 'nofollow)))
+ (should-not
+ (= (file-modes tmp-name1 'nofollow)
+ (file-modes tmp-name2 'nofollow)))
+ ;; Change permissions.
+ (set-file-modes tmp-name1 #o200)
+ (set-file-modes tmp-name2 #o200)
+ (should
+ (= (file-modes tmp-name1) (file-modes tmp-name2) #o200))
+ ;; Change permissions with NOFOLLOW.
+ (set-file-modes tmp-name1 #o300 'nofollow)
+ (set-file-modes tmp-name2 #o300 'nofollow)
+ (should
+ (= (file-modes tmp-name1 'nofollow)
+ (file-modes tmp-name2 'nofollow)))
+ (should-not (= (file-modes tmp-name1) (file-modes tmp-name2))))
+
+ ;; Cleanup.
+ (ignore-errors (delete-file tmp-name1))
+ (ignore-errors (delete-file tmp-name2)))))))
;; Method "smb" could run into "NT_STATUS_REVISION_MISMATCH" error.
(defmacro tramp--test-ignore-add-name-to-file-error (&rest body)
@@ -3467,7 +3636,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
;; `tmp-name3' is a local file name. Therefore, the link
;; target remains unchanged, even if quoted.
;; `make-symbolic-link' might not be permitted on w32 systems.
- (unless (tramp--test-windows-nt)
+ (unless (tramp--test-windows-nt-p)
(make-symbolic-link tmp-name1 tmp-name3)
(should
(string-equal tmp-name1 (file-symlink-p tmp-name3))))
@@ -3581,7 +3750,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(concat (file-remote-p tmp-name2) penguin)))))
;; `tmp-name3' is a local file name.
;; `make-symbolic-link' might not be permitted on w32 systems.
- (unless (tramp--test-windows-nt)
+ (unless (tramp--test-windows-nt-p)
(make-symbolic-link tmp-name1 tmp-name3)
(should (file-symlink-p tmp-name3))
(should-not (string-equal tmp-name3 (file-truename tmp-name3)))
@@ -3642,7 +3811,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(tramp--test-ignore-make-symbolic-link-error
(make-symbolic-link tmp-name2 tmp-name1)
(should (file-symlink-p tmp-name1))
- (if (tramp-smb-file-name-p tramp-test-temporary-file-directory)
+ (if (tramp--test-smb-p)
;; The symlink command of `smbclient' detects the
;; cycle already.
(should-error
@@ -3705,7 +3874,17 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(should (file-newer-than-file-p tmp-name2 tmp-name1))
;; `tmp-name3' does not exist.
(should (file-newer-than-file-p tmp-name2 tmp-name3))
- (should-not (file-newer-than-file-p tmp-name3 tmp-name1))))
+ (should-not (file-newer-than-file-p tmp-name3 tmp-name1))
+ ;; Check the NOFOLLOW arg. It exists since Emacs 28. For
+ ;; regular files, there shouldn't be a difference.
+ (when (tramp--test-emacs28-p)
+ (with-no-warnings
+ (set-file-times tmp-name1 (seconds-to-time 1) 'nofollow)
+ (should
+ (tramp-compat-time-equal-p
+ (tramp-compat-file-attribute-modification-time
+ (file-attributes tmp-name1))
+ (seconds-to-time 1)))))))
;; Cleanup.
(ignore-errors
@@ -3745,6 +3924,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
"Check that `file-acl' and `set-file-acl' work proper."
(skip-unless (tramp--test-enabled))
(skip-unless (file-acl tramp-test-temporary-file-directory))
+ (skip-unless (not (tramp--test-crypt-p)))
;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579.
(dolist (quoted (if (and (tramp--test-expensive-test)
(tramp--test-emacs27-p))
@@ -3823,6 +4003,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(skip-unless
(not (equal (file-selinux-context tramp-test-temporary-file-directory)
'(nil nil nil nil))))
+ (skip-unless (not (tramp--test-crypt-p)))
;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579.
(dolist (quoted (if (and (tramp--test-expensive-test)
(tramp--test-emacs27-p))
@@ -3966,7 +4147,6 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(when (not (memq system-type '(cygwin windows-nt)))
(let ((method (file-remote-p tramp-test-temporary-file-directory 'method))
(host (file-remote-p tramp-test-temporary-file-directory 'host))
- (vec (tramp-dissect-file-name tramp-test-temporary-file-directory))
(orig-syntax tramp-syntax))
(when (and (stringp host) (string-match tramp-host-with-port-regexp
host))
(setq host (match-string 1 host)))
@@ -3979,7 +4159,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(tramp-change-syntax syntax)
;; This has cleaned up all connection data, which are used
;; for completion. We must refill the cache.
- (tramp-set-connection-property vec "property" nil)
+ (tramp-set-connection-property tramp-test-vec "property" nil)
(let ;; This is needed for the `simplified' syntax.
((method-marker
@@ -4035,10 +4215,9 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
;; Cleanup.
(tramp-change-syntax orig-syntax))))
- (dolist (n-e '(nil t))
+ (dolist (non-essential '(nil t))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
- (let ((non-essential n-e)
- (tmp-name (tramp--test-make-temp-name nil quoted)))
+ (let ((tmp-name (tramp--test-make-temp-name nil quoted)))
(unwind-protect
(progn
@@ -4128,6 +4307,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
+ (skip-unless (not (tramp--test-crypt-p)))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(let* ((tmp-name (tramp--test-make-temp-name nil quoted))
@@ -4206,6 +4386,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
+ (skip-unless (not (tramp--test-crypt-p)))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(let ((default-directory tramp-test-temporary-file-directory)
@@ -4224,9 +4405,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
(while (accept-process-output proc 0 nil t))))
- ;; We cannot use `string-equal', because tramp-adb.el
- ;; echoes also the sent string.
- (should (string-match "\\`foo" (buffer-string))))
+ (should (string-match "foo" (buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc)))
@@ -4245,7 +4424,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
(while (accept-process-output proc 0 nil t))))
- (should (string-equal (buffer-string) "foo")))
+ (should (string-match "foo" (buffer-string))))
;; Cleanup.
(ignore-errors
@@ -4267,9 +4446,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
(while (accept-process-output proc 0 nil t))))
- ;; We cannot use `string-equal', because tramp-adb.el
- ;; echoes also the sent string.
- (should (string-match "\\`foo" (buffer-string))))
+ (should (string-match "foo" (buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc)))
@@ -4277,27 +4454,55 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
;; PTY.
(unwind-protect
(with-temp-buffer
- (if (not (tramp--test-sh-p))
+ ;; It works only for tramp-sh.el, and not direct async processes.
+ (if (or (not (tramp--test-sh-p)) (tramp-direct-async-process-p))
(should-error
(start-file-process "test4" (current-buffer) nil)
:type 'wrong-type-argument)
+
(setq proc (start-file-process "test4" (current-buffer) nil))
(should (processp proc))
(should (equal (process-status proc) 'run))
;; On MS Windows, `process-tty-name' returns nil.
- (unless (tramp--test-windows-nt)
+ (unless (tramp--test-windows-nt-p)
(should (stringp (process-tty-name proc))))))
;; Cleanup.
(ignore-errors (delete-process proc))))))
+(defmacro tramp--test--deftest-direct-async-process
+ (test docstring &optional unstable)
+ "Define ert test `TEST-direct-async' for direct async processes.
+If UNSTABLE is non-nil, the test is tagged as `:unstable'."
+ (declare (indent 1))
+ `(ert-deftest ,(intern (concat (symbol-name test) "-direct-async")) ()
+ ,docstring
+ :tags (if ,unstable '(:expensive-test :unstable) '(:expensive-test))
+ (skip-unless (tramp--test-enabled))
+ (let ((default-directory tramp-test-temporary-file-directory)
+ (ert-test (ert-get-test ',test))
+ (tramp-connection-properties
+ (cons '(nil "direct-async-process" t) tramp-connection-properties)))
+ (skip-unless (tramp-direct-async-process-p))
+ ;; For whatever reason, it doesn't cooperate with the "mock" method.
+ (skip-unless (not (tramp--test-mock-p)))
+ ;; We do expect an established connection already,
+ ;; `file-truename' does it by side-effect. Suppress
+ ;; `tramp--test-enabled', in order to keep the connection.
+ (cl-letf (((symbol-function #'tramp--test-enabled) (lambda nil t)))
+ (file-truename tramp-test-temporary-file-directory)
+ (funcall (ert-test-body ert-test))))))
+
+(tramp--test--deftest-direct-async-process tramp-test29-start-file-process
+ "Check direct async `start-file-process'.")
+
(ert-deftest tramp-test30-make-process ()
"Check `make-process'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
- ;; `make-process' has been inserted in Emacs 25.1. It supports file
- ;; name handlers since Emacs 27.
+ (skip-unless (not (tramp--test-crypt-p)))
+ ;; `make-process' supports file name handlers since Emacs 27.
(skip-unless (tramp--test-emacs27-p))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
@@ -4323,9 +4528,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
(while (accept-process-output proc 0 nil t))))
- ;; We cannot use `string-equal', because tramp-adb.el
- ;; echoes also the sent string.
- (should (string-match "\\`foo" (buffer-string))))
+ (should (string-match "foo" (buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc)))
@@ -4346,7 +4549,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
(while (accept-process-output proc 0 nil t))))
- (should (string-equal (buffer-string) "foo")))
+ (should (string-match "foo" (buffer-string))))
;; Cleanup.
(ignore-errors
@@ -4372,9 +4575,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (not (string-match "foo" (buffer-string)))
(while (accept-process-output proc 0 nil t))))
- ;; We cannot use `string-equal', because tramp-adb.el
- ;; echoes also the sent string.
- (should (string-match "\\`foo" (buffer-string))))
+ (should (string-match "foo" (buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc)))
@@ -4398,75 +4599,74 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
;; Read output.
(with-timeout (10 (tramp--test-timeout-handler))
(while (accept-process-output proc 0 nil t)))
- ;; We cannot use `string-equal', because tramp-adb.el
- ;; echoes also the sent string. And a remote macOS sends
- ;; a slightly modified string. On MS Windows,
- ;; `delete-process' sends an unknown signal.
- (should
- (string-match
- (if (eq system-type 'windows-nt)
- "unknown signal\n\\'" "killed.*\n\\'")
- (buffer-string))))
+ ;; On some MS Windows systems, it returns "unknown signal".
+ (should (string-match "unknown signal\\|killed" (buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc)))
;; Process with stderr buffer.
- (let ((stderr (generate-new-buffer "*stderr*")))
- (unwind-protect
- (with-temp-buffer
- (setq proc
- (with-no-warnings
- (make-process
- :name "test5" :buffer (current-buffer)
- :command '("cat" "/does-not-exist")
- :stderr stderr
- :file-handler t)))
- (should (processp proc))
- ;; Read stderr.
- (with-timeout (10 (tramp--test-timeout-handler))
- (while (accept-process-output proc 0 nil t)))
- (delete-process proc)
- (with-current-buffer stderr
- (should
- (string-match
- "cat:.* No such file or directory" (buffer-string)))))
+ (unless (tramp-direct-async-process-p)
+ (let ((stderr (generate-new-buffer "*stderr*")))
+ (unwind-protect
+ (with-temp-buffer
+ (setq proc
+ (with-no-warnings
+ (make-process
+ :name "test5" :buffer (current-buffer)
+ :command '("cat" "/does-not-exist")
+ :stderr stderr
+ :file-handler t)))
+ (should (processp proc))
+ ;; Read stderr.
+ (with-timeout (10 (tramp--test-timeout-handler))
+ (while (accept-process-output proc 0 nil t)))
+ (delete-process proc)
+ (with-current-buffer stderr
+ (should
+ (string-match
+ "cat:.* No such file or directory" (buffer-string)))))
- ;; Cleanup.
- (ignore-errors (delete-process proc))
- (ignore-errors (kill-buffer stderr))))
+ ;; Cleanup.
+ (ignore-errors (delete-process proc))
+ (ignore-errors (kill-buffer stderr)))))
;; Process with stderr file.
- (dolist (tmpfile `(,tmp-name1 ,tmp-name2))
- (unwind-protect
- (with-temp-buffer
- (setq proc
- (with-no-warnings
- (make-process
- :name "test6" :buffer (current-buffer)
- :command '("cat" "/does-not-exist")
- :stderr tmpfile
- :file-handler t)))
- (should (processp proc))
- ;; Read stderr.
- (with-timeout (10 (tramp--test-timeout-handler))
- (while (accept-process-output proc nil nil t)))
- (delete-process proc)
+ (unless (tramp-direct-async-process-p)
+ (dolist (tmpfile `(,tmp-name1 ,tmp-name2))
+ (unwind-protect
(with-temp-buffer
- (insert-file-contents tmpfile)
- (should
- (string-match
- "cat:.* No such file or directory" (buffer-string)))))
+ (setq proc
+ (with-no-warnings
+ (make-process
+ :name "test6" :buffer (current-buffer)
+ :command '("cat" "/does-not-exist")
+ :stderr tmpfile
+ :file-handler t)))
+ (should (processp proc))
+ ;; Read stderr.
+ (with-timeout (10 (tramp--test-timeout-handler))
+ (while (accept-process-output proc nil nil t)))
+ (delete-process proc)
+ (with-temp-buffer
+ (insert-file-contents tmpfile)
+ (should
+ (string-match
+ "cat:.* No such file or directory" (buffer-string)))))
- ;; Cleanup.
- (ignore-errors (delete-process proc))
- (ignore-errors (delete-file tmpfile)))))))
+ ;; Cleanup.
+ (ignore-errors (delete-process proc))
+ (ignore-errors (delete-file tmpfile))))))))
+
+(tramp--test--deftest-direct-async-process tramp-test30-make-process
+ "Check direct async `make-process'.")
(ert-deftest tramp-test31-interrupt-process ()
"Check `interrupt-process'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
+ (skip-unless (not (tramp--test-crypt-p)))
;; Since Emacs 26.1.
(skip-unless (boundp 'interrupt-process-functions))
@@ -4506,12 +4706,14 @@ INPUT, if non-nil, is a string sent to the process."
(async-shell-command command output-buffer error-buffer)
(let ((proc (get-buffer-process output-buffer))
(delete-exited-processes t))
- (when (stringp input)
- (process-send-string proc input))
- (with-timeout
- ((if (getenv "EMACS_EMBA_CI") 30 10) (tramp--test-timeout-handler))
- (while (or (accept-process-output proc nil nil t) (process-live-p
proc))))
- (accept-process-output proc nil nil t)))
+ (cl-letf (((symbol-function #'shell-command-sentinel) #'ignore))
+ (when (stringp input)
+ (process-send-string proc input))
+ (with-timeout
+ ((if (getenv "EMACS_EMBA_CI") 30 10) (tramp--test-timeout-handler))
+ (while
+ (or (accept-process-output proc nil nil t) (process-live-p proc))))
+ (accept-process-output proc nil nil t))))
(defun tramp--test-shell-command-to-string-asynchronously (command)
"Like `shell-command-to-string', but for asynchronous processes."
@@ -4527,6 +4729,7 @@ INPUT, if non-nil, is a string sent to the process."
;; remote processes in Emacs. That doesn't work for tramp-adb.el.
(skip-unless (or (and (tramp--test-adb-p) (tramp--test-emacs27-p))
(tramp--test-sh-p)))
+ (skip-unless (not (tramp--test-crypt-p)))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(let ((tmp-name (tramp--test-make-temp-name nil quoted))
@@ -4564,19 +4767,20 @@ INPUT, if non-nil, is a string sent to the process."
(ignore-errors (delete-file tmp-name)))
;; Test `{async-}shell-command' with error buffer.
- (let ((stderr (generate-new-buffer "*stderr*")))
- (unwind-protect
- (with-temp-buffer
- (funcall
- this-shell-command
- "echo foo >&2; echo bar" (current-buffer) stderr)
- (should (string-equal "bar\n" (buffer-string)))
- ;; Check stderr.
- (with-current-buffer stderr
- (should (string-equal "foo\n" (buffer-string)))))
+ (unless (tramp-direct-async-process-p)
+ (let ((stderr (generate-new-buffer "*stderr*")))
+ (unwind-protect
+ (with-temp-buffer
+ (funcall
+ this-shell-command
+ "echo foo >&2; echo bar" (current-buffer) stderr)
+ (should (string-equal "bar\n" (buffer-string)))
+ ;; Check stderr.
+ (with-current-buffer stderr
+ (should (string-equal "foo\n" (buffer-string)))))
- ;; Cleanup.
- (ignore-errors (kill-buffer stderr)))))
+ ;; Cleanup.
+ (ignore-errors (kill-buffer stderr))))))
;; Test sending string to `async-shell-command'.
(unwind-protect
@@ -4612,6 +4816,9 @@ INPUT, if non-nil, is a string sent to the process."
(when (natnump cols)
(should (= cols async-shell-command-width))))))
+(tramp--test--deftest-direct-async-process tramp-test32-shell-command
+ "Check direct async `shell-command'.")
+
;; This test is inspired by Bug#39067.
(ert-deftest tramp-test32-shell-command-dont-erase-buffer ()
"Check `shell-command-dont-erase-buffer'."
@@ -4621,6 +4828,7 @@ INPUT, if non-nil, is a string sent to the process."
(skip-unless (tramp--test-enabled))
(skip-unless nil)
(skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
+ (skip-unless (not (tramp--test-crypt-p)))
;; Prior Emacs 27, `shell-command-dont-erase-buffer' wasn't working properly.
(skip-unless (tramp--test-emacs27-p))
@@ -4744,6 +4952,7 @@ INPUT, if non-nil, is a string sent to the process."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
+ (skip-unless (not (tramp--test-crypt-p)))
(dolist (this-shell-command-to-string
'(;; Synchronously.
@@ -4756,67 +4965,79 @@ INPUT, if non-nil, is a string sent to the process."
(envvar (concat "VAR_" (upcase (md5 (current-time-string)))))
kill-buffer-query-functions)
- (unwind-protect
- ;; Set a value.
- (let ((process-environment
- (cons (concat envvar "=foo") process-environment)))
- ;; Default value.
- (should
- (string-match
- "foo"
- (funcall
- this-shell-command-to-string
- (format "echo -n ${%s:-bla}" envvar))))))
-
- (unwind-protect
- ;; Set the empty value.
- (let ((process-environment
- (cons (concat envvar "=") process-environment)))
- ;; Value is null.
+ ;; Check INSIDE_EMACS.
+ (setenv "INSIDE_EMACS")
+ (should
+ (string-equal
+ (format "%s,tramp:%s\n" emacs-version tramp-version)
+ (funcall this-shell-command-to-string "echo \"${INSIDE_EMACS:-bla}\"")))
+ (let ((process-environment
+ (cons (format "INSIDE_EMACS=%s,foo" emacs-version)
+ process-environment)))
+ (should
+ (string-equal
+ (format "%s,foo,tramp:%s\n" emacs-version tramp-version)
+ (funcall
+ this-shell-command-to-string "echo \"${INSIDE_EMACS:-bla}\""))))
+
+ ;; Set a value.
+ (let ((process-environment
+ (cons (concat envvar "=foo") process-environment)))
+ ;; Default value.
+ (should
+ (string-match
+ "foo"
+ (funcall
+ this-shell-command-to-string
+ (format "echo \"${%s:-bla}\"" envvar)))))
+
+ ;; Set the empty value.
+ (let ((process-environment
+ (cons (concat envvar "=") process-environment)))
+ ;; Value is null.
+ (should
+ (string-match
+ "bla"
+ (funcall
+ this-shell-command-to-string (format "echo \"${%s:-bla}\"" envvar))))
+ ;; Variable is set.
+ (should
+ (string-match
+ (regexp-quote envvar)
+ (funcall this-shell-command-to-string "set"))))
+
+ (unless (tramp-direct-async-process-p)
+ ;; We force a reconnect, in order to have a clean environment.
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
+ ;; Unset the variable.
+ (let ((tramp-remote-process-environment
+ (cons (concat envvar "=foo") tramp-remote-process-environment)))
+ ;; Set the initial value, we want to unset below.
+ (should
+ (string-match
+ "foo"
+ (funcall
+ this-shell-command-to-string
+ (format "echo \"${%s:-bla}\"" envvar))))
+ (let ((process-environment (cons envvar process-environment)))
+ ;; Variable is unset.
(should
(string-match
"bla"
(funcall
this-shell-command-to-string
- (format "echo -n ${%s:-bla}" envvar))))
- ;; Variable is set.
- (should
+ (format "echo \"${%s:-bla}\"" envvar))))
+ ;; Variable is unset.
+ (should-not
(string-match
(regexp-quote envvar)
- (funcall this-shell-command-to-string "set")))))
-
- ;; We force a reconnect, in order to have a clean environment.
- (tramp-cleanup-connection
- (tramp-dissect-file-name tramp-test-temporary-file-directory)
- 'keep-debug 'keep-password)
- (unwind-protect
- ;; Unset the variable.
- (let ((tramp-remote-process-environment
- (cons (concat envvar "=foo")
- tramp-remote-process-environment)))
- ;; Set the initial value, we want to unset below.
- (should
- (string-match
- "foo"
+ ;; We must remove PS1, the output is truncated otherwise.
(funcall
- this-shell-command-to-string
- (format "echo -n ${%s:-bla}" envvar))))
- (let ((process-environment
- (cons envvar process-environment)))
- ;; Variable is unset.
- (should
- (string-match
- "bla"
- (funcall
- this-shell-command-to-string
- (format "echo -n ${%s:-bla}" envvar))))
- ;; Variable is unset.
- (should-not
- (string-match
- (regexp-quote envvar)
- ;; We must remove PS1, the output is truncated otherwise.
- (funcall
- this-shell-command-to-string "printenv | grep -v PS1")))))))))
+ this-shell-command-to-string "printenv | grep -v PS1")))))))))
+
+(tramp--test--deftest-direct-async-process tramp-test33-environment-variables
+ "Check that remote processes set / unset environment variables properly.
+Use direct async.")
;; This test is inspired by Bug#27009.
(ert-deftest tramp-test33-environment-variables-and-port-numbers ()
@@ -4825,6 +5046,7 @@ INPUT, if non-nil, is a string sent to the process."
;; We test it only for the mock-up connection; otherwise there might
;; be problems with the used ports.
(skip-unless (and (eq tramp-syntax 'default) (tramp--test-mock-p)))
+ (skip-unless (not (tramp--test-crypt-p)))
;; We force a reconnect, in order to have a clean environment.
(dolist (dir `(,tramp-test-temporary-file-directory
@@ -4847,7 +5069,7 @@ INPUT, if non-nil, is a string sent to the process."
(should
(string-match
(number-to-string port)
- (shell-command-to-string (format "echo -n $%s" envvar))))))
+ (shell-command-to-string (format "echo $%s" envvar))))))
;; Cleanup.
(dolist (dir '("/mock:localhost#11111:" "/mock:localhost#22222:"))
@@ -4929,6 +5151,7 @@ INPUT, if non-nil, is a string sent to the process."
;; remote processes in Emacs. That doesn't work for tramp-adb.el.
(skip-unless (or (and (tramp--test-adb-p) (tramp--test-emacs27-p))
(tramp--test-sh-p)))
+ (skip-unless (not (tramp--test-crypt-p)))
;; Since Emacs 26.1.
(skip-unless (and (fboundp 'connection-local-set-profile-variables)
(fboundp 'connection-local-set-profiles)))
@@ -4985,6 +5208,7 @@ INPUT, if non-nil, is a string sent to the process."
"Check `exec-path' and `executable-find'."
(skip-unless (tramp--test-enabled))
(skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
+ (skip-unless (not (tramp--test-crypt-p)))
;; Since Emacs 27.1.
(skip-unless (fboundp 'exec-path))
@@ -5028,6 +5252,7 @@ INPUT, if non-nil, is a string sent to the process."
"Check loooong `tramp-remote-path'."
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
+ (skip-unless (not (tramp--test-crypt-p)))
;; Since Emacs 27.1.
(skip-unless (fboundp 'exec-path))
@@ -5035,23 +5260,20 @@ INPUT, if non-nil, is a string sent to the process."
(default-directory tramp-test-temporary-file-directory)
(orig-exec-path (with-no-warnings (exec-path)))
(tramp-remote-path tramp-remote-path)
- (orig-tramp-remote-path tramp-remote-path))
+ (orig-tramp-remote-path tramp-remote-path)
+ path)
(unwind-protect
(progn
;; Non existing directories are removed.
(setq tramp-remote-path
(cons (file-remote-p tmp-name 'localname) tramp-remote-path))
- (tramp-cleanup-connection
- (tramp-dissect-file-name tramp-test-temporary-file-directory)
- 'keep-debug 'keep-password)
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
(should (equal (with-no-warnings (exec-path)) orig-exec-path))
(setq tramp-remote-path orig-tramp-remote-path)
;; Double entries are removed.
(setq tramp-remote-path (append '("/" "/") tramp-remote-path))
- (tramp-cleanup-connection
- (tramp-dissect-file-name tramp-test-temporary-file-directory)
- 'keep-debug 'keep-password)
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
(should
(equal (with-no-warnings (exec-path)) (cons "/" orig-exec-path)))
(setq tramp-remote-path orig-tramp-remote-path)
@@ -5063,26 +5285,30 @@ INPUT, if non-nil, is a string sent to the process."
(let ((dir (make-temp-file (file-name-as-directory tmp-name)
'dir)))
(should (file-directory-p dir))
(setq tramp-remote-path
- (cons (file-remote-p dir 'localname) tramp-remote-path)
+ (append
+ tramp-remote-path `(,(file-remote-p dir 'localname)))
orig-exec-path
- (cons (file-remote-p dir 'localname) orig-exec-path))))
- (tramp-cleanup-connection
- (tramp-dissect-file-name tramp-test-temporary-file-directory)
- 'keep-debug 'keep-password)
+ (append
+ (butlast orig-exec-path)
+ `(,(file-remote-p dir 'localname))
+ (last orig-exec-path)))))
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
(should (equal (with-no-warnings (exec-path)) orig-exec-path))
- (should
- (string-equal
- ;; Ignore trailing newline.
- (substring (shell-command-to-string "echo $PATH") nil -1)
+ ;; Ignore trailing newline.
+ (setq path (substring (shell-command-to-string "echo $PATH") nil -1))
+ ;; The shell doesn't handle such long strings.
+ (unless (<= (length path)
+ (tramp-get-connection-property
+ tramp-test-vec "pipe-buf" 4096))
;; The last element of `exec-path' is `exec-directory'.
- (mapconcat #'identity (butlast orig-exec-path) ":")))
+ (should
+ (string-equal
+ path (mapconcat #'identity (butlast orig-exec-path) ":"))))
;; The shell "sh" shall always exist.
(should (apply #'executable-find '("sh" remote))))
;; Cleanup.
- (tramp-cleanup-connection
- (tramp-dissect-file-name tramp-test-temporary-file-directory)
- 'keep-debug 'keep-password)
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
(setq tramp-remote-path orig-tramp-remote-path)
(ignore-errors (delete-directory tmp-name 'recursive)))))
@@ -5091,6 +5317,7 @@ INPUT, if non-nil, is a string sent to the process."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
+ (skip-unless (not (tramp--test-crypt-p)))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
;; We must use `file-truename' for the temporary directory, in
@@ -5119,8 +5346,7 @@ INPUT, if non-nil, is a string sent to the process."
tramp-remote-process-environment))
;; We must force a reconnect, in order to activate $BZR_HOME.
(tramp-cleanup-connection
- (tramp-dissect-file-name tramp-test-temporary-file-directory)
- 'keep-debug 'keep-password)
+ tramp-test-vec 'keep-debug 'keep-password)
'(Bzr))
(t nil))))
;; Suppress nasty messages.
@@ -5146,13 +5372,9 @@ INPUT, if non-nil, is a string sent to the process."
(error (ert-skip "`vc-create-repo' not supported")))
;; The structure of VC-FILESET is not documented. Let's
;; hope it won't change.
- (condition-case nil
- (vc-register
- (list (car vc-handled-backends)
- (list (file-name-nondirectory tmp-name2))))
- ;; `vc-register' has changed its arguments in Emacs
- ;; 25.1. Let's skip it for older Emacsen.
- (error (skip-unless (tramp--test-emacs25-p))))
+ (vc-register
+ (list (car vc-handled-backends)
+ (list (file-name-nondirectory tmp-name2))))
;; vc-git uses an own process sentinel, Tramp's sentinel
;; for flushing the cache isn't used.
(dired-uncache (concat (file-remote-p default-directory) "/"))
@@ -5409,12 +5631,6 @@ INPUT, if non-nil, is a string sent to the process."
(delete-directory tmp-file)
(should-not (file-exists-p tmp-file))))
-(defun tramp--test-emacs25-p ()
- "Check for Emacs version >= 25.1.
-Some semantics has been changed for there, w/o new functions or
-variables, so we check the Emacs version directly."
- (>= emacs-major-version 25))
-
(defun tramp--test-emacs26-p ()
"Check for Emacs version >= 26.1.
Some semantics has been changed for there, w/o new functions or
@@ -5450,6 +5666,10 @@ This does not support some special file names."
(string-equal
"docker" (file-remote-p tramp-test-temporary-file-directory 'method)))
+(defun tramp--test-crypt-p ()
+ "Check, whether the remote directory is crypted"
+ (tramp-crypt-file-name-p tramp-test-temporary-file-directory))
+
(defun tramp--test-ftp-p ()
"Check, whether an FTP-like method is used.
This does not support globbing characters in file names (yet)."
@@ -5505,9 +5725,7 @@ This does not support special file names."
(defun tramp--test-sh-p ()
"Check, whether the remote host runs a based method from tramp-sh.el."
- (eq
- (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
- 'tramp-sh-file-name-handler))
+ (tramp-sh-file-name-handler-p tramp-test-vec))
(defun tramp--test-share-p ()
"Check, whether the method needs a share."
@@ -5520,11 +5738,11 @@ This does not support special file names."
"Check, whether the sudoedit method is used."
(tramp-sudoedit-file-name-p tramp-test-temporary-file-directory))
-(defun tramp--test-windows-nt ()
+(defun tramp--test-windows-nt-p ()
"Check, whether the locale host runs MS Windows."
(eq system-type 'windows-nt))
-(defun tramp--test-windows-nt-and-batch ()
+(defun tramp--test-windows-nt-and-batch-p ()
"Check, whether the locale host runs MS Windows in batch mode.
This does not support special characters."
(and (eq system-type 'windows-nt) noninteractive))
@@ -5541,7 +5759,12 @@ This does not support utf8 based file transfer."
"Check, whether the locale or remote host runs MS Windows.
This requires restrictions of file name syntax."
(or (eq system-type 'windows-nt)
- (tramp-smb-file-name-p tramp-test-temporary-file-directory)))
+ (tramp--test-smb-p)))
+
+(defun tramp--test-smb-p ()
+ "Check, whether the locale or remote host runs MS Windows.
+This requires restrictions of file name syntax."
+ (tramp-smb-file-name-p tramp-test-temporary-file-directory))
(defun tramp--test-check-files (&rest files)
"Run a simple but comprehensive test over every file in FILES."
@@ -5665,8 +5888,7 @@ This requires restrictions of file name syntax."
;; It does not work in the "smb" case, only relative
;; symlinks to existing files are shown there.
(tramp--test-ignore-make-symbolic-link-error
- (unless
- (tramp-smb-file-name-p tramp-test-temporary-file-directory)
+ (unless (tramp--test-smb-p)
(make-symbolic-link file2 file3)
(should (file-symlink-p file3))
(should
@@ -5693,6 +5915,7 @@ This requires restrictions of file name syntax."
;; We do not run on macOS due to encoding problems. See
;; Bug#36940.
(when (and (tramp--test-expensive-test) (tramp--test-sh-p)
+ (not (tramp--test-crypt-p))
(not (eq system-type 'darwin)))
(dolist (elt files)
(let ((envvar (concat "VAR_" (upcase (md5 elt))))
@@ -5826,7 +6049,7 @@ Use the `ls' command."
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-rsync-p)))
- (skip-unless (not (tramp--test-windows-nt-and-batch)))
+ (skip-unless (not (tramp--test-windows-nt-and-batch-p)))
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
(let ((tramp-connection-properties
@@ -5860,18 +6083,28 @@ Use the `ls' command."
"银河系漫游指南系列"
"Автостопом по гала́ктике"
;; Use codepoints without a name. See Bug#31272.
- "bung")
+ "bung"
+ ;; Use codepoints from Supplementary Multilingual Plane (U+10000
+ ;; to U+1FFFF).
+ "🌈🍒👋")
(when (tramp--test-expensive-test)
(delete-dups
(mapcar
- ;; Use all available language specific snippets. Filter out
- ;; strings which use unencodable characters.
+ ;; Use all available language specific snippets.
(lambda (x)
(and
(stringp (setq x (eval (get-language-info (car x) 'sample-text))))
- (not (unencodable-char-position
- 0 (length x) file-name-coding-system nil x))
+ ;; Filter out strings which use unencodable characters.
+ (not (and (or (tramp--test-gvfs-p) (tramp--test-smb-p))
+ (unencodable-char-position
+ 0 (length x) file-name-coding-system nil x)))
+ ;; Filter out not displayable characters.
+ (setq x (mapconcat
+ (lambda (y)
+ (and (char-displayable-p y) (char-to-string y)))
+ x ""))
+ (not (string-empty-p x))
;; ?\n and ?/ shouldn't be part of any file name. ?\t,
;; ?. and ?? do not work for "smb" method.
(replace-regexp-in-string "[\t\n/.?]" "" x)))
@@ -5882,9 +6115,10 @@ Use the `ls' command."
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-docker-p)))
(skip-unless (not (tramp--test-rsync-p)))
- (skip-unless (not (tramp--test-windows-nt-and-batch)))
+ (skip-unless (not (tramp--test-windows-nt-and-batch-p)))
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
(skip-unless (not (tramp--test-ksh-p)))
+ (skip-unless (not (tramp--test-crypt-p)))
(tramp--test-utf8))
@@ -5896,9 +6130,10 @@ Use the `stat' command."
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-docker-p)))
(skip-unless (not (tramp--test-rsync-p)))
- (skip-unless (not (tramp--test-windows-nt-and-batch)))
+ (skip-unless (not (tramp--test-windows-nt-and-batch-p)))
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
(skip-unless (not (tramp--test-ksh-p)))
+ (skip-unless (not (tramp--test-crypt-p)))
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(skip-unless (tramp-get-remote-stat v)))
@@ -5917,9 +6152,10 @@ Use the `perl' command."
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-docker-p)))
(skip-unless (not (tramp--test-rsync-p)))
- (skip-unless (not (tramp--test-windows-nt-and-batch)))
+ (skip-unless (not (tramp--test-windows-nt-and-batch-p)))
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
(skip-unless (not (tramp--test-ksh-p)))
+ (skip-unless (not (tramp--test-crypt-p)))
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(skip-unless (tramp-get-remote-perl v)))
@@ -5941,9 +6177,10 @@ Use the `ls' command."
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-docker-p)))
(skip-unless (not (tramp--test-rsync-p)))
- (skip-unless (not (tramp--test-windows-nt-and-batch)))
+ (skip-unless (not (tramp--test-windows-nt-and-batch-p)))
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
(skip-unless (not (tramp--test-ksh-p)))
+ (skip-unless (not (tramp--test-crypt-p)))
(let ((tramp-connection-properties
(append
@@ -6017,15 +6254,14 @@ This is needed in timer functions as well as process
filters and sentinels."
"Check parallel asynchronous requests.
Such requests could arrive from timers, process filters and
process sentinels. They shall not disturb each other."
- ;; The test fails from time to time, w/o a reproducible pattern. So
- ;; we mark it as unstable.
- :tags '(:expensive-test :unstable)
+ :tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
- (skip-unless nil)
;; Prior Emacs 27, `shell-file-name' was hard coded as "/bin/sh" for
;; remote processes in Emacs. That doesn't work for tramp-adb.el.
(skip-unless (or (and (tramp--test-adb-p) (tramp--test-emacs27-p))
(tramp--test-sh-p)))
+ (skip-unless (not (tramp--test-crypt-p)))
+ (skip-unless (not (tramp--test-docker-p)))
(with-timeout
(tramp--test-asynchronous-requests-timeout (tramp--test-timeout-handler))
@@ -6035,7 +6271,7 @@ process sentinels. They shall not disturb each other."
(shell-file-name (if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh"))
;; It doesn't work on w32 systems.
(watchdog
- (unless (tramp--test-windows-nt)
+ (unless (tramp--test-windows-nt-p)
(start-process-shell-command
"*watchdog*" nil
(format
@@ -6064,10 +6300,10 @@ process sentinels. They shall not disturb each other."
((getenv "EMACS_HYDRA_CI") 10)
(t 1)))
;; We must distinguish due to performance reasons.
- ;; (timer-operation
- ;; (cond
- ;; ((tramp--test-mock-p) #'vc-registered)
- ;; (t #'file-attributes)))
+ (timer-operation
+ (cond
+ ((tramp--test-mock-p) #'vc-registered)
+ (t #'file-attributes)))
;; This is when all timers start. We check inside the
;; timer function, that we don't exceed timeout.
(timer-start (current-time))
@@ -6086,10 +6322,7 @@ process sentinels. They shall not disturb each other."
0 timer-repeat
(lambda ()
(tramp--test-with-proper-process-name-and-buffer
- (get-buffer-process
- (tramp-get-buffer
- (tramp-dissect-file-name
- tramp-test-temporary-file-directory)))
+ (get-buffer-process (tramp-get-buffer tramp-test-vec))
(when (> (- (time-to-seconds) (time-to-seconds timer-start))
tramp--test-asynchronous-requests-timeout)
(tramp--test-timeout-handler))
@@ -6098,10 +6331,15 @@ process sentinels. They shall not disturb each other."
(default-directory tmp-name)
(file
(buffer-name
- (nth (random (length buffers)) buffers))))
+ (nth (random (length buffers)) buffers)))
+ ;; A remote operation in a timer could
+ ;; confuse Tramp heavily. So we ignore this
+ ;; error here.
+ (debug-ignored-errors
+ (cons 'remote-file-error debug-ignored-errors)))
(tramp--test-message
"Start timer %s %s" file (current-time-string))
- ;; (funcall timer-operation file)
+ (funcall timer-operation file)
(tramp--test-message
"Stop timer %s %s" file (current-time-string))
;; Adjust timer if it takes too much time.
@@ -6211,8 +6449,119 @@ process sentinels. They shall not disturb each other."
(ignore-errors (cancel-timer timer))
(ignore-errors (delete-directory tmp-name 'recursive))))))
+;; (tramp--test--deftest-direct-async-process
tramp-test43-asynchronous-requests
+;; "Check parallel direct asynchronous requests.")
+
+(ert-deftest tramp-test44-threads ()
+ "Check that Tramp cooperates with threads."
+ (skip-unless (tramp--test-enabled))
+ (skip-unless (featurep 'threads))
+ (skip-unless (= (length (with-no-warnings (all-threads))) 1))
+ (skip-unless (not (with-no-warnings (thread-last-error))))
+ ;; We need the thread features introduced in Emacs 27.
+ (skip-unless (bound-and-true-p main-thread))
+ ;; For the time being it works only in the feature branch.
+ (skip-unless
+ (string-equal
+ (bound-and-true-p emacs-repository-branch) "feature/tramp-thread-safe"))
+
+ (tramp--test-instrument-test-case 0
+ (with-no-warnings
+ (with-timeout (60 (tramp--test-timeout-handler))
+ ;; We cannot bind the variables dynamically; they are used in the
threads.
+ (defvar tmp-name1 (tramp--test-make-temp-name))
+ (defvar tmp-name2 (tramp--test-make-temp-name))
+ (defvar tmp-mutex (make-mutex "mutex"))
+ (defvar tmp-condvar1 (make-condition-variable tmp-mutex "condvar1"))
+ (defvar tmp-condvar2 (make-condition-variable tmp-mutex "condvar2"))
+
+ ;; Rename simple file.
+ (unwind-protect
+ (let (tmp-thread1 tmp-thread2)
+ (write-region "foo" nil tmp-name1)
+ (should (file-exists-p tmp-name1))
+ (should-not (file-exists-p tmp-name2))
+
+ (should (mutexp tmp-mutex))
+ (should (condition-variable-p tmp-condvar1))
+ (should (condition-variable-p tmp-condvar2))
+
+ ;; This thread renames `tmp-name1' to `tmp-name2' twice.
+ (setq
+ tmp-thread1
+ (make-thread
+ (lambda ()
+ ;; Rename first time.
+ (rename-file tmp-name1 tmp-name2)
+ ;; Notify thread2.
+ (with-mutex (condition-mutex tmp-condvar2)
+ (condition-notify tmp-condvar2 t))
+ ;; Rename second time, once we've got notification from thread2.
+ (with-mutex (condition-mutex tmp-condvar1)
+ (condition-wait tmp-condvar1))
+ (rename-file tmp-name1 tmp-name2))
+ "thread1"))
+
+ (should (threadp tmp-thread1))
+ (should (thread-live-p tmp-thread1))
+
+ ;; This thread renames `tmp-name2' to `tmp-name1' twice.
+ (setq
+ tmp-thread2
+ (make-thread
+ (lambda ()
+ ;; Rename first time, once we've got notification from thread1.
+ (with-mutex (condition-mutex tmp-condvar2)
+ (condition-wait tmp-condvar2))
+ (rename-file tmp-name2 tmp-name1)
+ ;; Notify thread1.
+ (with-mutex (condition-mutex tmp-condvar1)
+ (condition-notify tmp-condvar1 t))
+ ;; Rename second time, once we've got notification from
+ ;; the main thread.
+ (with-mutex (condition-mutex tmp-condvar2)
+ (condition-wait tmp-condvar2))
+ (rename-file tmp-name2 tmp-name1))
+ "thread2"))
+
+ (should (threadp tmp-thread2))
+ (should (thread-live-p tmp-thread2))
+ (should (= (length (all-threads)) 3))
+
+ ;; Wait for thread1.
+ (thread-join tmp-thread1)
+ ;; Checks.
+ (should-not (thread-live-p tmp-thread1))
+ (should (= (length (all-threads)) 2))
+ (should-not (thread-last-error))
+ (should (file-exists-p tmp-name2))
+ (should-not (file-exists-p tmp-name1))
+
+ ;; Notify thread2.
+ (with-mutex (condition-mutex tmp-condvar2)
+ (condition-notify tmp-condvar2 t))
+
+ ;; Wait for thread2.
+ (thread-join tmp-thread2)
+ ;; Checks.
+ (should-not (thread-live-p tmp-thread2))
+ (should (= (length (all-threads)) 1))
+ (should-not (thread-last-error))
+ (should (file-exists-p tmp-name1))
+ (should-not (file-exists-p tmp-name2)))
+
+ ;; Cleanup.
+ (ignore-errors (delete-file tmp-name1))
+ (ignore-errors (delete-file tmp-name2))
+ ;; We could have spurious threads still running; wait for them to die.
+ (while (cdr (all-threads))
+ (thread-signal (cadr (all-threads)) 'error nil)
+ (thread-yield))
+ ;; Cleanup errors.
+ (ignore-errors (thread-last-error 'cleanup)))))))
+
;; This test is inspired by Bug#29163.
-(ert-deftest tramp-test44-auto-load ()
+(ert-deftest tramp-test45-auto-load ()
"Check that Tramp autoloads properly."
;; If we use another syntax but `default', Tramp is already loaded
;; due to the `tramp-change-syntax' call.
@@ -6237,7 +6586,7 @@ process sentinels. They shall not disturb each other."
(mapconcat #'shell-quote-argument load-path " -L ")
(shell-quote-argument code)))))))
-(ert-deftest tramp-test44-delay-load ()
+(ert-deftest tramp-test45-delay-load ()
"Check that Tramp is loaded lazily, only when needed."
;; The autoloaded Tramp objects are different since Emacs 26.1. We
;; cannot test older Emacsen, therefore.
@@ -6270,7 +6619,7 @@ process sentinels. They shall not disturb each other."
(mapconcat #'shell-quote-argument load-path " -L ")
(shell-quote-argument (format code tm)))))))))
-(ert-deftest tramp-test44-recursive-load ()
+(ert-deftest tramp-test45-recursive-load ()
"Check that Tramp does not fail due to recursive load."
(skip-unless (tramp--test-enabled))
@@ -6294,7 +6643,7 @@ process sentinels. They shall not disturb each other."
(mapconcat #'shell-quote-argument load-path " -L ")
(shell-quote-argument code))))))))
-(ert-deftest tramp-test44-remote-load-path ()
+(ert-deftest tramp-test45-remote-load-path ()
"Check that Tramp autoloads its packages with remote `load-path'."
;; The autoloaded Tramp objects are different since Emacs 26.1. We
;; cannot test older Emacsen, therefore.
@@ -6323,7 +6672,7 @@ process sentinels. They shall not disturb each other."
(mapconcat #'shell-quote-argument load-path " -L ")
(shell-quote-argument code)))))))
-(ert-deftest tramp-test45-unload ()
+(ert-deftest tramp-test46-unload ()
"Check that Tramp and its subpackages unload completely.
Since it unloads Tramp, it shall be the last test to run."
:tags '(:expensive-test)
@@ -6357,12 +6706,14 @@ Since it unloads Tramp, it shall be the last test to
run."
(and (or (and (boundp x) (null (local-variable-if-set-p x)))
(and (functionp x) (null (autoloadp (symbol-function x)))))
(string-match "^tramp" (symbol-name x))
+ ;; `tramp-completion-mode' is autoloaded in Emacs < 28.1.
+ (not (eq 'tramp-completion-mode x))
(not (string-match "^tramp\\(-archive\\)?--?test" (symbol-name x)))
(not (string-match "unload-hook$" (symbol-name x)))
(ert-fail (format "`%s' still bound" x)))))
;; The defstruct `tramp-file-name' and all its internal functions
- ;; shall be purged. `cl--find-class' must be protected in Emacs 24.
- (with-no-warnings (should-not (cl--find-class 'tramp-file-name)))
+ ;; shall be purged.
+ (should-not (cl--find-class 'tramp-file-name))
(mapatoms
(lambda (x)
(and (functionp x)
@@ -6394,17 +6745,19 @@ If INTERACTIVE is non-nil, the tests are run
interactively."
;; * file-equal-p (partly done in `tramp-test21-file-links')
;; * file-in-directory-p
;; * file-name-case-insensitive-p
+;; * tramp-get-remote-gid
+;; * tramp-get-remote-uid
;; * tramp-set-file-uid-gid
;; * Work on skipped tests. Make a comment, when it is impossible.
;; * Revisit expensive tests, once problems in `tramp-error' are solved.
-;; * Fix `tramp-test05-expand-file-name-relative' in `expand-file-name'.
;; * Fix `tramp-test06-directory-file-name' for `ftp'.
;; * Investigate, why `tramp-test11-copy-file' and `tramp-test12-rename-file'
;; do not work properly for `nextcloud'.
-;; * Implement `tramp-test31-interrupt-process' for `adb'.
-;; * Fix Bug#16928 in `tramp-test43-asynchronous-requests'. A remote
-;; file name operation cannot run in the timer. Remove `:unstable' tag?
+;; * Implement `tramp-test31-interrupt-process' for `adb' and for
+;; direct async processes.
+;; * Fix `tramp-test44-threads'.
(provide 'tramp-tests)
+
;;; tramp-tests.el ends here
diff --git a/texi/Makefile b/texi/Makefile
index 107d964..9a54515 100644
--- a/texi/Makefile
+++ b/texi/Makefile
@@ -24,7 +24,7 @@
MAKEINFO = makeinfo --no-warn --no-split
TEXI_FILES = $(wildcard *.texi)
CLEAN_FILES = .\\\#* \\\#* .*~ *~ *.aux *.cp *.cps *.diff *.fn *.fns \
- *.ky *.log *.pg *.tmp *.toc *.tp *.vr *.vrs
+ *.ky *.log *.pg *.tmp *.toc *.tp *.vr *.vrs ../tramp.info
SOURCE_DIR = ~/src/tramp
.PHONY: all clean sync
@@ -32,7 +32,7 @@ SOURCE_DIR = ~/src/tramp
all: ../tramp.info
../tramp.info: $(TEXI_FILES)
- $(MAKEINFO) --footnote-style=end -o $@ $<
+ $(MAKEINFO) --footnote-style=end -o $@ tramp.texi
clean:
$(RM) $(CLEAN_FILES)
diff --git a/texi/tramp.texi b/texi/tramp.texi
index 3b5b8be..9430362 100644
--- a/texi/tramp.texi
+++ b/texi/tramp.texi
@@ -46,7 +46,7 @@ copy and modify this GNU manual.''
@node Top, Overview, (dir), (dir)
@top @value{tramp} @value{trampver} User Manual
-This file documents @value{tramp} @value{trampver}, a remote file
+This file documents @w{@value{tramp} @value{trampver}}, a remote file
editing package for Emacs.
@value{tramp} stands for ``Transparent Remote (file) Access, Multiple
@@ -59,7 +59,7 @@ local and the remote host, whereas @value{tramp} uses a
combination of
@command{ssh}/@command{scp}.
You can find the latest version of this document on the web at
-@uref{https://www.gnu.org/software/tramp/}.
+@uref{@value{trampurl}}.
@ifhtml
The latest release of @value{tramp} is available for
@@ -141,6 +141,7 @@ Configuring @value{tramp} for use
* Remote shell setup:: Remote shell setup hints.
* Android shell setup:: Android shell setup hints.
* Auto-save and Backup:: Auto-save and Backup.
+* Keeping files encrypted:: Protect remote files by encryption.
* Windows setup hints:: Issues with Cygwin ssh.
Using @value{tramp}
@@ -238,7 +239,7 @@ included in the file name portion, @value{tramp} sends the
login name
followed by a newline.
@item
-The remote host may then prompt for a password or pass phrase (for
+The remote host may then prompt for a password or passphrase (for
@command{rsh} or for @command{telnet}). @value{tramp} displays the
password prompt in the minibuffer. @value{tramp} then sends whatever
is entered to the remote host, followed by a newline.
@@ -312,21 +313,21 @@ behind the scenes when you open a file with @value{tramp}.
@cindex GNU ELPA
@vindex tramp-version
-@value{tramp} is included as part of Emacs (since Emacs 22.1).
+@value{tramp} is included as part of Emacs (since @w{Emacs 22.1}).
@value{tramp} is also freely packaged for download on the Internet at
@uref{https://ftp.gnu.org/gnu/tramp/}. The version number of
@value{tramp} can be obtained by the variable @code{tramp-version}.
For released @value{tramp} versions, this is a three-number string
-like ``2.4.3''.
+like ``2.4.5''.
A @value{tramp} release, which is packaged with Emacs, could differ
slightly from the corresponding standalone release. This is because
it isn't always possible to synchronize release dates between Emacs
and @value{tramp}. Such version numbers have the Emacs version number
-as suffix, like ``2.4.3.27.1''. This means @value{tramp} 2.4.3 as
-integrated in Emacs 27.1. A complete list of @value{tramp} versions
-packaged with Emacs can be retrieved by
+as suffix, like ``2.4.5.27.2''. This means @w{@value{tramp} 2.4.5} as
+integrated in @w{Emacs 27.2}. A complete list of @value{tramp}
+versions packaged with Emacs can be retrieved by
@vindex customize-package-emacs-version-alist
@lisp
@@ -337,7 +338,7 @@ packaged with Emacs can be retrieved by
ELPA} package. Besides the standalone releases, further minor version
of @value{tramp} will appear on GNU ELPA, until the next @value{tramp}
release appears. These minor versions have a four-number string, like
-``2.4.3.1''.
+``2.4.5.1''.
@value{tramp} development versions are available on Git servers.
Development versions contain new and incomplete features. The
@@ -557,13 +558,16 @@ of the local file name is the share exported by the
remote host,
@cindex method @option{davs}
@cindex @option{dav} method
@cindex @option{davs} method
+@cindex method @option{media}
+@cindex @option{media} method
On systems, which have installed @acronym{GVFS, the GNOME Virtual File
System}, its offered methods could be used by @value{tramp}. Examples
are @file{@trampfn{sftp,user@@host,/path/to/file}},
@file{@trampfn{afp,user@@host,/path/to/file}} (accessing Apple's AFP
-file system), @file{@trampfn{dav,user@@host,/path/to/file}} and
-@file{@trampfn{davs,user@@host,/path/to/file}} (for WebDAV shares).
+file system), @file{@trampfn{dav,user@@host,/path/to/file}},
+@file{@trampfn{davs,user@@host,/path/to/file}} (for WebDAV shares) and
+@file{@trampfn{media,device,/path/to/file}} (for media devices).
@anchor{Quick Start Guide: GNOME Online Accounts based methods}
@@ -664,6 +668,7 @@ might be used in your init file:
* Remote shell setup:: Remote shell setup hints.
* Android shell setup:: Android shell setup hints.
* Auto-save and Backup:: Auto-save and Backup.
+* Keeping files encrypted:: Protect remote files by encryption.
* Windows setup hints:: Issues with Cygwin ssh.
@end menu
@@ -1126,7 +1131,8 @@ Emacs.
@value{tramp} does not require a host name part of the remote file
name when a single Android device is connected to @command{adb}.
@value{tramp} instead uses @file{@trampfn{adb,,}} as the default name.
-@command{adb devices} shows available host names.
+@command{adb devices}, run in a shell outside Emacs, shows available
+host names.
@option{adb} method normally does not need user name to authenticate
on the Android device because it runs under the @command{adbd}
@@ -1179,9 +1185,6 @@ for accessing the system storage, you shall prefer this.
@ref{GVFS-based methods} for example, methods @option{gdrive} and
@option{nextcloud}.
-@strong{Note}: The @option{rclone} method is experimental, don't use
-it in production systems!
-
@end table
@@ -1227,6 +1230,7 @@ supported by these methods. See method
@option{nextcloud} for
handling them.
@item @option{gdrive}
+@cindex @acronym{GNOME} Online Accounts
@cindex method @option{gdrive}
@cindex @option{gdrive} method
@cindex google drive
@@ -1242,8 +1246,26 @@ Since Google Drive uses cryptic blob file names
internally,
could produce unexpected behavior in case two files in the same
directory have the same @code{display-name}, such a situation must be avoided.
+@item @option{media}
+@cindex method @option{media}
+@cindex @option{media} method
+@cindex media
+
+Media devices, like cell phones, tablets, cameras, can be accessed via
+the @option{media} method. Just the device name is needed in order to
+specify the host in the file name. However, the device must already
+be connected via USB, before accessing it. Possible device names are
+visible via host name completion, @ref{File name completion}.
+
+Depending on the device type, the access could be read-only. Some
+devices are accessible under different names in parallel, offering
+different parts of their file system.
+
+@value{tramp} does not require a host name as part of the remote file
+name when a single media device is connected. @value{tramp} instead
+uses @file{@trampfn{media,,}} as the default name.
+
@item @option{nextcloud}
-@cindex @acronym{GNOME} Online Accounts
@cindex method @option{nextcloud}
@cindex @option{nextcloud} method
@cindex nextcloud
@@ -1267,11 +1289,11 @@ that for security reasons refuse @command{ssh}
connections.
@defopt tramp-gvfs-methods
This user option is a list of external methods for @acronym{GVFS}@.
By default, this list includes @option{afp}, @option{dav},
-@option{davs}, @option{gdrive}, @option{nextcloud} and @option{sftp}.
-Other methods to include are @option{ftp}, @option{http},
-@option{https} and @option{smb}. These methods are not intended to be
-used directly as @acronym{GVFS}-based method. Instead, they are added
-here for the benefit of @ref{Archive file names}.
+@option{davs}, @option{gdrive}, @option{media}, @option{nextcloud} and
+@option{sftp}. Other methods to include are @option{ftp},
+@option{http}, @option{https} and @option{smb}. These methods are not
+intended to be used directly as @acronym{GVFS}-based method. Instead,
+they are added here for the benefit of @ref{Archive file names}.
If you want to use @acronym{GVFS}-based @option{ftp} or @option{smb}
methods, you must add them to @code{tramp-gvfs-methods}, and you must
@@ -1600,7 +1622,7 @@ support this command.
@subsection Tunneling with ssh
-With ssh, you could use the @code{ProxyCommand} entry in
+With @command{ssh}, you could use the @option{ProxyCommand} entry in
@file{~/.ssh/config}:
@example
@@ -1642,7 +1664,7 @@ suitable settings. Refer to the Lisp documentation of
that variable,
accessible with @kbd{C-h v tramp-methods @key{RET}}.
In the ELPA archives, there are several examples of such extensions.
-They can be installed with Emacs' Package Manager. This includes
+They can be installed with Emacs's Package Manager. This includes
@table @samp
@c @item anything-tramp
@@ -1708,6 +1730,7 @@ Convenience method to access vagrant boxes. It is often
used in
multi-hop file names like
@file{@value{prefix}vagrant@value{postfixhop}box|sudo@value{postfixhop}box@value{postfix}/path/to/file},
where @samp{box} is the name of the vagrant box.
+
@end table
@@ -1779,8 +1802,8 @@ in such files, it can return host names only.
@item @code{tramp-parse-sconfig}
@findex tramp-parse-sconfig
-This function returns the host nicknames defined by @code{Host} entries
-in @file{~/.ssh/config} style files.
+This function returns the host nicknames defined by @option{Host}
+entries in @file{~/.ssh/config} style files.
@item @code{tramp-parse-shostkeys}
@findex tramp-parse-shostkeys
@@ -2030,6 +2053,13 @@ The temporary directory on the remote host. If not
specified, the
default value is @t{"/data/local/tmp"} for the @option{adb} method,
@t{"/C$/Temp"} for the @option{smb} method, and @t{"/tmp"} otherwise.
+@item @t{"direct-async-process"}
+
+When this property is non-@code{nil}, an alternative, more performant
+implementation of @code{make-process} and
+@code{start-file-process} is applied. @ref{Improving performance of
+asynchronous remote processes} for a discussion of constraints.
+
@item @t{"posix"}
Connections using the @option{smb} method check, whether the remote
@@ -2075,7 +2105,7 @@ To improve performance and accuracy of remote file access,
@file{/usr/bin}, which are reasonable for most hosts. To accommodate
differences in hosts and paths, for example, @file{/bin:/usr/bin} on
Debian GNU/Linux or
-@file{/usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/SUNWspro/bin} on
+@file{/usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/developerstudio12.6/bin} on
Solaris, @value{tramp} queries the remote host with @command{getconf
PATH} and updates the symbol @code{tramp-default-remote-path}.
@@ -2102,8 +2132,8 @@ preserves the path value, which can be used to update
shell supports the login argument @samp{-l}.
@end defopt
-Starting with Emacs 26, @code{tramp-remote-path} can be set per host
-via connection-local
+Starting with @w{Emacs 26}, @code{tramp-remote-path} can be set per
+host via connection-local
@ifinfo
variables, @xref{Connection Variables, , , emacs}.
@end ifinfo
@@ -2150,7 +2180,7 @@ be recomputed. To force @value{tramp} to recompute
afresh, call
Per default, @value{tramp} uses the command @command{/bin/sh} for
starting a shell on the remote host. This can be changed by setting
-the connection property @t{"remote-shell"}, see @xref{Predefined
+the connection property @t{"remote-shell"}; see @pxref{Predefined
connection information}. If you want, for example, use
@command{/usr/bin/zsh} on a remote host, you might apply
@@ -2250,6 +2280,12 @@ example below:
@end group
@end lisp
+@vindex password-word-equivalents
+This user option is, by default, initialised from
+@code{password-word-equivalents} when @value{tramp} is loaded, and it
+is usually more convenient to add new passphrases to that user option
+instead of altering this user option.
+
Similar localization may be necessary for handling wrong password
prompts, for which @value{tramp} uses @code{tramp-wrong-passwd-regexp}.
@@ -2299,7 +2335,7 @@ string of that environment variable looks always like
@example
@group
echo $INSIDE_EMACS
-@result{} 27.1,tramp:2.4.3
+@result{} 27.2,tramp:2.4.5
@end group
@end example
@@ -2435,10 +2471,9 @@ overwrite as follows:
@lisp
@group
-(add-to-list
- 'tramp-connection-properties
- `(,(regexp-quote "192.168.0.1")
- "remote-copy-args" (("-l") ("%r"))))
+(add-to-list 'tramp-connection-properties
+ `(,(regexp-quote "192.168.0.1")
+ "remote-copy-args" (("-l") ("%r"))))
@end group
@end lisp
@@ -2457,7 +2492,7 @@ where @samp{192.168.0.1} is the remote host IP address
Android devices provide a restricted shell access through an USB
connection. The local host must have the @command{adb} program
installed. Usually, it is sufficient to open the file
-@file{@trampfn{adb,,/}}. Then you can navigate in the filesystem via
+@file{@trampfn{adb,,/}}. Then you can navigate in the file system via
@code{dired}.
Alternatively, applications such as @code{Termux} or @code{SSHDroid}
@@ -2473,7 +2508,7 @@ whatever shell is installed on the device with this
setting:
@lisp
@group
(add-to-list 'tramp-connection-properties
- (list (regexp-quote "192.168.0.26") "remote-shell" "sh"))
+ (list (regexp-quote "192.168.0.26") "remote-shell" "sh"))
@end group
@end lisp
@@ -2525,7 +2560,7 @@ the previous example, fix the connection properties as
follows:
@lisp
@group
(add-to-list 'tramp-connection-properties
- (list (regexp-quote "android") "remote-shell" "sh"))
+ (list (regexp-quote "android") "remote-shell" "sh"))
@end group
@end lisp
@@ -2632,6 +2667,117 @@ auto-saved files to the same directory as the original
file.
Alternatively, set the user option @code{tramp-auto-save-directory}
to direct all auto saves to that location.
+
+@node Keeping files encrypted
+@section Protect remote files by encryption
+@cindex Encrypt remote directories
+
+@strong{Note}: File encryption in @value{tramp} is experimental, don't
+use it in production systems!
+
+Sometimes, it is desirable to protect files located on remote
+directories, like cloud storages. In order to do this, you might
+instruct @value{tramp} to encrypt all files copied to a given remote
+directory, and to decrypt such files when accessing. This includes
+both file contents and file names.
+
+@value{tramp} does this transparently. Although both files and file
+names are encrypted on the remote side, they are accessible inside
+Emacs as they wouldn't be transformed as such.
+
+@cindex @command{encfs}
+@cindex @command{encfsctl}
+Internally, @value{tramp} uses the @command{encfs} package.
+Therefore, this feature is available only if this package is installed
+on the local host. @value{tramp} does not keep and @samp{encfs
+mountpoint} permanently. Instead, it encrypts / decrypts files and
+file names on the fly, using @command{encfsctl}.
+
+@deffn Command tramp-crypt-add-directory name
+This command marks the existing remote directory @var{name} for
+encryption. Files in that directory and all subdirectories will be
+encrypted before copying to, and decrypted after copying from that
+directory. File and directory names will be also encrypted.
+@end deffn
+
+@defopt tramp-crypt-encfs-option
+If a remote directory is marked for encryption, it is initialized via
+@command{encfs} the very first time a file in this directory is
+accessed. This user option controls, which default @command{encfs}
+configuration option will be selected, it can be @t{"--standard"}
+or @t{"--paranoia"}. See the @samp{encfs(1)} man page for details.
+
+However, @value{tramp} must adapt these configuration sets. The
+@code{chainedNameIV} configuration option must be disabled; otherwise
+@value{tramp} couldn't handle file name encryption transparently.
+@end defopt
+
+A password protected @option{encfs} configuration file is created the
+very first time you access an encrypted remote directory. It is kept
+in your @code{user-emacs-directory} with the url-encoded directory
+name as part of the basename, and @file{encfs6.xml} as suffix. If
+you, for example, mark the remote directory
+@file{@trampfn{nextcloud,user@@host,/path/to/dir}} for encryption, the
+configuration file is saved as
+@file{tramp-%2Fnextcloud%3Auser%40host%3A%2Fpath%2Fto%2Fdir%2F.encfs6.xml}
+in @code{user-emacs-directory}. Do not loose this file and the
+corresponding password; otherwise there is no way to decrypt your
+encrypted files.
+
+@defopt tramp-crypt-save-encfs-config-remote
+If this user option is non-@code{nil} (the default), the @option{encfs}
+configuration file @file{.encfs6.xml} is also kept in the encrypted
+remote directory. It depends on you, whether you regard the password
+protection of this file as sufficient. The advantage would be, that
+such a remote directory could be accessed by different Emacs sessions,
+different users, without presharing the configuration file between the
+users.
+@end defopt
+
+The command @command{encfsctl}, the workhorse for encryption /
+decryption, needs the configuration file password every call.
+Therefore, it is recommend to cache this password in Emacs. This can
+be done using @code{auth-sources}, @ref{Using an authentication file}.
+An entry needs the url-encoded directory name as machine, your local
+user name as user, and the password. The port is optional, if given
+it must be the string @t{"crypt"}. The example above would require
+the following entry in the authentication file (@t{"yourname"} is the
+result of @code{(user-login-name)}):
+
+@example
+machine %2Fnextcloud%3Auser%40host%3A%2Fpath%2Fto%2Fdir%2F \
+ login yourname port crypt password geheim
+@end example
+
+If you use a remote file name with a quoted localname part, this
+localname and the corresponding file will not be encrypted /
+decrypted. If you have an encrypted remote directory
+@file{@trampfn{nextcloud,user@@host,/path/to/dir}}, the command
+
+@example
+@kbd{C-x d @trampfn{nextcloud,user@@host,/path/to/dir}}
+@end example
+
+@noindent
+will show the directory listing with the plain file names, and the
+command
+
+@example
+@kbd{C-x d @trampfn{nextcloud,user@@host,/:/path/to/dir}}
+@end example
+
+@noindent
+will show the directory listing with the encrypted file names, and
+visiting a file will show its encrypted contents. However, it is
+highly discouraged to mix encrypted and not encrypted files in the
+same directory.
+
+@deffn Command tramp-crypt-add-directory name
+If a remote directory shall not include encrypted files anymore, it
+must be indicated by this command.
+@end deffn
+
+
@node Windows setup hints
@section Issues with Cygwin ssh
@cindex cygwin, issues
@@ -2665,10 +2811,10 @@ Wiki} it is explained how to use the helper program
@cindex @option{scpx} method with cygwin
When using the @option{scpx} access method, Emacs may call
-@command{scp} with MS Windows file naming, such as @code{c:/foo}. But
+@command{scp} with MS Windows file naming, such as @file{c:/foo}. But
the version of @command{scp} that is installed with Cygwin does not
know about MS Windows file naming, which causes it to incorrectly look
-for a host named @code{c}.
+for a host named @samp{c}.
A workaround: write a wrapper script for @option{scp} to convert
Windows file names to Cygwin file names.
@@ -3027,7 +3173,7 @@ or a string describing the signal, when the process has
been
interrupted. Since it cannot be determined reliably whether a remote
process has been interrupted, @code{process-file} returns always the
exit code. When the user option
-@code{process-file-return-signal-string} is non-nil,
+@code{process-file-return-signal-string} is non-@code{nil},
@code{process-file} regards all exit codes greater than 128 as an
indication that the process has been interrupted, and returns a
respective string.
@@ -3047,9 +3193,9 @@ integrated to work with @value{tramp}: @file{shell.el},
@value{tramp} always modifies the @env{INSIDE_EMACS} environment
variable for remote processes. Per default, this environment variable
shows the Emacs version. @value{tramp} adds its own version string,
-so it looks like @samp{27.1,tramp:2.4.3.1}. However, other packages
+so it looks like @samp{27.2,tramp:2.4.5.1}. However, other packages
might also add their name to this environment variable, like
-@samp{27.1,comint,tramp:2.4.3.1}.
+@samp{27.2,comint,tramp:2.4.5.1}.
For @value{tramp} to find the command on the remote, it must be
accessible through the default search path as setup by @value{tramp}
@@ -3158,8 +3304,8 @@ whatever reason, then replace @code{(getenv "DISPLAY")}
with a
hard-coded, fixed name. Note that using @code{:0} for X11 display name
here will not work as expected.
-An alternate approach is specify @code{ForwardX11 yes} or
-@code{ForwardX11Trusted yes} in @file{~/.ssh/config} on the local
+An alternate approach is specify @option{ForwardX11 yes} or
+@option{ForwardX11Trusted yes} in @file{~/.ssh/config} on the local
host.
@@ -3174,8 +3320,8 @@ ensures the correct name of the remote shell program.
When @code{explicit-shell-file-name} is equal to @code{nil}, calling
@code{shell} interactively will prompt for a shell name.
-Starting with Emacs 26, you could use connection-local variables for
-setting different values of @code{explicit-shell-file-name} for
+Starting with @w{Emacs 26}, you could use connection-local variables
+for setting different values of @code{explicit-shell-file-name} for
different remote hosts.
@ifinfo
@xref{Connection Variables, , , emacs}.
@@ -3225,30 +3371,30 @@ host. Example:
@end group
@end example
-@command{tail} command outputs continuously to the local buffer,
-@file{*Async Shell Command*}
+@command{tail} command outputs continuously to the local buffer whose
+name is the value of the variable @code{shell-command-buffer-name-async}.
@kbd{M-x auto-revert-tail-mode @key{RET}} runs similarly showing
continuous output.
@vindex shell-file-name
@vindex shell-command-switch
-@code{shell-command} uses the variables @code{shell-file-name} and
-@code{shell-command-switch} in order to determine which shell to run.
-For remote hosts, their default values are @file{/bin/sh} and
-@option{-c}, respectively (except for the @option{adb} method, which
-uses @file{/system/bin/sh}). Like the variables in the previous
-section, these variables can be changed via connection-local
-variables.
+@code{shell-command} uses the user option @code{shell-file-name} and
+the variable @code{shell-command-switch} in order to determine which
+shell to run. For remote hosts, their default values are
+@file{/bin/sh} and @option{-c}, respectively (except for the
+@option{adb} method, which uses @file{/system/bin/sh}). Like the
+variables in the previous section, these variables can be changed via
+connection-local variables.
@vindex async-shell-command-width
@vindex COLUMNS@r{, environment variable}
-If Emacs supports the variable @code{async-shell-command-width} (since
-Emacs 27), @value{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 @env{COLUMNS} to
-@code{tramp-remote-process-environment}.
+If Emacs supports the user option @code{async-shell-command-width}
+(since @w{Emacs 27}), @value{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
+@env{COLUMNS} to @code{tramp-remote-process-environment}.
@subsection Running @code{eshell} on a remote host
@@ -3380,6 +3526,74 @@ To open @command{powershell} as a remote shell, use this:
@end lisp
+@anchor{Improving performance of asynchronous remote processes}
+@subsection Improving performance of asynchronous remote processes
+@cindex Asynchronous remote processes
+@findex make-process
+@findex start-file-process
+
+@value{tramp}'s implementation of @code{make-process} and
+@code{start-file-process} requires a serious overhead for
+initialization, every process invocation. This is needed for handling
+interactive dialogues when connecting the remote host (like providing
+a password), and initial environment setup.
+
+Sometimes, this is not needed. Instead of starting a remote shell and
+running the command afterwards, it is sufficient to run the command
+directly. @value{tramp} supports this by an alternative
+implementation of @code{make-process} and @code{start-file-process}.
+This is triggered by the connection property
+@t{"direct-async-process"}, @xref{Predefined connection information},
+which must be set to a non-@code{nil} value. Example:
+
+@lisp
+@group
+(add-to-list 'tramp-connection-properties
+ (list (regexp-quote "@trampfn{ssh,user@@host,}")
+ "direct-async-process" t))
+@end group
+@end lisp
+
+Using direct asynchronous processes in @value{tramp} is not possible,
+if the remote host is connected via multiple hops
+(@pxref{Multi-hops}). In this case, @value{tramp} falls back to its
+classical implementation.
+
+Furthermore, this approach has the following limitations:
+
+@itemize
+@item
+It works only for connection methods defined in @file{tramp-sh.el} and
+@file{tramp-adb.el}.
+
+@item
+It does not support interactive user authentication. With
+@option{ssh}-based methods, this can be avoided by using a password
+agent like @command{ssh-agent}, using public key authentication, or
+using @option{ControlMaster} options.
+
+@item
+It cannot be killed via @code{interrupt-process}.
+
+@item
+It does not report the remote terminal name via @code{process-tty-name}.
+
+@item
+It does not set process property @code{remote-pid}.
+
+@item
+It does not use @code{tramp-remote-path} and
+@code{tramp-remote-process-environment}.
+@end itemize
+
+In order to gain even more performance, it is recommended to bind
+@code{tramp-verbose} to 0 when running @code{make-process} or
+@code{start-file-process}. Furthermore, you might set
+@code{tramp-use-ssh-controlmaster-options} to @code{nil} in order to
+bypass @value{tramp}'s handling of the @option{ControlMaster} options,
+and use your own settings in @file{~/.ssh/config}.
+
+
@node Cleanup remote connections
@section Cleanup remote connections
@cindex cleanup
@@ -3451,8 +3665,8 @@ On all buffers, which have a @code{buffer-file-name}
matching
prompted for modification in the minibuffer. The buffers are marked
modified, and must be saved explicitly.
-If user option @code{tramp-confirm-rename-file-names} is nil, changing
-the file name happens without confirmation. This requires a
+If user option @code{tramp-confirm-rename-file-names} is @code{nil},
+changing the file name happens without confirmation. This requires a
matching entry in @code{tramp-default-rename-alist}.
Remote buffers related to the remote connection identified by
@@ -3491,8 +3705,8 @@ Tramp infers by default, such as
@samp{@trampfn{method,user@@host,}}).
name of @code{source} when calling @code{tramp-rename-files}.
@code{source} could also be a Lisp form, which will be evaluated. The
-result must be a string or nil, which is interpreted as a regular
-expression which always matches.
+result must be a string or @code{nil}, which is interpreted as a
+regular expression which always matches.
Example entries:
@@ -3731,7 +3945,7 @@ row are possible, like
@file{/path/to/dir/file.tar.gz.uu/dir/file}.
@vindex tramp-archive-all-gvfs-methods
An archive file name could be a remote file name, as in
-@file{/ftp:anonymous@@ftp.gnu.org:/gnu/tramp/tramp-2.4.3.tar.gz/INSTALL}.
+@file{/ftp:anonymous@@ftp.gnu.org:/gnu/tramp/tramp-2.4.5.tar.gz/INSTALL}.
Since all file operations are mapped internally to @acronym{GVFS}
operations, remote file names supported by @code{tramp-gvfs} perform
better, because no local copy of the file archive must be downloaded
@@ -3742,7 +3956,7 @@ the similar @samp{/scp:user@@host:...}. See the constant
If @code{url-handler-mode} is enabled, archives could be visited via
URLs, like
-@file{https://ftp.gnu.org/gnu/tramp/tramp-2.4.3.tar.gz/INSTALL}. This
+@file{https://ftp.gnu.org/gnu/tramp/tramp-2.4.5.tar.gz/INSTALL}. This
allows complex file operations like
@lisp
@@ -3750,8 +3964,8 @@ allows complex file operations like
(progn
(url-handler-mode 1)
(ediff-directories
- "https://ftp.gnu.org/gnu/tramp/tramp-2.4.2.tar.gz/tramp-2.4.2";
- "https://ftp.gnu.org/gnu/tramp/tramp-2.4.3.tar.gz/tramp-2.4.3"; ""))
+ "https://ftp.gnu.org/gnu/tramp/tramp-2.4.4.tar.gz/tramp-2.4.4";
+ "https://ftp.gnu.org/gnu/tramp/tramp-2.4.5.tar.gz/tramp-2.4.5"; ""))
@end group
@end lisp
@@ -3866,8 +4080,8 @@ Where is the latest @value{tramp}?
@item
Which systems does it work on?
-The package works successfully on Emacs 24, Emacs 25, Emacs 26, Emacs
-27, and Emacs 28.
+The package works successfully on @w{Emacs 25}, @w{Emacs 26}, @w{Emacs
+27}, and @w{Emacs 28}.
While Unix and Unix-like systems are the primary remote targets,
@value{tramp} has equal success connecting to other platforms, such as
@@ -4069,17 +4283,17 @@ Host *
@item
-@value{tramp} does not use default @command{ssh} @code{ControlPath}
+@value{tramp} does not use default @command{ssh} @option{ControlPath}
-@value{tramp} overwrites @code{ControlPath} settings when initiating
+@value{tramp} overwrites @option{ControlPath} settings when initiating
@command{ssh} sessions. @value{tramp} does this to fend off a stall
if a master session opened outside the Emacs session is no longer
open. That is why @value{tramp} prompts for the password again even
if there is an @command{ssh} already open.
@vindex tramp-ssh-controlmaster-options
-Some @command{ssh} versions support a @code{ControlPersist} option,
-which allows you to set the @code{ControlPath} provided the variable
+Some @command{ssh} versions support a @option{ControlPersist} option,
+which allows you to set the @option{ControlPath} provided the variable
@code{tramp-ssh-controlmaster-options} is customized as follows:
@lisp
@@ -4104,12 +4318,16 @@ this @code{nil} setting:
(customize-set-variable 'tramp-use-ssh-controlmaster-options nil)
@end lisp
+This shall also be set to @code{nil} if you use the
+@option{ProxyCommand} or @option{ProxyJump} options in your
+@command{ssh} configuration.
+
@item
On multi-hop connections, @value{tramp} does not use @command{ssh}
-@code{ControlMaster}
+@option{ControlMaster}
-In order to use the @code{ControlMaster} option, @value{tramp} must
+In order to use the @option{ControlMaster} option, @value{tramp} must
check whether the @command{ssh} client supports this option. This is
only possible on the local host, for the first hop. @value{tramp}
does not use this option on proxy hosts.
@@ -4120,19 +4338,19 @@ configure @file{~/.ssh/config} on the proxy host:
@example
@group
Host *
- ControlMaster auto
- ControlPath tramp.%C
- ControlPersist no
+ ControlMaster auto
+ ControlPath tramp.%C
+ ControlPersist no
@end group
@end example
-Check @command{man ssh_config} whether these options are supported on
-your proxy host.
+Check the @samp{ssh_config(5)} man page whether these options are
+supported on your proxy host.
@item
@value{tramp} does not connect to Samba or MS Windows hosts running
-SMB1 connection protocol.
+SMB1 connection protocol
@vindex tramp-smb-options
Recent versions of @command{smbclient} do not support old connection
@@ -4218,7 +4436,7 @@ Host indication in the mode line?
@cindex @value{tramp} theme
@vindex tramp-theme-face-remapping-alist
-Install @file{tramp-theme} from GNU ELPA via Emacs' Package Manager.
+Install @file{tramp-theme} from GNU ELPA via Emacs's Package Manager.
Enable it via @kbd{M-x load-theme @key{RET} tramp @key{RET}}. Further
customization is explained in user option
@code{tramp-theme-face-remapping-alist}.
@@ -4291,6 +4509,21 @@ HISTFILE=/dev/null
@item
+Where are remote files trashed to?
+
+Emacs can trash file instead of deleting them, @ref{Misc File Ops,
+Trashing , , emacs}. Remote files are always trashed to the local
+trash, except remote encrypted files (@pxref{Keeping files
+encrypted}), which are deleted anyway.
+
+If Emacs is configured to use the XDG conventions for the trash
+directory, remote files cannot be restored with the respective tools,
+because those conventions don't specify remote paths. Such files must
+be restored by moving them manually from
+@file{$@{XDG_DATA_HOME@}/Trash/files/}, if needed.
+
+
+@item
How to shorten long file names when typing in @value{tramp}?
Adapt several of these approaches to reduce typing. If the full name
@@ -4359,7 +4592,7 @@ completion can further reduce key strokes: @kbd{C-x C-f
@value{prefix}ssh@value{postfixhop}x @key{TAB}}.
@item
-Use environment variables to expand long strings
+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
@@ -4405,9 +4638,8 @@ Abbreviation list expansion can be used to reduce typing
long file names:
@lisp
@group
-(add-to-list
- 'directory-abbrev-alist
- '("^/xy" . "@trampfn{ssh,news@@news.my.domain,/opt/news/etc/}"))
+(add-to-list 'directory-abbrev-alist
+ '("^/xy" . "@trampfn{ssh,news@@news.my.domain,/opt/news/etc/}"))
@end group
@end lisp
@@ -4643,6 +4875,27 @@ In case you have installed it from its Git repository,
@ref{Recompilation}.
@item
+I get an error @samp{Remote file error: Forbidden reentrant call of Tramp}
+
+@vindex remote-file-error
+@vindex debug-ignored-errors
+Timers, process filters and sentinels, and other event based functions
+can run at any time, when a remote file operation is still running.
+This can cause @value{tramp} to block. When such a situation is
+detected, this error is triggered. It shall be fixed in the
+respective function (an error report will help), but for the time
+being you can suppress this error by the following code in your
+@file{~/.emacs}:
+
+@lisp
+@group
+(setq debug-ignored-errors
+ (cons 'remote-file-error debug-ignored-errors))
+@end group
+@end lisp
+
+
+@item
How to disable other packages from calling @value{tramp}?
There are packages that call @value{tramp} without the user ever
@@ -4747,7 +5000,7 @@ handlers.
@node External packages
@section Integrating with external Lisp packages
-@subsection File name completion.
+@subsection File name completion
@vindex non-essential
Sometimes, it is not convenient to open a new connection to a remote
@@ -4765,8 +5018,9 @@ bind it to non-@code{nil} value.
@end lisp
-@subsection File attributes cache.
+@subsection File attributes cache
+@vindex process-file-side-effects
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 @value{tramp} to a grinding halt on busy
@@ -4805,9 +5059,30 @@ root-directory, it is most likely sufficient to make the
@code{default-directory} of the process buffer as the root directory.
+@subsection Timers
+
+@vindex remote-file-error
+Timers run asynchronously at any time when Emacs is waiting for
+sending a string to a process, or waiting for process output. They
+can run any remote file operation, which would conflict with the
+already running remote file operation, if the same connection is
+affected. @value{tramp} detects this situation, and raises the
+@code{remote-file-error} error. A timer function shall avoid this
+situation. At least, it shall protect itself against this error, by
+wrapping the timer function body with
+
+@lisp
+@group
+(ignore-error 'remote-file-error
+ @dots{})
+@end group
+@end lisp
+
+
@node Traces and Profiles
@chapter How to Customize Traces
@vindex tramp-verbose
+@vindex tramp-debug-to-file
@value{tramp} messages are raised with verbosity levels ranging from 0
to 10. @value{tramp} does not display all messages; only those with a
@@ -4860,6 +5135,20 @@ If @code{tramp-verbose} is greater than or equal to 10,
Lisp
backtraces are also added to the @value{tramp} debug buffer in case of
errors.
+In very rare cases it could happen, that @value{tramp} blocks Emacs.
+Killing Emacs does not allow to inspect the debug buffer. In that
+case, you might instruct @value{tramp} to mirror the debug buffer to
+file:
+
+@lisp
+(customize-set-variable 'tramp-debug-to-file t)
+@end lisp
+
+The debug buffer is written as file in your
+@code{temporary-file-directory}, which is usually @file{/tmp/}. Use
+this option with care, because it could decrease the performance of
+@value{tramp} actions.
+
To enable stepping through @value{tramp} function call traces, they
have to be specifically enabled as shown in this code:
diff --git a/texi/trampver.texi b/texi/trampver.texi
index 1e70463..4d0d84b 100644
--- a/texi/trampver.texi
+++ b/texi/trampver.texi
@@ -8,9 +8,10 @@
@c In the Tramp GIT, the version numbers are auto-frobbed from
@c tramp.el, and the bug report address is auto-frobbed from
@c configure.ac.
-@set trampver 2.4.4.4
+@set trampver 0
+@set trampurl https://www.gnu.org/software/tramp/
@set tramp-bug-report-address tramp-devel@@gnu.org
-@set emacsver 24.4
+@set emacsver 25.1
@c Other flags from configuration.
@set instprefix /usr/local
diff --git a/tramp-adb.el b/tramp-adb.el
index 2f20c8d..9ea7266 100644
--- a/tramp-adb.el
+++ b/tramp-adb.el
@@ -57,15 +57,27 @@ It is used for TCP/IP devices."
"When this method name is used, forward all calls to Android Debug Bridge.")
;;;###tramp-autoload
-(defcustom tramp-adb-prompt
- "^[[:digit:]]*|?[[:alnum:]\e;[]*@?[[:alnum:]]*[^#\\$]*[#\\$][[:space:]]"
+(defcustom tramp-adb-prompt "^[^#$\n\r]*[#$][[:space:]]"
"Regexp used as prompt in almquist shell."
:type 'regexp
- :version "24.4"
+ :version "28.1"
:group 'tramp)
+(eval-and-compile
+ (defconst tramp-adb-ls-date-year-regexp
+ "[[:digit:]]\\{4\\}-[[:digit:]]\\{2\\}-[[:digit:]]\\{2\\}"
+ "Regexp for date year format in ls output."))
+
+(eval-and-compile
+ (defconst tramp-adb-ls-date-time-regexp
+ "[[:digit:]]\\{2\\}:[[:digit:]]\\{2\\}"
+ "Regexp for date time format in ls output."))
+
(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:]]"
+ (concat
+ "[[:space:]]" tramp-adb-ls-date-year-regexp
+ "[[:space:]]" tramp-adb-ls-date-time-regexp
+ "[[:space:]]")
"Regexp for date format in ls output.")
(defconst tramp-adb-ls-toolbox-regexp
@@ -75,7 +87,8 @@ It is used for TCP/IP devices."
"[[:space:]]*\\([^[:space:]]+\\)" ; \2 username
"[[:space:]]+\\([^[:space:]]+\\)" ; \3 group
"[[:space:]]+\\([[:digit:]]+\\)" ; \4 size
- "[[:space:]]+\\([-[:digit:]]+[[:space:]][:[:digit:]]+\\)" ; \5 date
+ "[[:space:]]+\\(" tramp-adb-ls-date-year-regexp
+ "[[:space:]]" tramp-adb-ls-date-time-regexp "\\)" ; \5 date
"[[:space:]]\\(.*\\)$") ; \6 filename
"Regexp for ls output.")
@@ -83,8 +96,10 @@ It is used for TCP/IP devices."
(tramp--with-startup
(add-to-list 'tramp-methods
`(,tramp-adb-method
- (tramp-tmpdir "/data/local/tmp")
- (tramp-default-port 5555)))
+ (tramp-login-program ,tramp-adb-program)
+ (tramp-login-args (("shell")))
+ (tramp-tmpdir "/data/local/tmp")
+ (tramp-default-port 5555)))
(add-to-list 'tramp-default-host-alist `(,tramp-adb-method nil ""))
@@ -138,7 +153,7 @@ It is used for TCP/IP devices."
(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-truename . tramp-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.
@@ -162,6 +177,8 @@ It is used for TCP/IP devices."
(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-get-remote-gid . ignore)
+ (tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore)
(unhandled-file-name-directory . ignore)
(vc-registered . ignore)
@@ -183,10 +200,9 @@ It is used for TCP/IP devices."
"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) arguments))
- (tramp-run-real-handler operation arguments))))
+ (if-let ((fn (assoc operation tramp-adb-file-name-handler-alist)))
+ (save-match-data (apply (cdr fn) arguments))
+ (tramp-run-real-handler operation arguments)))
;;;###tramp-autoload
(tramp--with-startup
@@ -201,7 +217,7 @@ ARGUMENTS to pass to the OPERATION."
(lambda (line)
(when (string-match "^\\(\\S-+\\)[[:space:]]+device$" line)
;; Replace ":" by "#".
- `(nil ,(replace-regexp-in-string
+ `(nil ,(tramp-compat-string-replace
":" tramp-prefix-port-format (match-string 1 line)))))
(tramp-process-lines nil tramp-adb-program "devices"))))
@@ -216,11 +232,10 @@ ARGUMENTS to pass to the OPERATION."
(goto-char (point-min))
(forward-line)
(when (looking-at
- (eval-when-compile
- (concat "[[:space:]]*[^[:space:]]+"
- "[[:space:]]+\\([[:digit:]]+\\)"
- "[[:space:]]+\\([[:digit:]]+\\)"
- "[[:space:]]+\\([[:digit:]]+\\)")))
+ (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)))
@@ -230,105 +245,6 @@ ARGUMENTS to pass to the OPERATION."
(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 (tramp-compat-directory-name-p filename)
- #'file-name-as-directory #'identity)
- ;; Quote properly.
- (funcall
- (if (tramp-compat-file-name-quoted-p filename)
- #'tramp-compat-file-name-quote #'identity)
- (with-parsed-tramp-file-name
- (tramp-compat-file-name-unquote (expand-file-name filename)) nil
- (tramp-make-tramp-file-name
- v
- (with-tramp-file-property v localname "file-truename"
- (let (result) ; result steps in reverse order
- (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"
- (string-join
- (append '("") (reverse result) (list thisstep)) "/"))
- (setq symlink-target
- (tramp-compat-file-attribute-type
- (file-attributes
- (tramp-make-tramp-file-name
- v
- (string-join
- (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 "/user@host:/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
- (string-join (cons "" result) "/")
- "/"))
- (when (and is-dir (or (string-empty-p 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 (file-remote-p result)
- (setq result (tramp-compat-file-name-quote result 'top)))
- (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))
@@ -372,7 +288,9 @@ ARGUMENTS to pass to the OPERATION."
(if (eq id-format 'integer) 0 uid)
(if (eq id-format 'integer) 0 gid)
tramp-time-dont-know ; atime
- (date-to-time date) ; mtime
+ ;; `date-to-time' checks `iso8601-parse', which might fail.
+ (let (signal-hook-function)
+ (date-to-time date)) ; mtime
tramp-time-dont-know ; ctime
size
mod-string
@@ -383,7 +301,7 @@ ARGUMENTS to pass to the OPERATION."
file-properties)))
(defun tramp-adb-handle-directory-files-and-attributes
- (directory &optional full match nosort id-format _count)
+ (directory &optional full match nosort id-format count)
"Like `directory-files-and-attributes' for Tramp files."
(unless (file-exists-p directory)
(tramp-error
@@ -393,8 +311,8 @@ ARGUMENTS to pass to the OPERATION."
(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)
+ v localname (format "directory-files-and-attributes-%s-%s-%s-%s-%s"
+ full match id-format nosort count)
(with-current-buffer (tramp-get-buffer v)
(when (tramp-adb-send-command-and-check
v (format "%s -a -l %s"
@@ -424,11 +342,17 @@ ARGUMENTS to pass to the OPERATION."
(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)))))))))
+
+ (setq result (delq nil
+ (mapcar
+ (lambda (x) (if (or (not match)
+ (string-match-p
+ match (car x)))
+ x))
+ result)))
+ (when (and (natnump count) (> count 0))
+ (setq result (nbutlast result (- (length result) count))))
+ result)))))))
(defun tramp-adb-get-ls-command (vec)
"Determine `ls' command and its arguments."
@@ -439,7 +363,8 @@ ARGUMENTS to pass to the OPERATION."
;; 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")
+ vec (concat "ls --time-style=long-iso "
+ (tramp-get-remote-null-device vec)))
"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.
@@ -447,25 +372,11 @@ ARGUMENTS to pass to the OPERATION."
;; 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")
+ ((tramp-adb-send-command-and-check
+ vec (concat "ls --color=never -al " (tramp-get-remote-null-device vec)))
"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.
Android's \"ls\" command doesn't insert size column for directories:
@@ -475,10 +386,16 @@ Emacs dired can't find files."
(goto-char (point-min))
(while
(search-forward-regexp
-
"[[:space:]]\\([[:space:]][0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9][[:space:]]\\)" nil
t)
+ (eval-when-compile
+ (concat
+ "[[:space:]]"
+ "\\([[:space:]]" tramp-adb-ls-date-year-regexp "[[:space:]]\\)"))
+ nil t)
(replace-match "0\\1" "\\1" nil)
;; Insert missing "/".
- (when (looking-at-p "[0-9][0-9]:[0-9][0-9][[:space:]]+$")
+ (when (looking-at-p
+ (eval-when-compile
+ (concat tramp-adb-ls-date-time-regexp "[[:space:]]+$")))
(end-of-line)
(insert "/")))
;; Sort entries.
@@ -528,27 +445,25 @@ Emacs dired can't find files."
(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)
+(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-directory-properties v localname))
- (with-parsed-tramp-file-name directory nil
- (tramp-flush-directory-properties v localname)
+ (tramp-skeleton-delete-directory directory recursive trash
(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)
+(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 localname)
- (tramp-adb-barf-unless-okay
- v (format "rm %s" (tramp-shell-quote-argument localname))
- "Couldn't delete %s" filename)))
+ (if (and delete-by-moving-to-trash trash)
+ (move-file-to-trash filename)
+ (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."
@@ -589,9 +504,10 @@ Emacs dired can't find files."
(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)))
+ (unless
+ (and (tramp-adb-execute-adb-command
+ v "pull" (tramp-compat-file-name-unquote localname) tmpfile)
+ (file-exists-p tmpfile))
(ignore-errors (delete-file tmpfile))
(tramp-error
v 'file-error "Cannot make local copy of file `%s'" filename))
@@ -644,8 +560,8 @@ But handle the case, if the \"test\" command is not
available."
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))
+ (unless (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)))
@@ -661,8 +577,9 @@ But handle the case, if the \"test\" command is not
available."
;; Set file modification time.
(when (or (eq visit t) (stringp visit))
(set-visited-file-modtime
- (tramp-compat-file-attribute-modification-time
- (file-attributes filename))))
+ (or (tramp-compat-file-attribute-modification-time
+ (file-attributes filename))
+ (current-time))))
;; The end.
(when (and (null noninteractive)
@@ -670,13 +587,16 @@ But handle the case, if the \"test\" command is not
available."
(tramp-message v 0 "Wrote %s" filename))
(run-hooks 'tramp-handle-write-region-hook))))
-(defun tramp-adb-handle-set-file-modes (filename mode &optional _flag)
+(defun tramp-adb-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
(with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v localname)
- (tramp-adb-send-command-and-check v (format "chmod %o %s" mode
localname))))
+ ;; ADB shell does not support "chmod -h".
+ (unless (and (eq flag 'nofollow) (file-symlink-p filename))
+ (tramp-flush-file-properties v localname)
+ (tramp-adb-send-command-and-check
+ v (format "chmod %o %s" mode (tramp-shell-quote-argument localname))))))
-(defun tramp-adb-handle-set-file-times (filename &optional time _flag)
+(defun tramp-adb-handle-set-file-times (filename &optional time flag)
"Like `set-file-times' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)
@@ -685,21 +605,23 @@ But handle the case, if the \"test\" command is not
available."
(tramp-compat-time-equal-p time tramp-time-dont-know))
(current-time)
time))
+ (nofollow (if (eq flag 'nofollow) "-h" ""))
(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)))))
+ v (format
+ (concat "touch -d %s %s %s 2>%s || "
+ "touch -d %s %s %s 2>%s || "
+ "touch -t %s %s %s")
+ (format-time-string "%Y-%m-%dT%H:%M:%S.%NZ" time t)
+ nofollow quoted-name (tramp-get-remote-null-device v)
+ (format-time-string "%Y-%m-%dT%H:%M:%S" time t)
+ nofollow quoted-name (tramp-get-remote-null-device v)
+ (format-time-string "%Y%m%d%H%M.%S" time t)
+ nofollow quoted-name)))))
(defun tramp-adb-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
@@ -722,7 +644,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
- (not (tramp-compat-directory-name-p newname)))
+ (not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(with-tramp-progress-reporter
@@ -742,46 +664,45 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(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 localname)
- (when (tramp-adb-execute-adb-command
+ (if-let ((tmpfile (file-local-copy filename)))
+ ;; 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)
+ (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 localname)
+ (unless (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)))))))))
+ (tramp-error
+ v 'file-error
+ "Cannot copy `%s' `%s'" filename newname))))))))
;; KEEP-DATE handling.
(when keep-date
- (set-file-times
+ (tramp-compat-set-file-times
newname
(tramp-compat-file-attribute-modification-time
- (file-attributes filename))))))
+ (file-attributes filename))
+ (unless ok-if-already-exists 'nofollow)))))
(defun tramp-adb-handle-rename-file
(filename newname &optional ok-if-already-exists)
@@ -804,7 +725,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
- (not (tramp-compat-directory-name-p newname)))
+ (not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(with-tramp-progress-reporter
@@ -872,7 +793,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(cons program args) " "))
;; Determine input.
(if (null infile)
- (setq input "/dev/null")
+ (setq input (tramp-get-remote-null-device v))
(setq infile (expand-file-name infile))
(if (tramp-equal-remote default-directory infile)
;; INFILE is on the same remote host.
@@ -914,7 +835,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
tmpstderr (tramp-make-tramp-file-name v stderr))))
;; stderr to be discarded.
((null (cadr destination))
- (setq stderr "/dev/null"))))
+ (setq stderr (tramp-get-remote-null-device v)))))
;; 't
(destination
(setq outbuf (current-buffer))))
@@ -973,164 +894,172 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
;; The complete STDERR buffer is available only when the process has
;; terminated.
(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)))
- (when (and (stringp stderr) (tramp-tramp-file-p stderr)
- (not (tramp-equal-remote default-directory stderr)))
- (signal 'file-error (list "Wrong stderr" 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 can also be a file name.
- (tmpstderr
- (and stderr
- (if (and (stringp stderr) (tramp-tramp-file-p stderr))
- (tramp-unquote-file-local-name stderr)
- (tramp-make-tramp-temp-file v))))
- (remote-tmpstderr
- (and tmpstderr (tramp-make-tramp-file-name v tmpstderr)))
- (program (car command))
- (args (cdr command))
- (command
- (format "cd %s && exec %s %s"
- (tramp-shell-quote-argument localname)
- (if tmpstderr (format "2>'%s'" tmpstderr) "")
- (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)))
- ;; We must flush them here already; otherwise
- ;; `rename-file', `delete-file' or
- ;; `insert-file-contents' will fail.
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer")
- ;; Copy tmpstderr file.
- (when (and (stringp stderr)
- (not (tramp-tramp-file-p stderr)))
- (add-function
- :after (process-sentinel p)
- (lambda (_proc _msg)
- (rename-file remote-tmpstderr stderr))))
- ;; 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))
- ;; Provide error buffer. This shows only
- ;; initial error messages; messages arriving
- ;; later on will be inserted when the process
- ;; is deleted. The temporary file will exist
- ;; until the process is deleted.
- (when (bufferp stderr)
- (with-current-buffer stderr
- (insert-file-contents-literally
- remote-tmpstderr 'visit))
- ;; Delete tmpstderr file.
- (add-function
- :after (process-sentinel p)
- (lambda (_proc _msg)
- (with-current-buffer stderr
- (insert-file-contents-literally
- remote-tmpstderr 'visit nil nil 'replace))
- (delete-file remote-tmpstderr))))
- ;; 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"))))))))
+ "Like `make-process' for Tramp files.
+If connection property \"direct-async-process\" is non-nil, an
+alternative implementation will be used."
+ (if (tramp-direct-async-process-p args)
+ (apply #'tramp-handle-make-process args)
+ (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 #'bufferp stderr)))
+ (when (and (stringp stderr) (tramp-tramp-file-p stderr)
+ (not (tramp-equal-remote default-directory stderr)))
+ (signal 'file-error (list "Wrong stderr" 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 can also be a file name.
+ (tmpstderr
+ (and stderr
+ (if (and (stringp stderr) (tramp-tramp-file-p stderr))
+ (tramp-unquote-file-local-name stderr)
+ (tramp-make-tramp-temp-file v))))
+ (remote-tmpstderr
+ (and tmpstderr (tramp-make-tramp-file-name v tmpstderr)))
+ (program (car command))
+ (args (cdr command))
+ (command
+ (format "cd %s && exec %s %s"
+ (tramp-shell-quote-argument localname)
+ (if tmpstderr (format "2>'%s'" tmpstderr) "")
+ (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)
+ (coding-system-for-write
+ (if (symbolp coding) coding (car coding)))
+ (coding-system-for-read
+ (if (symbolp coding) coding (cdr coding))))
+ (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)))
+ ;; We must flush them here already;
+ ;; otherwise `rename-file', `delete-file' or
+ ;; `insert-file-contents' will fail.
+ (tramp-flush-connection-property v "process-name")
+ (tramp-flush-connection-property v "process-buffer")
+ ;; Copy tmpstderr file.
+ (when (and (stringp stderr)
+ (not (tramp-tramp-file-p stderr)))
+ (add-function
+ :after (process-sentinel p)
+ (lambda (_proc _msg)
+ (rename-file remote-tmpstderr stderr))))
+ ;; 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))
+ ;; Provide error buffer. This shows only
+ ;; initial error messages; messages arriving
+ ;; later on will be inserted when the
+ ;; process is deleted. The temporary file
+ ;; will exist until the process is deleted.
+ (when (bufferp stderr)
+ (with-current-buffer stderr
+ (insert-file-contents-literally
+ remote-tmpstderr 'visit))
+ ;; Delete tmpstderr file.
+ (add-function
+ :after (process-sentinel p)
+ (lambda (_proc _msg)
+ (with-current-buffer stderr
+ (insert-file-contents-literally
+ remote-tmpstderr 'visit nil nil 'replace))
+ (delete-file remote-tmpstderr))))
+ ;; 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"
+ (with-tramp-connection-property (tramp-get-process v) "remote-path"
(tramp-adb-send-command v "echo \\\"$PATH\\\"")
(split-string
(with-current-buffer (tramp-get-connection-buffer v)
@@ -1145,15 +1074,11 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
"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"
+ (with-tramp-connection-property (tramp-get-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-compat-string-replace
tramp-prefix-port-format ":"
(cond ((member host devices) host)
;; This is the case when the host is connected to the default port.
@@ -1167,10 +1092,10 @@ E.g. a host name \"192.168.1.1#5555\" returns
\"192.168.1.1:5555\"
;; 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))))
+ (tramp-adb-execute-adb-command
+ vec "connect"
+ (tramp-compat-string-replace
+ 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.
@@ -1180,18 +1105,18 @@ E.g. a host name \"192.168.1.1#5555\" returns
\"192.168.1.1:5555\"
vec 'file-error "Could not find device %s" host)))))))
(defun tramp-adb-execute-adb-command (vec &rest args)
- "Return nil on success error-output on failure."
+ "Execute an adb command.
+Insert the result into the connection buffer. Return nil on
+error and non-nil on success."
(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)))))
+ (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)))
+ (zerop (apply #'tramp-call-process vec tramp-adb-program nil t nil args))))
(defun tramp-adb-find-test-command (vec)
"Check whether the ash has a builtin \"test\" command.
@@ -1203,25 +1128,30 @@ This happens for Android >= 4.0."
(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))))))
+ (if (string-match-p "[[:multibyte:]]" command)
+ ;; Multibyte codepoints with four bytes are not supported at
+ ;; least by toybox.
+ (tramp-adb-execute-adb-command vec "shell" command)
+
+ (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 &optional exit-status)
"Run COMMAND and check its exit status.
@@ -1236,7 +1166,7 @@ the exit status."
(format "%s; echo tramp_exit_status $?" command)
"echo tramp_exit_status $?"))
(with-current-buffer (tramp-get-connection-buffer vec)
- (unless (tramp-search-regexp "tramp_exit_status [0-9]+")
+ (unless (tramp-search-regexp "tramp_exit_status [[:digit:]]+")
(tramp-error
vec 'file-error "Couldn't find exit status of `%s'" command))
(skip-chars-forward "^ ")
@@ -1334,18 +1264,33 @@ connection if a previous connection has died for some
reason."
(process-put p 'adjust-window-size-function #'ignore)
(set-process-query-on-exit-flag p nil)
+ ;; Set connection-local variables.
+ (tramp-set-connection-local-variables vec)
+
;; Change prompt.
(tramp-set-connection-property
p "prompt" (regexp-quote (format "///%s#$" prompt)))
(tramp-adb-send-command
vec (format "PS1=\"///\"\"%s\"\"#$\"" prompt))
+ ;; Disable line editing.
+ (tramp-adb-send-command
+ vec "set +o vi +o vi-esccomplete +o vi-tabcomplete +o emacs")
+
+ ;; Dump option settings in the traces.
+ (when (>= tramp-verbose 9)
+ (tramp-adb-send-command vec "set -o"))
+
;; 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`\\\"")
+ vec
+ (concat
+ "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
@@ -1369,33 +1314,32 @@ connection if a previous connection has died for some
reason."
(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")
+ ;; Do not flush, we need the nil value.
+ (tramp-set-file-property vec "" "su-command-p" nil)
(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
+;;; Default connection-local variables for Tramp:
+;; `connection-local-set-profile-variables' and
+;; `connection-local-set-profiles' exists since Emacs 26.1.
+(defconst tramp-adb-connection-local-default-shell-variables
'((shell-file-name . "/system/bin/sh")
(shell-command-switch . "-c"))
- "Default connection-local variables for remote adb connections.")
+ "Default connection-local shell variables for remote adb connections.")
+
+(tramp-compat-funcall
+ 'connection-local-set-profile-variables
+ 'tramp-adb-connection-local-default-shell-profile
+ tramp-adb-connection-local-default-shell-variables)
-;; `connection-local-set-profile-variables' and
-;; `connection-local-set-profiles' exists since Emacs 26.1.
(with-eval-after-load 'shell
(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))
+ 'tramp-adb-connection-local-default-shell-profile))
(add-hook 'tramp-unload-hook
(lambda ()
@@ -1403,4 +1347,9 @@ connection if a previous connection has died for some
reason."
(provide 'tramp-adb)
+;;; TODO:
+;;
+;; * Support file names with multibyte codepoints. Use as fallback
+;; "adb shell COMMAND".
+;;
;;; tramp-adb.el ends here
diff --git a/tramp-archive.el b/tramp-archive.el
index 611247e..931a971 100644
--- a/tramp-archive.el
+++ b/tramp-archive.el
@@ -163,7 +163,7 @@
"List of suffixes which indicate a file archive.
It must be supported by libarchive(3).")
-;; <http://unix-memo.readthedocs.io/en/latest/vfs.html>
+;; <https://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.
@@ -279,7 +279,9 @@ It must be supported by libarchive(3).")
(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.
+ (tramp-get-remote-gid . ignore)
+ (tramp-get-remote-uid . ignore)
+ (tramp-set-file-uid-gid . ignore)
(unhandled-file-name-directory . ignore)
(vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
@@ -353,7 +355,7 @@ arguments to pass to the OPERATION."
(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))))
+ (put #'tramp-archive-autoload-file-name-handler 'safe-magic t))))
;;;###autoload
(progn
@@ -369,7 +371,7 @@ arguments to pass to the OPERATION."
(tramp-register-archive-file-name-handler)
;; Mark `operations' the handler is responsible for.
-(put 'tramp-archive-file-name-handler 'operations
+(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'.
@@ -520,13 +522,16 @@ 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))))))
+ (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
+ (cdr (mapcar #'car (cl-struct-slot-info 'tramp-file-name))))))))
`(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,
diff --git a/tramp-cache.el b/tramp-cache.el
index 0f2d7a1..d2c451c 100644
--- a/tramp-cache.el
+++ b/tramp-cache.el
@@ -31,13 +31,13 @@
;; a process, has a unique cache. We distinguish 4 kind of caches,
;; depending on the key:
;;
-;; - localname is NIL. This are reusable properties. Examples:
+;; - localname is nil. These 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
+;; - localname is a string. These 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
@@ -45,21 +45,32 @@
;; expire after `remote-file-name-inhibit-cache' seconds if this
;; variable is set.
;;
-;; - The key is a process. This are temporary properties related to
+;; - The key is a process. These 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
+;; - The key is nil. These 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.
+;;
+;; - The key is `tramp-cache-undefined'. All functions return the
+;; expected values, but nothing is cached.
;; Some properties are handled special:
;;
;; - "process-name", "process-buffer" and "first-password-request" are
-;; not saved in the file `tramp-persistency-file-name'.
+;; not saved in the file `tramp-persistency-file-name', although
+;; being connection properties related to a `tramp-file-name'
+;; structure.
+;;
+;; - Reusable properties, which should not be saved, are kept in the
+;; process key retrieved by `tramp-get-process' (the main connection
+;; process). Other processes could reuse these properties, avoiding
+;; recomputation when a new asynchronous process is created by
+;; `make-process'. Examples are "remote-path" or "device" (tramp-adb.el).
;;; Code:
@@ -96,25 +107,31 @@ details see the info pages."
(defvar tramp-cache-data-changed nil
"Whether persistent cache data have been changed.")
+;;;###tramp-autoload
+(defconst tramp-cache-undefined 'undef
+ "The symbol marking undefined hash keys and values.")
+
(defun tramp-get-hash-table (key)
"Return 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)))
+matching entries of `tramp-connection-properties'.
+If KEY is `tramp-cache-undefined', don't create anything, and return nil."
+ (unless (eq key tramp-cache-undefined)
+ (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."
+Return 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))
@@ -122,31 +139,32 @@ Returns DEFAULT if not set."
(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)
+ (cached (and (hash-table-p hash) (gethash property hash)))
+ (cached-at (and (consp cached) (format-time-string "%T" (car cached))))
+ (value default)
+ cache-used)
+
+ (when ;; 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 cached)
(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))))
+ nil
+ (time-add (car cached) 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))
+ remote-file-name-inhibit-cache (car cached)))))
+ (setq value (cdr cached)
+ cache-used t))
- (tramp-message key 8 "%s %s %s" file property value)
+ (tramp-message
+ key 8 "%s %s %s; inhibit: %s; cache used: %s; cached at: %s"
+ file property value remote-file-name-inhibit-cache cache-used cached-at)
(when (>= tramp-verbose 10)
(let* ((var (intern (concat "tramp-cache-get-count-" property)))
- (val (or (bound-and-true-p var)
+ (val (or (numberp (bound-and-true-p var))
(progn
(add-hook 'tramp-cache-unload-hook
(lambda () (makunbound var)))
@@ -157,7 +175,7 @@ Returns DEFAULT if not set."
;;;###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."
+Return VALUE."
;; Unify localname. Remove hop from `tramp-file-name' structure.
(setq file (tramp-compat-file-name-unquote file)
key (copy-tramp-file-name key))
@@ -170,7 +188,7 @@ Returns VALUE."
(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)
+ (val (or (numberp (bound-and-true-p var))
(progn
(add-hook 'tramp-cache-unload-hook
(lambda () (makunbound var)))
@@ -202,13 +220,11 @@ Returns VALUE."
key (copy-tramp-file-name key))
(setf (tramp-file-name-localname key) file
(tramp-file-name-hop key) nil)
- (maphash
- (lambda (property _value)
- (when (string-match-p
- "^\\(directory-\\|file-name-all-completions\\|file-entries\\)"
- property)
- (tramp-flush-file-property key file property)))
- (tramp-get-hash-table key)))))
+ (dolist (property (hash-table-keys (tramp-get-hash-table key)))
+ (when (string-match-p
+ "^\\(directory-\\|file-name-all-completions\\|file-entries\\)"
+ property)
+ (tramp-flush-file-property key file property))))))
;;;###tramp-autoload
(defun tramp-flush-file-properties (key file)
@@ -239,14 +255,12 @@ Remove also properties of all files in subdirectories."
#'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)
+ (dolist (key (hash-table-keys tramp-cache-data))
+ (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)))
;; Remove file properties of symlinks.
(when (and (stringp truename)
(not (string-equal directory (directory-file-name truename))))
@@ -292,8 +306,9 @@ This is suppressed for temporary buffers."
"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."
+used to cache connection properties of the local machine.
+If KEY is `tramp-cache-undefined', or if the value is not set for
+the connection, return 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)
@@ -301,15 +316,19 @@ value is not set for the connection, returns DEFAULT."
(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)
+ (cached (if (hash-table-p hash)
+ (gethash property hash tramp-cache-undefined)
+ tramp-cache-undefined))
+ (value default)
+ cache-used)
+
+ (when (and (not (eq cached tramp-cache-undefined))
+ ;; If the key is an auxiliary process object, check
+ ;; whether the process is still alive.
+ (not (and (processp key) (not (process-live-p key)))))
+ (setq value cached
+ cache-used t))
+ (tramp-message key 7 "%s %s; cache used: %s" property value cache-used)
value))
;;;###tramp-autoload
@@ -317,19 +336,22 @@ value is not set for the connection, returns DEFAULT."
"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."
+used to cache connection properties of the local machine. If KEY
+is `tramp-cache-undefined', nothing is set.
+PROPERTY is set persistent when KEY is a `tramp-file-name' structure.
+Return VALUE."
;; 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))
+ (when-let ((hash (tramp-get-hash-table key)))
+ (puthash property value hash))
+ (setq tramp-cache-data-changed
+ (or tramp-cache-data-changed (tramp-file-name-p key)))
+ (tramp-message key 7 "%s %s" property value)
+ value)
;;;###tramp-autoload
(defun tramp-connection-property-p (key property)
@@ -337,7 +359,8 @@ PROPERTY is set persistent when KEY is a `tramp-file-name'
structure."
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)))
+ (not (eq (tramp-get-connection-property key property tramp-cache-undefined)
+ tramp-cache-undefined)))
;;;###tramp-autoload
(defun tramp-flush-connection-property (key property)
@@ -352,8 +375,10 @@ PROPERTY is set persistent when KEY is a `tramp-file-name'
structure."
(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)
+ (when-let ((hash (tramp-get-hash-table key)))
+ (remhash property hash))
+ (setq tramp-cache-data-changed
+ (or tramp-cache-data-changed (tramp-file-name-p key)))
(tramp-message key 7 "%s" property))
;;;###tramp-autoload
@@ -370,12 +395,10 @@ used to cache connection properties of the local machine."
(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) (push x properties)) hash))
- properties))
- (setq tramp-cache-data-changed t)
+ (when-let ((hash (gethash key tramp-cache-data)))
+ (hash-table-keys hash)))
+ (setq tramp-cache-data-changed
+ (or tramp-cache-data-changed (tramp-file-name-p key)))
(remhash key tramp-cache-data))
;;;###tramp-autoload
@@ -386,20 +409,15 @@ used to cache connection properties of the local machine."
(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)
+ (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))))))
+ (when (stringp key)
(setq key (substring-no-properties key)))
(when (stringp value)
(setq value (substring-no-properties value)))
@@ -411,7 +429,9 @@ used to cache connection properties of the local machine."
(prin1-to-string key))
(if (hash-table-p value)
(tramp-cache-print value)
- (if (bufferp 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))))
@@ -421,18 +441,18 @@ used to cache connection properties of the local machine."
;;;###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"))
- (push key result)))
- tramp-cache-data)
- result))
+ (let ((tramp-verbose 0))
+ (delq nil (mapcar
+ (lambda (key)
+ (and (tramp-file-name-p key)
+ (null (tramp-file-name-localname key))
+ (tramp-connection-property-p key "process-buffer")
+ key))
+ (hash-table-keys tramp-cache-data)))))
(defun tramp-dump-connection-properties ()
- "Write persistent connection properties into file
`tramp-persistency-file-name'."
+ "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)
@@ -464,15 +484,10 @@ used to cache connection properties of the local machine."
;; 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"))
+ ;; Starting with Emacs 28, we could use `lisp-data'.
+ (format ";; -*- emacs-lisp -*- <%s %s>\n"
+ (time-stamp-string "%02y/%02m/%02d %02H:%02M:%02S")
+ tramp-persistency-file-name)
";; Tramp connection history. Don't change this file.\n"
";; Run `M-x tramp-cleanup-all-connections' instead.\n\n"
(with-output-to-string
@@ -490,17 +505,14 @@ used to cache connection properties of the local machine."
"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))
+ (mapcar
+ (lambda (key)
+ (and (tramp-file-name-p key)
+ (string-equal method (tramp-file-name-method key))
+ (not (tramp-file-name-localname key))
+ (list (tramp-file-name-user key)
+ (tramp-file-name-host key))))
+ (hash-table-keys tramp-cache-data)))
;; 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.
diff --git a/tramp-cmds.el b/tramp-cmds.el
index b4dca23..9b62504 100644
--- a/tramp-cmds.el
+++ b/tramp-cmds.el
@@ -74,11 +74,13 @@ SYNTAX can be one of the symbols `default' (default),
Each function is called with the current vector as argument.")
;;;###tramp-autoload
-(defun tramp-cleanup-connection (vec &optional keep-debug keep-password)
+(defun tramp-cleanup-connection
+ (vec &optional keep-debug keep-password keep-processes)
"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.
+buffers, processes. KEEP-DEBUG non-nil preserves the debug
+buffer. KEEP-PASSWORD non-nil preserves the password cache.
+KEEP-PROCESSES non-nil preserves the asynchronous processes.
When called interactively, a Tramp connection has to be selected."
(interactive
;; When interactive, select the Tramp remote identification.
@@ -107,21 +109,21 @@ When called interactively, a Tramp connection has to be
selected."
;; 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)
-
;; Cancel timer.
(dolist (timer timer-list)
(when (and (eq (timer--function timer) 'tramp-timeout-session)
(tramp-file-name-equal-p vec (car (timer--args timer))))
(cancel-timer timer)))
+ ;; Delete processes.
+ (dolist (key (hash-table-keys tramp-cache-data))
+ (when (and (processp key)
+ (tramp-file-name-equal-p (process-get key 'vector) vec)
+ (or (not keep-processes)
+ (eq key (tramp-get-process vec))))
+ (tramp-flush-connection-properties key)
+ (delete-process key)))
+
;; Remove buffers.
(dolist
(buf (list (get-buffer (tramp-buffer-name vec))
@@ -130,6 +132,12 @@ When called interactively, a Tramp connection has to be
selected."
(tramp-get-connection-property vec "process-buffer" nil)))
(when (bufferp buf) (kill-buffer buf)))
+ ;; Flush file cache.
+ (tramp-flush-directory-properties vec "")
+
+ ;; Flush connection cache.
+ (tramp-flush-connection-properties vec)
+
;; The end.
(run-hook-with-args 'tramp-cleanup-connection-hook vec)))
@@ -151,9 +159,6 @@ When called interactively, a Tramp connection has to be
selected."
This includes password cache, file cache, connection cache, buffers."
(interactive)
- ;; Unlock Tramp.
- (setq tramp-locked nil)
-
;; Flush password cache.
(password-reset)
@@ -176,8 +181,9 @@ This includes password cache, file cache, connection cache,
buffers."
;; Cancel timers.
(cancel-function-timers 'tramp-timeout-session)
- ;; Remove buffers.
+ ;; Remove processes and buffers.
(dolist (name (tramp-list-tramp-buffers))
+ (when (processp (get-buffer-process name)) (delete-process name))
(when (bufferp (get-buffer name)) (kill-buffer name)))
;; The end.
@@ -350,9 +356,8 @@ The remote connection identified by SOURCE is flushed by
(or (setq target (tramp-default-rename-file source))
(tramp-user-error
nil
- (eval-when-compile
- (concat "There is no target specified. "
- "Check `tramp-default-rename-alist' for a proper entry.")))))
+ (concat "There is no target specified. "
+ "Check `tramp-default-rename-alist' for a proper entry."))))
(when (tramp-equal-remote source target)
(tramp-user-error nil "Source and target must have different remote."))
@@ -379,8 +384,7 @@ ESC or `q' to quit without changing further buffers,
(switch-to-buffer buffer)
(let* ((bfn (buffer-file-name))
(new-bfn (and (stringp bfn)
- (replace-regexp-in-string
- (regexp-quote source) target bfn)))
+ (tramp-compat-string-replace source target bfn)))
(prompt (format-message
"Set visited file name to `%s' [Type yn!eq or %s] "
new-bfn (key-description (vector help-char)))))
@@ -474,9 +478,7 @@ For details, see `tramp-rename-files'."
(defun tramp-bug ()
"Submit a bug report to the Tramp developers."
(interactive)
- (let ((reporter-prompt-for-summary-p t)
- ;; In rare cases, it could contain the password. So we make it nil.
- tramp-password-save-function)
+ (let ((reporter-prompt-for-summary-p t))
(reporter-submit-bug-report
tramp-bug-report-address ; to-address
(format "tramp (%s %s/%s)" ; package name and version
@@ -484,10 +486,11 @@ For details, see `tramp-rename-files'."
(sort
(delq nil (mapcar
(lambda (x)
- (and x (boundp x) (cons x 'tramp-reporter-dump-variable)))
+ (and x (boundp x) (not (get x 'tramp-suppress-trace))
+ (cons x 'tramp-reporter-dump-variable)))
(append
(mapcar #'intern (all-completions "tramp-" obarray #'boundp))
- ;; Non-tramp variables of interest.
+ ;; Non-Tramp variables of interest.
'(shell-prompt-pattern
backup-by-copying
backup-by-copying-when-linked
@@ -544,11 +547,11 @@ buffer in your bug report.
(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)))))))
+ (set varsym
+ `(decode-coding-string
+ (base64-decode-string
+ ,(base64-encode-string (encode-coding-string val 'raw-text)))
+ 'raw-text)))))
;; Dump variable.
(reporter-dump-variable varsym mailbuf)
@@ -557,11 +560,10 @@ buffer in your bug report.
;; Remove string quotation.
(forward-line -1)
(when (looking-at
- (eval-when-compile
- (concat "\\(^.*\\)" "\"" ;; \1 "
- "\\((base64-decode-string \\)" "\\\\" ;; \2 \
- "\\(\".*\\)" "\\\\" ;; \3 \
- "\\(\")\\)" "\"$"))) ;; \4 "
+ (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"))
diff --git a/tramp-compat.el b/tramp-compat.el
index b7a7cc4..cae3273 100644
--- a/tramp-compat.el
+++ b/tramp-compat.el
@@ -23,15 +23,15 @@
;;; Commentary:
-;; Tramp's main Emacs version for development is Emacs 27. This
-;; package provides compatibility functions for Emacs 24, Emacs 25 and
-;; Emacs 26.
+;; Tramp's main Emacs version for development is Emacs 28. This
+;; package provides compatibility functions for Emacs 25, Emacs 26 and
+;; Emacs 27.
;;; 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.
+;; In Emacs 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)
@@ -43,6 +43,8 @@
;; `temporary-file-directory' as function is introduced with Emacs 26.1.
(declare-function tramp-handle-temporary-file-directory "tramp")
+(declare-function tramp-tramp-file-p "tramp")
+(defvar tramp-temp-name-prefix)
(defconst tramp-compat-emacs-compiled-version (eval-when-compile emacs-version)
"The Emacs version used for compilation.")
@@ -60,6 +62,8 @@
`(when (functionp ,function)
(with-no-warnings (funcall ,function ,@arguments))))
+(put #'tramp-compat-funcall 'tramp-suppress-trace t)
+
(defsubst tramp-compat-temporary-file-directory ()
"Return name of directory for temporary files.
It is the default value of `temporary-file-directory'."
@@ -67,15 +71,19 @@ It is the default value of `temporary-file-directory'."
;; into an infloop.
(eval (car (get 'temporary-file-directory 'standard-value))))
+(defsubst tramp-compat-make-temp-name ()
+ "Generate a local temporary file name (compat function)."
+ (make-temp-name
+ (expand-file-name
+ tramp-temp-name-prefix (tramp-compat-temporary-file-directory))))
+
(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)))
+ (make-temp-file
+ (expand-file-name
+ tramp-temp-name-prefix (tramp-compat-temporary-file-directory))
+ dir-flag (file-name-extension f t)))
;; `temporary-file-directory' as function is introduced with Emacs 26.1.
(defalias 'tramp-compat-temporary-file-directory-function
@@ -83,31 +91,7 @@ Add the extension of F, if existing."
#'temporary-file-directory
#'tramp-handle-temporary-file-directory))
-(defun tramp-compat-process-running-p (process-name)
- "Return 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)))))))))
-
-;; `file-attribute-*' are introduced in Emacs 25.1.
+;; `file-attribute-*' are introduced in Emacs 26.1.
(defalias 'tramp-compat-file-attribute-type
(if (fboundp 'file-attribute-type)
@@ -189,31 +173,13 @@ and later, and is a float in Emacs 26 and earlier."
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.
+;; `file-name-unquote' are introduced in Emacs 26.1.
(defalias 'tramp-compat-file-local-name
(if (fboundp 'file-local-name)
#'file-local-name
@@ -223,7 +189,8 @@ 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.
+;; `file-name-quoted-p', `file-name-quote' and `file-name-unquote' got
+;; a second argument in Emacs 27.1.
(defalias 'tramp-compat-file-name-quoted-p
(if (and
(fboundp 'file-name-quoted-p)
@@ -265,7 +232,7 @@ NAME is unquoted."
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
+;; `tramp-syntax' has changed its meaning in Emacs 26.1. We still
;; support old settings.
(defsubst tramp-compat-tramp-syntax ()
"Return proper value of `tramp-syntax'."
@@ -274,29 +241,46 @@ NAME is unquoted."
((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 ()
- "Return a list of slot names."
- (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)))))
+ (if-let ((handler (find-file-name-handler default-directory 'exec-path)))
+ (funcall handler 'exec-path)
+ exec-path))))
;; `time-equal-p' has appeared in Emacs 27.1.
(defalias 'tramp-compat-time-equal-p
@@ -331,16 +315,79 @@ A nil value for either argument stands for the current
time."
(lambda (reporter &optional value _suffix)
(progress-reporter-update reporter value))))
+;; `file-modes', `set-file-modes' and `set-file-times' got argument
+;; FLAG in Emacs 28.1.
+(defalias 'tramp-compat-file-modes
+ (if (equal (tramp-compat-funcall 'func-arity #'file-modes) '(1 . 2))
+ #'file-modes
+ (lambda (filename &optional _flag)
+ (file-modes filename))))
+
+(defalias 'tramp-compat-set-file-modes
+ (if (equal (tramp-compat-funcall 'func-arity #'set-file-modes) '(2 . 3))
+ #'set-file-modes
+ (lambda (filename mode &optional _flag)
+ (set-file-modes filename mode))))
+
+(defalias 'tramp-compat-set-file-times
+ (if (equal (tramp-compat-funcall 'func-arity #'set-file-times) '(1 . 3))
+ #'set-file-times
+ (lambda (filename &optional timestamp _flag)
+ (set-file-times filename timestamp))))
+
+;; `directory-files' and `directory-files-and-attributes' got argument
+;; COUNT in Emacs 28.1.
+(defalias 'tramp-compat-directory-files
+ (if (equal (tramp-compat-funcall 'func-arity #'directory-files) '(1 . 5))
+ #'directory-files
+ (lambda (directory &optional full match nosort _count)
+ (directory-files directory full match nosort))))
+
+(defalias 'tramp-compat-directory-files-and-attributes
+ (if (equal (tramp-compat-funcall 'func-arity
#'directory-files-and-attributes)
+ '(1 . 6))
+ #'directory-files-and-attributes
+ (lambda (directory &optional full match nosort id-format _count)
+ (directory-files-and-attributes directory full match nosort id-format))))
+
+;; `directory-empty-p' is new in Emacs 28.1.
+(defalias 'tramp-compat-directory-empty-p
+ (if (fboundp 'directory-empty-p)
+ #'directory-empty-p
+ (lambda (dir)
+ (and (file-directory-p dir)
+ (null (tramp-compat-directory-files
+ dir nil directory-files-no-dot-files-regexp t 1))))))
+
+;; Function `null-device' is new in Emacs 28.1.
+(defalias 'tramp-compat-null-device
+ (if (fboundp 'null-device)
+ #'null-device
+ (lambda ()
+ (if (tramp-tramp-file-p default-directory) "/dev/null" null-device))))
+
+;; Function `string-replace' is new in Emacs 28.1.
+(defalias 'tramp-compat-string-replace
+ (if (fboundp 'string-replace)
+ #'string-replace
+ (lambda (fromstring tostring instring)
+ (replace-regexp-in-string (regexp-quote fromstring) tostring instring))))
+
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-loaddefs 'force)
(unload-feature 'tramp-compat 'force)))
+(provide 'tramp-compat)
+
;;; TODO:
;;
-;; * Starting with Emacs 25.1, replace `tramp-message-show-message' by
-;; the reverse of `inhibit-message'.
-
-(provide 'tramp-compat)
+;; * `func-arity' exists since Emacs 26.1.
+;;
+;; * Starting with Emacs 27.1, there's no need to escape open
+;; parentheses with a backslash in docstrings anymore.
+;;
+;; * Starting with Emacs 27.1, there's `make-empty-file'. Could be
+;; used instead of `write-region'.
;;; tramp-compat.el ends here
diff --git a/tramp-crypt.el b/tramp-crypt.el
new file mode 100644
index 0000000..4d34bbb
--- /dev/null
+++ b/tramp-crypt.el
@@ -0,0 +1,844 @@
+;;; tramp-crypt.el --- Tramp crypt utilities -*- lexical-binding:t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Michael Albinus <michael.albinus@gmx.de>
+;; Keywords: comm, processes
+;; Package: tramp
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Access functions for crypted remote files. It uses encfs to
+;; encrypt / decrypt the files on a remote directory. A remote
+;; directory, which shall include crypted files, must be declared in
+;; `tramp-crypt-directories' via command `tramp-crypt-add-directory'.
+;; All files in that directory, including all subdirectories, are
+;; stored there encrypted. This includes file names and directory
+;; names.
+
+;; This package is just responsible for the encryption part. Copying
+;; of the crypted files is still the responsibility of the remote file
+;; name handlers.
+
+;; A password protected encfs configuration file is created the very
+;; first time you access a crypted remote directory. It is kept in
+;; your user directory "~/.emacs.d/" with the url-encoded directory
+;; name as part of the basename, and ".encfs6.xml" as suffix. Do not
+;; loose this file and the corresponding password; otherwise there is
+;; no way to decrypt your crypted files.
+
+;; If the user option `tramp-crypt-save-encfs-config-remote' is
+;; non-nil (the default), the encfs configuration file ".encfs6.xml"
+;; is also kept in the crypted remote directory. It depends on you,
+;; whether you regard the password protection of this file as
+;; sufficient.
+
+;; If you use a remote file name with a quoted localname part, this
+;; localname and the corresponding file will not be encrypted/
+;; decrypted. For example, if you have a crypted remote directory
+;; "/nextcloud:user@host:/crypted_dir", the command
+;;
+;; C-x d /nextcloud:user@host:/crypted_dir
+;;
+;; will show the directory listing with the plain file names, and the
+;; command
+;;
+;; C-x d /nextcloud:user@host:/:/crypted_dir
+;;
+;; will show the directory with the encrypted file names, and visiting
+;; a file will show its crypted contents. However, it is highly
+;; discouraged to mix crypted and not crypted files in the same
+;; directory.
+
+;; If a remote directory shall not include crypted files anymore, it
+;; must be indicated by the command `tramp-crypt-remove-directory'.
+
+;;; Code:
+
+(eval-when-compile (require 'cl-lib))
+(require 'tramp)
+
+(autoload 'prop-match-beginning "text-property-search")
+(autoload 'prop-match-end "text-property-search")
+(autoload 'text-property-search-forward "text-property-search")
+
+(defconst tramp-crypt-method "crypt"
+ "Method name for crypted remote directories.")
+
+(defcustom tramp-crypt-encfs-program "encfs"
+ "Name of the encfs program."
+ :group 'tramp
+ :version "28.1"
+ :type 'string)
+
+(defcustom tramp-crypt-encfsctl-program "encfsctl"
+ "Name of the encfsctl program."
+ :group 'tramp
+ :version "28.1"
+ :type 'string)
+
+(defcustom tramp-crypt-encfs-option "--standard"
+ "Configuration option for encfs.
+This could be either \"--standard\" or \"--paranoia\". The file
+name IV chaining mode mode will always be disabled when
+initializing a new crypted remote directory."
+ :group 'tramp
+ :version "28.1"
+ :type '(choice (const "--standard")
+ (const "--paranoia")))
+
+;; We check only for encfs, assuming that encfsctl will be available
+;; as well. The autoloaded value is nil, the check will run when
+;; tramp-crypt.el is loaded by `tramp-crypt-add-directory'. It is a
+;; common technique to let-bind this variable to nil in order to
+;; suppress the file name operation of this package.
+;;;###tramp-autoload
+(defvar tramp-crypt-enabled nil
+ "Non-nil when encryption support is available.")
+(setq tramp-crypt-enabled (executable-find tramp-crypt-encfs-program))
+
+;;;###tramp-autoload
+(defconst tramp-crypt-encfs-config ".encfs6.xml"
+ "Encfs configuration file name.")
+
+(defcustom tramp-crypt-save-encfs-config-remote t
+ "Whether to keep the encfs configuration file in the crypted remote
directory."
+ :group 'tramp
+ :version "28.1"
+ :type 'boolean)
+
+;;;###tramp-autoload
+(defvar tramp-crypt-directories nil
+ "List of crypted remote directories.")
+
+;; 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-crypt-file-name-p (name)
+ "Return the crypted remote directory NAME belongs to.
+If NAME doesn't belong to a crypted remote directory, retun nil."
+ (catch 'crypt-file-name-p
+ (and tramp-crypt-enabled (stringp name)
+ (not (tramp-compat-file-name-quoted-p name))
+ (not (string-suffix-p tramp-crypt-encfs-config name))
+ (dolist (dir tramp-crypt-directories)
+ (and (string-prefix-p
+ dir (file-name-as-directory (expand-file-name name)))
+ (throw 'crypt-file-name-p dir))))))
+
+
+;; New handlers should be added here.
+;;;###tramp-autoload
+(defconst tramp-crypt-file-name-handler-alist
+ '((access-file . tramp-crypt-handle-access-file)
+ (add-name-to-file . tramp-handle-add-name-to-file)
+ ;; `byte-compiler-base-file-name' performed by default handler.
+ (copy-directory . tramp-handle-copy-directory)
+ (copy-file . tramp-crypt-handle-copy-file)
+ (delete-directory . tramp-crypt-handle-delete-directory)
+ (delete-file . tramp-crypt-handle-delete-file)
+ ;; `diff-latest-backup-file' performed by default handler.
+ ;; `directory-file-name' performed by default handler.
+ (directory-files . tramp-crypt-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' performed by default handler.
+ (file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
+ (file-acl . ignore)
+ (file-attributes . tramp-crypt-handle-file-attributes)
+ (file-directory-p . tramp-handle-file-directory-p)
+ (file-equal-p . tramp-handle-file-equal-p)
+ (file-executable-p . tramp-crypt-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-crypt-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 .
tramp-crypt-handle-file-ownership-preserved-p)
+ (file-readable-p . tramp-crypt-handle-file-readable-p)
+ (file-regular-p . tramp-handle-file-regular-p)
+ ;; `file-remote-p' performed by default handler.
+ (file-selinux-context . ignore)
+ (file-symlink-p . tramp-handle-file-symlink-p)
+ (file-system-info . tramp-crypt-handle-file-system-info)
+ ;; `file-truename' performed by default handler.
+ (file-writable-p . tramp-crypt-handle-file-writable-p)
+ (find-backup-file-name . tramp-handle-find-backup-file-name)
+ ;; `get-file-buffer' performed by default handler.
+ (insert-directory . tramp-crypt-handle-insert-directory)
+ ;; `insert-file-contents' performed by default handler.
+ (load . tramp-handle-load)
+ (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
+ (make-directory . tramp-crypt-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-crypt-handle-rename-file)
+ (set-file-acl . ignore)
+ (set-file-modes . tramp-crypt-handle-set-file-modes)
+ (set-file-selinux-context . ignore)
+ (set-file-times . tramp-crypt-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' performed by default handler.
+ (temporary-file-directory . tramp-handle-temporary-file-directory)
+ ;; `tramp-get-remote-gid' performed by default handler.
+ ;; `tramp-get-remote-uid' performed by default handler.
+ (tramp-set-file-uid-gid . tramp-crypt-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-handle-write-region))
+ "Alist of handler functions for crypt method.
+Operations not mentioned here will be handled by the default Emacs
primitives.")
+
+(defsubst tramp-crypt-file-name-for-operation (operation &rest args)
+ "Like `tramp-file-name-for-operation', but for crypted remote files."
+ (let ((tfnfo (apply #'tramp-file-name-for-operation operation args)))
+ ;; `tramp-file-name-for-operation' returns already the first argument
+ ;; if it is remote. So we check a possible second argument.
+ (unless (tramp-crypt-file-name-p tfnfo)
+ (setq tfnfo (apply
+ #'tramp-file-name-for-operation operation
+ (cons (tramp-compat-temporary-file-directory) (cdr args)))))
+ tfnfo))
+
+(defun tramp-crypt-run-real-handler (operation args)
+ "Invoke normal file name handler for OPERATION.
+First arg specifies the OPERATION, second arg ARGS is a list of
+arguments to pass to the OPERATION."
+ (let* ((inhibit-file-name-handlers
+ `(tramp-crypt-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-crypt-file-name-handler (operation &rest args)
+ "Invoke the crypted remote file related OPERATION.
+First arg specifies the OPERATION, second arg ARGS is a list of
+arguments to pass to the OPERATION."
+ (if-let ((filename
+ (apply #'tramp-crypt-file-name-for-operation operation args))
+ (fn (and (tramp-crypt-file-name-p filename)
+ (assoc operation tramp-crypt-file-name-handler-alist))))
+ (save-match-data (apply (cdr fn) args))
+ (tramp-crypt-run-real-handler operation args)))
+
+;;;###tramp-autoload
+(progn (defun tramp-register-crypt-file-name-handler ()
+ "Add crypt file name handler to `file-name-handler-alist'."
+ (when (and tramp-crypt-enabled tramp-crypt-directories)
+ (add-to-list 'file-name-handler-alist
+ (cons tramp-file-name-regexp #'tramp-crypt-file-name-handler))
+ (put #'tramp-crypt-file-name-handler 'safe-magic t))))
+
+(tramp-register-file-name-handlers)
+
+;; Mark `operations' the handler is responsible for.
+(put #'tramp-crypt-file-name-handler 'operations
+ (mapcar #'car tramp-crypt-file-name-handler-alist))
+
+
+;; File name conversions.
+
+(defun tramp-crypt-config-file-name (vec)
+ "Return the encfs config file name for VEC."
+ (expand-file-name
+ (concat "tramp-" (tramp-file-name-host vec) tramp-crypt-encfs-config)
+ user-emacs-directory))
+
+(defun tramp-crypt-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."
+ ;; 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-get-connection-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)))
+
+ ;; The following operations must be performed w/o
+ ;; `tramp-crypt-file-name-handler'.
+ (let* (tramp-crypt-enabled
+ ;; Don't check for a proper method.
+ (non-essential t)
+ (remote-config
+ (expand-file-name
+ tramp-crypt-encfs-config (tramp-crypt-get-remote-dir vec)))
+ (local-config (tramp-crypt-config-file-name vec)))
+ ;; There is no local encfs6 config file.
+ (when (not (file-exists-p local-config))
+ (if (and tramp-crypt-save-encfs-config-remote
+ (file-exists-p remote-config))
+ ;; Copy remote encfs6 config file if possible.
+ (copy-file remote-config local-config 'ok 'keep)
+
+ ;; Create local encfs6 config file otherwise.
+ (let* ((default-directory (tramp-compat-temporary-file-directory))
+ (tmpdir1 (file-name-as-directory
+ (tramp-compat-make-temp-file " .crypt" 'dir-flag)))
+ (tmpdir2 (file-name-as-directory
+ (tramp-compat-make-temp-file " .nocrypt" 'dir-flag))))
+ ;; Enable `auth-source', unless "emacs -Q" has been called.
+ (tramp-set-connection-property
+ vec "first-password-request" tramp-cache-read-persistent-data)
+ (with-temp-buffer
+ (insert
+ (tramp-read-passwd
+ (tramp-get-connection-process vec)
+ (format
+ "New EncFS Password for %s " (tramp-crypt-get-remote-dir vec))))
+ (when
+ (zerop
+ (tramp-call-process-region
+ vec (point-min) (point-max)
+ tramp-crypt-encfs-program nil (tramp-get-connection-buffer
vec)
+ nil tramp-crypt-encfs-option "--extpass=cat" tmpdir1 tmpdir2))
+ ;; Save the password.
+ (ignore-errors
+ (and (functionp tramp-password-save-function)
+ (funcall tramp-password-save-function)))))
+
+ ;; Write local config file. Suppress file name IV chaining mode.
+ (with-temp-file local-config
+ (insert-file-contents
+ (expand-file-name tramp-crypt-encfs-config tmpdir1))
+ (when (search-forward
+ "<chainedNameIV>1</chainedNameIV>" nil 'noerror)
+ (replace-match "<chainedNameIV>0</chainedNameIV>")))
+
+ ;; Unmount encfs. Delete temporary directories.
+ (tramp-call-process
+ vec tramp-crypt-encfs-program nil nil nil
+ "--unmount" tmpdir1 tmpdir2)
+ (delete-directory tmpdir1 'recursive)
+ (delete-directory tmpdir2)
+
+ ;; Copy local encfs6 config file to remote.
+ (when tramp-crypt-save-encfs-config-remote
+ (copy-file local-config remote-config 'ok 'keep)))))))
+
+(defun tramp-crypt-send-command (vec &rest args)
+ "Send encfsctl command to connection VEC.
+ARGS are the arguments. It returns t if ran successful, and nil otherwise."
+ (tramp-crypt-maybe-open-connection vec)
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (erase-buffer)
+ (set-buffer-multibyte nil))
+ (with-temp-buffer
+ (let* (;; Don't check for a proper method.
+ (non-essential t)
+ (default-directory (tramp-compat-temporary-file-directory))
+ ;; We cannot add it to `process-environment', because
+ ;; `tramp-call-process-region' doesn't use it.
+ (encfs-config
+ (format "ENCFS6_CONFIG=%s" (tramp-crypt-config-file-name vec)))
+ (args (delq nil args)))
+ ;; Enable `auth-source', unless "emacs -Q" has been called.
+ (tramp-set-connection-property
+ vec "first-password-request" tramp-cache-read-persistent-data)
+ (insert
+ (tramp-read-passwd
+ (tramp-get-connection-process vec)
+ (format "EncFS Password for %s " (tramp-crypt-get-remote-dir vec))))
+ (when (zerop
+ (apply
+ #'tramp-call-process-region vec (point-min) (point-max)
+ "env" nil (tramp-get-connection-buffer vec)
+ nil encfs-config tramp-crypt-encfsctl-program
+ (car args) "--extpass=cat" (cdr args)))
+ ;; Save the password.
+ (ignore-errors
+ (and (functionp tramp-password-save-function)
+ (funcall tramp-password-save-function)))
+ t))))
+
+(defun tramp-crypt-do-encrypt-or-decrypt-file-name (op name)
+ "Return encrypted / decrypted NAME if NAME belongs to a crypted directory.
+OP must be `encrypt' or `decrypt'. Raise an error if this fails.
+Otherwise, return NAME."
+ (if-let ((tramp-crypt-enabled t)
+ (dir (tramp-crypt-file-name-p name))
+ ;; It must be absolute for the cache.
+ (localname (substring name (1- (length dir))))
+ (crypt-vec (tramp-crypt-dissect-file-name dir)))
+ ;; Preserve trailing "/".
+ (funcall
+ (if (directory-name-p name) #'file-name-as-directory #'identity)
+ (concat
+ dir
+ (unless (string-equal localname "/")
+ (with-tramp-file-property
+ crypt-vec localname (concat (symbol-name op) "-file-name")
+ (unless (tramp-crypt-send-command
+ crypt-vec (if (eq op 'encrypt) "encode" "decode")
+ (tramp-compat-temporary-file-directory) localname)
+ (tramp-error
+ crypt-vec 'file-error "%s of file name %s failed."
+ (if (eq op 'encrypt) "Encoding" "Decoding") name))
+ (with-current-buffer (tramp-get-connection-buffer crypt-vec)
+ (goto-char (point-min))
+ (buffer-substring (point-min) (point-at-eol)))))))
+ ;; Nothing to do.
+ name))
+
+(defsubst tramp-crypt-encrypt-file-name (name)
+ "Return encrypted NAME if NAME belongs to a crypted directory.
+Otherwise, return NAME."
+ (tramp-crypt-do-encrypt-or-decrypt-file-name 'encrypt name))
+
+(defsubst tramp-crypt-decrypt-file-name (name)
+ "Return decrypted NAME if NAME belongs to a crypted directory.
+Otherwise, return NAME."
+ (tramp-crypt-do-encrypt-or-decrypt-file-name 'decrypt name))
+
+(defun tramp-crypt-do-encrypt-or-decrypt-file (op root infile outfile)
+ "Encrypt / decrypt file INFILE to OUTFILE according to crypted directory
ROOT.
+Both files must be local files. OP must be `encrypt' or `decrypt'.
+If OP ist `decrypt', the basename of INFILE must be an encrypted file name.
+Raise an error if this fails."
+ (when-let ((tramp-crypt-enabled t)
+ (dir (tramp-crypt-file-name-p root))
+ (crypt-vec (tramp-crypt-dissect-file-name dir)))
+ (let ((coding-system-for-read
+ (if (eq op 'decrypt) 'binary coding-system-for-read))
+ (coding-system-for-write
+ (if (eq op 'encrypt) 'binary coding-system-for-write)))
+ (unless (tramp-crypt-send-command
+ crypt-vec "cat" (and (eq op 'encrypt) "--reverse")
+ (file-name-directory infile)
+ (concat "/" (file-name-nondirectory infile)))
+ (tramp-error
+ crypt-vec 'file-error "%s of file %s failed."
+ (if (eq op 'encrypt) "Encrypting" "Decrypting") infile))
+ (with-current-buffer (tramp-get-connection-buffer crypt-vec)
+ (write-region nil nil outfile)))))
+
+(defsubst tramp-crypt-encrypt-file (root infile outfile)
+ "Encrypt file INFILE to OUTFILE according to crypted directory ROOT.
+See `tramp-crypt-do-encrypt-or-decrypt-file'."
+ (tramp-crypt-do-encrypt-or-decrypt-file 'encrypt root infile outfile))
+
+(defsubst tramp-crypt-decrypt-file (root infile outfile)
+ "Decrypt file INFILE to OUTFILE according to crypted directory ROOT.
+See `tramp-crypt-do-encrypt-or-decrypt-file'."
+ (tramp-crypt-do-encrypt-or-decrypt-file 'decrypt root infile outfile))
+
+;;;###tramp-autoload
+(defun tramp-crypt-add-directory (name)
+ "Mark remote directory NAME for encryption.
+Files in that directory and all subdirectories will be encrypted
+before copying to, and decrypted after copying from that
+directory. File names will be also encrypted."
+ (interactive "DRemote directory name: ")
+ (unless tramp-crypt-enabled
+ (tramp-user-error nil "Feature is not enabled."))
+ (unless (and (tramp-tramp-file-p name) (file-directory-p name))
+ (tramp-user-error nil "%s must be an existing remote directory." name))
+ (when (tramp-compat-file-name-quoted-p name)
+ (tramp-user-error nil "%s must not be quoted." name))
+ (setq name (file-name-as-directory (expand-file-name name)))
+ (unless (member name tramp-crypt-directories)
+ (setq tramp-crypt-directories (cons name tramp-crypt-directories)))
+ (tramp-register-file-name-handlers))
+
+(defun tramp-crypt-remove-directory (name)
+ "Unmark remote directory NAME for encryption.
+Existing files in that directory and its subdirectories will be
+kept in their encrypted form."
+ (interactive "DRemote directory name: ")
+ (unless tramp-crypt-enabled
+ (tramp-user-error nil "Feature is not enabled."))
+ (setq name (file-name-as-directory (expand-file-name name)))
+ (when (and (member name tramp-crypt-directories)
+ (delete
+ tramp-crypt-encfs-config
+ (directory-files name nil directory-files-no-dot-files-regexp))
+ (yes-or-no-p
+ "There exist encrypted files, do you want to continue? "))
+ (setq tramp-crypt-directories (delete name tramp-crypt-directories))
+ (tramp-register-file-name-handlers)))
+
+;; `auth-source' requires a user.
+(defun tramp-crypt-dissect-file-name (name)
+ "Return a `tramp-file-name' structure for NAME.
+The structure consists of the `tramp-crypt-method' method, the
+local user name, the hexlified directory NAME as host, and the
+localname."
+ (save-match-data
+ (if-let ((dir (tramp-crypt-file-name-p name)))
+ (make-tramp-file-name
+ :method tramp-crypt-method :user (user-login-name)
+ :host (url-hexify-string dir))
+ (tramp-user-error nil "Not a crypted remote directory: \"%s\"" name))))
+
+(defun tramp-crypt-get-remote-dir (vec)
+ "Return the name of the crypted remote directory to be used for encfs."
+ (url-unhex-string (tramp-file-name-host vec)))
+
+
+;; File name primitives.
+
+(defun tramp-crypt-handle-access-file (filename string)
+ "Like `access-file' for Tramp files."
+ (let* ((encrypt-filename (tramp-crypt-encrypt-file-name filename))
+ (encrypt-regexp (concat (regexp-quote encrypt-filename) "\\'"))
+ tramp-crypt-enabled)
+ (condition-case err
+ (access-file encrypt-filename string)
+ (error
+ (when (and (eq (car err) 'file-missing) (stringp (cadr err))
+ (string-match-p encrypt-regexp (cadr err)))
+ (setcar
+ (cdr err)
+ (replace-regexp-in-string encrypt-regexp filename (cadr err))))
+ (signal (car err) (cdr err))))))
+
+(defun tramp-crypt-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-crypt-handle-copy-file' and
+`tramp-crypt-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))
+ (let ((t1 (tramp-crypt-file-name-p filename))
+ (t2 (tramp-crypt-file-name-p newname))
+ (encrypt-filename (tramp-crypt-encrypt-file-name filename))
+ (encrypt-newname (tramp-crypt-encrypt-file-name newname))
+ (msg-operation (if (eq op 'copy) "Copying" "Renaming")))
+
+ (if (file-directory-p filename)
+ (progn
+ (copy-directory filename newname keep-date t)
+ (when (eq op 'rename)
+ (delete-directory filename 'recursive)))
+
+ (with-parsed-tramp-file-name (if t1 filename newname) nil
+ (unless (file-exists-p filename)
+ (tramp-error
+ v tramp-file-missing
+ "%s file" msg-operation "No such file or directory" filename))
+ (when (and (not ok-if-already-exists) (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+ (when (and (file-directory-p newname)
+ (not (directory-name-p newname)))
+ (tramp-error v 'file-error "File is a directory %s" newname))
+
+ (with-tramp-progress-reporter
+ v 0 (format "%s %s to %s" msg-operation filename newname)
+ (if (and t1 t2 (string-equal t1 t2))
+ ;; Both files are on the same crypted remote directory.
+ (let (tramp-crypt-enabled)
+ (if (eq op 'copy)
+ (copy-file
+ encrypt-filename encrypt-newname ok-if-already-exists
+ keep-date preserve-uid-gid preserve-extended-attributes)
+ (rename-file
+ encrypt-filename encrypt-newname ok-if-already-exists)))
+
+ (let* ((tmpdir (tramp-compat-make-temp-file filename 'dir))
+ (tmpfile1
+ (expand-file-name
+ (file-name-nondirectory encrypt-filename) tmpdir))
+ (tmpfile2
+ (expand-file-name
+ (file-name-nondirectory encrypt-newname) tmpdir))
+ tramp-crypt-enabled)
+ (cond
+ ;; Source and target file are on a crypted remote directory.
+ ((and t1 t2)
+ (if (eq op 'copy)
+ (copy-file
+ encrypt-filename encrypt-newname ok-if-already-exists
+ keep-date preserve-uid-gid preserve-extended-attributes)
+ (rename-file
+ encrypt-filename encrypt-newname ok-if-already-exists)))
+ ;; Source file is on a crypted remote directory.
+ (t1
+ (if (eq op 'copy)
+ (copy-file
+ encrypt-filename tmpfile1 t keep-date preserve-uid-gid
+ preserve-extended-attributes)
+ (rename-file encrypt-filename tmpfile1 t))
+ (tramp-crypt-decrypt-file t1 tmpfile1 tmpfile2)
+ (rename-file tmpfile2 newname ok-if-already-exists))
+ ;; Target file is on a crypted remote directory.
+ (t2
+ (if (eq op 'copy)
+ (copy-file
+ filename tmpfile1 t keep-date preserve-uid-gid
+ preserve-extended-attributes)
+ (rename-file filename tmpfile1 t))
+ (tramp-crypt-encrypt-file t2 tmpfile1 tmpfile2)
+ (rename-file tmpfile2 encrypt-newname ok-if-already-exists)))
+ (delete-directory tmpdir 'recursive))))))
+
+ (when (and t1 (eq op 'rename))
+ (with-parsed-tramp-file-name filename v1
+ (tramp-flush-file-properties v1 v1-localname)))
+
+ (when t2
+ (with-parsed-tramp-file-name newname v2
+ (tramp-flush-file-properties v2 v2-localname)))))
+
+(defun tramp-crypt-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))
+ ;; At least one file a Tramp file?
+ (if (or (tramp-tramp-file-p filename)
+ (tramp-tramp-file-p newname))
+ (tramp-crypt-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))))
+
+;; Crypted files won't be trashed.
+(defun tramp-crypt-handle-delete-directory
+ (directory &optional recursive _trash)
+ "Like `delete-directory' for Tramp files."
+ (with-parsed-tramp-file-name (expand-file-name directory) nil
+ (tramp-flush-directory-properties v localname)
+ (let (tramp-crypt-enabled)
+ (delete-directory (tramp-crypt-encrypt-file-name directory) recursive))))
+
+;; Crypted files won't be trashed.
+(defun tramp-crypt-handle-delete-file (filename &optional _trash)
+ "Like `delete-file' for Tramp files."
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (tramp-flush-file-properties v localname)
+ (let (tramp-crypt-enabled)
+ (delete-file (tramp-crypt-encrypt-file-name filename)))))
+
+(defun tramp-crypt-handle-directory-files
+ (directory &optional full match nosort count)
+ "Like `directory-files' for Tramp files."
+ (unless (file-exists-p directory)
+ (tramp-error
+ (tramp-dissect-file-name directory) tramp-file-missing
+ "No such file or directory" directory))
+ (when (file-directory-p directory)
+ (setq directory (file-name-as-directory (expand-file-name directory)))
+ (let* (tramp-crypt-enabled
+ (result
+ (directory-files (tramp-crypt-encrypt-file-name directory) 'full)))
+ (setq result
+ (mapcar (lambda (x) (tramp-crypt-decrypt-file-name x)) result))
+ (when match
+ (setq result
+ (delq
+ nil
+ (mapcar
+ (lambda (x)
+ (when (string-match-p match (substring x (length directory)))
+ x))
+ result))))
+ (unless full
+ (setq result
+ (mapcar
+ (lambda (x)
+ (replace-regexp-in-string
+ (concat "^" (regexp-quote directory)) "" x))
+ result)))
+ (unless nosort
+ (setq result (sort result #'string<)))
+ (when (and (natnump count) (> count 0))
+ (setq result (nbutlast result (- (length result) count))))
+ result)))
+
+(defun tramp-crypt-handle-file-attributes (filename &optional id-format)
+ "Like `file-attributes' for Tramp files."
+ (let (tramp-crypt-enabled)
+ (file-attributes (tramp-crypt-encrypt-file-name filename) id-format)))
+
+(defun tramp-crypt-handle-file-executable-p (filename)
+ "Like `file-executable-p' for Tramp files."
+ (let (tramp-crypt-enabled)
+ (file-executable-p (tramp-crypt-encrypt-file-name filename))))
+
+(defun tramp-crypt-handle-file-name-all-completions (filename directory)
+ "Like `file-name-all-completions' for Tramp files."
+ (all-completions
+ filename
+ (let* (completion-regexp-list
+ tramp-crypt-enabled
+ (directory (file-name-as-directory directory))
+ (enc-dir (tramp-crypt-encrypt-file-name directory)))
+ (mapcar
+ (lambda (x)
+ (substring
+ (tramp-crypt-decrypt-file-name (concat enc-dir x))
+ (length directory)))
+ (file-name-all-completions "" enc-dir)))))
+
+(defun tramp-crypt-handle-file-readable-p (filename)
+ "Like `file-readable-p' for Tramp files."
+ (let (tramp-crypt-enabled)
+ (file-readable-p (tramp-crypt-encrypt-file-name filename))))
+
+(defun tramp-crypt-handle-file-ownership-preserved-p (filename &optional group)
+ "Like `file-ownership-preserved-p' for Tramp files."
+ (let (tramp-crypt-enabled)
+ (file-ownership-preserved-p (tramp-crypt-encrypt-file-name filename)
group)))
+
+(defun tramp-crypt-handle-file-system-info (filename)
+ "Like `file-system-info' for Tramp files."
+ (let (tramp-crypt-enabled)
+ ;; `file-system-info' exists since Emacs 27.1.
+ (tramp-compat-funcall
+ 'file-system-info (tramp-crypt-encrypt-file-name filename))))
+
+(defun tramp-crypt-handle-file-writable-p (filename)
+ "Like `file-writable-p' for Tramp files."
+ (let (tramp-crypt-enabled)
+ (file-writable-p (tramp-crypt-encrypt-file-name filename))))
+
+(defun tramp-crypt-handle-insert-directory
+ (filename switches &optional wildcard full-directory-p)
+ "Like `insert-directory' for Tramp files.
+WILDCARD is not supported."
+ ;; This package has been added to Emacs 27.1.
+ (when (load "text-property-search" 'noerror 'nomessage)
+ (let (tramp-crypt-enabled)
+ (tramp-handle-insert-directory
+ (tramp-crypt-encrypt-file-name filename)
+ switches wildcard full-directory-p)
+ (let* ((filename (file-name-as-directory filename))
+ (enc (tramp-crypt-encrypt-file-name filename))
+ match string)
+ (goto-char (point-min))
+ (while (setq match (text-property-search-forward 'dired-filename t t))
+ (setq string
+ (buffer-substring
+ (prop-match-beginning match) (prop-match-end match))
+ string (if (file-name-absolute-p string)
+ (tramp-crypt-decrypt-file-name string)
+ (substring
+ (tramp-crypt-decrypt-file-name (concat enc string))
+ (length filename))))
+ (delete-region (prop-match-beginning match) (prop-match-end match))
+ (insert (propertize string 'dired-filename t)))))))
+
+(defun tramp-crypt-handle-make-directory (dir &optional parents)
+ "Like `make-directory' for Tramp files."
+ (with-parsed-tramp-file-name (expand-file-name dir) nil
+ (when (and (null parents) (file-exists-p dir))
+ (tramp-error v 'file-already-exists "Directory already exists %s" dir))
+ (let (tramp-crypt-enabled)
+ (make-directory (tramp-crypt-encrypt-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 cache.
+ (tramp-flush-directory-properties
+ v (if parents "/" (file-name-directory localname)))))
+
+(defun tramp-crypt-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))
+ ;; At least one file a Tramp file?
+ (if (or (tramp-tramp-file-p filename)
+ (tramp-tramp-file-p newname))
+ (tramp-crypt-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-crypt-handle-set-file-modes (filename mode &optional flag)
+ "Like `set-file-modes' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (tramp-flush-file-properties v localname)
+ (let (tramp-crypt-enabled)
+ (tramp-compat-set-file-modes
+ (tramp-crypt-encrypt-file-name filename) mode flag))))
+
+(defun tramp-crypt-handle-set-file-times (filename &optional time flag)
+ "Like `set-file-times' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (tramp-flush-file-properties v localname)
+ (let (tramp-crypt-enabled)
+ (tramp-compat-set-file-times
+ (tramp-crypt-encrypt-file-name filename) time flag))))
+
+(defun tramp-crypt-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-flush-file-properties v localname)
+ (let (tramp-crypt-enabled)
+ (tramp-set-file-uid-gid
+ (tramp-crypt-encrypt-file-name filename) uid gid))))
+
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (unload-feature 'tramp-crypt 'force)))
+
+(provide 'tramp-crypt)
+
+;;; TODO:
+
+;; * I suggest having a feature where the user can specify to always
+;; use encryption for certain host names. So if you specify a host
+;; name which is on that list (of names, or perhaps regexps?), tramp
+;; would modify the request so as to do the encryption. (Richard Stallman)
+
+;;; tramp-crypt.el ends here
diff --git a/tramp-ftp.el b/tramp-ftp.el
index 95ae156..46835c5 100644
--- a/tramp-ftp.el
+++ b/tramp-ftp.el
@@ -31,8 +31,7 @@
(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)
@@ -79,9 +78,9 @@ present for backward compatibility."
;;; 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)
+ (or (assoc "^[[:alpha:]]:/[^/:]*\\'" file-name-handler-alist)
(setq file-name-handler-alist
- (cons '("^[a-zA-Z]:/[^/:]*\\'" .
+ (cons '("^[:alpha:]]:/[^/:]*\\'" .
ange-ftp-completion-hook-function)
file-name-handler-alist)))))
@@ -127,7 +126,16 @@ pass to the OPERATION."
;; "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))
+ (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
@@ -139,9 +147,7 @@ pass to the OPERATION."
;; "~/.netrc".
((memq operation '(file-directory-p file-exists-p))
(if (apply #'ange-ftp-hook-function operation args)
- (let ((v (tramp-dissect-file-name (car args) t)))
- (setf (tramp-file-name-method v) tramp-ftp-method)
- (tramp-set-connection-property v "started" t))
+ (tramp-set-connection-property v "started" t)
nil))
;; If the second argument of `copy-file' or `rename-file' is a
diff --git a/tramp-gvfs.el b/tramp-gvfs.el
index b457f54..1722c53 100644
--- a/tramp-gvfs.el
+++ b/tramp-gvfs.el
@@ -49,11 +49,15 @@
;; 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", "media", "nextcloud" and "sftp".
;; "gdrive" and "nextcloud" connection methods require a respective
;; account in GNOME Online Accounts, with enabled "Files" service.
+;; The "media" connection method is responsible for media devices,
+;; like cell phones, tablets, cameras etc. The device must already be
+;; connected via USB, before accessing it.
+
;; 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
@@ -104,9 +108,6 @@
(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")
@@ -124,16 +125,16 @@
(or ;; Until Emacs 25, `process-attributes' could crash Emacs
;; for some processes. Better we don't check.
(<= emacs-major-version 25)
- (tramp-compat-process-running-p "gvfs-fuse-daemon")
- (tramp-compat-process-running-p "gvfsd-fuse"))))
+ (tramp-process-running-p "gvfs-fuse-daemon")
+ (tramp-process-running-p "gvfsd-fuse"))))
"Non-nil when GVFS is available.")
;;;###tramp-autoload
(defcustom tramp-gvfs-methods
- '("afp" "dav" "davs" "gdrive" "nextcloud" "sftp")
+ '("afp" "dav" "davs" "gdrive" "media" "nextcloud" "sftp")
"List of methods for remote files, accessed with GVFS."
:group 'tramp
- :version "27.1"
+ :version "28.1"
:type '(repeat (choice (const "afp")
(const "dav")
(const "davs")
@@ -141,10 +142,12 @@
(const "gdrive")
(const "http")
(const "https")
+ (const "media")
(const "nextcloud")
(const "sftp")
(const "smb"))))
+;;;###tramp-autoload
(defconst tramp-goa-methods '("gdrive" "nextcloud")
"List of methods which require registration at GNOME Online Accounts.")
@@ -154,15 +157,23 @@
(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)))))
+(defvar tramp-media-methods '("afc" "gphoto2" "mtp")
+ "List of GVFS methods which are covered by the \"media\" method.
+They are checked during start up via
+`tramp-gvfs-interface-remotevolumemonitor'.")
+
+(defsubst tramp-gvfs-service-volumemonitor (method)
+ "Return the well known name of the volume monitor responsible for METHOD."
+ (symbol-value
+ (intern-soft (format "tramp-gvfs-service-%s-volumemonitor" method))))
+
+;; Remove media methods if not supported.
+(when tramp-gvfs-enabled
+ (dolist (method tramp-media-methods)
+ (unless (member (tramp-gvfs-service-volumemonitor method)
+ (dbus-list-known-names :session))
+ (setq tramp-media-methods (delete method tramp-media-methods)))))
;;;###tramp-autoload
(defcustom tramp-gvfs-zeroconf-domain "local"
@@ -172,13 +183,15 @@
:type 'string)
;; Add the methods to `tramp-methods', in order to allow minibuffer
-;; completion.
+;; completion. Add defaults for `tramp-default-host-alist'.
;;;###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))))))
+ (dolist (method tramp-gvfs-methods)
+ (unless (assoc method tramp-methods)
+ (add-to-list 'tramp-methods `(,method)))
+ (when (member method tramp-goa-methods)
+ (add-to-list 'tramp-default-host-alist `(,method nil ""))))))
(defconst tramp-gvfs-path-tramp (concat dbus-path-emacs "/Tramp")
"The preceding object path for own objects.")
@@ -460,8 +473,209 @@ It has been changed in GVFS 1.14.")
;; </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)
+;; in order to be compatible with Emacs 25.
+(cl-defstruct (tramp-goa-account (:type list) :named) method user host port)
+
+;;;###tramp-autoload
+(defconst tramp-gvfs-service-afc-volumemonitor "org.gtk.vfs.AfcVolumeMonitor"
+ "The well known name of the AFC volume monitor.")
+
+;; This one is not needed yet.
+(defconst tramp-gvfs-service-goa-volumemonitor "org.gtk.vfs.GoaVolumeMonitor"
+ "The well known name of the GOA volume monitor.")
+
+;;;###tramp-autoload
+(defconst tramp-gvfs-service-gphoto2-volumemonitor
+ "org.gtk.vfs.GPhoto2VolumeMonitor"
+ "The well known name of the GPhoto2 volume monitor.")
+
+;;;###tramp-autoload
+(defconst tramp-gvfs-service-mtp-volumemonitor "org.gtk.vfs.MTPVolumeMonitor"
+ "The well known name of the MTP volume monitor.")
+
+(defconst tramp-gvfs-path-remotevolumemonitor
+ "/org/gtk/Private/RemoteVolumeMonitor"
+ "The object path of the remote volume monitor.")
+
+(defconst tramp-gvfs-interface-remotevolumemonitor
+ "org.gtk.Private.RemoteVolumeMonitor"
+ "The volume monitor interface.")
+
+;; <interface name='org.gtk.Private.RemoteVolumeMonitor'>
+;; <method name="IsSupported">
+;; <arg type='b' name='is_supported' direction='out'/>
+;; </method>
+;; <method name="List">
+;; <arg type='a(ssssbbbbbbbbuasa{ss}sa{sv})' name='drives'
direction='out'/>
+;; <arg type='a(ssssssbbssa{ss}sa{sv})' name='volumes' direction='out'/>
+;; <arg type='a(ssssssbsassa{sv})' name='mounts' direction='out'/>
+;; </method>
+;; <method name="CancelOperation">
+;; <arg type='s' name='cancellation_id' direction='in'/>
+;; <arg type='b' name='was_cancelled' direction='out'/>
+;; </method>
+;; <method name="MountUnmount">
+;; <arg type='s' name='id' direction='in'/>
+;; <arg type='s' name='cancellation_id' direction='in'/>
+;; <arg type='u' name='unmount_flags' direction='in'/>
+;; <arg type='s' name='mount_op_id' direction='in'/>
+;; </method>
+;; <method name="VolumeMount">
+;; <arg type='s' name='id' direction='in'/>
+;; <arg type='s' name='cancellation_id' direction='in'/>
+;; <arg type='u' name='mount_flags' direction='in'/>
+;; <arg type='s' name='mount_op_id' direction='in'/>
+;; </method>
+;; <method name="DriveEject">
+;; <arg type='s' name='id' direction='in'/>
+;; <arg type='s' name='cancellation_id' direction='in'/>
+;; <arg type='u' name='unmount_flags' direction='in'/>
+;; <arg type='s' name='mount_op_id' direction='in'/>
+;; </method>
+;; <method name="DrivePollForMedia">
+;; <arg type='s' name='id' direction='in'/>
+;; <arg type='s' name='cancellation_id' direction='in'/>
+;; </method>
+;; <method name="DriveStart">
+;; <arg type='s' name='id' direction='in'/>
+;; <arg type='s' name='cancellation_id' direction='in'/>
+;; <arg type='u' name='flags' direction='in'/>
+;; <arg type='s' name='mount_op_id' direction='in'/>
+;; </method>
+;; <method name="DriveStop">
+;; <arg type='s' name='id' direction='in'/>
+;; <arg type='s' name='cancellation_id' direction='in'/>
+;; <arg type='u' name='unmount_flags' direction='in'/>
+;; <arg type='s' name='mount_op_id' direction='in'/>
+;; </method>
+;; <method name="MountOpReply">
+;; <arg type='s' name='mount_op_id' direction='in'/>
+;; <arg type='i' name='result' direction='in'/>
+;; <arg type='s' name='user_name' direction='in'/>
+;; <arg type='s' name='domain' direction='in'/>
+;; <arg type='s' name='encoded_password' direction='in'/>
+;; <arg type='i' name='password_save' direction='in'/>
+;; <arg type='i' name='choice' direction='in'/>
+;; <arg type='b' name='anonymous' direction='in'/>
+;; </method>
+;; <signal name="DriveChanged">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='(ssssbbbbbbbbuasa{ss}sa{sv})' name='drive'/>
+;; </signal>
+;; <signal name="DriveConnected">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='(ssssbbbbbbbbuasa{ss}sa{sv})' name='drive'/>
+;; </signal>
+;; <signal name="DriveDisconnected">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='(ssssbbbbbbbbuasa{ss}sa{sv})' name='drive'/>
+;; </signal>
+;; <signal name="DriveEjectButton">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='(ssssbbbbbbbbuasa{ss}sa{sv})' name='drive'/>
+;; </signal>
+;; <signal name="DriveStopButton">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='(ssssbbbbbbbbuasa{ss}sa{sv})' name='drive'/>
+;; </signal>
+;; <signal name="VolumeChanged">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='(ssssssbbssa{ss}sa{sv})' name='volume'/>
+;; </signal>
+;; <signal name="VolumeAdded">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='(ssssssbbssa{ss}sa{sv})' name='volume'/>
+;; </signal>
+;; <signal name="VolumeRemoved">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='(ssssssbbssa{ss}sa{sv})' name='volume'/>
+;; </signal>
+;; <signal name="MountChanged">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='(ssssssbsassa{sv})' name='mount'/>
+;; </signal>
+;; <signal name="MountAdded">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='(ssssssbsassa{sv})' name='mount'/>
+;; </signal>
+;; <signal name="MountPreUnmount">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='(ssssssbsassa{sv})' name='mount'/>
+;; </signal>
+;; <signal name="MountRemoved">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='(ssssssbsassa{sv})' name='mount'/>
+;; </signal>
+;; <signal name="MountOpAskPassword">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='s' name='message_to_show'/>
+;; <arg type='s' name='default_user'/>
+;; <arg type='s' name='default_domain'/>
+;; <arg type='u' name='flags'/>
+;; </signal>
+;; <signal name="MountOpAskQuestion">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='s' name='message_to_show'/>
+;; <arg type='as' name='choices'/>
+;; </signal>
+;; <signal name="MountOpShowProcesses">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='s' name='message_to_show'/>
+;; <arg type='ai' name='pid'/>
+;; <arg type='as' name='choices'/>
+;; </signal>
+;; <signal name="MountOpShowUnmountProgress">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='s' name='message_to_show'/>
+;; <arg type='x' name='time_left'/>
+;; <arg type='x' name='bytes_left'/>
+;; </signal>
+;; <signal name="MountOpAborted">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; </signal>
+;; </interface>
+
+;; STRUCT volume
+;; STRING id
+;; STRING name
+;; STRING gicon_data
+;; STRING symbolic_gicon_data
+;; STRING uuid
+;; STRING activation_uri
+;; BOOLEAN can-mount
+;; BOOLEAN should-automount
+;; STRING drive-id
+;; STRING mount-id
+;; ARRAY identifiers
+;; DICT
+;; STRING key (unix-device, class, uuid, ...)
+;; STRING value
+;; STRING sort_key
+;; ARRAY expansion
+;; DICT
+;; STRING key (always-call-mount, is-removable, ...)
+;; VARIANT value (boolean?)
+
+;; The basic structure for media devices. We use a list :type, in
+;; order to be compatible with Emacs 25.
+(cl-defstruct (tramp-media-device (:type list) :named) method host port)
;; "gvfs-<command>" utilities have been deprecated in GVFS 1.31.1. We
;; must use "gio <command>" tool instead.
@@ -474,37 +688,38 @@ It has been changed in GVFS 1.14.")
("gvfs-mount" . "mount")
("gvfs-move" . "move")
("gvfs-rm" . "remove")
- ("gvfs-set-attribute" . "set")
- ("gvfs-trash" . "trash"))
+ ("gvfs-set-attribute" . "set"))
"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"
- "standard::is-volatile"
- "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'.")
+(eval-and-compile
+ (defconst tramp-gvfs-file-attributes
+ '("name"
+ "type"
+ "standard::display-name"
+ "standard::symlink-target"
+ "standard::is-volatile"
+ "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."))
+
+(eval-and-compile
+ (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:]]*"
@@ -603,6 +818,8 @@ It has been changed in GVFS 1.14.")
(start-file-process . ignore)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-get-remote-gid . tramp-gvfs-handle-get-remote-gid)
+ (tramp-get-remote-uid . tramp-gvfs-handle-get-remote-uid)
(tramp-set-file-uid-gid . tramp-gvfs-handle-set-file-uid-gid)
(unhandled-file-name-directory . ignore)
(vc-registered . ignore)
@@ -628,10 +845,9 @@ 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))))
+ (if-let ((fn (assoc operation tramp-gvfs-file-name-handler-alist)))
+ (save-match-data (apply (cdr fn) args))
+ (tramp-run-real-handler operation args)))
;;;###tramp-autoload
(when (featurep 'dbusbind)
@@ -645,20 +861,19 @@ pass to the OPERATION."
(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)
+ (if (string-match-p "^(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)))))
+ (when-let ((byte-array
+ (if (and (consp byte-array) (atom (car byte-array)))
+ byte-array (car 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."
@@ -683,6 +898,8 @@ The call will be traced by Tramp with trace level 6."
(tramp-message vec 6 "%s" result(tramp-gvfs-stringify-dbus-message result))
result))
+(put #'tramp-dbus-function 'tramp-suppress-trace t)
+
(defmacro with-tramp-dbus-call-method
(vec synchronous bus service path interface method &rest args)
"Apply a D-Bus call on bus BUS.
@@ -692,14 +909,15 @@ 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'."
+ (declare (indent 2) (debug t))
`(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)))
+ ;; We use `dbus-ignore-errors', because this macro is also called
+ ;; when loading.
+ (dbus-ignore-errors (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
@@ -707,6 +925,7 @@ or `dbus-call-method-asynchronously'."
"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.
+ (declare (indent 1) (debug t))
`(when (member
,interface
(tramp-dbus-function
@@ -715,8 +934,6 @@ The call will be traced by Tramp with trace level 6."
(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
@@ -731,10 +948,10 @@ is no information where to trace the message.")
(tramp-error tramp-gvfs-dbus-event-vector 'file-error "%s" (cadr err))))
(add-hook 'dbus-event-error-functions #'tramp-gvfs-dbus-event-error)
-(add-hook
- 'tramp-gvfs-unload-hook
- (lambda ()
- (remove-hook 'dbus-event-error-functions #'tramp-gvfs-dbus-event-error)))
+(add-hook 'tramp-gvfs-unload-hook
+ (lambda ()
+ (remove-hook 'dbus-event-error-functions
+ #'tramp-gvfs-dbus-event-error)))
;; File name primitives.
@@ -768,6 +985,7 @@ file names."
(let ((t1 (tramp-tramp-file-p filename))
(t2 (tramp-tramp-file-p newname))
(equal-remote (tramp-equal-remote filename newname))
+ ;; "gvfs-rename" is not trustworthy.
(gvfs-operation (if (eq op 'copy) "gvfs-copy" "gvfs-move"))
(msg-operation (if (eq op 'copy) "Copying" "Renaming")))
@@ -779,7 +997,7 @@ file names."
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
- (not (tramp-compat-directory-name-p newname)))
+ (not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(if (or (and equal-remote
@@ -849,8 +1067,8 @@ file names."
(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))
+ (setq filename (expand-file-name filename)
+ newname (expand-file-name newname))
;; At least one file a Tramp file?
(if (or (tramp-tramp-file-p filename)
(tramp-tramp-file-p newname))
@@ -864,24 +1082,21 @@ file names."
(defun tramp-gvfs-handle-delete-directory (directory &optional recursive trash)
"Like `delete-directory' for Tramp files."
- (with-parsed-tramp-file-name directory nil
+ (tramp-skeleton-delete-directory directory recursive trash
(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)))
+ (delete-directory file recursive)
+ (delete-file file)))
(directory-files
directory 'full directory-files-no-dot-files-regexp))
- (when (directory-files directory nil directory-files-no-dot-files-regexp)
+ (unless (tramp-compat-directory-empty-p directory)
(tramp-error
v 'file-error "Couldn't delete non-empty %s" directory)))
- (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))
+ (unless (tramp-gvfs-send-command
+ v "gvfs-rm" (tramp-gvfs-url-file-name directory))
;; Propagate the error.
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
@@ -892,15 +1107,15 @@ file names."
"Like `delete-file' for Tramp files."
(with-parsed-tramp-file-name filename nil
(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)))))
+ (if (and delete-by-moving-to-trash trash)
+ (move-file-to-trash filename)
+ (unless (tramp-gvfs-send-command
+ v "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."
@@ -966,10 +1181,11 @@ file names."
(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))
+ (eval-when-compile
+ (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)))))
@@ -1070,8 +1286,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(if (eq id-format 'integer)
(string-to-number
(or (cdr (assoc "unix::uid" attributes))
- (eval-when-compile
- (format "%s" tramp-unknown-id-integer))))
+ (eval-when-compile (format "%s"
tramp-unknown-id-integer))))
(or (cdr (assoc "owner::user" attributes))
(cdr (assoc "unix::uid" attributes))
tramp-unknown-id-string)))
@@ -1079,8 +1294,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(if (eq id-format 'integer)
(string-to-number
(or (cdr (assoc "unix::gid" attributes))
- (eval-when-compile
- (format "%s" tramp-unknown-id-integer))))
+ (eval-when-compile (format "%s"
tramp-unknown-id-integer))))
(or (cdr (assoc "owner::group" attributes))
(cdr (assoc "unix::gid" attributes))
tramp-unknown-id-string)))
@@ -1220,6 +1434,9 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(unless (process-live-p p)
(tramp-error
p 'file-notify-error "Monitoring not supported for `%s'" file-name))
+ ;; Set "gio-file-monitor" property. We believe, that "gio
+ ;; monitor" uses polling when applied for mounted files.
+ (tramp-set-connection-property p "gio-file-monitor" 'GPollFileMonitor)
p))))
(defun tramp-gvfs-monitor-process-filter (proc string)
@@ -1234,11 +1451,11 @@ If FILE-SYSTEM is non-nil, return file system
attributes."
(tramp-message proc 6 "%S\n%s" proc string)
(setq string (concat rest-string string)
;; Fix action names.
- string (replace-regexp-in-string
+ string (tramp-compat-string-replace
"attributes changed" "attribute-changed" string)
- string (replace-regexp-in-string
+ string (tramp-compat-string-replace
"changes done" "changes-done-hint" string)
- string (replace-regexp-in-string
+ string (tramp-compat-string-replace
"renamed to" "moved" string))
;; https://bugs.launchpad.net/bugs/1742946
(when
@@ -1260,11 +1477,11 @@ If FILE-SYSTEM is non-nil, return file system
attributes."
;; 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)
+ (while (string-match-p "%\\([[:xdigit:]]\\{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 ""))
+ (while (string-match-p "%\\([[:xdigit:]]\\{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))
@@ -1297,7 +1514,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
;; 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)
+ (and (/= (tramp-get-remote-uid v 'integer)
(tramp-compat-file-attribute-user-id
(file-attributes filename 'integer)))
(not
@@ -1347,8 +1564,8 @@ If FILE-SYSTEM is non-nil, return file system attributes."
"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))
+ (setq filename (expand-file-name filename)
+ newname (expand-file-name newname))
;; At least one file a Tramp file?
(if (or (tramp-tramp-file-p filename)
(tramp-tramp-file-p newname))
@@ -1358,78 +1575,110 @@ If FILE-SYSTEM is non-nil, return file system
attributes."
(tramp-run-real-handler
#'rename-file (list filename newname ok-if-already-exists))))
-(defun tramp-gvfs-handle-set-file-modes (filename mode &optional _flag)
+(defun tramp-gvfs-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)
(tramp-gvfs-send-command
- v "gvfs-set-attribute" "-t" "uint32"
- (tramp-gvfs-url-file-name (tramp-make-tramp-file-name v))
- "unix::mode" (number-to-string mode))))
+ v "gvfs-set-attribute" (if (eq flag 'nofollow) "-nt" "-t") "uint32"
+ (tramp-gvfs-url-file-name filename) "unix::mode" (number-to-string
mode))))
-(defun tramp-gvfs-handle-set-file-times (filename &optional time _flag)
+(defun tramp-gvfs-handle-set-file-times (filename &optional time flag)
"Like `set-file-times' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)
- (let ((time
- (if (or (null time)
+ (tramp-gvfs-send-command
+ v "gvfs-set-attribute" (if (eq flag 'nofollow) "-nt" "-t") "uint64"
+ (tramp-gvfs-url-file-name filename) "time::modified"
+ (format-time-string
+ "%s" (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-gvfs-send-command
- v "gvfs-set-attribute" "-t" "uint64"
- (tramp-gvfs-url-file-name (tramp-make-tramp-file-name v))
- "time::modified" (format-time-string "%s" time)))))
+ time)))))
+
+(defun tramp-gvfs-handle-get-remote-uid (vec id-format)
+ "The uid of the remote connection VEC, in ID-FORMAT.
+ID-FORMAT valid values are `string' and `integer'."
+ (if (equal id-format 'string)
+ (tramp-file-name-user vec)
+ (when-let
+ ((localname (tramp-get-connection-property vec "default-location" nil)))
+ (tramp-compat-file-attribute-user-id
+ (file-attributes
+ (tramp-make-tramp-file-name vec localname) id-format)))))
+
+(defun tramp-gvfs-handle-get-remote-gid (vec id-format)
+ "The gid of the remote connection VEC, in ID-FORMAT.
+ID-FORMAT valid values are `string' and `integer'."
+ (when-let
+ ((localname (tramp-get-connection-property vec "default-location" nil)))
+ (tramp-compat-file-attribute-group-id
+ (file-attributes
+ (tramp-make-tramp-file-name vec localname) id-format))))
-(defun tramp-gvfs-set-file-uid-gid (filename &optional uid gid)
+(defun tramp-gvfs-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-flush-file-properties v localname)
(when (natnump uid)
(tramp-gvfs-send-command
v "gvfs-set-attribute" "-t" "uint32"
- (tramp-gvfs-url-file-name (tramp-make-tramp-file-name v))
- "unix::uid" (number-to-string uid)))
+ (tramp-gvfs-url-file-name filename) "unix::uid" (number-to-string uid)))
(when (natnump gid)
(tramp-gvfs-send-command
v "gvfs-set-attribute" "-t" "uint32"
- (tramp-gvfs-url-file-name (tramp-make-tramp-file-name v))
+ (tramp-gvfs-url-file-name filename)
"unix::gid" (number-to-string gid)))))
;; File name conversions.
+(defun tramp-gvfs-activation-uri (filename)
+ "Return activation URI to be used in gio commands."
+ (if (tramp-tramp-file-p filename)
+ (with-parsed-tramp-file-name filename nil
+ ;; Ensure that media devices are cached.
+ (when (string-equal method "media")
+ (tramp-get-media-device v))
+ (with-tramp-connection-property v "activation-uri"
+ (setq localname "/")
+ (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 (string-equal "media" method)
+ (when-let
+ ((media (tramp-get-connection-property v "media-device" nil)))
+ (setq method (tramp-media-device-method media)
+ host (tramp-media-device-host media)
+ port (tramp-media-device-port media))))
+ (when (and user domain)
+ (setq user (concat domain ";" user)))
+ (url-recreate-url
+ (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)
+ localname nil nil t))))
+ ;; Local URI.
+ (url-recreate-url
+ (url-parse-make-urlobj "file" nil nil nil nil nil nil nil t))))
+
(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))))
+ (let* (;; "/" must NOT be hexified.
+ (url-unreserved-chars (cons ?/ url-unreserved-chars))
+ (result
+ (concat (substring (tramp-gvfs-activation-uri filename) 0 -1)
+ (url-hexify-string (tramp-file-local-name filename)))))
(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)))
+ (tramp-message
+ (tramp-dissect-file-name filename) 10
+ "remote file `%s' is URL `%s'" filename result))
result))
(defun tramp-gvfs-object-path (filename)
@@ -1441,6 +1690,14 @@ If FILE-SYSTEM is non-nil, return file system
attributes."
(dbus-unescape-from-identifier
(replace-regexp-in-string "^.*/\\([^/]+\\)$" "\\1" object-path)))
+(defun tramp-gvfs-url-host (url)
+ "Return the host name part of URL, a string.
+We cannot use `url-host', because `url-generic-parse-url' returns
+a downcased host name only."
+ (and (stringp url)
+ (string-match "^[[:alnum:]]+://\\([^/:]+\\)" url)
+ (match-string 1 url)))
+
;; D-Bus GVFS functions.
@@ -1507,8 +1764,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(list
t ;; handled.
nil ;; no abort of D-Bus.
- (with-tramp-connection-property
- (tramp-get-connection-process v) message
+ (with-tramp-connection-property (tramp-get-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.
@@ -1581,11 +1837,22 @@ If FILE-SYSTEM is non-nil, return file system
attributes."
(when (string-equal "google-drive" method)
(setq method "gdrive"))
(when (and (string-equal "http" method) (stringp uri))
- (setq uri (url-generic-parse-url uri)
+ (setq host (tramp-gvfs-url-host uri)
+ 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-media-methods)
+ ;; Ensure that media devices are cached.
+ (tramp-get-media-devices nil)
+ (let ((v (tramp-get-connection-property
+ (make-tramp-media-device
+ :method method :host host :port port)
+ "vector" nil)))
+ (when v
+ (setq method (tramp-file-name-method v)
+ host (tramp-file-name-host v)
+ port (tramp-file-name-port v)))))
(when (member method tramp-gvfs-methods)
(with-parsed-tramp-file-name
(tramp-make-tramp-file-name method user domain host port "") nil
@@ -1671,11 +1938,22 @@ If FILE-SYSTEM is non-nil, return file system
attributes."
(when (string-equal "google-drive" method)
(setq method "gdrive"))
(when (and (string-equal "http" method) (stringp uri))
- (setq uri (url-generic-parse-url uri)
+ (setq host (tramp-gvfs-url-host uri)
+ 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-media-methods)
+ ;; Ensure that media devices are cached.
+ (tramp-get-media-devices vec)
+ (let ((v (tramp-get-connection-property
+ (make-tramp-media-device
+ :method method :host host :port port)
+ "vector" nil)))
+ (when v
+ (setq method (tramp-file-name-method v)
+ host (tramp-file-name-host v)
+ port (tramp-file-name-port v)))))
(when (and
(string-equal method (tramp-file-name-method vec))
(string-equal user (tramp-file-name-user vec))
@@ -1700,8 +1978,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(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)))
+ (tramp-cleanup-connection vec 'keep-debug 'keep-password))
(defun tramp-gvfs-mount-spec-entry (key value)
"Construct a mount-spec entry to be used in a mount_spec.
@@ -1713,11 +1990,16 @@ It was \"a(say)\", but has changed to \"a{sv})\"."
(defun tramp-gvfs-mount-spec (vec)
"Return a mount-spec for \"org.gtk.vfs.MountTracker.mountLocation\"."
- (let* ((method (tramp-file-name-method vec))
+ (let* ((media (tramp-get-media-device vec))
+ (method (if media
+ (tramp-media-device-method media)
+ (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))
+ (host (if media
+ (tramp-media-device-host media) (tramp-file-name-host vec)))
+ (port (if media
+ (tramp-media-device-port media) (tramp-file-name-port vec)))
(localname (tramp-file-name-unquote-localname vec))
(share (when (string-match "^/?\\([^/]+\\)" localname)
(match-string 1 localname)))
@@ -1768,42 +2050,41 @@ It was \"a(say)\", but has changed to \"a{sv})\"."
;; Return.
`(:struct ,(tramp-gvfs-dbus-string-to-byte-array mount-pref) ,mount-spec)))
+(defun tramp-gvfs-handler-volumeadded-volumeremoved (_dbus-name _id volume)
+ "Signal handler for the \"org.gtk.Private.RemoteVolumeMonitor.VolumeAdded\" \
+and \"org.gtk.Private.RemoteVolumeMonitor.VolumeRemoved\" signals."
+ (ignore-errors
+ (let* ((signal-name (dbus-event-member-name last-input-event))
+ (uri (url-generic-parse-url (nth 5 volume)))
+ (method (url-type uri))
+ (vec (make-tramp-file-name
+ :method "media"
+ ;; A host name cannot contain spaces.
+ :host (tramp-compat-string-replace " " "_" (nth 1 volume))))
+ (media (make-tramp-media-device
+ :method method
+ :host (tramp-gvfs-url-host (nth 5 volume))
+ :port (and (url-portspec uri)))))
+ (when (member method tramp-media-methods)
+ (tramp-message
+ vec 6 "%s %s" signal-name (tramp-gvfs-stringify-dbus-message volume))
+ (tramp-flush-connection-properties vec)
+ (tramp-flush-connection-properties media)
+ (tramp-get-media-devices nil)))))
+
+(when tramp-gvfs-enabled
+ (dbus-register-signal
+ :session nil tramp-gvfs-path-remotevolumemonitor
+ tramp-gvfs-interface-remotevolumemonitor "VolumeAdded"
+ #'tramp-gvfs-handler-volumeadded-volumeremoved)
+ (dbus-register-signal
+ :session nil tramp-gvfs-path-remotevolumemonitor
+ tramp-gvfs-interface-remotevolumemonitor "VolumeRemoved"
+ #'tramp-gvfs-handler-volumeadded-volumeremoved))
+
;; 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."
@@ -1811,7 +2092,7 @@ This is relevant for GNOME Online Accounts."
;; 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 (tramp-make-goa-name vec) "prefix" "/")))
+ (tramp-get-connection-property (tramp-get-goa-account vec) "prefix" "/")))
(defun tramp-gvfs-maybe-open-connection (vec)
"Maybe open a connection VEC.
@@ -1834,7 +2115,10 @@ connection if a previous connection has died for some
reason."
: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-process-query-on-exit-flag p nil)
+
+ ;; Set connection-local variables.
+ (tramp-set-connection-local-variables vec)))
(unless (tramp-gvfs-connection-mounted-p vec)
(let ((method (tramp-file-name-method vec))
@@ -1860,7 +2144,7 @@ connection if a previous connection has died for some
reason."
;; Ensure that GNOME Online Accounts are cached.
(tramp-get-goa-accounts vec)
(when (tramp-get-connection-property
- (tramp-make-goa-name vec) "FilesDisabled" t)
+ (tramp-get-goa-account vec) "FilesDisabled" t)
(tramp-user-error
vec "There is no Online Account `%s'"
(tramp-make-tramp-file-name vec 'noloc))))
@@ -1938,21 +2222,9 @@ connection if a previous connection has died for some
reason."
(and (functionp tramp-password-save-function)
(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))))
+ (tramp-get-connection-process vec) "connected" t)))))
(defun tramp-gvfs-gio-tool-p (vec)
"Check, whether the gio tool is available."
@@ -1985,12 +2257,12 @@ is applied, and it returns t if the return code is
zero."
(and (tramp-flush-file-properties vec "/") nil)))))
-;; D-Bus GNOME Online Accounts functions.
+;; GNOME Online Accounts functions.
-(defun tramp-make-goa-name (vec)
- "Transform VEC into a `tramp-goa-name' structure."
+(defun tramp-get-goa-account (vec)
+ "Transform VEC into a `tramp-goa-account' structure."
(when (tramp-file-name-p vec)
- (make-tramp-goa-name
+ (make-tramp-goa-account
:method (tramp-file-name-method vec)
:user (tramp-file-name-user vec)
:host (tramp-file-name-host vec)
@@ -1998,12 +2270,12 @@ is applied, and it returns t if the return code is
zero."
(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
+The hash key is a `tramp-goa-account' 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.
+`tramp-goa-interface-files' of the corresponding GNOME Online
+Account. Additionally, a property \"prefix\" is added.
VEC is used only for traces."
- (with-tramp-connection-property (tramp-make-goa-name vec) "goa-accounts"
+ (with-tramp-connection-property nil "goa-accounts"
(dolist
(object-path
(mapcar
@@ -2029,15 +2301,15 @@ VEC is used only for traces."
(cdr (assoc "ProviderType" account-properties))
'("google" "owncloud"))
(string-match tramp-goa-identity-regexp identity))
- (setq key (make-tramp-goa-name
+ (setq key (make-tramp-goa-account
: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"))
+ (when (string-equal (tramp-goa-account-method key) "google")
+ (setf (tramp-goa-account-method key) "gdrive"))
+ (when (string-equal (tramp-goa-account-method key) "owncloud")
+ (setf (tramp-goa-account-method key) "nextcloud"))
;; Cache all properties.
(dolist (prop (nconc account-properties files-properties))
(tramp-set-connection-property key (car prop) (cdr prop)))
@@ -2053,6 +2325,80 @@ VEC is used only for traces."
;; Mark, that goa accounts have been cached.
"cached"))
+(defun tramp-parse-goa-accounts (service)
+ "Return a list of (user host) tuples allowed to access.
+It checks for registered GNOME Online Accounts."
+ ;; SERVICE might be encoded as a DNS-SD service.
+ (and (string-match tramp-dns-sd-service-regexp service)
+ (setq service (match-string 1 service)))
+ (mapcar
+ (lambda (key)
+ (and (tramp-goa-account-p key)
+ (string-equal service (tramp-goa-account-method key))
+ (list (tramp-goa-account-user key)
+ (tramp-goa-account-host key))))
+ (hash-table-keys tramp-cache-data)))
+
+
+;; Media devices functions.
+
+(defun tramp-get-media-device (vec)
+ "Transform VEC into a `tramp-media-device' structure.
+Check, that respective cache values do exist."
+ (if-let ((media (tramp-get-connection-property vec "media-device" nil))
+ (prop (tramp-get-connection-property media "vector" nil)))
+ media
+ (tramp-get-media-devices vec)
+ (tramp-get-connection-property vec "media-device" nil)))
+
+(defun tramp-get-media-devices (vec)
+ "Retrieve media devices, and cache them.
+The hash key is a `tramp-media-device' structure.
+VEC is used only for traces."
+ (let (devices)
+ (dolist (method tramp-media-methods)
+ (dolist (volume (cadr (with-tramp-dbus-call-method vec t
+ :session (tramp-gvfs-service-volumemonitor method)
+ tramp-gvfs-path-remotevolumemonitor
+ tramp-gvfs-interface-remotevolumemonitor "List")))
+ (let* ((uri (url-generic-parse-url (nth 5 volume)))
+ (vec (make-tramp-file-name
+ :method "media"
+ ;; A host name cannot contain spaces.
+ :host (tramp-compat-string-replace " " "_" (nth 1
volume))))
+ (media (make-tramp-media-device
+ :method method
+ :host (tramp-gvfs-url-host (nth 5 volume))
+ :port (and (url-portspec uri)
+ (number-to-string (url-portspec uri))))))
+ (push (tramp-file-name-host vec) devices)
+ (tramp-set-connection-property vec "activation-uri" (nth 5 volume))
+ (tramp-set-connection-property vec "media-device" media)
+ (tramp-set-connection-property media "vector" vec))))
+
+ ;; Adapt default host name, supporting /media:: when possible.
+ (setq tramp-default-host-alist
+ (append
+ `(("media" nil ,(if (= (length devices) 1) (car devices) "")))
+ (delete
+ (assoc "media" tramp-default-host-alist)
+ tramp-default-host-alist)))))
+
+(defun tramp-parse-media-names (service)
+ "Return a list of (user host) tuples allowed to access.
+It checks for mounted media devices."
+ ;; SERVICE might be encoded as a DNS-SD service.
+ (and (string-match tramp-dns-sd-service-regexp service)
+ (setq service (match-string 1 service)))
+ (mapcar
+ (lambda (key)
+ (and (tramp-media-device-p key)
+ (string-equal service (tramp-media-device-method key))
+ (tramp-get-connection-property key "vector" nil)
+ (list nil (tramp-file-name-host
+ (tramp-get-connection-property key "vector" nil)))))
+ (hash-table-keys tramp-cache-data)))
+
;; D-Bus zeroconf functions.
@@ -2097,42 +2443,65 @@ This uses \"avahi-browse\" in case D-Bus is not enabled
in Avahi."
(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
- ;; Sometimes, it fails with "Variable binding depth exceeds
+ ;; Suppress D-Bus error messages and Tramp traces.
+ (let (;; Sometimes, it fails with "Variable binding depth exceeds
;; max-specpdl-size". Shall be fixed in Emacs 27.
- (max-specpdl-size (* 2 max-specpdl-size)))
+ (max-specpdl-size (* 2 max-specpdl-size))
+ (tramp-verbose 0)
+ tramp-gvfs-dbus-event-vector fun)
+ ;; Add completion functions for services announced by DNS-SD.
+ ;; See <http://www.dns-sd.org/ServiceTypes.html> for valid service types.
(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")
+ (when (setq fun (or (and (zeroconf-list-service-types)
+ #'tramp-zeroconf-parse-device-names)
+ (and (executable-find "avahi-browse")
+ #'tramp-gvfs-parse-device-names)))
+ (when (member "afp" tramp-gvfs-methods)
+ (tramp-set-completion-function
+ "afp" `((,fun "_afpovertcp._tcp"))))
+ (when (member "dav" tramp-gvfs-methods)
+ (tramp-set-completion-function
+ "dav" `((,fun "_webdav._tcp")
+ (,fun "_webdavs._tcp"))))
+ (when (member "davs" tramp-gvfs-methods)
(tramp-set-completion-function
- "afp" '((tramp-gvfs-parse-device-names "_afpovertcp._tcp")))
+ "davs" `((,fun "_webdav._tcp")
+ (,fun "_webdavs._tcp"))))
+ (when (member "ftp" tramp-gvfs-methods)
(tramp-set-completion-function
- "dav" '((tramp-gvfs-parse-device-names "_webdav._tcp")))
+ "ftp" `((,fun "_ftp._tcp"))))
+ (when (member "http" tramp-gvfs-methods)
(tramp-set-completion-function
- "davs" '((tramp-gvfs-parse-device-names "_webdav._tcp")))
+ "http" `((,fun "_http._tcp")
+ (,fun "_https._tcp"))))
+ (when (member "https" tramp-gvfs-methods)
(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"))))))))
+ "https" `((,fun "_http._tcp")
+ (,fun "_https._tcp"))))
+ (when (member "sftp" tramp-gvfs-methods)
+ (tramp-set-completion-function
+ "sftp" `((,fun "_sftp-ssh._tcp")
+ (,fun "_ssh._tcp")
+ (,fun "_workstation._tcp"))))
+ (when (member "smb" tramp-gvfs-methods)
+ (tramp-set-completion-function
+ "smb" `((,fun "_smb._tcp")))))
+
+ ;; Add completion functions for GNOME Online Accounts.
+ (tramp-get-goa-accounts nil)
+ (dolist (method tramp-goa-methods)
+ (when (member method tramp-gvfs-methods)
+ (tramp-set-completion-function
+ method `((tramp-parse-goa-accounts ,(format "_%s._tcp" method))))))
+
+ ;; Add completion functions for media devices.
+ (tramp-get-media-devices nil)
+ (tramp-set-completion-function
+ "media"
+ (mapcar
+ (lambda (method) `(tramp-parse-media-names ,(format "_%s._tcp" method)))
+ tramp-media-methods))))
(add-hook 'tramp-unload-hook
(lambda ()
@@ -2145,7 +2514,7 @@ This uses \"avahi-browse\" in case D-Bus is not enabled
in Avahi."
;; * (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.
+;; smb-server) or via smb-network or network.
;;
;; * Check, how two shares of the same SMB server can be mounted in
;; parallel.
diff --git a/tramp-integration.el b/tramp-integration.el
index 7e4a9bf..566c673 100644
--- a/tramp-integration.el
+++ b/tramp-integration.el
@@ -262,23 +262,39 @@ NAME must be equal to `tramp-current-connection'."
(info-lookup->topic-cache 'symbol))))))))
;;; Default connection-local variables for Tramp:
+;; `connection-local-set-profile-variables' and
+;; `connection-local-set-profiles' exists since Emacs 26.1.
+
+(defconst tramp-connection-local-default-system-variables
+ '((path-separator . ":")
+ (null-device . "/dev/null"))
+ "Default connection-local system variables for remote connections.")
+
+(tramp-compat-funcall
+ 'connection-local-set-profile-variables
+ 'tramp-connection-local-default-system-profile
+ tramp-connection-local-default-system-variables)
+
+(tramp-compat-funcall
+ 'connection-local-set-profiles
+ `(:application tramp)
+ 'tramp-connection-local-default-system-profile)
-(defconst tramp-connection-local-default-profile
+(defconst tramp-connection-local-default-shell-variables
'((shell-file-name . "/bin/sh")
(shell-command-switch . "-c"))
- "Default connection-local variables for remote connections.")
+ "Default connection-local shell variables for remote connections.")
+
+(tramp-compat-funcall
+ 'connection-local-set-profile-variables
+ 'tramp-connection-local-default-shell-profile
+ tramp-connection-local-default-shell-variables)
-;; `connection-local-set-profile-variables' and
-;; `connection-local-set-profiles' exists since Emacs 26.1.
(with-eval-after-load 'shell
(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))
+ 'tramp-connection-local-default-shell-profile))
(add-hook 'tramp-unload-hook
(lambda () (unload-feature 'tramp-integration 'force)))
diff --git a/tramp-loaddefs.el b/tramp-loaddefs.el
deleted file mode 100644
index e0f1906..0000000
--- a/tramp-loaddefs.el
+++ /dev/null
@@ -1,686 +0,0 @@
-;;; tramp-loaddefs.el --- automatically extracted autoloads
-;;
-;;; Code:
-
-
-;;;### (autoloads nil "tramp-adb" "tramp-adb.el" (0 0 0 0))
-;;; Generated autoloads from tramp-adb.el
-
-(defvar tramp-adb-program "adb" "\
-Name of the Android Debug Bridge program.")
-
-(custom-autoload 'tramp-adb-program "tramp-adb" t)
-
-(defvar 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.")
-
-(custom-autoload 'tramp-adb-connect-if-not-connected "tramp-adb" t)
-
-(defconst tramp-adb-method "adb" "\
-When this method name is used, forward all calls to Android Debug Bridge.")
-
-(defvar tramp-adb-prompt
"^[[:digit:]]*|?[[:alnum:]\33;[]*@?[[:alnum:]]*[^#\\$]*[#\\$][[:space:]]" "\
-Regexp used as prompt in almquist shell.")
-
-(custom-autoload 'tramp-adb-prompt "tramp-adb" t)
-
-(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
""))))
-
-(defconst tramp-adb-file-name-handler-alist '((access-file .
tramp-handle-access-file) (add-name-to-file . tramp-handle-add-name-to-file)
(copy-directory . tramp-handle-copy-directory) (copy-file .
tramp-adb-handle-copy-file) (delete-directory .
tramp-adb-handle-delete-directory) (delete-file . tramp-adb-handle-delete-file)
(directory-file-name . tramp-handle-directory-file-name) (directory-files .
tramp-handle-directory-files) (directory-files-and-attributes .
tramp-adb-handle-directory [...]
-Alist of handler functions for Tramp ADB method.")
-
-(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)))
-
-(autoload 'tramp-adb-file-name-handler "tramp-adb" "\
-Invoke the ADB handler for OPERATION.
-First arg specifies the OPERATION, second arg is a list of
-ARGUMENTS to pass to the OPERATION.
-
-\(fn OPERATION &rest ARGUMENTS)" nil nil)
-
-(tramp--with-startup (tramp-register-foreign-file-name-handler
#'tramp-adb-file-name-p #'tramp-adb-file-name-handler))
-
-(autoload 'tramp-adb-parse-device-names "tramp-adb" "\
-Return a list of (nil host) tuples allowed to access.
-
-\(fn IGNORE)" nil nil)
-
-;;;***
-
-;;;### (autoloads nil "tramp-archive" "tramp-archive.el" (0 0 0 0))
-;;; Generated autoloads from tramp-archive.el
-
-(defconst tramp-archive-file-name-regexp (ignore-errors
(tramp-archive-autoload-file-name-regexp)) "\
-Regular expression matching archive file names.")
-
-(defconst tramp-archive-method "archive" "\
-Method name for archives in GVFS.")
-
-(defconst tramp-archive-file-name-handler-alist '((access-file .
tramp-archive-handle-access-file) (add-name-to-file .
tramp-archive-handle-not-implemented) (copy-file .
tramp-archive-handle-copy-file) (delete-directory .
tramp-archive-handle-not-implemented) (delete-file .
tramp-archive-handle-not-implemented) (directory-file-name .
tramp-archive-handle-directory-file-name) (directory-files .
tramp-handle-directory-files) (directory-files-and-attributes .
tramp-handle-directory-files-an [...]
-Alist of handler functions for file archive method.
-Operations not mentioned here will be handled by the default Emacs
primitives.")
-
-(autoload 'tramp-archive-file-name-handler "tramp-archive" "\
-Invoke the file archive related OPERATION.
-First arg specifies the OPERATION, second arg ARGS is a list of
-arguments to pass to the OPERATION.
-
-\(fn OPERATION &rest ARGS)" nil nil)
-
-;;;***
-
-;;;### (autoloads nil "tramp-cache" "tramp-cache.el" (0 0 0 0))
-;;; Generated autoloads from tramp-cache.el
-
-(defvar tramp-cache-data (make-hash-table :test #'equal) "\
-Hash table for remote files properties.")
-
-(defvar 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.")
-
-(custom-autoload 'tramp-connection-properties "tramp-cache" t)
-
-(defvar tramp-persistency-file-name (expand-file-name (locate-user-emacs-file
"tramp")) "\
-File which keeps connection history for Tramp connections.")
-
-(custom-autoload 'tramp-persistency-file-name "tramp-cache" t)
-
-(autoload 'tramp-get-file-property "tramp-cache" "\
-Get the PROPERTY of FILE from the cache context of KEY.
-Returns DEFAULT if not set.
-
-\(fn KEY FILE PROPERTY DEFAULT)" nil nil)
-
-(autoload 'tramp-set-file-property "tramp-cache" "\
-Set the PROPERTY of FILE to VALUE, in the cache context of KEY.
-Returns VALUE.
-
-\(fn KEY FILE PROPERTY VALUE)" nil nil)
-
-(autoload 'tramp-flush-file-property "tramp-cache" "\
-Remove PROPERTY of FILE in the cache context of KEY.
-
-\(fn KEY FILE PROPERTY)" nil nil)
-
-(autoload 'tramp-flush-file-properties "tramp-cache" "\
-Remove all properties of FILE in the cache context of KEY.
-
-\(fn KEY FILE)" nil nil)
-
-(autoload 'tramp-flush-directory-properties "tramp-cache" "\
-Remove all properties of DIRECTORY in the cache context of KEY.
-Remove also properties of all files in subdirectories.
-
-\(fn KEY DIRECTORY)" nil nil)
-
-(autoload 'tramp-get-connection-property "tramp-cache" "\
-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.
-
-\(fn KEY PROPERTY DEFAULT)" nil nil)
-
-(autoload 'tramp-set-connection-property "tramp-cache" "\
-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.
-
-\(fn KEY PROPERTY VALUE)" nil nil)
-
-(autoload 'tramp-connection-property-p "tramp-cache" "\
-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.
-
-\(fn KEY PROPERTY)" nil nil)
-
-(autoload 'tramp-flush-connection-property "tramp-cache" "\
-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.
-
-\(fn KEY PROPERTY)" nil nil)
-
-(autoload 'tramp-flush-connection-properties "tramp-cache" "\
-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.
-
-\(fn KEY)" nil nil)
-
-(autoload 'tramp-cache-print "tramp-cache" "\
-Print hash table TABLE.
-
-\(fn TABLE)" nil nil)
-
-(autoload 'tramp-list-connections "tramp-cache" "\
-Return all known `tramp-file-name' structs according to `tramp-cache'." nil
nil)
-
-(autoload 'tramp-parse-connection-properties "tramp-cache" "\
-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.
-
-\(fn METHOD)" nil nil)
-
-(defvar tramp-cache-read-persistent-data (or init-file-user site-run-file) "\
-Whether to read persistent data at startup time.")
-
-;;;***
-
-;;;### (autoloads nil "tramp-cmds" "tramp-cmds.el" (0 0 0 0))
-;;; Generated autoloads from tramp-cmds.el
-
-(autoload 'tramp-change-syntax "tramp-cmds" "\
-Change Tramp syntax.
-SYNTAX can be one of the symbols `default' (default),
-`simplified' (ange-ftp like) or `separate' (XEmacs like).
-
-\(fn &optional SYNTAX)" t nil)
-
-(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.")
-
-(autoload 'tramp-cleanup-connection "tramp-cmds" "\
-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.
-
-\(fn VEC &optional KEEP-DEBUG KEEP-PASSWORD)" t nil)
-
-(autoload 'tramp-cleanup-this-connection "tramp-cmds" "\
-Flush all connection related objects of the current buffer's connection." t
nil)
-
-(defvar tramp-cleanup-all-connections-hook nil "\
-List of functions to be called after all Tramp connections are cleaned up.")
-
-(autoload 'tramp-cleanup-all-connections "tramp-cmds" "\
-Flush all Tramp internal objects.
-This includes password cache, file cache, connection cache, buffers." t nil)
-
-(autoload 'tramp-cleanup-all-buffers "tramp-cmds" "\
-Kill all remote buffers." t nil)
-
-(defvar tramp-default-rename-alist nil "\
-Default target for renaming remote buffer file names.
-This is an alist of cons cells (SOURCE . TARGET). The first
-matching item specifies the target to be applied for renaming
-buffer file names from source via `tramp-rename-files'. SOURCE
-is a regular expressions, which matches a remote file name.
-TARGET must be a directory name, which could be remote (including
-remote directories Tramp infers by default, such as
-\"/method:user@host:\").
-
-TARGET can contain the patterns %m, %u or %h, which are replaced
-by the method name, user name or host name of SOURCE when calling
-`tramp-rename-files'.
-
-SOURCE could also be a Lisp form, which will be evaluated. The
-result must be a string or nil, which is interpreted as a regular
-expression which always matches.")
-
-(custom-autoload 'tramp-default-rename-alist "tramp-cmds" t)
-
-(defvar tramp-confirm-rename-file-names t "\
-Whether renaming a buffer file name must be confirmed.")
-
-(custom-autoload 'tramp-confirm-rename-file-names "tramp-cmds" t)
-
-(autoload 'tramp-rename-files "tramp-cmds" "\
-Replace in all buffers the visiting file name from SOURCE to TARGET.
-SOURCE is a remote directory name, which could contain also a
-localname part. TARGET is the directory name SOURCE is replaced
-with. Often, TARGET is a remote directory name on another host,
-but it can also be a local directory name. If TARGET has no
-local part, the local part from SOURCE is used.
-
-If TARGET is nil, it is selected according to the first match in
-`tramp-default-rename-alist'. If called interactively, this
-match is offered as initial value for selection.
-
-On all buffers, which have a `buffer-file-name' matching SOURCE,
-this name is modified by replacing SOURCE with TARGET. This is
-applied by calling `set-visited-file-name'. The new
-`buffer-file-name' is prompted for modification in the
-minibuffer. The buffers are marked modified, and must be saved
-explicitly.
-
-If user option `tramp-confirm-rename-file-names' is nil, changing
-the file name happens without confirmation. This requires a
-matching entry in `tramp-default-rename-alist'.
-
-Remote buffers related to the remote connection identified by
-SOURCE, which are not visiting files, or which are visiting files
-not matching SOURCE, are not modified.
-
-Interactively, TARGET is selected from `tramp-default-rename-alist'
-without confirmation if the prefix argument is non-nil.
-
-The remote connection identified by SOURCE is flushed by
-`tramp-cleanup-connection'.
-
-\(fn SOURCE TARGET)" t nil)
-
-(autoload 'tramp-rename-these-files "tramp-cmds" "\
-Replace visiting file names to TARGET.
-The current buffer must be related to a remote connection. In
-all buffers, which are visiting a file with the same directory
-name, the buffer file name is changed.
-
-Interactively, TARGET is selected from `tramp-default-rename-alist'
-without confirmation if the prefix argument is non-nil.
-
-For details, see `tramp-rename-files'.
-
-\(fn TARGET)" t nil)
-
-(autoload 'tramp-version "tramp-cmds" "\
-Print version number of tramp.el in minibuffer or current buffer.
-
-\(fn ARG)" t nil)
-
-(autoload 'tramp-bug "tramp-cmds" "\
-Submit a bug report to the Tramp developers." t nil)
-
-;;;***
-
-;;;### (autoloads nil "tramp-ftp" "tramp-ftp.el" (0 0 0 0))
-;;; Generated autoloads from tramp-ftp.el
-
-(autoload 'tramp-ftp-enable-ange-ftp "tramp-ftp" "\
-Reenable Ange-FTP, when Tramp is unloaded." nil nil)
-
-(defconst tramp-ftp-method "ftp" "\
-When this method name is used, forward all calls to Ange-FTP.")
-
-(tramp--with-startup (add-to-list 'tramp-methods (cons tramp-ftp-method nil))
(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)) (tramp-set-completion-function
tramp-ftp-method '((tramp-parse-netrc "~/.netrc"))))
-
-(autoload 'tramp-ftp-file-name-handler "tramp-ftp" "\
-Invoke the Ange-FTP handler for OPERATION and ARGS.
-First arg specifies the OPERATION, second arg is a list of arguments to
-pass to the OPERATION.
-
-\(fn OPERATION &rest ARGS)" nil nil)
-
-(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--with-startup (add-to-list 'tramp-foreign-file-name-handler-alist (cons
#'tramp-ftp-file-name-p #'tramp-ftp-file-name-handler)))
-
-;;;***
-
-;;;### (autoloads nil "tramp-gvfs" "tramp-gvfs.el" (0 0 0 0))
-;;; Generated autoloads from tramp-gvfs.el
-
-(defvar tramp-gvfs-methods '("afp" "dav" "davs" "gdrive" "nextcloud" "sftp") "\
-List of methods for remote files, accessed with GVFS.")
-
-(custom-autoload 'tramp-gvfs-methods "tramp-gvfs" t)
-
-(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))))))
-
-(defvar tramp-gvfs-zeroconf-domain "local" "\
-Zeroconf domain to be used for discovering services, like host names.")
-
-(custom-autoload 'tramp-gvfs-zeroconf-domain "tramp-gvfs" t)
-
-(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-goa-service "org.gnome.OnlineAccounts" "\
-The well known name of the GNOME Online Accounts service.")
-
-(defconst tramp-gvfs-file-name-handler-alist '((access-file .
tramp-handle-access-file) (add-name-to-file . tramp-handle-add-name-to-file)
(copy-directory . tramp-handle-copy-directory) (copy-file .
tramp-gvfs-handle-copy-file) (delete-directory .
tramp-gvfs-handle-delete-directory) (delete-file .
tramp-gvfs-handle-delete-file) (directory-file-name .
tramp-handle-directory-file-name) (directory-files .
tramp-handle-directory-files) (directory-files-and-attributes .
tramp-handle-directory [...]
-Alist of handler functions for Tramp GVFS method.
-Operations not mentioned here will be handled by the default Emacs
primitives.")
-
-(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)))))
-
-(autoload 'tramp-gvfs-file-name-handler "tramp-gvfs" "\
-Invoke the GVFS related OPERATION and ARGS.
-First arg specifies the OPERATION, second arg is a list of arguments to
-pass to the OPERATION.
-
-\(fn OPERATION &rest ARGS)" nil nil)
-
-(when (featurep 'dbusbind) (tramp--with-startup
(tramp-register-foreign-file-name-handler #'tramp-gvfs-file-name-p
#'tramp-gvfs-file-name-handler)))
-
-;;;***
-
-;;;### (autoloads nil "tramp-rclone" "tramp-rclone.el" (0 0 0 0))
-;;; Generated autoloads from tramp-rclone.el
-
-(defconst tramp-rclone-method "rclone" "\
-When this method name is used, forward all calls to rclone mounts.")
-
-(defvar tramp-rclone-program "rclone" "\
-Name of the rclone program.")
-
-(custom-autoload 'tramp-rclone-program "tramp-rclone" t)
-
-(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 ""))))
-
-(defconst tramp-rclone-file-name-handler-alist '((access-file .
tramp-handle-access-file) (add-name-to-file . tramp-handle-add-name-to-file)
(copy-directory . tramp-handle-copy-directory) (copy-file .
tramp-rclone-handle-copy-file) (delete-directory .
tramp-rclone-handle-delete-directory) (delete-file .
tramp-rclone-handle-delete-file) (directory-file-name .
tramp-handle-directory-file-name) (directory-files .
tramp-rclone-handle-directory-files) (directory-files-and-attributes . tramp-h
[...]
-Alist of handler functions for Tramp RCLONE method.
-Operations not mentioned here will be handled by the default Emacs
primitives.")
-
-(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)))
-
-(autoload 'tramp-rclone-file-name-handler "tramp-rclone" "\
-Invoke the rclone handler for OPERATION and ARGS.
-First arg specifies the OPERATION, second arg is a list of arguments to
-pass to the OPERATION.
-
-\(fn OPERATION &rest ARGS)" nil nil)
-
-(tramp--with-startup (tramp-register-foreign-file-name-handler
#'tramp-rclone-file-name-p #'tramp-rclone-file-name-handler))
-
-(autoload 'tramp-rclone-parse-device-names "tramp-rclone" "\
-Return a list of (nil host) tuples allowed to access.
-
-\(fn IGNORE)" nil nil)
-
-;;;***
-
-;;;### (autoloads nil "tramp-sh" "tramp-sh.el" (0 0 0 0))
-;;; Generated autoloads from tramp-sh.el
-
-(defconst tramp-default-remote-shell "/bin/sh" "\
-The default remote shell Tramp applies.")
-
-(defvar 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' for
-out-of-band methods).
-If it is nil, no compression at all will be applied.")
-
-(custom-autoload 'tramp-inline-compress-start-size "tramp-sh" t)
-
-(defvar 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.")
-
-(custom-autoload 'tramp-copy-size-limit "tramp-sh" t)
-
-(defvar 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.")
-
-(custom-autoload 'tramp-terminal-type "tramp-sh" t)
-
-(defvar 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\".")
-
-(custom-autoload 'tramp-histfile-override "tramp-sh" t)
-
-(defconst tramp-display-escape-sequence-regexp "\33[[;0-9]+m" "\
-Terminal control escape sequences for display attributes.")
-
-(defconst tramp-initial-end-of-output "#$ " "\
-Prompt when establishing a connection.")
-
-(defvar tramp-use-ssh-controlmaster-options t "\
-Whether to use `tramp-ssh-controlmaster-options'.")
-
-(custom-autoload 'tramp-use-ssh-controlmaster-options "tramp-sh" t)
-
-(tramp--with-startup (add-to-list 'tramp-methods `("rcp" (tramp-login-program
"rsh") (tramp-login-args (("%h") ("-l" "%u"))) (tramp-remote-shell
,tramp-default-remote-shell) (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 ,tram [...]
-
-(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.")
-
-(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/hostkey [...]
-Default list of (FUNCTION FILE) pairs to be examined for ssh methods.")
-
-(defconst tramp-completion-function-alist-telnet '((tramp-parse-hosts
"/etc/hosts")) "\
-Default list of (FUNCTION FILE) pairs to be examined for telnet methods.")
-
-(defconst tramp-completion-function-alist-su '((tramp-parse-passwd
"/etc/passwd")) "\
-Default list of (FUNCTION FILE) pairs to be examined for su methods.")
-
-(defconst tramp-completion-function-alist-sg '((tramp-parse-etc-group
"/etc/group")) "\
-Default list of (FUNCTION FILE) pairs to be examined for sg methods.")
-
-(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--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- [...]
-
-(defvar 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'.")
-
-(custom-autoload 'tramp-remote-path "tramp-sh" t)
-
-(defvar 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.")
-
-(custom-autoload 'tramp-remote-process-environment "tramp-sh" t)
-
-(defvar tramp-sh-extra-args '(("/bash\\'" . "-noediting -norc -noprofile")
("/zsh\\'" . "-f +Z -V")) "\
-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. These arguments shall disable line editing, see
-`tramp-open-shell'.
-
-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.")
-
-(custom-autoload 'tramp-sh-extra-args "tramp-sh" t)
-
-(defconst tramp-sh-file-name-handler-alist '((access-file .
tramp-handle-access-file) (add-name-to-file . tramp-sh-handle-add-name-to-file)
(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)
(directory-file-name . tramp-handle-directory-file-name) (directory-files .
tramp-handle-directory-files) (directory-files-and-attributes .
tramp-sh-handle-director [...]
-Alist of handler functions.
-Operations not mentioned here will be handled by the normal Emacs functions.")
-
-(autoload 'tramp-sh-file-name-handler "tramp-sh" "\
-Invoke remote-shell Tramp file name handler.
-Fall back to normal file name handler if no Tramp handler exists.
-
-\(fn OPERATION &rest ARGS)" nil nil)
-
-(tramp--with-startup (tramp-register-foreign-file-name-handler #'identity
#'tramp-sh-file-name-handler 'append))
-
-(autoload 'tramp-convert-file-attributes "tramp-sh" "\
-Convert `file-attributes' ATTR generated by perl script, stat or ls.
-Convert file mode bits to string and set virtual device number.
-Return ATTR.
-
-\(fn VEC ATTR)" nil nil)
-
-;;;***
-
-;;;### (autoloads nil "tramp-smb" "tramp-smb.el" (0 0 0 0))
-;;; Generated autoloads from tramp-smb.el
-
-(defconst tramp-smb-method "smb" "\
-Method to connect SAMBA and M$ SMB servers.")
-
-(unless (memq system-type '(cygwin windows-nt)) (tramp--with-startup
(add-to-list 'tramp-methods `(,tramp-smb-method (tramp-tmpdir "/C$/Temp")
(tramp-case-insensitive t)))))
-
-(tramp--with-startup (add-to-list 'tramp-default-user-alist `(,(concat "\\`"
tramp-smb-method "\\'") nil nil)) (tramp-set-completion-function
tramp-smb-method '((tramp-parse-netrc "~/.netrc"))))
-
-(defvar tramp-smb-program "smbclient" "\
-Name of SMB client to run.")
-
-(custom-autoload 'tramp-smb-program "tramp-smb" t)
-
-(defvar tramp-smb-acl-program "smbcacls" "\
-Name of SMB acls to run.")
-
-(custom-autoload 'tramp-smb-acl-program "tramp-smb" t)
-
-(defvar 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.")
-
-(custom-autoload 'tramp-smb-conf "tramp-smb" t)
-
-(defvar tramp-smb-options nil "\
-List of additional options.
-They are added to the `tramp-smb-program' call via \"--option '...'\".
-
-For example, if the deprecated SMB1 protocol shall be used, add to
-this variable (\"client min protocol=NT1\") .")
-
-(custom-autoload 'tramp-smb-options "tramp-smb" t)
-
-(defconst tramp-smb-file-name-handler-alist '((access-file .
tramp-handle-access-file) (add-name-to-file .
tramp-smb-handle-add-name-to-file) (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) (directory-file-name .
tramp-handle-directory-file-name) (directory-files .
tramp-smb-handle-directory-files) (directory-files-and-attributes .
tramp-handle-d [...]
-Alist of handler functions for Tramp SMB method.
-Operations not mentioned here will be handled by the default Emacs
primitives.")
-
-(defvar 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.")
-
-(custom-autoload 'tramp-smb-winexe-program "tramp-smb" t)
-
-(defvar tramp-smb-winexe-shell-command "powershell.exe" "\
-Shell to be used for processes on remote machines.
-This must be Powershell V2 compatible.")
-
-(custom-autoload 'tramp-smb-winexe-shell-command "tramp-smb" t)
-
-(defvar 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.")
-
-(custom-autoload 'tramp-smb-winexe-shell-command-switch "tramp-smb" t)
-
-(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)))
-
-(autoload 'tramp-smb-file-name-handler "tramp-smb" "\
-Invoke the SMB related OPERATION and ARGS.
-First arg specifies the OPERATION, second arg is a list of arguments to
-pass to the OPERATION.
-
-\(fn OPERATION &rest ARGS)" nil nil)
-
-(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)))
-
-;;;***
-
-;;;### (autoloads nil "tramp-sudoedit" "tramp-sudoedit.el" (0 0 0
-;;;;;; 0))
-;;; Generated autoloads from tramp-sudoedit.el
-
-(defconst tramp-sudoedit-method "sudoedit" "\
-When this method name is used, call sudoedit for editing a file.")
-
-(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-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 . tramp-handle-copy-directory) (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-files . tramp-handle-directory-files) (directory-fi [...]
-Alist of handler functions for Tramp SUDOEDIT method.")
-
-(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)))
-
-(autoload 'tramp-sudoedit-file-name-handler "tramp-sudoedit" "\
-Invoke the SUDOEDIT handler for OPERATION and ARGS.
-First arg specifies the OPERATION, second arg is a list of arguments to
-pass to the OPERATION.
-
-\(fn OPERATION &rest ARGS)" nil nil)
-
-(tramp--with-startup (tramp-register-foreign-file-name-handler
#'tramp-sudoedit-file-name-p #'tramp-sudoedit-file-name-handler))
-
-;;;***
-
-;;;### (autoloads nil "tramp-uu" "tramp-uu.el" (0 0 0 0))
-;;; Generated autoloads from tramp-uu.el
-
-(autoload 'tramp-uuencode-region "tramp-uu" "\
-UU-encode the region between BEG and END.
-
-\(fn BEG END)" nil nil)
-
-;;;***
-
-;;;### (autoloads nil "trampver" "trampver.el" (0 0 0 0))
-;;; Generated autoloads from trampver.el
-
-(defconst tramp-version "2.4.4.4" "\
-This version of Tramp.")
-
-(defconst tramp-bug-report-address "tramp-devel@gnu.org" "\
-Email address to send bug reports to.")
-
-;;;***
-
-;;;### (autoloads nil nil ("tramp-compat.el" "tramp-integration.el"
-;;;;;; "tramp.el") (0 0 0 0))
-
-;;;***
-
-(provide 'tramp-loaddefs)
-;; Local Variables:
-;; version-control: never
-;; no-byte-compile: t
-;; no-update-autoloads: t
-;; coding: utf-8
-;; End:
-;;; tramp-loaddefs.el ends here
diff --git a/tramp-rclone.el b/tramp-rclone.el
index 1567a24..4790bb4 100644
--- a/tramp-rclone.el
+++ b/tramp-rclone.el
@@ -135,6 +135,8 @@
(start-file-process . ignore)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-get-remote-gid . ignore)
+ (tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore)
(unhandled-file-name-directory . ignore)
(vc-registered . ignore)
@@ -157,10 +159,9 @@ Operations not mentioned here will be handled by the
default Emacs primitives.")
"Invoke the rclone handler for OPERATION and ARGS.
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))))
+ (if-let ((fn (assoc operation tramp-rclone-file-name-handler-alist)))
+ (save-match-data (apply (cdr fn) args))
+ (tramp-run-real-handler operation args)))
;;;###tramp-autoload
(tramp--with-startup
@@ -220,7 +221,7 @@ file names."
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
- (not (tramp-compat-directory-name-p newname)))
+ (not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(if (or (and t1 (not (tramp-rclone-file-name-p filename)))
@@ -271,8 +272,8 @@ file names."
(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))
+ (setq filename (expand-file-name filename)
+ newname (expand-file-name newname))
;; At least one file a Tramp file?
(if (or (tramp-tramp-file-p filename)
(tramp-tramp-file-p newname))
@@ -288,19 +289,19 @@ file names."
(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-directory-properties v localname)
- (tramp-rclone-flush-directory-cache v)))
+ (tramp-rclone-flush-directory-cache v)
+ (delete-directory (tramp-rclone-local-file-name directory) recursive
trash)))
(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
+ (tramp-rclone-flush-directory-cache v)
(delete-file (tramp-rclone-local-file-name filename) trash)
- (tramp-flush-file-properties v localname)
- (tramp-rclone-flush-directory-cache v)))
+ (tramp-flush-file-properties v localname)))
(defun tramp-rclone-handle-directory-files
- (directory &optional full match nosort _count)
+ (directory &optional full match nosort count)
"Like `directory-files' for Tramp files."
(unless (file-exists-p directory)
(tramp-error
@@ -310,8 +311,8 @@ file names."
(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)))
+ (tramp-compat-directory-files
+ (tramp-rclone-local-file-name directory) full match nosort
count)))
;; Massage the result.
(when full
(let ((local (concat "^" (regexp-quote (tramp-rclone-mount-point v))))
@@ -429,8 +430,8 @@ file names."
(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))
+ (setq filename (expand-file-name filename)
+ newname (expand-file-name newname))
;; At least one file a Tramp file?
(if (or (tramp-tramp-file-p filename)
(tramp-tramp-file-p newname))
@@ -458,7 +459,7 @@ file names."
;; to cache a nil result.
(or (tramp-get-connection-property
(tramp-get-connection-process vec) "mounted" nil)
- (let* ((default-directory temporary-file-directory)
+ (let* ((default-directory (tramp-compat-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)
@@ -484,7 +485,8 @@ file names."
;; crash Emacs for some processes. So we use
;; "pidof", which might not work everywhere.
(if (<= emacs-major-version 25)
- (let ((default-directory temporary-file-directory))
+ (let ((default-directory
+ (tramp-compat-temporary-file-directory)))
(mapcar
#'string-to-number
(split-string
diff --git a/tramp-sh.el b/tramp-sh.el
index a70d3aa..0dbcb83 100644
--- a/tramp-sh.el
+++ b/tramp-sh.el
@@ -58,8 +58,7 @@ If it is nil, no compression at all will be applied."
;;;###tramp-autoload
(defcustom tramp-copy-size-limit 10240
- "The maximum file size where inline copying is preferred over an \
-out-of-the-band copy.
+ "Maximum file size where inline copying is preferred to 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))
@@ -91,10 +90,10 @@ the default storage location, e.g. \"$HOME/.sh_history\"."
(string :tag "Redirect to a file")))
;;;###tramp-autoload
-(defconst tramp-display-escape-sequence-regexp "\e[[;0-9]+m"
+(defconst tramp-display-escape-sequence-regexp "\e[[:digit:];[]+m"
"Terminal control escape sequences for display attributes.")
-(defconst tramp-device-escape-sequence-regexp "\e[[0-9]+n"
+(defconst tramp-device-escape-sequence-regexp "\e[[:digit:][]+n"
"Terminal control escape sequences for device status.")
;; ksh on OpenBSD 4.5 requires that $PS1 contains a `#' character for
@@ -118,7 +117,9 @@ detected as prompt when being sent on echoing hosts,
therefore.")
;;;###tramp-autoload
(defcustom tramp-use-ssh-controlmaster-options t
- "Whether to use `tramp-ssh-controlmaster-options'."
+ "Whether to use `tramp-ssh-controlmaster-options'.
+Set it to nil, if you use Control* or Proxy* options in your ssh
+configuration."
:group 'tramp
:version "24.4"
:type 'boolean)
@@ -242,14 +243,14 @@ The string is used in `tramp-methods'.")
(add-to-list 'tramp-methods
`("telnet"
(tramp-login-program "telnet")
- (tramp-login-args (("%h") ("%p") ("2>/dev/null")))
+ (tramp-login-args (("%h") ("%p") ("%n")))
(tramp-remote-shell ,tramp-default-remote-shell)
(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-login-args (("%h") ("%p") ("%n")))
(tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))
@@ -260,8 +261,7 @@ The string is used in `tramp-methods'.")
;; 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")))))
+ (tramp-remote-copy-args (("-l") ("-p" "%r") ("%n")))))
(add-to-list 'tramp-methods
`("su"
(tramp-login-program "su")
@@ -478,10 +478,11 @@ The string is used in `tramp-methods'.")
;; 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
+;; FreeBSD, DragonFly: /usr/bin:/bin:/usr/sbin:/sbin: - beware trailing ":"!
+;; FreeBSD 12.1, Darwin: /usr/bin:/bin:/usr/sbin:/sbin
;; IRIX64: /usr/bin
;; QNAP QTS: ---
+;; Hydra: /run/current-system/sw/bin:/bin:/usr/bin
;;;###tramp-autoload
(defcustom tramp-remote-path
'(tramp-default-remote-path "/bin" "/usr/bin" "/sbin" "/usr/sbin"
@@ -492,8 +493,8 @@ The string is used in `tramp-methods'.")
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.
+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
@@ -593,10 +594,12 @@ 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.")
+we have this shell function.
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-perl-file-truename
- "%s -e '
+ "%p -e '
use File::Spec;
use Cwd \"realpath\";
@@ -631,14 +634,14 @@ if (!$result) {
$result =~ s/\"/\\\\\"/g;
print \"\\\"$result\\\"\\n\";
-' \"$1\" 2>/dev/null"
+' \"$1\" %n"
"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.")
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-perl-file-name-all-completions
- "%s -e '
+ "%p -e '
opendir(d, $ARGV[0]) || die(\"$ARGV[0]: $!\\nfail\\n\");
@files = readdir(d); closedir(d);
foreach $f (@files) {
@@ -650,11 +653,11 @@ foreach $f (@files) {
}
}
print \"ok\\n\"
-' \"$1\" 2>/dev/null"
+' \"$1\" %n"
"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.")
+`file-name-all-completions' on the remote file system.
+Format specifiers are replaced by `tramp-expand-script', 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
@@ -663,7 +666,7 @@ passed to `format', so percent characters need to be
doubled.")
;; 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 '
+ "%p -e '
@stat = lstat($ARGV[0]);
if (!@stat) {
print \"nil\\n\";
@@ -700,14 +703,14 @@ printf(
$stat[7],
$stat[2],
$stat[1]
-);' \"$1\" \"$2\" 2>/dev/null"
+);' \"$1\" \"$2\" %n"
"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.")
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-perl-directory-files-and-attributes
- "%s -e '
+ "%p -e '
chdir($ARGV[0]) or printf(\"\\\"Cannot change to $ARGV[0]: $''!''\\\"\\n\"),
exit();
opendir(DIR,\".\") or printf(\"\\\"Cannot open directory $ARGV[0]:
$''!''\\\"\\n\"), exit();
@list = readdir(DIR);
@@ -752,31 +755,31 @@ for($i = 0; $i < $n; $i++)
$stat[2],
$stat[1]);
}
-printf(\")\\n\");' \"$1\" \"$2\" 2>/dev/null"
+printf(\")\\n\");' \"$1\" \"$2\" %n"
"Perl script implementing `directory-files-and-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.")
+Format specifiers are replaced by `tramp-expand-script', 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"
+ "%p -MMIME::Base64 -0777 -ne 'print encode_base64($_)' %n"
"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.")
+on the remote host.
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-perl-decode-with-module
- "%s -MMIME::Base64 -0777 -ne 'print decode_base64($_)' 2>/dev/null"
+ "%p -MMIME::Base64 -0777 -ne 'print decode_base64($_)' %n"
"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.")
+on the remote host.
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-perl-encode
- "%s -e '
+ "%p -e '
# This script contributed by Juanma Barranquero <lektu@terra.es>.
# Copyright (C) 2002-2020 Free Software Foundation, Inc.
use strict;
@@ -809,13 +812,13 @@ while (read STDIN, $data, 54) {
(substr(unpack(q(B*), $data) . q(00000), 0, 432) =~ /....../g)),
$pad,
qq(\\n);
-}' 2>/dev/null"
+}' %n"
"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.")
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-perl-decode
- "%s -e '
+ "%p -e '
# This script contributed by Juanma Barranquero <lektu@terra.es>.
# Copyright (C) 2002-2020 Free Software Foundation, Inc.
use strict;
@@ -853,24 +856,27 @@ while (my $data = <STDIN>) {
((join q(), map {$trans{$_} || q()} split //, $chunk) =~ /......../g);
last if $finished;
-}' 2>/dev/null"
+}' %n"
"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.")
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-perl-pack
- "%s -e 'binmode STDIN; binmode STDOUT; print pack(q{u*}, join q{}, <>)'"
+ "%p -e 'binmode STDIN; binmode STDOUT; print pack(q{u*}, join q{}, <>)' %n"
"Perl program to use for encoding a file.
-Escape sequence %s is replaced with name of Perl binary.")
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-perl-unpack
- "%s -e 'binmode STDIN; binmode STDOUT; print unpack(q{u*}, join q{}, <>)'"
+ "%p -e 'binmode STDIN; binmode STDOUT; print unpack(q{u*}, join q{}, <>)' %n"
"Perl program to use for decoding a file.
-Escape sequence %s is replaced with name of Perl binary.")
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-hexdump-encode "%h -v -e '16/1 \" %%02x\" \"\\n\"'"
"`hexdump' program to use for encoding a file.
-This string is passed to `format', so percent characters need to be doubled.")
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-awk-encode
"%a '\\
@@ -904,21 +910,24 @@ END {
printf tail
}'"
"`awk' program to use for encoding a file.
-This string is passed to `format', so percent characters need to be doubled.")
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-hexdump-awk-encode
(format "%s | %s" tramp-hexdump-encode tramp-awk-encode)
"`hexdump' / `awk' pipe to use for encoding a file.
-This string is passed to `format', so percent characters need to be doubled.")
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-od-encode "%o -v -t x1 -A n"
"`od' program to use for encoding a file.
-This string is passed to `format', so percent characters need to be doubled.")
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
-(defconst tramp-od-awk-encode
- (format "%s | %s" tramp-od-encode tramp-awk-encode)
+(defconst tramp-od-awk-encode (format "%s | %s" tramp-od-encode
tramp-awk-encode)
"`od' / `awk' pipe to use for encoding a file.
-This string is passed to `format', so percent characters need to be doubled.")
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-awk-decode
"%a '\\
@@ -935,7 +944,7 @@ BEGIN {
if (o) {
printf \"%%c\", o
} else {
- system(\"dd if=/dev/zero bs=1 count=1 2>/dev/null\")
+ system(\"dd if=/dev/zero bs=1 count=1 %n\")
}
obc=0; o=0
}
@@ -944,7 +953,8 @@ BEGIN {
}
}'"
"Awk program to use for decoding a file.
-This string is passed to `format', so percent characters need to be doubled.")
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-vc-registered-read-file-names
"echo \"(\"
@@ -966,7 +976,8 @@ echo \")\""
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.")
+of command line.
+Format specifiers \"%s\" are replaced before the script is used.")
;; New handlers should be added here.
;;;###tramp-autoload
@@ -1039,6 +1050,8 @@ of command line.")
(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-get-remote-gid . tramp-sh-handle-get-remote-gid)
+ (tramp-get-remote-uid . tramp-sh-handle-get-remote-uid)
(tramp-set-file-uid-gid . tramp-sh-handle-set-file-uid-gid)
(unhandled-file-name-directory . ignore)
(vc-registered . tramp-sh-handle-vc-registered)
@@ -1116,8 +1129,7 @@ component is used as the target of the symlink."
"Like `file-truename' for Tramp files."
;; Preserve trailing "/".
(funcall
- (if (tramp-compat-directory-name-p filename)
- #'file-name-as-directory #'identity)
+ (if (directory-name-p filename) #'file-name-as-directory #'identity)
;; Quote properly.
(funcall
(if (tramp-compat-file-name-quoted-p filename)
@@ -1154,59 +1166,9 @@ component is used as the target of the symlink."
(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"
- (string-join
- (append '("") (reverse result) (list thisstep)) "/"))
- (setq symlink-target
- (tramp-compat-file-attribute-type
- (file-attributes
- (tramp-make-tramp-file-name
- v
- (string-join
- (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 (string-join (cons "" result) "/") "/"))
- (when (string-empty-p result) (setq result "/")))))
+ (t (setq
+ result
+ (tramp-file-local-name (tramp-handle-file-truename filename)))))
;; Detect cycle.
(when (and (file-symlink-p filename)
@@ -1378,13 +1340,12 @@ component is used as the target of the symlink."
(tramp-send-command-and-read
vec
(format
- (eval-when-compile
- (concat
- ;; 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 -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')"))
+ (concat
+ ;; 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 -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')")
(tramp-get-remote-stat vec)
tramp-stat-marker tramp-stat-marker
(if (eq id-format 'integer)
@@ -1474,17 +1435,24 @@ of."
;; 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 &optional _flag)
+(defun tramp-sh-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
(with-parsed-tramp-file-name filename nil
- (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)))
+ ;; We need "chmod -h" when the flag is set.
+ (when (or (not (eq flag 'nofollow))
+ (not (file-symlink-p filename))
+ (tramp-get-remote-chmod-h v))
+ (tramp-flush-file-properties v localname)
+ ;; FIXME: extract the proper text from chmod's stderr.
+ (tramp-barf-unless-okay
+ v
+ (format
+ "chmod %s %o %s"
+ (if (and (eq flag 'nofollow) (tramp-get-remote-chmod-h v)) "-h" "")
+ mode (tramp-shell-quote-argument localname))
+ "Error while changing file's mode %s" filename))))
-(defun tramp-sh-handle-set-file-times (filename &optional time _flag)
+(defun tramp-sh-handle-set-file-times (filename &optional time flag)
"Like `set-file-times' for Tramp files."
(with-parsed-tramp-file-name filename nil
(when (tramp-get-remote-touch v)
@@ -1497,13 +1465,34 @@ of."
time)))
(tramp-send-command-and-check
v (format
- "env TZ=UTC %s %s %s"
+ "env TZ=UTC %s %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))
"")
+ (if (eq flag 'nofollow) "-h" "")
(tramp-shell-quote-argument localname)))))))
+(defun tramp-sh-handle-get-remote-uid (vec id-format)
+ "The uid of the remote connection VEC, in ID-FORMAT.
+ID-FORMAT valid values are `string' and `integer'."
+ (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)))))
+
+(defun tramp-sh-handle-get-remote-gid (vec id-format)
+ "The gid of the remote connection VEC, in ID-FORMAT.
+ID-FORMAT valid values are `string' and `integer'."
+ (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)))))
+
(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
@@ -1527,7 +1516,7 @@ of."
(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"
+ (with-tramp-connection-property (tramp-get-process vec) "selinux-p"
(tramp-send-command-and-check vec "selinuxenabled")))
(defun tramp-sh-handle-file-selinux-context (filename)
@@ -1535,9 +1524,8 @@ of."
(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_]+\\)"))))
+ (regexp (concat "\\([[:alnum:]_]+\\):" "\\([[:alnum:]_]+\\):"
+ "\\([[:alnum:]_]+\\):" "\\([[:alnum:]_]+\\)")))
(when (and (tramp-remote-selinux-p v)
(tramp-send-command-and-check
v (format
@@ -1576,7 +1564,7 @@ of."
(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"
+ (with-tramp-connection-property (tramp-get-process vec) "acl-p"
(tramp-send-command-and-check vec "getfacl /")))
(defun tramp-sh-handle-file-acl (filename)
@@ -1706,8 +1694,10 @@ of."
(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)))
+ (with-tramp-file-property
+ v localname
+ (format "file-ownership-preserved-p%s" (if group "-group" ""))
+ (let ((attributes (file-attributes filename 'integer)))
;; 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)
@@ -1721,7 +1711,7 @@ of."
;; Directory listings.
(defun tramp-sh-handle-directory-files-and-attributes
- (directory &optional full match nosort id-format _count)
+ (directory &optional full match nosort id-format count)
"Like `directory-files-and-attributes' for Tramp files."
(unless id-format (setq id-format 'integer))
(unless (file-exists-p directory)
@@ -1756,13 +1746,18 @@ of."
(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)))))
+ (unless nosort
+ (setq result (sort result (lambda (x y) (string< (car x) (car y))))))
+
+ (when (and (natnump count) (> count 0))
+ (setq result (nbutlast result (- (length result) count))))
+
+ (or result
;; The scripts could fail, for example with huge file size.
(tramp-handle-directory-files-and-attributes
- directory full match nosort id-format)))))
+ directory full match nosort id-format count)))))
+;; FIXME: Fix function to work with count parameter.
(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."
@@ -1778,6 +1773,7 @@ of."
(when (stringp object) (tramp-error vec 'file-error object))
object))
+;; FIXME: Fix function to work with count parameter.
(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."
@@ -1785,21 +1781,19 @@ of."
(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.
- ;; Therefore, we use \000 as file separator.
- ;; `tramp-sh--quoting-style-options' do not work for file names
- ;; with spaces piped to "xargs".
- ;; 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 | tr '\\n\\r' '\\000\\000' | "
- "xargs -0 %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 \")\""))
+ (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. Therefore, we use
+ ;; \000 as file separator. `tramp-sh--quoting-style-options' do
+ ;; not work for file names with spaces piped to "xargs".
+ ;; 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 | tr '\\n\\r' '\\000\\000' | "
+ "xargs -0 %s -c "
+ "'(%s%%n%s (%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' "
+ "-- 2>%s | 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
@@ -1815,6 +1809,7 @@ of."
"%g"
(eval-when-compile (concat tramp-stat-marker "%G" tramp-stat-marker)))
tramp-stat-marker tramp-stat-marker
+ (tramp-get-remote-null-device vec)
tramp-stat-quoted-marker)))
;; This function should return "foo/" for directories and "bar" for
@@ -1840,16 +1835,17 @@ of."
(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"))
+ (format (concat
+ "(cd %s 2>&1 && %s -a 2>%s"
+ " | while IFS= read f; do"
+ " if %s -d \"$f\" 2>%s;"
+ " 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))))
+ (tramp-get-remote-null-device v)
+ (tramp-get-test-command v)
+ (tramp-get-remote-null-device v))))
;; Now grab the output.
(with-current-buffer (tramp-get-buffer v)
@@ -1954,7 +1950,7 @@ tramp-sh-handle-file-name-all-completions: internal error
accessing `%s': `%s'"
;; scp or rsync DTRT.
(progn
(when (and (file-directory-p newname)
- (not (tramp-compat-directory-name-p newname)))
+ (not (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)))
@@ -1967,7 +1963,7 @@ tramp-sh-handle-file-name-all-completions: internal error
accessing `%s': `%s'"
(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))
+ 'copy dirname newname 'ok-if-already-exists keep-date))
;; We must do it file-wise.
(tramp-run-real-handler
@@ -1984,8 +1980,8 @@ tramp-sh-handle-file-name-all-completions: internal error
accessing `%s': `%s'"
"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))
+ (setq filename (expand-file-name filename)
+ newname (expand-file-name newname))
;; At least one file a Tramp file?
(if (or (tramp-tramp-file-p filename)
(tramp-tramp-file-p newname))
@@ -2036,7 +2032,7 @@ file names."
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
- (not (tramp-compat-directory-name-p newname)))
+ (not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(with-tramp-progress-reporter
@@ -2063,7 +2059,7 @@ file names."
(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))
+ op filename newname ok-if-already-exists keep-date))
;; No shortcut was possible. So we copy the file
;; first. If the operation was `rename', we go back
@@ -2076,7 +2072,7 @@ file names."
;; source and target file.
(t
(tramp-do-copy-or-rename-file-via-buffer
- op filename newname keep-date))))))
+ op filename newname ok-if-already-exists keep-date))))))
;; One file is a Tramp file, the other one is local.
((or t1 t2)
@@ -2091,11 +2087,11 @@ file names."
;; 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))
+ op filename newname ok-if-already-exists keep-date))
;; Use the inline method via a Tramp buffer.
(t (tramp-do-copy-or-rename-file-via-buffer
- op filename newname keep-date))))
+ op filename newname ok-if-already-exists keep-date))))
(t
;; One of them must be a Tramp file.
@@ -2117,7 +2113,8 @@ file names."
(with-parsed-tramp-file-name newname v2
(tramp-flush-file-properties v2 v2-localname))))))))
-(defun tramp-do-copy-or-rename-file-via-buffer (op filename newname keep-date)
+(defun tramp-do-copy-or-rename-file-via-buffer
+ (op filename newname ok-if-already-exists 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.
@@ -2145,10 +2142,11 @@ KEEP-DATE is non-nil if NEWNAME should have the same
timestamp as FILENAME."
(insert-file-contents-literally filename)))
;; KEEP-DATE handling.
(when keep-date
- (set-file-times
+ (tramp-compat-set-file-times
newname
(tramp-compat-file-attribute-modification-time
- (file-attributes filename))))
+ (file-attributes filename))
+ (unless ok-if-already-exists 'nofollow)))
;; Set the mode.
(set-file-modes newname (tramp-default-file-modes filename))
;; If the operation was `rename', delete the original file.
@@ -2236,7 +2234,7 @@ the uid and gid from FILENAME."
(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)
+ ok-if-already-exists keep-date preserve-uid-gid)
;; We must change the ownership to the local user.
(tramp-set-file-uid-gid
(concat prefix localname2)
@@ -2302,10 +2300,12 @@ the uid and gid from FILENAME."
;; Set the time and mode. Mask possible errors.
(ignore-errors
(when keep-date
- (set-file-times newname file-times)
+ (tramp-compat-set-file-times
+ newname file-times (unless ok-if-already-exists 'nofollow))
(set-file-modes newname file-modes))))))
-(defun tramp-do-copy-or-rename-file-out-of-band (op filename newname keep-date)
+(defun tramp-do-copy-or-rename-file-out-of-band
+ (op filename newname ok-if-already-exists keep-date)
"Invoke `scp' program to copy.
The method used must be an out-of-band method."
(let* ((t1 (tramp-tramp-file-p filename))
@@ -2328,9 +2328,9 @@ The method used must be an out-of-band method."
(unwind-protect
(progn
(tramp-do-copy-or-rename-file-out-of-band
- op filename tmpfile keep-date)
+ op filename tmpfile ok-if-already-exists keep-date)
(tramp-do-copy-or-rename-file-out-of-band
- 'rename tmpfile newname keep-date))
+ 'rename tmpfile newname ok-if-already-exists keep-date))
;; Save exit.
(ignore-errors
(if dir-flag
@@ -2373,7 +2373,8 @@ The method used must be an out-of-band method."
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 " " ""))
+ ?k (if keep-date " " "")
+ ?n (concat "2>" (tramp-get-remote-null-device v)))
copy-program (tramp-get-method-parameter v 'tramp-copy-program)
copy-keep-date (tramp-get-method-parameter
v 'tramp-copy-keep-date)
@@ -2504,10 +2505,11 @@ The method used must be an out-of-band method."
;; Handle KEEP-DATE argument.
(when (and keep-date (not copy-keep-date))
- (set-file-times
+ (tramp-compat-set-file-times
newname
(tramp-compat-file-attribute-modification-time
- (file-attributes filename))))
+ (file-attributes filename))
+ (unless ok-if-already-exists 'nofollow)))
;; Set the mode.
(unless (and keep-date copy-keep-date)
@@ -2539,13 +2541,10 @@ The method used must be an out-of-band method."
(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-directory-properties v localname)
+ (tramp-skeleton-delete-directory directory recursive trash
(tramp-barf-unless-okay
v (format "cd / && %s %s"
- (or (and trash (tramp-get-remote-trash v))
- (if recursive "rm -rf" "rmdir"))
+ (if recursive "rm -rf" "rmdir")
(tramp-shell-quote-argument localname))
"Couldn't delete %s" directory)))
@@ -2554,11 +2553,11 @@ The method used must be an out-of-band method."
(setq filename (expand-file-name filename))
(with-parsed-tramp-file-name filename nil
(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)))
+ (if (and delete-by-moving-to-trash trash)
+ (move-file-to-trash filename)
+ (tramp-barf-unless-okay
+ v (format "rm -f %s" (tramp-shell-quote-argument localname))
+ "Couldn't delete %s" filename))))
;; Dired.
@@ -2642,12 +2641,13 @@ The method used must be an out-of-band method."
(if full-directory-p
(tramp-send-command
v
- (format "%s %s %s 2>/dev/null"
+ (format "%s %s %s 2>%s"
(tramp-get-ls-command v)
switches
(if wildcard
localname
- (tramp-shell-quote-argument (concat localname ".")))))
+ (tramp-shell-quote-argument (concat localname ".")))
+ (tramp-get-remote-null-device v)))
(tramp-barf-unless-okay
v
(format "cd %s" (tramp-shell-quote-argument
@@ -2658,7 +2658,7 @@ The method used must be an out-of-band method."
(tramp-run-real-handler #'file-name-directory (list localname))))
(tramp-send-command
v
- (format "%s %s %s 2>/dev/null"
+ (format "%s %s %s 2>%s"
(tramp-get-ls-command v)
switches
(if (or wildcard
@@ -2668,7 +2668,8 @@ The method used must be an out-of-band method."
""
(tramp-shell-quote-argument
(tramp-run-real-handler
- #'file-name-nondirectory (list localname)))))))
+ #'file-name-nondirectory (list localname))))
+ (tramp-get-remote-null-device v))))
(save-restriction
(let ((beg (point)))
@@ -2704,15 +2705,44 @@ The method used must be an out-of-band method."
;; 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))
+ (save-excursion
+ (goto-char beg)
+ (while
+ (re-search-forward tramp-display-escape-sequence-regexp nil t)
+ (replace-match ""))))
+
+ ;; Now decode what read if necessary. Stolen from
`insert-directory'.
+ (let ((coding (or coding-system-for-read
+ file-name-coding-system
+ default-file-name-coding-system
+ 'undecided))
+ coding-no-eol
+ val pos)
+ (when (and enable-multibyte-characters
+ (not (memq (coding-system-base coding)
+ '(raw-text no-conversion))))
+ ;; If no coding system is specified or detection is
+ ;; requested, detect the coding.
+ (if (eq (coding-system-base coding) 'undecided)
+ (setq coding (detect-coding-region beg (point) t)))
+ (if (not (eq (coding-system-base coding) 'undecided))
+ (save-restriction
+ (setq coding-no-eol
+ (coding-system-change-eol-conversion coding 'unix))
+ (narrow-to-region beg (point))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (setq pos (point)
+ val (get-text-property (point) 'dired-filename))
+ (goto-char (next-single-property-change
+ (point) 'dired-filename nil (point-max)))
+ ;; Force no eol conversion on a file name, so
+ ;; that CR is preserved.
+ (decode-coding-region pos (point)
+ (if val coding-no-eol coding))
+ (if val
+ (put-text-property pos (point)
+ 'dired-filename t)))))))
;; The inserted file could be from somewhere else.
(when (and (not wildcard) (not full-directory-p))
@@ -2720,7 +2750,7 @@ The method used must be an out-of-band method."
(when (file-symlink-p filename)
(goto-char (search-backward "->" beg 'noerror)))
(search-backward
- (if (tramp-compat-directory-name-p filename)
+ (if (directory-name-p filename)
"."
(file-name-nondirectory filename))
beg 'noerror)
@@ -2730,12 +2760,11 @@ The method used must be an out-of-band method."
(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))))
+ (when-let ((available (get-free-disk-space ".")))
+ ;; Replace "total" with "total used", to avoid confusion.
+ (replace-match "\\1 used in directory")
+ (end-of-line)
+ (insert " available " available)))
(goto-char (point-max)))))))
@@ -2806,225 +2835,239 @@ the result will be a local, non-Tramp, file name."
;; terminated.
(defun tramp-sh-handle-make-process (&rest args)
"Like `make-process' for Tramp files.
-STDERR can also be a file name."
- (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 (or (null command) (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)))
- (when (and (stringp stderr) (tramp-tramp-file-p stderr)
- (not (tramp-equal-remote default-directory stderr)))
- (signal 'file-error (list "Wrong stderr" 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 can also be a file name.
- (tmpstderr
- (and stderr
- (if (and (stringp stderr) (tramp-tramp-file-p stderr))
- (tramp-unquote-file-local-name stderr)
- (tramp-make-tramp-temp-file v))))
- (remote-tmpstderr
- (and tmpstderr (tramp-make-tramp-file-name v tmpstderr)))
- (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)
- (= (length args) 2)
- (string-equal "-c" (car args))
- ;; Don't if there is a string.
- (not (string-match-p "'\\|\"" (cadr args)))))
- ;; 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))
+STDERR can also be a file name. If connection property
+\"direct-async-process\" is non-nil, an alternative
+implementation will be used."
+ (if (tramp-direct-async-process-p args)
+ (apply #'tramp-handle-make-process args)
+ (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 (or (null command) (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 #'bufferp stderr)))
+ (when (and (stringp stderr) (tramp-tramp-file-p stderr)
+ (not (tramp-equal-remote default-directory stderr)))
+ (signal 'file-error (list "Wrong stderr" 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 can also be a file name.
+ (tmpstderr
+ (and stderr
+ (if (and (stringp stderr) (tramp-tramp-file-p stderr))
+ (tramp-unquote-file-local-name stderr)
+ (tramp-make-tramp-temp-file v))))
+ (remote-tmpstderr
+ (and tmpstderr (tramp-make-tramp-file-name v tmpstderr)))
+ (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)
+ (= (length args) 2)
+ (string-equal "-c" (car args))
+ ;; Don't if there is a string.
+ (not (string-match-p "'\\|\"" (cadr args)))))
+ ;; 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)
+ (setenv-internal
+ env "INSIDE_EMACS"
+ (concat (or (getenv "INSIDE_EMACS") emacs-version)
+ ",tramp:" tramp-version)
+ 'keep)
+ (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))
+ (coding-system-for-write
+ (if (symbolp coding) coding (car coding)))
+ (coding-system-for-read
+ (if (symbolp coding) coding (cdr coding))))
+ (clear-visited-file-modtime)
(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)))
- ;; We must flush them here already; otherwise
- ;; `rename-file', `delete-file' or
- ;; `insert-file-contents' will fail.
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer")
- ;; Copy tmpstderr file.
- (when (and (stringp stderr)
- (not (tramp-tramp-file-p stderr)))
- (add-function
- :after (process-sentinel p)
- (lambda (_proc _msg)
- (rename-file remote-tmpstderr stderr))))
- ;; Provide error buffer. This shows only
- ;; initial error messages; messages arriving
- ;; later on will be inserted when the process is
- ;; deleted. The temporary file will exist until
- ;; the process is deleted.
- (when (bufferp stderr)
- (with-current-buffer stderr
- (insert-file-contents-literally remote-tmpstderr))
- ;; Delete tmpstderr file.
- (add-function
- :after (process-sentinel p)
- (lambda (_proc _msg)
- (when (file-exists-p remote-tmpstderr)
- (with-current-buffer stderr
- (insert-file-contents-literally
- remote-tmpstderr nil nil nil 'replace))
- (delete-file remote-tmpstderr)))))
- ;; Return process.
- p)))
+ ;; 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)))
+ ;; We must flush them here already; otherwise
+ ;; `rename-file', `delete-file' or
+ ;; `insert-file-contents' will fail.
+ (tramp-flush-connection-property v "process-name")
+ (tramp-flush-connection-property v "process-buffer")
+ ;; Copy tmpstderr file.
+ (when (and (stringp stderr)
+ (not (tramp-tramp-file-p stderr)))
+ (add-function
+ :after (process-sentinel p)
+ (lambda (_proc _msg)
+ (rename-file remote-tmpstderr stderr))))
+ ;; Provide error buffer. This shows only
+ ;; initial error messages; messages arriving
+ ;; later on will be inserted when the process
+ ;; is deleted. The temporary file will exist
+ ;; until the process is deleted.
+ (when (bufferp stderr)
+ (with-current-buffer stderr
+ (insert-file-contents-literally remote-tmpstderr))
+ ;; Delete tmpstderr file.
+ (add-function
+ :after (process-sentinel p)
+ (lambda (_proc _msg)
+ (when (file-exists-p remote-tmpstderr)
+ (with-current-buffer stderr
+ (insert-file-contents-literally
+ remote-tmpstderr nil nil nil 'replace))
+ (delete-file remote-tmpstderr)))))
+ ;; 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"))))))))
+ ;; 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-get-signal-strings (vec)
"Strings to return by `process-file' in case of signals."
@@ -3105,6 +3148,11 @@ STDERR can also be a file name."
(if (tramp-get-env-with-u-option v)
(setq env (append `("-u" ,elt) env))
(setq uenv (cons elt uenv))))))
+ (setenv-internal
+ env "INSIDE_EMACS"
+ (concat (or (getenv "INSIDE_EMACS") emacs-version)
+ ",tramp:" tramp-version)
+ 'keep)
(when env
(setq command
(format
@@ -3117,7 +3165,7 @@ STDERR can also be a file name."
(mapconcat #'tramp-shell-quote-argument uenv " ") command)))
;; Determine input.
(if (null infile)
- (setq input "/dev/null")
+ (setq input (tramp-get-remote-null-device v))
(setq infile (expand-file-name infile))
(if (tramp-equal-remote default-directory infile)
;; INFILE is on the same remote host.
@@ -3159,7 +3207,7 @@ STDERR can also be a file name."
tmpstderr (tramp-make-tramp-file-name v stderr 'nohop))))
;; stderr to be discarded.
((null (cadr destination))
- (setq stderr "/dev/null"))))
+ (setq stderr (tramp-get-remote-null-device v)))))
;; 't
(destination
(setq outbuf (current-buffer))))
@@ -3262,7 +3310,9 @@ STDERR can also be a file name."
;; correctly. Unset `file-name-handler-alist'.
;; Otherwise, epa-file gets confused.
(let (file-name-handler-alist
- (coding-system-for-write 'binary))
+ (coding-system-for-write 'binary)
+ (default-directory
+ (tramp-compat-temporary-file-directory)))
(with-temp-file tmpfile
(set-buffer-multibyte nil)
(insert-buffer-substring (tramp-get-buffer v))
@@ -3333,7 +3383,8 @@ STDERR can also be a file name."
#'write-region
(list start end localname append 'no-message lockname))
- (let* ((modes (save-excursion (tramp-default-file-modes filename)))
+ (let* ((modes (tramp-default-file-modes
+ filename (and (eq mustbenew 'excl) 'nofollow)))
;; 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
@@ -3452,9 +3503,8 @@ STDERR can also be a file name."
loc-enc tmpfile t))
(tramp-error
v 'file-error
- (eval-when-compile
- (concat "Cannot write to `%s', "
- "local encoding command `%s' failed"))
+ (concat "Cannot write to `%s', "
+ "local encoding command `%s' failed")
filename loc-enc))))
;; Send buffer into remote decoding command which
@@ -3499,9 +3549,8 @@ STDERR can also be a file name."
(buffer-string))))
(tramp-error
v 'file-error
- (eval-when-compile
- (concat "Couldn't write region to `%s',"
- " decode using `%s' failed"))
+ (concat "Couldn't write region to `%s',"
+ " decode using `%s' failed")
filename rem-dec)))))
;; Save exit.
@@ -3511,14 +3560,13 @@ STDERR can also be a file name."
(t
(tramp-error
v 'file-error
- (eval-when-compile
- (concat "Method `%s' should specify both encoding and "
- "decoding command or an scp program"))
+ (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))))
+ (setq last-coding-system-used coding-system-used))))
(tramp-flush-file-properties v localname)
@@ -3532,7 +3580,8 @@ STDERR can also be a file name."
;; 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))
+ (or (tramp-compat-file-attribute-modification-time file-attr)
+ (current-time)))
(when (and (= (tramp-compat-file-attribute-user-id file-attr) uid)
(= (tramp-compat-file-attribute-group-id file-attr)
gid))
(setq need-chown nil))))
@@ -3566,8 +3615,7 @@ STDERR can also be a file name."
(defun tramp-sh-handle-vc-registered (file)
"Like `vc-registered' for Tramp files."
(when vc-handled-backends
- (let ((tramp-message-show-message
- (and (not revert-buffer-in-progress-p) tramp-message-show-message))
+ (let ((inhibit-message (or revert-buffer-in-progress-p inhibit-message))
(temp-message (unless revert-buffer-in-progress-p "")))
(with-temp-message temp-message
(with-parsed-tramp-file-name file nil
@@ -3626,27 +3674,30 @@ STDERR can also be a file name."
;; 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)
+ (let ((vc-handled-backends (copy-sequence 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)
+ (when (and
+ (memq 'Bzr vc-handled-backends)
+ (or (not (require 'vc-bzr nil 'noerror))
(not (with-tramp-connection-property v vc-bzr-program
(tramp-find-executable
- v vc-bzr-program (tramp-get-remote-path v)))))
+ 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)
+ (when (and
+ (memq 'Git vc-handled-backends)
+ (or (not (require 'vc-git nil 'noerror))
(not (with-tramp-connection-property v vc-git-program
(tramp-find-executable
- v vc-git-program (tramp-get-remote-path v)))))
+ 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)
+ (when (and
+ (memq 'Hg vc-handled-backends)
+ (or (not (require 'vc-hg nil 'noerror))
(not (with-tramp-connection-property v vc-hg-program
(tramp-find-executable
- v vc-hg-program (tramp-get-remote-path v)))))
+ v vc-hg-program (tramp-get-remote-path v))))))
(setq vc-handled-backends (remq 'Hg vc-handled-backends)))
;; Run.
(tramp-with-demoted-errors
@@ -3657,10 +3708,17 @@ STDERR can also be a file name."
(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))))
+ (if-let ((fn (assoc operation tramp-sh-file-name-handler-alist)))
+ (save-match-data (apply (cdr fn) args))
+ (tramp-run-real-handler operation args)))
+
+;;;###tramp-autoload
+(defun tramp-sh-file-name-handler-p (vec)
+ "Whether VEC uses a method from `tramp-sh-file-name-handler'."
+ (and (assoc (tramp-file-name-method vec) tramp-methods)
+ (eq (tramp-find-foreign-file-name-handler
+ (tramp-make-tramp-file-name vec nil 'nohop))
+ 'tramp-sh-file-name-handler)))
;; This must be the last entry, because `identity' always matches.
;;;###tramp-autoload
@@ -3712,19 +3770,17 @@ Fall back to normal file name handler if no Tramp
handler exists."
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")))
+ (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")))
+ (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)))
+ (lambda (x) (intern-soft (tramp-compat-string-replace "_" "-"
x)))
(split-string events "," 'omit))))
;; "gio monitor".
((setq command (tramp-get-remote-gio-monitor v))
@@ -3782,6 +3838,10 @@ Fall back to normal file name handler if no Tramp
handler exists."
(unless (process-live-p p)
(tramp-error
p 'file-notify-error "Monitoring not supported for `%s'" file-name))
+ ;; Set "gio-file-monitor" property if needed.
+ (when (string-equal (file-name-nondirectory command) "gio")
+ (tramp-set-connection-property
+ p "gio-file-monitor" (tramp-get-remote-gio-file-monitor v)))
p))))
(defun tramp-sh-gio-monitor-process-filter (proc string)
@@ -3796,11 +3856,11 @@ Fall back to normal file name handler if no Tramp
handler exists."
(tramp-message proc 6 "%S\n%s" proc string)
(setq string (concat rest-string string)
;; Fix action names.
- string (replace-regexp-in-string
+ string (tramp-compat-string-replace
"attributes changed" "attribute-changed" string)
- string (replace-regexp-in-string
+ string (tramp-compat-string-replace
"changes done" "changes-done-hint" string)
- string (replace-regexp-in-string
+ string (tramp-compat-string-replace
"renamed to" "moved" string))
;; https://bugs.launchpad.net/bugs/1742946
(when
@@ -3808,7 +3868,7 @@ Fall back to normal file name handler if no Tramp handler
exists."
(delete-process proc))
;; Delete empty lines.
- (setq string (replace-regexp-in-string "\n\n" "\n" string))
+ (setq string (tramp-compat-string-replace "\n\n" "\n" string))
(while (string-match
(eval-when-compile
@@ -3856,16 +3916,15 @@ Fall back to normal file name handler if no Tramp
handler exists."
(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
+ string (tramp-compat-string-replace
"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]+"))
+ (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))
@@ -3874,7 +3933,7 @@ Fall back to normal file name handler if no Tramp handler
exists."
proc
(list
(intern-soft
- (replace-regexp-in-string
+ (tramp-compat-string-replace
"_" "-" (downcase (match-string 4 string)))))
;; File names are returned as absolute paths. We must
;; add the remote prefix.
@@ -3901,10 +3960,9 @@ Fall back to normal file name handler if no Tramp
handler exists."
(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]+\\)\\)?"))
+ (concat "^[^[:blank:]]+"
+ "[[:blank:]]+\\([^[:blank:]]+\\)"
+ "\\([[:blank:]]+\\([^\n\r]+\\)\\)?")
line)
(tramp-error proc 'file-notify-error "%s" line))
@@ -3914,7 +3972,7 @@ Fall back to normal file name handler if no Tramp handler
exists."
(mapcar
(lambda (x)
(intern-soft
- (replace-regexp-in-string "_" "-" (downcase x))))
+ (tramp-compat-string-replace "_" "-" (downcase x))))
(split-string (match-string 1 line) "," 'omit))
(or (match-string 3 line)
(file-name-nondirectory (process-get proc 'watch-name))))))
@@ -3940,11 +3998,10 @@ Fall back to normal file name handler if no Tramp
handler exists."
(goto-char (point-min))
(forward-line)
(when (looking-at
- (eval-when-compile
- (concat "\\(?:^/[^[:space:]]*[[:space:]]\\)?"
- "[[:space:]]*\\([[:digit:]]+\\)"
- "[[:space:]]+\\([[:digit:]]+\\)"
- "[[:space:]]+\\([[:digit:]]+\\)")))
+ (concat "\\(?:^/[^[:space:]]*[[:space:]]\\)?"
+ "[[:space:]]*\\([[:digit:]]+\\)"
+ "[[:space:]]+\\([[:digit:]]+\\)"
+ "[[:space:]]+\\([[:digit:]]+\\)"))
(mapcar
(lambda (d)
(* d (tramp-get-connection-property v "df-blocksize" 0)))
@@ -3957,6 +4014,51 @@ Fall back to normal file name handler if no Tramp
handler exists."
;;; Internal Functions:
+(defun tramp-expand-script (vec script)
+ "Expand SCRIPT with remote files or commands.
+\"%a\", \"%h\", \"%o\" and \"%p\" format specifiers are replaced
+by the respective `awk', `hexdump', `od' and `perl' commands.
+\"%n\" is replaced by \"2>/dev/null\", and \"%t\" is replaced by
+a temporary file name.
+If VEC is nil, the respective local commands are used.
+If there is a format specifier which cannot be expanded, this
+function returns nil."
+ (if (not (string-match-p "\\(^\\|[^%]\\)%[ahnopt]" script))
+ script
+ (catch 'wont-work
+ (let ((awk (when (string-match-p "\\(^\\|[^%]\\)%a" script)
+ (or
+ (if vec (tramp-get-remote-awk vec) (executable-find "awk"))
+ (throw 'wont-work nil))))
+ (hdmp (when (string-match-p "\\(^\\|[^%]\\)%h" script)
+ (or
+ (if vec (tramp-get-remote-hexdump vec)
+ (executable-find "hexdump"))
+ (throw 'wont-work nil))))
+ (dev (when (string-match-p "\\(^\\|[^%]\\)%n" script)
+ (or
+ (if vec (concat "2>" (tramp-get-remote-null-device vec))
+ (if (eq system-type 'windows-nt) ""
+ (concat "2>" null-device)))
+ (throw 'wont-work nil))))
+ (od (when (string-match-p "\\(^\\|[^%]\\)%o" script)
+ (or (if vec (tramp-get-remote-od vec) (executable-find "od"))
+ (throw 'wont-work nil))))
+ (perl (when (string-match-p "\\(^\\|[^%]\\)%p" script)
+ (or
+ (if vec
+ (tramp-get-remote-perl vec) (executable-find "perl"))
+ (throw 'wont-work nil))))
+ (tmp (when (string-match-p "\\(^\\|[^%]\\)%t" script)
+ (or
+ (if vec
+ (tramp-file-local-name (tramp-make-tramp-temp-name vec))
+ (tramp-compat-make-temp-name))
+ (throw 'wont-work nil)))))
+ (format-spec
+ script
+ (format-spec-make ?a awk ?h hdmp ?n dev ?o od ?p perl ?t tmp))))))
+
(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."
@@ -3969,16 +4071,17 @@ Only send the definition if it has not already been
done."
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
+ (setq script (tramp-compat-string-replace
(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"))
+ ;; Expand format specifiers.
+ (unless (setq script (tramp-expand-script vec script))
+ (tramp-error
+ vec 'file-error
+ (format "Script %s is not applicable on remote host" name)))
+ ;; Send it.
(tramp-barf-unless-okay
vec
- (format "%s () {\n%s\n}"
- name (format script (tramp-get-remote-perl vec)))
+ (format "%s () {\n%s\n}" name script)
"Script %s sending failed" name)
(tramp-set-connection-property
(tramp-get-connection-process vec) "scripts" (cons name scripts))))))
@@ -4013,13 +4116,16 @@ hosts, or files, disagree."
(tramp-shell-quote-argument v1-localname)
(tramp-shell-quote-argument v2-localname))))))
+(defconst tramp-sunos-unames (regexp-opt '("SunOS 5.10" "SunOS 5.11"))
+ "Regexp to determine remote SunOS.")
+
(defun tramp-find-executable
(vec progname dirlist &optional ignore-tilde ignore-path)
"Search 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
+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.
@@ -4034,7 +4140,7 @@ This function expects to be in the right *tramp* buffer."
;; therefore.
(unless (or ignore-path
(string-match-p
- (eval-when-compile (regexp-opt '("SunOS 5.10" "SunOS 5.11")))
+ tramp-sunos-unames
(tramp-get-connection-property vec "uname" "")))
(tramp-send-command vec (format "which \\%s | wc -w" progname))
(goto-char (point-min))
@@ -4045,19 +4151,18 @@ This function expects to be in the right *tramp*
buffer."
;; Remove all ~/foo directories from dirlist.
(let (newdl d)
(while dirlist
- (setq d (car dirlist))
- (setq dirlist (cdr dirlist))
+ (setq d (car dirlist)
+ 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"))
+ (format (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
(string-join dirlist "\n")
@@ -4083,7 +4188,10 @@ variable PATH."
(pipe-buf
(with-tramp-connection-property vec "pipe-buf"
(tramp-send-command-and-read
- vec "getconf PIPE_BUF / 2>/dev/null || echo 4096" 'noerror)))
+ vec
+ (format "getconf PIPE_BUF / 2>%s || echo 4096"
+ (tramp-get-remote-null-device vec))
+ 'noerror)))
tmpfile chunk chunksize)
(tramp-message vec 5 "Setting $PATH environment variable")
(if (< (length command) pipe-buf)
@@ -4098,7 +4206,7 @@ variable PATH."
chunk (substring command 0 chunksize)
command (substring command chunksize))
(tramp-send-command vec (format
- "echo -n %s >>%s"
+ "printf \"%%b\" \"$*\" %s >>%s"
(tramp-shell-quote-argument chunk)
(tramp-shell-quote-argument tmpfile))))
(tramp-send-command vec (format ". %s" tmpfile))
@@ -4195,12 +4303,11 @@ file exists and nonzero exit status otherwise."
;; 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"))
+ (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 "INSIDE_EMACS") emacs-version) tramp-version
(or (getenv-internal "ENV" tramp-remote-process-environment) "")
(if (stringp tramp-histfile-override)
(format "HISTFILE=%s"
@@ -4228,45 +4335,45 @@ file exists and nonzero exit status otherwise."
(defun tramp-find-shell (vec)
"Open 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
+ ;; If we are in `make-process', we don't need another shell.
+ (unless (tramp-get-connection-property vec "process-name" nil)
+ (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
+ tramp-sunos-unames
+ (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
(concat
"Couldn't find a remote shell which groks tilde "
- "expansion, using `%s'"))
- default-shell)))
+ "expansion, using `%s'")
+ default-shell)))
- 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)))))
+ ;; 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.
@@ -4328,11 +4435,15 @@ process to set up. VEC specifies the connection."
;; 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`\\\""))))
+ (let* ((old-uname (tramp-get-connection-property vec "uname" nil))
+ (uname
+ ;; If we are in `make-process', we don't need to recompute.
+ (if (and old-uname
+ (tramp-get-connection-property vec "process-name" nil))
+ old-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
@@ -4384,7 +4495,7 @@ process to set up. VEC specifies the connection."
(t
(tramp-message
vec 5 "Checking remote host type for `send-process-string' bug")
- (if (string-match-p "^FreeBSD" uname) 500 0))))
+ (if (string-match-p "FreeBSD\\|DragonFly" uname) 500 0))))
;; Set remote PATH variable.
(tramp-set-remote-path vec)
@@ -4402,22 +4513,28 @@ process to set up. VEC specifies the connection."
(tramp-find-shell vec)
;; Disable unexpected output.
- (tramp-send-command vec "mesg n 2>/dev/null; biff n 2>/dev/null" t)
+ (tramp-send-command
+ vec
+ (format "mesg n 2>%s; biff n 2>%s"
+ (tramp-get-remote-null-device vec)
+ (tramp-get-remote-null-device vec))
+ 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>.
+ ;;
<https://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)
+ (if (string-match-p "BSD\\|DragonFly\\|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)
+ (tramp-send-command
+ vec (concat "stty iutf8 2>" (tramp-get-remote-null-device vec)) t)
;; Set `remote-tty' process property.
(let ((tty (tramp-send-command-and-read vec "echo \\\"`tty`\\\""
'noerror)))
@@ -4472,7 +4589,7 @@ process to set up. VEC specifies the connection."
(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")))
+ (pack ,tramp-perl-pack ,tramp-perl-unpack))
"List of local coding commands for inline transfer.
Each item is a list that looks like this:
@@ -4533,7 +4650,8 @@ 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.
\"%a\", \"%h\" and \"%o\" format specifiers are replaced by the
-respective `awk', `hexdump' and `od' commands.
+respective `awk', `hexdump' and `od' commands. \"%n\" is
+replaced by \"2>/dev/null\".
The optional TEST command can be used for further tests, whether
ENCODING and DECODING are applicable.")
@@ -4552,8 +4670,8 @@ Goes through the list `tramp-local-coding-commands' and
(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))
+ (setq loc-enc (nth 1 litem)
+ 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))
@@ -4561,6 +4679,8 @@ Goes through the list `tramp-local-coding-commands' and
vec 5 "Checking local encoding function `%s'" loc-enc)
(tramp-message
vec 5 "Checking local encoding command `%s' for sanity" loc-enc)
+ (unless (stringp (setq loc-enc (tramp-expand-script nil loc-enc)))
+ (throw 'wont-work-local nil))
(unless (zerop (tramp-call-local-coding-command loc-enc nil nil))
(throw 'wont-work-local nil)))
(if (not (stringp loc-dec))
@@ -4568,6 +4688,8 @@ Goes through the list `tramp-local-coding-commands' and
vec 5 "Checking local decoding function `%s'" loc-dec)
(tramp-message
vec 5 "Checking local decoding command `%s' for sanity" loc-dec)
+ (unless (stringp (setq loc-dec (tramp-expand-script nil loc-dec)))
+ (throw 'wont-work-local nil))
(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
@@ -4575,9 +4697,9 @@ Goes through the list `tramp-local-coding-commands' and
(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))
+ (setq rem-enc (nth 1 ritem)
+ rem-dec (nth 2 ritem)
+ rem-test (nth 3 ritem))
;; Check the remote test command if exists.
(when (stringp rem-test)
(tramp-message
@@ -4595,68 +4717,25 @@ Goes through the list `tramp-local-coding-commands' and
(unless (stringp rem-enc)
(let ((name (symbol-name rem-enc))
(value (symbol-value rem-enc)))
- ;; Check if remote perl exists when necessary.
- (and (string-match-p "perl" name)
- (not (tramp-get-remote-perl vec))
- (throw 'wont-work-remote nil))
- ;; Check if remote awk exists when necessary.
- (and (string-match-p "\\(^\\|[^%]\\)%a" value)
- (not (tramp-get-remote-awk vec))
- (throw 'wont-work-remote nil))
- ;; Check if remote hexdump exists when necessary.
- (and (string-match-p "\\(^\\|[^%]\\)%h" value)
- (not (tramp-get-remote-hexdump vec))
- (throw 'wont-work-remote nil))
- ;; Check if remote od exists when necessary.
- (and (string-match-p "\\(^\\|[^%]\\)%o" value)
- (not (tramp-get-remote-od vec))
- (throw 'wont-work-remote nil))
(while (string-match "-" name)
(setq name (replace-match "_" nil t name)))
- (when (string-match-p "\\(^\\|[^%]\\)%[aho]" value)
- (setq value
- (format-spec
- value
- (format-spec-make
- ?a (tramp-get-remote-awk vec)
- ?h (tramp-get-remote-hexdump vec)
- ?o (tramp-get-remote-od vec)))
- value (replace-regexp-in-string "%" "%%" value)))
(tramp-maybe-send-script vec value 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)
+ vec
+ (format
+ "%s <%s" rem-enc (tramp-get-remote-null-device
vec))
+ t)
(throw 'wont-work-remote nil))
(unless (stringp rem-dec)
(let ((name (symbol-name rem-dec))
- (value (symbol-value rem-dec))
- tmpfile)
+ (value (symbol-value rem-dec)))
(while (string-match "-" name)
(setq name (replace-match "_" nil t name)))
- (when (string-match-p "\\(^\\|[^%]\\)%[aho]" value)
- (setq value
- (format-spec
- value
- (format-spec-make
- ?a (tramp-get-remote-awk vec)
- ?h (tramp-get-remote-hexdump vec)
- ?o (tramp-get-remote-od vec)))
- value (replace-regexp-in-string "%" "%%" value)))
- (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-file-local-name tmpfile)))))
(tramp-maybe-send-script vec value name)
(setq rem-dec name)))
(tramp-message
@@ -4674,9 +4753,9 @@ Goes through the list `tramp-local-coding-commands' and
(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)))))))
+ (setq rem-enc (nth 1 ritem)
+ rem-dec (nth 2 ritem)
+ found t)))))))
(when found
;; Set connection properties. Since the commands are risky
@@ -4694,7 +4773,7 @@ Goes through the list `tramp-local-coding-commands' and
"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'.
+INPUT can also be nil which means `null-device'.
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)."
@@ -4789,99 +4868,6 @@ Goes through the list `tramp-inline-compress-commands'."
(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
@@ -4932,7 +4918,8 @@ Goes through the list `tramp-inline-compress-commands'."
(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
+ (if (and (tramp-get-connection-property
+ (tramp-get-connection-process vec) "locked" nil)
(tramp-file-name-equal-p vec (car tramp-current-connection)))
(progn
(tramp-message
@@ -4940,7 +4927,7 @@ If there is just some editing, retry it after 5 seconds."
(run-at-time 5 nil 'tramp-timeout-session vec))
(tramp-message
vec 3 "Timeout session %s" (tramp-make-tramp-file-name vec 'noloc))
- (tramp-cleanup-connection vec 'keep-debug)))
+ (tramp-cleanup-connection vec 'keep-debug nil 'keep-processes)))
(defun tramp-maybe-open-connection (vec)
"Maybe open a connection VEC.
@@ -4961,11 +4948,8 @@ connection if a previous connection has died for some
reason."
(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))))
+ (time-since (cdr tramp-current-connection))
+ (or tramp-connection-min-time-diff 0)))
(throw 'suppress 'suppress))
;; If too much time has passed since last command was sent, look
@@ -4976,11 +4960,9 @@ connection if a previous connection has died for some
reason."
;; 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))))
+ (when (and (time-less-p
+ 60 (time-since
+ (tramp-get-connection-property p "last-cmd-time" 0)))
(process-live-p p))
(tramp-send-command vec "echo are you awake" t t)
(unless (and (process-live-p p)
@@ -5057,6 +5039,9 @@ connection if a previous connection has died for some
reason."
(tramp-message vec 6 "%s" (string-join (process-command p) " "))
+ ;; Set connection-local variables.
+ (tramp-set-connection-local-variables vec)
+
;; Check whether process is alive.
(tramp-barf-if-no-shell-prompt
p 10
@@ -5094,11 +5079,8 @@ connection if a previous connection has died for some
reason."
;; 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)))))
+ (tramp-get-process vec) "temp-file"
+ (tramp-compat-make-temp-name)))
spec r-shell)
;; Add arguments for asynchronous processes.
@@ -5169,9 +5151,6 @@ connection if a previous connection has died for some
reason."
(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
@@ -5267,18 +5246,21 @@ 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.
+DONT-SUPPRESS-ERR is non-nil, stderr won't be sent to \"/dev/null\".
Optional argument EXIT-STATUS, if non-nil, triggers the return of
the exit status."
(tramp-send-command
vec
(concat (if subshell "( " "")
command
- (if command (if dont-suppress-err "; " " 2>/dev/null; ") "")
+ (if command
+ (if dont-suppress-err
+ "; " (format " 2>%s; " (tramp-get-remote-null-device vec)))
+ "")
"echo tramp_exit_status $?"
(if subshell " )" "")))
(with-current-buffer (tramp-get-connection-buffer vec)
- (unless (tramp-search-regexp "tramp_exit_status [0-9]+")
+ (unless (tramp-search-regexp "tramp_exit_status [[:digit:]]+")
(tramp-error
vec 'file-error "Couldn't find exit status of `%s'" command))
(skip-chars-forward "^ ")
@@ -5474,7 +5456,7 @@ Nonexistent directories are removed from spec."
;; 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)
+ (tramp-get-process vec)
vec)
"remote-path"
(let* ((remote-path (copy-tree tramp-remote-path))
@@ -5484,7 +5466,11 @@ Nonexistent directories are removed from spec."
(when elt1
(or
(tramp-send-command-and-read
- vec "echo \\\"`getconf PATH 2>/dev/null`\\\"" 'noerror)
+ vec
+ (format
+ "echo \\\"`getconf PATH 2>%s`\\\""
+ (tramp-get-remote-null-device vec))
+ 'noerror)
;; Default if "getconf" is not available.
(progn
(tramp-message
@@ -5588,7 +5574,8 @@ Nonexistent directories are removed from spec."
vec (format "%s -lnd /" result))
(when (tramp-send-command-and-check
vec (format
- "%s --color=never -al /dev/null" result))
+ "%s --color=never -al %s"
+ result (tramp-get-remote-null-device vec)))
(setq result (concat result " --color=never")))
(throw 'ls-found result))
(setq dl (cdr dl))))))
@@ -5609,7 +5596,9 @@ Nonexistent directories are removed from spec."
(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))
+ vec (format
+ "%s %s -al %s"
+ (tramp-get-ls-command vec) option (tramp-get-remote-null-device
vec)))
option)))
(defun tramp-get-test-command (vec)
@@ -5682,8 +5671,7 @@ Nonexistent directories are removed from spec."
;; stat on Solaris is buggy. We've got reports for "SunOS 5.10"
;; and "SunOS 5.11" so far.
(unless (string-match-p
- (eval-when-compile (regexp-opt '("SunOS 5.10" "SunOS 5.11")))
- (tramp-get-connection-property vec "uname" ""))
+ tramp-sunos-unames (tramp-get-connection-property vec "uname" ""))
(tramp-message vec 5 "Finding a suitable `stat' command")
(let ((result (tramp-find-executable
vec "stat" (tramp-get-remote-path vec)))
@@ -5729,10 +5717,7 @@ This command is returned only if
`delete-by-moving-to-trash' is non-nil."
(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)))))
+ (tmpfile (tramp-make-tramp-temp-name vec)))
;; Busyboxes do support the "-t" option only when they have been
;; built with the DESKTOP config option. Let's check it.
(when result
@@ -5777,6 +5762,30 @@ This command is returned only if
`delete-by-moving-to-trash' is non-nil."
(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-gio-file-monitor (vec)
+ "Determine remote GFileMonitor."
+ (with-tramp-connection-property vec "gio-file-monitor"
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (tramp-message vec 5 "Finding the used GFileMonitor")
+ (when-let ((gio (tramp-get-remote-gio-monitor vec)))
+ ;; Search for the used FileMonitor. There is no known way to
+ ;; get this information directly from gio, so we check for
+ ;; linked libraries of libgio.
+ (when (tramp-send-command-and-check vec (concat "ldd " gio))
+ (goto-char (point-min))
+ (when (re-search-forward "\\S-+/libgio\\S-+")
+ (when (tramp-send-command-and-check
+ vec (concat "strings " (match-string 0)))
+ (goto-char (point-min))
+ (re-search-forward
+ (format
+ "^%s$"
+ (regexp-opt
+ '("GFamFileMonitor" "GFenFileMonitor"
+ "GInotifyFileMonitor" "GKqueueFileMonitor")))
+ nil 'noerror)
+ (intern (match-string 0)))))))))
+
(defun tramp-get-remote-gvfs-monitor-dir (vec)
"Determine remote `gvfs-monitor-dir' command."
(with-tramp-connection-property vec "gvfs-monitor-dir"
@@ -5847,27 +5856,6 @@ This command is returned only if
`delete-by-moving-to-trash' is non-nil."
"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
@@ -5898,27 +5886,6 @@ ID-FORMAT valid values are `string' and `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-remote-busybox (vec)
"Determine remote `busybox' command."
(with-tramp-connection-property vec "busybox"
@@ -5934,7 +5901,7 @@ ID-FORMAT valid values are `string' and `integer'."
(command (format "%s %s" busybox "awk")))
(and busybox
(tramp-send-command-and-check
- vec (concat command " {} </dev/null"))
+ vec (concat command " {} <" (tramp-get-remote-null-device vec)))
command)))))
(defun tramp-get-remote-hexdump (vec)
@@ -5945,7 +5912,8 @@ ID-FORMAT valid values are `string' and `integer'."
(let* ((busybox (tramp-get-remote-busybox vec))
(command (format "%s %s" busybox "hexdump")))
(and busybox
- (tramp-send-command-and-check vec (concat command " </dev/null"))
+ (tramp-send-command-and-check
+ vec (concat command " <" (tramp-get-remote-null-device vec)))
command)))))
(defun tramp-get-remote-od (vec)
@@ -5957,16 +5925,32 @@ ID-FORMAT valid values are `string' and `integer'."
(command (format "%s %s" busybox "od")))
(and busybox
(tramp-send-command-and-check
- vec (concat command " -A n </dev/null"))
+ vec
+ (concat command " -A n <" (tramp-get-remote-null-device vec)))
command)))))
+(defun tramp-get-remote-chmod-h (vec)
+ "Check whether remote `chmod' supports nofollow argument."
+ (with-tramp-connection-property vec "chmod-h"
+ (tramp-message vec 5 "Finding a suitable `chmod' command with nofollow")
+ (let ((tmpfile (tramp-make-tramp-temp-name vec)))
+ (prog1
+ (tramp-send-command-and-check
+ vec
+ (format
+ "ln -s foo %s && chmod -h %s 0777"
+ (tramp-file-local-name tmpfile) (tramp-file-local-name tmpfile)))
+ (delete-file tmpfile)))))
+
(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)))
+ vec (format "env FOO=foo env -u FOO 2>%s | grep -qv FOO"
+ (tramp-get-remote-null-device vec))
+ t)))
;; Some predefined connection properties.
(defun tramp-get-inline-compress (vec prop size)
@@ -5977,10 +5961,9 @@ 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
+ (with-tramp-connection-property (tramp-get-process vec) prop
(tramp-find-inline-compress vec)
- (tramp-get-connection-property
- (tramp-get-connection-process vec) prop nil))))
+ (tramp-get-connection-property (tramp-get-process vec) prop nil))))
(defun tramp-get-inline-coding (vec prop size)
"Return the coding command related to PROP.
@@ -5998,11 +5981,9 @@ function cell is returned to be applied on a buffer."
;; no inline coding is found.
(ignore-errors
(let ((coding
- (with-tramp-connection-property
- (tramp-get-connection-process vec) prop
+ (with-tramp-connection-property (tramp-get-process vec) prop
(tramp-find-inline-encoding vec)
- (tramp-get-connection-property
- (tramp-get-connection-process vec) prop nil)))
+ (tramp-get-connection-property (tramp-get-process vec) prop nil)))
(prop1 (if (string-match-p "encoding" prop)
"inline-compress" "inline-decompress"))
compress)
@@ -6080,9 +6061,6 @@ function cell is returned to be applied on a buffer."
;; 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.
@@ -6164,4 +6142,9 @@ function cell is returned to be applied on a buffer."
;;
;; * Implement `:stderr' of `make-process' as pipe process.
+;; * One interesting solution (with other applications as well) would
+;; be to stipulate, as a directory or connection-local variable, an
+;; additional rc file on the remote machine that is sourced every
+;; time Tramp connects. <https://emacs.stackexchange.com/questions/62306>
+
;;; tramp-sh.el ends here
diff --git a/tramp-smb.el b/tramp-smb.el
index b76308a..83c1b58 100644
--- a/tramp-smb.el
+++ b/tramp-smb.el
@@ -74,7 +74,7 @@
:version "24.4")
;;;###tramp-autoload
-(defcustom tramp-smb-conf "/dev/null"
+(defcustom tramp-smb-conf null-device
"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."
@@ -90,7 +90,7 @@ For example, if the deprecated SMB1 protocol shall be used,
add to
this variable (\"client min protocol=NT1\") ."
:group 'tramp
:type '(repeat string)
- :version "27.2")
+ :version "28.1")
(defvar tramp-smb-version nil
"Version string of the SMB client.")
@@ -293,6 +293,8 @@ See `tramp-actions-before-shell' for more info.")
(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-get-remote-gid . ignore)
+ (tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore)
(unhandled-file-name-directory . ignore)
(vc-registered . ignore)
@@ -341,10 +343,9 @@ This can be used to disable echo etc."
"Invoke the SMB related OPERATION and ARGS.
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))))
+ (if-let ((fn (assoc operation tramp-smb-file-name-handler-alist)))
+ (save-match-data (apply (cdr fn) args))
+ (tramp-run-real-handler operation args)))
;;;###tramp-autoload
(unless (memq system-type '(cygwin windows-nt))
@@ -432,16 +433,12 @@ pass to the OPERATION."
v tramp-file-missing
"Copying directory" "No such file or directory" dirname))
(when (and (file-directory-p newname)
- (not (tramp-compat-directory-name-p newname)))
+ (not (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)))))
+ (let ((tmpdir (tramp-compat-make-temp-name)))
(unwind-protect
(progn
(make-directory tmpdir)
@@ -467,12 +464,9 @@ pass to the OPERATION."
(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))))
+ (tramp-compat-string-replace
+ "\\" "/" (tramp-smb-get-localname v))))
+ (tmpdir (tramp-compat-make-temp-name))
(args (list (concat "//" host "/" share) "-E"))
(options tramp-smb-options))
@@ -556,10 +550,11 @@ pass to the OPERATION."
;; Handle KEEP-DATE argument.
(when keep-date
- (set-file-times
+ (tramp-compat-set-file-times
newname
(tramp-compat-file-attribute-modification-time
- (file-attributes dirname))))
+ (file-attributes dirname))
+ (unless ok-if-already-exists 'nofollow)))
;; Set the mode.
(unless keep-date
@@ -598,83 +593,81 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
tramp-file-missing
"Copying file" "No such file or directory" filename))
- (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.
+ (if-let ((tmpfile (file-local-copy filename)))
+ ;; 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)
+ (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))
(when (and (file-directory-p newname)
- (tramp-compat-directory-name-p newname))
- (setq newname
- (expand-file-name (file-name-nondirectory filename) newname)))
+ (not (directory-name-p newname)))
+ (tramp-error v 'file-error "File is a directory %s" 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))
- (when (and (file-directory-p newname)
- (not (tramp-compat-directory-name-p newname)))
- (tramp-error v 'file-error "File is a directory %s" newname))
-
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (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))))))
+ ;; We must also flush the cache of the directory, because
+ ;; `file-attributes' reads the values from there.
+ (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
+ (tramp-compat-set-file-times
newname
(tramp-compat-file-attribute-modification-time
- (file-attributes filename))))))
+ (file-attributes filename))
+ (unless ok-if-already-exists 'nofollow)))))
-(defun tramp-smb-handle-delete-directory (directory &optional recursive _trash)
+(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
+ (tramp-skeleton-delete-directory directory recursive trash
+ (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)))
+
;; We must also flush the cache of the directory, because
;; `file-attributes' reads the values from there.
(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")
+ (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)))
+ (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)))))
+ (tramp-error v 'file-error "`%s' not removed." directory)))))
-(defun tramp-smb-handle-delete-file (filename &optional _trash)
+(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)
@@ -682,20 +675,21 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
;; We must also flush the cache of the directory, because
;; `file-attributes' reads the values from there.
(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))))))
+ (if (and delete-by-moving-to-trash trash)
+ (move-file-to-trash filename)
+ (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 _count)
+ (directory &optional full match nosort count)
"Like `directory-files' for Tramp files."
(unless (file-exists-p directory)
(tramp-error
@@ -709,14 +703,22 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(delete nil
(mapcar (lambda (x) (when (string-match-p match x) x))
result))))
- ;; Append directory.
+
+ ;; Sort them if necessary.
+ (unless nosort
+ (setq result (sort result #'string-lessp)))
+
+ ;; Return count number of results.
+ (when (and (natnump count) (> count 0))
+ (setq result (nbutlast result (- (length result) count))))
+
+ ;; Prepend directory.
(when full
(setq result
(mapcar
- (lambda (x) (format "%s/%s" directory x))
+ (lambda (x) (format "%s/%s" (directory-file-name 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)
@@ -775,8 +777,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(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)))
+ (localname (tramp-compat-string-replace
+ "\\" "/" (tramp-smb-get-localname v)))
(args (list (concat "//" host "/" share) "-E"))
(options tramp-smb-options))
@@ -795,7 +797,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(setq
args
(append args (list (tramp-unquote-shell-quote-argument localname)
- "2>/dev/null")))
+ (concat "2>" (tramp-get-remote-null-device
v)))))
(unwind-protect
(with-temp-buffer
@@ -880,23 +882,31 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(while (not (eobp))
(cond
((looking-at
- "Size:\\s-+\\([0-9]+\\)\\s-+Blocks:\\s-+[0-9]+\\s-+\\(\\w+\\)")
+ (concat
+ "Size:\\s-+\\([[:digit:]]+\\)\\s-+"
+ "Blocks:\\s-+[[:digit:]]+\\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]+\\)")
+
"Inode:\\s-+\\([[:digit:]]+\\)\\s-+Links:\\s-+\\([[:digit:]]+\\)")
(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]+\\)")
+ (concat
+ "Access:\\s-+([[:digit:]]+/\\(\\S-+\\))\\s-+"
+ "Uid:\\s-+\\([[:digit:]]+\\)\\s-+"
+ "Gid:\\s-+\\([[:digit:]]+\\)"))
(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]+\\)")
+ (concat
+ "Access:\\s-+"
+ "\\([[:digit:]]+\\)-\\([[:digit:]]+\\)-\\([[:digit:]]+\\)\\s-+"
+ "\\([[:digit:]]+\\):\\([[:digit:]]+\\):\\([[:digit:]]+\\)"))
(setq atime
(encode-time
(string-to-number (match-string 6)) ;; sec
@@ -906,7 +916,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(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]+\\)")
+ (concat
+ "Modify:\\s-+"
+ "\\([[:digit:]]+\\)-\\([[:digit:]]+\\)-\\([[:digit:]]+\\)\\s-+"
+ "\\([[:digit:]]+\\):\\([[:digit:]]+\\):\\([[:digit:]]+\\)"))
(setq mtime
(encode-time
(string-to-number (match-string 6)) ;; sec
@@ -916,7 +929,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(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]+\\)")
+ (concat
+ "Change:\\s-+"
+ "\\([[:digit:]]+\\)-\\([[:digit:]]+\\)-\\([[:digit:]]+\\)\\s-+"
+ "\\([[:digit:]]+\\):\\([[:digit:]]+\\):\\([[:digit:]]+\\)"))
(setq ctime
(encode-time
(string-to-number (match-string 6)) ;; sec
@@ -992,10 +1008,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(goto-char (point-min))
(forward-line)
(when (looking-at
- (eval-when-compile
- (concat "[[:space:]]*\\([[:digit:]]+\\)"
- " blocks of size \\([[:digit:]]+\\)"
- "\\. \\([[:digit:]]+\\) blocks available")))
+ (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)))))
@@ -1025,7 +1040,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(setq filename (expand-file-name filename))
(unless switches (setq switches ""))
;; Mark trailing "/".
- (when (and (tramp-compat-directory-name-p filename)
+ (when (and (directory-name-p filename)
(not full-directory-p))
(setq switches (concat switches "F")))
(if full-directory-p
@@ -1377,7 +1392,7 @@ component is used as the target of the symlink."
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
- (not (tramp-compat-directory-name-p newname)))
+ (not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(with-tramp-progress-reporter
@@ -1430,10 +1445,10 @@ component is used as the target of the symlink."
(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)))
+ (localname (tramp-compat-string-replace
+ "\\" "/" (tramp-smb-get-localname v)))
(args (list (concat "//" host "/" share) "-E" "-S"
- (replace-regexp-in-string
+ (tramp-compat-string-replace
"\n" "," acl-string)))
(options tramp-smb-options))
@@ -1479,7 +1494,7 @@ component is used as the target of the symlink."
;; This is meant for traces, and returning from the
;; function. No error is propagated outside, due to
;; the `ignore-errors' closure.
- (unless (tramp-search-regexp "tramp_exit_status [0-9]+")
+ (unless (tramp-search-regexp "tramp_exit_status [[:digit:]]+")
(tramp-error
v 'file-error
"Couldn't find exit status of `%s'" tramp-smb-acl-program))
@@ -1493,15 +1508,17 @@ component is used as the target of the symlink."
(tramp-flush-connection-property v "process-name")
(tramp-flush-connection-property v "process-buffer")))))))
-(defun tramp-smb-handle-set-file-modes (filename mode &optional _flag)
+(defun tramp-smb-handle-set-file-modes (filename mode &optional flag)
"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)))))
+ ;; smbclient chmod does not support nofollow.
+ (unless (and (eq flag 'nofollow) (file-symlink-p filename))
+ (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
@@ -1613,8 +1630,9 @@ errors for shares like \"C$/\", which are common in
Microsoft Windows."
;; Set file modification time.
(when (or (eq visit t) (stringp visit))
(set-visited-file-modtime
- (tramp-compat-file-attribute-modification-time
- (file-attributes filename))))
+ (or (tramp-compat-file-attribute-modification-time
+ (file-attributes filename))
+ (current-time))))
;; The end.
(when (and (null noninteractive)
@@ -1722,21 +1740,21 @@ Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME
YEAR)."
;; Entries provided by smbclient DIR aren't fully regular.
;; They should have the format
;;
-;; \s-\{2,2} - leading spaces
+;; \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-+[[:digit:]]+ - 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
+;; [ 12][[:digit:]] - day
;; \s- - space delimiter
-;; [0-9]\{2,2\}:[0-9]\{2,2\}:[0-9]\{2,2\} - time
+;; [[:digit:]]\{2,2\}:[[:digit:]]\{2,2\}:[[:digit:]]\{2,2\} - time
;; \s- - space delimiter
-;; [0-9]\{4,4\} - year
+;; [[:digit:]]\{4,4\} - year
;;
;; samba/src/client.c (http://samba.org/doxygen/samba/client_8c-source.html)
;; has function display_finfo:
@@ -1784,13 +1802,14 @@ are listed. Result is the list (LOCALNAME MODE SIZE
MTIME)."
(cl-block nil
;; year.
- (if (string-match "\\([0-9]+\\)$" line)
+ (if (string-match "\\([[:digit:]]+\\)$" 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)
+ (if (string-match
+ "\\([[:digit:]]+\\):\\([[:digit:]]+\\):\\([[:digit:]]+\\)$" 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))
@@ -1798,7 +1817,7 @@ are listed. Result is the list (LOCALNAME MODE SIZE
MTIME)."
(cl-return))
;; day.
- (if (string-match "\\([0-9]+\\)$" line)
+ (if (string-match "\\([[:digit:]]+\\)$" line)
(setq day (string-to-number (match-string 1 line))
line (substring line 0 -3))
(cl-return))
@@ -1815,7 +1834,7 @@ are listed. Result is the list (LOCALNAME MODE SIZE
MTIME)."
(cl-return))
;; size.
- (if (string-match "\\([0-9]+\\)$" line)
+ (if (string-match "\\([[:digit:]]+\\)$" line)
(let ((length (- (max 10 (1+ (length (match-string 1 line)))))))
(setq size (string-to-number (match-string 1 line)))
(when (string-match
@@ -1870,7 +1889,7 @@ are listed. Result is the list (LOCALNAME MODE SIZE
MTIME)."
(if (and (process-live-p (tramp-get-connection-process vec))
(tramp-get-connection-property vec "posix" t))
(with-tramp-connection-property
- (tramp-get-connection-process vec) "cifs-capabilities"
+ (tramp-get-process vec) "cifs-capabilities"
(save-match-data
(when (tramp-smb-send-command vec "posix")
(with-current-buffer (tramp-get-connection-buffer vec)
@@ -1887,8 +1906,7 @@ are listed. Result is the list (LOCALNAME MODE SIZE
MTIME)."
;; 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"
+ (with-tramp-connection-property (tramp-get-process vec) "stat-capability"
(tramp-smb-send-command vec "stat \"/\""))))
@@ -1950,11 +1968,9 @@ If ARGUMENT is non-nil, use it as argument for
;; 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))))
+ (when (and (time-less-p
+ 60 (time-since
+ (tramp-get-connection-property p "last-cmd-time" 0)))
(process-live-p p)
(re-search-forward tramp-smb-errors nil t))
(delete-process p)
@@ -2024,8 +2040,11 @@ If ARGUMENT is non-nil, use it as argument for
(process-put p 'adjust-window-size-function #'ignore)
(set-process-query-on-exit-flag p nil)
+ ;; Set connection-local variables.
+ (tramp-set-connection-local-variables vec)
+
(condition-case err
- (let (tramp-message-show-message)
+ (let ((inhibit-message t))
;; Play login scenario.
(tramp-process-actions
p vec nil
@@ -2057,9 +2076,6 @@ If ARGUMENT is non-nil, use it as argument for
(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))
@@ -2131,8 +2147,7 @@ Removes smb prompt. Returns nil if an error message has
appeared."
"%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))
+ (add-hook 'kill-buffer-hook #'tramp-smb-kill-winexe-function nil t)
;; Suppress "^M". Shouldn't we specify utf8?
(set-process-coding-system (tramp-get-connection-process vec) 'raw-text-dos)
diff --git a/tramp-sudoedit.el b/tramp-sudoedit.el
index 4af5861..558a57b 100644
--- a/tramp-sudoedit.el
+++ b/tramp-sudoedit.el
@@ -132,6 +132,8 @@ See `tramp-actions-before-shell' for more info.")
(start-file-process . ignore)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-get-remote-gid . tramp-sudoedit-handle-get-remote-gid)
+ (tramp-get-remote-uid . tramp-sudoedit-handle-get-remote-uid)
(tramp-set-file-uid-gid . tramp-sudoedit-handle-set-file-uid-gid)
(unhandled-file-name-directory . ignore)
(vc-registered . ignore)
@@ -153,10 +155,9 @@ See `tramp-actions-before-shell' for more info.")
"Invoke the SUDOEDIT handler for OPERATION and ARGS.
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))))
+ (if-let ((fn (assoc operation tramp-sudoedit-file-name-handler-alist)))
+ (save-match-data (apply (cdr fn) args))
+ (tramp-run-real-handler operation args)))
;;;###tramp-autoload
(tramp--with-startup
@@ -248,7 +249,7 @@ absolute file names."
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
- (not (tramp-compat-directory-name-p newname)))
+ (not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(if (or (and (file-remote-p filename) (not t1))
@@ -282,7 +283,8 @@ absolute file names."
;; Set the time and mode. Mask possible errors.
(when keep-date
(ignore-errors
- (set-file-times newname file-times)
+ (tramp-compat-set-file-times
+ newname file-times (unless ok-if-already-exists 'nofollow))
(set-file-modes newname file-modes)))
;; Handle `preserve-extended-attributes'. We ignore possible
@@ -303,8 +305,8 @@ absolute file names."
(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))
+ (setq filename (expand-file-name filename)
+ newname (expand-file-name newname))
;; At least one file a Tramp file?
(if (or (tramp-tramp-file-p filename)
(tramp-tramp-file-p newname))
@@ -319,29 +321,25 @@ absolute file names."
(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-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-skeleton-delete-directory directory recursive trash
+ (unless (tramp-sudoedit-send-command
+ v (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 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)))))
+ (if (and delete-by-moving-to-trash trash)
+ (move-file-to-trash filename)
+ (unless (tramp-sudoedit-send-command
+ v "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.
@@ -373,7 +371,7 @@ the result will be a local, non-Tramp, file name."
(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"
+ (with-tramp-connection-property (tramp-get-process vec) "acl-p"
(zerop (tramp-call-process vec "getfacl" nil nil nil "/"))))
(defun tramp-sudoedit-handle-file-acl (filename)
@@ -464,19 +462,21 @@ the result will be a local, non-Tramp, file name."
(tramp-sudoedit-send-command
v "test" "-r" (tramp-compat-file-name-unquote localname)))))
-(defun tramp-sudoedit-handle-set-file-modes (filename mode &optional _flag)
+(defun tramp-sudoedit-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
(with-parsed-tramp-file-name filename nil
- (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))))
+ ;; It is unlikely that "chmod -h" works.
+ (unless (and (eq flag 'nofollow) (file-symlink-p filename))
+ (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"
+ (with-tramp-connection-property (tramp-get-process vec) "selinux-p"
(zerop (tramp-call-process vec "selinuxenabled"))))
(defun tramp-sudoedit-handle-file-selinux-context (filename)
@@ -484,9 +484,8 @@ the result will be a local, non-Tramp, file name."
(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_]+\\)"))))
+ (regexp (concat "\\([[:alnum:]_]+\\):" "\\([[:alnum:]_]+\\):"
+ "\\([[:alnum:]_]+\\):" "\\([[:alnum:]_]+\\)")))
(when (and (tramp-sudoedit-remote-selinux-p v)
(tramp-sudoedit-send-command
v "ls" "-d" "-Z"
@@ -511,10 +510,9 @@ the result will be a local, non-Tramp, file name."
(goto-char (point-min))
(forward-line)
(when (looking-at
- (eval-when-compile
- (concat "[[:space:]]*\\([[:digit:]]+\\)"
- "[[:space:]]+\\([[:digit:]]+\\)"
- "[[:space:]]+\\([[:digit:]]+\\)")))
+ (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.
@@ -522,7 +520,7 @@ the result will be a local, non-Tramp, file name."
(string-to-number (match-string 2)))
(string-to-number (match-string 3)))))))))
-(defun tramp-sudoedit-handle-set-file-times (filename &optional time _flag)
+(defun tramp-sudoedit-handle-set-file-times (filename &optional time flag)
"Like `set-file-times' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)
@@ -535,14 +533,14 @@ the result will be a local, non-Tramp, file name."
(tramp-sudoedit-send-command
v "env" "TZ=UTC" "touch" "-t"
(format-time-string "%Y%m%d%H%M.%S" time t)
+ (if (eq flag 'nofollow) "-h" "")
(tramp-compat-file-name-unquote localname)))))
(defun tramp-sudoedit-handle-file-truename (filename)
"Like `file-truename' for Tramp files."
;; Preserve trailing "/".
(funcall
- (if (tramp-compat-directory-name-p filename)
- #'file-name-as-directory #'identity)
+ (if (directory-name-p filename) #'file-name-as-directory #'identity)
;; Quote properly.
(funcall
(if (tramp-compat-file-name-quoted-p filename)
@@ -642,8 +640,8 @@ component is used as the target of the symlink."
(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))
+ (setq filename (expand-file-name filename)
+ newname (expand-file-name newname))
;; At least one file a Tramp file?
(if (or (tramp-tramp-file-p filename)
(tramp-tramp-file-p newname))
@@ -687,21 +685,19 @@ component is used as the target of the symlink."
(tramp-flush-file-property v localname "file-selinux-context"))
t)))))
-(defun tramp-sudoedit-get-remote-uid (vec id-format)
+(defun tramp-sudoedit-handle-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"))))
+ (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)
+(defun tramp-sudoedit-handle-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"))))
+ (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."
@@ -709,21 +705,22 @@ ID-FORMAT valid values are `string' and `integer'."
(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)))
+ (or uid (tramp-get-remote-uid v 'integer))
+ (or gid (tramp-get-remote-gid v 'integer)))
(tramp-unquote-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)))
+ (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)))
+ (flag (and (eq mustbenew 'excl) 'nofollow))
+ (modes (tramp-default-file-modes filename flag)))
(prog1
(tramp-handle-write-region
start end filename append visit lockname mustbenew)
@@ -737,7 +734,7 @@ ID-FORMAT valid values are `string' and `integer'."
(file-attributes filename 'integer))
gid))
(tramp-set-file-uid-gid filename uid gid))
- (set-file-modes filename modes)))))
+ (tramp-compat-set-file-modes filename modes flag)))))
;; Internal functions.
@@ -782,14 +779,7 @@ connection if a previous connection has died for some
reason."
(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)))
+ (tramp-set-connection-property p "connected" t))))
(defun tramp-sudoedit-send-command (vec &rest args)
"Send commands ARGS to connection VEC.
diff --git a/tramp-uu.el b/tramp-uu.el
index 6a044e5..f368f72 100644
--- a/tramp-uu.el
+++ b/tramp-uu.el
@@ -94,8 +94,3 @@
(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
index e286254..d254854 100644
--- a/tramp.el
+++ b/tramp.el
@@ -7,10 +7,6 @@
;; Maintainer: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
;; Package: tramp
-;; Version: 2.4.4.4
-;; Package-Requires: ((emacs "24.4"))
-;; Package-Type: multi
-;; URL: https://savannah.gnu.org/projects/tramp
;; This file is part of GNU Emacs.
@@ -64,6 +60,7 @@
;; Pacify byte-compiler.
(require 'cl-lib)
+(declare-function file-notify-rm-watch "filenotify")
(declare-function netrc-parse "netrc")
(defvar auto-save-file-name-transforms)
@@ -79,6 +76,7 @@
(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.")
+ (put 'tramp--startup-hook 'tramp-suppress-trace t)
(defmacro tramp--with-startup (&rest body)
"Schedule BODY to be executed at the end of tramp.el."
@@ -110,6 +108,13 @@ Any level x includes messages for all levels 1 .. x-1.
The levels are
10 traces (huge)."
:type 'integer)
+(defcustom tramp-debug-to-file nil
+ "Whether Tramp debug messages shall be saved to file.
+The debug file has the same name as the debug buffer, written to
+`temporary-file-directory'."
+ :version "28.1"
+ :type 'boolean)
+
(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
@@ -242,6 +247,7 @@ pair of the form (KEY VALUE). The following KEYs are
defined:
- \"%k\" indicates the keep-date parameter of a program, if exists.
- \"%c\" adds additional `tramp-ssh-controlmaster-options'
options for the first hop.
+ - \"%n\" expands to \"2>/dev/null\".
The existence of `tramp-login-args', combined with the
absence of `tramp-copy-args', is an indication that the
@@ -253,6 +259,10 @@ pair of the form (KEY VALUE). The following KEYs are
defined:
parameters to suppress diagnostic messages, in order not to
tamper the process output.
+ * `tramp-direct-async-args'
+ An additional argument when a direct asynchronous process is
+ started. Used so far only in the \"mock\" method of tramp-tests.el.
+
* `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
@@ -565,7 +575,7 @@ Sometimes the prompt is reported to look like \"login
as:\"."
;; 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] *\\)*")
+ "[^]#$%>\n]*#?[]#$%>] *\\(\e\\[[[:digit:];]*[[:alpha:]] *\\)*")
"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
@@ -584,6 +594,11 @@ This regexp must match both `tramp-initial-end-of-output'
and
"Regexp matching password-like prompts.
The regexp should match at end of buffer.
+This variable is, by default, initialised from
+`password-word-equivalents' when Tramp is loaded, and it is
+usually more convenient to add new passphrases to that variable
+instead of altering this variable.
+
The `sudo' program appears to insert a `^@' character into the prompt."
:version "24.4"
:type 'regexp)
@@ -606,7 +621,7 @@ The `sudo' program appears to insert a `^@' character into
the prompt."
"\\|"
"^.*\\("
;; Here comes a list of regexes, separated by \\|
- "Received signal [0-9]+"
+ "Received signal [[:digit:]]+"
"\\).*")
"Regexp matching a `login failed' message.
The regexp should match at end of buffer."
@@ -751,7 +766,7 @@ to be set, depending on VALUE."
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-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
@@ -802,9 +817,9 @@ Used in `tramp-make-tramp-file-name'.")
Should always start with \"^\". Derived from `tramp-prefix-format'.")
(defconst tramp-method-regexp-alist
- '((default . "[a-zA-Z0-9-]+")
+ '((default . "[[:alnum:]-]+")
(simplified . "")
- (separate . "[a-zA-Z0-9-]*"))
+ (separate . "[[:alnum:]-]*"))
"Alist mapping Tramp syntax to regexps matching methods identifiers.")
(defun tramp-build-method-regexp ()
@@ -848,7 +863,7 @@ Derived from `tramp-postfix-method-format'.")
"Regexp matching delimiter between user and domain names.
Derived from `tramp-prefix-domain-format'.")
-(defconst tramp-domain-regexp "[a-zA-Z0-9_.-]+"
+(defconst tramp-domain-regexp "[[:alnum:]_.-]+"
"Regexp matching domain names.")
(defconst tramp-user-with-domain-regexp
@@ -865,7 +880,7 @@ Used in `tramp-make-tramp-file-name'.")
"Regexp matching delimiter between user and host names.
Derived from `tramp-postfix-user-format'.")
-(defconst tramp-host-regexp "[a-zA-Z0-9_.%-]+"
+(defconst tramp-host-regexp "[[:alnum:]_.%-]+"
"Regexp matching host names.")
(defconst tramp-prefix-ipv6-format-alist
@@ -893,7 +908,7 @@ 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.]+"
+(defconst tramp-ipv6-regexp "\\(?:[[:alnum:]]*:\\)+[[:alnum:].]+"
"Regexp matching IPv6 addresses.")
(defconst tramp-postfix-ipv6-format-alist
@@ -925,7 +940,7 @@ Derived from `tramp-postfix-ipv6-format'.")
"Regexp matching delimiter between host names and port numbers.
Derived from `tramp-prefix-port-format'.")
-(defconst tramp-port-regexp "[0-9]+"
+(defconst tramp-port-regexp "[[:digit:]]+"
"Regexp matching port numbers.")
(defconst tramp-host-with-port-regexp
@@ -1003,8 +1018,8 @@ See `tramp-file-name-structure'."
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.
+ "List detailing the Tramp file name structure.
+This is a list of six elements (REGEXP METHOD USER HOST FILE HOP).
The first element REGEXP is a regular expression matching a Tramp file
name. The regex should contain parentheses around the method name,
@@ -1244,6 +1259,7 @@ the (optional) timestamp of last activity on this
connection.")
"Password save function.
Will be called once the password has been verified by successful
authentication.")
+(put 'tramp-password-save-function 'tramp-suppress-trace t)
(defconst tramp-completion-file-name-handler-alist
'((file-name-all-completions
@@ -1267,7 +1283,7 @@ calling HANDLER.")
;; data structure.
;; The basic structure for remote file names. We use a list :type,
-;; in order to be compatible with Emacs 24 and 25.
+;; in order to be compatible with Emacs 25.
(cl-defstruct (tramp-file-name (:type list) :named)
method user domain host port localname hop)
@@ -1293,7 +1309,7 @@ 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'.
+;; Comparison 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)
@@ -1315,9 +1331,10 @@ entry does not exist, return nil."
;; 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))))))
+ (when-let ((methods-entry
+ (assoc
+ param (assoc (tramp-file-name-method vec) tramp-methods))))
+ (cadr methods-entry)))))
;; The localname can be quoted with "/:". Extract this.
(defun tramp-file-name-unquote-localname (vec)
@@ -1377,8 +1394,8 @@ This is METHOD, if non-nil. Otherwise, do a lookup in
(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)))
+ (setq lmethod (nth 2 item)
+ choices nil)))
lmethod)
tramp-default-method)))
;; We must mark, whether a default value has been used.
@@ -1398,8 +1415,8 @@ This is USER, if non-nil. Otherwise, do a lookup in
(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)))
+ (setq luser (nth 2 item)
+ choices nil)))
luser)
tramp-default-user)))
;; We must mark, whether a default value has been used.
@@ -1419,8 +1436,8 @@ This is HOST, if non-nil. Otherwise, do a lookup in
(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)))
+ (setq lhost (nth 2 item)
+ choices nil)))
lhost)
tramp-default-host)))
;; We must mark, whether a default value has been used.
@@ -1482,16 +1499,13 @@ default values are used."
:method method :user user :domain domain :host host
:port port :localname localname :hop hop))
;; The method must be known.
- (unless (or nodefault (tramp-completion-mode-p)
+ (unless (or nodefault non-essential
(string-equal method tramp-default-method-marker)
(assoc method tramp-methods))
(tramp-user-error
v "Method `%s' is not known." method))
;; 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)))
+ (unless (or (null hop) nodefault non-essential (tramp-multi-hop-p v))
(tramp-user-error
v "Method `%s' is not supported for multi-hops." method)))))))
@@ -1505,8 +1519,7 @@ See `tramp-dissect-file-name' for details."
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))
+ (unless (or nodefault non-essential (tramp-multi-hop-p v))
(tramp-user-error
v "Method `%s' is not supported for multi-hops."
(tramp-file-name-method v)))
@@ -1639,6 +1652,15 @@ from the default one."
(or (tramp-get-connection-property vec "process-name" nil)
(tramp-buffer-name vec)))
+(defun tramp-get-process (vec-or-proc)
+ "Get the default connection process to be used for VEC-OR-PROC.
+Return `tramp-cache-undefined' in case it doesn't exist."
+ (or (and (tramp-file-name-p vec-or-proc)
+ (get-buffer-process (tramp-buffer-name vec-or-proc)))
+ (and (processp vec-or-proc)
+ (tramp-get-process (process-get vec-or-proc 'vector)))
+ tramp-cache-undefined))
+
(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
@@ -1681,11 +1703,10 @@ version, the function does nothing."
(format "*debug tramp/%s %s*" method host-port))))
(defconst tramp-debug-outline-regexp
- (eval-when-compile
- (concat
- "[0-9]+:[0-9]+:[0-9]+\\.[0-9]+ " ;; Timestamp.
- "\\(?:\\(#<thread .+>\\) \\)?" ;; Thread.
- "[a-z0-9-]+ (\\([0-9]+\\)) #")) ;; Function name, verbosity.
+ (concat
+ "[[:digit:]]+:[[:digit:]]+:[[:digit:]]+\\.[[:digit:]]+ " ;; Timestamp.
+ "\\(?:\\(#<thread .+>\\) \\)?" ;; Thread.
+ "[[:alnum:]-]+ (\\([[:digit:]]+\\)) #") ;; Function name, verbosity.
"Used for highlighting Tramp debug buffers in `outline-mode'.")
(defconst tramp-debug-font-lock-keywords
@@ -1704,8 +1725,7 @@ The outline level is equal to the verbosity of the Tramp
message."
(defun tramp-get-debug-buffer (vec)
"Get the debug buffer for VEC."
- (with-current-buffer
- (get-buffer-create (tramp-debug-buffer-name 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
@@ -1714,92 +1734,93 @@ The outline level is equal to the verbosity of the
Tramp message."
;; `(custom-declare-variable outline-minor-mode-prefix ...)'
;; raises on error in `(outline-mode)', we don't want to see it
;; in the traces.
- (let ((default-directory (tramp-compat-temporary-file-directory))
- signal-hook-function)
+ (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)))
+ (setq-local outline-level 'tramp-debug-outline-level)
+ (setq-local 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)))
+(defun tramp-get-debug-file-name (vec)
+ "Get the debug buffer for VEC."
+ (expand-file-name
+ (tramp-compat-string-replace "/" " " (tramp-debug-buffer-name vec))
+ (tramp-compat-temporary-file-directory)))
+
(defsubst tramp-debug-message (vec fmt-string &rest arguments)
"Append message to debug buffer of VEC.
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))
+ (let ((inhibit-message t)
+ file-name-handler-alist message-log-max signal-hook-function)
+ (with-current-buffer (tramp-get-debug-buffer vec)
+ (goto-char (point-max))
+ (let ((point (point)))
+ ;; Headline.
+ (when (bobp)
(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))))
- ;; 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-debug-message"
- "tramp-error"
- "tramp-error-with-buffer"
- "tramp-message"
- "tramp-signal-hook-function"
- "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.")
+ ";; 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 "")))))
+ ;; Delete debug file.
+ (when (and tramp-debug-to-file (tramp-get-debug-file-name vec))
+ (ignore-errors (delete-file (tramp-get-debug-file-name vec)))))
+ (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 "")
+ (and (symbolp btf) (setq fn (symbol-name btf))
+ (or (not (string-match-p "^tramp" fn))
+ (get btf 'tramp-suppress-trace))
+ (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))
+ ;; Write message to debug file.
+ (when tramp-debug-to-file
+ (ignore-errors
+ (write-region
+ point (point-max) (tramp-get-debug-file-name vec) 'append)))))))
+
+(put #'tramp-debug-message 'tramp-suppress-trace t)
+
+(defvar tramp-inhibit-progress-reporter nil
+ "Show Tramp progress reporter in the minibuffer.
+This variable is used to disable concurrent progress reporter messages.")
(defsubst tramp-message (vec-or-proc level fmt-string &rest arguments)
"Emit a message depending on verbosity level.
@@ -1816,8 +1837,9 @@ 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))
+ ;; Display only when there is a minimum level, and the progress
+ ;; reporter doesn't suppress further messages.
+ (when (and (<= level 3) (null tramp-inhibit-progress-reporter))
(apply #'message
(concat
(cond
@@ -1849,6 +1871,8 @@ applicable)."
(concat (format "(%d) # " level) fmt-string)
arguments))))))
+(put #'tramp-message 'tramp-suppress-trace t)
+
(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
@@ -1859,13 +1883,16 @@ function is meant for debugging purposes."
vec-or-proc 10 "\n%s" (with-output-to-string (backtrace)))
(with-output-to-temp-buffer "*debug tramp*" (backtrace)))))
+(put #'tramp-backtrace 'tramp-suppress-trace t)
+
(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 with
FMT-STRING and ARGUMENTS."
- (let (tramp-message-show-message signal-hook-function)
+ (let ((inhibit-message t)
+ signal-hook-function)
(tramp-backtrace vec-or-proc)
(unless arguments
;; FMT-STRING could be just a file name, as in
@@ -1883,6 +1910,8 @@ FMT-STRING and ARGUMENTS."
(signal signal (list (substring-no-properties
(apply #'format-message fmt-string arguments))))))
+(put #'tramp-error 'tramp-suppress-trace t)
+
(defsubst tramp-error-with-buffer
(buf vec-or-proc signal fmt-string &rest arguments)
"Emit an error, and show BUF.
@@ -1900,13 +1929,13 @@ an input event arrives. The other arguments are passed
to `tramp-error'."
(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))
+ (not non-essential)
;; Show only when Emacs has started already.
(current-message))
- (let ((enable-recursive-minibuffers t))
+ (let ((enable-recursive-minibuffers t)
+ inhibit-message)
;; `tramp-error' does not show messages. So we must do it
;; ourselves.
(apply #'message fmt-string arguments)
@@ -1918,19 +1947,21 @@ an input event arrives. The other arguments are passed
to `tramp-error'."
(when (tramp-file-name-equal-p vec (car tramp-current-connection))
(setcdr tramp-current-connection (current-time)))))))
+(put #'tramp-error-with-buffer 'tramp-suppress-trace t)
+
;; 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 user error (or \"pilot error\")."
(unwind-protect
(apply #'tramp-error vec-or-proc 'user-error fmt-string arguments)
;; Save exit.
- (when (and tramp-message-show-message
- (not (zerop tramp-verbose))
+ (when (and (not (zerop tramp-verbose))
;; Do not show when flagged from outside.
- (not (tramp-completion-mode-p))
+ (not non-essential)
;; Show only when Emacs has started already.
(current-message))
- (let ((enable-recursive-minibuffers t))
+ (let ((enable-recursive-minibuffers t)
+ inhibit-message)
;; `tramp-error' does not show messages. So we must do it ourselves.
(apply #'message fmt-string arguments)
(discard-input)
@@ -1940,18 +1971,21 @@ an input event arrives. The other arguments are passed
to `tramp-error'."
(tramp-file-name-equal-p vec-or-proc (car tramp-current-connection))
(setcdr tramp-current-connection (current-time)))))))
+(put #'tramp-user-error 'tramp-suppress-trace t)
+
(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))
+ (declare (indent 2) (debug (symbolp form body)))
(let ((err (make-symbol "err")))
`(condition-case-unless-debug ,err
(progn ,@body)
(error (tramp-message ,vec-or-proc 3 ,format ,err) nil))))
+(put #'tramp-with-demoted-errors 'tramp-suppress-trace t)
+
;; This function provides traces in case of errors not triggered by
;; Tramp functions.
(defun tramp-signal-hook-function (error-symbol data)
@@ -1963,6 +1997,8 @@ the resulting error message."
(car tramp-current-connection) error-symbol
"%s" (mapconcat (lambda (x) (format "%s" x)) data " "))))
+(put #'tramp-signal-hook-function 'tramp-suppress-trace t)
+
(defmacro with-parsed-tramp-file-name (filename var &rest body)
"Parse a Tramp filename and make components available in the body.
@@ -1979,12 +2015,14 @@ Remaining args are Lisp expressions to be evaluated
(inside an implicit
If VAR is nil, then we bind `v' to the structure and `method', `user',
`domain', `host', `port', `localname', `hop' to the components."
+ (declare (indent 2) (debug (form symbolp body)))
(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))))
+ (mapcar
+ (lambda (elem)
+ `(,(if var (intern (format "%s-%s" var elem)) elem)
+ (,(intern (format "tramp-file-name-%s" elem))
+ ,(or var 'v))))
+ (cdr (mapcar #'car (cl-struct-slot-info 'tramp-file-name))))))
`(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,
@@ -1993,8 +2031,6 @@ If VAR is nil, then we bind `v' to the structure and
`method', `user',
(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 suffix)
@@ -2005,25 +2041,30 @@ If VAR is nil, then we bind `v' to the structure and
`method', `user',
(tramp-compat-progress-reporter-update reporter value suffix))))
(defmacro with-tramp-progress-reporter (vec level message &rest body)
- "Execute BODY, spinning a progress reporter with MESSAGE.
+ "Execute BODY, spinning a progress reporter with MESSAGE in interactive mode.
If LEVEL does not fit for visible messages, there are only traces
without a visible progress reporter."
(declare (indent 3) (debug t))
- `(progn
+ `(if (or noninteractive inhibit-message)
+ (progn ,@body)
(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))))))
+ ;; Start only when there is no other progress reporter
+ ;; running, and when there is a minimum level.
+ (when-let ((pr (and (null tramp-inhibit-progress-reporter)
+ (<= ,level (min tramp-verbose 3))
+ (make-progress-reporter ,message nil nil))))
+ (run-at-time 3 0.1 #'tramp-progress-reporter-update pr))))
(unwind-protect
;; Execute the body.
- (prog1 (progn ,@body) (setq cookie "done"))
+ (prog1
+ ;; Suppress concurrent progress reporter messages.
+ (let ((tramp-inhibit-progress-reporter
+ (or tramp-inhibit-progress-reporter tm)))
+ ,@body)
+ (setq cookie "done"))
;; Stop progress reporter.
(if tm (cancel-timer tm))
(tramp-message ,vec ,level "%s...%s" ,message cookie)))))
@@ -2034,6 +2075,7 @@ without a visible 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."
+ (declare (indent 3) (debug t))
`(if (file-name-absolute-p ,file)
(let ((value (tramp-get-file-property ,vec ,file ,property 'undef)))
(when (eq value 'undef)
@@ -2045,12 +2087,11 @@ FILE must be a local file name on a connection
identified via VEC."
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 execute BODY and set."
+ (declare (indent 2) (debug t))
`(let ((value (tramp-get-connection-property ,key ,property 'undef)))
(when (eq value 'undef)
;; We cannot pass ,@body as parameter to
@@ -2060,8 +2101,6 @@ FILE must be a local file name on a connection identified
via VEC."
(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\\>"))
@@ -2074,12 +2113,15 @@ letter into the file name. This function removes it."
(save-match-data
(let ((quoted (tramp-compat-file-name-quoted-p name 'top))
(result (tramp-compat-file-name-unquote name 'top)))
- (setq result (if (string-match "\\`[a-zA-Z]:/" result)
+ (setq result (if (string-match "\\`[[:alpha:]]:/" result)
(replace-match "/" nil t result) result))
(if quoted (tramp-compat-file-name-quote result 'top) result))))
;;; Config Manipulation Functions:
+(defconst tramp-dns-sd-service-regexp "^_[-[:alnum:]]+\\._tcp$"
+ "DNS-SD service regexp.")
+
(defun tramp-set-completion-function (method function-list)
"Set the list of completion functions for METHOD.
FUNCTION-LIST is a list of entries of the form (FUNCTION FILE).
@@ -2112,10 +2154,10 @@ Example:
(zerop
(tramp-call-process
v "reg" nil nil nil "query" (nth 1 (car v))))))
- ;; Zeroconf service type.
+ ;; DNS-SD service type.
((string-match-p
- "^_[[:alpha:]]+\\._[[:alpha:]]+$" (nth 1 (car v))))
- ;; Configuration file.
+ tramp-dns-sd-service-regexp (nth 1 (car v))))
+ ;; Configuration file or empty string.
(t (file-exists-p (nth 1 (car v))))))
(setq r (delete (car v) r)))
(setq v (cdr v)))
@@ -2153,11 +2195,13 @@ For definition of that list see
`tramp-set-completion-function'."
(defvar tramp-devices 0
"Keeps virtual device numbers.")
-(defun tramp-default-file-modes (filename)
+(defun tramp-default-file-modes (filename &optional flag)
"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)
+If optional FLAG is ‘nofollow’, do not follow FILENAME if it is a
+symbolic link. If the file modes of FILENAME cannot be
+determined, return the value of `default-file-modes', without
+execute permissions."
+ (or (tramp-compat-file-modes filename flag)
(logand (default-file-modes) #o0666)))
(defun tramp-replace-environment-variables (filename)
@@ -2188,6 +2232,7 @@ arguments to pass to the OPERATION."
tramp-vc-file-name-handler
tramp-completion-file-name-handler
tramp-archive-file-name-handler
+ tramp-crypt-file-name-handler
cygwin-mount-name-hook-function
cygwin-mount-map-drive-hook-function
.
@@ -2253,7 +2298,7 @@ Must be handled by the callers."
file-newer-than-file-p rename-file))
(cond
((tramp-tramp-file-p (nth 0 args)) (nth 0 args))
- ((tramp-tramp-file-p (nth 1 args)) (nth 1 args))
+ ((file-name-absolute-p (nth 1 args)) (nth 1 args))
(t default-directory)))
;; FILE DIRECTORY resp FILE1 FILE2.
((eq operation 'expand-file-name)
@@ -2281,13 +2326,13 @@ Must be handled by the callers."
exec-path make-process))
default-directory)
;; PROC.
- ((member operation
- '(file-notify-rm-watch
- ;; Emacs 25+ only.
- file-notify-valid-p))
+ ((member operation '(file-notify-rm-watch file-notify-valid-p))
(when (processp (nth 0 args))
(with-current-buffer (process-buffer (nth 0 args))
default-directory)))
+ ;; VEC.
+ ((member operation '(tramp-get-remote-gid tramp-get-remote-uid))
+ (tramp-make-tramp-file-name (nth 0 args)))
;; Unknown file primitive.
(t (error "Unknown file I/O primitive: %s" operation))))
@@ -2304,37 +2349,23 @@ Must be handled by the callers."
res (cdr elt))))
res)))
-;; 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."
+ (if-let ((p (and (tramp-connectable-p vec)
+ (tramp-get-connection-process vec))))
+ (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 for OPERATION and ARGS.
-Fall back to normal file name handler if no Tramp file name handler exists."
+Fall 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))
;; `file-remote-p' is called for everything, even for symbolic
;; links which look remote. We don't want to get an error.
@@ -2343,88 +2374,95 @@ Fall back to normal file name handler if no Tramp file
name handler exists."
(save-match-data
(setq filename (tramp-replace-environment-variables filename))
(with-parsed-tramp-file-name filename nil
- (let ((current-connection tramp-current-connection)
- (foreign
- (tramp-find-foreign-file-name-handler filename operation))
- (signal-hook-function #'tramp-signal-hook-function)
- result)
- ;; Set `tramp-current-connection'.
- (unless
- (tramp-file-name-equal-p v (car tramp-current-connection))
- (setq tramp-current-connection (list v)))
-
- ;; Call the backend function.
- (unwind-protect
- (if foreign
- (let ((sf (symbol-function foreign)))
- ;; 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)
- ;; FIXME: Not clear why we need these bindings here.
- ;; The explanation above is not convincing and
- ;; the bug#9114 for which it was added doesn't
- ;; clarify the core of the problem.
- (let ((default-directory
- (tramp-compat-temporary-file-directory))
- file-name-handler-alist)
- (autoload-do-load sf foreign)))
- ;; (tramp-message
- ;; v 4 "Running `%s'..." (cons operation args))
- ;; 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
- v '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)
+ ;; 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)
+ ;; Run only when Emacs is idle.
+ (tramp-compat-funcall 'check-idle-thread)
+ (let ((current-connection tramp-current-connection)
+ (foreign
+ (tramp-find-foreign-file-name-handler filename operation))
+ (signal-hook-function #'tramp-signal-hook-function)
+ result)
+ ;; Set `tramp-current-connection'.
+ (unless
+ (tramp-file-name-equal-p v (car tramp-current-connection))
+ (setq tramp-current-connection (list v)))
+
+ ;; Call the backend function.
+ (unwind-protect
+ (if foreign
+ (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)
+ ;; FIXME: Not clear why we need these bindings
here.
+ ;; The explanation above is not convincing and
+ ;; the bug#9114 for which it was added doesn't
+ ;; clarify the core of the problem.
+ (let ((default-directory
+ (tramp-compat-temporary-file-directory))
+ file-name-handler-alist)
+ (autoload-do-load sf foreign)))
+ ;; (tramp-message
+ ;; v 4 "Running `%s'..." (cons operation args))
+ ;; Switch process thread.
+ (when (and tramp-mutex
+ (tramp-connectable-p v)
+ (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
+ (apply foreign operation args))))
+ ;; (tramp-message
+ ;; v 4 "Running `%s'...`%s'" (cons operation args)
result)
+ (cond
+ ((eq result 'non-essential)
(tramp-message
- v 1 "Suppress received in operation %s"
+ v 5 "Non-essential received in operation %s"
(cons operation args))
- (tramp-cleanup-connection v t)
- (tramp-run-real-handler operation args)))
- (t result)))
-
- ;; 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))
-
- ;; Reset `tramp-current-connection'.
- (unless
- (tramp-file-name-equal-p
- (car current-connection) (car tramp-current-connection))
- (setq tramp-current-connection current-connection))))))
+ (tramp-run-real-handler operation args))
+ ((eq result 'suppress)
+ (let ((inhibit-message t))
+ (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)))
+
+ ;; 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))
+
+ ;; Reset `tramp-current-connection'.
+ (unless
+ (tramp-file-name-equal-p
+ (car current-connection) (car tramp-current-connection))
+ (setq tramp-current-connection current-connection)))))))
;; When `tramp-mode' is not enabled, or the file name is quoted,
;; we don't do anything.
@@ -2433,18 +2471,21 @@ Fall back to normal file name handler if no Tramp file
name handler exists."
(defun tramp-completion-file-name-handler (operation &rest args)
"Invoke Tramp file name completion handler for OPERATION and ARGS.
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))))
+ (if-let
+ ((fn (and tramp-mode
+ (assoc operation tramp-completion-file-name-handler-alist))))
+ (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)))
+ (when tramp-mode
+ ;; We cannot use `tramp-compat-temporary-file-directory' here due
+ ;; to autoload.
+ (let ((default-directory temporary-file-directory))
+ (load "tramp" 'noerror 'nomessage)))
(apply operation args)))
;; `tramp-autoload-file-name-handler' must be registered before
@@ -2456,7 +2497,7 @@ Falls back to normal file name handler if no Tramp file
name handler exists."
(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)))
+ (put #'tramp-autoload-file-name-handler 'safe-magic t)))
;;;###autoload (tramp-register-autoload-file-name-handlers)
@@ -2492,34 +2533,36 @@ remote file names."
(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
+ ;; property of `tramp-file-name-handler',
+ ;; `tramp-archive-file-name-handler' and
+ ;; `tramp-crypt-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)
+ (put #'tramp-file-name-handler 'safe-magic t)
+
+ (tramp-register-crypt-file-name-handler)
(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)
+ (put #'tramp-completion-file-name-handler 'safe-magic t)
;; Mark `operations' the handler is responsible for.
- (put 'tramp-completion-file-name-handler 'operations
+ (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))
+ (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)))))))
+ (when-let ((entry (rassoc fnh file-name-handler-alist)))
+ (setq file-name-handler-alist
+ (cons entry (delete entry file-name-handler-alist))))))
(tramp--with-startup (tramp-register-file-name-handlers))
@@ -2531,7 +2574,7 @@ 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
+ (put #'tramp-file-name-handler
'operations
(delete-dups
(append
@@ -2572,24 +2615,11 @@ Add operations defined in `HANDLER-alist' to
`tramp-file-name-handler'."
;;; 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 (vec-or-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
+ (let ((tramp-verbose 0)
(vec
(cond
((tramp-file-name-p vec-or-filename) vec-or-filename)
@@ -2599,7 +2629,7 @@ not in completion mode."
;; `tramp-buffer-name'; otherwise `start-file-process'
;; wouldn't run ever when `non-essential' is non-nil.
(and vec (process-live-p (get-process (tramp-buffer-name vec))))
- (not (tramp-completion-mode-p)))))
+ (not non-essential))))
;; Method, host name and user name completion.
;; `tramp-completion-dissect-file-name' returns a list of
@@ -2890,7 +2920,7 @@ Either user or host may be nil."
(defun tramp-parse-rhosts-group ()
"Return a (user host) tuple allowed to access.
Either user or host may be nil."
- (let ((result)
+ (let (result
(regexp
(concat
"^\\(" tramp-host-regexp "\\)"
@@ -2940,7 +2970,7 @@ User is always nil."
"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$")))
+ dirname (concat "^key_[[:digit:]]+_\\(" tramp-host-regexp "\\)\\.pub$")))
(defun tramp-parse-sknownhosts (dirname)
"Return a list of (user host) tuples allowed to access.
@@ -2975,7 +3005,7 @@ Host is always \"localhost\"."
(defun tramp-parse-passwd-group ()
"Return a (user host) tuple allowed to access.
Host is always \"localhost\"."
- (let ((result)
+ (let (result
(regexp (concat "^\\(" tramp-user-regexp "\\):")))
(when (re-search-forward regexp (point-at-eol) t)
(setq result (list (match-string 1) "localhost")))
@@ -2997,7 +3027,7 @@ Host is always \"localhost\"."
(defun tramp-parse-etc-group-group ()
"Return a (group host) tuple allowed to access.
Host is always \"localhost\"."
- (let ((result)
+ (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")))
@@ -3034,7 +3064,7 @@ User is always nil."
(defun tramp-parse-putty-group (registry)
"Return a (user host) tuple allowed to access.
User is always nil."
- (let ((result)
+ (let (result
(regexp (concat (regexp-quote registry) "\\\\\\(.+\\)")))
(when (re-search-forward regexp (point-at-eol) t)
(setq result (list nil (match-string 1))))
@@ -3108,8 +3138,7 @@ User is always nil."
(setq directory (substring directory 0 -1)))
directory)
-(defun tramp-handle-directory-files
- (directory &optional full match nosort _count)
+(defun tramp-handle-directory-files (directory &optional full match nosort
count)
"Like `directory-files' for Tramp files."
(unless (file-exists-p directory)
(tramp-error
@@ -3125,16 +3154,20 @@ User is always nil."
(when (or (null match) (string-match-p match item))
(push (if full (concat directory item) item)
result)))
- (if nosort result (sort result #'string<)))))
+ (unless nosort
+ (setq result (sort result #'string<)))
+ (when (and (natnump count) (> count 0))
+ (setq result (nbutlast result (- (length result) count))))
+ result)))
(defun tramp-handle-directory-files-and-attributes
- (directory &optional full match nosort id-format _count)
+ (directory &optional full match nosort id-format count)
"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)))
+ (tramp-compat-directory-files directory full match nosort count)))
(defun tramp-handle-dired-uncache (dir)
"Like `dired-uncache' for Tramp files."
@@ -3214,12 +3247,13 @@ User is always nil."
(copy-file filename tmpfile 'ok-if-already-exists 'keep-time)
tmpfile)))
-(defun tramp-handle-file-modes (filename &optional _flag)
+(defun tramp-handle-file-modes (filename &optional flag)
"Like `file-modes' for Tramp files."
- ;; Starting with Emacs 25.1, `when-let' can be used.
- (let ((attrs (file-attributes (or (file-truename filename) filename))))
- (when attrs
- (tramp-mode-string-to-int (tramp-compat-file-attribute-modes attrs)))))
+ (when-let ((attrs (file-attributes filename))
+ (mode-string (tramp-compat-file-attribute-modes attrs)))
+ (if (and (not (eq flag 'nofollow)) (eq ?l (aref mode-string 0)))
+ (file-modes (file-truename filename))
+ (tramp-mode-string-to-int mode-string))))
;; Localname manipulation functions that grok Tramp localnames...
(defun tramp-handle-file-name-as-directory (file)
@@ -3257,12 +3291,13 @@ User is always nil."
(let ((candidate
(tramp-compat-file-name-unquote
(directory-file-name filename)))
+ case-fold-search
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-file-local-name candidate))
+ "[[:lower:]]" (tramp-file-local-name candidate))
(not (file-exists-p candidate)))
(setq candidate
(directory-file-name
@@ -3271,8 +3306,8 @@ User is always nil."
;; 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-file-local-name candidate))
+ (unless (string-match-p
+ "[[:lower:]]" (tramp-file-local-name candidate))
(setq tmpfile
(let ((default-directory
(file-name-directory filename)))
@@ -3337,21 +3372,18 @@ User is always nil."
(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))))))
+ (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)
;; Sometimes, `file-attributes' does not return a proper value
;; even if `file-exists-p' does.
- (ignore-errors
- (eq ?-
- (aref
- (tramp-compat-file-attribute-modes (file-attributes filename))
- 0)))))
+ (when-let ((attr (file-attributes filename)))
+ (eq ?- (aref (tramp-compat-file-attribute-modes attr) 0)))))
(defun tramp-handle-file-remote-p (filename &optional identification connected)
"Like `file-remote-p' for Tramp files."
@@ -3390,8 +3422,7 @@ User is always nil."
"Like `file-truename' for Tramp files."
;; Preserve trailing "/".
(funcall
- (if (tramp-compat-directory-name-p filename)
- #'file-name-as-directory #'identity)
+ (if (directory-name-p filename) #'file-name-as-directory #'identity)
;; Quote properly.
(funcall
(if (tramp-compat-file-name-quoted-p filename)
@@ -3403,6 +3434,8 @@ User is always nil."
;; something is wrong; otherwise they might think that Emacs
;; is hung. Of course, correctness has to come first.
(numchase-limit 20)
+ ;; Unquoting could enable encryption.
+ tramp-crypt-enabled
symlink-target)
(with-parsed-tramp-file-name result v1
;; We cache only the localname.
@@ -3462,7 +3495,7 @@ User is always nil."
"Like `insert-directory' for Tramp files."
(unless switches (setq switches ""))
;; Mark trailing "/".
- (when (and (tramp-compat-directory-name-p filename)
+ (when (and (directory-name-p filename)
(not full-directory-p))
(setq switches (concat switches "F")))
;; Check, whether directory is accessible.
@@ -3472,7 +3505,7 @@ User is always nil."
(with-tramp-progress-reporter v 0 (format "Opening directory %s" filename)
(let (ls-lisp-use-insert-directory-program start)
;; Silence byte compiler.
- ls-lisp-use-insert-directory-program
+ (ignore ls-lisp-use-insert-directory-program)
(tramp-run-real-handler
#'insert-directory
(list filename switches wildcard full-directory-p))
@@ -3521,10 +3554,10 @@ User is always nil."
;; When we shall insert only a part of the file, we
;; copy this part. This works only for the shell file
- ;; name handlers.
+ ;; name handlers. It doesn't work for crypted files.
(when (and (or beg end)
- (tramp-get-method-parameter
- v 'tramp-login-program))
+ (tramp-sh-file-name-handler-p v)
+ (null tramp-crypt-enabled))
(setq remote-copy (tramp-make-tramp-temp-file v))
;; This is defined in tramp-sh.el. Let's assume
;; this is loaded already.
@@ -3596,8 +3629,8 @@ User is always nil."
;; Save exit.
(progn
(when visit
- (setq buffer-file-name filename)
- (setq buffer-read-only (not (file-writable-p filename)))
+ (setq buffer-file-name filename
+ buffer-read-only (not (file-writable-p filename)))
(set-visited-file-modtime)
(set-buffer-modified-p nil))
(when (and (stringp local-copy)
@@ -3631,7 +3664,8 @@ User is always nil."
v tramp-file-missing "Cannot load nonexistent file `%s'" file))
(if (not (file-exists-p file))
nil
- (let ((tramp-message-show-message (not nomessage)))
+ (let ((signal-hook-function (unless noerror signal-hook-function))
+ (inhibit-message (or inhibit-message nomessage)))
(with-tramp-progress-reporter v 0 (format "Loading %s" file)
(let ((local-copy (file-local-copy file)))
(unwind-protect
@@ -3639,8 +3673,241 @@ User is always nil."
(delete-file local-copy)))))
t)))
+(defun tramp-multi-hop-p (vec)
+ "Whether the method of VEC is capable of multi-hops."
+ (and (tramp-sh-file-name-handler-p vec)
+ (not (tramp-get-method-parameter vec 'tramp-copy-program))))
+
+(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))
+ (unless (tramp-multi-hop-p item)
+ (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-direct-async-process-p (&rest args)
+ "Whether direct async `make-process' can be called."
+ (let ((v (tramp-dissect-file-name default-directory))
+ (buffer (plist-get args :buffer))
+ (stderr (plist-get args :stderr)))
+ (and ;; It has been indicated.
+ (tramp-get-connection-property v "direct-async-process" nil)
+ ;; There's no multi-hop.
+ (or (not (tramp-multi-hop-p v))
+ (= (length (tramp-compute-multi-hops v)) 1))
+ ;; There's no remote stdout or stderr file.
+ (or (not (stringp buffer)) (not (tramp-tramp-file-p buffer)))
+ (or (not (stringp stderr)) (not (tramp-tramp-file-p stderr))))))
+
+(defun tramp-handle-make-process (&rest args)
+ "An alternative `make-process' implementation for Tramp files.
+It does not support `:stderr'."
+ (when args
+ (with-parsed-tramp-file-name (expand-file-name default-directory) nil
+ (let ((default-directory (tramp-compat-temporary-file-directory))
+ (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))
+ (signal 'wrong-type-argument (list #'bufferp 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)))
+ ;; We use as environment the difference to toplevel
+ ;; `process-environment'.
+ (env (mapcar
+ (lambda (elt)
+ (unless
+ (member
+ elt (default-toplevel-value 'process-environment))
+ (when (string-match-p "=" elt) elt)))
+ process-environment))
+ (env (setenv-internal
+ env "INSIDE_EMACS"
+ (concat (or (getenv "INSIDE_EMACS") emacs-version)
+ ",tramp:" tramp-version)
+ 'keep))
+ (env (mapcar #'tramp-shell-quote-argument (delq nil env)))
+ ;; Quote command.
+ (command (mapconcat #'tramp-shell-quote-argument command " "))
+ ;; Set cwd and environment variables.
+ (command
+ (append `("cd" ,localname "&&" "(" "env") env `(,command ")"))))
+
+ ;; Check for `tramp-sh-file-name-handler', because something
+ ;; is different between tramp-adb.el and tramp-sh.el.
+ (let* ((sh-file-name-handler-p (tramp-sh-file-name-handler-p v))
+ (login-program
+ (tramp-get-method-parameter v 'tramp-login-program))
+ (login-args
+ (tramp-get-method-parameter v 'tramp-login-args))
+ (async-args
+ (tramp-get-method-parameter v 'tramp-async-args))
+ (direct-async-args
+ (tramp-get-method-parameter v 'tramp-direct-async-args))
+ ;; 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
+ (when sh-file-name-handler-p
+ (with-tramp-connection-property
+ (tramp-get-process v) "temp-file"
+ (tramp-compat-make-temp-name))))
+ (options
+ (when sh-file-name-handler-p
+ (tramp-compat-funcall
+ 'tramp-ssh-controlmaster-options v)))
+ spec p)
+
+ ;; Replace `login-args' place holders.
+ (setq
+ spec (format-spec-make ?t tmpfile)
+ options (format-spec (or options "") spec)
+ spec (format-spec-make
+ ?h (or host "") ?u (or user "") ?p (or port "")
+ ?c options ?l "")
+ ;; Add arguments for asynchronous processes.
+ login-args (append async-args direct-async-args login-args)
+ ;; Expand format spec.
+ login-args
+ (tramp-compat-flatten-tree
+ (mapcar
+ (lambda (x)
+ (setq x (mapcar (lambda (y) (format-spec y spec)) x))
+ (unless (member "" x) x))
+ login-args))
+ ;; Split ControlMaster options.
+ login-args
+ (tramp-compat-flatten-tree
+ (mapcar (lambda (x) (split-string x " ")) login-args))
+ p (make-process
+ :name name :buffer buffer
+ :command (append `(,login-program) login-args command)
+ :coding coding :noquery noquery :connection-type connection-type
+ :filter filter :sentinel sentinel :stderr stderr))
+
+ (tramp-message v 6 "%s" (string-join (process-command p) " "))
+ p))))))
+
(defun tramp-handle-make-symbolic-link
- (target linkname &optional ok-if-already-exists)
+ (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."
@@ -3653,8 +3920,7 @@ support symbolic links."
(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)
+(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))
@@ -3673,9 +3939,12 @@ support symbolic links."
(setq current-buffer-p t)
(current-buffer))
(t (get-buffer-create
+ ;; These variables have been introduced with Emacs 28.1.
(if asynchronous
- "*Async Shell Command*"
- "*Shell Command Output*")))))
+ (or (bound-and-true-p shell-command-buffer-name-async)
+ "*Async Shell Command*")
+ (or (bound-and-true-p shell-command-buffer-name)
+ "*Shell Command Output*"))))))
(error-buffer
(cond
((bufferp error-buffer) error-buffer)
@@ -3809,7 +4078,8 @@ support symbolic links."
(defun tramp-handle-start-file-process (name buffer program &rest args)
"Like `start-file-process' for Tramp files.
BUFFER might be a list, in this case STDERR is separated."
- ;; `make-process' knows the `:file-handler' argument since Emacs 27.1 only.
+ ;; `make-process' knows the `:file-handler' argument since Emacs
+ ;; 27.1 only. Therefore, we invoke it via `tramp-file-name-handler'.
(tramp-file-name-handler
'make-process
:name name
@@ -3917,7 +4187,14 @@ of."
(tramp-error v 'file-already-exists filename))
(let ((tmpfile (tramp-compat-make-temp-file filename))
- (modes (save-excursion (tramp-default-file-modes filename))))
+ (modes (tramp-default-file-modes
+ filename (and (eq mustbenew 'excl) 'nofollow)))
+ (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))))
(when (and append (file-exists-p filename))
(copy-file filename tmpfile 'ok))
;; The permissions of the temporary file should be set. If
@@ -3936,15 +4213,19 @@ of."
(error
(delete-file tmpfile)
(tramp-error
- v 'file-error "Couldn't write region to `%s'" filename))))
+ v 'file-error "Couldn't write region to `%s'" filename)))
- (tramp-flush-file-properties v 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))))
+ ;; Set file modification time.
+ (when (or (eq visit t) (stringp visit))
+ (set-visited-file-modtime
+ (or (tramp-compat-file-attribute-modification-time
+ (file-attributes filename))
+ (current-time))))
+
+ ;; Set the ownership.
+ (tramp-set-file-uid-gid filename uid gid))
;; The end.
(when (and (null noninteractive)
@@ -3998,7 +4279,7 @@ of."
"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)))
+ (file-notify-rm-watch proc)))
;;; Functions for establishing connection:
@@ -4140,9 +4421,9 @@ See `tramp-process-actions' for the format of ACTIONS."
(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))
+ (setq item (pop todo)
+ pattern (format "\\(%s\\)\\'" (symbol-value (nth 0 item)))
+ action (nth 1 item))
(tramp-message
vec 5 "Looking for regexp \"%s\" from remote shell" pattern)
(when (tramp-check-for-regexp proc pattern)
@@ -4192,9 +4473,8 @@ performed successfully. Any other value means an error."
(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)))))
+ (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)))
@@ -4215,10 +4495,9 @@ performed successfully. Any other value means an error."
(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]'"))))
+ (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"
@@ -4230,21 +4509,52 @@ performed successfully. Any other value means an
error."
;;; Utility functions:
+;; 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 lock each
+;; connection process separately by a connection property.
+
+(defmacro with-tramp-locked-connection (proc &rest body)
+ "Lock PROC for other communication, and run BODY.
+Mostly useful to protect BODY from being interrupted by timers."
+ (declare (indent 1) (debug t))
+ `(if (tramp-get-connection-property ,proc "locked" nil)
+ ;; Be kind for older Emacsen.
+ (if (member 'remote-file-error debug-ignored-errors)
+ (throw 'non-essential 'non-essential)
+ (tramp-error
+ ,proc 'remote-file-error "Forbidden reentrant call of Tramp"))
+ (unwind-protect
+ (progn
+ (tramp-set-connection-property ,proc "locked" t)
+ ,@body)
+ (tramp-flush-connection-property ,proc "locked"))))
+
+(font-lock-add-keywords
+ 'emacs-lisp-mode '("\\<with-tramp-locked-connection\\>"))
+
(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."
+for process communication also.
+If the user quits via `C-g', it is propagated up to `tramp-file-name-handler'."
(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))
+ ;; This must be protected by the "locked" property.
+ (with-tramp-locked-connection proc
+ ;; JUST-THIS-ONE is set due to Bug#12145. `with-local-quit'
+ ;; returns t in order to report success.
+ (if (with-local-quit
+ (setq result (accept-process-output proc timeout nil t)) t)
+ (tramp-message
+ proc 10 "%s %s %s %s\n%s"
+ proc timeout (process-status proc) result (buffer-string))
+ ;; Propagate quit.
+ (keyboard-quit)))
result)))
(defun tramp-search-regexp (regexp)
@@ -4361,19 +4671,21 @@ the remote host use line-endings as defined in the
variable
(unless (or (string-empty-p 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))))))
+ ;; This must be protected by the "locked" property.
+ (with-tramp-locked-connection p
+ ;; 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."
@@ -4402,7 +4714,7 @@ 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'.
+;; Comparison 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
@@ -4423,6 +4735,7 @@ If both files are local, the function returns t."
(and (tramp-tramp-file-p file1) (tramp-tramp-file-p file2)
(string-equal (file-remote-p file1) (file-remote-p file2)))))
+;; See also `file-modes-symbolic-to-number'.
(defun tramp-mode-string-to-int (mode-string)
"Convert a ten-letter \"drwxrwxrwx\"-style MODE-STRING into mode bits."
(let* (case-fold-search
@@ -4502,6 +4815,7 @@ If both files are local, the function returns t."
"A list of file types returned from the `stat' system call.
This is used to map a mode number to a permission string.")
+;; See also `file-modes-number-to-symbolic'.
(defun tramp-file-mode-from-int (mode)
"Turn an integer representing a file MODE into an ls(1)-like string."
(let ((type (cdr
@@ -4512,9 +4826,9 @@ This is used to map a mode number to a permission
string.")
(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"))
+ (setq user (tramp-file-mode-permissions user suid "s")
+ group (tramp-file-mode-permissions group sgid "s")
+ other (tramp-file-mode-permissions other sticky "t"))
(concat type user group other)))
(defun tramp-file-mode-permissions (perm suid suid-text)
@@ -4544,16 +4858,15 @@ If FILENAME is remote, a file name handler is called."
(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 systems, "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)
- (tramp-unquote-shell-quote-argument filename)))))))
+ (if-let ((handler (find-file-name-handler filename 'tramp-set-file-uid-gid)))
+ (funcall handler #'tramp-set-file-uid-gid filename uid gid)
+ ;; On W32 systems, "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)
+ (tramp-unquote-shell-quote-argument filename))))))
(defun tramp-get-local-uid (id-format)
"The uid of the local user, in ID-FORMAT.
@@ -4619,12 +4932,8 @@ be granted."
(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))
+ (remote-uid (tramp-get-remote-uid vec (intern suffix)))
+ (remote-gid (tramp-get-remote-gid vec (intern suffix)))
(unknown-id
(if (string-equal suffix "string")
tramp-unknown-id-string tramp-unknown-id-integer)))
@@ -4658,6 +4967,32 @@ be granted."
(tramp-compat-file-attribute-group-id
file-attr))))))))))))
+(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)
+ (or (when-let
+ ((handler
+ (find-file-name-handler
+ (tramp-make-tramp-file-name vec) 'tramp-get-remote-uid)))
+ (funcall handler #'tramp-get-remote-uid vec id-format))
+ ;; Ensure there is a valid result.
+ (and (equal id-format 'integer) tramp-unknown-id-integer)
+ (and (equal id-format 'string) tramp-unknown-id-string))))
+
+(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)
+ (or (when-let
+ ((handler
+ (find-file-name-handler
+ (tramp-make-tramp-file-name vec) 'tramp-get-remote-uid)))
+ (funcall handler #'tramp-get-remote-gid vec id-format))
+ ;; Ensure there is a valid result.
+ (and (equal id-format 'integer) tramp-unknown-id-integer)
+ (and (equal id-format 'string) tramp-unknown-id-string))))
+
(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."
@@ -4671,16 +5006,16 @@ This handles also chrooted environments, which are not
regarded as local."
;; 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)
+ (tramp-sh-file-name-handler-p vec)
+ ;; Direct actions aren't possible for crypted directories.
+ (null tramp-crypt-enabled)
;; 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))))))
+ (zerop (tramp-get-remote-uid vec 'integer))))))
(defun tramp-get-remote-tmpdir (vec)
"Return directory for temporary files on the remote host identified by VEC."
@@ -4693,18 +5028,21 @@ This handles also chrooted environments, which are not
regarded as local."
(tramp-error vec 'file-error "Directory %s not accessible" dir))
dir)))
+(defun tramp-make-tramp-temp-name (vec)
+ "Generate a temporary file name on the remote host identified by VEC."
+ (make-temp-name
+ (expand-file-name tramp-temp-name-prefix (tramp-get-remote-tmpdir vec))))
+
(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)
+ (let (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))
+ (setq result (tramp-make-tramp-temp-name vec))
(if (file-exists-p result)
(setq result nil)
;; This creates the file by side effect.
@@ -4877,6 +5215,19 @@ verbosity of 6."
(tramp-message vec 6 "%s" result)
result))
+(defun tramp-process-running-p (process-name)
+ "Return t if system process PROCESS-NAME is running for `user-login-name'."
+ (when (stringp process-name)
+ (catch 'result
+ (dolist (pid (list-system-processes))
+ (when-let ((attributes (process-attributes pid))
+ (comm (cdr (assoc 'comm attributes))))
+ (and (string-equal (cdr (assoc 'user attributes)) (user-login-name))
+ ;; The returned command name could be truncated to 15
+ ;; characters. Therefore, we cannot check for `string-equal'.
+ (string-prefix-p comm process-name)
+ (throw 'result t)))))))
+
(defun tramp-read-passwd (proc &optional prompt)
"Read a password from user (compat function).
Consults the auth-source package.
@@ -4899,6 +5250,8 @@ Invokes `password-read' if available, `read-passwd' else."
(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)))
+ ;; Use connection-local value.
+ (auth-sources (with-current-buffer (process-buffer proc) auth-sources))
;; We suspend the timers while reading the password.
(stimers (with-timeout-suspend))
auth-info auth-passwd)
@@ -4939,7 +5292,7 @@ Invokes `password-read' if available, `read-passwd' else."
(setq auth-passwd (funcall auth-passwd)))
auth-passwd)
- ;; Try the password cache.
+ ;; Try the password cache. Exists since Emacs 26.1.
(progn
(setq auth-passwd (password-read pw-prompt key)
tramp-password-save-function
@@ -5043,7 +5396,9 @@ name of a process or buffer, or nil to default to the
current buffer."
(tramp-compat-funcall
'tramp-send-command
(process-get proc 'vector)
- (format "(\\kill -2 -%d || \\kill -2 %d) 2>/dev/null" pid pid))
+ (format "(\\kill -2 -%d || \\kill -2 %d) 2>%s"
+ pid pid
+ (tramp-get-remote-null-device (process-get proc 'vector))))
;; Wait, until the process has disappeared. If it doesn't,
;; fall back to the default implementation.
(while (tramp-accept-process-output proc 0))
@@ -5057,6 +5412,32 @@ name of a process or buffer, or nil to default to the
current buffer."
(lambda ()
(remove-hook 'interrupt-process-functions #'tramp-interrupt-process))))
+(defun tramp-get-remote-null-device (vec)
+ "Return null device on the remote host identified by VEC.
+If VEC is nil, return local null device."
+ (if (null vec)
+ null-device
+ (with-tramp-connection-property vec "null-device"
+ (let ((default-directory (tramp-make-tramp-file-name vec)))
+ (tramp-compat-null-device)))))
+
+(defmacro tramp-skeleton-delete-directory (directory recursive trash &rest
body)
+ "Skeleton for `tramp-*-handle-delete-directory'.
+BODY is the backend specific code."
+ (declare (indent 3) (debug t))
+ `(with-parsed-tramp-file-name (expand-file-name ,directory) nil
+ (if (and delete-by-moving-to-trash ,trash)
+ ;; Move non-empty dir to trash only if recursive deletion was
+ ;; requested.
+ (if (not (or ,recursive (tramp-compat-directory-empty-p ,directory)))
+ (tramp-error
+ v 'file-error "Directory is not empty, not moving to trash")
+ (move-file-to-trash ,directory))
+ ,@body)
+ (tramp-flush-directory-properties v localname)))
+
+(put #'tramp-skeleton-delete-directory 'tramp-suppress-trace t)
+
;; Checklist for `tramp-unload-hook'
;; - Unload all `tramp-*' packages
;; - Reset `file-name-handler-alist'
@@ -5098,16 +5479,5 @@ name of a process or buffer, or nil to default to the
current buffer."
;; 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
deleted file mode 100644
index 8f46c50..0000000
--- a/tramp.info
+++ /dev/null
@@ -1,489 +0,0 @@
-This is tramp.info, produced by makeinfo version 6.7 from
-doclicense.texi.
-
- Version 1.3, 3 November 2008
-
- Copyright (C) 2000, 2001, 2002, 2007, 2008, 2009 Free Software
Foundation, Inc.
- <https://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
- <https://www.gnu.org/licenses/>.
-
- 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.
-
-
-
-Tag Table:
-
-End Tag Table
-
-
-Local Variables:
-coding: utf-8
-End:
diff --git a/trampver.el b/trampver.el
index 47a536d..85a2964 100644
--- a/trampver.el
+++ b/trampver.el
@@ -7,6 +7,10 @@
;; Maintainer: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
;; Package: tramp
+;; Version: 0
+;; Package-Requires: ((emacs "25.1"))
+;; Package-Type: multi
+;; URL: https://www.gnu.org/software/tramp/
;; This file is part of GNU Emacs.
@@ -30,16 +34,13 @@
;;; Code:
-;; In the Tramp GIT, the version number is auto-frobbed from tramp.el,
-;; and the bug report address is auto-frobbed from configure.ac.
-;; Emacs version check is defined in macro AC_EMACS_INFO of
-;; aclocal.m4; should be changed only there.
-
-;; Needed for Emacs 24.
-(defvar inhibit-message)
+;; In the Tramp GIT repository, the version number, the bug report
+;; address and the required Emacs version are auto-frobbed from
+;; configure.ac, so you should edit that file and run "autoconf &&
+;; ./configure" to change them.
;;;###tramp-autoload
-(defconst tramp-version "2.4.4.4"
+(defconst tramp-version "0"
"This version of Tramp.")
;;;###tramp-autoload
@@ -73,9 +74,9 @@
"The repository revision of the Tramp sources.")
;; Check for Emacs version.
-(let ((x (if (not (string-lessp emacs-version "24.4"))
+(let ((x (if (not (string-lessp emacs-version "25.1"))
"ok"
- (format "Tramp 2.4.4.4 is not fit for %s"
+ (format "Tramp 0 is not fit for %s"
(replace-regexp-in-string "\n" "" (emacs-version))))))
(unless (string-equal "ok" x) (error "%s" x)))
@@ -95,7 +96,7 @@
("2.2.13.25.2" . "25.3")
("2.3.3" . "26.1") ("2.3.3.26.1" . "26.1") ("2.3.5.26.2" . "26.2")
("2.3.5.26.3" . "26.3")
- ("2.4.3.27.1" . "27.1")))
+ ("2.4.3.27.1" . "27.1") ("2.4.5.27.2" . "27.2")))
(add-hook 'tramp-unload-hook
(lambda ()
@@ -104,8 +105,3 @@
(provide 'trampver)
;;; trampver.el ends here
-
-;; Local Variables:
-;; mode: Emacs-Lisp
-;; coding: utf-8
-;; End:
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [elpa] externals/tramp d982d7e: Sync with Tramp repository,
Michael Albinus <=