911 |
:group 'tramp |
:group 'tramp |
912 |
:type 'regexp) |
:type 'regexp) |
913 |
|
|
914 |
(defcustom tramp-out-of-band-prompt-regexp |
(defcustom tramp-process-alive-regexp |
915 |
"" |
"" |
916 |
"Regular expression indicating an out-of-band copy has finished. |
"Regular expression indicating a process has finished. |
917 |
In fact this expression is empty by intention, it will be used only to |
In fact this expression is empty by intention, it will be used only to |
918 |
check regularly the status of the associated process. |
check regularly the status of the associated process. |
919 |
The answer will be provided by `tramp-action-out-of-band', which see." |
The answer will be provided by `tramp-action-process-alive' and |
920 |
|
`tramp-action-out-of-band', which see." |
921 |
:group 'tramp |
:group 'tramp |
922 |
:type 'regexp) |
:type 'regexp) |
923 |
|
|
1147 |
|
|
1148 |
;;;###autoload |
;;;###autoload |
1149 |
(defconst tramp-completion-file-name-regexp-unified |
(defconst tramp-completion-file-name-regexp-unified |
1150 |
"^/[^/]*$" |
"^/$\\|^/[^/:][^/]*$" |
1151 |
"Value for `tramp-completion-file-name-regexp' for unified remoting. |
"Value for `tramp-completion-file-name-regexp' for unified remoting. |
1152 |
Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and |
Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and |
1153 |
Tramp. See `tramp-file-name-structure-unified' for more explanations.") |
Tramp. See `tramp-file-name-structure-unified' for more explanations.") |
1289 |
(tramp-wrong-passwd-regexp tramp-action-permission-denied) |
(tramp-wrong-passwd-regexp tramp-action-permission-denied) |
1290 |
(tramp-yesno-prompt-regexp tramp-action-yesno) |
(tramp-yesno-prompt-regexp tramp-action-yesno) |
1291 |
(tramp-yn-prompt-regexp tramp-action-yn) |
(tramp-yn-prompt-regexp tramp-action-yn) |
1292 |
(tramp-terminal-prompt-regexp tramp-action-terminal)) |
(tramp-terminal-prompt-regexp tramp-action-terminal) |
1293 |
|
(tramp-process-alive-regexp tramp-action-process-alive)) |
1294 |
"List of pattern/action pairs. |
"List of pattern/action pairs. |
1295 |
Whenever a pattern matches, the corresponding action is performed. |
Whenever a pattern matches, the corresponding action is performed. |
1296 |
Each item looks like (PATTERN ACTION). |
Each item looks like (PATTERN ACTION). |
1308 |
(defcustom tramp-actions-copy-out-of-band |
(defcustom tramp-actions-copy-out-of-band |
1309 |
'((tramp-password-prompt-regexp tramp-action-password) |
'((tramp-password-prompt-regexp tramp-action-password) |
1310 |
(tramp-wrong-passwd-regexp tramp-action-permission-denied) |
(tramp-wrong-passwd-regexp tramp-action-permission-denied) |
1311 |
(tramp-out-of-band-prompt-regexp tramp-action-out-of-band)) |
(tramp-process-alive-regexp tramp-action-out-of-band)) |
1312 |
"List of pattern/action pairs. |
"List of pattern/action pairs. |
1313 |
This list is used for copying/renaming with out-of-band methods. |
This list is used for copying/renaming with out-of-band methods. |
1314 |
See `tramp-actions-before-shell' for more info." |
See `tramp-actions-before-shell' for more info." |
1320 |
(tramp-login-prompt-regexp tramp-multi-action-login) |
(tramp-login-prompt-regexp tramp-multi-action-login) |
1321 |
(shell-prompt-pattern tramp-multi-action-succeed) |
(shell-prompt-pattern tramp-multi-action-succeed) |
1322 |
(tramp-shell-prompt-pattern tramp-multi-action-succeed) |
(tramp-shell-prompt-pattern tramp-multi-action-succeed) |
1323 |
(tramp-wrong-passwd-regexp tramp-multi-action-permission-denied)) |
(tramp-wrong-passwd-regexp tramp-multi-action-permission-denied) |
1324 |
|
(tramp-process-alive-regexp tramp-action-process-alive)) |
1325 |
"List of pattern/action pairs. |
"List of pattern/action pairs. |
1326 |
This list is used for each hop in multi-hop connections. |
This list is used for each hop in multi-hop connections. |
1327 |
See `tramp-actions-before-shell' for more info." |
See `tramp-actions-before-shell' for more info." |
1329 |
:type '(repeat (list variable function))) |
:type '(repeat (list variable function))) |
1330 |
|
|
1331 |
(defcustom tramp-initial-commands |
(defcustom tramp-initial-commands |
1332 |
'("unset correct" |
'("unset HISTORY" |
1333 |
|
"unset correct" |
1334 |
"unset autocorrect") |
"unset autocorrect") |
1335 |
"List of commands to send to the first remote shell that we see. |
"List of commands to send to the first remote shell that we see. |
1336 |
These commands will be sent to any shell, and thus they should be |
These commands will be sent to any shell, and thus they should be |
1772 |
(insert-directory . tramp-handle-insert-directory) |
(insert-directory . tramp-handle-insert-directory) |
1773 |
(expand-file-name . tramp-handle-expand-file-name) |
(expand-file-name . tramp-handle-expand-file-name) |
1774 |
(file-local-copy . tramp-handle-file-local-copy) |
(file-local-copy . tramp-handle-file-local-copy) |
1775 |
|
(file-remote-p . tramp-handle-file-remote-p) |
1776 |
(insert-file-contents . tramp-handle-insert-file-contents) |
(insert-file-contents . tramp-handle-insert-file-contents) |
1777 |
(write-region . tramp-handle-write-region) |
(write-region . tramp-handle-write-region) |
1778 |
(find-backup-file-name . tramp-handle-find-backup-file-name) |
(find-backup-file-name . tramp-handle-find-backup-file-name) |
2047 |
"Like `file-truename' for tramp files." |
"Like `file-truename' for tramp files." |
2048 |
(with-parsed-tramp-file-name filename nil |
(with-parsed-tramp-file-name filename nil |
2049 |
(let* ((steps (tramp-split-string localname "/")) |
(let* ((steps (tramp-split-string localname "/")) |
2050 |
(localnamedir (let ((directory-sep-char ?/)) |
(localnamedir (tramp-let-maybe directory-sep-char ?/ ;for XEmacs |
2051 |
(file-name-as-directory localname))) |
(file-name-as-directory localname))) |
2052 |
(is-dir (string= localname localnamedir)) |
(is-dir (string= localname localnamedir)) |
2053 |
(thisstep nil) |
(thisstep nil) |
2054 |
(numchase 0) |
(numchase 0) |
2989 |
;; Use rcp-like program for file transfer. |
;; Use rcp-like program for file transfer. |
2990 |
(let ((p (apply 'start-process (buffer-name trampbuf) trampbuf |
(let ((p (apply 'start-process (buffer-name trampbuf) trampbuf |
2991 |
copy-program copy-args))) |
copy-program copy-args))) |
2992 |
(process-kill-without-query p) |
(tramp-set-process-query-on-exit-flag p nil) |
2993 |
(tramp-process-actions p multi-method method user host |
(tramp-process-actions p multi-method method user host |
2994 |
tramp-actions-copy-out-of-band)) |
tramp-actions-copy-out-of-band)) |
2995 |
(kill-buffer trampbuf) |
(kill-buffer trampbuf) |
3302 |
;; expand-file-name (this does "/./" and "/../"). We bind |
;; expand-file-name (this does "/./" and "/../"). We bind |
3303 |
;; directory-sep-char here for XEmacs on Windows, which |
;; directory-sep-char here for XEmacs on Windows, which |
3304 |
;; would otherwise use backslash. |
;; would otherwise use backslash. |
3305 |
(let ((directory-sep-char ?/)) |
(tramp-let-maybe directory-sep-char ?/ |
3306 |
(tramp-make-tramp-file-name |
(tramp-make-tramp-file-name |
3307 |
multi-method (or method (tramp-find-default-method user host)) |
multi-method (or method (tramp-find-default-method user host)) |
3308 |
user host |
user host |
3530 |
(t (error "Wrong method specification for `%s'" method))) |
(t (error "Wrong method specification for `%s'" method))) |
3531 |
tmpfil))) |
tmpfil))) |
3532 |
|
|
3533 |
|
(defun tramp-handle-file-remote-p (filename) |
3534 |
|
"Like `file-remote-p' for tramp files." |
3535 |
|
(when (tramp-tramp-file-p filename) t)) |
3536 |
|
|
3537 |
(defun tramp-handle-insert-file-contents |
(defun tramp-handle-insert-file-contents |
3538 |
(filename &optional visit beg end replace) |
(filename &optional visit beg end replace) |
3853 |
|
|
3854 |
;; We handle here all file primitives. Most of them have the file |
;; We handle here all file primitives. Most of them have the file |
3855 |
;; name as first parameter; nevertheless we check for them explicitly |
;; name as first parameter; nevertheless we check for them explicitly |
3856 |
;; in order to be be signalled if a new primitive appears. This |
;; in order to be signalled if a new primitive appears. This |
3857 |
;; scenario is needed because there isn't a way to decide by |
;; scenario is needed because there isn't a way to decide by |
3858 |
;; syntactical means whether a foreign method must be called. It would |
;; syntactical means whether a foreign method must be called. It would |
3859 |
;; ease the live if `file-name-handler-alist' would support a decision |
;; ease the life if `file-name-handler-alist' would support a decision |
3860 |
;; function as well but regexp only. |
;; function as well but regexp only. |
3861 |
(defun tramp-file-name-for-operation (operation &rest args) |
(defun tramp-file-name-for-operation (operation &rest args) |
3862 |
"Return file name related to OPERATION file primitive. |
"Return file name related to OPERATION file primitive. |
3870 |
'dired-compress-file 'dired-uncache |
'dired-compress-file 'dired-uncache |
3871 |
'file-accessible-directory-p 'file-attributes |
'file-accessible-directory-p 'file-attributes |
3872 |
'file-directory-p 'file-executable-p 'file-exists-p |
'file-directory-p 'file-executable-p 'file-exists-p |
3873 |
'file-local-copy 'file-modes 'file-name-as-directory |
'file-local-copy 'file-remote-p 'file-modes |
3874 |
'file-name-directory 'file-name-nondirectory |
'file-name-as-directory 'file-name-directory |
3875 |
'file-name-sans-versions 'file-ownership-preserved-p |
'file-name-nondirectory 'file-name-sans-versions |
3876 |
'file-readable-p 'file-regular-p 'file-symlink-p |
'file-ownership-preserved-p 'file-readable-p |
3877 |
'file-truename 'file-writable-p 'find-backup-file-name |
'file-regular-p 'file-symlink-p 'file-truename |
3878 |
'find-file-noselect 'get-file-buffer 'insert-directory |
'file-writable-p 'find-backup-file-name 'find-file-noselect |
3879 |
'insert-file-contents 'load 'make-directory |
'get-file-buffer 'insert-directory 'insert-file-contents |
3880 |
'make-directory-internal 'set-file-modes |
'load 'make-directory 'make-directory-internal |
3881 |
'substitute-in-file-name 'unhandled-file-name-directory |
'set-file-modes 'substitute-in-file-name |
3882 |
'vc-registered |
'unhandled-file-name-directory 'vc-registered |
3883 |
; XEmacs only |
; XEmacs only |
3884 |
'abbreviate-file-name 'create-file-buffer |
'abbreviate-file-name 'create-file-buffer |
3885 |
'dired-file-modtime 'dired-make-compressed-filename |
'dired-file-modtime 'dired-make-compressed-filename |
3948 |
(foreign (apply foreign operation args)) |
(foreign (apply foreign operation args)) |
3949 |
(t (tramp-run-real-handler operation args)))))) |
(t (tramp-run-real-handler operation args)))))) |
3950 |
|
|
|
;;;###autoload |
|
|
(put 'tramp-file-name-handler 'file-remote-p t) ;for file-remote-p |
|
|
|
|
3951 |
(defun tramp-sh-file-name-handler (operation &rest args) |
(defun tramp-sh-file-name-handler (operation &rest args) |
3952 |
"Invoke remote-shell Tramp file name handler. |
"Invoke remote-shell Tramp file name handler. |
3953 |
Fall back to normal file name handler if no Tramp handler exists." |
Fall back to normal file name handler if no Tramp handler exists." |
4892 |
"Checks whether the given `ls' executable in one of the dirs groks `-n'. |
"Checks whether the given `ls' executable in one of the dirs groks `-n'. |
4893 |
Returns nil if none was found, else the command is returned." |
Returns nil if none was found, else the command is returned." |
4894 |
(let ((dl dirlist) |
(let ((dl dirlist) |
4895 |
(result nil) |
(result nil)) |
4896 |
(directory-sep-char ?/)) ;for XEmacs |
(tramp-let-maybe directory-sep-char ?/ ;for XEmacs |
4897 |
;; It would be better to use the CL function `find', but |
;; It would be better to use the CL function `find', but |
4898 |
;; we don't want run-time dependencies on CL. |
;; we don't want run-time dependencies on CL. |
4899 |
(while (and dl (not result)) |
(while (and dl (not result)) |
4900 |
(let ((x (concat (file-name-as-directory (car dl)) cmd))) |
(let ((x (concat (file-name-as-directory (car dl)) cmd))) |
4901 |
(when (tramp-check-ls-command multi-method method user host x) |
(when (tramp-check-ls-command multi-method method user host x) |
4902 |
(setq result x))) |
(setq result x))) |
4903 |
(setq dl (cdr dl))) |
(setq dl (cdr dl))) |
4904 |
result)) |
result))) |
4905 |
|
|
4906 |
(defun tramp-find-ls-command (multi-method method user host) |
(defun tramp-find-ls-command (multi-method method user host) |
4907 |
"Finds an `ls' command which groks the `-n' option, returning nil if failed. |
"Finds an `ls' command which groks the `-n' option, returning nil if failed. |
4981 |
(process-send-string nil (concat tramp-terminal-type |
(process-send-string nil (concat tramp-terminal-type |
4982 |
tramp-rsh-end-of-line))) |
tramp-rsh-end-of-line))) |
4983 |
|
|
4984 |
|
(defun tramp-action-process-alive (p multi-method method user host) |
4985 |
|
"Check whether a process has finished." |
4986 |
|
(unless (memq (process-status p) '(run open)) |
4987 |
|
(throw 'tramp-action 'process-died))) |
4988 |
|
|
4989 |
(defun tramp-action-out-of-band (p multi-method method user host) |
(defun tramp-action-out-of-band (p multi-method method user host) |
4990 |
"Check whether an out-of-band copy has finished." |
"Check whether an out-of-band copy has finished." |
4991 |
(cond ((and (memq (process-status p) '(stop exit)) |
(cond ((and (memq (process-status p) '(stop exit)) |
5175 |
user host 'tramp-login-args))) |
user host 'tramp-login-args))) |
5176 |
(found nil) |
(found nil) |
5177 |
(pw nil)) |
(pw nil)) |
5178 |
(process-kill-without-query p) |
(tramp-set-process-query-on-exit-flag p nil) |
5179 |
(set-buffer (tramp-get-buffer multi-method method user host)) |
(set-buffer (tramp-get-buffer multi-method method user host)) |
5180 |
(erase-buffer) |
(erase-buffer) |
5181 |
(tramp-process-actions p multi-method method user host |
(tramp-process-actions p multi-method method user host |
5242 |
(apply #'start-process bufnam buf login-program |
(apply #'start-process bufnam buf login-program |
5243 |
host login-args))) |
host login-args))) |
5244 |
(found nil)) |
(found nil)) |
5245 |
(process-kill-without-query p) |
(tramp-set-process-query-on-exit-flag p nil) |
5246 |
|
|
5247 |
(set-buffer buf) |
(set-buffer buf) |
5248 |
(tramp-process-actions p multi-method method user host |
(tramp-process-actions p multi-method method user host |
5303 |
user host 'tramp-login-args)))) |
user host 'tramp-login-args)))) |
5304 |
(found nil) |
(found nil) |
5305 |
(pw nil)) |
(pw nil)) |
5306 |
(process-kill-without-query p) |
(tramp-set-process-query-on-exit-flag p nil) |
5307 |
(set-buffer (tramp-get-buffer multi-method method user host)) |
(set-buffer (tramp-get-buffer multi-method method user host)) |
5308 |
(tramp-process-actions p multi-method method user host |
(tramp-process-actions p multi-method method user host |
5309 |
tramp-actions-before-shell) |
tramp-actions-before-shell) |
5356 |
tramp-multi-sh-program)) |
tramp-multi-sh-program)) |
5357 |
(num-hops (length method)) |
(num-hops (length method)) |
5358 |
(i 0)) |
(i 0)) |
5359 |
(process-kill-without-query p) |
(tramp-set-process-query-on-exit-flag p nil) |
5360 |
(tramp-message 9 "Waiting 60s for local shell to come up...") |
(tramp-message 9 "Waiting 60s for local shell to come up...") |
5361 |
(unless (tramp-wait-for-regexp |
(unless (tramp-wait-for-regexp |
5362 |
p 60 (format "\\(%s\\)\\'\\|\\(%s\\)\\'" |
p 60 (format "\\(%s\\)\\'\\|\\(%s\\)\\'" |
5476 |
(with-timeout (timeout) |
(with-timeout (timeout) |
5477 |
(while (not found) |
(while (not found) |
5478 |
(accept-process-output proc 1) |
(accept-process-output proc 1) |
5479 |
|
(unless (memq (process-status proc) '(run open)) |
5480 |
|
(error "Process has died")) |
5481 |
(goto-char (point-min)) |
(goto-char (point-min)) |
5482 |
(setq found (when (re-search-forward regexp nil t) |
(setq found (when (re-search-forward regexp nil t) |
5483 |
(tramp-match-string-list))))))) |
(tramp-match-string-list))))))) |
5484 |
(t |
(t |
5485 |
(while (not found) |
(while (not found) |
5486 |
(accept-process-output proc 1) |
(accept-process-output proc 1) |
5487 |
|
(unless (memq (process-status proc) '(run open)) |
5488 |
|
(error "Process has died")) |
5489 |
(goto-char (point-min)) |
(goto-char (point-min)) |
5490 |
(setq found (when (re-search-forward regexp nil t) |
(setq found (when (re-search-forward regexp nil t) |
5491 |
(tramp-match-string-list)))))) |
(tramp-match-string-list)))))) |
5540 |
|
|
5541 |
;; HHH: Not Changed. This might handle the case where USER is not |
;; HHH: Not Changed. This might handle the case where USER is not |
5542 |
;; given in the "File name" very poorly. Then, the local |
;; given in the "File name" very poorly. Then, the local |
5543 |
;; variable tramp-current user will be set to nil. |
;; variable tramp-current-user will be set to nil. |
5544 |
(defun tramp-pre-connection (multi-method method user host) |
(defun tramp-pre-connection (multi-method method user host) |
5545 |
"Do some setup before actually logging in. |
"Do some setup before actually logging in. |
5546 |
METHOD, USER and HOST specify the connection." |
METHOD, USER and HOST specify the connection." |
5635 |
"stty -onlcr")))) |
"stty -onlcr")))) |
5636 |
(erase-buffer) |
(erase-buffer) |
5637 |
(tramp-message |
(tramp-message |
5638 |
9 "Waiting 30s for `HISTFILE=$HOME/.tramp_history; HISTSIZE=1'") |
9 "Waiting 30s for `HISTFILE=$HOME/.tramp_history; HISTSIZE=1; export HISTFILE; export HISTSIZE'") |
5639 |
(tramp-send-command-internal multi-method method user host |
(tramp-send-command-internal |
5640 |
"HISTFILE=$HOME/.tramp_history; HISTSIZE=1") |
multi-method method user host |
5641 |
|
"HISTFILE=$HOME/.tramp_history; HISTSIZE=1; export HISTFILE; export HISTSIZE") |
5642 |
(erase-buffer) |
(erase-buffer) |
5643 |
(tramp-message 9 "Waiting 30s for `set +o vi +o emacs'") |
(tramp-message 9 "Waiting 30s for `set +o vi +o emacs'") |
5644 |
(tramp-send-command-internal multi-method method user host |
(tramp-send-command-internal multi-method method user host |
6094 |
(with-timeout (timeout) |
(with-timeout (timeout) |
6095 |
(while (not found) |
(while (not found) |
6096 |
(accept-process-output proc 1) |
(accept-process-output proc 1) |
6097 |
|
(unless (memq (process-status proc) '(run open)) |
6098 |
|
(error "Process has died")) |
6099 |
(goto-char (point-max)) |
(goto-char (point-max)) |
6100 |
(forward-line -1) |
(forward-line -1) |
6101 |
(setq found (looking-at end-of-output)))))) |
(setq found (looking-at end-of-output)))))) |
6102 |
(t |
(t |
6103 |
(while (not found) |
(while (not found) |
6104 |
(accept-process-output proc 1) |
(accept-process-output proc 1) |
6105 |
|
(unless (memq (process-status proc) '(run open)) |
6106 |
|
(error "Process has died")) |
6107 |
(goto-char (point-max)) |
(goto-char (point-max)) |
6108 |
(forward-line -1) |
(forward-line -1) |
6109 |
(setq found (looking-at end-of-output)))))) |
(setq found (looking-at end-of-output)))))) |
6781 |
it does the right thing." |
it does the right thing." |
6782 |
(delete "" (split-string string pattern))) |
(delete "" (split-string string pattern))) |
6783 |
|
|
6784 |
|
(defun tramp-set-process-query-on-exit-flag (process flag) |
6785 |
|
"Specify if query is needed for process when Emacs is exited. |
6786 |
|
If the second argument flag is non-nil, Emacs will query the user before |
6787 |
|
exiting if process is running." |
6788 |
|
(if (fboundp 'set-process-query-on-exit-flag) |
6789 |
|
(set-process-query-on-exit-flag process flag) |
6790 |
|
(funcall (symbol-function 'process-kill-without-query) |
6791 |
|
process flag))) |
6792 |
|
|
6793 |
|
(defmacro tramp-let-maybe (variable value &rest body) |
6794 |
|
"Let-bind VARIABLE to VALUE in BODY, but only if VARIABLE is not obsolete. |
6795 |
|
BODY is executed whether or not the variable is obsolete. |
6796 |
|
The intent is to protect against `obsolete variable' warnings." |
6797 |
|
`(if (get 'byte-obsolete-variable ',variable) |
6798 |
|
(progn ,@body) |
6799 |
|
(let ((,variable ,value)) |
6800 |
|
,@body))) |
6801 |
|
(put 'tramp-let-maybe 'lisp-indent-function 2) |
6802 |
|
|
6803 |
|
|
6804 |
;; ------------------------------------------------------------ |
;; ------------------------------------------------------------ |
6805 |
;; -- Kludges section -- |
;; -- Kludges section -- |
6806 |
;; ------------------------------------------------------------ |
;; ------------------------------------------------------------ |