branch: externals/tramp
commit f015886436e23593c074b4f22713bf3005f6b414
Author: Michael Albinus <michael.albi...@gmx.de>
Commit: Michael Albinus <michael.albi...@gmx.de>
Tramp ELPA version 2.5.1.2 released
---
test/tramp-tests.el | 165 ++++++++++++++++++++++---
texi/tramp.texi | 51 ++++++--
texi/trampver.texi | 2 +-
tramp-adb.el | 9 +-
tramp-cache.el | 6 +-
tramp-cmds.el | 2 +-
tramp-compat.el | 21 +++-
tramp-gvfs.el | 2 +-
tramp-sh.el | 132 +++++++++++---------
tramp-smb.el | 337 +++++++++++++++++++++++++++-------------------------
tramp.el | 77 +++++++-----
trampver.el | 6 +-
12 files changed, 529 insertions(+), 281 deletions(-)
diff --git a/test/tramp-tests.el b/test/tramp-tests.el
index 98493bf..a7a8ec8 100644
--- a/test/tramp-tests.el
+++ b/test/tramp-tests.el
@@ -177,6 +177,19 @@ The temporary file is not created."
(make-temp-name "tramp-test")
(if local temporary-file-directory tramp-test-temporary-file-directory))))
+;; Method "smb" supports `make-symbolic-link' only if the remote host
+;; has CIFS capabilities. tramp-adb.el, tramp-gvfs.el, tramp-rclone.el
+;; and tramp-sshfs.el do not support symbolic links at all.
+(defmacro tramp--test-ignore-make-symbolic-link-error (&rest body)
+ "Run BODY, ignoring \"make-symbolic-link not supported\" file error."
+ (declare (indent defun) (debug (body)))
+ `(condition-case err
+ (progn ,@body)
+ (file-error
+ (unless (string-equal (error-message-string err)
+ "make-symbolic-link not supported")
+ (signal (car err) (cdr err))))))
+
;; Don't print messages in nested `tramp--test-instrument-test-case' calls.
(defvar tramp--test-instrument-test-case-p nil
"Whether `tramp--test-instrument-test-case' run.
@@ -2866,7 +2879,8 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(file-name-nondirectory tmp-name1) tmp-name2))
(tmp-name4 (expand-file-name "foo" tmp-name1))
(tmp-name5 (expand-file-name "foo" tmp-name2))
- (tmp-name6 (expand-file-name "foo" tmp-name3)))
+ (tmp-name6 (expand-file-name "foo" tmp-name3))
+ (tmp-name7 (tramp--test-make-temp-name nil quoted)))
;; Copy complete directory.
(unwind-protect
@@ -2922,7 +2936,48 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
;; Cleanup.
(ignore-errors
(delete-directory tmp-name1 'recursive)
- (delete-directory tmp-name2 'recursive))))))
+ (delete-directory tmp-name2 'recursive)))
+
+ ;; Copy symlink to directory. Implemented since Emacs 28.1.
+ (when (boundp 'copy-directory-create-symlink)
+ (dolist (copy-directory-create-symlink '(nil t))
+ (unwind-protect
+ (tramp--test-ignore-make-symbolic-link-error
+ ;; Copy to file name.
+ (make-directory tmp-name1)
+ (write-region "foo" nil tmp-name4)
+ (make-symbolic-link tmp-name1 tmp-name7)
+ (should (file-directory-p tmp-name1))
+ (should (file-exists-p tmp-name4))
+ (should (file-symlink-p tmp-name7))
+ (copy-directory tmp-name7 tmp-name2)
+ (if copy-directory-create-symlink
+ (should
+ (string-equal
+ (file-symlink-p tmp-name2) (file-symlink-p tmp-name7)))
+ (should (file-directory-p tmp-name2)))
+ ;; Copy to directory name.
+ (delete-directory tmp-name2 'recursive)
+ (make-directory tmp-name2)
+ (should (file-directory-p tmp-name2))
+ (copy-directory tmp-name7 (file-name-as-directory tmp-name2))
+ (if copy-directory-create-symlink
+ (should
+ (string-equal
+ (file-symlink-p
+ (expand-file-name
+ (file-name-nondirectory tmp-name7) tmp-name2))
+ (file-symlink-p tmp-name7)))
+ (should
+ (file-directory-p
+ (expand-file-name
+ (file-name-nondirectory tmp-name7) tmp-name2)))))
+
+ ;; Cleanup.
+ (ignore-errors
+ (delete-directory tmp-name1 'recursive)
+ (delete-directory tmp-name2 'recursive)
+ (delete-directory tmp-name7 'recursive))))))))
(ert-deftest tramp-test16-directory-files ()
"Check `directory-files'."
@@ -3266,19 +3321,6 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(ignore-errors (kill-buffer buffer))
(ignore-errors (delete-directory tmp-name1 'recursive))))))
-;; Method "smb" supports `make-symbolic-link' only if the remote host
-;; has CIFS capabilities. tramp-adb.el, tramp-gvfs.el, tramp-rclone.el
-;; and tramp-sshfs.el do not support symbolic links at all.
-(defmacro tramp--test-ignore-make-symbolic-link-error (&rest body)
- "Run BODY, ignoring \"make-symbolic-link not supported\" file error."
- (declare (indent defun) (debug (body)))
- `(condition-case err
- (progn ,@body)
- (file-error
- (unless (string-equal (error-message-string err)
- "make-symbolic-link not supported")
- (signal (car err) (cdr err))))))
-
(ert-deftest tramp-test18-file-attributes ()
"Check `file-attributes'.
This tests also `access-file', `file-readable-p',
@@ -4535,16 +4577,50 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
;; Cleanup.
(ignore-errors (delete-process proc)))
+ ;; Process connection type.
+ (when (and (tramp--test-sh-p)
+ ;; `executable-find' has changed the number of
+ ;; parameters in Emacs 27.1, so we use `apply' for
+ ;; older Emacsen.
+ (ignore-errors
+ (with-no-warnings
+ (apply #'executable-find '("hexdump" remote)))))
+ (dolist (process-connection-type '(nil pipe t pty))
+ (unwind-protect
+ (with-temp-buffer
+ (setq proc
+ (start-file-process
+ (format "test4-%s" process-connection-type)
+ (current-buffer) "hexdump" "-v" "-e" "/1 \"%02X\n\""))
+ (should (processp proc))
+ (should (equal (process-status proc) 'run))
+ (process-send-string proc "foo\r\n")
+ (process-send-eof proc)
+ ;; Read output.
+ (with-timeout (10 (tramp--test-timeout-handler))
+ (while (< (- (point-max) (point-min))
+ (length "66\n6F\n6F\n0D\n0A\n"))
+ (while (accept-process-output proc 0 nil t))))
+ (should
+ (string-match-p
+ (if (memq process-connection-type '(nil pipe))
+ "66\n6F\n6F\n0D\n0A\n"
+ "66\n6F\n6F\n0A\n0A\n")
+ (buffer-string))))
+
+ ;; Cleanup.
+ (ignore-errors (delete-process proc)))))
+
;; PTY.
(unwind-protect
(with-temp-buffer
;; It works only for tramp-sh.el, and not direct async processes.
(if (or (not (tramp--test-sh-p)) (tramp-direct-async-process-p))
(should-error
- (start-file-process "test4" (current-buffer) nil)
+ (start-file-process "test5" (current-buffer) nil)
:type 'wrong-type-argument)
- (setq proc (start-file-process "test4" (current-buffer) nil))
+ (setq proc (start-file-process "test5" (current-buffer) nil))
(should (processp proc))
(should (equal (process-status proc) 'run))
;; On MS Windows, `process-tty-name' returns nil.
@@ -4749,7 +4825,52 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
;; Cleanup.
(ignore-errors (delete-process proc))
- (ignore-errors (delete-file tmp-name)))))))
+ (ignore-errors (delete-file tmp-name))))
+
+ ;; Process connection type.
+ (when (and (tramp--test-sh-p)
+ ;; `executable-find' has changed the number of
+ ;; parameters in Emacs 27.1, so we use `apply' for
+ ;; older Emacsen.
+ (ignore-errors
+ (with-no-warnings
+ (apply #'executable-find '("hexdump" remote)))))
+ (dolist (connection-type '(nil pipe t pty))
+ ;; `process-connection-type' is taken when
+ ;; `:connection-type' is nil.
+ (dolist (process-connection-type
+ (unless connection-type '(nil pipe t pty)))
+ (unwind-protect
+ (with-temp-buffer
+ (setq proc
+ (with-no-warnings
+ (make-process
+ :name
+ (format "test7-%s-%s"
+ connection-type process-connection-type)
+ :buffer (current-buffer)
+ :connection-type connection-type
+ :command '("hexdump" "-v" "-e" "/1 \"%02X\n\"")
+ :file-handler t)))
+ (should (processp proc))
+ (should (equal (process-status proc) 'run))
+ (process-send-string proc "foo\r\n")
+ (process-send-eof proc)
+ ;; Read output.
+ (with-timeout (10 (tramp--test-timeout-handler))
+ (while (< (- (point-max) (point-min))
+ (length "66\n6F\n6F\n0D\n0A\n"))
+ (while (accept-process-output proc 0 nil t))))
+ (should
+ (string-match-p
+ (if (memq (or connection-type process-connection-type)
+ '(nil pipe))
+ "66\n6F\n6F\n0D\n0A\n"
+ "66\n6F\n6F\n0A\n0A\n")
+ (buffer-string))))
+
+ ;; Cleanup.
+ (ignore-errors (delete-process proc)))))))))
(tramp--test--deftest-direct-async-process tramp-test30-make-process
"Check direct async `make-process'.")
@@ -6320,6 +6441,7 @@ This requires restrictions of file name syntax."
;; These tests are inspired by Bug#17238.
(ert-deftest tramp-test41-special-characters ()
"Check special characters in file names."
+ (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 245s
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-rsync-p)))
(skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
@@ -6330,6 +6452,7 @@ This requires restrictions of file name syntax."
"Check special characters in file names.
Use the `stat' command."
:tags '(:expensive-test)
+ (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 287s
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-rsync-p)))
@@ -6348,6 +6471,7 @@ Use the `stat' command."
"Check special characters in file names.
Use the `perl' command."
:tags '(:expensive-test)
+ (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 266s
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-rsync-p)))
@@ -6369,6 +6493,7 @@ Use the `perl' command."
"Check special characters in file names.
Use the `ls' command."
:tags '(:expensive-test)
+ (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 287s
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-rsync-p)))
@@ -6434,6 +6559,7 @@ Use the `ls' command."
(ert-deftest tramp-test42-utf8 ()
"Check UTF8 encoding in file names and file contents."
+ (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 620s
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-docker-p)))
(skip-unless (not (tramp--test-rsync-p)))
@@ -6449,6 +6575,7 @@ Use the `ls' command."
"Check UTF8 encoding in file names and file contents.
Use the `stat' command."
:tags '(:expensive-test)
+ (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 595s
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-docker-p)))
@@ -6471,6 +6598,7 @@ Use the `stat' command."
"Check UTF8 encoding in file names and file contents.
Use the `perl' command."
:tags '(:expensive-test)
+ (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 620s
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-docker-p)))
@@ -6496,6 +6624,7 @@ Use the `perl' command."
"Check UTF8 encoding in file names and file contents.
Use the `ls' command."
:tags '(:expensive-test)
+ (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 690s
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-docker-p)))
diff --git a/texi/tramp.texi b/texi/tramp.texi
index 6aa5260..817cea2 100644
--- a/texi/tramp.texi
+++ b/texi/tramp.texi
@@ -1290,7 +1290,7 @@ they are added here for the benefit of @ref{Archive file
names}.
If you want to use @acronym{GVFS}-based @option{ftp} or @option{smb}
methods, you must add them to @code{tramp-gvfs-methods}, and you must
-disable the corresponding Tramp package by setting
+disable the corresponding @value{tramp} package by setting
@code{tramp-ftp-method} or @code{tramp-smb-method} to @code{nil},
respectively:
@@ -2122,9 +2122,9 @@ to construct these lists.
@item @t{"remote-shell"}
-This property tells Tramp which remote shell to apply on the remote
-host. It is used in all connection methods of @file{tramp-sh.el}.
-The default value is @t{"/bin/sh"}.
+This property tells @value{tramp} which remote shell to apply on the
+remote host. It is used in all connection methods of
+@file{tramp-sh.el}. The default value is @t{"/bin/sh"}.
@item @t{"remote-shell-login"}
@@ -2310,9 +2310,9 @@ trouble with the shell prompt due to set zle options will
be avoided.
For @command{bash}, loading @file{~/.editrc} or @file{~/.inputrc} is
suppressed.
-Similar problems can happen with the local shell Tramp uses to create
-a process. By default, it uses the command @command{/bin/sh} for
-this, which could also be a link to another shell. In order to
+Similar problems can happen with the local shell @value{tramp} uses to
+create a process. By default, it uses the command @command{/bin/sh}
+for this, which could also be a link to another shell. In order to
overwrite this, you might apply
@vindex tramp-encoding-shell
@@ -3734,6 +3734,33 @@ To open @command{powershell} as a remote shell, use this:
@end lisp
+@subsection Remote process connection type
+@vindex process-connection-type
+@cindex tramp-process-connection-type
+
+Asynchronous processes differ in the way, whether they use a pseudo
+tty, or not. This is controlled by the variable
+@code{process-connection-type}, which can be @code{t} or @code{pty}
+(use a pseudo tty), or @code{nil} or @code{pipe} (don't use it).
+@value{tramp} is based on running shells on the remote host, which
+require a pseudo tty. Therefore, it declares the variable
+@code{tramp-process-connection-type}, which carries this information
+for remote processes. Per default, its value is @code{t}, and there's
+no need to change it. The name of the remote pseudo tty is returned
+by the function @code{process-tty-name}.
+
+If a remote process, started by @code{start-file-process}, shouldn't
+use a pseudo tty, this can be indicated by setting
+@code{process-connection-type} to @code{nil} or @code{pipe}. There is
+still a pseudo tty for the started process, but some terminal
+properties are changed, like suppressing translation of carriage
+return characters into newline.
+
+The function @code{make-process} allows an explicit setting by the
+@code{:connection-type} keyword. If this keyword is not used, the
+value of @code{process-connection-type} is applied instead.
+
+
@anchor{Improving performance of asynchronous remote processes}
@subsection Improving performance of asynchronous remote processes
@cindex Asynchronous remote processes
@@ -4578,6 +4605,16 @@ supported on your proxy host.
@item
+Does @value{tramp} support @acronym{SSH} security keys?
+
+Yes. @command{OpenSSH} has added support for @acronym{FIDO} hardware
+devices via special key types @option{*-sk}. @value{tramp} supports
+the additional handshaking messages for them. This requires at least
+@command{OpenSSH} 8.2, and a @acronym{FIDO} @acronym{U2F} compatible
+security key, like yubikey, solokey, or nitrokey.
+
+
+@item
@value{tramp} does not connect to Samba or MS Windows hosts running
SMB1 connection protocol
diff --git a/texi/trampver.texi b/texi/trampver.texi
index 653ffab..e8e5010 100644
--- a/texi/trampver.texi
+++ b/texi/trampver.texi
@@ -8,7 +8,7 @@
@c In the Tramp GIT, the version numbers are auto-frobbed from
@c tramp.el, and the bug report address is auto-frobbed from
@c configure.ac.
-@set trampver 2.5.1.1
+@set trampver 2.5.1.2
@set trampurl https://www.gnu.org/software/tramp/
@set tramp-bug-report-address tramp-devel@@gnu.org
@set emacsver 25.1
diff --git a/tramp-adb.el b/tramp-adb.el
index 5e0accc..70dbfdb 100644
--- a/tramp-adb.el
+++ b/tramp-adb.el
@@ -924,7 +924,8 @@ implementation will be used."
(command (plist-get args :command))
(coding (plist-get args :coding))
(noquery (plist-get args :noquery))
- (connection-type (plist-get args :connection-type))
+ (connection-type
+ (or (plist-get args :connection-type) process-connection-type))
(filter (plist-get args :filter))
(sentinel (plist-get args :sentinel))
(stderr (plist-get args :stderr)))
@@ -940,7 +941,9 @@ implementation will be used."
(memq (car coding) coding-system-list)
(memq (cdr coding) coding-system-list)))
(signal 'wrong-type-argument (list #'symbolp coding)))
- (unless (or (null connection-type) (memq connection-type '(pipe pty)))
+ (when (eq connection-type t)
+ (setq connection-type 'pty))
+ (unless (memq connection-type '(nil pipe pty))
(signal 'wrong-type-argument (list #'symbolp connection-type)))
(unless (or (null filter) (functionp filter))
(signal 'wrong-type-argument (list #'functionp filter)))
@@ -1065,7 +1068,7 @@ implementation will be used."
p))))
;; Save exit.
- (if (string-match-p tramp-temp-buffer-name (buffer-name))
+ (if (string-prefix-p tramp-temp-buffer-name (buffer-name))
(ignore-errors
(set-process-buffer (tramp-get-connection-process v) nil)
(kill-buffer (current-buffer)))
diff --git a/tramp-cache.el b/tramp-cache.el
index 7b735c8..03cca2e 100644
--- a/tramp-cache.el
+++ b/tramp-cache.el
@@ -125,7 +125,7 @@ If KEY is `tramp-cache-undefined', don't create anything,
and return nil."
(puthash key (make-hash-table :test #'equal) tramp-cache-data)))
(when (tramp-file-name-p key)
(dolist (elt tramp-connection-properties)
- (when (string-match-p
+ (when (tramp-compat-string-search
(or (nth 0 elt) "")
(tramp-make-tramp-file-name key 'noloc 'nohop))
(tramp-set-connection-property key (nth 1 elt) (nth 2 elt)))))
@@ -268,8 +268,8 @@ Remove also properties of all files in subdirectories."
(dolist (key (hash-table-keys tramp-cache-data))
(when (and (tramp-file-name-p key)
(stringp (tramp-file-name-localname key))
- (string-match-p (regexp-quote directory)
- (tramp-file-name-localname key)))
+ (tramp-compat-string-search
+ directory (tramp-file-name-localname key)))
(remhash key tramp-cache-data)))
;; Remove file properties of symlinks.
(when (and (stringp truename)
diff --git a/tramp-cmds.el b/tramp-cmds.el
index d30d220..6278fd3 100644
--- a/tramp-cmds.el
+++ b/tramp-cmds.el
@@ -672,7 +672,7 @@ buffer in your bug report.
(insert "\nload-path shadows:\n==================\n")
(ignore-errors
(mapc
- (lambda (x) (when (string-match-p "tramp" x) (insert x "\n")))
+ (lambda (x) (when (tramp-compat-string-search "tramp" x) (insert x "\n")))
(split-string (list-load-path-shadows t) "\n")))
;; Append buffers only when we are in message mode.
diff --git a/tramp-compat.el b/tramp-compat.el
index 37de988..6ac0b89 100644
--- a/tramp-compat.el
+++ b/tramp-compat.el
@@ -320,6 +320,15 @@ A nil value for either argument stands for the current
time."
(lambda (reporter &optional value _suffix)
(progress-reporter-update reporter value))))
+;; `ignore-error' is new in Emacs Emacs 27.1.
+(defmacro tramp-compat-ignore-error (condition &rest body)
+ "Execute BODY; if the error CONDITION occurs, return nil.
+Otherwise, return result of last form in BODY.
+
+CONDITION can also be a list of error conditions."
+ (declare (debug t) (indent 1))
+ `(condition-case nil (progn ,@body) (,condition nil)))
+
;; `file-modes', `set-file-modes' and `set-file-times' got argument
;; FLAG in Emacs 28.1.
(defalias 'tramp-compat-file-modes
@@ -376,7 +385,17 @@ A nil value for either argument stands for the current
time."
(if (fboundp 'string-replace)
#'string-replace
(lambda (fromstring tostring instring)
- (replace-regexp-in-string (regexp-quote fromstring) tostring instring))))
+ (let ((case-fold-search nil))
+ (replace-regexp-in-string
+ (regexp-quote fromstring) tostring instring t t)))))
+
+;; Function `string-search' is new in Emacs 28.1.
+(defalias 'tramp-compat-string-search
+ (if (fboundp 'string-search)
+ #'string-search
+ (lambda (needle haystack &optional start-pos)
+ (let ((case-fold-search nil))
+ (string-match-p (regexp-quote needle) haystack start-pos)))))
;; Function `make-lock-file-name' is new in Emacs 28.1.
(defalias 'tramp-compat-make-lock-file-name
diff --git a/tramp-gvfs.el b/tramp-gvfs.el
index eff14a2..e4f54cf 100644
--- a/tramp-gvfs.el
+++ b/tramp-gvfs.el
@@ -1401,7 +1401,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(defun tramp-gvfs-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
- (unless (string-match-p "/" filename)
+ (unless (tramp-compat-string-search "/" filename)
(all-completions
filename
(with-parsed-tramp-file-name (expand-file-name directory) nil
diff --git a/tramp-sh.el b/tramp-sh.el
index 7cf90b9..a2bf0af 100644
--- a/tramp-sh.el
+++ b/tramp-sh.el
@@ -519,7 +519,7 @@ shell from reading its init file."
(tramp-yn-prompt-regexp tramp-action-yn)
(tramp-terminal-prompt-regexp tramp-action-terminal)
(tramp-antispoof-regexp tramp-action-confirm-message)
- (tramp-yubikey-regexp tramp-action-show-and-confirm-message)
+ (tramp-security-key-confirm-regexp tramp-action-show-and-confirm-message)
(tramp-process-alive-regexp tramp-action-process-alive))
"List of pattern/action pairs.
Whenever a pattern matches, the corresponding action is performed.
@@ -537,7 +537,7 @@ corresponding PATTERN matches, the ACTION function is
called.")
'((tramp-password-prompt-regexp tramp-action-password)
(tramp-wrong-passwd-regexp tramp-action-permission-denied)
(tramp-copy-failed-regexp tramp-action-permission-denied)
- (tramp-yubikey-regexp tramp-action-show-and-confirm-message)
+ (tramp-security-key-confirm-regexp tramp-action-show-and-confirm-message)
(tramp-process-alive-regexp tramp-action-out-of-band))
"List of pattern/action pairs.
This list is used for copying/renaming with out-of-band methods.
@@ -1740,7 +1740,7 @@ ID-FORMAT valid values are `string' and `integer'."
;; files.
(defun tramp-sh-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
- (unless (string-match-p "/" filename)
+ (unless (tramp-compat-string-search "/" filename)
(all-completions
filename
(with-parsed-tramp-file-name (expand-file-name directory) nil
@@ -1857,41 +1857,53 @@ ID-FORMAT valid values are `string' and `integer'."
(dirname newname &optional keep-date parents copy-contents)
"Like `copy-directory' for Tramp files."
(let ((t1 (tramp-tramp-file-p dirname))
- (t2 (tramp-tramp-file-p newname)))
+ (t2 (tramp-tramp-file-p newname))
+ target)
(with-parsed-tramp-file-name (if t1 dirname newname) nil
(unless (file-exists-p dirname)
(tramp-compat-file-missing v dirname))
- (if (and (not copy-contents)
- (tramp-get-method-parameter v 'tramp-copy-recursive)
- ;; When DIRNAME and NEWNAME are remote, they must have
- ;; the same method.
- (or (null t1) (null t2)
- (string-equal
- (tramp-file-name-method (tramp-dissect-file-name dirname))
- (tramp-file-name-method
- (tramp-dissect-file-name newname)))))
- ;; scp or rsync DTRT.
- (progn
- (when (and (file-directory-p newname)
- (not (directory-name-p newname)))
- (tramp-error v 'file-already-exists newname))
- (setq dirname (directory-file-name (expand-file-name dirname))
- newname (directory-file-name (expand-file-name newname)))
- (when (and (file-directory-p newname)
- (not (string-equal (file-name-nondirectory dirname)
- (file-name-nondirectory newname))))
- (setq newname
- (expand-file-name
- (file-name-nondirectory dirname) newname)))
- (unless (file-directory-p (file-name-directory newname))
+
+ ;; `copy-directory-create-symlink' exists since Emacs 28.1.
+ (if (and (bound-and-true-p copy-directory-create-symlink)
+ (setq target (file-symlink-p dirname))
+ (tramp-equal-remote dirname newname))
+ (make-symbolic-link
+ target
+ (if (directory-name-p newname)
+ (concat newname (file-name-nondirectory dirname)) newname)
+ t)
+
+ (if (and (not copy-contents)
+ (tramp-get-method-parameter v 'tramp-copy-recursive)
+ ;; When DIRNAME and NEWNAME are remote, they must
+ ;; have the same method.
+ (or (null t1) (null t2)
+ (string-equal
+ (tramp-file-name-method (tramp-dissect-file-name dirname))
+ (tramp-file-name-method
+ (tramp-dissect-file-name newname)))))
+ ;; scp or rsync DTRT.
+ (progn
+ (when (and (file-directory-p newname)
+ (not (directory-name-p newname)))
+ (tramp-error v 'file-already-exists newname))
+ (setq dirname (directory-file-name (expand-file-name dirname))
+ newname (directory-file-name (expand-file-name newname)))
+ (when (and (file-directory-p newname)
+ (not (string-equal (file-name-nondirectory dirname)
+ (file-name-nondirectory newname))))
+ (setq newname
+ (expand-file-name
+ (file-name-nondirectory dirname) newname)))
+ (unless (file-directory-p (file-name-directory newname))
(make-directory (file-name-directory newname) parents))
- (tramp-do-copy-or-rename-file-out-of-band
- 'copy dirname newname 'ok-if-already-exists keep-date))
+ (tramp-do-copy-or-rename-file-out-of-band
+ 'copy dirname newname 'ok-if-already-exists keep-date))
- ;; We must do it file-wise.
- (tramp-run-real-handler
- #'copy-directory
- (list dirname newname keep-date parents copy-contents)))
+ ;; We must do it file-wise.
+ (tramp-run-real-handler
+ #'copy-directory
+ (list dirname newname keep-date parents copy-contents))))
;; When newname did exist, we have wrong cached values.
(when t2
@@ -2309,7 +2321,8 @@ The method used must be an out-of-band method."
copy-args
(tramp-compat-flatten-tree
(mapcar
- (lambda (x) (if (string-match-p " " x) (split-string x) x))
+ (lambda (x) (if (tramp-compat-string-search " " x)
+ (split-string x) x))
copy-args))
copy-env (apply #'tramp-expand-args v 'tramp-copy-env spec)
remote-copy-program
@@ -2602,8 +2615,8 @@ The method used must be an out-of-band method."
(save-restriction
(narrow-to-region beg-marker end-marker)
;; Some busyboxes are reluctant to discard colors.
- (unless
- (string-match-p "color" (tramp-get-connection-property v "ls" ""))
+ (unless (tramp-compat-string-search
+ "color" (tramp-get-connection-property v "ls" ""))
(goto-char (point-min))
(while (re-search-forward tramp-display-escape-sequence-regexp nil
t)
(replace-match "")))
@@ -2751,7 +2764,8 @@ implementation will be used."
(command (plist-get args :command))
(coding (plist-get args :coding))
(noquery (plist-get args :noquery))
- (connection-type (plist-get args :connection-type))
+ (connection-type
+ (or (plist-get args :connection-type) process-connection-type))
(filter (plist-get args :filter))
(sentinel (plist-get args :sentinel))
(stderr (plist-get args :stderr)))
@@ -2767,7 +2781,9 @@ implementation will be used."
(memq (car coding) coding-system-list)
(memq (cdr coding) coding-system-list)))
(signal 'wrong-type-argument (list #'symbolp coding)))
- (unless (or (null connection-type) (memq connection-type '(pipe pty)))
+ (when (eq connection-type t)
+ (setq connection-type 'pty))
+ (unless (memq connection-type '(nil pipe pty))
(signal 'wrong-type-argument (list #'symbolp connection-type)))
(unless (or (null filter) (functionp filter))
(signal 'wrong-type-argument (list #'functionp filter)))
@@ -2828,7 +2844,7 @@ implementation will be used."
(env (dolist (elt (cons prompt process-environment) env)
(or (member
elt (default-toplevel-value 'process-environment))
- (if (string-match-p "=" elt)
+ (if (tramp-compat-string-search "=" elt)
(setq env (append env `(,elt)))
(setq uenv (cons elt uenv))))))
(env (setenv-internal
@@ -2915,6 +2931,9 @@ implementation will be used."
(setq p (tramp-get-connection-process v))
(process-put p 'remote-pid pid)
(tramp-set-connection-property p "remote-pid" pid))
+ ;; Disable carriage return to newline translation.
+ (when (memq connection-type '(nil pipe))
+ (tramp-send-command v "stty -icrnl"))
;; `tramp-maybe-open-connection' and
;; `tramp-send-command-and-read' could have
;; trashed the connection buffer. Remove this.
@@ -2957,7 +2976,7 @@ implementation will be used."
p)))
;; Save exit.
- (if (string-match-p tramp-temp-buffer-name (buffer-name))
+ (if (string-prefix-p tramp-temp-buffer-name (buffer-name))
(ignore-errors
(set-process-buffer p nil)
(kill-buffer (current-buffer)))
@@ -3039,7 +3058,7 @@ implementation will be used."
;; We use as environment the difference to toplevel
`process-environment'.
(dolist (elt process-environment)
(or (member elt (default-toplevel-value 'process-environment))
- (if (string-match-p "=" elt)
+ (if (tramp-compat-string-search "=" elt)
(setq env (append env `(,elt)))
(setq uenv (cons elt uenv)))))
(setenv-internal env "INSIDE_EMACS" (tramp-inside-emacs) 'keep)
@@ -4308,7 +4327,7 @@ process to set up. VEC specifies the connection."
;; Use MULE to select the right EOL convention for communicating
;; with the process.
(let ((cs (or (and (memq 'utf-8-hfs (coding-system-list))
- (string-match-p "^Darwin" uname)
+ (string-prefix-p "Darwin" uname)
(cons 'utf-8-hfs 'utf-8-hfs))
(and (memq 'utf-8 (coding-system-list))
(string-match-p "utf-?8" (tramp-get-remote-locale vec))
@@ -4321,7 +4340,7 @@ process to set up. VEC specifies the connection."
cs-encode (or (cdr cs) 'undecided)
cs-encode
(coding-system-change-eol-conversion
- cs-encode (if (string-match-p "^Darwin" uname) 'mac 'unix)))
+ cs-encode (if (string-prefix-p "Darwin" uname) 'mac 'unix)))
(tramp-send-command vec "(echo foo ; echo bar)" t)
(goto-char (point-min))
(when (search-forward "\r" nil t)
@@ -4371,7 +4390,7 @@ process to set up. VEC specifies the connection."
;; IRIX64 bash expands "!" even when in single quotes. This
;; destroys our shell functions, we must disable it. See
;;
<https://stackoverflow.com/questions/3291692/irix-bash-shell-expands-expression-in-single-quotes-yet-shouldnt>.
- (when (string-match-p "^IRIX64" uname)
+ (when (string-prefix-p "IRIX64" uname)
(tramp-send-command vec "set +H" t))
;; Disable tab expansion.
@@ -4627,12 +4646,12 @@ means standard output and thus the current buffer), or
nil (which
means discard it)."
(tramp-call-process
nil tramp-encoding-shell
- (when (and input (not (string-match-p "%s" cmd))) input)
+ (when (and input (not (tramp-compat-string-search "%s" cmd))) input)
(if (eq output t) t nil)
nil
tramp-encoding-command-switch
(concat
- (if (string-match-p "%s" cmd) (format cmd input) cmd)
+ (if (tramp-compat-string-search "%s" cmd) (format cmd input) cmd)
(if (stringp output) (concat " >" output) ""))))
(defconst tramp-inline-compress-commands
@@ -5222,7 +5241,7 @@ Return ATTR."
(when (stringp (car attr))
(aset (nth 8 attr) 0 ?l)))
;; Convert directory indication bit.
- (when (string-match-p "^d" (nth 8 attr))
+ (when (string-prefix-p "d" (nth 8 attr))
(setcar attr t))
;; Convert symlink from `tramp-do-file-attributes-with-stat'.
;; Decode also multibyte string.
@@ -5802,12 +5821,13 @@ function cell is returned to be applied on a buffer."
(with-tramp-connection-property (tramp-get-process vec) prop
(tramp-find-inline-encoding vec)
(tramp-get-connection-property (tramp-get-process vec) prop nil)))
- (prop1 (if (string-match-p "encoding" prop)
+ (prop1 (if (tramp-compat-string-search "encoding" prop)
"inline-compress" "inline-decompress"))
compress)
;; The connection property might have been cached. So we must
;; send the script to the remote side - maybe.
- (when (and coding (symbolp coding) (string-match-p "remote" prop))
+ (when (and coding (symbolp coding)
+ (tramp-compat-string-search "remote" prop))
(let ((name (symbol-name coding)))
(while (string-match "-" name)
(setq name (replace-match "_" nil t name)))
@@ -5819,7 +5839,7 @@ function cell is returned to be applied on a buffer."
;; Return the value.
(cond
((and compress (symbolp coding))
- (if (string-match-p "decompress" prop1)
+ (if (tramp-compat-string-search "decompress" prop1)
`(lambda (beg end)
(,coding beg end)
(let ((coding-system-for-write 'binary)
@@ -5838,16 +5858,16 @@ function cell is returned to be applied on a buffer."
(,coding (point-min) (point-max)))))
((symbolp coding)
coding)
- ((and compress (string-match-p "decoding" prop))
+ ((and compress (tramp-compat-string-search "decoding" prop))
(format
;; Windows shells need the program file name after
;; the pipe symbol be quoted if they use forward
;; slashes as directory separators.
(cond
- ((and (string-match-p "local" prop)
+ ((and (tramp-compat-string-search "local" prop)
(eq system-type 'windows-nt))
"(%s | \"%s\")")
- ((string-match-p "local" prop) "(%s | %s)")
+ ((tramp-compat-string-search "local" prop) "(%s | %s)")
(t "(%s | %s >%%s)"))
coding compress))
(compress
@@ -5855,14 +5875,14 @@ function cell is returned to be applied on a buffer."
;; Windows shells need the program file name after
;; the pipe symbol be quoted if they use forward
;; slashes as directory separators.
- (if (and (string-match-p "local" prop)
+ (if (and (tramp-compat-string-search "local" prop)
(eq system-type 'windows-nt))
"(%s <%%s | \"%s\")"
"(%s <%%s | %s)")
compress coding))
- ((string-match-p "decoding" prop)
+ ((tramp-compat-string-search "decoding" prop)
(cond
- ((string-match-p "local" prop) (format "%s" coding))
+ ((tramp-compat-string-search "local" prop) (format "%s" coding))
(t (format "%s >%%s" coding))))
(t
(format "%s <%%s" coding)))))))
diff --git a/tramp-smb.el b/tramp-smb.el
index 3d5be61..5cfe874 100644
--- a/tramp-smb.el
+++ b/tramp-smb.el
@@ -414,157 +414,176 @@ arguments to pass to the OPERATION."
(defun tramp-smb-handle-copy-directory
(dirname newname &optional keep-date parents copy-contents)
"Like `copy-directory' for Tramp files."
- (if copy-contents
- ;; We must do it file-wise.
- (tramp-run-real-handler
- #'copy-directory (list dirname newname keep-date parents copy-contents))
-
- (setq dirname (expand-file-name dirname)
- newname (expand-file-name newname))
- (let ((t1 (tramp-tramp-file-p dirname))
- (t2 (tramp-tramp-file-p newname)))
- (with-parsed-tramp-file-name (if t1 dirname newname) nil
- (with-tramp-progress-reporter
- v 0 (format "Copying %s to %s" dirname newname)
- (unless (file-exists-p dirname)
- (tramp-compat-file-missing v dirname))
- (when (and (file-directory-p newname)
- (not (directory-name-p newname)))
- (tramp-error v 'file-already-exists newname))
- (cond
- ;; We must use a local temporary directory.
- ((and t1 t2)
- (let ((tmpdir (tramp-compat-make-temp-name)))
- (unwind-protect
- (progn
- (make-directory tmpdir)
- (copy-directory
- dirname (file-name-as-directory tmpdir) keep-date 'parents)
- (copy-directory
- (expand-file-name (file-name-nondirectory dirname) tmpdir)
- newname keep-date parents))
- (delete-directory tmpdir 'recursive))))
-
- ;; We can copy recursively.
- ;; TODO: Does not work reliably.
- (nil ;(and (or t1 t2) (tramp-smb-get-cifs-capabilities v))
+ (let ((t1 (tramp-tramp-file-p dirname))
+ (t2 (tramp-tramp-file-p newname))
+ target)
+ (with-parsed-tramp-file-name (if t1 dirname newname) nil
+ (unless (file-exists-p dirname)
+ (tramp-compat-file-missing v dirname))
+
+ ;; `copy-directory-create-symlink' exists since Emacs 28.1.
+ (if (and (bound-and-true-p copy-directory-create-symlink)
+ (setq target (file-symlink-p dirname))
+ (tramp-equal-remote dirname newname))
+ (make-symbolic-link
+ target
+ (if (directory-name-p newname)
+ (concat newname (file-name-nondirectory dirname)) newname)
+ t)
+
+ (if copy-contents
+ ;; We must do it file-wise.
+ (tramp-run-real-handler
+ #'copy-directory
+ (list dirname newname keep-date parents copy-contents))
+
+ (setq dirname (expand-file-name dirname)
+ newname (expand-file-name newname))
+ (with-tramp-progress-reporter
+ v 0 (format "Copying %s to %s" dirname newname)
+ (unless (file-exists-p dirname)
+ (tramp-compat-file-missing v dirname))
(when (and (file-directory-p newname)
- (not (string-equal (file-name-nondirectory dirname)
- (file-name-nondirectory newname))))
- (setq newname
- (expand-file-name
- (file-name-nondirectory dirname) newname))
- (if t2 (setq v (tramp-dissect-file-name newname))))
- (if (not (file-directory-p newname))
- (make-directory newname parents))
-
- (let* ((share (tramp-smb-get-share v))
- (localname (file-name-as-directory
- (tramp-compat-string-replace
- "\\" "/" (tramp-smb-get-localname v))))
- (tmpdir (tramp-compat-make-temp-name))
- (args (list (concat "//" host "/" share) "-E"))
- (options tramp-smb-options))
-
- (if (not (zerop (length user)))
- (setq args (append args (list "-U" user)))
- (setq args (append args (list "-N"))))
-
- (when domain (setq args (append args (list "-W" domain))))
- (when port (setq args (append args (list "-p" port))))
- (when tramp-smb-conf
- (setq args (append args (list "-s" tramp-smb-conf))))
- (while options
+ (not (directory-name-p newname)))
+ (tramp-error v 'file-already-exists newname))
+ (cond
+ ;; We must use a local temporary directory.
+ ((and t1 t2)
+ (let ((tmpdir (tramp-compat-make-temp-name)))
+ (unwind-protect
+ (progn
+ (make-directory tmpdir)
+ (copy-directory
+ dirname (file-name-as-directory tmpdir)
+ keep-date 'parents)
+ (copy-directory
+ (expand-file-name (file-name-nondirectory dirname)
tmpdir)
+ newname keep-date parents))
+ (delete-directory tmpdir 'recursive))))
+
+ ;; We can copy recursively.
+ ;; TODO: Does not work reliably.
+ (nil ;(and (or t1 t2) (tramp-smb-get-cifs-capabilities v))
+ (when (and (file-directory-p newname)
+ (not (string-equal (file-name-nondirectory dirname)
+ (file-name-nondirectory newname))))
+ (setq newname
+ (expand-file-name
+ (file-name-nondirectory dirname) newname))
+ (if t2 (setq v (tramp-dissect-file-name newname))))
+ (if (not (file-directory-p newname))
+ (make-directory newname parents))
+
+ (let* ((share (tramp-smb-get-share v))
+ (localname (file-name-as-directory
+ (tramp-compat-string-replace
+ "\\" "/" (tramp-smb-get-localname v))))
+ (tmpdir (tramp-compat-make-temp-name))
+ (args (list (concat "//" host "/" share) "-E"))
+ (options tramp-smb-options))
+
+ (if (not (zerop (length user)))
+ (setq args (append args (list "-U" user)))
+ (setq args (append args (list "-N"))))
+
+ (when domain (setq args (append args (list "-W" domain))))
+ (when port (setq args (append args (list "-p" port))))
+ (when tramp-smb-conf
+ (setq args (append args (list "-s" tramp-smb-conf))))
+ (while options
+ (setq args
+ (append args `("--option" ,(format "%s" (car options))))
+ options (cdr options)))
(setq args
- (append args `("--option" ,(format "%s" (car options))))
- options (cdr options)))
- (setq args
- (if t1
- ;; Source is remote.
- (append args
+ (if t1
+ ;; Source is remote.
+ (append args
+ (list "-D" (tramp-unquote-shell-quote-argument
+ localname)
+ "-c" (tramp-unquote-shell-quote-argument
+ "tar qc - *")
+ "|" "tar" "xfC" "-"
+ (tramp-unquote-shell-quote-argument
+ tmpdir)))
+ ;; Target is remote.
+ (append (list
+ "tar" "cfC" "-"
+ (tramp-unquote-shell-quote-argument dirname)
+ "." "|")
+ args
(list "-D" (tramp-unquote-shell-quote-argument
localname)
"-c" (tramp-unquote-shell-quote-argument
- "tar qc - *")
- "|" "tar" "xfC" "-"
- (tramp-unquote-shell-quote-argument
- tmpdir)))
- ;; Target is remote.
- (append (list "tar" "cfC" "-"
- (tramp-unquote-shell-quote-argument dirname)
- "." "|")
- args
- (list "-D" (tramp-unquote-shell-quote-argument
- localname)
- "-c" (tramp-unquote-shell-quote-argument
- "tar qx -")))))
-
- (unwind-protect
- (with-temp-buffer
- ;; Set the transfer process properties.
- (tramp-set-connection-property
- v "process-name" (buffer-name (current-buffer)))
- (tramp-set-connection-property
- v "process-buffer" (current-buffer))
-
- (when t1
- ;; The smbclient tar command creates always
- ;; complete paths. We must emulate the
- ;; directory structure, and symlink to the real
- ;; target.
- (make-directory
- (expand-file-name
- ".." (concat tmpdir localname))
- 'parents)
- (make-symbolic-link
- newname (directory-file-name (concat tmpdir localname))))
-
- ;; Use an asynchronous processes. By this,
- ;; password can be handled.
- (let* ((default-directory tmpdir)
- (p (apply
- #'start-process
- (tramp-get-connection-name v)
- (tramp-get-connection-buffer v)
- tramp-smb-program args)))
-
- (tramp-message
- v 6 "%s" (string-join (process-command p) " "))
- (process-put p 'vector v)
- (process-put p 'adjust-window-size-function #'ignore)
- (set-process-query-on-exit-flag p nil)
- (tramp-process-actions p v nil tramp-smb-actions-with-tar)
-
- (while (process-live-p p)
- (sleep-for 0.1))
- (tramp-message v 6 "\n%s" (buffer-string))))
-
- ;; Reset the transfer process properties.
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer")
- (when t1 (delete-directory tmpdir 'recursive))))
-
- ;; Handle KEEP-DATE argument.
- (when keep-date
- (tramp-compat-set-file-times
- newname
- (tramp-compat-file-attribute-modification-time
- (file-attributes dirname))
- (unless ok-if-already-exists 'nofollow)))
-
- ;; Set the mode.
- (unless keep-date
- (set-file-modes newname (tramp-default-file-modes dirname)))
-
- ;; When newname did exist, we have wrong cached values.
- (when t2
- (with-parsed-tramp-file-name newname nil
- (tramp-flush-file-properties v localname))))
-
- ;; We must do it file-wise.
- (t
- (tramp-run-real-handler
- #'copy-directory (list dirname newname keep-date parents)))))))))
+ "tar qx -")))))
+
+ (unwind-protect
+ (with-temp-buffer
+ ;; Set the transfer process properties.
+ (tramp-set-connection-property
+ v "process-name" (buffer-name (current-buffer)))
+ (tramp-set-connection-property
+ v "process-buffer" (current-buffer))
+
+ (when t1
+ ;; The smbclient tar command creates always
+ ;; complete paths. We must emulate the
+ ;; directory structure, and symlink to the
+ ;; real target.
+ (make-directory
+ (expand-file-name
+ ".." (concat tmpdir localname))
+ 'parents)
+ (make-symbolic-link
+ newname
+ (directory-file-name (concat tmpdir localname))))
+
+ ;; Use an asynchronous processes. By this,
+ ;; password can be handled.
+ (let* ((default-directory tmpdir)
+ (p (apply
+ #'start-process
+ (tramp-get-connection-name v)
+ (tramp-get-connection-buffer v)
+ tramp-smb-program args)))
+
+ (tramp-message
+ v 6 "%s" (string-join (process-command p) " "))
+ (process-put p 'vector v)
+ (process-put p 'adjust-window-size-function #'ignore)
+ (set-process-query-on-exit-flag p nil)
+ (tramp-process-actions
+ p v nil tramp-smb-actions-with-tar)
+
+ (while (process-live-p p)
+ (sleep-for 0.1))
+ (tramp-message v 6 "\n%s" (buffer-string))))
+
+ ;; Reset the transfer process properties.
+ (tramp-flush-connection-property v "process-name")
+ (tramp-flush-connection-property v "process-buffer")
+ (when t1 (delete-directory tmpdir 'recursive))))
+
+ ;; Handle KEEP-DATE argument.
+ (when keep-date
+ (tramp-compat-set-file-times
+ newname
+ (tramp-compat-file-attribute-modification-time
+ (file-attributes dirname))
+ (unless ok-if-already-exists 'nofollow)))
+
+ ;; Set the mode.
+ (unless keep-date
+ (set-file-modes newname (tramp-default-file-modes dirname)))
+
+ ;; When newname did exist, we have wrong cached values.
+ (when t2
+ (with-parsed-tramp-file-name newname nil
+ (tramp-flush-file-properties v localname))))
+
+ ;; We must do it file-wise.
+ (t
+ (tramp-run-real-handler
+ #'copy-directory (list dirname newname keep-date
parents))))))))))
(defun tramp-smb-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
@@ -849,7 +868,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
;; Check result.
(when entry
- (list (and (string-match-p "d" (nth 1 entry))
+ (list (and (tramp-compat-string-search "d" (nth 1 entry))
t) ;0 file type
-1 ;1 link count
uid ;2 uid
@@ -982,7 +1001,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(mapcar
(lambda (x)
(list
- (if (string-match-p "d" (nth 1 x))
+ (if (tramp-compat-string-search "d" (nth 1 x))
(file-name-as-directory (nth 0 x))
(nth 0 x))))
(tramp-smb-get-file-entries directory)))))))
@@ -1021,7 +1040,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(defun tramp-smb-handle-file-writable-p (filename)
"Like `file-writable-p' for Tramp files."
(if (file-exists-p filename)
- (string-match-p
+ (tramp-compat-string-search
"w"
(or (tramp-compat-file-attribute-modes (file-attributes filename)) ""))
(let ((dir (file-name-directory filename)))
@@ -1076,9 +1095,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
;; Check for matching entries.
(mapcar
(lambda (x)
- (when (string-match-p
- (format "^%s" base) (nth 0 x))
- x))
+ (when (string-match-p (format "^%s" base) (nth 0 x)) x))
entries)
;; We just need the only and only entry FILENAME.
(list (assoc base entries)))))
@@ -1088,14 +1105,14 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(sort
entries
(lambda (x y)
- (if (string-match-p "t" switches)
+ (if (tramp-compat-string-search "t" switches)
;; Sort by date.
(time-less-p (nth 3 y) (nth 3 x))
;; Sort by name.
(string-lessp (nth 0 x) (nth 0 y))))))
;; Handle "-F" switch.
- (when (string-match-p "F" switches)
+ (when (tramp-compat-string-search "F" switches)
(mapc
(lambda (x)
(unless (zerop (length (car x)))
@@ -1124,7 +1141,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(expand-file-name
(nth 0 x) (file-name-directory filename))
'string)))))
- (when (string-match-p "l" switches)
+ (when (tramp-compat-string-search "l" switches)
(insert
(format
"%10s %3d %-8s %-8s %8s %s "
@@ -1153,7 +1170,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(put-text-property start (point) 'dired-filename t))
;; Insert symlink.
- (when (and (string-match-p "l" switches)
+ (when (and (tramp-compat-string-search "l" switches)
(stringp (tramp-compat-file-attribute-type attr)))
(insert " -> " (tramp-compat-file-attribute-type attr))))
@@ -1551,7 +1568,7 @@ component is used as the target of the symlink."
;; Save exit.
(with-current-buffer (tramp-get-connection-buffer v)
- (if (string-match-p tramp-temp-buffer-name (buffer-name))
+ (if (tramp-compat-string-search tramp-temp-buffer-name (buffer-name))
(progn
(set-process-buffer (tramp-get-connection-process v) nil)
(kill-buffer (current-buffer)))
@@ -1857,10 +1874,12 @@ are listed. Result is the list (LOCALNAME MODE SIZE
MTIME)."
mode (or (match-string 1 line) "")
mode (format
"%s%s"
- (if (string-match-p "D" mode) "d" "-")
+ (if (tramp-compat-string-search "D" mode) "d" "-")
(mapconcat
(lambda (_x) "") " "
- (concat "r" (if (string-match-p "R" mode) "-" "w") "x")))
+ (format
+ "r%sx"
+ (if (tramp-compat-string-search "R" mode) "-" "w"))))
line (substring line 0 -6))
(cl-return))
diff --git a/tramp.el b/tramp.el
index 18cae06..429d1ce 100644
--- a/tramp.el
+++ b/tramp.el
@@ -697,11 +697,26 @@ The regexp should match at end of buffer."
:version "27.1"
:type 'regexp)
-;; Yubikey requires the user physically to touch the device with their
-;; finger. We must tell it to the user.
-(defcustom tramp-yubikey-regexp
+;; A security key requires the user physically to touch the device
+;; with their finger. We must tell it to the user.
+;; Added in OpenSSH 8.2. I've tested it with yubikey.
+(defcustom tramp-security-key-confirm-regexp
"^\r*Confirm user presence for key .*[\r\n]*"
- "Regular expression matching yubikey confirmation message.
+ "Regular expression matching security key confirmation message.
+The regexp should match at end of buffer."
+ :version "28.1"
+ :type 'regexp)
+
+(defcustom tramp-security-key-confirmed-regexp
+ "^\r*User presence confirmed[\r\n]*"
+ "Regular expression matching security key confirmation message.
+The regexp should match at end of buffer."
+ :version "28.1"
+ :type 'regexp)
+
+(defcustom tramp-security-key-timeout-regexp
+ "^\r*sign_and_send_pubkey: signing failed for .*[\r\n]*"
+ "Regular expression matching security key timeout message.
The regexp should match at end of buffer."
:version "28.1"
:type 'regexp)
@@ -1256,14 +1271,14 @@ this variable to be set as well."
:type '(choice (const nil) integer))
;; Logging in to a remote host normally requires obtaining a pty. But
-;; Emacs on macOS has process-connection-type set to nil by default,
+;; Emacs on macOS has `process-connection-type' set to nil by default,
;; so on those systems Tramp doesn't obtain a pty. Here, we allow
;; for an override of the system default.
(defcustom tramp-process-connection-type t
"Overrides `process-connection-type' for connections from Tramp.
Tramp binds `process-connection-type' to the value given here before
opening a connection to a remote host."
- :type '(choice (const nil) (const t) (const pty)))
+ :type '(choice (const nil) (const t) (const pipe) (const pty)))
(defcustom tramp-connection-timeout 60
"Defines the max time to wait for establishing a connection (in seconds).
@@ -1617,7 +1632,8 @@ default values are used."
(setq v (tramp-dissect-hop-name hop)
hop (and hop (tramp-make-tramp-hop-name v))))
(let ((tramp-default-host
- (or (and v (not (string-match-p "%h" (tramp-file-name-host v)))
+ (or (and v (not (tramp-compat-string-search
+ "%h" (tramp-file-name-host v)))
(tramp-file-name-host v))
tramp-default-host)))
(setq method (tramp-find-method method user host)
@@ -1969,7 +1985,7 @@ ARGUMENTS to actually emit the message (if applicable)."
(if (not btf)
(setq fn "")
(and (symbolp btf) (setq fn (symbol-name btf))
- (or (not (string-match-p "^tramp" fn))
+ (or (not (string-prefix-p "tramp" fn))
(get btf 'tramp-suppress-trace))
(setq fn nil))
(setq btn (1+ btn))))
@@ -2221,7 +2237,7 @@ If VAR is nil, then we bind `v' to the structure and
`method', `user',
"Report progress of an operation for Tramp."
(let* ((parameters (cdr reporter))
(message (aref parameters 3)))
- (when (string-match-p message (or (current-message) ""))
+ (when (tramp-compat-string-search message (or (current-message) ""))
(tramp-compat-progress-reporter-update reporter value suffix))))
(defmacro with-tramp-progress-reporter (vec level message &rest body)
@@ -2335,7 +2351,7 @@ Example:
(unless (and (functionp (nth 0 (car v)))
(cond
;; Windows registry.
- ((string-match-p "^HKEY_CURRENT_USER" (nth 1 (car v)))
+ ((string-prefix-p "HKEY_CURRENT_USER" (nth 1 (car v)))
(and (memq system-type '(cygwin windows-nt))
(zerop
(tramp-call-process
@@ -3024,8 +3040,7 @@ remote host and localname (filename on remote host)."
"Return all method completions for PARTIAL-METHOD."
(mapcar
(lambda (method)
- (and method
- (string-match-p (concat "^" (regexp-quote partial-method)) method)
+ (and method (string-prefix-p partial-method method)
(tramp-completion-make-tramp-file-name method nil nil nil)))
(mapcar #'car tramp-methods)))
@@ -3037,8 +3052,7 @@ PARTIAL-USER must match USER, PARTIAL-HOST must match
HOST."
(cond
((and partial-user partial-host)
- (if (and host
- (string-match-p (concat "^" (regexp-quote partial-host)) host)
+ (if (and host (string-prefix-p partial-host host)
(string-equal partial-user (or user partial-user)))
(setq user partial-user)
(setq user nil
@@ -3046,16 +3060,12 @@ PARTIAL-USER must match USER, PARTIAL-HOST must match
HOST."
(partial-user
(setq host nil)
- (unless
- (and user
- (string-match-p (concat "^" (regexp-quote partial-user)) user))
+ (unless (and user (string-prefix-p partial-user user))
(setq user nil)))
(partial-host
(setq user nil)
- (unless
- (and host
- (string-match-p (concat "^" (regexp-quote partial-host)) host))
+ (unless (and host (string-prefix-p partial-host host))
(setq host nil)))
(t (setq user nil
@@ -3733,7 +3743,7 @@ User is always nil."
(list filename switches wildcard full-directory-p))
;; `ls-lisp' always returns full listings. We must remove
;; superfluous parts.
- (unless (string-match-p "l" switches)
+ (unless (tramp-compat-string-search "l" switches)
(save-excursion
(goto-char (point-min))
(while (setq start
@@ -4124,7 +4134,8 @@ substitution. SPEC-LIST is a list of char/value pairs
used for
(command (plist-get args :command))
(coding (plist-get args :coding))
(noquery (plist-get args :noquery))
- (connection-type (plist-get args :connection-type))
+ (connection-type
+ (or (plist-get args :connection-type) process-connection-type))
(filter (plist-get args :filter))
(sentinel (plist-get args :sentinel))
(stderr (plist-get args :stderr)))
@@ -4140,7 +4151,9 @@ substitution. SPEC-LIST is a list of char/value pairs
used for
(memq (car coding) coding-system-list)
(memq (cdr coding) coding-system-list)))
(signal 'wrong-type-argument (list #'symbolp coding)))
- (unless (or (null connection-type) (memq connection-type '(pipe pty)))
+ (when (eq connection-type t)
+ (setq connection-type 'pty))
+ (unless (memq connection-type '(nil pipe pty))
(signal 'wrong-type-argument (list #'symbolp connection-type)))
(unless (or (null filter) (functionp filter))
(signal 'wrong-type-argument (list #'functionp filter)))
@@ -4156,14 +4169,14 @@ substitution. SPEC-LIST is a list of char/value pairs
used for
(generate-new-buffer tramp-temp-buffer-name)))
(env (mapcar
(lambda (elt)
- (when (string-match-p "=" elt) elt))
+ (when (tramp-compat-string-search "=" elt) elt))
tramp-remote-process-environment))
;; We use as environment the difference to toplevel
;; `process-environment'.
(env (dolist (elt process-environment env)
(when
(and
- (string-match-p "=" elt)
+ (tramp-compat-string-search "=" elt)
(not
(member
elt (default-toplevel-value
'process-environment))))
@@ -4720,15 +4733,23 @@ The terminal type can be configured with
`tramp-terminal-type'."
"Show the user a message for confirmation.
Wait, until the connection buffer changes."
(with-current-buffer (process-buffer proc)
- (let ((stimers (with-timeout-suspend)))
+ (let ((stimers (with-timeout-suspend))
+ (cursor-in-echo-area t)
+ set-message-function clear-message-function)
+ ;; Silence byte compiler.
+ (ignore set-message-function clear-message-function)
(tramp-message vec 6 "\n%s" (buffer-string))
- (goto-char (point-min))
(tramp-check-for-regexp proc tramp-process-action-regexp)
(with-temp-message (replace-regexp-in-string "[\r\n]" "" (match-string
0))
;; Hide message in buffer.
(narrow-to-region (point-max) (point-max))
;; Wait for new output.
- (tramp-wait-for-regexp proc 30 "."))
+ (while (not (tramp-compat-ignore-error 'file-error
+ (tramp-wait-for-regexp
+ proc 0.1 tramp-security-key-confirmed-regexp)))
+ (when (tramp-check-for-regexp proc tramp-security-key-timeout-regexp)
+ (throw 'tramp-action 'timeout))
+ (redisplay 'force)))
;; Reenable the timers.
(with-timeout-unsuspend stimers)))
t)
diff --git a/trampver.el b/trampver.el
index d3e08be..8a3793b 100644
--- a/trampver.el
+++ b/trampver.el
@@ -7,7 +7,7 @@
;; Maintainer: Michael Albinus <michael.albi...@gmx.de>
;; Keywords: comm, processes
;; Package: tramp
-;; Version: 2.5.1.1
+;; Version: 2.5.1.2
;; Package-Requires: ((emacs "25.1"))
;; Package-Type: multi
;; URL: https://www.gnu.org/software/tramp/
@@ -40,7 +40,7 @@
;; ./configure" to change them.
;;;###tramp-autoload
-(defconst tramp-version "2.5.1.1"
+(defconst tramp-version "2.5.1.2"
"This version of Tramp.")
;;;###tramp-autoload
@@ -76,7 +76,7 @@
;; Check for Emacs version.
(let ((x (if (not (string-lessp emacs-version "25.1"))
"ok"
- (format "Tramp 2.5.1.1 is not fit for %s"
+ (format "Tramp 2.5.1.2 is not fit for %s"
(replace-regexp-in-string "\n" "" (emacs-version))))))
(unless (string-equal "ok" x) (error "%s" x)))
