;; buffer local variable, which is computed depending on remote host properties
;; when `tramp-chunksize' is zero or nil.
(defcustom tramp-chunksize (when (memq system-type '(hpux)) 500)
+;; Parentheses in docstring starting at beginning of line are escaped.
+;; Fontification is messed up when
+;; `open-paren-in-column-0-is-defun-start' set to t.
"If non-nil, chunksize for sending input to local process.
It is necessary only on systems which have a buggy `process-send-string'
implementation. The necessity, whether this variable must be set, can be
;; We use the cached property.
(tramp-get-connection-property vec hash-entry)
;; Use the static value from `tramp-methods'.
- (if-let ((methods-entry
- (assoc
- param (assoc (tramp-file-name-method vec) tramp-methods))))
+ (if-let* ((methods-entry
+ (assoc
+ param (assoc (tramp-file-name-method vec) tramp-methods))))
(cadr methods-entry)
;; Return the default value.
default))))
:port port :localname localname :hop hop))
;; The method must be known.
(unless (or nodefault non-essential
- (assoc method tramp-methods)
- (when-let ((params-fun
- (intern-soft
- (format "tramp-%s-method-params" method)))
- ((functionp params-fun))
- (params (funcall params-fun)))
- (push (cons method params) tramp-methods)))
+ (assoc method tramp-methods))
(tramp-user-error
v "Method `%s' is not known" method))
;; Only some methods from tramp-sh.el do support multi-hops.
(declare (indent 2) (debug (symbolp form body)))
(let ((err (make-symbol "err")))
`(condition-case ,err
- (progn ,@body)
+ (let (signal-hook-function) ,@body)
(error
(if (not (or (file-exists-p ,filename) (file-symlink-p ,filename)))
- (tramp-error ,vec 'file-missing ,filename)
+ (when (tramp-connectable-p ,vec)
+ (tramp-error ,vec 'file-missing ,filename))
(signal (car ,err) (cdr ,err)))))))
;; This function provides traces in case of errors not triggered by
;; We start a pulsing progress reporter after 3 seconds.
;; Start only when there is no other progress reporter
;; running, and when there is a minimum level.
- (when-let ((pr (and (null tramp-inhibit-progress-reporter)
- (<= ,level (min tramp-verbose 3))
- (make-progress-reporter ,message))))
+ (when-let* ((pr (and (null tramp-inhibit-progress-reporter)
+ (<= ,level (min tramp-verbose 3))
+ (make-progress-reporter ,message))))
(run-at-time 3 0.1 #'tramp-progress-reporter-update pr))))
(unwind-protect
;; Execute the body.
(let ((seconds (car list))
(timeout-forms (cdr list)))
;; If non-nil, `seconds' must be a positive number.
- `(if-let (((natnump ,seconds))
- ((not (zerop timeout))))
+ `(if-let* (((natnump ,seconds))
+ ((not (zerop timeout))))
(with-timeout (,seconds ,@timeout-forms) ,@body)
,@body)))
'(add-name-to-file copy-directory copy-file
file-equal-p file-in-directory-p
file-name-all-completions file-name-completion
- file-name-completion-annotation
file-newer-than-file-p rename-file))
(cond
((tramp-tramp-file-p (nth 0 args)) (nth 0 args))
(tramp-message
v 5 "Non-essential received in operation %s"
(cons operation args))
- (let ((tramp-verbose 10)) (tramp-backtrace v))
+ (tramp-backtrace v)
(tramp-run-real-handler operation args))
((eq result 'suppress)
(let ((inhibit-message t))
(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."
- (if-let
+ (if-let*
((fn (and tramp-mode minibuffer-completing-file-name
(assoc operation tramp-completion-file-name-handler-alist))))
(save-match-data (apply (cdr fn) args))
;; 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))
- (when-let ((entry (rassoc fnh 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))))))
"Check if it is possible to connect the remote host without side-effects.
This is true, if either the remote host is already connected, or if we are
not in completion mode."
- (let ((tramp-verbose 0)
- (vec (tramp-ensure-dissected-file-name vec-or-filename)))
- (or ;; We check this for the process related to
- ;; `tramp-buffer-name'; otherwise `make-process' wouldn't run
- ;; ever when `non-essential' is non-nil.
- (process-live-p (tramp-get-process vec))
- (not non-essential))))
+ (or (not non-essential)
+ ;; We check this for the process related to `tramp-buffer-name';
+ ;; otherwise `make-process' wouldn't run ever when
+ ;; `non-essential' is non-nil.
+ (and-let* ((tramp-verbose 0)
+ (vec (tramp-ensure-dissected-file-name vec-or-filename))
+ (p (tramp-get-process vec))
+ ((process-live-p p))
+ ((tramp-get-connection-property p "connected"))))))
(defun tramp-completion-handle-expand-file-name (filename &optional directory)
"Like `expand-file-name' for partial Tramp files."
(dolist (elt '(".." "."))
(when (string-prefix-p ,filename elt)
(setq result (cons (concat elt "/") result)))))
- result)))))
+ (if (consp completion-regexp-list)
+ ;; Discriminate over `completion-regexp-list'.
+ (mapcar
+ (lambda (x)
+ (when (stringp x)
+ (catch 'match
+ (dolist (elt completion-regexp-list x)
+ (unless (string-match-p elt x) (throw 'match nil))))))
+ result)
+ result))))))
(defvar tramp--last-hop-directory nil
"Tracks the directory from which to run login programs.")
"Skeleton for `tramp-*-handle-directory-files'.
BODY is the backend specific code."
(declare (indent 5) (debug t))
- `(or
- (with-parsed-tramp-file-name (expand-file-name ,directory) nil
- (tramp-barf-if-file-missing v ,directory
- (when (file-directory-p ,directory)
- (setf ,directory
- (file-name-as-directory (expand-file-name ,directory)))
- (let ((temp
- (with-tramp-file-property v localname "directory-files" ,@body))
- result item)
- (while temp
- (setq item (directory-file-name (pop temp)))
- (when (or (null ,match) (string-match-p ,match item))
- (push (if ,full (concat ,directory item) item)
- result)))
- (unless ,nosort
- (setq result (sort result #'string<)))
- (when (and (natnump ,count) (> ,count 0))
- (setq result (tramp-compat-ntake ,count result)))
- result))))
-
- ;; Error handling.
- (if (not (file-exists-p ,directory))
- (tramp-error
- (tramp-dissect-file-name ,directory) 'file-missing ,directory)
- nil)))
+ `(with-parsed-tramp-file-name (expand-file-name ,directory) nil
+ (tramp-barf-if-file-missing v ,directory
+ (if (not (file-directory-p ,directory))
+ ;; Trigger the `file-missing' error.
+ (signal 'error nil)
+ (setf ,directory
+ (file-name-as-directory (expand-file-name ,directory)))
+ (let ((temp
+ (with-tramp-file-property v localname "directory-files" ,@body))
+ result item)
+ (while temp
+ (setq item (directory-file-name (pop temp)))
+ (when (or (null ,match) (string-match-p ,match item))
+ (push (if ,full (concat ,directory item) item)
+ result)))
+ (unless ,nosort
+ (setq result (sort result #'string<)))
+ (when (and (natnump ,count) (> ,count 0))
+ (setq result (tramp-compat-ntake ,count result)))
+ result)))))
(defmacro tramp-skeleton-directory-files-and-attributes
(directory &optional full match nosort id-format count &rest body)
"Skeleton for `tramp-*-handle-directory-files-and-attributes'.
BODY is the backend specific code."
(declare (indent 6) (debug t))
- `(or
- (with-parsed-tramp-file-name (expand-file-name ,directory) nil
- (tramp-barf-if-file-missing v ,directory
- (when (file-directory-p ,directory)
- (let ((temp
- (copy-tree
- (mapcar
- (lambda (x)
- (cons
- (car x)
- (tramp-convert-file-attributes
- v (expand-file-name (car x) localname)
- ,id-format (cdr x))))
- (with-tramp-file-property
- v localname "directory-files-and-attributes"
- ,@body))))
- result item)
-
- (while temp
- (setq item (pop temp))
- (when (or (null ,match) (string-match-p ,match (car item)))
- (when ,full
- (setcar item (expand-file-name (car item) ,directory)))
- (push item result)))
-
- (unless ,nosort
- (setq result
- (sort result (lambda (x y) (string< (car x) (car y))))))
-
- (when (and (natnump ,count) (> ,count 0))
- (setq result (tramp-compat-ntake ,count result)))
-
- (or result
- ;; The scripts could fail, for example with huge file size.
- (tramp-handle-directory-files-and-attributes
- ,directory ,full ,match ,nosort ,id-format ,count))))))
-
- ;; Error handling.
- (if (not (file-exists-p ,directory))
- (tramp-error
- (tramp-dissect-file-name ,directory) 'file-missing ,directory)
- nil)))
+ `(with-parsed-tramp-file-name (expand-file-name ,directory) nil
+ (tramp-barf-if-file-missing v ,directory
+ (if (not (file-directory-p ,directory))
+ ;; Trigger the `file-missing' error.
+ (signal 'error nil)
+ (let ((temp
+ (copy-tree
+ (mapcar
+ (lambda (x)
+ (cons
+ (car x)
+ (tramp-convert-file-attributes
+ v (expand-file-name (car x) localname)
+ ,id-format (cdr x))))
+ (with-tramp-file-property
+ v localname "directory-files-and-attributes"
+ ,@body))))
+ result item)
+
+ (while temp
+ (setq item (pop temp))
+ (when (or (null ,match) (string-match-p ,match (car item)))
+ (when ,full
+ (setcar item (expand-file-name (car item) ,directory)))
+ (push item result)))
+
+ (unless ,nosort
+ (setq result
+ (sort result (lambda (x y) (string< (car x) (car y))))))
+
+ (when (and (natnump ,count) (> ,count 0))
+ (setq result (tramp-compat-ntake ,count result)))
+
+ (or result
+ ;; The scripts could fail, for example with huge file size.
+ (tramp-handle-directory-files-and-attributes
+ ,directory ,full ,match ,nosort ,id-format ,count)))))))
(defcustom tramp-use-file-attributes t
"Whether to use \"file-attributes\" connection property for check.
BODY is the backend specific code."
(declare (indent 1) (debug t))
`(with-parsed-tramp-file-name (expand-file-name ,filename) nil
- (when (not (file-exists-p ,filename))
- (tramp-error v 'file-missing ,filename))
- (with-tramp-saved-file-properties
- v localname
- ;; We cannot add "file-attributes", "file-executable-p",
- ;; "file-ownership-preserved-p", "file-readable-p",
- ;; "file-writable-p".
- '("file-directory-p" "file-exists-p" "file-symlink-p" "file-truename")
- (tramp-flush-file-properties v localname))
- (condition-case err
- (progn ,@body)
- (error (if tramp-inhibit-errors-if-setting-file-attributes-fail
- (display-warning 'tramp (error-message-string err))
- (signal (car err) (cdr err)))))))
+ (tramp-barf-if-file-missing v ,filename
+ (if (not (file-exists-p ,filename))
+ ;; Trigger the `file-missing' error.
+ (signal 'error nil)
+ (with-tramp-saved-file-properties
+ v localname
+ ;; We cannot add "file-attributes", "file-executable-p",
+ ;; "file-ownership-preserved-p", "file-readable-p",
+ ;; "file-writable-p".
+ '("file-directory-p" "file-exists-p"
+ "file-symlink-p" "file-truename")
+ (tramp-flush-file-properties v localname))
+ (condition-case err
+ (progn ,@body)
+ (error (if tramp-inhibit-errors-if-setting-file-attributes-fail
+ (display-warning 'tramp (error-message-string err))
+ (signal (car err) (cdr err)))))))))
(defmacro tramp-skeleton-write-region
(start end filename append visit lockname mustbenew &rest body)
(let (last-coding-system-used (need-chown t))
;; Set file modification time.
(when (or (eq ,visit t) (stringp ,visit))
- (when-let ((file-attr (file-attributes filename 'integer)))
+ (when-let* ((file-attr (file-attributes filename 'integer)))
(set-visited-file-modtime
;; We must pass modtime explicitly, because FILENAME
;; can be different from (buffer-file-name), f.e. if
(tramp-dont-suspend-timers t))
(with-tramp-timeout
(timeout
- (unless (when-let ((p (tramp-get-connection-process v)))
- (and (process-live-p p)
- (tramp-get-connection-property p "connected")))
+ (unless (and (not non-essential) (tramp-connectable-p v))
(tramp-cleanup-connection v 'keep-debug 'keep-password))
(tramp-error
v 'file-error
(defun tramp-handle-file-modes (filename &optional flag)
"Like `file-modes' for Tramp files."
- (when-let ((attrs (file-attributes filename))
- (mode-string (file-attribute-modes attrs)))
+ (when-let* ((attrs (file-attributes filename))
+ (mode-string (file-attribute-modes attrs)))
(if (and (not (eq flag 'nofollow)) (eq ?l (aref mode-string 0)))
(file-modes (file-truename filename))
(tramp-mode-string-to-int mode-string))))
;; because `file-truename' could raise an error for cyclic
;; symlinks.
(ignore-errors
- (when-let ((attr (file-attributes filename)))
+ (when-let* ((attr (file-attributes filename)))
(cond
((eq ?- (aref (file-attribute-modes attr) 0)))
((eq ?l (aref (file-attribute-modes attr) 0))
(defun tramp-get-lock-file (file)
"Read lockfile info of FILE.
Return nil when there is no lockfile."
- (when-let ((lockname (make-lock-file-name file)))
+ (when-let* ((lockname (make-lock-file-name file)))
(or (file-symlink-p lockname)
(and (file-readable-p lockname)
(with-temp-buffer
(defun tramp-handle-file-locked-p (file)
"Like `file-locked-p' for Tramp files."
- (when-let ((info (tramp-get-lock-file file))
- (match (string-match tramp-lock-file-info-regexp info)))
+ (when-let* ((info (tramp-get-lock-file file))
+ (match (string-match tramp-lock-file-info-regexp info)))
(or ; Locked by me.
(and (string-equal (match-string 1 info) (user-login-name))
(string-equal (match-string 2 info) tramp-system-name)
;; for remote files.
(ask-user-about-supersession-threat file))
- (when-let ((info (tramp-get-lock-file file))
- (match (string-match tramp-lock-file-info-regexp info)))
+ (when-let* ((info (tramp-get-lock-file file))
+ (match (string-match tramp-lock-file-info-regexp info)))
(unless (ask-user-about-lock
file (format
"%s@%s (pid %s)" (match-string 1 info)
(match-string 2 info) (match-string 3 info)))
(throw 'dont-lock nil)))
- (when-let ((lockname (make-lock-file-name file))
- ;; USER@HOST.PID[:BOOT_TIME]
- (info
- (format
- "%s@%s.%s" (user-login-name) tramp-system-name
- (tramp-get-lock-pid file))))
+ (when-let* ((lockname (make-lock-file-name file))
+ ;; USER@HOST.PID[:BOOT_TIME]
+ (info
+ (format
+ "%s@%s.%s" (user-login-name) tramp-system-name
+ (tramp-get-lock-pid file))))
;; Protect against security hole.
(with-parsed-tramp-file-name file nil
;; When there is no connection, we don't do it. Otherwise,
;; functions like `kill-buffer' would try to reestablish the
;; connection. See Bug#61663.
- (if-let ((v (tramp-dissect-file-name file))
- ((process-live-p (tramp-get-process v)))
- (lockname (make-lock-file-name file)))
+ (if-let* ((v (tramp-dissect-file-name file))
+ ((tramp-connectable-p v))
+ ((process-live-p (tramp-get-process v)))
+ (lockname (make-lock-file-name file)))
(delete-file lockname)
;; Trigger the unlock error. Be quiet if user isn't
;; interested in lock files. See Bug#70900.
elt (default-toplevel-value 'process-environment))))
(setq env (cons elt env)))))
;; Add remote path if exists.
- (env (if-let ((sh-file-name-handler-p)
- (remote-path
- (string-join (tramp-get-remote-path v) ":")))
+ (env (if-let* ((sh-file-name-handler-p)
+ (remote-path
+ (string-join (tramp-get-remote-path v) ":")))
(setenv-internal env "PATH" remote-path 'keep)
env))
;; Add HISTFILE if indicated.
- (env (if-let ((sh-file-name-handler-p))
+ (env (if sh-file-name-handler-p
(cond
((stringp tramp-histfile-override)
(setenv-internal
(save-restriction
(with-tramp-progress-reporter
proc 3 "Waiting for prompts from remote shell"
- (let (exit)
+ (let ((enable-recursive-minibuffers t)
+ exit)
(with-tramp-timeout (timeout (setq exit 'timeout))
(while (not exit)
(setq exit (catch 'tramp-action
;; communication. This could block the output for the current
;; process. Read such output first. (Bug#61350)
;; The process property isn't set anymore due to Bug#62194.
- (when-let (((process-get proc 'tramp-shared-socket))
- (v (process-get proc 'tramp-vector)))
+ (when-let* (((process-get proc 'tramp-shared-socket))
+ (v (process-get proc 'tramp-vector)))
(dolist (p (delq proc (process-list)))
(when (tramp-file-name-equal-p v (process-get p 'tramp-vector))
(with-tramp-suspended-timers
must be non-negative integers.
The setgid bit of the upper directory is respected.
If FILENAME is remote, a file name handler is called."
- (let* ((dir (file-name-directory filename))
- (modes (file-modes dir)))
- (when (and modes (not (zerop (logand modes #o2000))))
- (setq gid (file-attribute-group-id (file-attributes dir)))))
+ (when-let* ((dir (file-name-directory filename))
+ (modes (file-modes dir))
+ ((not (zerop (logand modes #o2000)))))
+ (setq gid (file-attribute-group-id (file-attributes dir))))
(if (tramp-tramp-file-p filename)
(funcall (if (tramp-crypt-file-name-p filename)
(catch 'result
(let ((default-directory temporary-file-directory))
(dolist (pid (list-system-processes))
- (when-let ((attributes (process-attributes pid))
- (comm (cdr (assoc 'comm attributes))))
- (and (string-equal (cdr (assoc 'user attributes)) (user-login-name))
- ;; The returned command name could be truncated to 15
- ;; characters. Therefore, we cannot check for `string-equal'.
- (string-prefix-p comm process-name)
- (throw 'result t))))))))
+ (and-let* ((attributes (process-attributes pid))
+ (comm (cdr (assoc 'comm attributes)))
+ ((string-equal
+ (cdr (assoc 'user attributes)) (user-login-name)))
+ ;; The returned command name could be truncated
+ ;; to 15 characters. Therefore, we cannot check
+ ;; for `string-equal'.
+ ((string-prefix-p comm process-name))
+ ((throw 'result t)))))))))
;; When calling "emacs -Q", `auth-source-search' won't be called. If
;; you want to debug exactly this case, call "emacs -Q --eval '(setq
(require 'vc-git)
(require 'vc-hg)
+(declare-function project-mode-line-format "project")
(declare-function tramp-check-remote-uname "tramp-sh")
(declare-function tramp-find-executable "tramp-sh")
(declare-function tramp-get-remote-chmod-h "tramp-sh")
(defvar tramp-use-connection-share)
;; Declared in Emacs 30.1.
+(defvar project-mode-line)
(defvar remote-file-name-access-timeout)
(defvar remote-file-name-inhibit-delete-by-moving-to-trash)
;; Cleanup.
(tramp-cleanup-connection tramp-test-vec 'keep-debug))
+;; This test is inspired by Bug#78572.
+(ert-deftest tramp-test48-session-timeout ()
+ "Check that Tramp handles a session timeout properly."
+ (skip-unless (tramp--test-enabled))
+ (skip-unless
+ (tramp-get-method-parameter tramp-test-vec 'tramp-session-timeout))
+
+ ;; We want to see the timeout message.
+ (tramp--test-instrument-test-case 3
+ (let ((remote-file-name-inhibit-cache t)
+ (tmp-name (tramp--test-make-temp-name)))
+ (unwind-protect
+ (progn
+ (should-not (file-exists-p tmp-name))
+ (write-region "foo" nil tmp-name)
+ (should (file-exists-p tmp-name))
+
+ (tramp-timeout-session tramp-test-vec)
+ (should (file-exists-p tmp-name))
+ (should (directory-files (file-name-directory tmp-name)))
+
+ ;; `project-mode-line' was introduced in Emacs 30.1.
+ (when (boundp 'project-mode-line)
+ (require 'project)
+ (ert-with-message-capture captured-messages
+ (let ((project-mode-line t))
+ (with-temp-buffer
+ (set-visited-file-name tmp-name)
+ (insert "foo")
+ (should (buffer-modified-p))
+ (tramp-timeout-session tramp-test-vec)
+ ;; This calls `file-directory-p' and
+ ;; `directory-files'. Shouldn't raise an error when
+ ;; not connected.
+ (project-mode-line-format)
+ ;; Steal the file lock.
+ (cl-letf (((symbol-function #'ask-user-about-lock) #'always))
+ (save-buffer)))
+ (should-not
+ (string-match-p "File is missing:" captured-messages))))))
+
+ ;; Cleanup.
+ (ignore-errors (delete-file tmp-name))))))
+
;; This test is inspired by Bug#29163.
-(ert-deftest tramp-test48-auto-load ()
+(ert-deftest tramp-test49-auto-load ()
"Check that Tramp autoloads properly."
;; If we use another syntax but `default', Tramp is already loaded
;; due to the `tramp-change-syntax' call.
(mapconcat #'shell-quote-argument load-path " -L ")
(shell-quote-argument code)))))))
-(ert-deftest tramp-test48-delay-load ()
+(ert-deftest tramp-test49-delay-load ()
"Check that Tramp is loaded lazily, only when needed."
;; Tramp is neither loaded at Emacs startup, nor when completing a
;; non-Tramp file name like "/foo". Completing a Tramp-alike file
(mapconcat #'shell-quote-argument load-path " -L ")
(shell-quote-argument (format code tm)))))))))
-(ert-deftest tramp-test48-recursive-load ()
+(ert-deftest tramp-test49-recursive-load ()
"Check that Tramp does not fail due to recursive load."
(skip-unless (tramp--test-enabled))
(mapconcat #'shell-quote-argument load-path " -L ")
(shell-quote-argument code))))))))
-(ert-deftest tramp-test48-remote-load-path ()
+(ert-deftest tramp-test49-remote-load-path ()
"Check that Tramp autoloads its packages with remote `load-path'."
;; `tramp-cleanup-all-connections' is autoloaded from tramp-cmds.el.
;; It shall still work, when a remote file name is in the
(mapconcat #'shell-quote-argument load-path " -L ")
(shell-quote-argument code)))))))
-(ert-deftest tramp-test49-without-remote-files ()
+(ert-deftest tramp-test50-without-remote-files ()
"Check that Tramp can be suppressed."
(skip-unless (tramp--test-enabled))
(setq tramp-mode t)
(should (file-remote-p ert-remote-temporary-file-directory)))
-(ert-deftest tramp-test50-unload ()
+(ert-deftest tramp-test51-unload ()
"Check that Tramp and its subpackages unload completely.
Since it unloads Tramp, it shall be the last test to run."
:tags '(:expensive-test)
projects / emacs.git / commitdiff