1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-24 06:20:43 -08:00

Tramp code cleanup

* lisp/net/tramp-sh.el (tramp-methods) <telnet, nc>:
Reintroduce "%n" marker.
(tramp-maybe-open-connection): Handle it.

* lisp/net/tramp.el (tramp-prefix-regexp):
* lisp/net/tramp-smb.el (tramp-smb-options): Fix docstring.

* lisp/net/tramp*.el: Fix typos.  Remove trailing space from
`yes-or-no-p' and `y-or-n-p' prompts.

* test/lisp/net/tramp-tests.el (tramp--test-telnet-p): New defun.
(tramp-test29-start-file-process, tramp-test30-make-process)
(tramp-test35-remote-path, tramp-test44-asynchronous-requests):
Adapt tests.
This commit is contained in:
Michael Albinus 2021-09-16 16:50:24 +02:00
parent 85c7993631
commit 36474a1e49
13 changed files with 80 additions and 62 deletions

View file

@ -361,7 +361,7 @@ arguments to pass to the OPERATION."
(tramp-message vec 5 "Finding a suitable `ls' command") (tramp-message vec 5 "Finding a suitable `ls' command")
(cond (cond
;; Support Android derived systems where "ls" command is provided ;; Support Android derived systems where "ls" command is provided
;; by GNU Coreutils. Force "ls" to print one column and set ;; by GNU Coreutils. Force "ls" to print one column and set
;; time-style to imitate other "ls" flavors. ;; time-style to imitate other "ls" flavors.
((tramp-adb-send-command-and-check ((tramp-adb-send-command-and-check
vec (concat "ls --time-style=long-iso " vec (concat "ls --time-style=long-iso "
@ -548,7 +548,7 @@ But handle the case, if the \"test\" command is not available."
(or (eq mustbenew 'excl) (or (eq mustbenew 'excl)
(not (not
(y-or-n-p (y-or-n-p
(format "File %s exists; overwrite anyway? " filename))))) (format "File %s exists; overwrite anyway?" filename)))))
(tramp-error v 'file-already-exists filename)) (tramp-error v 'file-already-exists filename))
(let ((file-locked (eq (file-locked-p lockname) t)) (let ((file-locked (eq (file-locked-p lockname) t))

View file

@ -190,7 +190,7 @@ It must be supported by libarchive(3).")
;; In older Emacsen (prior 27.1), `tramp-archive-autoload-file-name-regexp' ;; In older Emacsen (prior 27.1), `tramp-archive-autoload-file-name-regexp'
;; is not autoloaded. So we cannot expect it to be known in ;; is not autoloaded. So we cannot expect it to be known in
;; tramp-loaddefs.el. But it exists, when tramp-archive.el is loaded. ;; tramp-loaddefs.el. But it exists, when tramp-archive.el is loaded.
;;;###tramp-autoload ;;;###tramp-autoload
(defconst tramp-archive-file-name-regexp (defconst tramp-archive-file-name-regexp
(ignore-errors (tramp-archive-autoload-file-name-regexp)) (ignore-errors (tramp-archive-autoload-file-name-regexp))

View file

@ -312,7 +312,7 @@ The remote connection identified by SOURCE is flushed by
(if (null connections) (if (null connections)
(tramp-user-error nil "There are no remote connections.") (tramp-user-error nil "There are no remote connections.")
(setq source (setq source
;; Likely, the source remote connection is broken. So we ;; Likely, the source remote connection is broken. So we
;; shall avoid any action on it. ;; shall avoid any action on it.
(let (non-essential) (let (non-essential)
(completing-read-default (completing-read-default
@ -717,7 +717,7 @@ the debug buffer(s).")
(setq buffer-read-only t) (setq buffer-read-only t)
(goto-char (point-min)) (goto-char (point-min))
(when (y-or-n-p "Do you want to append the buffer(s)? ") (when (y-or-n-p "Do you want to append the buffer(s)?")
;; OK, let's send. First we delete the buffer list. ;; OK, let's send. First we delete the buffer list.
(kill-buffer nil) (kill-buffer nil)
(switch-to-buffer curbuf) (switch-to-buffer curbuf)

View file

@ -517,7 +517,7 @@ kept in their encrypted form."
tramp-crypt-encfs-config tramp-crypt-encfs-config
(directory-files name nil directory-files-no-dot-files-regexp)) (directory-files name nil directory-files-no-dot-files-regexp))
(yes-or-no-p (yes-or-no-p
"There exist encrypted files, do you want to continue? ")) "There exist encrypted files, do you want to continue?"))
(setq tramp-crypt-directories (delete name tramp-crypt-directories)) (setq tramp-crypt-directories (delete name tramp-crypt-directories))
(tramp-register-file-name-handlers))) (tramp-register-file-name-handlers)))

View file

@ -120,15 +120,15 @@ pass to the OPERATION."
(nth 2 tramp-file-name-structure) (nth 2 tramp-file-name-structure)
(nth 4 tramp-file-name-structure))) (nth 4 tramp-file-name-structure)))
;; ange-ftp uses `ange-ftp-ftp-name-arg' and `ange-ftp-ftp-name-res' ;; ange-ftp uses `ange-ftp-ftp-name-arg' and `ange-ftp-ftp-name-res'
;; for optimization in `ange-ftp-ftp-name'. If Tramp wasn't active, ;; for optimization in `ange-ftp-ftp-name'. If Tramp wasn't active,
;; there could be incorrect values from previous calls in case the ;; there could be incorrect values from previous calls in case the
;; "ftp" method is used in the Tramp file name. So we unset ;; "ftp" method is used in the Tramp file name. So we unset
;; those values. ;; those values.
(ange-ftp-ftp-name-arg "") (ange-ftp-ftp-name-arg "")
(ange-ftp-ftp-name-res nil)) (ange-ftp-ftp-name-res nil))
(cond (cond
;; If argument is a symlink, `file-directory-p' and ;; If argument is a symlink, `file-directory-p' and
;; `file-exists-p' call the traversed file recursively. So we ;; `file-exists-p' call the traversed file recursively. So we
;; cannot disable the file-name-handler this case. We set the ;; cannot disable the file-name-handler this case. We set the
;; connection property "started" in order to put the remote ;; connection property "started" in order to put the remote
;; location into the cache, which is helpful for further ;; location into the cache, which is helpful for further

View file

@ -1815,10 +1815,8 @@ a downcased host name only."
(message "%s" message) (message "%s" message)
(pop-to-buffer (current-buffer))) (pop-to-buffer (current-buffer)))
(if (yes-or-no-p (if (yes-or-no-p
(concat (buffer-substring
(buffer-substring (line-beginning-position) (point)))
(line-beginning-position) (point))
" "))
0 1))))) 0 1)))))
;; When QUIT is raised, we shall return this ;; When QUIT is raised, we shall return this
@ -1840,7 +1838,7 @@ a downcased host name only."
(ignore-errors (ignore-errors
(let ((signal-name (dbus-event-member-name last-input-event)) (let ((signal-name (dbus-event-member-name last-input-event))
(elt mount-info)) (elt mount-info))
;; Jump over the first elements of the mount info. Since there ;; Jump over the first elements of the mount info. Since there
;; were changes in the entries, we cannot access dedicated ;; were changes in the entries, we cannot access dedicated
;; elements. ;; elements.
(while (stringp (car elt)) (setq elt (cdr elt))) (while (stringp (car elt)) (setq elt (cdr elt)))
@ -1936,7 +1934,7 @@ a downcased host name only."
:session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker
tramp-gvfs-interface-mounttracker tramp-gvfs-listmounts)) tramp-gvfs-interface-mounttracker tramp-gvfs-listmounts))
nil) nil)
;; Jump over the first elements of the mount info. Since there ;; Jump over the first elements of the mount info. Since there
;; were changes in the entries, we cannot access dedicated ;; were changes in the entries, we cannot access dedicated
;; elements. ;; elements.
(while (stringp (car elt)) (setq elt (cdr elt))) (while (stringp (car elt)) (setq elt (cdr elt)))

