diff options
Diffstat (limited to 'lisp/net/tramp-sh.el')
| -rw-r--r-- | lisp/net/tramp-sh.el | 1203 |
1 files changed, 536 insertions, 667 deletions
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 842b1ce2880..57cb6e11d21 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -32,9 +32,6 @@ (eval-when-compile (require 'cl) (require 'dired)) -(defvar directory-sep-char) -(defvar tramp-gw-tunnel-method) -(defvar tramp-gw-socks-method) (defvar vc-handled-backends) (defvar vc-bzr-program) (defvar vc-git-program) @@ -47,7 +44,8 @@ When inline transfer, compress transferred data of file whose size is this value or above (up to `tramp-copy-size-limit'). If it is nil, no compression at all will be applied." :group 'tramp - :type '(choice (const nil) integer)) + :type '(choice (const nil) integer) + :require 'tramp) ;;;###tramp-autoload (defcustom tramp-copy-size-limit 10240 @@ -55,7 +53,8 @@ If it is nil, no compression at all will be applied." out-of-the-band copy. If it is nil, out-of-the-band copy will be used without a check." :group 'tramp - :type '(choice (const nil) integer)) + :type '(choice (const nil) integer) + :require 'tramp) ;;;###tramp-autoload (defcustom tramp-terminal-type "dumb" @@ -64,7 +63,8 @@ Because Tramp wants to parse the output of the remote shell, it is easily confused by ANSI color escape sequences and suchlike. Often, shell init files conditionalize this setup based on the TERM environment variable." :group 'tramp - :type 'string) + :type 'string + :require 'tramp) ;;;###tramp-autoload (defcustom tramp-histfile-override "~/.tramp_history" @@ -81,11 +81,16 @@ the default storage location, e.g. \"$HOME/.sh_history\"." :version "25.2" :type '(choice (const :tag "Do not override HISTFILE" nil) (const :tag "Unset HISTFILE" t) - (string :tag "Redirect to a file"))) + (string :tag "Redirect to a file")) + :require 'tramp) ;;;###tramp-autoload -(defconst tramp-color-escape-sequence-regexp "\e[[;0-9]+m" - "Escape sequences produced by the \"ls\" command.") +(defconst tramp-display-escape-sequence-regexp "\e[[;0-9]+m" + "Terminal control escape sequences for display attributes.") + +;;;###tramp-autoload +(defconst tramp-device-escape-sequence-regexp "\e[[0-9]+n" + "Terminal control escape sequences for device status.") ;; ksh on OpenBSD 4.5 requires that $PS1 contains a `#' character for ;; root users. It uses the `$' character for other users. In order @@ -111,13 +116,14 @@ detected as prompt when being sent on echoing hosts, therefore.") "Whether to use `tramp-ssh-controlmaster-options'." :group 'tramp :version "24.4" - :type 'boolean) + :type 'boolean + :require 'tramp) (defvar tramp-ssh-controlmaster-options nil "Which ssh Control* arguments to use. If it is a string, it should have the form -\"-o ControlMaster=auto -o ControlPath='tramp.%%r@%%h:%%p' +\"-o ControlMaster=auto -o ControlPath=\\='tramp.%%r@%%h:%%p\\=' -o ControlPersist=no\". Percent characters in the ControlPath spec must be doubled, because the string is used as format string. @@ -164,11 +170,7 @@ The string is used in `tramp-methods'.") (tramp-copy-program "scp") (tramp-copy-args (("-P" "%p") ("-p" "%k") ("-q") ("-r") ("%c"))) (tramp-copy-keep-date t) - (tramp-copy-recursive t) - (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null") - ("-o" "UserKnownHostsFile=/dev/null") - ("-o" "StrictHostKeyChecking=no"))) - (tramp-default-port 22))) + (tramp-copy-recursive t))) ;;;###tramp-autoload (add-to-list 'tramp-methods '("scpx" @@ -183,11 +185,7 @@ The string is used in `tramp-methods'.") (tramp-copy-args (("-P" "%p") ("-p" "%k") ("-q") ("-r") ("%c"))) (tramp-copy-keep-date t) - (tramp-copy-recursive t) - (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null") - ("-o" "UserKnownHostsFile=/dev/null") - ("-o" "StrictHostKeyChecking=no"))) - (tramp-default-port 22))) + (tramp-copy-recursive t))) ;;;###tramp-autoload (add-to-list 'tramp-methods '("rsync" @@ -199,7 +197,7 @@ The string is used in `tramp-methods'.") (tramp-remote-shell-login ("-l")) (tramp-remote-shell-args ("-c")) (tramp-copy-program "rsync") - (tramp-copy-args (("-t" "%k") ("-r"))) + (tramp-copy-args (("-t" "%k") ("-p") ("-r") ("-s"))) (tramp-copy-env (("RSYNC_RSH") ("ssh" "%c"))) (tramp-copy-keep-date t) (tramp-copy-keep-tmpfile t) @@ -229,11 +227,7 @@ The string is used in `tramp-methods'.") (tramp-async-args (("-q"))) (tramp-remote-shell "/bin/sh") (tramp-remote-shell-login ("-l")) - (tramp-remote-shell-args ("-c")) - (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null") - ("-o" "UserKnownHostsFile=/dev/null") - ("-o" "StrictHostKeyChecking=no"))) - (tramp-default-port 22))) + (tramp-remote-shell-args ("-c")))) ;;;###tramp-autoload (add-to-list 'tramp-methods '("sshx" @@ -243,11 +237,7 @@ The string is used in `tramp-methods'.") (tramp-async-args (("-q"))) (tramp-remote-shell "/bin/sh") (tramp-remote-shell-login ("-l")) - (tramp-remote-shell-args ("-c")) - (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null") - ("-o" "UserKnownHostsFile=/dev/null") - ("-o" "StrictHostKeyChecking=no"))) - (tramp-default-port 22))) + (tramp-remote-shell-args ("-c")))) ;;;###tramp-autoload (add-to-list 'tramp-methods '("telnet" @@ -255,8 +245,7 @@ The string is used in `tramp-methods'.") (tramp-login-args (("%h") ("%p") ("2>/dev/null"))) (tramp-remote-shell "/bin/sh") (tramp-remote-shell-login ("-l")) - (tramp-remote-shell-args ("-c")) - (tramp-default-port 23))) + (tramp-remote-shell-args ("-c")))) ;;;###tramp-autoload (add-to-list 'tramp-methods '("nc" @@ -272,8 +261,7 @@ The string is used in `tramp-methods'.") ;; We use "-p" as required for newer busyboxes. For older ;; busybox/nc versions, the value must be (("-l") ("%r")). This ;; can be achieved by tweaking `tramp-connection-properties'. - (tramp-remote-copy-args (("-l") ("-p" "%r") ("2>/dev/null"))) - (tramp-default-port 23))) + (tramp-remote-copy-args (("-l") ("-p" "%r") ("2>/dev/null"))))) ;;;###tramp-autoload (add-to-list 'tramp-methods '("su" @@ -284,6 +272,15 @@ The string is used in `tramp-methods'.") (tramp-remote-shell-args ("-c")) (tramp-connection-timeout 10))) ;;;###tramp-autoload +(add-to-list + 'tramp-methods + '("sg" + (tramp-login-program "sg") + (tramp-login-args (("-") ("%u"))) + (tramp-remote-shell "/bin/sh") + (tramp-remote-shell-args ("-c")) + (tramp-connection-timeout 10))) +;;;###tramp-autoload (add-to-list 'tramp-methods '("sudo" (tramp-login-program "sudo") @@ -299,6 +296,14 @@ The string is used in `tramp-methods'.") (tramp-connection-timeout 10))) ;;;###tramp-autoload (add-to-list 'tramp-methods + '("doas" + (tramp-login-program "doas") + (tramp-login-args (("-u" "%u") ("-s"))) + (tramp-remote-shell "/bin/sh") + (tramp-remote-shell-args ("-c")) + (tramp-connection-timeout 10))) +;;;###tramp-autoload +(add-to-list 'tramp-methods '("ksu" (tramp-login-program "ksu") (tramp-login-args (("%u") ("-q"))) @@ -328,8 +333,7 @@ The string is used in `tramp-methods'.") ("/bin/sh") ("\""))) (tramp-remote-shell "/bin/sh") (tramp-remote-shell-login ("-l")) - (tramp-remote-shell-args ("-c")) - (tramp-default-port 22))) + (tramp-remote-shell-args ("-c")))) ;;;###tramp-autoload (add-to-list 'tramp-methods `("plinkx" @@ -361,8 +365,7 @@ The string is used in `tramp-methods'.") (tramp-copy-args (("-l" "%u") ("-P" "%p") ("-scp") ("-p" "%k") ("-q") ("-r"))) (tramp-copy-keep-date t) - (tramp-copy-recursive t) - (tramp-default-port 22))) + (tramp-copy-recursive t))) ;;;###tramp-autoload (add-to-list 'tramp-methods `("psftp" @@ -379,9 +382,8 @@ The string is used in `tramp-methods'.") (tramp-remote-shell-args ("-c")) (tramp-copy-program "pscp") (tramp-copy-args (("-l" "%u") ("-P" "%p") ("-sftp") ("-p" "%k") - ("-q") ("-r"))) - (tramp-copy-keep-date t) - (tramp-copy-recursive t))) + ("-q"))) + (tramp-copy-keep-date t))) ;;;###tramp-autoload (add-to-list 'tramp-methods '("fcp" @@ -400,7 +402,7 @@ The string is used in `tramp-methods'.") ;;;###tramp-autoload (add-to-list 'tramp-default-user-alist - `(,(concat "\\`" (regexp-opt '("su" "sudo" "ksu")) "\\'") + `(,(concat "\\`" (regexp-opt '("su" "sudo" "doas" "ksu")) "\\'") nil "root")) ;; Do not add "ssh" based methods, otherwise ~/.ssh/config would be ignored. ;; Do not add "plink" based methods, they ask interactively for the user. @@ -446,12 +448,17 @@ The string is used in `tramp-methods'.") "Default list of (FUNCTION FILE) pairs to be examined for su methods.") ;;;###tramp-autoload +(defconst tramp-completion-function-alist-sg + '((tramp-parse-etc-group "/etc/group")) + "Default list of (FUNCTION FILE) pairs to be examined for sg methods.") + +;;;###tramp-autoload (defconst tramp-completion-function-alist-putty `((tramp-parse-putty ,(if (memq system-type '(windows-nt)) "HKEY_CURRENT_USER\\Software\\SimonTatham\\PuTTY\\Sessions" "~/.putty/sessions"))) - "Default list of (FUNCTION REGISTRY) pairs to be examined for putty sessions.") + "Default list of (FUNCTION REGISTRY) pairs to be examined for putty sessions.") ;;;###tramp-autoload (eval-after-load 'tramp @@ -470,7 +477,9 @@ The string is used in `tramp-methods'.") (tramp-set-completion-function "nc" tramp-completion-function-alist-telnet) (tramp-set-completion-function "su" tramp-completion-function-alist-su) (tramp-set-completion-function "sudo" tramp-completion-function-alist-su) + (tramp-set-completion-function "doas" tramp-completion-function-alist-su) (tramp-set-completion-function "ksu" tramp-completion-function-alist-su) + (tramp-set-completion-function "sg" tramp-completion-function-alist-sg) (tramp-set-completion-function "krlogin" tramp-completion-function-alist-rsh) (tramp-set-completion-function "plink" tramp-completion-function-alist-ssh) @@ -483,10 +492,11 @@ The string is used in `tramp-methods'.") ;; "getconf PATH" yields: ;; HP-UX: /usr/bin:/usr/ccs/bin:/opt/ansic/bin:/opt/langtools/bin:/opt/fortran/bin ;; Solaris: /usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/SUNWspro/bin -;; GNU/Linux (Debian, Suse): /bin:/usr/bin +;; GNU/Linux (Debian, Suse, RHEL): /bin:/usr/bin ;; FreeBSD: /usr/bin:/bin:/usr/sbin:/sbin: - beware trailing ":"! ;; Darwin: /usr/bin:/bin:/usr/sbin:/sbin ;; IRIX64: /usr/bin +;; QNAP QTS: --- ;;;###tramp-autoload (defcustom tramp-remote-path '(tramp-default-remote-path "/bin" "/usr/bin" "/sbin" "/usr/sbin" @@ -515,11 +525,12 @@ the list by the special value `tramp-own-remote-path'." :type '(repeat (choice (const :tag "Default Directories" tramp-default-remote-path) (const :tag "Private Directories" tramp-own-remote-path) - (string :tag "Directory")))) + (string :tag "Directory"))) + :require 'tramp) ;;;###tramp-autoload (defcustom tramp-remote-process-environment - `("TMOUT=0" "LC_CTYPE=''" + `("ENV=''" "TMOUT=0" "LC_CTYPE=''" ,(format "TERM=%s" tramp-terminal-type) ,(format "INSIDE_EMACS='%s,tramp:%s'" emacs-version tramp-version) "CDPATH=" "HISTORY=" "MAIL=" "MAILCHECK=" "MAILPATH=" "PAGER=cat" @@ -533,8 +544,9 @@ which might have been set in the init files like ~/.profile. Special handling is applied to the PATH environment, which should not be set here. Instead, it should be set via `tramp-remote-path'." :group 'tramp - :version "24.4" - :type '(repeat string)) + :version "26.1" + :type '(repeat string) + :require 'tramp) ;;;###tramp-autoload (defcustom tramp-sh-extra-args '(("/bash\\'" . "-norc -noprofile")) @@ -551,7 +563,8 @@ shell from reading its init file." ;; `alist' is available. Who knows the right way to test it? :type (if (get 'alist 'widget-type) '(alist :key-type string :value-type string) - '(repeat (cons string string)))) + '(repeat (cons string string))) + :require 'tramp) (defconst tramp-actions-before-shell '((tramp-login-prompt-regexp tramp-action-login) @@ -637,29 +650,19 @@ Escape sequence %s is replaced with name of Perl binary. This string is passed to `format', so percent characters need to be doubled.") (defconst tramp-perl-file-name-all-completions - "%s -e 'sub case { - my $str = shift; - if ($ARGV[2]) { - return lc($str); - } - else { - return $str; - } -} + "%s -e ' opendir(d, $ARGV[0]) || die(\"$ARGV[0]: $!\\nfail\\n\"); @files = readdir(d); closedir(d); foreach $f (@files) { - if (case(substr($f, 0, length($ARGV[1]))) eq case($ARGV[1])) { - if (-d \"$ARGV[0]/$f\") { - print \"$f/\\n\"; - } - else { - print \"$f\\n\"; - } + if (-d \"$ARGV[0]/$f\") { + print \"$f/\\n\"; + } + else { + print \"$f\\n\"; } } print \"ok\\n\" -' \"$1\" \"$2\" \"$3\" 2>/dev/null" +' \"$1\" 2>/dev/null" "Perl script to produce output suitable for use with `file-name-all-completions' on the remote file system. Escape sequence %s is replaced with name of Perl binary. This string is @@ -987,10 +990,7 @@ of command line.") (directory-files . tramp-handle-directory-files) (directory-files-and-attributes . tramp-sh-handle-directory-files-and-attributes) - ;; `dired-call-process' performed by default handler. (dired-compress-file . tramp-sh-handle-dired-compress-file) - (dired-recursive-delete-directory - . tramp-sh-handle-dired-recursive-delete-directory) (dired-uncache . tramp-handle-dired-uncache) (expand-file-name . tramp-sh-handle-expand-file-name) (file-accessible-directory-p . tramp-handle-file-accessible-directory-p) @@ -1005,6 +1005,7 @@ of command line.") (file-modes . tramp-handle-file-modes) (file-name-all-completions . tramp-sh-handle-file-name-all-completions) (file-name-as-directory . tramp-handle-file-name-as-directory) + (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p) (file-name-completion . tramp-handle-file-name-completion) (file-name-directory . tramp-handle-file-name-directory) (file-name-nondirectory . tramp-handle-file-name-nondirectory) @@ -1026,11 +1027,10 @@ of command line.") ;; `get-file-buffer' performed by default handler. (insert-directory . tramp-sh-handle-insert-directory) (insert-file-contents . tramp-handle-insert-file-contents) - (insert-file-contents-literally - . tramp-sh-handle-insert-file-contents-literally) (load . tramp-handle-load) (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-directory . tramp-sh-handle-make-directory) + (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-symbolic-link . tramp-sh-handle-make-symbolic-link) (process-file . tramp-sh-handle-process-file) (rename-file . tramp-sh-handle-rename-file) @@ -1042,7 +1042,8 @@ of command line.") (shell-command . tramp-handle-shell-command) (start-file-process . tramp-sh-handle-start-file-process) (substitute-in-file-name . tramp-handle-substitute-in-file-name) - (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory) + (temporary-file-directory . tramp-handle-temporary-file-directory) + (unhandled-file-name-directory . ignore) (vc-registered . tramp-sh-handle-vc-registered) (verify-visited-file-modtime . tramp-sh-handle-verify-visited-file-modtime) (write-region . tramp-sh-handle-write-region)) @@ -1123,7 +1124,9 @@ target of the symlink differ." (tramp-make-tramp-file-name method user host (with-tramp-file-property v localname "file-truename" - (let ((result nil)) ; result steps in reverse order + (let ((result nil) ; result steps in reverse order + (quoted (tramp-compat-file-name-quoted-p localname)) + (localname (tramp-compat-file-name-unquote localname))) (tramp-message v 4 "Finding true name for `%s'" filename) (cond ;; Use GNU readlink --canonicalize-missing where available. @@ -1149,10 +1152,8 @@ target of the symlink differ." (format "tramp_perl_file_truename %s" (tramp-shell-quote-argument localname))))) - ;; Do it yourself. We bind `directory-sep-char' here for - ;; XEmacs on Windows, which would otherwise use backslash. - (t (let ((directory-sep-char ?/) - (steps (tramp-compat-split-string localname "/")) + ;; Do it yourself. + (t (let ((steps (split-string localname "/" 'omit)) (thisstep nil) (numchase 0) ;; Don't make the following value larger than @@ -1170,14 +1171,15 @@ target of the symlink differ." (append '("") (reverse result) (list thisstep)) "/")) (setq symlink-target - (nth 0 (file-attributes - (tramp-make-tramp-file-name - method user host - (mapconcat 'identity - (append '("") - (reverse result) - (list thisstep)) - "/"))))) + (tramp-compat-file-attribute-type + (file-attributes + (tramp-make-tramp-file-name + method user host + (mapconcat 'identity + (append '("") + (reverse result) + (list thisstep)) + "/"))))) (cond ((string= "." thisstep) (tramp-message v 5 "Ignoring step `.'")) ((string= ".." thisstep) @@ -1201,9 +1203,8 @@ target of the symlink differ." symlink-target)) (setq symlink-target localname)) (setq steps - (append (tramp-compat-split-string - symlink-target "/") - steps))) + (append + (split-string symlink-target "/" 'omit) steps))) (t ;; It's a file. (setq result (cons thisstep result))))) @@ -1220,6 +1221,7 @@ target of the symlink differ." (when (string= "" result) (setq result "/"))))) + (when quoted (setq result (tramp-compat-file-name-quote result))) (tramp-message v 4 "True name of `%s' is `%s'" localname result) result)))) @@ -1326,8 +1328,10 @@ target of the symlink differ." (setq res-gid (read (current-buffer))) (if (eq id-format 'integer) (progn - (unless (numberp res-uid) (setq res-uid -1)) - (unless (numberp res-gid) (setq res-gid -1))) + (unless (numberp res-uid) + (setq res-uid tramp-unknown-id-integer)) + (unless (numberp res-gid) + (setq res-gid tramp-unknown-id-integer))) (progn (unless (stringp res-uid) (setq res-uid (symbol-name res-uid))) (unless (stringp res-gid) (setq res-gid (symbol-name res-gid))))) @@ -1356,8 +1360,8 @@ target of the symlink differ." res-gid ;; 4. Last access time, as a list of integers. Normally ;; this would be in the same format as `current-time', but - ;; the subseconds part is not currently implemented, and (0 - ;; 0) denotes an unknown time. + ;; the subseconds part is not currently implemented, and + ;; (0 0) denotes an unknown time. ;; 5. Last modification time, likewise. ;; 6. Last status change time, likewise. '(0 0) '(0 0) '(0 0) ;CCC how to find out? @@ -1371,8 +1375,7 @@ target of the symlink differ." ;; 10. Inode number. res-inode ;; 11. Device number. Will be replaced by a virtual device number. - -1 - )))))) + -1)))))) (defun tramp-do-file-attributes-with-perl (vec localname &optional id-format) @@ -1428,9 +1431,9 @@ target of the symlink differ." (let* ((remote-file-name-inhibit-cache t) (attr (file-attributes f)) ;; '(-1 65535) means file doesn't exists yet. - (modtime (or (nth 5 attr) '(-1 65535)))) - (when (boundp 'last-coding-system-used) - (setq coding-system-used (symbol-value 'last-coding-system-used))) + (modtime (or (tramp-compat-file-attribute-modification-time attr) + '(-1 65535)))) + (setq coding-system-used last-coding-system-used) ;; We use '(0 0) as a don't-know value. See also ;; `tramp-do-file-attributes-with-ls'. (if (not (equal modtime '(0 0))) @@ -1444,8 +1447,7 @@ target of the symlink differ." (setq attr (buffer-substring (point) (point-at-eol)))) (tramp-set-file-property v localname "visited-file-modtime-ild" attr)) - (when (boundp 'last-coding-system-used) - (set 'last-coding-system-used coding-system-used)) + (setq last-coding-system-used coding-system-used) nil))))) ;; This function makes the same assumption as @@ -1464,12 +1466,12 @@ of." ;; connection. (if (or (not f) (eq (visited-file-modtime) 0) - (not (tramp-file-name-handler 'file-remote-p f nil 'connected))) + (not (file-remote-p f nil 'connected))) t (with-parsed-tramp-file-name f nil (let* ((remote-file-name-inhibit-cache t) (attr (file-attributes f)) - (modtime (nth 5 attr)) + (modtime (tramp-compat-file-attribute-modification-time attr)) (mt (visited-file-modtime))) (cond @@ -1509,48 +1511,26 @@ of." ;; FIXME: extract the proper text from chmod's stderr. (tramp-barf-unless-okay v - (format "chmod %s %s" - (tramp-compat-decimal-to-octal mode) - (tramp-shell-quote-argument localname)) + (format "chmod %o %s" mode (tramp-shell-quote-argument localname)) "Error while changing file's mode %s" filename))) (defun tramp-sh-handle-set-file-times (filename &optional time) "Like `set-file-times' for Tramp files." - (if (tramp-tramp-file-p filename) - (with-parsed-tramp-file-name filename nil - (when (tramp-get-remote-touch v) - (tramp-flush-file-property v (file-name-directory localname)) - (tramp-flush-file-property v localname) - (let ((time (if (or (null time) (equal time '(0 0))) - (current-time) - time)) - ;; With GNU Emacs, `format-time-string' has an - ;; optional parameter ZONE. This is preferred, - ;; because we could handle the case when the remote - ;; host is located in a different time zone as the - ;; local host. - (utc (not (featurep 'xemacs)))) - (tramp-send-command-and-check - v (format - "%s %s %s %s" - (if utc "env TZ=UTC" "") - (tramp-get-remote-touch v) - (if (tramp-get-connection-property v "touch-t" nil) - (format "-t %s" - (if utc - (format-time-string "%Y%m%d%H%M.%S" time t) - (format-time-string "%Y%m%d%H%M.%S" time))) - "") - (tramp-shell-quote-argument localname)))))) - - ;; We handle also the local part, because in older Emacsen, - ;; without `set-file-times', this function is an alias for this. - ;; We are local, so we don't need the UTC settings. - (zerop - (tramp-call-process - nil "touch" nil nil nil "-t" - (format-time-string "%Y%m%d%H%M.%S" time) - (tramp-shell-quote-argument filename))))) + (with-parsed-tramp-file-name filename nil + (when (tramp-get-remote-touch v) + (tramp-flush-file-property v (file-name-directory localname)) + (tramp-flush-file-property v localname) + (let ((time (if (or (null time) (equal time '(0 0))) + (current-time) + time))) + (tramp-send-command-and-check + v (format + "env TZ=UTC %s %s %s" + (tramp-get-remote-touch v) + (if (tramp-get-connection-property v "touch-t" nil) + (format "-t %s" (format-time-string "%Y%m%d%H%M.%S" time t)) + "") + (tramp-shell-quote-argument localname))))))) (defun tramp-set-file-uid-gid (filename &optional uid gid) "Set the ownership for FILENAME. @@ -1654,8 +1634,7 @@ be non-negative integers." (goto-char (point-max)) (delete-blank-lines) (when (> (point-max) (point-min)) - (tramp-compat-funcall - 'substring-no-properties (buffer-string)))))))) + (substring-no-properties (buffer-string)))))))) (defun tramp-sh-handle-set-file-acl (filename acl-string) "Like `set-file-acl' for Tramp files." @@ -1716,9 +1695,16 @@ be non-negative integers." ;; and obtain the result. (let ((fa1 (file-attributes file1)) (fa2 (file-attributes file2))) - (if (and (not (equal (nth 5 fa1) '(0 0))) - (not (equal (nth 5 fa2) '(0 0)))) - (> 0 (tramp-time-diff (nth 5 fa2) (nth 5 fa1))) + (if (and + (not + (equal (tramp-compat-file-attribute-modification-time fa1) + '(0 0))) + (not + (equal (tramp-compat-file-attribute-modification-time fa2) + '(0 0)))) + (> 0 (tramp-time-diff + (tramp-compat-file-attribute-modification-time fa2) + (tramp-compat-file-attribute-modification-time fa1))) ;; If one of them is the dont-know value, then we can ;; still try to run a shell command on the remote host. ;; However, this only works if both files are Tramp @@ -1770,9 +1756,11 @@ be non-negative integers." ;; information would be lost by an (attempted) delete and create. (or (null attributes) (and - (= (nth 2 attributes) (tramp-get-remote-uid v 'integer)) + (= (tramp-compat-file-attribute-user-id attributes) + (tramp-get-remote-uid v 'integer)) (or (not group) - (= (nth 3 attributes) (tramp-get-remote-gid v 'integer))))))))) + (= (tramp-compat-file-attribute-group-id attributes) + (tramp-get-remote-gid v 'integer))))))))) ;; Directory listings. @@ -1875,142 +1863,62 @@ be non-negative integers." (defun tramp-sh-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." (unless (save-match-data (string-match "/" filename)) - (with-parsed-tramp-file-name (expand-file-name directory) nil + (all-completions + filename + (with-parsed-tramp-file-name (expand-file-name directory) nil + (with-tramp-file-property v localname "file-name-all-completions" + (let (result) + ;; Get a list of directories and files, including reliably + ;; tagging the directories with a trailing "/". Because I + ;; rock. --daniel@danann.net + (tramp-send-command + v + (if (tramp-get-remote-perl v) + (progn + (tramp-maybe-send-script + v tramp-perl-file-name-all-completions + "tramp_perl_file_name_all_completions") + (format "tramp_perl_file_name_all_completions %s" + (tramp-shell-quote-argument localname))) + + (format (concat + "(cd %s 2>&1 && %s -a 2>/dev/null" + " | while IFS= read f; do" + " if %s -d \"$f\" 2>/dev/null;" + " then \\echo \"$f/\"; else \\echo \"$f\"; fi; done" + " && \\echo ok) || \\echo fail") + (tramp-shell-quote-argument localname) + (tramp-get-ls-command v) + (tramp-get-test-command v)))) - (all-completions - filename - (mapcar - 'list - (or - ;; Try cache entries for `filename', `filename' with last - ;; character removed, `filename' with last two characters - ;; removed, ..., and finally the empty string - all - ;; concatenated to the local directory name. - (let ((remote-file-name-inhibit-cache - (or remote-file-name-inhibit-cache - tramp-completion-reread-directory-timeout))) - - ;; This is inefficient for very long file names, pity - ;; `reduce' is not available... - (car - (apply - 'append - (mapcar - (lambda (x) - (let ((cache-hit - (tramp-get-file-property - v - (concat localname (substring filename 0 x)) - "file-name-all-completions" - nil))) - (when cache-hit (list cache-hit)))) - ;; We cannot use a length of 0, because file properties - ;; for "foo" and "foo/" are identical. - (tramp-compat-number-sequence (length filename) 1 -1))))) - - ;; Cache expired or no matching cache entry found so we need - ;; to perform a remote operation. - (let (result) - ;; Get a list of directories and files, including reliably - ;; tagging the directories with a trailing '/'. Because I - ;; rock. --daniel@danann.net - - ;; Changed to perform `cd' in the same remote op and only - ;; get entries starting with `filename'. Capture any `cd' - ;; error messages. Ensure any `cd' and `echo' aliases are - ;; ignored. - (tramp-send-command - v - (if (tramp-get-remote-perl v) - (progn - (tramp-maybe-send-script - v tramp-perl-file-name-all-completions - "tramp_perl_file_name_all_completions") - (format "tramp_perl_file_name_all_completions %s %s %d" - (tramp-shell-quote-argument localname) - (tramp-shell-quote-argument filename) - (if (symbol-value - ;; `read-file-name-completion-ignore-case' - ;; is introduced with Emacs 22.1. - (if (boundp - 'read-file-name-completion-ignore-case) - 'read-file-name-completion-ignore-case - 'completion-ignore-case)) - 1 0))) - - (format (concat - "(cd %s 2>&1 && (%s -a %s 2>/dev/null" - ;; `ls' with wildcard might fail with `Argument - ;; list too long' error in some corner cases; if - ;; `ls' fails after `cd' succeeded, chances are - ;; that's the case, so let's retry without - ;; wildcard. This will return "too many" entries - ;; but that isn't harmful. - " || %s -a 2>/dev/null)" - " | while IFS= read f; do" - " if %s -d \"$f\" 2>/dev/null;" - " then \\echo \"$f/\"; else \\echo \"$f\"; fi; done" - " && \\echo ok) || \\echo fail") - (tramp-shell-quote-argument localname) - (tramp-get-ls-command v) - ;; When `filename' is empty, just `ls' without - ;; `filename' argument is more efficient than `ls *' - ;; for very large directories and might avoid the - ;; `Argument list too long' error. - ;; - ;; With and only with wildcard, we need to add - ;; `-d' to prevent `ls' from descending into - ;; sub-directories. - (if (zerop (length filename)) - "." - (format "-d %s*" (tramp-shell-quote-argument filename))) - (tramp-get-ls-command v) - (tramp-get-test-command v)))) - - ;; Now grab the output. - (with-current-buffer (tramp-get-buffer v) - (goto-char (point-max)) - - ;; Check result code, found in last line of output. - (forward-line -1) - (if (looking-at "^fail$") - (progn - ;; Grab error message from line before last line - ;; (it was put there by `cd 2>&1'). - (forward-line -1) - (tramp-error - v 'file-error - "tramp-sh-handle-file-name-all-completions: %s" - (buffer-substring (point) (point-at-eol)))) - ;; For peace of mind, if buffer doesn't end in `fail' - ;; then it should end in `ok'. If neither are in the - ;; buffer something went seriously wrong on the remote - ;; side. - (unless (looking-at "^ok$") - (tramp-error - v 'file-error - "\ + ;; Now grab the output. + (with-current-buffer (tramp-get-buffer v) + (goto-char (point-max)) + + ;; Check result code, found in last line of output. + (forward-line -1) + (if (looking-at "^fail$") + (progn + ;; Grab error message from line before last line + ;; (it was put there by `cd 2>&1'). + (forward-line -1) + (tramp-error + v 'file-error + "tramp-sh-handle-file-name-all-completions: %s" + (buffer-substring (point) (point-at-eol)))) + ;; For peace of mind, if buffer doesn't end in `fail' + ;; then it should end in `ok'. If neither are in the + ;; buffer something went seriously wrong on the remote + ;; side. + (unless (looking-at "^ok$") + (tramp-error + v 'file-error "\ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" - (tramp-shell-quote-argument localname) (buffer-string)))) + (tramp-shell-quote-argument localname) (buffer-string)))) - (while (zerop (forward-line -1)) - (push (buffer-substring (point) (point-at-eol)) result))) - - ;; Because the remote op went through OK we know the - ;; directory we `cd'-ed to exists. - (tramp-set-file-property v localname "file-exists-p" t) - - ;; Because the remote op went through OK we know every - ;; file listed by `ls' exists. - (mapc (lambda (entry) - (tramp-set-file-property - v (concat localname entry) "file-exists-p" t)) - result) - - ;; Store result in the cache. - (tramp-set-file-property - v (concat localname filename) - "file-name-all-completions" result)))))))) + (while (zerop (forward-line -1)) + (push (buffer-substring (point) (point-at-eol)) result))) + result)))))) ;; cp, mv and ln @@ -2034,7 +1942,8 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" "File %s already exists; make it a new name anyway? " newname))) (tramp-error - v2 'file-error "add-name-to-file: file %s already exists" newname)) + v2 'file-already-exists + "add-name-to-file: file %s already exists" newname)) (when ok-if-already-exists (setq ln (concat ln " -f"))) (tramp-flush-file-property v2 (file-name-directory v2-localname)) (tramp-flush-file-property v2 v2-localname) @@ -2048,7 +1957,7 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" (defun tramp-sh-handle-copy-file (filename newname &optional ok-if-already-exists keep-date - preserve-uid-gid preserve-extended-attributes) + preserve-uid-gid preserve-extended-attributes) "Like `copy-file' for Tramp files." (setq filename (expand-file-name filename)) (setq newname (expand-file-name newname)) @@ -2059,19 +1968,18 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" (tramp-do-copy-or-rename-file 'copy filename newname ok-if-already-exists keep-date preserve-uid-gid preserve-extended-attributes)) - ;; Compat section. + ;; Compat section. PRESERVE-EXTENDED-ATTRIBUTES has been + ;; introduced with Emacs 24.1 (as PRESERVE-SELINUX-CONTEXT), and + ;; renamed in Emacs 24.3. (preserve-extended-attributes (tramp-run-real-handler 'copy-file (list filename newname ok-if-already-exists keep-date preserve-uid-gid preserve-extended-attributes))) - (preserve-uid-gid - (tramp-run-real-handler - 'copy-file - (list filename newname ok-if-already-exists keep-date preserve-uid-gid))) (t (tramp-run-real-handler - 'copy-file (list filename newname ok-if-already-exists keep-date))))) + 'copy-file + (list filename newname ok-if-already-exists keep-date preserve-uid-gid))))) (defun tramp-sh-handle-copy-directory (dirname newname &optional keep-date parents copy-contents) @@ -2126,13 +2034,14 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" (if (or (tramp-tramp-file-p filename) (tramp-tramp-file-p newname)) (tramp-do-copy-or-rename-file - 'rename filename newname ok-if-already-exists t t) + 'rename filename newname ok-if-already-exists + 'keep-time 'preserve-uid-gid) (tramp-run-real-handler 'rename-file (list filename newname ok-if-already-exists)))) (defun tramp-do-copy-or-rename-file (op filename newname &optional ok-if-already-exists keep-date - preserve-uid-gid preserve-extended-attributes) + preserve-uid-gid preserve-extended-attributes) "Copy or rename a remote file. OP must be `copy' or `rename' and indicates the operation to perform. FILENAME specifies the file to copy or rename, NEWNAME is the name of @@ -2151,7 +2060,8 @@ file names." (error "Unknown operation `%s', must be `copy' or `rename'" op)) (let ((t1 (tramp-tramp-file-p filename)) (t2 (tramp-tramp-file-p newname)) - (length (nth 7 (file-attributes (file-truename filename)))) + (length (tramp-compat-file-attribute-size + (file-attributes (file-truename filename)))) (attributes (and preserve-extended-attributes (apply 'file-extended-attributes (list filename))))) @@ -2262,7 +2172,11 @@ KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME." (set-buffer-multibyte nil) (insert-file-contents-literally filename))) ;; KEEP-DATE handling. - (when keep-date (set-file-times newname (nth 5 (file-attributes filename)))) + (when keep-date + (set-file-times + newname + (tramp-compat-file-attribute-modification-time + (file-attributes filename)))) ;; Set the mode. (set-file-modes newname (tramp-default-file-modes filename)) ;; If the operation was `rename', delete the original file. @@ -2280,7 +2194,8 @@ as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep the uid and gid from FILENAME." (let ((t1 (tramp-tramp-file-p filename)) (t2 (tramp-tramp-file-p newname)) - (file-times (nth 5 (file-attributes filename))) + (file-times (tramp-compat-file-attribute-modification-time + (file-attributes filename))) (file-modes (tramp-default-file-modes filename))) (with-parsed-tramp-file-name (if t1 filename newname) nil (let* ((cmd (cond ((and (eq op 'copy) preserve-uid-gid) "cp -f -p") @@ -2290,14 +2205,8 @@ the uid and gid from FILENAME." v 'file-error "Unknown operation `%s', must be `copy' or `rename'" op)))) - (localname1 - (if t1 - (tramp-file-name-handler 'file-remote-p filename 'localname) - filename)) - (localname2 - (if t2 - (tramp-file-name-handler 'file-remote-p newname 'localname) - newname)) + (localname1 (if t1 (file-remote-p filename 'localname) filename)) + (localname2 (if t2 (file-remote-p newname 'localname) newname)) (prefix (file-remote-p (if t1 filename newname))) cmd-result) @@ -2334,12 +2243,12 @@ the uid and gid from FILENAME." (zerop (logand (file-modes (file-name-directory localname1)) - (tramp-compat-octal-to-decimal "1000")))) + (string-to-number "1000" 8)))) (file-writable-p (file-name-directory localname2)) (or (file-directory-p localname2) (file-writable-p localname2)))) (if (eq op 'copy) - (tramp-compat-copy-file + (copy-file localname1 localname2 ok-if-already-exists keep-date preserve-uid-gid) (tramp-run-real-handler @@ -2379,25 +2288,21 @@ the uid and gid from FILENAME." ;; Since this does not work reliable, we also ;; give read permissions. (set-file-modes - (concat prefix tmpfile) - (tramp-compat-octal-to-decimal "0777")) + (concat prefix tmpfile) (string-to-number "0777" 8)) (tramp-set-file-uid-gid (concat prefix tmpfile) (tramp-get-local-uid 'integer) (tramp-get-local-gid 'integer))) (t2 (if (eq op 'copy) - (tramp-compat-copy-file - localname1 tmpfile t - keep-date preserve-uid-gid) + (copy-file + localname1 tmpfile t keep-date preserve-uid-gid) (tramp-run-real-handler - 'rename-file - (list localname1 tmpfile t))) + 'rename-file (list localname1 tmpfile t))) ;; We must change the ownership as local user. ;; Since this does not work reliable, we also ;; give read permissions. - (set-file-modes - tmpfile (tramp-compat-octal-to-decimal "0777")) + (set-file-modes tmpfile (string-to-number "0777" 8)) (tramp-set-file-uid-gid tmpfile (tramp-get-remote-uid v 'integer) @@ -2456,7 +2361,7 @@ The method used must be an out-of-band method." ;; Save exit. (ignore-errors (if dir-flag - (tramp-compat-delete-directory + (delete-directory (expand-file-name ".." tmpfile) 'recursive) (delete-file tmpfile))))) @@ -2468,35 +2373,22 @@ The method used must be an out-of-band method." v "login-as" nil)) tramp-current-host (tramp-file-name-real-host v)) - ;; Expand hops. Might be necessary for gateway methods. - (setq v (car (tramp-compute-multi-hops v))) - (aset v 3 localname) - ;; Check which ones of source and target are Tramp files. - (setq source (if t1 - (tramp-make-copy-program-file-name v) - (shell-quote-argument filename)) - target (if t2 - (tramp-make-copy-program-file-name v) - (shell-quote-argument - (funcall + (setq source (funcall (if (and (file-directory-p filename) - (string-equal - (file-name-nondirectory filename) - (file-name-nondirectory newname))) - 'file-name-directory + (not (file-exists-p newname))) + 'file-name-as-directory 'identity) - newname)))) - - ;; Check for host and port number. We cannot use - ;; `tramp-file-name-port', because this returns also - ;; `tramp-default-port', which might clash with settings in - ;; "~/.ssh/config". - (setq host (tramp-file-name-host v) - port "") - (when (string-match tramp-host-with-port-regexp host) - (setq port (string-to-number (match-string 2 host)) - host (string-to-number (match-string 1 host)))) + (if t1 + (tramp-make-copy-program-file-name v) + (tramp-unquote-shell-quote-argument filename))) + target (if t2 + (tramp-make-copy-program-file-name v) + (tramp-unquote-shell-quote-argument newname))) + + ;; Check for host and port number. + (setq host (tramp-file-name-real-host v) + port (tramp-file-name-port v)) ;; Check for user. There might be an interactive setting. (setq user (or (tramp-file-name-user v) @@ -2615,43 +2507,26 @@ The method used must be an out-of-band method." ;; Use an asynchronous process. By this, password can ;; be handled. We don't set a timeout, because the - ;; copying of large files can last longer than 60 - ;; secs. - (let ((p (apply 'start-process-shell-command - (tramp-get-connection-name v) - (tramp-get-connection-buffer v) - copy-program - (append - copy-args - (list "&&" "echo" "tramp_exit_status" "0" - "||" "echo" "tramp_exit_status" "1"))))) - (tramp-message - orig-vec 6 "%s" - (mapconcat 'identity (process-command p) " ")) + ;; copying of large files can last longer than 60 secs. + (let* ((command + (mapconcat + 'identity (append (list copy-program) copy-args) + " ")) + (p (let ((default-directory + (tramp-compat-temporary-file-directory))) + (start-process-shell-command + (tramp-get-connection-name v) + (tramp-get-connection-buffer v) + command)))) + (tramp-message orig-vec 6 "%s" command) (tramp-set-connection-property p "vector" orig-vec) - (tramp-compat-set-process-query-on-exit-flag p nil) + (set-process-query-on-exit-flag p nil) ;; We must adapt `tramp-local-end-of-line' for ;; sending the password. (let ((tramp-local-end-of-line tramp-rsh-end-of-line)) (tramp-process-actions - p v nil tramp-actions-copy-out-of-band)) - - ;; Check the return code. - (goto-char (point-max)) - (unless - (re-search-backward "tramp_exit_status [0-9]+" nil t) - (tramp-error - orig-vec 'file-error - "Couldn't find exit status of `%s'" - (mapconcat 'identity (process-command p) " "))) - (skip-chars-forward "^ ") - (unless (zerop (read (current-buffer))) - (forward-line -1) - (tramp-error - orig-vec 'file-error - "Error copying: `%s'" - (buffer-substring (point-min) (point-at-eol)))))) + p v nil tramp-actions-copy-out-of-band)))) ;; Reset the transfer process properties. (tramp-set-connection-property v "process-name" nil) @@ -2666,7 +2541,10 @@ The method used must be an out-of-band method." ;; Handle KEEP-DATE argument. (when (and keep-date (not copy-keep-date)) - (set-file-times newname (nth 5 (file-attributes filename)))) + (set-file-times + newname + (tramp-compat-file-attribute-modification-time + (file-attributes filename)))) ;; Set the mode. (unless (and keep-date copy-keep-date) @@ -2677,7 +2555,7 @@ The method used must be an out-of-band method." (unless (eq op 'copy) (if (file-regular-p filename) (delete-file filename) - (tramp-compat-delete-directory filename 'recursive)))))) + (delete-directory filename 'recursive)))))) (defun tramp-sh-handle-make-directory (dir &optional parents) "Like `make-directory' for Tramp files." @@ -2717,51 +2595,16 @@ The method used must be an out-of-band method." ;; Dired. -;; CCC: This does not seem to be enough. Something dies when -;; we try and delete two directories under Tramp :/ -(defun tramp-sh-handle-dired-recursive-delete-directory (filename) - "Recursively delete the directory given. -This is like `dired-recursive-delete-directory' for Tramp files." - (with-parsed-tramp-file-name filename nil - ;; Run a shell command 'rm -r <localname>'. - ;; Code shamelessly stolen from the dired implementation and, um, hacked :) - (unless (file-exists-p filename) - (tramp-error v 'file-error "No such directory: %s" filename)) - ;; Which is better, -r or -R? (-r works for me <daniel@danann.net>). - (tramp-send-command - v - (format "rm -rf %s" (tramp-shell-quote-argument localname)) - ;; Don't read the output, do it explicitly. - nil t) - ;; Wait for the remote system to return to us... - ;; This might take a while, allow it plenty of time. - (tramp-wait-for-output (tramp-get-connection-process v) 120) - ;; Make sure that it worked... - (tramp-flush-file-property v (file-name-directory localname)) - (tramp-flush-directory-property v localname) - (and (file-exists-p filename) - (tramp-error - v 'file-error "Failed to recursively delete %s" filename)))) +(defvar dired-compress-file-suffixes) +(declare-function dired-remove-file "dired-aux") -(defun tramp-sh-handle-dired-compress-file (file &rest _ok-flag) +(defun tramp-sh-handle-dired-compress-file (file) "Like `dired-compress-file' for Tramp files." - ;; OK-FLAG is valid for XEmacs only, but not implemented. ;; Code stolen mainly from dired-aux.el. (with-parsed-tramp-file-name file nil (tramp-flush-file-property v localname) (save-excursion - (let ((suffixes - (if (not (featurep 'xemacs)) - ;; Emacs case - (symbol-value 'dired-compress-file-suffixes) - ;; XEmacs has `dired-compression-method-alist', which is - ;; transformed into `dired-compress-file-suffixes' structure. - (mapcar - (lambda (x) - (list (concat (regexp-quote (nth 1 x)) "\\'") - nil - (mapconcat 'identity (nth 3 x) " "))) - (symbol-value 'dired-compression-method-alist)))) + (let ((suffixes dired-compress-file-suffixes) suffix) ;; See if any suffix rule matches this file name. (while suffixes @@ -2779,8 +2622,7 @@ This is like `dired-recursive-delete-directory' for Tramp files." (when (tramp-send-command-and-check v (concat (nth 2 suffix) " " (tramp-shell-quote-argument localname))) - ;; `dired-remove-file' is not defined in XEmacs. - (tramp-compat-funcall 'dired-remove-file file) + (dired-remove-file file) (string-match (car suffix) file) (concat (substring file 0 (match-beginning 0)))))) (t @@ -2790,8 +2632,7 @@ This is like `dired-recursive-delete-directory' for Tramp files." (when (tramp-send-command-and-check v (concat "gzip -f " (tramp-shell-quote-argument localname))) - ;; `dired-remove-file' is not defined in XEmacs. - (tramp-compat-funcall 'dired-remove-file file) + (dired-remove-file file) (cond ((file-exists-p (concat file ".gz")) (concat file ".gz")) ((file-exists-p (concat file ".z")) @@ -2810,6 +2651,8 @@ This is like `dired-recursive-delete-directory' for Tramp files." filename switches wildcard full-directory-p) (when (stringp switches) (setq switches (split-string switches))) + (when (tramp-get-ls-command-with-quoting-style v) + (setq switches (append switches '("--quoting-style=literal")))) (when (and (member "--dired" switches) (not (tramp-get-ls-command-with-dired v))) (setq switches (delete "--dired" switches))) @@ -2895,15 +2738,14 @@ This is like `dired-recursive-delete-directory' for Tramp files." (unless (string-match "color" (tramp-get-connection-property v "ls" "")) (goto-char beg) - (while (re-search-forward tramp-color-escape-sequence-regexp nil t) + (while + (re-search-forward tramp-display-escape-sequence-regexp nil t) (replace-match ""))) ;; Decode the output, it could be multibyte. (decode-coding-region beg (point-max) - (or file-name-coding-system - (and (boundp 'default-file-name-coding-system) - (symbol-value 'default-file-name-coding-system)))) + (or file-name-coding-system default-file-name-coding-system)) ;; The inserted file could be from somewhere else. (when (and (not wildcard) (not full-directory-p)) @@ -2930,7 +2772,7 @@ the result will be a local, non-Tramp, file name." ;; Unless NAME is absolute, concat DIR and NAME. (unless (file-name-absolute-p name) (setq name (concat (file-name-as-directory dir) name))) - ;; If NAME is not a Tramp file, run the real handler. + ;; If connection is not established yet, run the real handler. (if (not (tramp-connectable-p name)) (tramp-run-real-handler 'expand-file-name (list name nil)) ;; Dissect NAME. @@ -2966,13 +2808,10 @@ the result will be a local, non-Tramp, file name." (while (string-match "//" localname) (setq localname (replace-match "/" t t localname))) ;; No tilde characters in file name, do normal - ;; `expand-file-name' (this does "/./" and "/../"). We bind - ;; `directory-sep-char' here for XEmacs on Windows, which would - ;; otherwise use backslash. `default-directory' is bound, - ;; because on Windows there would be problems with UNC shares or - ;; Cygwin mounts. - (let ((directory-sep-char ?/) - (default-directory (tramp-compat-temporary-file-directory))) + ;; `expand-file-name' (this does "/./" and "/../"). + ;; `default-directory' is bound, because on Windows there would + ;; be problems with UNC shares or Cygwin mounts. + (let ((default-directory (tramp-compat-temporary-file-directory))) (tramp-make-tramp-file-name method user host (tramp-drop-volume-letter @@ -2984,7 +2823,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) @@ -2997,7 +2836,12 @@ the result will be a local, non-Tramp, file name." (defun tramp-sh-handle-start-file-process (name buffer program &rest args) "Like `start-file-process' for Tramp files." (with-parsed-tramp-file-name (expand-file-name default-directory) nil - (let* (;; When PROGRAM matches "*sh", and the first arg is "-c", + (let* ((buffer + (if buffer + (get-buffer-create buffer) + ;; BUFFER can be nil. We use a temporary buffer. + (generate-new-buffer tramp-temp-buffer-name))) + ;; When PROGRAM matches "*sh", and the first arg is "-c", ;; it might be that the arguments exceed the command line ;; length. Therefore, we modify the command. (heredoc (and (stringp program) @@ -3060,9 +2904,6 @@ the result will be a local, non-Tramp, file name." ;; `eshell' and friends. (tramp-current-connection nil)) - (unless buffer - ;; BUFFER can be nil. We use a temporary buffer. - (setq buffer (generate-new-buffer tramp-temp-buffer-name))) (while (get-process name1) ;; NAME must be unique as process name. (setq i (1+ i) @@ -3099,7 +2940,7 @@ the result will be a local, non-Tramp, file name." ;; Send the command. (tramp-send-command v command nil t) ; nooutput ;; Check, whether a pty is associated. - (unless (tramp-compat-process-get + (unless (process-get (tramp-get-connection-process v) 'remote-tty) (tramp-error v 'file-error @@ -3109,7 +2950,7 @@ the result will be a local, non-Tramp, file name." ;; process. We ignore errors, because the process ;; could have finished already. (ignore-errors - (tramp-compat-set-process-query-on-exit-flag p t) + (set-process-query-on-exit-flag p t) (set-marker (process-mark p) (point))) ;; Return process. p)))) @@ -3241,12 +3082,7 @@ the result will be a local, non-Tramp, file name." ;; because the remote process could have changed them. (when tmpinput (delete-file tmpinput)) - ;; `process-file-side-effects' has been introduced with GNU - ;; Emacs 23.2. If set to nil, no remote file will be changed - ;; by `program'. If it doesn't exist, we assume its default - ;; value t. - (unless (and (boundp 'process-file-side-effects) - (not (symbol-value 'process-file-side-effects))) + (unless process-file-side-effects (tramp-flush-directory-property v "")) ;; Return exit status. @@ -3259,10 +3095,11 @@ the result will be a local, non-Tramp, file name." (with-parsed-tramp-file-name filename nil (unless (file-exists-p filename) (tramp-error - v 'file-error + v tramp-file-missing "Cannot make local copy of non-existing file `%s'" filename)) - (let* ((size (nth 7 (file-attributes (file-truename filename)))) + (let* ((size (tramp-compat-file-attribute-size + (file-attributes (file-truename filename)))) (rem-enc (tramp-get-inline-coding v "remote-encoding" size)) (loc-dec (tramp-get-inline-coding v "local-decoding" size)) (tmpfile (tramp-compat-make-temp-file filename))) @@ -3272,7 +3109,7 @@ the result will be a local, non-Tramp, file name." ;; `copy-file' handles direct copy and out-of-band methods. ((or (tramp-local-host-p v) (tramp-method-out-of-band-p v size)) - (copy-file filename tmpfile t t)) + (copy-file filename tmpfile 'ok-if-already-exists 'keep-time)) ;; Use inline encoding for file transfer. (rem-enc @@ -3333,30 +3170,6 @@ the result will be a local, non-Tramp, file name." (run-hooks 'tramp-handle-file-local-copy-hook) tmpfile))) -;; This is needed for XEmacs only. Code stolen from files.el. -(defun tramp-sh-handle-insert-file-contents-literally - (filename &optional visit beg end replace) - "Like `insert-file-contents-literally' for Tramp files." - (let ((format-alist nil) - (after-insert-file-functions nil) - (coding-system-for-read 'no-conversion) - (coding-system-for-write 'no-conversion) - (find-buffer-file-type-function - (if (fboundp 'find-buffer-file-type) - (symbol-function 'find-buffer-file-type) - nil)) - (inhibit-file-name-handlers - '(epa-file-handler image-file-handler jka-compr-handler)) - (inhibit-file-name-operation 'insert-file-contents)) - (unwind-protect - (progn - (fset 'find-buffer-file-type (lambda (_filename) t)) - (insert-file-contents filename visit beg end replace)) - ;; Save exit. - (if find-buffer-file-type-function - (fset 'find-buffer-file-type find-buffer-file-type-function) - (fmakunbound 'find-buffer-file-type))))) - ;; CCC grok LOCKNAME (defun tramp-sh-handle-write-region (start end filename &optional append visit lockname confirm) @@ -3373,14 +3186,15 @@ the result will be a local, non-Tramp, file name." ;; (error ;; "tramp-sh-handle-write-region: LOCKNAME must be nil or equal FILENAME")) - ;; XEmacs takes a coding system as the seventh argument, not `confirm'. - (when (and (not (featurep 'xemacs)) confirm (file-exists-p filename)) + (when (and confirm (file-exists-p filename)) (unless (y-or-n-p (format "File %s exists; overwrite anyway? " filename)) (tramp-error v 'file-error "File not overwritten"))) - (let ((uid (or (nth 2 (tramp-compat-file-attributes filename 'integer)) + (let ((uid (or (tramp-compat-file-attribute-user-id + (file-attributes filename 'integer)) (tramp-get-remote-uid v 'integer))) - (gid (or (nth 3 (tramp-compat-file-attributes filename 'integer)) + (gid (or (tramp-compat-file-attribute-group-id + (file-attributes filename 'integer)) (tramp-get-remote-gid v 'integer)))) (if (and (tramp-local-host-p v) @@ -3438,9 +3252,7 @@ the result will be a local, non-Tramp, file name." (signal (car err) (cdr err)))) ;; Now, `last-coding-system-used' has the right value. Remember it. - (when (boundp 'last-coding-system-used) - (setq coding-system-used - (symbol-value 'last-coding-system-used)))) + (setq coding-system-used last-coding-system-used)) ;; The permissions of the temporary file should be set. If ;; FILENAME does not exist (eq modes nil) it has been @@ -3450,7 +3262,7 @@ the result will be a local, non-Tramp, file name." (when modes (set-file-modes tmpfile - (logior (or modes 0) (tramp-compat-octal-to-decimal "0400")))) + (logior (or modes 0) (string-to-number "0400" 8)))) ;; This is a bit lengthy due to the different methods ;; possible for file transfer. First, we check whether the @@ -3459,7 +3271,8 @@ the result will be a local, non-Tramp, file name." ;; specified. However, if the method _also_ specifies an ;; encoding function, then that is used for encoding the ;; contents of the tmp file. - (let* ((size (nth 7 (file-attributes tmpfile))) + (let* ((size (tramp-compat-file-attribute-size + (file-attributes tmpfile))) (rem-dec (tramp-get-inline-coding v "remote-decoding" size)) (loc-enc (tramp-get-inline-coding v "local-encoding" size))) (cond @@ -3590,14 +3403,14 @@ the result will be a local, non-Tramp, file name." (let (last-coding-system-used (need-chown t)) ;; Set file modification time. (when (or (eq visit t) (stringp visit)) - (let ((file-attr (tramp-compat-file-attributes filename 'integer))) + (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 ;; `file-precious-flag' is set. - (nth 5 file-attr)) - (when (and (= (nth 2 file-attr) uid) - (= (nth 3 file-attr) gid)) + (tramp-compat-file-attribute-modification-time file-attr)) + (when (and (= (tramp-compat-file-attribute-user-id file-attr) uid) + (= (tramp-compat-file-attribute-group-id file-attr) gid)) (setq need-chown nil)))) ;; Set the ownership. @@ -3625,7 +3438,7 @@ the result will be a local, non-Tramp, file name." ;; any other remote command. (defun tramp-sh-handle-vc-registered (file) "Like `vc-registered' for Tramp files." - (tramp-compat-with-temp-message "" + (with-temp-message "" (with-parsed-tramp-file-name file nil (with-tramp-progress-reporter v 3 (format-message "Checking `vc-registered' for %s" file) @@ -3782,7 +3595,12 @@ Fall back to normal file name handler if no Tramp handler exists." (concat "create,modify,move,moved_from,moved_to,move_self," "delete,delete_self,ignored")) ((memq 'attribute-change flags) "attrib,ignored")) - sequence `(,command "-mq" "-e" ,events ,localname))) + sequence `(,command "-mq" "-e" ,events ,localname) + ;; Make events a list of symbols. + events + (mapcar + (lambda (x) (intern-soft (replace-regexp-in-string "_" "-" x))) + (split-string events "," 'omit)))) ;; None. (t (tramp-error v 'file-notify-error @@ -3803,15 +3621,15 @@ Fall back to normal file name handler if no Tramp handler exists." (mapconcat 'identity sequence " ")) (tramp-message v 6 "Run `%s', %S" (mapconcat 'identity sequence " ") p) (tramp-set-connection-property p "vector" v) - ;; Needed for `tramp-sh-gvfs-monitor-dir-process-filter'. - (tramp-compat-process-put p 'events events) - (tramp-compat-process-put p 'watch-name localname) - (tramp-compat-set-process-query-on-exit-flag p nil) + ;; Needed for process filter. + (process-put p 'events events) + (process-put p 'watch-name localname) + (set-process-query-on-exit-flag p nil) (set-process-filter p filter) ;; 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)))) @@ -3819,16 +3637,17 @@ Fall back to normal file name handler if no Tramp handler exists." (defun tramp-sh-gvfs-monitor-dir-process-filter (proc string) "Read output from \"gvfs-monitor-dir\" and add corresponding \ file-notify events." - (let ((remote-prefix + (let ((events (process-get proc 'events)) + (remote-prefix (with-current-buffer (process-buffer proc) (file-remote-p default-directory))) - (rest-string (tramp-compat-process-get proc 'rest-string))) + (rest-string (process-get proc 'rest-string))) (when rest-string (tramp-message proc 10 "Previous string:\n%s" rest-string)) (tramp-message proc 6 "%S\n%s" proc string) (setq string (concat rest-string string) ;; Attribute change is returned in unused wording. - string (tramp-compat-replace-regexp-in-string + string (replace-regexp-in-string "ATTRIB CHANGED" "ATTRIBUTE_CHANGED" string)) (when (string-match "Monitoring not supported" string) (delete-process proc)) @@ -3845,59 +3664,65 @@ file-notify events." (object (list proc - (intern-soft - (tramp-compat-replace-regexp-in-string - "_" "-" (downcase (match-string 4 string)))) + (list + (intern-soft + (replace-regexp-in-string + "_" "-" (downcase (match-string 4 string))))) ;; File names are returned as absolute paths. We must ;; add the remote prefix. (concat remote-prefix file) (when file1 (concat remote-prefix file1))))) (setq string (replace-match "" nil nil string)) ;; Remove watch when file or directory to be watched is deleted. - (when (and (member (cadr object) '(moved deleted)) - (string-equal - file (tramp-compat-process-get proc 'watch-name))) + (when (and (member (caadr object) '(moved deleted)) + (string-equal file (process-get proc 'watch-name))) (delete-process proc)) ;; Usually, we would add an Emacs event now. Unfortunately, ;; `unread-command-events' does not accept several events at - ;; once. Therefore, we apply the callback directly. - (when (member (cadr object) (tramp-compat-process-get proc 'events)) - (tramp-compat-funcall 'file-notify-callback object)))) + ;; once. Therefore, we apply the handler directly. + (when (member (caadr object) events) + (tramp-compat-funcall + 'file-notify-handle-event + `(file-notify ,object file-notify-callback))))) ;; Save rest of the string. (when (zerop (length string)) (setq string nil)) (when string (tramp-message proc 10 "Rest string:\n%s" string)) - (tramp-compat-process-put proc 'rest-string string))) + (process-put proc 'rest-string string))) (defun tramp-sh-inotifywait-process-filter (proc string) "Read output from \"inotifywait\" and add corresponding file-notify events." - (tramp-message proc 6 "%S\n%s" proc string) - (dolist (line (split-string string "[\n\r]+" 'omit-nulls)) - ;; Check, whether there is a problem. - (unless - (string-match - (concat "^[^[:blank:]]+" - "[[:blank:]]+\\([^[:blank:]]+\\)+" - "\\([[:blank:]]+\\([^\n\r]+\\)\\)?") - line) - (tramp-error proc 'file-notify-error "%s" line)) - - (let ((object - (list - proc - (mapcar - (lambda (x) - (intern-soft - (tramp-compat-replace-regexp-in-string "_" "-" (downcase x)))) - (split-string (match-string 1 line) "," 'omit-nulls)) - (match-string 3 line)))) - ;; Remove watch when file or directory to be watched is deleted. - (when (equal (cadr object) 'ignored) - (delete-process proc)) - ;; Usually, we would add an Emacs event now. Unfortunately, - ;; `unread-command-events' does not accept several events at - ;; once. Therefore, we apply the callback directly. - (tramp-compat-funcall 'file-notify-callback object)))) + (let ((events (process-get proc 'events))) + (tramp-message proc 6 "%S\n%s" proc string) + (dolist (line (split-string string "[\n\r]+" 'omit)) + ;; Check, whether there is a problem. + (unless + (string-match + (concat "^[^[:blank:]]+" + "[[:blank:]]+\\([^[:blank:]]+\\)+" + "\\([[:blank:]]+\\([^\n\r]+\\)\\)?") + line) + (tramp-error proc 'file-notify-error "%s" line)) + + (let ((object + (list + proc + (mapcar + (lambda (x) + (intern-soft + (replace-regexp-in-string "_" "-" (downcase x)))) + (split-string (match-string 1 line) "," 'omit)) + (match-string 3 line)))) + ;; Remove watch when file or directory to be watched is deleted. + (when (member (caadr object) '(move-self delete-self ignored)) + (delete-process proc)) + ;; Usually, we would add an Emacs event now. Unfortunately, + ;; `unread-command-events' does not accept several events at + ;; once. Therefore, we apply the handler directly. + (when (member (caadr object) events) + (tramp-compat-funcall + 'file-notify-handle-event + `(file-notify ,object file-notify-callback))))))) ;;; Internal Functions: @@ -3913,7 +3738,7 @@ Only send the definition if it has not already been done." vec 5 (format-message "Sending script `%s'" name) ;; In bash, leading TABs like in `tramp-vc-registered-read-file-names' ;; could result in unwanted command expansion. Avoid this. - (setq script (tramp-compat-replace-regexp-in-string + (setq script (replace-regexp-in-string (make-string 1 ?\t) (make-string 8 ? ) script)) ;; The script could contain a call of Perl. This is masked with `%s'. (when (and (string-match "%s" script) @@ -3986,8 +3811,7 @@ This function expects to be in the right *tramp* buffer." (setq result (concat "\\" progname)))) (unless result (when ignore-tilde - ;; Remove all ~/foo directories from dirlist. In XEmacs, - ;; `remove' is in CL, and we want to avoid CL dependencies. + ;; Remove all ~/foo directories from dirlist. (let (newdl d) (while dirlist (setq d (car dirlist)) @@ -4107,7 +3931,8 @@ file exists and nonzero exit status otherwise." ;; $HISTFILE is set according to `tramp-histfile-override'. (tramp-send-command vec (format - "exec env ENV='' %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s" + "exec env ENV=%s %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s" + (or (getenv-internal "ENV" tramp-remote-process-environment) "") (if (stringp tramp-histfile-override) (format "HISTFILE=%s" (tramp-shell-quote-argument tramp-histfile-override)) @@ -4139,7 +3964,7 @@ file exists and nonzero exit status otherwise." shell) (setq shell (with-tramp-connection-property vec "remote-shell" - ;; CCC: "root" does not exist always, see QNAP 459. + ;; CCC: "root" does not exist always, see my QNAP TS-459. ;; Which check could we apply instead? (tramp-send-command vec "echo ~root" t) (if (or (string-match "^~root$" (buffer-string)) @@ -4243,41 +4068,32 @@ process to set up. VEC specifies the connection." ;; CCC this can't be the right way to do it. Hm. (tramp-message vec 5 "Determining coding system") (with-current-buffer (process-buffer proc) - (if (featurep 'mule) - ;; Use MULE to select the right EOL convention for - ;; communicating with the process. - (let ((cs (or (and (memq 'utf-8 (coding-system-list)) - (string-match "utf-?8" (tramp-get-remote-locale vec)) - (cons 'utf-8 'utf-8)) - (tramp-compat-funcall 'process-coding-system proc) - (cons 'undecided 'undecided))) - cs-decode cs-encode) - (when (symbolp cs) (setq cs (cons cs cs))) - (setq cs-decode (or (car cs) 'undecided) - cs-encode (or (cdr cs) 'undecided)) - (setq cs-encode - (tramp-compat-coding-system-change-eol-conversion - cs-encode (if (string-match "^Darwin" uname) 'mac 'unix))) - (tramp-send-command vec "echo foo ; echo bar" t) - (goto-char (point-min)) - (when (search-forward "\r" nil t) - (setq cs-decode (tramp-compat-coding-system-change-eol-conversion - cs-decode 'dos))) - ;; Special setting for macOS. - (when (and (string-match "^Darwin" uname) - (memq 'utf-8-hfs (coding-system-list))) - (setq cs-decode 'utf-8-hfs - cs-encode 'utf-8-hfs)) - (tramp-compat-funcall - 'set-buffer-process-coding-system cs-decode cs-encode) - (tramp-message - vec 5 "Setting coding system to `%s' and `%s'" cs-decode cs-encode)) - ;; Look for ^M and do something useful if found. - (when (search-forward "\r" nil t) - ;; We have found a ^M but cannot frob the process coding - ;; system because we're running on a non-MULE Emacs. Let's - ;; try stty, instead. - (tramp-send-command vec "stty -onlcr" t)))) + ;; Use MULE to select the right EOL convention for communicating + ;; with the process. + (let ((cs (or (and (memq 'utf-8 (coding-system-list)) + (string-match "utf-?8" (tramp-get-remote-locale vec)) + (cons 'utf-8 'utf-8)) + (process-coding-system proc) + (cons 'undecided 'undecided))) + cs-decode cs-encode) + (when (symbolp cs) (setq cs (cons cs cs))) + (setq cs-decode (or (car cs) 'undecided) + cs-encode (or (cdr cs) 'undecided) + cs-encode + (coding-system-change-eol-conversion + cs-encode (if (string-match "^Darwin" uname) 'mac 'unix))) + (tramp-send-command vec "echo foo ; echo bar" t) + (goto-char (point-min)) + (when (search-forward "\r" nil t) + (setq cs-decode (coding-system-change-eol-conversion cs-decode 'dos))) + ;; Special setting for macOS. + (when (and (string-match "^Darwin" uname) + (memq 'utf-8-hfs (coding-system-list))) + (setq cs-decode 'utf-8-hfs + cs-encode 'utf-8-hfs)) + (set-buffer-process-coding-system cs-decode cs-encode) + (tramp-message + vec 5 "Setting coding system to `%s' and `%s'" cs-decode cs-encode))) (tramp-send-command vec "set +o vi +o emacs" t) @@ -4332,7 +4148,7 @@ process to set up. VEC specifies the connection." ;; Set `remote-tty' process property. (let ((tty (tramp-send-command-and-read vec "echo \\\"`tty`\\\"" 'noerror))) (unless (zerop (length tty)) - (tramp-compat-process-put proc 'remote-tty tty))) + (process-put proc 'remote-tty tty))) ;; Dump stty settings in the traces. (when (>= tramp-verbose 9) @@ -4341,23 +4157,23 @@ process to set up. VEC specifies the connection." ;; Set the environment. (tramp-message vec 5 "Setting default environment") - (let ((env (append `(,(tramp-get-remote-locale vec)) - (copy-sequence tramp-remote-process-environment))) - unset vars item) - (while env - (setq item (tramp-compat-split-string (car env) "=")) - (setcdr item (mapconcat 'identity (cdr item) "=")) - (if (and (stringp (cdr item)) (not (string-equal (cdr item) ""))) - (push (format "%s %s" (car item) (cdr item)) vars) - (push (car item) unset)) - (setq env (cdr env))) + (let (unset vars) + (dolist (item (reverse + (append `(,(tramp-get-remote-locale vec)) + (copy-sequence tramp-remote-process-environment)))) + (setq item (split-string item "=" 'omit)) + (setcdr item (mapconcat 'identity (cdr item) "=")) + (if (and (stringp (cdr item)) (not (string-equal (cdr item) ""))) + (push (format "%s %s" (car item) (cdr item)) vars) + (push (car item) unset))) (when vars (tramp-send-command vec - (format "while read var val; do export $var=$val; done <<'%s'\n%s\n%s" - tramp-end-of-heredoc - (mapconcat 'identity vars "\n") - tramp-end-of-heredoc) + (format + "while read var val; do export $var=\"$val\"; done <<'%s'\n%s\n%s" + tramp-end-of-heredoc + (mapconcat 'identity vars "\n") + tramp-end-of-heredoc) t)) (when unset (tramp-send-command @@ -4535,8 +4351,7 @@ Goes through the list `tramp-local-coding-commands' and value (format-spec-make ?t - (tramp-file-name-handler - 'file-remote-p tmpfile 'localname))))) + (file-remote-p tmpfile 'localname))))) (tramp-maybe-send-script vec value name) (setq rem-dec name))) (tramp-message @@ -4657,8 +4472,7 @@ Goes through the list `tramp-inline-compress-commands'." vec 2 "Couldn't find an inline transfer compress command"))))) (defun tramp-compute-multi-hops (vec) - "Expands VEC according to `tramp-default-proxies-alist'. -Gateway hops are already opened." + "Expands VEC according to `tramp-default-proxies-alist'." (let ((target-alist `(,vec)) (hops (or (tramp-file-name-hop vec) "")) (item vec) @@ -4715,32 +4529,6 @@ Gateway hops are already opened." ;; Start next search. (setq choices tramp-default-proxies-alist))))) - ;; Handle gateways. - (when (and (boundp 'tramp-gw-tunnel-method) (boundp 'tramp-gw-socks-method) - (string-match - (format - "^\\(%s\\|%s\\)$" tramp-gw-tunnel-method tramp-gw-socks-method) - (tramp-file-name-method (car target-alist)))) - (let ((gw (pop target-alist)) - (hop (pop target-alist))) - ;; Is the method prepared for gateways? - (unless (tramp-file-name-port hop) - (tramp-error - vec 'file-error - "Connection `%s' is not supported for gateway access." hop)) - ;; Open the gateway connection. - (push - (vector - (tramp-file-name-method hop) (tramp-file-name-user hop) - (tramp-compat-funcall 'tramp-gw-open-connection vec gw hop) nil nil) - target-alist) - ;; For the password prompt, we need the correct values. - ;; Therefore, we must remember the gateway vector. But we - ;; cannot do it as connection property, because it shouldn't - ;; be persistent. And we have no started process yet either. - (let ((tramp-verbose 0)) - (tramp-set-file-property (car target-alist) "" "gateway" hop)))) - ;; Foreign and out-of-band methods are not supported for multi-hops. (when (cdr target-alist) (setq choices target-alist) @@ -4830,7 +4618,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 @@ -4851,9 +4639,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"))) @@ -4863,9 +4651,10 @@ 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. (when (and (boundp 'non-essential) (symbol-value 'non-essential)) (throw 'non-essential 'non-essential)) @@ -4903,6 +4692,9 @@ connection if a previous connection has died for some reason." (options (tramp-ssh-controlmaster-options vec)) (process-connection-type tramp-process-connection-type) (process-adaptive-read-buffering nil) + ;; There are unfortunate settings for "cmdproxy" on + ;; W32 systems. + (process-coding-system-alist nil) (coding-system-for-read nil) ;; This must be done in order to avoid our file ;; name handler. @@ -4920,7 +4712,7 @@ connection if a previous connection has died for some reason." ;; Set sentinel and query flag. (tramp-set-connection-property p "vector" vec) (set-process-sentinel p 'tramp-process-sentinel) - (tramp-compat-set-process-query-on-exit-flag p nil) + (set-process-query-on-exit-flag p nil) (setq tramp-current-connection (cons (butlast (append vec nil) 2) (current-time)) tramp-current-host (system-name)) @@ -4951,13 +4743,6 @@ connection if a previous connection has died for some reason." (connection-timeout (tramp-get-method-parameter hop 'tramp-connection-timeout)) - (gw-args - (tramp-get-method-parameter hop 'tramp-gw-args)) - (gw (let ((tramp-verbose 0)) - (tramp-get-file-property hop "" "gateway" nil))) - (g-method (and gw (tramp-file-name-method gw))) - (g-user (and gw (tramp-file-name-user gw))) - (g-host (and gw (tramp-file-name-real-host gw))) (command login-program) ;; We don't create the temporary file. In ;; fact, it is just a prefix for the @@ -4981,12 +4766,6 @@ connection if a previous connection has died for some reason." (when (and process-name async-args) (setq login-args (append async-args login-args))) - ;; Add gateway arguments if necessary. - (when gw - (tramp-set-connection-property p "gateway" t) - (when gw-args - (setq login-args (append gw-args login-args)))) - ;; Check for port number. Until now, there's no ;; need for handling like method, user, host. (when (string-match tramp-host-with-port-regexp l-host) @@ -4999,11 +4778,10 @@ connection if a previous connection has died for some reason." (setq r-shell t))) ;; Set variables for computing the prompt for - ;; reading password. They can also be derived - ;; from a gateway. - (setq tramp-current-method (or g-method l-method) - tramp-current-user (or g-user l-user) - tramp-current-host (or g-host l-host)) + ;; reading password. + (setq tramp-current-method l-method + tramp-current-user l-user + tramp-current-host l-host) ;; Add login environment. (when login-env @@ -5054,7 +4832,10 @@ connection if a previous connection has died for some reason." (tramp-message vec 3 "Sending command `%s'" command) (tramp-send-command vec command t t) (tramp-process-actions - p vec pos tramp-actions-before-shell + p vec + (min + pos (with-current-buffer (process-buffer p) (point-max))) + tramp-actions-before-shell (or connection-timeout tramp-connection-timeout)) (tramp-message vec 3 "Found remote shell prompt on `%s'" l-host)) @@ -5062,6 +4843,9 @@ connection if a previous connection has died for some reason." (setq options "" target-alist (cdr target-alist))) + ;; Set connection-local variables. + (tramp-set-connection-local-variables vec) + ;; Make initial shell settings. (tramp-open-connection-setup-interactive-shell p vec) @@ -5109,7 +4893,12 @@ function waits for output unless NOOUTPUT is set." (with-current-buffer (process-buffer proc) (let* (;; Initially, `tramp-end-of-output' is "#$ ". There might ;; be leading escape sequences, which must be ignored. - (regexp (format "[^#$\n]*%s\r?$" (regexp-quote tramp-end-of-output))) + ;; Busyboxes built with the EDITING_ASK_TERMINAL config + ;; option send also escape sequences, which must be + ;; ignored. + (regexp (format "[^#$\n]*%s\\(%s\\)?\r?$" + (regexp-quote tramp-end-of-output) + tramp-device-escape-sequence-regexp)) ;; Sometimes, the commands do not return a newline but a ;; null byte before the shell prompt, for example "git ;; ls-files -c -z ...". @@ -5212,18 +5001,19 @@ Return ATTR." (when attr ;; Remove color escape sequences from symlink. (when (stringp (car attr)) - (while (string-match tramp-color-escape-sequence-regexp (car attr)) + (while (string-match tramp-display-escape-sequence-regexp (car attr)) (setcar attr (replace-match "" nil nil (car attr))))) - ;; Convert uid and gid. Use -1 as indication of unusable value. + ;; Convert uid and gid. Use `tramp-unknown-id-integer' as + ;; indication of unusable value. (when (and (numberp (nth 2 attr)) (< (nth 2 attr) 0)) - (setcar (nthcdr 2 attr) -1)) + (setcar (nthcdr 2 attr) tramp-unknown-id-integer)) (when (and (floatp (nth 2 attr)) - (<= (nth 2 attr) (tramp-compat-most-positive-fixnum))) + (<= (nth 2 attr) most-positive-fixnum)) (setcar (nthcdr 2 attr) (round (nth 2 attr)))) (when (and (numberp (nth 3 attr)) (< (nth 3 attr) 0)) - (setcar (nthcdr 3 attr) -1)) + (setcar (nthcdr 3 attr) tramp-unknown-id-integer)) (when (and (floatp (nth 3 attr)) - (<= (nth 3 attr) (tramp-compat-most-positive-fixnum))) + (<= (nth 3 attr) most-positive-fixnum)) (setcar (nthcdr 3 attr) (round (nth 3 attr)))) ;; Convert last access time. (unless (listp (nth 4 attr)) @@ -5244,7 +5034,7 @@ Return ATTR." (when (< (nth 7 attr) 0) (setcar (nthcdr 7 attr) -1)) (when (and (floatp (nth 7 attr)) - (<= (nth 7 attr) (tramp-compat-most-positive-fixnum))) + (<= (nth 7 attr) most-positive-fixnum)) (setcar (nthcdr 7 attr) (round (nth 7 attr)))) ;; Convert file mode bits to string. (unless (stringp (nth 8 attr)) @@ -5296,7 +5086,8 @@ Return ATTR." (let ((method (tramp-file-name-method vec)) (user (tramp-file-name-user vec)) (host (tramp-file-name-real-host vec)) - (localname (tramp-file-name-localname vec))) + (localname + (directory-file-name (tramp-file-name-unquote-localname vec)))) (when (string-match tramp-ipv6-regexp host) (setq host (format "[%s]" host))) (unless (string-match "ftp$" method) @@ -5305,8 +5096,8 @@ Return ATTR." ((tramp-get-method-parameter vec 'tramp-remote-copy-program) localname) ((not (zerop (length user))) - (shell-quote-argument (format "%s@%s:%s" user host localname))) - (t (shell-quote-argument (format "%s:%s" host localname)))))) + (format "%s@%s:%s" user host (shell-quote-argument localname))) + (t (format "%s:%s" host (shell-quote-argument localname)))))) (defun tramp-method-out-of-band-p (vec size) "Return t if this is an out-of-band method, nil otherwise." @@ -5324,6 +5115,8 @@ Return ATTR." ;; Variables local to connection. (defun tramp-get-remote-path (vec) + "Compile list of remote directories for $PATH. +Nonexistent directories are removed from spec." (with-tramp-connection-property ;; When `tramp-own-remote-path' is in `tramp-remote-path', we ;; cache the result for the session only. Otherwise, the result @@ -5376,7 +5169,7 @@ Return ATTR." (when elt1 (setcdr elt1 (append - (tramp-compat-split-string (or default-remote-path "") ":") + (split-string (or default-remote-path "") ":" 'omit) (cdr elt1))) (setq remote-path (delq 'tramp-default-remote-path remote-path))) @@ -5384,7 +5177,7 @@ Return ATTR." (when elt2 (setcdr elt2 (append - (tramp-compat-split-string (or own-remote-path "") ":") + (split-string (or own-remote-path "") ":" 'omit) (cdr elt2))) (setq remote-path (delq 'tramp-own-remote-path remote-path))) @@ -5412,6 +5205,7 @@ Return ATTR." remote-path))))) (defun tramp-get-remote-locale (vec) + "Determine remote locale, supporting UTF8 if possible." (with-tramp-connection-property vec "locale" (tramp-send-command vec "locale -a") (let ((candidates '("en_US.utf8" "C.utf8" "en_US.UTF-8")) @@ -5428,6 +5222,7 @@ Return ATTR." (format "LC_ALL=%s" (or locale "C"))))) (defun tramp-get-ls-command (vec) + "Determine remote `ls' command." (with-tramp-connection-property vec "ls" (tramp-message vec 5 "Finding a suitable `ls' command") (or @@ -5453,6 +5248,7 @@ Return ATTR." (tramp-error vec 'file-error "Couldn't find a proper `ls' command")))) (defun tramp-get-ls-command-with-dired (vec) + "Check, whether the remote `ls' command supports the --dired option." (save-match-data (with-tramp-connection-property vec "ls-dired" (tramp-message vec 5 "Checking, whether `ls --dired' works") @@ -5463,6 +5259,7 @@ Return ATTR." vec (format "%s --dired -al /dev/null" (tramp-get-ls-command vec)))))) (defun tramp-get-ls-command-with-quoting-style (vec) + "Check, whether the remote `ls' command supports the --quoting-style option." (save-match-data (with-tramp-connection-property vec "ls-quoting-style" (tramp-message vec 5 "Checking, whether `ls --quoting-style=shell' works") @@ -5471,6 +5268,7 @@ Return ATTR." (tramp-get-ls-command vec)))))) (defun tramp-get-ls-command-with-w-option (vec) + "Check, whether the remote `ls' command supports the -w option." (save-match-data (with-tramp-connection-property vec "ls-w-option" (tramp-message vec 5 "Checking, whether `ls -w' works") @@ -5481,6 +5279,7 @@ Return ATTR." vec (format "%s -alw" (tramp-get-ls-command vec)))))) (defun tramp-get-test-command (vec) + "Determine remote `test' command." (with-tramp-connection-property vec "test" (tramp-message vec 5 "Finding a suitable `test' command") (if (tramp-send-command-and-check vec "test 0") @@ -5488,6 +5287,7 @@ Return ATTR." (tramp-find-executable vec "test" (tramp-get-remote-path vec))))) (defun tramp-get-test-nt-command (vec) + "Check, whether the remote `test' command supports the -nt option." ;; Does `test A -nt B' work? Use abominable `find' construct if it ;; doesn't. BSD/OS 4.0 wants the parentheses around the command, ;; for otherwise the shell crashes. @@ -5509,33 +5309,41 @@ Return ATTR." "tramp_test_nt %s %s")))) (defun tramp-get-file-exists-command (vec) + "Determine remote command for file existing check." (with-tramp-connection-property vec "file-exists" (tramp-message vec 5 "Finding command to check if file exists") (tramp-find-file-exists-command vec))) (defun tramp-get-remote-ln (vec) + "Determine remote `ln' command." (with-tramp-connection-property vec "ln" (tramp-message vec 5 "Finding a suitable `ln' command") (tramp-find-executable vec "ln" (tramp-get-remote-path vec)))) (defun tramp-get-remote-perl (vec) + "Determine remote `perl' command." (with-tramp-connection-property vec "perl" (tramp-message vec 5 "Finding a suitable `perl' command") (let ((result (or (tramp-find-executable vec "perl5" (tramp-get-remote-path vec)) - (tramp-find-executable - vec "perl" (tramp-get-remote-path vec))))) + (tramp-find-executable vec "perl" (tramp-get-remote-path vec))))) + ;; Perform a basic check. + (and result + (null (tramp-send-command-and-check + vec (format "%s -e 'print \"Hello\n\";'" result))) + (setq result nil)) ;; We must check also for some Perl modules. (when result (with-tramp-connection-property vec "perl-file-spec" - (tramp-send-command-and-check - vec (format "%s -e 'use File::Spec;'" result))) + (tramp-send-command-and-check + vec (format "%s -e 'use File::Spec;'" result))) (with-tramp-connection-property vec "perl-cwd-realpath" - (tramp-send-command-and-check - vec (format "%s -e 'use Cwd \"realpath\";'" result)))) + (tramp-send-command-and-check + vec (format "%s -e 'use Cwd \"realpath\";'" result)))) result))) (defun tramp-get-remote-stat (vec) + "Determine remote `stat' command." (with-tramp-connection-property vec "stat" (tramp-message vec 5 "Finding a suitable `stat' command") (let ((result (tramp-find-executable @@ -5556,6 +5364,7 @@ Return ATTR." result))) (defun tramp-get-remote-readlink (vec) + "Determine remote `readlink' command." (with-tramp-connection-property vec "readlink" (tramp-message vec 5 "Finding a suitable `readlink' command") (let ((result (tramp-find-executable @@ -5566,11 +5375,13 @@ Return ATTR." result)))) (defun tramp-get-remote-trash (vec) + "Determine remote `trash' command." (with-tramp-connection-property vec "trash" (tramp-message vec 5 "Finding a suitable `trash' command") (tramp-find-executable vec "trash" (tramp-get-remote-path vec)))) (defun tramp-get-remote-touch (vec) + "Determine remote `touch' command." (with-tramp-connection-property vec "touch" (tramp-message vec 5 "Finding a suitable `touch' command") (let ((result (tramp-find-executable @@ -5590,22 +5401,25 @@ Return ATTR." "%s -t %s %s" result (format-time-string "%Y%m%d%H%M.%S") - (tramp-file-name-handler 'file-remote-p tmpfile 'localname)))) + (file-remote-p tmpfile 'localname)))) (delete-file tmpfile)) result))) (defun tramp-get-remote-gvfs-monitor-dir (vec) + "Determine remote `gvfs-monitor-dir' command." (with-tramp-connection-property vec "gvfs-monitor-dir" (tramp-message vec 5 "Finding a suitable `gvfs-monitor-dir' command") (tramp-find-executable vec "gvfs-monitor-dir" (tramp-get-remote-path vec) t t))) (defun tramp-get-remote-inotifywait (vec) + "Determine remote `inotifywait' command." (with-tramp-connection-property vec "inotifywait" (tramp-message vec 5 "Finding a suitable `inotifywait' command") (tramp-find-executable vec "inotifywait" (tramp-get-remote-path vec) t t))) (defun tramp-get-remote-id (vec) + "Determine remote `id' command." (with-tramp-connection-property vec "id" (tramp-message vec 5 "Finding POSIX `id' command") (catch 'id-found @@ -5619,6 +5433,7 @@ Return ATTR." (setq dl (cdr dl)))))))) (defun tramp-get-remote-uid-with-id (vec id-format) + "Implement `tramp-get-remote-uid' for Tramp files using `id'." (tramp-send-command-and-read vec (format "%s -u%s %s" @@ -5628,6 +5443,7 @@ Return ATTR." "" "| sed -e s/^/\\\"/ -e s/\\$/\\\"/")))) (defun tramp-get-remote-uid-with-perl (vec id-format) + "Implement `tramp-get-remote-uid' for Tramp files using a Perl script." (tramp-send-command-and-read vec (format "%s -le '%s'" @@ -5637,6 +5453,7 @@ Return ATTR." "print \"\\\"\", scalar getpwuid($>), \"\\\"\"")))) (defun tramp-get-remote-python (vec) + "Determine remote `python' command." (with-tramp-connection-property vec "python" (tramp-message vec 5 "Finding a suitable `python' command") (or (tramp-find-executable vec "python" (tramp-get-remote-path vec)) @@ -5644,6 +5461,7 @@ Return ATTR." (tramp-find-executable vec "python3" (tramp-get-remote-path vec))))) (defun tramp-get-remote-uid-with-python (vec id-format) + "Implement `tramp-get-remote-uid' for Tramp files using `python'." (tramp-send-command-and-read vec (format "%s -c \"%s\"" @@ -5653,6 +5471,8 @@ Return ATTR." "import os, pwd; print ('\\\"' + pwd.getpwuid(os.getuid())[0] + '\\\"')")))) (defun tramp-get-remote-uid (vec id-format) + "The uid of the remote connection VEC, in ID-FORMAT. +ID-FORMAT valid values are `string' and `integer'." (with-tramp-connection-property vec (format "uid-%s" id-format) (let ((res (ignore-errors @@ -5665,11 +5485,14 @@ Return ATTR." (tramp-get-remote-uid-with-python vec id-format)))))) ;; Ensure there is a valid result. (cond - ((and (equal id-format 'integer) (not (integerp res))) -1) - ((and (equal id-format 'string) (not (stringp res))) "UNKNOWN") + ((and (equal id-format 'integer) (not (integerp res))) + tramp-unknown-id-integer) + ((and (equal id-format 'string) (not (stringp res))) + tramp-unknown-id-string) (t res))))) (defun tramp-get-remote-gid-with-id (vec id-format) + "Implement `tramp-get-remote-gid' for Tramp files using `id'." (tramp-send-command-and-read vec (format "%s -g%s %s" @@ -5679,6 +5502,7 @@ Return ATTR." "" "| sed -e s/^/\\\"/ -e s/\\$/\\\"/")))) (defun tramp-get-remote-gid-with-perl (vec id-format) + "Implement `tramp-get-remote-gid' for Tramp files using a Perl script." (tramp-send-command-and-read vec (format "%s -le '%s'" @@ -5688,6 +5512,7 @@ Return ATTR." "print \"\\\"\", scalar getgrgid($)), \"\\\"\"")))) (defun tramp-get-remote-gid-with-python (vec id-format) + "Implement `tramp-get-remote-gid' for Tramp files using `python'." (tramp-send-command-and-read vec (format "%s -c \"%s\"" @@ -5697,6 +5522,8 @@ Return ATTR." "import os, grp; print ('\\\"' + grp.getgrgid(os.getgid())[0] + '\\\"')")))) (defun tramp-get-remote-gid (vec id-format) + "The gid of the remote connection VEC, in ID-FORMAT. +ID-FORMAT valid values are `string' and `integer'." (with-tramp-connection-property vec (format "gid-%s" id-format) (let ((res (ignore-errors @@ -5709,11 +5536,14 @@ Return ATTR." (tramp-get-remote-gid-with-python vec id-format)))))) ;; Ensure there is a valid result. (cond - ((and (equal id-format 'integer) (not (integerp res))) -1) - ((and (equal id-format 'string) (not (stringp res))) "UNKNOWN") + ((and (equal id-format 'integer) (not (integerp res))) + tramp-unknown-id-integer) + ((and (equal id-format 'string) (not (stringp res))) + tramp-unknown-id-string) (t res))))) (defun tramp-get-env-with-u-option (vec) + "Check, whether the remote `env' command supports the -u option." (with-tramp-connection-property vec "env-u-option" (tramp-message vec 5 "Checking, whether `env -u' works") ;; Option "-u" is a GNU extension. @@ -5776,18 +5606,14 @@ function cell is returned to be applied on a buffer." `(lambda (beg end) (,coding beg end) (let ((coding-system-for-write 'binary) - (coding-system-for-read 'binary) - (default-directory - (tramp-compat-temporary-file-directory))) + (coding-system-for-read 'binary)) (apply 'tramp-call-process-region ,vec (point-min) (point-max) (car (split-string ,compress)) t t nil (cdr (split-string ,compress))))) `(lambda (beg end) (let ((coding-system-for-write 'binary) - (coding-system-for-read 'binary) - (default-directory - (tramp-compat-temporary-file-directory))) + (coding-system-for-read 'binary)) (apply 'tramp-call-process-region ,vec beg end (car (split-string ,compress)) t t nil @@ -5835,14 +5661,18 @@ function cell is returned to be applied on a buffer." ;; * Don't use globbing for directories with many files, as this is ;; likely to produce long command lines, and some shells choke on ;; long command lines. +;; ;; * Don't search for perl5 and perl. Instead, only search for perl and ;; then look if it's the right version (with `perl -v'). +;; ;; * When editing a remote CVS controlled file as a different user, VC ;; gets confused about the file locking status. Try to find out why ;; the workaround doesn't work. +;; ;; * Allow out-of-band methods as _last_ multi-hop. Open a connection ;; until the last but one hop via `start-file-process'. Apply it ;; also for ftp and smb. +;; ;; * WIBNI if we had a command "trampclient"? If I was editing in ;; some shell with root privileges, it would be nice if I could ;; just call @@ -5864,21 +5694,60 @@ function cell is returned to be applied on a buffer." ;; reasonably unproblematic. And maybe trampclient should have some ;; way of passing credentials, like by using an SSL socket or ;; something. (David Kastrup) +;; ;; * Reconnect directly to a compliant shell without first going ;; through the user's default shell. (Pete Forman) +;; ;; * How can I interrupt the remote process with a signal ;; (interrupt-process seems not to work)? (Markus Triska) +;; ;; * Avoid the local shell entirely for starting remote processes. If ;; so, I think even a signal, when delivered directly to the local ;; SSH instance, would correctly be propagated to the remote process ;; automatically; possibly SSH would have to be started with ;; "-t". (Markus Triska) +;; ;; * It makes me wonder if tramp couldn't fall back to ssh when scp ;; isn't on the remote host. (Mark A. Hershberger) +;; ;; * Use lsh instead of ssh. (Alfred M. Szmidt) +;; ;; * Optimize out-of-band copying when both methods are scp-like (not ;; rsync). +;; ;; * Keep a second connection open for out-of-band methods like scp or ;; rsync. +;; +;; * Implement completion for "/method:user@host:~<abc> TAB". +;; +;; * I think you could get the best of both worlds by using an +;; approach similar to Tramp but running a little tramp-daemon on +;; the other end, such that we can use a more efficient +;; communication protocol (e.g. when saving a file we could locally +;; diff it against the last version (of which the remote daemon +;; would also keep a copy), and then only send the diff). +;; +;; This said, even using such a daemon it might be difficult to get +;; good performance: part of the problem is the number of +;; round-trips. E.g. when saving a file we have to check if the +;; file was modified in the mean time and whether saving into a new +;; inode would change the owner (etc...), which each require a +;; round-trip. To get rid of these round-trips, we'd have to +;; shortcut this code and delegate the higher-level "save file" +;; operation to the remote server, which then has to perform those +;; tasks but still obeying the locally set customizations about how +;; to do each one of those tasks. +;; +;; We could either put higher-level ops in there (like +;; `save-buffer'), which implies replicating the whole `save-buffer' +;; behavior, which is a lot of work and likely to be not 100% +;; faithful. +;; +;; Or we could introduce new low-level ops that are asynchronous, +;; and then rewrite save-buffer to use them. IOW save-buffer would +;; start with a bunch of calls like `start-getting-file-attributes' +;; which could immediately be passed on to the remote side, and +;; later on checks the return value of those calls as and when +;; needed. (Stefan Monnier) ;;; tramp-sh.el ends here |