From 1d0d6d9296414686ce17b8731fba66c56f904ee8 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 29 Aug 2016 18:39:07 +0200 Subject: [PATCH] Use `process-live-p' in Tramp * lisp/net/tramp-compat.el (tramp-compat-process-live-p): New defun. * lisp/net/tramp.el (tramp-connectable-p, tramp-handle-file-remote-p) (tramp-handle-file-notify-valid-p) (tramp-action-process-alive, tramp-action-out-of-band) (tramp-wait-for-regexp): * lisp/net/tramp-adb.el (tramp-adb-parse-device-names) (tramp-adb-maybe-open-connection): * lisp/net/tramp-cache.el (tramp-get-connection-property): * tramp-gvfs.el (tramp-gvfs-handle-file-notify-add-watch): * lisp/net/tramp-gw.el (tramp-gw-gw-proc-sentinel) (tramp-gw-aux-proc-sentinel, tramp-gw-open-connection): * tramp-sh.el (tramp-process-sentinel) (tramp-sh-handle-file-notify-add-watch) (tramp-maybe-open-connection): * lisp/net/lisp/net/lisp/net/tramp-smb.el (tramp-smb-action-with-tar) (tramp-smb-handle-copy-directory, tramp-smb-action-get-acl) (tramp-smb-handle-process-file, tramp-smb-action-set-acl) (tramp-smb-get-cifs-capabilities) (tramp-smb-get-stat-capability) (tramp-smb-maybe-open-connection, tramp-smb-wait-for-output) (tramp-smb-kill-winexe-function): Use it. --- lisp/net/tramp-adb.el | 7 +++---- lisp/net/tramp-cache.el | 2 +- lisp/net/tramp-compat.el | 13 +++++++++++++ lisp/net/tramp-gvfs.el | 2 +- lisp/net/tramp-gw.el | 7 +++---- lisp/net/tramp-sh.el | 12 ++++++------ lisp/net/tramp-smb.el | 35 ++++++++++++++++------------------- lisp/net/tramp.el | 25 ++++++++++++------------- 8 files changed, 55 insertions(+), 48 deletions(-) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 24b732255d4..48a05a7bf4f 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -202,7 +202,7 @@ pass to the OPERATION." result) (tramp-message v 6 "%s" (mapconcat 'identity (process-command p) " ")) (set-process-query-on-exit-flag p nil) - (while (eq 'run (process-status p)) + (while (tramp-compat-process-live-p p) (accept-process-output p 0.1)) (accept-process-output p 0.1) (tramp-message v 6 "\n%s" (buffer-string)) @@ -1168,8 +1168,7 @@ connection if a previous connection has died for some reason." (when (and user (not (tramp-get-file-property vec "" "su-command-p" t))) (tramp-error vec 'file-error "Cannot switch to user `%s'" user)) - (unless - (and p (processp p) (memq (process-status p) '(run open))) + (unless (tramp-compat-process-live-p p) (save-match-data (when (and p (processp p)) (delete-process p)) (if (zerop (length device)) @@ -1188,7 +1187,7 @@ connection if a previous connection has died for some reason." vec 6 "%s" (mapconcat 'identity (process-command p) " ")) ;; Wait for initial prompt. (tramp-adb-wait-for-output p 30) - (unless (eq 'run (process-status p)) + (unless (tramp-compat-process-live-p p) (tramp-error vec 'file-error "Terminated!")) (tramp-set-connection-property p "vector" vec) (set-process-query-on-exit-flag p nil) diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 76b49a09e3a..9a2ff0b099f 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -240,7 +240,7 @@ connection, returns DEFAULT." (value ;; If the key is an auxiliary process object, check whether ;; the process is still alive. - (if (and (processp key) (not (memq (process-status key) '(run open)))) + (if (and (processp key) (not (tramp-compat-process-live-p key))) default (if (hash-table-p hash) (gethash property hash default) diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index b2f91016585..19e48f6f251 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -248,6 +248,19 @@ Add the extension of F, if existing." process-name)))) (setq result t))))))))) +;; `process-running-live-p' is introduced in Emacs 24. +(defalias 'tramp-compat-process-live-p + (if (fboundp 'process-running-live-p) + 'process-running-live-p + (lambda (process) + "Returns non-nil if PROCESS is alive. +A process is considered alive if its status is `run', `open', +`listen', `connect' or `stop'. Value is nil if PROCESS is not a +process." + (and (processp process) + (memq (process-status process) + '(run open listen connect stop)))))) + ;; `default-toplevel-value' has been declared in Emacs 24. (unless (fboundp 'default-toplevel-value) (defalias 'default-toplevel-value 'symbol-value)) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 82abf542c5e..398fc87870c 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1084,7 +1084,7 @@ file names." ;; There might be an error if the monitor is not supported. ;; Give the filter a chance to read the output. (tramp-accept-process-output p 1) - (unless (memq (process-status p) '(run open)) + (unless (tramp-compat-process-live-p p) (tramp-error v 'file-notify-error "Monitoring not supported for `%s'" file-name)) p)))) diff --git a/lisp/net/tramp-gw.el b/lisp/net/tramp-gw.el index ecf1436d599..5f9720ff650 100644 --- a/lisp/net/tramp-gw.el +++ b/lisp/net/tramp-gw.el @@ -93,7 +93,7 @@ (defun tramp-gw-gw-proc-sentinel (proc _event) "Delete auxiliary process when we are deleted." - (unless (memq (process-status proc) '(run open)) + (unless (tramp-compat-process-live-p proc) (tramp-message tramp-gw-vector 4 "Deleting auxiliary process `%s'" tramp-gw-gw-proc) (let* ((tramp-verbose 0) @@ -102,7 +102,7 @@ (defun tramp-gw-aux-proc-sentinel (proc _event) "Activate the different filters for involved gateway and auxiliary processes." - (when (memq (process-status proc) '(run open)) + (when (tramp-compat-process-live-p proc) ;; A new process has been spawned from `tramp-gw-aux-proc'. (tramp-message tramp-gw-vector 4 @@ -149,8 +149,7 @@ instead of the host name declared in TARGET-VEC." tramp-gw-gw-vector gw-vec) ;; Start listening auxiliary process. - (unless (and (processp tramp-gw-aux-proc) - (memq (process-status tramp-gw-aux-proc) '(listen))) + (unless (tramp-compat-process-live-p tramp-gw-aux-proc) (let ((aux-vec (vector "aux" (tramp-file-name-user gw-vec) (tramp-file-name-host gw-vec) nil nil))) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 9afa85e8ceb..61d853f111e 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2839,7 +2839,7 @@ the result will be a local, non-Tramp, file name." (defun tramp-process-sentinel (proc event) "Flush file caches." - (unless (memq (process-status proc) '(run open)) + (unless (tramp-compat-process-live-p proc) (let ((vec (tramp-get-connection-property proc "vector" nil))) (when vec (tramp-message vec 5 "Sentinel called: `%S' `%s'" proc event) @@ -3641,7 +3641,7 @@ Fall back to normal file name handler if no Tramp handler exists." ;; There might be an error if the monitor is not supported. ;; Give the filter a chance to read the output. (tramp-accept-process-output p 1) - (unless (memq (process-status p) '(run open)) + (unless (tramp-compat-process-live-p p) (tramp-error v 'file-notify-error "Monitoring not supported for `%s'" file-name)) p)))) @@ -4649,7 +4649,7 @@ connection if a previous connection has died for some reason." ;; If Tramp opens the same connection within a short time frame, ;; there is a problem. We shall signal this. - (unless (or (and p (processp p) (memq (process-status p) '(run open))) + (unless (or (tramp-compat-process-live-p p) (not (equal (butlast (append vec nil) 2) (car tramp-current-connection))) (> (tramp-time-diff @@ -4670,9 +4670,9 @@ connection if a previous connection has died for some reason." (tramp-get-connection-property p "last-cmd-time" '(0 0 0))) 60) - p (processp p) (memq (process-status p) '(run open))) + (tramp-compat-process-live-p p)) (tramp-send-command vec "echo are you awake" t t) - (unless (and (memq (process-status p) '(run open)) + (unless (and (tramp-compat-process-live-p p) (tramp-wait-for-output p 10)) ;; The error will be caught locally. (tramp-error vec 'file-error "Awake did fail"))) @@ -4682,7 +4682,7 @@ connection if a previous connection has died for some reason." ;; New connection must be opened. (condition-case err - (unless (and p (processp p) (memq (process-status p) '(run open))) + (unless (tramp-compat-process-live-p p) ;; If `non-essential' is non-nil, don't reopen a new connection. ;; This variable has been introduced with Emacs 24.1. diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index be7eb88b9c7..05ce6041a8b 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -388,7 +388,7 @@ pass to the OPERATION." (defun tramp-smb-action-with-tar (proc vec) "Untar from connection buffer." - (if (not (memq (process-status proc) '(run open))) + (if (not (tramp-compat-process-live-p proc)) (throw 'tramp-action 'process-died) (with-current-buffer (tramp-get-connection-buffer vec) @@ -520,7 +520,7 @@ pass to the OPERATION." (set-process-query-on-exit-flag p nil) (tramp-process-actions p v nil tramp-smb-actions-with-tar) - (while (memq (process-status p) '(run open)) + (while (tramp-compat-process-live-p p) (sit-for 0.1)) (tramp-message v 6 "\n%s" (buffer-string)))) @@ -705,7 +705,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (defun tramp-smb-action-get-acl (proc vec) "Read ACL data from connection buffer." - (when (not (memq (process-status proc) '(run open))) + (unless (tramp-compat-process-live-p proc) ;; Accept pending output. (while (tramp-accept-process-output proc 0.1)) (with-current-buffer (tramp-get-connection-buffer vec) @@ -1218,7 +1218,7 @@ target of the symlink differ." (narrow-to-region (point-max) (point-max)) (let ((p (tramp-get-connection-process v))) (tramp-smb-send-command v "exit $lasterrorcode") - (while (memq (process-status p) '(run open)) + (while (tramp-compat-process-live-p p) (sleep-for 0.1) (setq ret (process-exit-status p)))) (delete-region (point-min) (point-max)) @@ -1302,7 +1302,7 @@ target of the symlink differ." (defun tramp-smb-action-set-acl (proc vec) "Read ACL data from connection buffer." - (when (not (memq (process-status proc) '(run open))) + (unless (tramp-compat-process-live-p proc) ;; Accept pending output. (while (tramp-accept-process-output proc 0.1)) (with-current-buffer (tramp-get-connection-buffer vec) @@ -1718,8 +1718,7 @@ Result is the list (LOCALNAME MODE SIZE MTIME)." (defun tramp-smb-get-cifs-capabilities (vec) "Check, whether the SMB server supports POSIX commands." ;; When we are not logged in yet, we return nil. - (if (let ((p (tramp-get-connection-process vec))) - (and p (processp p) (memq (process-status p) '(run open)))) + (if (tramp-compat-process-live-p (tramp-get-connection-process vec)) (with-tramp-connection-property (tramp-get-connection-process vec) "cifs-capabilities" (save-match-data @@ -1737,8 +1736,7 @@ Result is the list (LOCALNAME MODE SIZE MTIME)." "Check, whether the SMB server supports the STAT command." ;; When we are not logged in yet, we return nil. (if (and (tramp-smb-get-share vec) - (let ((p (tramp-get-connection-process vec))) - (and p (processp p) (memq (process-status p) '(run open))))) + (tramp-compat-process-live-p (tramp-get-connection-process vec))) (with-tramp-connection-property (tramp-get-connection-process vec) "stat-capability" (tramp-smb-send-command vec "stat \"/\"")))) @@ -1805,18 +1803,17 @@ If ARGUMENT is non-nil, use it as argument for (tramp-get-connection-property p "last-cmd-time" '(0 0 0))) 60) - p (processp p) (memq (process-status p) '(run open)) + (tramp-compat-process-live-p p) (re-search-forward tramp-smb-errors nil t)) (delete-process p) (setq p nil))) ;; Check whether it is still the same share. - (unless - (and p (processp p) (memq (process-status p) '(run open)) - (or argument - (string-equal - share - (tramp-get-connection-property p "smb-share" "")))) + (unless (and (tramp-compat-process-live-p p) + (or argument + (string-equal + share + (tramp-get-connection-property p "smb-share" "")))) (save-match-data ;; There might be unread output from checking for share names. @@ -1947,7 +1944,7 @@ Returns nil if an error message has appeared." ;; Algorithm: get waiting output. See if last line contains ;; `tramp-smb-prompt' sentinel or `tramp-smb-errors' strings. ;; If not, wait a bit and again get waiting output. - (while (and (not found) (not err) (memq (process-status p) '(run open))) + (while (and (not found) (not err) (tramp-compat-process-live-p p)) ;; Accept pending output. (tramp-accept-process-output p 0.1) @@ -1961,7 +1958,7 @@ Returns nil if an error message has appeared." (setq err (re-search-forward tramp-smb-errors nil t))) ;; When the process is still alive, read pending output. - (while (and (not found) (memq (process-status p) '(run open))) + (while (and (not found) (tramp-compat-process-live-p p)) ;; Accept pending output. (tramp-accept-process-output p 0.1) @@ -1985,7 +1982,7 @@ Returns nil if an error message has appeared." "Send SIGKILL to the winexe process." (ignore-errors (let ((p (get-buffer-process (current-buffer)))) - (when (and p (processp p) (memq (process-status p) '(run open))) + (when (tramp-compat-process-live-p p) (signal-process (process-id p) 'SIGINT))))) (defun tramp-smb-call-winexe (vec) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index f262b739ad5..4e9d4c29cd4 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -939,14 +939,14 @@ checked via the following code: (erase-buffer) (let ((proc (start-process (buffer-name) (current-buffer) \"ssh\" \"-l\" user host \"wc\" \"-c\"))) - (when (memq (process-status proc) \\='(run open)) + (when (process-live-p proc) (process-send-string proc (make-string sent ?\\ )) (process-send-eof proc) (process-send-eof proc)) (while (not (progn (goto-char (point-min)) (re-search-forward \"\\\\w+\" (point-max) t))) (accept-process-output proc 1)) - (when (memq (process-status proc) \\='(run open)) + (when (process-live-p proc) (setq received (string-to-number (match-string 0))) (delete-process proc) (message \"Bytes sent: %s\\tBytes received: %s\" sent received) @@ -2284,11 +2284,10 @@ should never be set globally, the intention is to let-bind it.") This is true, if either the remote host is already connected, or if we are not in completion mode." (and (tramp-tramp-file-p filename) - (with-parsed-tramp-file-name filename nil - (or (not (tramp-completion-mode-p)) - (let* ((tramp-verbose 0) - (p (tramp-get-connection-process v))) - (and p (processp p) (memq (process-status p) '(run open)))))))) + (or (not (tramp-completion-mode-p)) + (tramp-compat-process-live-p + (tramp-get-connection-process + (tramp-dissect-file-name filename)))))) (defun tramp-completion-handle-expand-file-name (name &optional dir) "Like `expand-file-name' for Tramp files." @@ -2942,7 +2941,7 @@ User is always nil." (when (tramp-tramp-file-p filename) (let* ((v (tramp-dissect-file-name filename)) (p (tramp-get-connection-process v)) - (c (and p (processp p) (memq (process-status p) '(run open)) + (c (and (tramp-compat-process-live-p p) (tramp-get-connection-property p "connected" nil)))) ;; We expand the file name only, if there is already a connection. (with-parsed-tramp-file-name @@ -3344,7 +3343,7 @@ of." (defun tramp-handle-file-notify-valid-p (proc) "Like `file-notify-valid-p' for Tramp files." - (and proc (processp proc) (memq (process-status proc) '(run open)) + (and (tramp-compat-process-live-p proc) ;; Sometimes, the process is still in status `run' when the ;; file or directory to be watched is deleted already. (with-current-buffer (process-buffer proc) @@ -3439,14 +3438,14 @@ The terminal type can be configured with `tramp-terminal-type'." (defun tramp-action-process-alive (proc _vec) "Check, whether a process has finished." - (unless (memq (process-status proc) '(run open)) + (unless (tramp-compat-process-live-p proc) (throw 'tramp-action 'process-died))) (defun tramp-action-out-of-band (proc vec) "Check, whether an out-of-band copy has finished." ;; There might be pending output for the exit status. (tramp-accept-process-output proc 0.1) - (cond ((and (memq (process-status proc) '(stop exit)) + (cond ((and (not (tramp-compat-process-live-p proc)) (zerop (process-exit-status proc))) (tramp-message vec 3 "Process has finished.") (throw 'tramp-action 'ok)) @@ -3608,14 +3607,14 @@ nil." (with-timeout (timeout) (while (not found) (tramp-accept-process-output proc 1) - (unless (memq (process-status proc) '(run open)) + (unless (tramp-compat-process-live-p proc) (tramp-error-with-buffer nil proc 'file-error "Process has died")) (setq found (tramp-check-for-regexp proc regexp))))) (t (while (not found) (tramp-accept-process-output proc 1) - (unless (memq (process-status proc) '(run open)) + (unless (tramp-compat-process-live-p proc) (tramp-error-with-buffer nil proc 'file-error "Process has died")) (setq found (tramp-check-for-regexp proc regexp))))) -- 2.39.2