View file

@ -244,14 +244,14 @@ The string is used in `tramp-methods'.")
(add-to-list 'tramp-methods (add-to-list 'tramp-methods
`("telnet" `("telnet"
(tramp-login-program "telnet") (tramp-login-program "telnet")
(tramp-login-args (("%h") ("%p"))) (tramp-login-args (("%h") ("%p") ("%n")))
(tramp-remote-shell ,tramp-default-remote-shell) (tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-login ("-l")) (tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c")))) (tramp-remote-shell-args ("-c"))))
(add-to-list 'tramp-methods (add-to-list 'tramp-methods
`("nc" `("nc"
(tramp-login-program "telnet") (tramp-login-program "telnet")
(tramp-login-args (("%h") ("%p"))) (tramp-login-args (("%h") ("%p") ("%n")))
(tramp-remote-shell ,tramp-default-remote-shell) (tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-login ("-l")) (tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c")) (tramp-remote-shell-args ("-c"))
@ -1064,7 +1064,7 @@ component is used as the target of the symlink."
(not (not
(yes-or-no-p (yes-or-no-p
(format (format
"File %s already exists; make it a link anyway? " "File %s already exists; make it a link anyway?"
localname))))) localname)))))
(tramp-error v 'file-already-exists localname) (tramp-error v 'file-already-exists localname)
(delete-file linkname))) (delete-file linkname)))
@ -1073,7 +1073,7 @@ component is used as the target of the symlink."
;; Right, they are on the same host, regardless of user, ;; Right, they are on the same host, regardless of user,
;; method, etc. We now make the link on the remote ;; method, etc. We now make the link on the remote
;; machine. This will occur as the user that TARGET belongs to. ;; machine. This will occur as the user that TARGET belongs to.
(and (tramp-send-command-and-check (and (tramp-send-command-and-check
v (format "cd %s" (tramp-shell-quote-argument cwd))) v (format "cd %s" (tramp-shell-quote-argument cwd)))
(tramp-send-command-and-check (tramp-send-command-and-check
@ -1825,7 +1825,7 @@ ID-FORMAT valid values are `string' and `integer'."
(and (numberp ok-if-already-exists) (and (numberp ok-if-already-exists)
(not (yes-or-no-p (not (yes-or-no-p
(format (format
"File %s already exists; make it a link anyway? " "File %s already exists; make it a link anyway?"
v2-localname))))) v2-localname)))))
(tramp-error v2 'file-already-exists newname) (tramp-error v2 'file-already-exists newname)
(delete-file newname))) (delete-file newname)))
@ -2231,7 +2231,7 @@ the uid and gid from FILENAME."
;; Save exit. ;; Save exit.
(ignore-errors (delete-file tmpfile))))))))) (ignore-errors (delete-file tmpfile)))))))))
;; Set the time and mode. Mask possible errors. ;; Set the time and mode. Mask possible errors.
(ignore-errors (ignore-errors
(when keep-date (when keep-date
(tramp-compat-set-file-times (tramp-compat-set-file-times
@ -2748,7 +2748,7 @@ the result will be a local, non-Tramp, file name."
;;; Remote commands: ;;; Remote commands:
;; We use BUFFER also as connection buffer during setup. Because of ;; We use BUFFER also as connection buffer during setup. Because of
;; this, its original contents must be saved, and restored once ;; this, its original contents must be saved, and restored once
;; connection has been setup. ;; connection has been setup.
(defun tramp-sh-handle-make-process (&rest args) (defun tramp-sh-handle-make-process (&rest args)
@ -3269,7 +3269,7 @@ implementation will be used."
(or (eq mustbenew 'excl) (or (eq mustbenew 'excl)
(not (not
(y-or-n-p (y-or-n-p
(format "File %s exists; overwrite anyway? " filename))))) (format "File %s exists; overwrite anyway?" filename)))))
(tramp-error v 'file-already-exists filename)) (tramp-error v 'file-already-exists filename))
(let ((file-locked (eq (file-locked-p lockname) t)) (let ((file-locked (eq (file-locked-p lockname) t))
@ -4000,7 +4000,7 @@ Returns the absolute file name of PROGNAME, if found, and nil otherwise.
This function expects to be in the right *tramp* buffer." This function expects to be in the right *tramp* buffer."
(with-current-buffer (tramp-get-connection-buffer vec) (with-current-buffer (tramp-get-connection-buffer vec)
(let (result) (let (result)
;; Check whether the executable is in $PATH. "which(1)" does not ;; Check whether the executable is in $PATH. "which(1)" does not
;; report always a correct error code; therefore we check the ;; report always a correct error code; therefore we check the
;; number of words it returns. "SunOS 5.10" (and maybe "SunOS ;; number of words it returns. "SunOS 5.10" (and maybe "SunOS
;; 5.11") have problems with this command, we disable the call ;; 5.11") have problems with this command, we disable the call
@ -4904,6 +4904,8 @@ connection if a previous connection has died for some reason."
(tramp-error vec 'file-error "`tramp-encoding-shell' not set")) (tramp-error vec 'file-error "`tramp-encoding-shell' not set"))
(let* ((current-host tramp-system-name) (let* ((current-host tramp-system-name)
(target-alist (tramp-compute-multi-hops vec)) (target-alist (tramp-compute-multi-hops vec))
;; Needed for `tramp-get-remote-null-device'.
(previous-hop nil)
;; We will apply `tramp-ssh-controlmaster-options' ;; We will apply `tramp-ssh-controlmaster-options'
;; only for the first hop. ;; only for the first hop.
(options (tramp-ssh-controlmaster-options vec)) (options (tramp-ssh-controlmaster-options vec))
@ -5016,6 +5018,8 @@ connection if a previous connection has died for some reason."
hop 'tramp-login-args hop 'tramp-login-args
?h (or l-host "") ?u (or l-user "") ?p (or l-port "") ?h (or l-host "") ?u (or l-user "") ?p (or l-port "")
?c (format-spec options (format-spec-make ?t tmpfile)) ?c (format-spec options (format-spec-make ?t tmpfile))
?n (concat
"2>" (tramp-get-remote-null-device previous-hop))
?l (concat remote-shell " " extra-args " -i")) ?l (concat remote-shell " " extra-args " -i"))
;; A restricted shell does not allow "exec". ;; A restricted shell does not allow "exec".
(when r-shell '("&&" "exit" "||" "exit"))) (when r-shell '("&&" "exit" "||" "exit")))
@ -5031,10 +5035,12 @@ connection if a previous connection has died for some reason."
tramp-actions-before-shell tramp-actions-before-shell
(or connection-timeout tramp-connection-timeout)) (or connection-timeout tramp-connection-timeout))
(tramp-message (tramp-message
vec 3 "Found remote shell prompt on `%s'" l-host)) vec 3 "Found remote shell prompt on `%s'" l-host)
;; Next hop.
(setq options "" ;; Next hop.
target-alist (cdr target-alist))) (setq options ""
target-alist (cdr target-alist)
previous-hop hop)))
;; Activate session timeout. ;; Activate session timeout.
(when (tramp-get-connection-property p "session-timeout" nil) (when (tramp-get-connection-property p "session-timeout" nil)

View file

@ -48,7 +48,7 @@
;; Another guess. We might implement a better check later on. ;; Another guess. We might implement a better check later on.
(tramp-case-insensitive t))))) (tramp-case-insensitive t)))))
;; Add a default for `tramp-default-user-alist'. Rule: For the SMB method, ;; Add a default for `tramp-default-user-alist'. Rule: For the SMB method,
;; the anonymous user is chosen. ;; the anonymous user is chosen.
;;;###tramp-autoload ;;;###tramp-autoload
(tramp--with-startup (tramp--with-startup
@ -83,7 +83,7 @@ call, letting the SMB client use the default one."
They are added to the `tramp-smb-program' call via \"--option '...'\". They are added to the `tramp-smb-program' call via \"--option '...'\".
For example, if the deprecated SMB1 protocol shall be used, add to For example, if the deprecated SMB1 protocol shall be used, add to
this variable (\"client min protocol=NT1\") ." this variable \"client min protocol=NT1\"."
:group 'tramp :group 'tramp
:type '(repeat string) :type '(repeat string)
:version "28.1") :version "28.1")
@ -376,7 +376,7 @@ arguments to pass to the OPERATION."
(and (numberp ok-if-already-exists) (and (numberp ok-if-already-exists)
(not (yes-or-no-p (not (yes-or-no-p
(format (format
"File %s already exists; make it a link anyway? " "File %s already exists; make it a link anyway?"
v2-localname))))) v2-localname)))))
(tramp-error v2 'file-already-exists newname) (tramp-error v2 'file-already-exists newname)
(delete-file newname))) (delete-file newname)))
@ -1247,7 +1247,7 @@ component is used as the target of the symlink."
(and (numberp ok-if-already-exists) (and (numberp ok-if-already-exists)
(not (yes-or-no-p (not (yes-or-no-p
(format (format
"File %s already exists; make it a link anyway? " "File %s already exists; make it a link anyway?"
localname))))) localname)))))
(tramp-error v 'file-already-exists localname) (tramp-error v 'file-already-exists localname)
(delete-file linkname))) (delete-file linkname)))
@ -1526,7 +1526,7 @@ component is used as the target of the symlink."
(tramp-error (tramp-error
v 'file-error "Error while changing file's mode %s" filename)))))) v 'file-error "Error while changing file's mode %s" filename))))))
;; We use BUFFER also as connection buffer during setup. Because of ;; We use BUFFER also as connection buffer during setup. Because of
;; this, its original contents must be saved, and restored once ;; this, its original contents must be saved, and restored once
;; connection has been setup. ;; connection has been setup.
(defun tramp-smb-handle-start-file-process (name buffer program &rest args) (defun tramp-smb-handle-start-file-process (name buffer program &rest args)
@ -1603,7 +1603,7 @@ errors for shares like \"C$/\", which are common in Microsoft Windows."
(or (eq mustbenew 'excl) (or (eq mustbenew 'excl)
(not (not
(y-or-n-p (y-or-n-p
(format "File %s exists; overwrite anyway? " filename))))) (format "File %s exists; overwrite anyway?" filename)))))
(tramp-error v 'file-already-exists filename)) (tramp-error v 'file-already-exists filename))
(let ((file-locked (eq (file-locked-p lockname) t)) (let ((file-locked (eq (file-locked-p lockname) t))
@ -1703,7 +1703,7 @@ If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"."
localname))) localname)))
;; Share names of a host are cached. It is very unlikely that the ;; Share names of a host are cached. It is very unlikely that the
;; shares do change during connection. ;; shares do change during connection.
(defun tramp-smb-get-file-entries (directory) (defun tramp-smb-get-file-entries (directory)
"Read entries which match DIRECTORY. "Read entries which match DIRECTORY.
@ -2200,5 +2200,7 @@ Removes smb prompt. Returns nil if an error message has appeared."
;; ;;
;; * Try to remove the inclusion of dummy "" directory. Seems to be at ;; * Try to remove the inclusion of dummy "" directory. Seems to be at
;; several places, especially in `tramp-smb-handle-insert-directory'. ;; several places, especially in `tramp-smb-handle-insert-directory'.
;;
;; * Keep a separate connection process per share.
;;; tramp-smb.el ends here ;;; tramp-smb.el ends here

View file

@ -292,7 +292,7 @@ arguments to pass to the OPERATION."
(or (eq mustbenew 'excl) (or (eq mustbenew 'excl)
(not (not
(y-or-n-p (y-or-n-p
(format "File %s exists; overwrite anyway? " filename))))) (format "File %s exists; overwrite anyway?" filename)))))
(tramp-error v 'file-already-exists filename)) (tramp-error v 'file-already-exists filename))
(let ((file-locked (eq (file-locked-p lockname) t))) (let ((file-locked (eq (file-locked-p lockname) t)))

View file

@ -190,7 +190,7 @@ arguments to pass to the OPERATION."
(and (numberp ok-if-already-exists) (and (numberp ok-if-already-exists)
(not (yes-or-no-p (not (yes-or-no-p
(format (format
"File %s already exists; make it a link anyway? " "File %s already exists; make it a link anyway?"
v2-localname))))) v2-localname)))))
(tramp-error v2 'file-already-exists newname) (tramp-error v2 'file-already-exists newname)
(delete-file newname))) (delete-file newname)))
@ -632,7 +632,7 @@ component is used as the target of the symlink."
(not (not
(yes-or-no-p (yes-or-no-p
(format (format
"File %s already exists; make it a link anyway? " "File %s already exists; make it a link anyway?"
localname))))) localname)))))
(tramp-error v 'file-already-exists localname) (tramp-error v 'file-already-exists localname)
(delete-file linkname))) (delete-file linkname)))

