X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/96764333c438566b20fd381960fef77fa12eb586..0e963201d03d9229bb8ac4323291d2b0119526ed:/lisp/net/tramp-sh.el diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index c02287d5cc..2e6233ade3 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1,6 +1,6 @@ ;;; tramp-sh.el --- Tramp access functions for (s)sh-like connections -;; Copyright (C) 1998-2015 Free Software Foundation, Inc. +;; Copyright (C) 1998-2016 Free Software Foundation, Inc. ;; (copyright statements below in code to be updated with the above notice) @@ -486,6 +486,7 @@ The string is used in `tramp-methods'.") ;; Solaris: /usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/SUNWspro/bin ;; GNU/Linux (Debian, Suse): /bin:/usr/bin ;; FreeBSD: /usr/bin:/bin:/usr/sbin:/sbin: - beware trailing ":"! +;; Darwin: /usr/bin:/bin:/usr/sbin:/sbin ;; IRIX64: /usr/bin ;;;###tramp-autoload (defcustom tramp-remote-path @@ -597,9 +598,14 @@ we have this shell function.") use File::Spec; use Cwd \"realpath\"; +sub myrealpath { + my ($file) = @_; + return realpath($file) if -e $file; +} + sub recursive { my ($volume, @dirs) = @_; - my $real = realpath(File::Spec->catpath( + my $real = myrealpath(File::Spec->catpath( $volume, File::Spec->catdir(@dirs), \"\")); if ($real) { my ($vol, $dir) = File::Spec->splitpath($real, 1); @@ -613,7 +619,7 @@ sub recursive { } } -$result = realpath($ARGV[0]); +$result = myrealpath($ARGV[0]); if (!$result) { my ($vol, $dir) = File::Spec->splitpath($ARGV[0], 1); ($vol, @dirs) = recursive($vol, File::Spec->splitdir($dir)); @@ -621,10 +627,7 @@ if (!$result) { $result = File::Spec->catpath($vol, File::Spec->catdir(@dirs), \"\"); } -if ($ARGV[0] =~ /\\/$/) { - $result = $result . \"/\"; -} - +$result =~ s/\"/\\\\\"/g; print \"\\\"$result\\\"\\n\"; ' \"$1\" 2>/dev/null" "Perl script to produce output suitable for use with `file-truename' @@ -993,10 +996,10 @@ of command line.") (file-acl . tramp-sh-handle-file-acl) (file-attributes . tramp-sh-handle-file-attributes) (file-directory-p . tramp-sh-handle-file-directory-p) - ;; `file-equal-p' performed by default handler. + (file-equal-p . tramp-handle-file-equal-p) (file-executable-p . tramp-sh-handle-file-executable-p) (file-exists-p . tramp-sh-handle-file-exists-p) - ;; `file-in-directory-p' performed by default handler. + (file-in-directory-p . tramp-handle-file-in-directory-p) (file-local-copy . tramp-sh-handle-file-local-copy) (file-modes . tramp-handle-file-modes) (file-name-all-completions . tramp-sh-handle-file-name-all-completions) @@ -1143,20 +1146,17 @@ target of the symlink differ." ;; 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 "/")) - (localnamedir (tramp-run-real-handler - 'file-name-as-directory (list localname))) - (is-dir (string= localname localnamedir)) - (thisstep nil) - (numchase 0) - ;; Don't make the following value larger than - ;; necessary. People expect an error message in - ;; a timely fashion when something is wrong; - ;; otherwise they might think that Emacs is hung. - ;; Of course, correctness has to come first. - (numchase-limit 20) - symlink-target) + (t (let ((directory-sep-char ?/) + (steps (tramp-compat-split-string localname "/")) + (thisstep nil) + (numchase 0) + ;; Don't make the following value larger than + ;; necessary. People expect an error message in a + ;; timely fashion when something is wrong; + ;; otherwise they might think that Emacs is hung. + ;; Of course, correctness has to come first. + (numchase-limit 20) + symlink-target) (while (and steps (< numchase numchase-limit)) (setq thisstep (pop steps)) (tramp-message @@ -1212,10 +1212,8 @@ target of the symlink differ." (if result (mapconcat 'identity (cons "" result) "/") "/")) - (when (and is-dir - (or (string= "" result) - (not (string= (substring result -1) "/")))) - (setq result (concat result "/")))))) + (when (string= "" result) + (setq result "/"))))) (tramp-message v 4 "True name of `%s' is `%s'" localname result) result)))) @@ -1276,11 +1274,15 @@ target of the symlink differ." (tramp-get-test-command vec) (tramp-shell-quote-argument localname) (tramp-get-ls-command vec) + (if (eq id-format 'integer) "-ildn" "-ild") ;; On systems which have no quoting style, file names ;; with special characters could fail. - (if (tramp-get-ls-command-with-quoting-style vec) - "--quoting-style=c" "") - (if (eq id-format 'integer) "-ildn" "-ild") + (cond + ((tramp-get-ls-command-with-quoting-style vec) + "--quoting-style=c") + ((tramp-get-ls-command-with-w-option vec) + "-w") + (t "")) (tramp-shell-quote-argument localname))) ;; Parse `ls -l' output ... (with-current-buffer (tramp-get-buffer vec) @@ -1837,10 +1839,14 @@ be non-negative integers." "-- 2>/dev/null | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g'); echo \")\"") (tramp-shell-quote-argument localname) (tramp-get-ls-command vec) - ;; On systems which have no quoting style, file names with - ;; special characters could fail. - (if (tramp-get-ls-command-with-quoting-style vec) - "--quoting-style=shell" "") + ;; On systems which have no quoting style, file names with special + ;; characters could fail. + (cond + ((tramp-get-ls-command-with-quoting-style vec) + "--quoting-style=shell") + ((tramp-get-ls-command-with-w-option vec) + "-w") + (t "")) (tramp-get-remote-stat vec) tramp-stat-marker tramp-stat-marker tramp-stat-marker tramp-stat-marker @@ -2457,16 +2463,17 @@ The method used must be an out-of-band method." (setq source (if t1 (tramp-make-copy-program-file-name v) (shell-quote-argument filename)) - target (funcall + target (if t2 + (tramp-make-copy-program-file-name v) + (shell-quote-argument + (funcall (if (and (file-directory-p filename) (string-equal (file-name-nondirectory filename) (file-name-nondirectory newname))) 'file-name-directory 'identity) - (if t2 - (tramp-make-copy-program-file-name v) - (shell-quote-argument newname)))) + newname)))) ;; Check for host and port number. We cannot use ;; `tramp-file-name-port', because this returns also @@ -4148,7 +4155,8 @@ seconds. If not, it produces an error message with the given ERROR-ARGS." "Set up an interactive shell. Mainly sets the prompt and the echo correctly. PROC is the shell process to set up. VEC specifies the connection." - (let ((tramp-end-of-output tramp-initial-end-of-output)) + (let ((tramp-end-of-output tramp-initial-end-of-output) + (case-fold-search t)) (tramp-open-shell vec (tramp-get-method-parameter vec 'tramp-remote-shell)) ;; Disable tab and echo expansion. @@ -4173,6 +4181,25 @@ process to set up. VEC specifies the connection." vec (format "PS1=%s PS2='' PS3='' PROMPT_COMMAND=''" (tramp-shell-quote-argument tramp-end-of-output)) t) + ;; Check whether the output of "uname -sr" has been changed. If + ;; yes, this is a strong indication that we must expire all + ;; connection properties. We start again with + ;; `tramp-maybe-open-connection', it will be caught there. + (tramp-message vec 5 "Checking system information") + (let ((old-uname (tramp-get-connection-property vec "uname" nil)) + (new-uname + (tramp-set-connection-property + vec "uname" + (tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\"")))) + (when (and (stringp old-uname) (not (string-equal old-uname new-uname))) + (tramp-message + vec 3 + "Connection reset, because remote host changed from `%s' to `%s'" + old-uname new-uname) + ;; We want to keep the password. + (tramp-cleanup-connection vec t t) + (throw 'uname-changed (tramp-maybe-open-connection vec)))) + ;; Try to set up the coding system correctly. ;; CCC this can't be the right way to do it. Hm. (tramp-message vec 5 "Determining coding system") @@ -4181,7 +4208,7 @@ process to set up. VEC specifies the connection." ;; 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 "utf8" (tramp-get-remote-locale vec)) + (string-match "utf-?8" (tramp-get-remote-locale vec)) (cons 'utf-8 'utf-8)) (tramp-compat-funcall 'process-coding-system proc) (cons 'undecided 'undecided))) @@ -4191,8 +4218,12 @@ process to set up. VEC specifies the connection." (setq cs-encode (cdr cs)) (unless cs-decode (setq cs-decode 'undecided)) (unless cs-encode (setq cs-encode 'undecided)) - (setq cs-encode (tramp-compat-coding-system-change-eol-conversion - cs-encode 'unix)) + (setq cs-encode + (tramp-compat-coding-system-change-eol-conversion + cs-encode + (if (string-match + "^Darwin" (tramp-get-connection-property vec "uname" "")) + 'mac 'unix))) (tramp-send-command vec "echo foo ; echo bar" t) (goto-char (point-min)) (when (search-forward "\r" nil t) @@ -4211,25 +4242,6 @@ process to set up. VEC specifies the connection." (tramp-send-command vec "set +o vi +o emacs" t) - ;; Check whether the output of "uname -sr" has been changed. If - ;; yes, this is a strong indication that we must expire all - ;; connection properties. We start again with - ;; `tramp-maybe-open-connection', it will be caught there. - (tramp-message vec 5 "Checking system information") - (let ((old-uname (tramp-get-connection-property vec "uname" nil)) - (new-uname - (tramp-set-connection-property - vec "uname" - (tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\"")))) - (when (and (stringp old-uname) (not (string-equal old-uname new-uname))) - (tramp-message - vec 3 - "Connection reset, because remote host changed from `%s' to `%s'" - old-uname new-uname) - ;; We want to keep the password. - (tramp-cleanup-connection vec t t) - (throw 'uname-changed (tramp-maybe-open-connection vec)))) - ;; Check whether the remote host suffers from buggy ;; `send-process-string'. This is known for FreeBSD (see comment in ;; `send_process', file process.c). I've tested sending 624 bytes @@ -4263,7 +4275,7 @@ process to set up. VEC specifies the connection." (tramp-find-shell vec) ;; Disable unexpected output. - (tramp-send-command vec "mesg n; biff n" t) + (tramp-send-command vec "mesg n 2>/dev/null; biff n 2>/dev/null" t) ;; IRIX64 bash expands "!" even when in single quotes. This ;; destroys our shell functions, we must disable it. See @@ -4276,6 +4288,10 @@ process to set up. VEC specifies the connection." (tramp-get-connection-property vec "uname" "")) (tramp-send-command vec "stty -oxtabs" t)) + ;; Set utf8 encoding. Needed for Mac OS X, for example. This is + ;; non-POSIX, so we must expect errors on some systems. + (tramp-send-command vec "stty iutf8 2>/dev/null" t) + ;; Set `remote-tty' process property. (let ((tty (tramp-send-command-and-read vec "echo \\\"`tty`\\\"" 'noerror))) (unless (zerop (length tty)) @@ -5294,21 +5310,26 @@ Return ATTR." ;; The login shell could return more than just the $PATH ;; string. So we use `tramp-end-of-heredoc' as marker. (when elt2 - (tramp-send-command-and-read - vec - (format - "%s %s %s 'echo %s \\\"$PATH\\\"'" - (tramp-get-method-parameter vec 'tramp-remote-shell) - (mapconcat - 'identity - (tramp-get-method-parameter vec 'tramp-remote-shell-login) - " ") - (mapconcat - 'identity - (tramp-get-method-parameter vec 'tramp-remote-shell-args) - " ") - (tramp-shell-quote-argument tramp-end-of-heredoc)) - nil (regexp-quote tramp-end-of-heredoc))))) + (or + (tramp-send-command-and-read + vec + (format + "%s %s %s 'echo %s \\\"$PATH\\\"'" + (tramp-get-method-parameter vec 'tramp-remote-shell) + (mapconcat + 'identity + (tramp-get-method-parameter vec 'tramp-remote-shell-login) + " ") + (mapconcat + 'identity + (tramp-get-method-parameter vec 'tramp-remote-shell-args) + " ") + (tramp-shell-quote-argument tramp-end-of-heredoc)) + 'noerror (regexp-quote tramp-end-of-heredoc)) + (progn + (tramp-message + vec 2 "Could not retrieve `tramp-own-remote-path'") + nil))))) ;; Replace place holder `tramp-default-remote-path'. (when elt1 @@ -5352,7 +5373,7 @@ Return ATTR." (defun tramp-get-remote-locale (vec) (with-tramp-connection-property vec "locale" (tramp-send-command vec "locale -a") - (let ((candidates '("en_US.utf8" "C.utf8")) + (let ((candidates '("en_US.utf8" "C.utf8" "en_US.UTF-8")) locale) (with-current-buffer (tramp-get-connection-buffer vec) (while candidates @@ -5404,13 +5425,20 @@ Return ATTR." (save-match-data (with-tramp-connection-property vec "ls-quoting-style" (tramp-message vec 5 "Checking, whether `ls --quoting-style=shell' works") - ;; Some "ls" versions are sensible wrt the order of arguments, - ;; they fail when "-al" is after the "--dired" argument (for - ;; example on FreeBSD). (tramp-send-command-and-check vec (format "%s --quoting-style=shell -al /dev/null" (tramp-get-ls-command vec)))))) +(defun tramp-get-ls-command-with-w-option (vec) + (save-match-data + (with-tramp-connection-property vec "ls-w-option" + (tramp-message vec 5 "Checking, whether `ls -w' works") + ;; Option "-w" is available on BSD systems. No argument is + ;; given, because this could return wrong results in case "ls" + ;; supports the "-w NUM" argument, as for busyboxes. + (tramp-send-command-and-check + vec (format "%s -alw" (tramp-get-ls-command vec)))))) + (defun tramp-get-test-command (vec) (with-tramp-connection-property vec "test" (tramp-message vec 5 "Finding a suitable `test' command")