summaryrefslogtreecommitdiff
path: root/lisp/net
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/net')
-rw-r--r--lisp/net/ange-ftp.el2
-rw-r--r--lisp/net/dns.el16
-rw-r--r--lisp/net/ldap.el2
-rw-r--r--lisp/net/newst-backend.el2
-rw-r--r--lisp/net/nsm.el6
-rw-r--r--lisp/net/rcirc.el8
-rw-r--r--lisp/net/sasl-scram-sha256.el59
-rw-r--r--lisp/net/sasl.el5
-rw-r--r--lisp/net/tramp-adb.el136
-rw-r--r--lisp/net/tramp-archive.el21
-rw-r--r--lisp/net/tramp-cache.el30
-rw-r--r--lisp/net/tramp-cmds.el2
-rw-r--r--lisp/net/tramp-compat.el86
-rw-r--r--lisp/net/tramp-gvfs.el561
-rw-r--r--lisp/net/tramp-rclone.el11
-rw-r--r--lisp/net/tramp-sh.el254
-rw-r--r--lisp/net/tramp-smb.el94
-rw-r--r--lisp/net/tramp-sudoedit.el25
-rw-r--r--lisp/net/tramp-uu.el5
-rw-r--r--lisp/net/tramp.el303
-rw-r--r--lisp/net/trampver.el14
21 files changed, 1043 insertions, 599 deletions
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index 1d456044901..f28394260dd 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -838,7 +838,7 @@ If nil, prompt the user for a password."
"If non-nil, regexp matching hosts on which `dir' command lists directory."
:group 'ange-ftp
:type '(choice (const :tag "Default" nil)
- string))
+ regexp))
(defcustom ange-ftp-binary-file-name-regexp ""
"If a file matches this regexp then it is transferred in binary mode."
diff --git a/lisp/net/dns.el b/lisp/net/dns.el
index cefe0851f03..78d48271629 100644
--- a/lisp/net/dns.el
+++ b/lisp/net/dns.el
@@ -258,10 +258,8 @@ If TCP-P, the first two bytes of the package with be the length field."
(nreverse spec))))
(defun dns-read-int32 ()
- ;; Full 32 bit Integers can't be handled by 32-bit Emacsen. If we
- ;; use floats, it works.
- (format "%.0f" (+ (* (dns-read-bytes 1) 16777216.0)
- (dns-read-bytes 3))))
+ (declare (obsolete nil "28.1"))
+ (number-to-string (dns-read-bytes 4)))
(defun dns-read-type (string type)
(let ((buffer (current-buffer))
@@ -286,11 +284,11 @@ If TCP-P, the first two bytes of the package with be the length field."
((eq type 'SOA)
(list (list 'mname (dns-read-name buffer))
(list 'rname (dns-read-name buffer))
- (list 'serial (dns-read-int32))
- (list 'refresh (dns-read-int32))
- (list 'retry (dns-read-int32))
- (list 'expire (dns-read-int32))
- (list 'minimum (dns-read-int32))))
+ (list 'serial (dns-read-bytes 4))
+ (list 'refresh (dns-read-bytes 4))
+ (list 'retry (dns-read-bytes 4))
+ (list 'expire (dns-read-bytes 4))
+ (list 'minimum (dns-read-bytes 4))))
((eq type 'SRV)
(list (list 'priority (dns-read-bytes 2))
(list 'weight (dns-read-bytes 2))
diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el
index e42a7655ef3..700653250fb 100644
--- a/lisp/net/ldap.el
+++ b/lisp/net/ldap.el
@@ -727,7 +727,7 @@ an alist of attribute/value pairs."
(setq record nil)
(skip-chars-forward " \t\n")
(message "Parsing results... %d" numres)
- (1+ numres))
+ (setq numres (1+ numres)))
(message "Parsing results... done")
(nreverse result)))))
diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el
index eb61d7a6796..b8f1bccd788 100644
--- a/lisp/net/newst-backend.el
+++ b/lisp/net/newst-backend.el
@@ -363,7 +363,7 @@ description are marked as immortal."
(const :tag "Title" title)
(const :tag "Description" description)
(const :tag "All" all))
- (string :tag "Regexp")))))
+ (regexp :tag "Regexp")))))
:group 'newsticker-headline-processing)
;; ======================================================================
diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el
index e94947bc7f1..1b0f04e5a19 100644
--- a/lisp/net/nsm.el
+++ b/lisp/net/nsm.el
@@ -311,9 +311,9 @@ See also: `network-security-protocol-checks' and `nsm-noninteractive'"
(map-values results)
"\n")
"\n")
- "\n* ")))))
- (delete-process process)
- (setq process nil)))
+ "\n* "))))))
+ (delete-process process)
+ (setq process nil))
(run-hook-with-args 'nsm-tls-post-check-functions
host port status settings results)))
process)
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index fff640bb675..ad06d31cf9a 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -254,7 +254,7 @@ Examples:
(\"bitlbee\" bitlbee \"robert\" \"sekrit\")
(\"dal.net\" nickserv \"bob\" \"sekrit\" \"NickServ@services.dal.net\")
(\"quakenet.org\" quakenet \"bobby\" \"sekrit\"))"
- :type '(alist :key-type (string :tag "Server")
+ :type '(alist :key-type (regexp :tag "Server")
:value-type (choice (list :tag "NickServ"
(const nickserv)
(string :tag "Nick")
@@ -359,9 +359,9 @@ If VAL is a coding system, it is used for both decoding and encoding
messages.
If VAL is a cons of coding systems, the car part is used for decoding,
and the cdr part is used for encoding."
- :type '(alist :key-type (choice (string :tag "Channel Regexp")
- (cons (string :tag "Channel Regexp")
- (string :tag "Server Regexp")))
+ :type '(alist :key-type (choice (regexp :tag "Channel Regexp")
+ (cons (regexp :tag "Channel Regexp")
+ (regexp :tag "Server Regexp")))
:value-type (choice coding-system
(cons (coding-system :tag "Decode")
(coding-system :tag "Encode")))))
diff --git a/lisp/net/sasl-scram-sha256.el b/lisp/net/sasl-scram-sha256.el
new file mode 100644
index 00000000000..e50a032c233
--- /dev/null
+++ b/lisp/net/sasl-scram-sha256.el
@@ -0,0 +1,59 @@
+;;; sasl-scram-sha256.el --- SCRAM-SHA-256 module for the SASL client framework -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Simon Josefsson <simon@josefsson.org>
+;; Package: sasl
+
+;; 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:
+
+;; Implement the SCRAM-SHA-256 mechanism from RFC 7677.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'sasl)
+(require 'hex-util)
+(require 'rfc2104)
+(require 'sasl-scram-rfc)
+
+;;; SCRAM-SHA-256
+
+(defconst sasl-scram-sha-256-steps
+ '(sasl-scram-client-first-message
+ sasl-scram-sha-256-client-final-message
+ sasl-scram-sha-256-authenticate-server))
+
+(defun sasl-scram-sha256 (object &optional start end binary)
+ (secure-hash 'sha256 object start end binary))
+
+(defun sasl-scram-sha-256-client-final-message (client step)
+ (sasl-scram--client-final-message
+ ;; HMAC-SHA256 uses block length 64 and hash length 32; see RFC 4634.
+ 'sasl-scram-sha256 64 32 client step))
+
+(defun sasl-scram-sha-256-authenticate-server (client step)
+ (sasl-scram--authenticate-server
+ 'sasl-scram-sha256 64 32 client step))
+
+(put 'sasl-scram-sha256 'sasl-mechanism
+ (sasl-make-mechanism "SCRAM-SHA-256" sasl-scram-sha-256-steps))
+
+(provide 'sasl-scram-sha256)
+
+;;; sasl-scram-sha256.el ends here
diff --git a/lisp/net/sasl.el b/lisp/net/sasl.el
index 4405c904cd3..ab118e1f982 100644
--- a/lisp/net/sasl.el
+++ b/lisp/net/sasl.el
@@ -35,8 +35,8 @@
;;; Code:
(defvar sasl-mechanisms
- '("SCRAM-SHA-1" "CRAM-MD5" "DIGEST-MD5" "PLAIN" "LOGIN" "ANONYMOUS"
- "NTLM"))
+ '("SCRAM-SHA-256" "SCRAM-SHA-1" "CRAM-MD5" "DIGEST-MD5" "PLAIN" "LOGIN"
+ "ANONYMOUS" "NTLM"))
(defvar sasl-mechanism-alist
'(("CRAM-MD5" sasl-cram)
@@ -45,6 +45,7 @@
("LOGIN" sasl-login)
("ANONYMOUS" sasl-anonymous)
("NTLM" sasl-ntlm)
+ ("SCRAM-SHA-256" sasl-scram-sha256)
("SCRAM-SHA-1" sasl-scram-rfc)))
(defvar sasl-unique-id-function #'sasl-unique-id-function)
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 5cfcb81708f..194dd2d308f 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -181,10 +181,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
@@ -234,8 +233,7 @@ ARGUMENTS to pass to the OPERATION."
"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)
@@ -719,14 +717,14 @@ 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
v 0 (format "Copying %s to %s" filename newname)
(if (and t1 t2 (tramp-equal-remote filename newname))
- (let ((l1 (tramp-compat-file-local-name filename))
- (l2 (tramp-compat-file-local-name newname)))
+ (let ((l1 (tramp-file-local-name filename))
+ (l2 (tramp-file-local-name newname)))
;; We must also flush the cache of the directory,
;; because `file-attributes' reads the values from
;; there.
@@ -739,39 +737,37 @@ 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
- 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)))))))))
+ (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)
+ (when (tramp-adb-execute-adb-command
+ v "push"
+ (tramp-compat-file-name-unquote filename)
+ (tramp-compat-file-name-unquote localname))
+ (tramp-error
+ v 'file-error
+ "Cannot copy `%s' `%s'" filename newname))))))))
;; KEEP-DATE handling.
(when keep-date
@@ -801,7 +797,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
@@ -809,8 +805,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(if (and t1 t2
(tramp-equal-remote filename newname)
(not (file-directory-p filename)))
- (let ((l1 (tramp-compat-file-local-name filename))
- (l2 (tramp-compat-file-local-name newname)))
+ (let ((l1 (tramp-file-local-name filename))
+ (l2 (tramp-file-local-name newname)))
;; We must also flush the cache of the directory, because
;; `file-attributes' reads the values from there.
(tramp-flush-file-properties v l1)
@@ -846,7 +842,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(setq infile (expand-file-name infile))
(if (tramp-equal-remote default-directory infile)
;; INFILE is on the same remote host.
- (setq input (with-parsed-tramp-file-name infile nil localname))
+ (setq input (tramp-file-local-name infile))
;; INFILE must be copied to remote host.
(setq input (tramp-make-tramp-temp-file v)
tmpinput (tramp-make-tramp-file-name v input))
@@ -877,8 +873,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(setcar (cdr destination) (expand-file-name (cadr destination)))
(if (tramp-equal-remote default-directory (cadr destination))
;; stderr is on the same remote host.
- (setq stderr (with-parsed-tramp-file-name
- (cadr destination) nil localname))
+ (setq stderr (tramp-file-local-name (cadr destination)))
;; stderr must be copied to remote host. The temporary
;; file must be deleted after execution.
(setq stderr (tramp-make-tramp-temp-file v)
@@ -936,6 +931,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; We use BUFFER also as connection buffer during setup. Because of
;; this, its original contents must be saved, and restored once
;; connection has been setup.
+;; 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
@@ -969,17 +966,29 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(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"
+ (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
@@ -1029,6 +1038,18 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(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
@@ -1037,6 +1058,21 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(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 remote-tmpstderr 'visit))
+ ;; Delete tmpstderr file.
+ (add-function
+ :after (process-sentinel p)
+ (lambda (_proc _msg)
+ (with-current-buffer stderr
+ (insert-file-contents remote-tmpstderr 'visit))
+ (delete-file remote-tmpstderr))))
;; Return process.
p))))
@@ -1062,7 +1098,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(read (current-buffer)))
":" 'omit)))
;; The equivalent to `exec-directory'.
- `(,(tramp-compat-file-local-name default-directory))))
+ `(,(tramp-file-local-name (expand-file-name default-directory)))))
(defun tramp-adb-get-device (vec)
"Return full host name from VEC to be used in shell execution.
diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el
index b9bf6180a5d..95cbfb8c22a 100644
--- a/lisp/net/tramp-archive.el
+++ b/lisp/net/tramp-archive.el
@@ -350,7 +350,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
@@ -366,7 +366,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'.
@@ -517,13 +517,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/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index b81a1a23d5f..f8325a16892 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -130,13 +130,8 @@ Returns DEFAULT if not set."
(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 value) remote-file-name-inhibit-cache)))
(and (consp remote-file-name-inhibit-cache)
(time-less-p
remote-file-name-inhibit-cache (car value)))))
@@ -386,20 +381,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)))
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index 9d1025b9072..b4dca2321c1 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -358,7 +358,7 @@ The remote connection identified by SOURCE is flushed by
;; Append local file name if none is specified.
(when (string-equal (file-remote-p target) target)
- (setq target (concat target (file-remote-p source 'localname))))
+ (setq target (concat target (tramp-file-local-name source))))
;; Make them directory names.
(setq source (directory-file-name source)
target (directory-file-name target))
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 723b8cfa1e3..ba1cb9e4310 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/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)
@@ -41,6 +41,7 @@
(require 'shell)
(require 'subr-x)
+;; `temporary-file-directory' as function is introduced with Emacs 26.1.
(declare-function tramp-handle-temporary-file-directory "tramp")
;; For not existing functions, obsolete functions, or functions with a
@@ -51,6 +52,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'."
@@ -77,28 +80,18 @@ Add the extension of F, if existing."
(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.
+ (let (result)
+ (dolist (pid (tramp-compat-funcall 'list-system-processes) result)
+ (let ((attributes (process-attributes pid)))
+ (and (string-equal (cdr (assoc 'user attributes)) (user-login-name))
+ (when-let ((comm (cdr (assoc 'comm attributes))))
+ ;; The returned command name could be truncated to 15
+ ;; characters. Therefore, we cannot check for
+ ;; `string-equal'.
+ (string-match-p (concat "^" (regexp-quote comm)) process-name))
+ (setq result t)))))))
+
+;; `file-attribute-*' are introduced in Emacs 26.1.
(defalias 'tramp-compat-file-attribute-type
(if (fboundp 'file-attribute-type)
@@ -180,24 +173,6 @@ 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)
@@ -265,13 +240,6 @@ 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.
@@ -284,10 +252,9 @@ NAME is unquoted."
#'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
@@ -327,11 +294,6 @@ A nil value for either argument stands for the current time."
(unload-feature 'tramp-loaddefs 'force)
(unload-feature 'tramp-compat 'force)))
-;;; TODO:
-;;
-;; * Starting with Emacs 25.1, replace `tramp-message-show-message' by
-;; the reverse of `inhibit-message'.
-
(provide 'tramp-compat)
;;; tramp-compat.el ends here
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 34a234c47f0..3811c6767ac 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/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
@@ -127,10 +131,10 @@
;;;###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")
@@ -138,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.")
@@ -151,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"
@@ -169,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 (cons "media" 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.")
@@ -457,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.
@@ -625,10 +842,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)
@@ -649,13 +865,12 @@ pass to the OPERATION."
"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."
@@ -680,6 +895,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.
@@ -689,14 +906,13 @@ 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)))
-(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
@@ -704,6 +920,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
@@ -712,8 +929,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
@@ -772,7 +987,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
@@ -1383,36 +1598,45 @@ If FILE-SYSTEM is non-nil, return file system attributes."
;; 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 (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)
@@ -1569,6 +1793,17 @@ If FILE-SYSTEM is non-nil, return file system attributes."
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 (downcase 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
@@ -1659,6 +1894,17 @@ If FILE-SYSTEM is non-nil, return file system attributes."
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 (downcase 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))
@@ -1696,11 +1942,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)))
@@ -1794,7 +2045,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.
@@ -1843,7 +2094,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))))
@@ -1968,12 +2219,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)
@@ -1981,12 +2232,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
@@ -2012,15 +2263,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)))
@@ -2036,6 +2287,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)))
+ (let (result)
+ (maphash
+ (lambda (key _value)
+ (if (and (tramp-goa-account-p key)
+ (string-equal service (tramp-goa-account-method key)))
+ (push (list (tramp-goa-account-user key)
+ (tramp-goa-account-host key))
+ result)))
+ tramp-cache-data)
+ result))
+
+
+;; 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."
+; (with-tramp-connection-property nil "media-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 (replace-regexp-in-string " " "_" (nth 1 volume))))
+ (media (make-tramp-media-device
+ :method method
+ :host (url-host uri)
+ :port (and (url-portspec uri)
+ (number-to-string (url-portspec uri))))))
+ (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))))
+ ;; Mark, that media devices have been cached.
+); "cached"))
+
+(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)))
+ (let (result)
+ (maphash
+ (lambda (key _value)
+ (if (and (tramp-media-device-p key)
+ (string-equal service (tramp-media-device-method key))
+ (tramp-get-connection-property key "vector" nil))
+ (push
+ (list nil (tramp-file-name-host
+ (tramp-get-connection-property key "vector" nil)))
+ result)))
+ tramp-cache-data)
+ result))
+
;; D-Bus zeroconf functions.
@@ -2080,39 +2405,61 @@ 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)
+ ;; Suppress D-Bus error messages and Tramp traces.
+ (let (tramp-gvfs-dbus-event-vector tramp-verbose 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 ()
@@ -2122,10 +2469,14 @@ This uses \"avahi-browse\" in case D-Bus is not enabled in Avahi."
;;; TODO:
+;; * Support /media::.
+;;
+;; * React on media mount/unmount.
+;;
;; * (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/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el
index 9f539850139..3e029e44ff5 100644
--- a/lisp/net/tramp-rclone.el
+++ b/lisp/net/tramp-rclone.el
@@ -157,10 +157,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 +219,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)))
@@ -564,7 +563,7 @@ connection if a previous connection has died for some reason."
,(tramp-rclone-mount-point vec)
;; This could be nil.
,(tramp-get-method-parameter vec 'tramp-mount-args))))
- (while (not (file-exists-p (tramp-make-tramp-file-name vec 'localname)))
+ (while (not (file-exists-p (tramp-make-tramp-file-name vec 'noloc)))
(tramp-cleanup-connection vec 'keep-debug 'keep-password))
;; Mark it as connected.
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index af97328b3d3..5f2c1ad3d56 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -866,8 +866,12 @@ Escape sequence %s is replaced with name of Perl binary.")
"Perl program to use for decoding a file.
Escape sequence %s is replaced with name of Perl binary.")
+(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.")
+
(defconst tramp-awk-encode
- "od -v -t x1 -A n | busybox awk '\\
+ "%a '\\
BEGIN {
b64 = \"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/\"
b16 = \"0123456789abcdef\"
@@ -897,11 +901,25 @@ END {
}
printf tail
}'"
- "Awk program to use for encoding a file.
+ "`awk' program to use for encoding a file.
+This string is passed to `format', so 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.")
+
+(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.")
+
+(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.")
(defconst tramp-awk-decode
- "busybox awk '\\
+ "%a '\\
BEGIN {
b64 = \"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/\"
}
@@ -926,12 +944,6 @@ BEGIN {
"Awk program to use for decoding a file.
This string is passed to `format', so percent characters need to be doubled.")
-(defconst tramp-awk-coding-test
- "test -c /dev/zero && \
-od -v -t x1 -A n </dev/null && \
-busybox awk '{}' </dev/null"
- "Test command for checking `tramp-awk-encode' and `tramp-awk-decode'.")
-
(defconst tramp-vc-registered-read-file-names
"echo \"(\"
while read file; do
@@ -1051,9 +1063,7 @@ component is used as the target of the symlink."
(let ((non-essential t))
(when (and (tramp-tramp-file-p target)
(tramp-file-name-equal-p v (tramp-dissect-file-name target)))
- (setq target
- (tramp-file-name-localname
- (tramp-dissect-file-name (expand-file-name target))))))
+ (setq target (tramp-file-local-name (expand-file-name target)))))
;; If TARGET is still remote, quote it.
(if (tramp-tramp-file-p target)
@@ -1104,8 +1114,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)
@@ -1263,8 +1272,8 @@ component is used as the target of the symlink."
(defun tramp-do-file-attributes-with-ls (vec localname &optional id-format)
"Implement `file-attributes' for Tramp files using the ls(1) command."
(let (symlinkp dirp
- res-inode res-filemodes res-numlinks
- res-uid res-gid res-size res-symlink-target)
+ res-inode res-filemodes res-numlinks
+ res-uid res-gid res-size res-symlink-target)
(tramp-message vec 5 "file attributes with ls: %s" localname)
;; We cannot send all three commands combined, it could exceed
;; NAME_MAX or PATH_MAX. Happened on macOS, for example.
@@ -1948,7 +1957,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)))
@@ -2030,7 +2039,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
@@ -2171,8 +2180,8 @@ the uid and gid from FILENAME."
v 'file-error
"Unknown operation `%s', must be `copy' or `rename'"
op))))
- (localname1 (tramp-compat-file-local-name filename))
- (localname2 (tramp-compat-file-local-name newname))
+ (localname1 (tramp-file-local-name filename))
+ (localname2 (tramp-file-local-name newname))
(prefix (file-remote-p (if t1 filename newname)))
cmd-result)
(when (and (eq op 'copy) (file-directory-p filename))
@@ -2714,7 +2723,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)
@@ -2724,12 +2733,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)))))))
@@ -2796,8 +2804,11 @@ the result will be a local, non-Tramp, file name."
;; We use BUFFER also as connection buffer during setup. Because of
;; this, its original contents must be saved, and restored once
;; connection has been setup.
+;; The complete STDERR buffer is available only when the process has
+;; terminated.
(defun tramp-sh-handle-make-process (&rest args)
- "Like `make-process' for Tramp files."
+ "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))
@@ -2829,14 +2840,23 @@ the result will be a local, non-Tramp, file name."
(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 (and stderr (get-buffer-create stderr)))
- (tmpstderr (and stderr (tramp-make-tramp-temp-file v)))
+ ;; 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
@@ -2965,21 +2985,33 @@ the result will be a local, non-Tramp, file name."
(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 shall be inserted by `auto-revert'.
- ;; The temporary file will still be existing.
- ;; TODO: Write a sentinel, which deletes the
- ;; temporary file.
- (when tmpstderr
- ;; We must flush them here already; otherwise
- ;; `insert-file-contents' will fail.
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer")
+ ;; 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
- (tramp-make-tramp-file-name v tmpstderr) 'visit)
- (auto-revert-mode)))
+ (insert-file-contents remote-tmpstderr 'visit))
+ ;; Delete tmpstderr file.
+ (add-function
+ :after (process-sentinel p)
+ (lambda (_proc _msg)
+ (with-current-buffer stderr
+ (insert-file-contents remote-tmpstderr 'visit))
+ (delete-file remote-tmpstderr))))
;; Return process.
p)))
@@ -3028,7 +3060,7 @@ the result will be a local, non-Tramp, file name."
(setq infile (expand-file-name infile))
(if (tramp-equal-remote default-directory infile)
;; INFILE is on the same remote host.
- (setq input (with-parsed-tramp-file-name infile nil localname))
+ (setq input (tramp-file-local-name infile))
;; INFILE must be copied to remote host.
(setq input (tramp-make-tramp-temp-file v)
tmpinput (tramp-make-tramp-file-name v input 'nohop))
@@ -3059,8 +3091,7 @@ the result will be a local, non-Tramp, file name."
(setcar (cdr destination) (expand-file-name (cadr destination)))
(if (tramp-equal-remote default-directory (cadr destination))
;; stderr is on the same remote host.
- (setq stderr (with-parsed-tramp-file-name
- (cadr destination) nil localname))
+ (setq stderr (tramp-file-local-name (cadr destination)))
;; stderr must be copied to remote host. The temporary
;; file must be deleted after execution.
(setq stderr (tramp-make-tramp-temp-file v)
@@ -3122,7 +3153,7 @@ the result will be a local, non-Tramp, file name."
(append
(tramp-get-remote-path (tramp-dissect-file-name default-directory))
;; The equivalent to `exec-directory'.
- `(,(tramp-compat-file-local-name default-directory))))
+ `(,(tramp-file-local-name (expand-file-name default-directory)))))
(defun tramp-sh-handle-file-local-copy (filename)
"Like `file-local-copy' for Tramp files."
@@ -3468,8 +3499,7 @@ the result will be a local, non-Tramp, 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
@@ -3559,10 +3589,9 @@ the result will be a local, non-Tramp, 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)))
;; This must be the last entry, because `identity' always matches.
;;;###tramp-autoload
@@ -3995,8 +4024,7 @@ variable PATH."
(setq tmpfile
(tramp-make-tramp-file-name vec (tramp-make-tramp-temp-file vec)))
(write-region command nil tmpfile)
- (tramp-send-command
- vec (format ". %s" (tramp-compat-file-local-name tmpfile)))
+ (tramp-send-command vec (format ". %s" (tramp-file-local-name tmpfile)))
(delete-file tmpfile))))
;; ------------------------------------------------------------
@@ -4383,7 +4411,7 @@ and end of region, and are expected to replace the region contents
with the encoded or decoded results, respectively.")
(defconst tramp-remote-coding-commands
- `((b64 "base64" "base64 -d -i")
+ '((b64 "base64" "base64 -d -i")
;; "-i" is more robust with older base64 from GNU coreutils.
;; However, I don't know whether all base64 versions do supports
;; this option.
@@ -4394,8 +4422,9 @@ with the encoded or decoded results, respectively.")
(b64 "recode data..base64" "recode base64..data")
(b64 tramp-perl-encode-with-module tramp-perl-decode-with-module)
(b64 tramp-perl-encode tramp-perl-decode)
- ;; This is painful slow, so we put it on the end.
- (b64 tramp-awk-encode tramp-awk-decode ,tramp-awk-coding-test)
+ ;; These are painfully slow, so we put them on the end.
+ (b64 tramp-hexdump-awk-encode tramp-awk-decode)
+ (b64 tramp-od-awk-encode tramp-awk-decode)
(uu "uuencode xxx" "uudecode -o /dev/stdout" "test -c /dev/stdout")
(uu "uuencode xxx" "uudecode -o -")
(uu "uuencode xxx" "uudecode -p")
@@ -4421,6 +4450,8 @@ Perl or Shell implementation for this functionality. This
program will be transferred to the remote host, and it is
available as shell function with the same name. A \"%t\" format
specifier in the variable value denotes a temporary file.
+\"%a\", \"%h\" and \"%o\" format specifiers are replaced by the
+respective `awk', `hexdump' and `od' commands.
The optional TEST command can be used for further tests, whether
ENCODING and DECODING are applicable.")
@@ -4471,11 +4502,6 @@ Goes through the list `tramp-local-coding-commands' and
vec 5 "Checking remote test command `%s'" rem-test)
(unless (tramp-send-command-and-check vec rem-test t)
(throw 'wont-work-remote nil)))
- ;; Check if remote perl exists when necessary.
- (when (and (symbolp rem-enc)
- (string-match-p "perl" (symbol-name rem-enc))
- (not (tramp-get-remote-perl vec)))
- (throw 'wont-work-remote nil))
;; Check if remote encoding and decoding commands can be
;; called remotely with null input and output. This makes
;; sure there are no syntax errors and the command is really
@@ -4485,10 +4511,36 @@ Goes through the list `tramp-local-coding-commands' and
;; redirecting "mimencode" output to /dev/null, then as root
;; it might change the permissions of /dev/null!
(unless (stringp rem-enc)
- (let ((name (symbol-name rem-enc)))
+ (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)))
- (tramp-maybe-send-script vec (symbol-value rem-enc) 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
@@ -4503,6 +4555,15 @@ Goes through the list `tramp-local-coding-commands' and
tmpfile)
(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
@@ -4513,7 +4574,7 @@ Goes through the list `tramp-local-coding-commands' and
(format-spec
value
(format-spec-make
- ?t (tramp-compat-file-local-name tmpfile)))))
+ ?t (tramp-file-local-name tmpfile)))))
(tramp-maybe-send-script vec value name)
(setq rem-dec name)))
(tramp-message
@@ -4796,7 +4857,7 @@ If there is just some editing, retry it after 5 seconds."
vec 5 "Cannot timeout session, trying it again in %s seconds." 5)
(run-at-time 5 nil 'tramp-timeout-session vec))
(tramp-message
- vec 3 "Timeout session %s" (tramp-make-tramp-file-name vec 'localname))
+ vec 3 "Timeout session %s" (tramp-make-tramp-file-name vec 'noloc))
(tramp-cleanup-connection vec 'keep-debug)))
(defun tramp-maybe-open-connection (vec)
@@ -4818,11 +4879,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
@@ -4833,11 +4891,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)
@@ -5594,7 +5650,7 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil."
"%s -t %s %s"
result
(format-time-string "%Y%m%d%H%M.%S")
- (tramp-compat-file-local-name tmpfile))))
+ (tramp-file-local-name tmpfile))))
(delete-file tmpfile))
result)))
@@ -5769,6 +5825,47 @@ ID-FORMAT valid values are `string' and `integer'."
tramp-unknown-id-string)
(t res)))))
+(defun tramp-get-remote-busybox (vec)
+ "Determine remote `busybox' command."
+ (with-tramp-connection-property vec "busybox"
+ (tramp-message vec 5 "Finding a suitable `busybox' command")
+ (tramp-find-executable vec "busybox" (tramp-get-remote-path vec))))
+
+(defun tramp-get-remote-awk (vec)
+ "Determine remote `awk' command."
+ (with-tramp-connection-property vec "awk"
+ (tramp-message vec 5 "Finding a suitable `awk' command")
+ (or (tramp-find-executable vec "awk" (tramp-get-remote-path vec))
+ (let* ((busybox (tramp-get-remote-busybox vec))
+ (command (format "%s %s" busybox "awk")))
+ (and busybox
+ (tramp-send-command-and-check
+ vec (concat command " {} </dev/null"))
+ command)))))
+
+(defun tramp-get-remote-hexdump (vec)
+ "Determine remote `hexdump' command."
+ (with-tramp-connection-property vec "hexdump"
+ (tramp-message vec 5 "Finding a suitable `hexdump' command")
+ (or (tramp-find-executable vec "hexdump" (tramp-get-remote-path vec))
+ (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"))
+ command)))))
+
+(defun tramp-get-remote-od (vec)
+ "Determine remote `od' command."
+ (with-tramp-connection-property vec "od"
+ (tramp-message vec 5 "Finding a suitable `od' command")
+ (or (tramp-find-executable vec "od" (tramp-get-remote-path vec))
+ (let* ((busybox (tramp-get-remote-busybox vec))
+ (command (format "%s %s" busybox "od")))
+ (and busybox
+ (tramp-send-command-and-check
+ vec (concat command " -A n </dev/null"))
+ command)))))
+
(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"
@@ -5889,9 +5986,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.
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index bf77ab9dee8..f02be394a7b 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -329,10 +329,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))
@@ -420,7 +419,7 @@ 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.
@@ -581,40 +580,39 @@ 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
@@ -1003,7 +1001,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
@@ -1188,9 +1186,7 @@ component is used as the target of the symlink."
(let ((non-essential t))
(when (and (tramp-tramp-file-p target)
(tramp-file-name-equal-p v (tramp-dissect-file-name target)))
- (setq target
- (tramp-file-name-localname
- (tramp-dissect-file-name (expand-file-name target))))))
+ (setq target (tramp-file-local-name (expand-file-name target)))))
;; If TARGET is still remote, quote it.
(if (tramp-tramp-file-p target)
@@ -1244,7 +1240,7 @@ component is used as the target of the symlink."
(setq infile (expand-file-name infile))
(if (tramp-equal-remote default-directory infile)
;; INFILE is on the same remote host.
- (setq input (with-parsed-tramp-file-name infile nil localname))
+ (setq input (tramp-file-local-name infile))
;; INFILE must be copied to remote host.
(setq input (tramp-make-tramp-temp-file v)
tmpinput (tramp-make-tramp-file-name v input))
@@ -1357,7 +1353,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
@@ -1924,11 +1920,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)
@@ -1994,7 +1988,7 @@ If ARGUMENT is non-nil, use it as argument for
(set-process-query-on-exit-flag p nil)
(condition-case err
- (let (tramp-message-show-message)
+ (let ((inhibit-message t))
;; Play login scenario.
(tramp-process-actions
p vec nil
@@ -2132,7 +2126,5 @@ Removes smb prompt. Returns nil if an error message has appeared."
;;
;; * Try to remove the inclusion of dummy "" directory. Seems to be at
;; several places, especially in `tramp-smb-handle-insert-directory'.
-;;
-;; * Ignore case in file names.
;;; tramp-smb.el ends here
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index 08188cefde3..9f08d5f1e64 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -153,10 +153,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 +247,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))
@@ -265,10 +264,8 @@ absolute file names."
v 0 (format "%s %s to %s" msg-operation filename newname)
(unless (tramp-sudoedit-send-command
v sudoedit-operation
- (tramp-compat-file-name-unquote
- (tramp-compat-file-local-name filename))
- (tramp-compat-file-name-unquote
- (tramp-compat-file-local-name newname)))
+ (tramp-unquote-file-local-name filename)
+ (tramp-unquote-file-local-name newname))
(tramp-error
v 'file-error
"Error %s `%s' `%s'" msg-operation filename newname))))
@@ -543,8 +540,7 @@ the result will be a local, non-Tramp, file name."
"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)
@@ -615,9 +611,7 @@ component is used as the target of the symlink."
(let ((non-essential t))
(when (and (tramp-tramp-file-p target)
(tramp-file-name-equal-p v (tramp-dissect-file-name target)))
- (setq target
- (tramp-file-name-localname
- (tramp-dissect-file-name (expand-file-name target))))))
+ (setq target (tramp-file-local-name (expand-file-name target)))))
;; If TARGET is still remote, quote it.
(if (tramp-tramp-file-p target)
@@ -715,8 +709,7 @@ ID-FORMAT valid values are `string' and `integer'."
(format "%d:%d"
(or uid (tramp-sudoedit-get-remote-uid v 'integer))
(or gid (tramp-sudoedit-get-remote-gid v 'integer)))
- (tramp-compat-file-name-unquote
- (tramp-compat-file-local-name filename)))))
+ (tramp-unquote-file-local-name filename))))
(defun tramp-sudoedit-handle-write-region
(start end filename &optional append visit lockname mustbenew)
diff --git a/lisp/net/tramp-uu.el b/lisp/net/tramp-uu.el
index 6a044e58840..f368f72a8dc 100644
--- a/lisp/net/tramp-uu.el
+++ b/lisp/net/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/lisp/net/tramp.el b/lisp/net/tramp.el
index 0ad65fb8bd0..324b2a24b80 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -7,8 +7,8 @@
;; Maintainer: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
;; Package: tramp
-;; Version: 2.4.3
-;; Package-Requires: ((emacs "24.4"))
+;; Version: 2.5.0-pre
+;; Package-Requires: ((emacs "25.1"))
;; Package-Type: multi
;; URL: https://savannah.gnu.org/projects/tramp
@@ -1258,7 +1258,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)
@@ -1306,9 +1306,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)
@@ -1347,6 +1348,11 @@ of `process-file', `start-file-process', or `shell-command'."
(match-string (nth 4 tramp-file-name-structure) name))
(tramp-compat-file-local-name name)))
+;; The localname can be quoted with "/:". Extract this.
+(defun tramp-unquote-file-local-name (name)
+ "Return unquoted localname of NAME."
+ (tramp-compat-file-name-unquote (tramp-file-local-name name)))
+
(defun tramp-find-method (method user host)
"Return the right method string to use depending on USER and HOST.
This is METHOD, if non-nil. Otherwise, do a lookup in
@@ -1468,7 +1474,7 @@ 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
@@ -1592,7 +1598,7 @@ necessary only. This function will be used in file name completion."
tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)
host)
tramp-postfix-host-format))
- (when localname localname)))
+ localname))
(defun tramp-get-buffer (vec &optional dont-create)
"Get the connection buffer to be used for VEC.
@@ -1648,7 +1654,7 @@ version, the function does nothing."
"Set connection-local variables in the current buffer.
If connection-local variables are not supported by this Emacs
version, the function does nothing."
- (when (file-remote-p default-directory)
+ (when (tramp-tramp-file-p default-directory)
;; `hack-connection-local-variables-apply' exists since Emacs 26.1.
(tramp-compat-funcall
'hack-connection-local-variables-apply
@@ -1744,29 +1750,10 @@ ARGUMENTS to actually emit the message (if applicable)."
(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)))
+ (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.
@@ -1781,11 +1768,7 @@ ARGUMENTS to actually emit the message (if applicable)."
;; 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.")
+(put #'tramp-debug-message 'tramp-suppress-trace t)
(defsubst tramp-message (vec-or-proc level fmt-string &rest arguments)
"Emit a message depending on verbosity level.
@@ -1803,7 +1786,7 @@ applicable)."
(ignore-errors
(when (<= level tramp-verbose)
;; Display only when there is a minimum level.
- (when (and tramp-message-show-message (<= level 3))
+ (when (<= level 3)
(apply #'message
(concat
(cond
@@ -1835,6 +1818,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
@@ -1845,13 +1830,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
@@ -1869,6 +1857,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.
@@ -1886,13 +1876,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)
@@ -1904,19 +1894,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)
@@ -1926,18 +1918,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)
@@ -1949,6 +1944,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.
@@ -1965,12 +1962,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,
@@ -1979,8 +1978,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)
@@ -1991,22 +1988,20 @@ 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))))))
+ ;; We start a pulsing progress reporter after 3
+ ;; seconds. Display only when there is a minimum level.
+ (when (<= ,level (min tramp-verbose 3))
+ (when-let ((pr (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"))
@@ -2020,6 +2015,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)
@@ -2031,12 +2027,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
@@ -2046,8 +2041,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\\>"))
@@ -2066,6 +2059,9 @@ letter into the file name. This function removes it."
;;; 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).
@@ -2098,10 +2094,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)))
@@ -2267,10 +2263,7 @@ 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)))
@@ -2390,7 +2383,7 @@ Fall back to normal file name handler if no Tramp file name handler exists."
(cons operation args))
(tramp-run-real-handler operation args))
((eq result 'suppress)
- (let (tramp-message-show-message)
+ (let ((inhibit-message t))
(tramp-message
v 1 "Suppress received in operation %s"
(cons operation args))
@@ -2419,8 +2412,8 @@ 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)
+ (when tramp-mode
+ (if-let ((fn (assoc operation tramp-completion-file-name-handler-alist)))
(save-match-data (apply (cdr fn) args))
(tramp-run-real-handler operation args))))
@@ -2428,9 +2421,9 @@ Falls back to normal file name handler if no Tramp file name handler exists."
(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
+ (let ((default-directory temporary-file-directory))
+ (load "tramp" 'noerror 'nomessage)))
(apply operation args)))
;; `tramp-autoload-file-name-handler' must be registered before
@@ -2442,7 +2435,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)
@@ -2483,29 +2476,28 @@ remote file names."
;; 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)
(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))
@@ -2517,7 +2509,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
@@ -2558,19 +2550,6 @@ 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
@@ -2585,7 +2564,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
@@ -2876,7 +2855,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 "\\)"
@@ -2961,7 +2940,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")))
@@ -2983,7 +2962,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")))
@@ -3020,7 +2999,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))))
@@ -3201,10 +3180,8 @@ User is always nil."
(defun tramp-handle-file-modes (filename)
"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 (or (file-truename filename) filename))))
+ (tramp-mode-string-to-int (tramp-compat-file-attribute-modes attrs))))
;; Localname manipulation functions that grok Tramp localnames...
(defun tramp-handle-file-name-as-directory (file)
@@ -3247,7 +3224,7 @@ User is always nil."
;; lower case letters. This avoids us to create a
;; temporary file.
(while (and (string-match-p
- "[a-z]" (tramp-compat-file-local-name candidate))
+ "[a-z]" (tramp-file-local-name candidate))
(not (file-exists-p candidate)))
(setq candidate
(directory-file-name
@@ -3257,8 +3234,7 @@ User is always nil."
;; to Emacs 26+ like `file-name-case-insensitive-p',
;; so there is no compatibility problem calling it.
(unless
- (string-match-p
- "[a-z]" (tramp-compat-file-local-name candidate))
+ (string-match-p "[a-z]" (tramp-file-local-name candidate))
(setq tmpfile
(let ((default-directory
(file-name-directory filename)))
@@ -3271,7 +3247,7 @@ User is always nil."
(file-exists-p
(concat
(file-remote-p candidate)
- (upcase (tramp-compat-file-local-name candidate))))
+ (upcase (tramp-file-local-name candidate))))
;; Cleanup.
(when tmpfile (delete-file tmpfile)))))))))))
@@ -3323,21 +3299,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."
@@ -3376,8 +3349,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)
@@ -3413,7 +3385,7 @@ User is always nil."
(tramp-error
v1 'file-error
"Maximum number (%d) of symlinks exceeded" numchase-limit)))
- (tramp-compat-file-local-name (directory-file-name result)))))))))
+ (tramp-file-local-name (directory-file-name result)))))))))
(defun tramp-handle-file-writable-p (filename)
"Like `file-writable-p' for Tramp files."
@@ -3448,7 +3420,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.
@@ -3617,7 +3589,7 @@ 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 ((inhibit-message nomessage))
(with-tramp-progress-reporter v 0 (format "Loading %s" file)
(let ((local-copy (file-local-copy file)))
(unwind-protect
@@ -3698,7 +3670,7 @@ support symbolic links."
(rename-uniquely))
(setq output-buffer (get-buffer-create bname)))))
- (setq buffer (if (and (not asynchronous) error-buffer)
+ (setq buffer (if error-buffer
(with-parsed-tramp-file-name default-directory nil
(list output-buffer
(tramp-make-tramp-file-name
@@ -3726,13 +3698,24 @@ support symbolic links."
;; Run the process.
(setq p (start-file-process-shell-command
(buffer-name output-buffer) buffer command))
- ;; Display output.
- (with-current-buffer output-buffer
- (display-buffer output-buffer '(nil (allow-no-window . t)))
- (setq mode-line-process '(":%s"))
- (shell-mode)
- (set-process-sentinel p #'shell-command-sentinel)
- (set-process-filter p #'comint-output-filter))))
+ (if (process-live-p p)
+ ;; Display output.
+ (with-current-buffer output-buffer
+ (display-buffer output-buffer '(nil (allow-no-window . t)))
+ (setq mode-line-process '(":%s"))
+ (shell-mode)
+ (set-process-filter p #'comint-output-filter)
+ (set-process-sentinel
+ p (if (listp buffer)
+ (lambda (_proc _string)
+ (with-current-buffer error-buffer
+ (insert-file-contents (cadr buffer)))
+ (delete-file (cadr buffer)))
+ #'shell-command-sentinel)))
+ ;; Show stderr.
+ (with-current-buffer error-buffer
+ (insert-file-contents (cadr buffer)))
+ (delete-file (cadr buffer)))))
(prog1
;; Run the process.
@@ -3755,13 +3738,16 @@ support symbolic links."
(display-message-or-buffer output-buffer)))))))
(defun tramp-handle-start-file-process (name buffer program &rest args)
- "Like `start-file-process' for Tramp files."
+ "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.
(tramp-file-name-handler
'make-process
:name name
- :buffer buffer
+ :buffer (if (listp buffer) (car buffer) buffer)
:command (and program (cons program args))
+ ;; `shell-command' adds an errfile to `buffer'.
+ :stderr (when (listp buffer) (cadr buffer))
:noquery nil
:file-handler t))
@@ -4362,7 +4348,7 @@ would yield t. On the other hand, the following check results in nil:
(tramp-equal-remote \"/sudo::/etc\" \"/su::/etc\")
If both files are local, the function returns t."
- (or (and (null (file-remote-p file1)) (null (file-remote-p file2)))
+ (or (and (null (tramp-tramp-file-p file1)) (null (tramp-tramp-file-p file2)))
(and (tramp-tramp-file-p file1) (tramp-tramp-file-p file2)
(string-equal (file-remote-p file1) (file-remote-p file2)))))
@@ -4487,16 +4473,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.
@@ -4632,7 +4617,7 @@ This handles also chrooted environments, which are not regarded as local."
(tramp-make-tramp-file-name
vec (or (tramp-get-method-parameter vec 'tramp-tmpdir) "/tmp"))))
(or (and (file-directory-p dir) (file-writable-p dir)
- (tramp-compat-file-local-name dir))
+ (tramp-file-local-name dir))
(tramp-error vec 'file-error "Directory %s not accessible" dir))
dir)))
@@ -4655,7 +4640,7 @@ Return the local name of the temporary file."
(set-file-modes result #o0700)))
;; Return the local part.
- (with-parsed-tramp-file-name result nil localname)))
+ (tramp-file-local-name result)))
(defun tramp-delete-temp-file-function ()
"Remove temporary files related to current buffer."
@@ -4682,7 +4667,7 @@ this file, if that variable is non-nil."
(let ((system-type
(if (and (stringp tramp-auto-save-directory)
- (file-remote-p tramp-auto-save-directory))
+ (tramp-tramp-file-p tramp-auto-save-directory))
'not-windows
system-type))
(auto-save-file-name-transforms
@@ -5040,10 +5025,4 @@ name of a process or buffer, or nil to default to the current buffer."
;; `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/lisp/net/trampver.el b/lisp/net/trampver.el
index dacdd44102f..0a92e0d3202 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -35,11 +35,8 @@
;; 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)
-
;;;###tramp-autoload
-(defconst tramp-version "2.4.3.27.1"
+(defconst tramp-version "2.5.0-pre"
"This version of Tramp.")
;;;###tramp-autoload
@@ -71,9 +68,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.3.27.1 is not fit for %s"
+ (format "Tramp 2.5.0-pre is not fit for %s"
(replace-regexp-in-string "\n" "" (emacs-version))))))
(unless (string-equal "ok" x) (error "%s" x)))
@@ -102,8 +99,3 @@
(provide 'trampver)
;;; trampver.el ends here
-
-;; Local Variables:
-;; mode: Emacs-Lisp
-;; coding: utf-8
-;; End:
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-25 10:07:05 +0000