]> code.delx.au - gnu-emacs/blobdiff - lisp/net/tramp.el
* net/tramp.el (top): Require cl.el, when `copy-tree' is not available
[gnu-emacs] / lisp / net / tramp.el
index aa7456ad29a4bf4975cc6ed5f1678359dd0c32f4..9f326800f0e3b6bb98beb3b0af6fd24729c17d00 100644 (file)
@@ -1,4 +1,4 @@
-;;; -*- mode: Emacs-Lisp; coding: iso-2022-7bit; -*-
+;;; -*- mode: Emacs-Lisp; coding: utf-8; -*-
 ;;; tramp.el --- Transparent Remote Access, Multiple Protocol
 
 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
@@ -6,7 +6,7 @@
 
 ;; (copyright statements below in code to be updated with the above notice)
 
-;; Author: Kai Gro\e,A_\e(Bjohann <kai.grossjohann@gmx.net>
+;; Author: Kai Großjohann <kai.grossjohann@gmx.net>
 ;;         Michael Albinus <michael.albinus@gmx.de>
 ;; Keywords: comm, processes
 
@@ -14,8 +14,8 @@
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3 of the License, or
-;; (at your option) any later version.
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 (require 'shell)
 (require 'advice)
 
+;; `copy-tree' is part of subr.el since Emacs 22.
+(eval-when-compile
+  (unless (functionp 'copy-tree)
+    (require 'cl)))
+
 ;; Requiring 'tramp-cache results in an endless loop.
 (autoload 'tramp-get-file-property "tramp-cache")
 (autoload 'tramp-set-file-property "tramp-cache")
@@ -1027,7 +1032,7 @@ The `sudo' program appears to insert a `^@' character into the prompt."
                        "Login incorrect"
                        "Login Incorrect"
                        "Connection refused"
-                       "Connection closed by foreign host."
+                       "Connection closed"
                        "Sorry, try again."
                        "Name or service not known"
                        "Host key verification failed."
@@ -2448,6 +2453,7 @@ of."
        t
       (let ((f (buffer-file-name)))
        (with-parsed-tramp-file-name f nil
+         (tramp-flush-file-property v localname)
          (let* ((attr (file-attributes f))
                 (modtime (nth 5 attr))
                 (mt (visited-file-modtime)))
@@ -3466,7 +3472,7 @@ beginning of local filename are not substituted."
 (defun tramp-handle-executable-find (command)
   "Like `executable-find' for Tramp files."
   (with-parsed-tramp-file-name default-directory nil
-    (tramp-find-executable v command tramp-remote-path t)))
+    (tramp-find-executable v command (tramp-get-remote-path v) t)))
 
 ;; We use BUFFER also as connection buffer during setup. Because of
 ;; this, its original contents must be saved, and restored once
@@ -3580,8 +3586,11 @@ beginning of local filename are not substituted."
              (tramp-send-command v command)
            ;; We should show the output anyway.
            (when outbuf
-             (with-current-buffer outbuf
-               (insert-buffer-substring (tramp-get-connection-buffer v)))
+             (let ((output-string
+                    (with-current-buffer (tramp-get-connection-buffer v)
+                      (buffer-substring (point-min) (point-max)))))
+               (with-current-buffer outbuf
+                 (insert output-string)))
              (when display (display-buffer outbuf))))
        ;; When the user did interrupt, we should do it also.
        (error
@@ -3613,12 +3622,20 @@ beginning of local filename are not substituted."
   (let* ((asynchronous (string-match "[ \t]*&[ \t]*\\'" command))
         (args (split-string (substring command 0 asynchronous) " "))
         (output-buffer
-         (or output-buffer
-             (if asynchronous
-                 "*Async Shell Command*"
-               "*Shell Command Output*")))
+         (cond
+          ((bufferp output-buffer) output-buffer)
+          ((stringp output-buffer) (get-buffer-create output-buffer))
+          (output-buffer (current-buffer))
+          (t (generate-new-buffer
+              (if asynchronous
+                  "*Async Shell Command*"
+                "*Shell Command Output*")))))
+        (error-buffer
+         (cond
+          ((bufferp error-buffer) error-buffer)
+          ((stringp error-buffer) (get-buffer-create error-buffer))))
         (buffer
-         (if (and (not asynchronous) (bufferp error-buffer))
+         (if (and (not asynchronous) error-buffer)
              (with-parsed-tramp-file-name default-directory nil
                (list output-buffer (tramp-make-tramp-temp-file v)))
            output-buffer)))
@@ -3636,7 +3653,10 @@ beginning of local filename are not substituted."
       (when (listp buffer)
        (with-current-buffer error-buffer
          (insert-file-contents (cadr buffer)))
-       (delete-file (cadr buffer))))))
+       (delete-file (buffer-file-name (cadr buffer))))
+      ;; There's some output, display it.
+      (when (with-current-buffer output-buffer (> (point-max) (point-min)))
+       (display-message-or-buffer output-buffer)))))
 
 ;; File Editing.
 
@@ -3713,7 +3733,7 @@ beginning of local filename are not substituted."
       (run-hooks 'tramp-handle-file-local-copy-hook)
       tmpfil)))
 