View file

@ -861,7 +861,7 @@ Used in `tramp-make-tramp-file-name'.")
(defvar tramp-prefix-regexp nil ;Initialized when defining `tramp-syntax'! (defvar tramp-prefix-regexp nil ;Initialized when defining `tramp-syntax'!
"Regexp matching the very beginning of Tramp file names. "Regexp matching the very beginning of Tramp file names.
Should always start with \"^\". Derived from `tramp-prefix-format'.") Should always start with \"^\". Derived from `tramp-prefix-format'.")
(defconst tramp-method-regexp-alist (defconst tramp-method-regexp-alist
'((default . "[[:alnum:]-]+") '((default . "[[:alnum:]-]+")
@ -2379,7 +2379,7 @@ For definition of that list see `tramp-set-completion-function'."
;; Inodes don't exist for some file systems. Therefore we must ;; Inodes don't exist for some file systems. Therefore we must
;; generate virtual ones. Used in `find-buffer-visiting'. The method ;; generate virtual ones. Used in `find-buffer-visiting'. The method
;; applied might be not so efficient (Ange-FTP uses hashes). But ;; applied might be not so efficient (Ange-FTP uses hashes). But
;; performance isn't the major issue given that file transfer will ;; performance isn't the major issue given that file transfer will
;; take time. ;; take time.
(defvar tramp-inodes 0 (defvar tramp-inodes 0
@ -2908,7 +2908,7 @@ not in completion mode."
;; I misuse a little bit the `tramp-file-name' structure in order to ;; I misuse a little bit the `tramp-file-name' structure in order to
;; handle completion possibilities for partial methods / user names / ;; handle completion possibilities for partial methods / user names /
;; host names. Return value is a list of `tramp-file-name' structures ;; host names. Return value is a list of `tramp-file-name' structures
;; according to possible completions. If "localname" is non-nil it ;; according to possible completions. If "localname" is non-nil it
;; means there shouldn't be a completion anymore. ;; means there shouldn't be a completion anymore.
;; Expected results: ;; Expected results:
@ -3288,7 +3288,7 @@ User is always nil."
(and (numberp ok-if-already-exists) (and (numberp ok-if-already-exists)
(not (yes-or-no-p (not (yes-or-no-p
(format (format
"File %s already exists; make it a link anyway? " "File %s already exists; make it a link anyway?"
localname))))) localname)))))
(tramp-error v 'file-already-exists newname) (tramp-error v 'file-already-exists newname)
(delete-file newname))) (delete-file newname)))
@ -3463,7 +3463,7 @@ User is always nil."
(or ;; Maybe there is a default value. (or ;; Maybe there is a default value.
(tramp-get-method-parameter v 'tramp-case-insensitive) (tramp-get-method-parameter v 'tramp-case-insensitive)
;; There isn't. So we must check, in case there's a connection already. ;; There isn't. So we must check, in case there's a connection already.
(and (file-remote-p filename nil 'connected) (and (file-remote-p filename nil 'connected)
(with-tramp-connection-property v "case-insensitive" (with-tramp-connection-property v "case-insensitive"
(ignore-errors (ignore-errors
@ -3694,7 +3694,7 @@ User is always nil."
(yes-or-no-p (yes-or-no-p
(concat (concat
"Backup file on local temporary directory, " "Backup file on local temporary directory, "
"do you want to continue? "))))) "do you want to continue?")))))
(tramp-error v 'file-error "Unsafe backup file name")))))) (tramp-error v 'file-error "Unsafe backup file name"))))))
(defun tramp-handle-insert-directory (defun tramp-handle-insert-directory
@ -3915,7 +3915,7 @@ Return nil when there is no lockfile."
(yes-or-no-p (yes-or-no-p
(concat (concat
"Lock file on local temporary directory, " "Lock file on local temporary directory, "
"do you want to continue? "))))) "do you want to continue?")))))
(tramp-error v 'file-error "Unsafe lock file name"))) (tramp-error v 'file-error "Unsafe lock file name")))
;; Do the lock. ;; Do the lock.
@ -4274,13 +4274,13 @@ support symbolic links."
((eq async-shell-command-buffer 'confirm-kill-process) ((eq async-shell-command-buffer 'confirm-kill-process)
;; If will kill a process, query first. ;; If will kill a process, query first.
(if (yes-or-no-p (if (yes-or-no-p
"A command is running in the default buffer. Kill it? ") "A command is running in the default buffer. Kill it?")
(kill-process p) (kill-process p)
(tramp-user-error p "Shell command in progress"))) (tramp-user-error p "Shell command in progress")))
((eq async-shell-command-buffer 'confirm-new-buffer) ((eq async-shell-command-buffer 'confirm-new-buffer)
;; If will create a new buffer, query first. ;; If will create a new buffer, query first.
(if (yes-or-no-p (if (yes-or-no-p
"A command is running in the default buffer. Use a new buffer? ") "A command is running in the default buffer. Use a new buffer?")
(setq output-buffer (generate-new-buffer bname)) (setq output-buffer (generate-new-buffer bname))
(tramp-user-error p "Shell command in progress"))) (tramp-user-error p "Shell command in progress")))
((eq async-shell-command-buffer 'new-buffer) ((eq async-shell-command-buffer 'new-buffer)
@ -4289,7 +4289,7 @@ support symbolic links."
((eq async-shell-command-buffer 'confirm-rename-buffer) ((eq async-shell-command-buffer 'confirm-rename-buffer)
;; If will rename the buffer, query first. ;; If will rename the buffer, query first.
(if (yes-or-no-p (if (yes-or-no-p
"A command is running in the default buffer. Rename it? ") "A command is running in the default buffer. Rename it?")
(progn (progn
(with-current-buffer output-buffer (with-current-buffer output-buffer
(rename-uniquely)) (rename-uniquely))
@ -4492,7 +4492,7 @@ of."
(or (eq mustbenew 'excl) (or (eq mustbenew 'excl)
(not (not
(y-or-n-p (y-or-n-p
(format "File %s exists; overwrite anyway? " filename))))) (format "File %s exists; overwrite anyway?" filename)))))
(tramp-error v 'file-already-exists filename)) (tramp-error v 'file-already-exists filename))
(let ((file-locked (eq (file-locked-p lockname) t)) (let ((file-locked (eq (file-locked-p lockname) t))
@ -5468,7 +5468,7 @@ this file, if that variable is non-nil."
(yes-or-no-p (yes-or-no-p
(concat (concat
"Autosave file on local temporary directory, " "Autosave file on local temporary directory, "
"do you want to continue? "))))) "do you want to continue?")))))
(tramp-error v 'file-error "Unsafe autosave file name")))))) (tramp-error v 'file-error "Unsafe autosave file name"))))))
(defun tramp-subst-strs-in-string (alist string) (defun tramp-subst-strs-in-string (alist string)

View file

@ -29,7 +29,7 @@
;;; Commentary: ;;; Commentary:
;; Convenience functions around the Tramp version. Partly generated ;; Convenience functions around the Tramp version. Partly generated
;; during Tramp configuration. ;; during Tramp configuration.
;;; Code: ;;; Code:

View file

@ -2083,7 +2083,7 @@ Also see `ignore'."
"/method:host:/:/path//foo")) "/method:host:/:/path//foo"))
;; Forwhatever reasons, the following tests let Emacs crash for ;; Forwhatever reasons, the following tests let Emacs crash for
;; Emacs 25, occasionally. No idea what's up. ;; Emacs 25, occasionally. No idea what's up.
(when (tramp--test-emacs26-p) (when (tramp--test-emacs26-p)
(should (should
(string-equal (string-equal
@ -4464,7 +4464,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(should (string-equal (format "%s\n" fnnd) (buffer-string))) (should (string-equal (format "%s\n" fnnd) (buffer-string)))
(should-not (get-buffer-window (current-buffer) t)) (should-not (get-buffer-window (current-buffer) t))
;; Second run. The output must be appended. ;; Second run. The output must be appended.
(goto-char (point-max)) (goto-char (point-max))
(should (zerop (process-file "ls" nil t t fnnd))) (should (zerop (process-file "ls" nil t t fnnd)))
;; `ls' could produce colorized output. ;; `ls' could produce colorized output.
@ -4588,8 +4588,10 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(should (should
(string-match-p (string-match-p
(if (memq process-connection-type '(nil pipe)) (if (memq process-connection-type '(nil pipe))
"66\n6F\n6F\n0D\n0A\n" ;; `telnet' converts \r to <CR><NUL> if `crlf'
"66\n6F\n6F\n0A\n0A\n") ;; flag is FALSE. See telnet(1) man page.
"66\n6F\n6F\n0D\\(\n00\\)?\n0A\n"
"66\n6F\n6F\n0A\\(\n00\\)?\n0A\n")
(buffer-string)))) (buffer-string))))
;; Cleanup. ;; Cleanup.
@ -4754,8 +4756,9 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
;; Cleanup. ;; Cleanup.
(ignore-errors (delete-process proc))) (ignore-errors (delete-process proc)))
;; Process with stderr buffer. ;; Process with stderr buffer. `telnet' does not cooperate with
(unless (tramp-direct-async-process-p) ;; three processes.
(unless (or (tramp--test-telnet-p) (tramp-direct-async-process-p))
(let ((stderr (generate-new-buffer "*stderr*"))) (let ((stderr (generate-new-buffer "*stderr*")))
(unwind-protect (unwind-protect
(with-temp-buffer (with-temp-buffer
@ -4851,8 +4854,10 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(string-match-p (string-match-p
(if (memq (or connection-type process-connection-type) (if (memq (or connection-type process-connection-type)
'(nil pipe)) '(nil pipe))
"66\n6F\n6F\n0D\n0A\n" ;; `telnet' converts \r to <CR><NUL> if `crlf'
"66\n6F\n6F\n0A\n0A\n") ;; flag is FALSE. See telnet(1) man page.
"66\n6F\n6F\n0D\\(\n00\\)?\n0A\n"
"66\n6F\n6F\n0A\\(\n00\\)?\n0A\n")
(buffer-string)))) (buffer-string))))
;; Cleanup. ;; Cleanup.
@ -5498,9 +5503,9 @@ Use direct async.")
;; Ignore trailing newline. ;; Ignore trailing newline.
(setq path (substring (shell-command-to-string "echo $PATH") nil -1)) (setq path (substring (shell-command-to-string "echo $PATH") nil -1))
;; The shell doesn't handle such long strings. ;; The shell doesn't handle such long strings.
(unless (<= (length path) (when (<= (length path)
(tramp-get-connection-property (tramp-get-connection-property
tramp-test-vec "pipe-buf" 4096)) tramp-test-vec "pipe-buf" 4096))
;; The last element of `exec-path' is `exec-directory'. ;; The last element of `exec-path' is `exec-directory'.
(should (should
(string-equal (string-equal
@ -6154,6 +6159,12 @@ This requires restrictions of file name syntax."
"Check, whether the sudoedit method is used." "Check, whether the sudoedit method is used."
(tramp-sudoedit-file-name-p tramp-test-temporary-file-directory)) (tramp-sudoedit-file-name-p tramp-test-temporary-file-directory))
(defun tramp--test-telnet-p ()
"Check, whether the telnet method is used.
This does not support special file names."
(string-equal
"telnet" (file-remote-p tramp-test-temporary-file-directory 'method)))
(defun tramp--test-windows-nt-p () (defun tramp--test-windows-nt-p ()
"Check, whether the locale host runs MS Windows." "Check, whether the locale host runs MS Windows."
(eq system-type 'windows-nt)) (eq system-type 'windows-nt))
@ -6712,6 +6723,7 @@ process sentinels. They shall not disturb each other."
(tramp--test-sh-p))) (tramp--test-sh-p)))
(skip-unless (not (tramp--test-crypt-p))) (skip-unless (not (tramp--test-crypt-p)))
(skip-unless (not (tramp--test-docker-p))) (skip-unless (not (tramp--test-docker-p)))
(skip-unless (not (tramp--test-telnet-p)))
(skip-unless (not (tramp--test-windows-nt-p))) (skip-unless (not (tramp--test-windows-nt-p)))
(with-timeout (with-timeout