-(defun tramp-handle-file-remote-p (file &optional identification connected)
+(defun tramp-handle-file-remote-p (filename &optional identification connected)
   "Like `file-remote-p' for Tramp files."
   (when (tramp-tramp-file-p filename)
     (with-parsed-tramp-file-name filename nil
@@ -4176,8 +4196,12 @@ Falls back to normal file name handler if no tramp file name handler exists."
         ((and completion (zerop (length localname))
               (memq operation '(file-name-as-directory)))
          filename)
-        ;; Call the backend function.
-        (foreign (apply foreign operation args))
+        ;; Call the backend function.  Set a connection property
+        ;; first, it will be reused for user/host name completion.
+        (foreign
+         (unless (zerop (length localname))
+           (tramp-set-connection-property v "started" nil))
+         (apply foreign operation args))
         ;; Nothing to do for us.
         (t (tramp-run-real-handler operation args)))))))
 
@@ -5080,53 +5104,9 @@ I.e., for each directory in `tramp-remote-path', it is tested
 whether it exists and if so, it is added to the environment
 variable PATH."
   (tramp-message vec 5 (format "Setting $PATH environment variable"))
-
-  (with-current-buffer (tramp-get-connection-buffer vec)
-    (set (make-local-variable 'tramp-remote-path)
-        (copy-tree tramp-remote-path))
-    (let* ((elt (memq 'tramp-default-remote-path tramp-remote-path))
-          (tramp-default-remote-path
-           (with-connection-property vec "default-remote-path"
-             (when elt
-               (condition-case nil
-                   (symbol-name
-                    (tramp-send-command-and-read vec "getconf PATH"))
-                 ;; Default if "getconf" is not available.
-                 (error
-                  (tramp-message
-                   vec 3
-                   "`getconf PATH' not successful, using default value \"%s\"."
-                   "/bin:/usr/bin")
-                  "/bin:/usr/bin"))))))
-      (when elt
-       ;; Replace place holder `tramp-default-remote-path'.
-       (setcdr elt
-               (append
-                (tramp-split-string tramp-default-remote-path ":")
-                (cdr elt)))
-       (setq tramp-remote-path
-             (delq 'tramp-default-remote-path tramp-remote-path))))
-
-    ;; Check for existence of directories.
-    (setq tramp-remote-path
-         (delq
-          nil
-          (mapcar
-           (lambda (x)
-             (and
-              (with-connection-property vec x
-                (file-directory-p
-                 (tramp-make-tramp-file-name
-                  (tramp-file-name-method vec)
-                  (tramp-file-name-user vec)
-                  (tramp-file-name-host vec)
-                  x)))
-              x))
-           tramp-remote-path)))
-    (tramp-send-command
-     vec
-     (format "PATH=%s; export PATH"
-            (mapconcat 'identity tramp-remote-path ":")))))
+  (tramp-send-command
+   vec (format "PATH=%s; export PATH"
+              (mapconcat 'identity (tramp-get-remote-path vec) ":"))))
 
 ;; -- communication with external shell --
 
@@ -5191,8 +5171,10 @@ file exists and nonzero exit status otherwise."
        (cond
         ((string-match "^~root$" (buffer-string))
          (setq shell
-               (or (tramp-find-executable vec "bash" tramp-remote-path t)
-                   (tramp-find-executable vec "ksh" tramp-remote-path t)))
+               (or (tramp-find-executable
+                    vec "bash" (tramp-get-remote-path vec) t)
+                   (tramp-find-executable
+                    vec "ksh" (tramp-get-remote-path vec) t)))
          (unless shell
            (tramp-error
             vec 'file-error
@@ -6115,7 +6097,8 @@ In case there is no valid Lisp expression, it raises an error"
     (condition-case nil
        (prog1 (read (current-buffer))
          ;; Error handling.
-         (when (re-search-forward "\\S-" nil t) (error)))
+         (when (re-search-forward "\\S-" (tramp-line-end-position) t)
+           (error)))
       (error (tramp-error
              vec 'file-error
              "`%s' does not return a valid Lisp expression: `%s'"
@@ -6124,7 +6107,7 @@ In case there is no valid Lisp expression, it raises an error"
 ;; It seems that Tru64 Unix does not like it if long strings are sent
 ;; to it in one go.  (This happens when sending the Perl
 ;; `file-attributes' implementation, for instance.)  Therefore, we
-;; have this function which waits a bit at each line.
+;; have this function which sends the string in chunks.
 (defun tramp-send-string (vec string)
   "Send the STRING via connection VEC.
 
@@ -6142,7 +6125,7 @@ the remote host use line-endings as defined in the variable
       ;; Clean up the buffer.  We cannot call `erase-buffer' because
       ;; narrowing might be in effect.
       (let (buffer-read-only) (delete-region (point-min) (point-max)))
-      ;; replace "\n" by `tramp-rsh-end-of-line'
+      ;; Replace "\n" by `tramp-rsh-end-of-line'.
       (setq string
            (mapconcat 'identity
                       (split-string string "\n")
@@ -6150,7 +6133,7 @@ the remote host use line-endings as defined in the variable
       (unless (or (string= string "")
                  (string-equal (substring string -1) tramp-rsh-end-of-line))
        (setq string (concat string tramp-rsh-end-of-line)))
-      ;; send the string
+      ;; Send the string.
       (if (and chunksize (not (zerop chunksize)))
          (let ((pos 0)
                (end (length string)))
@@ -6533,6 +6516,46 @@ necessary only.  This function will be used in file name completion."
 
 ;; Variables local to connection.
 
+(defun tramp-get-remote-path (vec)
+  (with-connection-property vec "remote-path"
+    (let* ((remote-path (copy-tree tramp-remote-path))
+          (elt (memq 'tramp-default-remote-path remote-path))
+          (default-remote-path
+            (when elt
+              (condition-case nil
+                  (symbol-name
+                   (tramp-send-command-and-read vec "getconf PATH"))
+                ;; Default if "getconf" is not available.
+                (error
+                 (tramp-message
+                  vec 3
+                  "`getconf PATH' not successful, using default value \"%s\"."
+                  "/bin:/usr/bin")
+                 "/bin:/usr/bin")))))
+      (when elt
+       ;; Replace place holder `tramp-default-remote-path'.
+       (setcdr elt
+               (append
+                (tramp-split-string default-remote-path ":")
+                (cdr elt)))
+       (setq remote-path (delq 'tramp-default-remote-path remote-path)))
+
+      ;; Remove non-existing directories.
+      (delq
+       nil
+       (mapcar
+       (lambda (x)
+         (and
+          (with-connection-property vec x
+            (file-directory-p
+             (tramp-make-tramp-file-name
+              (tramp-file-name-method vec)
+              (tramp-file-name-user vec)
+              (tramp-file-name-host vec)
+              x)))
+          x))
+       remote-path)))))
+
 (defun tramp-get-ls-command (vec)
   (with-connection-property vec "ls"
     (with-current-buffer (tramp-get-buffer vec)
@@ -6540,7 +6563,7 @@ necessary only.  This function will be used in file name completion."
       (or
        (catch 'ls-found
         (dolist (cmd '("ls" "gnuls" "gls"))
-          (let ((dl tramp-remote-path)
+          (let ((dl (tramp-get-remote-path vec))
                 result)
             (while
                 (and
@@ -6551,13 +6574,6 @@ necessary only.  This function will be used in file name completion."
               (when (zerop (tramp-send-command-and-check
                             vec (format "%s -lnd /" result)))
                 (throw 'ls-found result))
-              ;; Remove unneeded directories from path.
-              (while
-                  (and
-                   dl
-                   (not
-                    (string-equal result (expand-file-name cmd (car dl)))))
-                (setq dl (cdr dl)))
               (setq dl (cdr dl))))))
        (tramp-error vec 'file-error "Couldn't find a proper `ls' command")))))
 
@@ -6567,7 +6583,7 @@ necessary only.  This function will be used in file name completion."
       (tramp-message vec 5 "Finding a suitable `test' command")
       (if (zerop (tramp-send-command-and-check vec "test 0"))
          "test"
-       (tramp-find-executable vec "test" tramp-remote-path)))))
+       (tramp-find-executable vec "test" (tramp-get-remote-path vec))))))
 
 (defun tramp-get-test-nt-command (vec)
   ;; Does `test A -nt B' work?  Use abominable `find' construct if it
@@ -6601,20 +6617,21 @@ necessary only.  This function will be used in file name completion."
   (with-connection-property vec "ln"
     (with-current-buffer (tramp-get-buffer vec)
       (tramp-message vec 5 "Finding a suitable `ln' command")
-      (tramp-find-executable vec "ln" tramp-remote-path))))
+      (tramp-find-executable vec "ln" (tramp-get-remote-path vec)))))
 
 (defun tramp-get-remote-perl (vec)
   (with-connection-property vec "perl"
     (with-current-buffer (tramp-get-buffer vec)
       (tramp-message vec 5 "Finding a suitable `perl' command")
-      (or (tramp-find-executable vec "perl5" tramp-remote-path)
-         (tramp-find-executable vec "perl" tramp-remote-path)))))
+      (or (tramp-find-executable vec "perl5" (tramp-get-remote-path vec))
+         (tramp-find-executable vec "perl" (tramp-get-remote-path vec))))))
 
 (defun tramp-get-remote-stat (vec)
   (with-connection-property vec "stat"
     (with-current-buffer (tramp-get-buffer vec)
       (tramp-message vec 5 "Finding a suitable `stat' command")
-      (let ((result (tramp-find-executable vec "stat" tramp-remote-path))
+      (let ((result (tramp-find-executable
+                    vec "stat" (tramp-get-remote-path vec)))
            tmp)
        ;; Check whether stat(1) returns usable syntax.
        (when result
@@ -6636,7 +6653,7 @@ necessary only.  This function will be used in file name completion."
       (tramp-message vec 5 "Finding POSIX `id' command")
       (or
        (catch 'id-found
-        (let ((dl tramp-remote-path)
+        (let ((dl (tramp-get-remote-path vec))
               result)
           (while
               (and
@@ -6647,15 +6664,6 @@ necessary only.  This function will be used in file name completion."
             (when (zerop (tramp-send-command-and-check
                           vec (format "%s -u" result)))
               (throw 'id-found result))
-            ;; Remove unneeded directories from path.
-            (while
-                (and
-                 dl
-                 (not
-                  (string-equal
-                   result
-                   (concat (file-name-as-directory (car dl)) "id"))))
-              (setq dl (cdr dl)))
             (setq dl (cdr dl)))))
        (tramp-error vec 'file-error "Couldn't find a POSIX `id' command")))))
 
@@ -7035,7 +7043,6 @@ Only works for Bourne-like shells."
               tramp-default-user-alist
               tramp-rsh-end-of-line
               tramp-default-password-end-of-line
-              tramp-remote-path
               tramp-login-prompt-regexp
               ;; Mask non-7bit characters
               (tramp-password-prompt-regexp . tramp-reporter-dump-variable)
@@ -7350,7 +7357,6 @@ please ensure that the buffers are attached to your email.\n\n")
 ;; * Grok `append' parameter for `write-region'.
 ;; * Test remote ksh or bash for tilde expansion in `tramp-find-shell'?
 ;; * abbreviate-file-name
-;; * grok ~ in tramp-remote-path  (Henrik Holm <henrikh@tele.ntnu.no>)
 ;; * better error checking.  At least whenever we see something
 ;;   strange when doing zerop, we should kill the process and start
 ;;   again.  (Greg Stark)
@@ -7358,7 +7364,7 @@ please ensure that the buffers are attached to your email.\n\n")
 ;;   transfer method to use.  (Greg Stark)
 ;; * Remove unneeded parameters from methods.
 ;; * Invoke rsync once for copying a whole directory hierarchy.
-;;   (Francesco Potort\e,Al\e(B)
+;;   (Francesco Potortì)
 ;; * Make it work for different encodings, and for different file name
 ;;   encodings, too.  (Daniel Pittman)
 ;; * Clean up unused *tramp/foo* buffers after a while.  (Pete Forman)