]> code.delx.au - gnu-emacs/blobdiff - lisp/net/tramp.el
nnimap respool fix
[gnu-emacs] / lisp / net / tramp.el
index f076f043c5f651f08b662e6fc51927170767efd2..face017946dcb32a1b9b5d682551c0bbfe69e1a8 100644 (file)
@@ -1,6 +1,6 @@
 ;;; tramp.el --- Transparent Remote Access, Multiple Protocol
 
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2014 Free Software Foundation, Inc.
 
 ;; Author: Kai Großjohann <kai.grossjohann@gmx.net>
 ;;         Michael Albinus <michael.albinus@gmx.de>
@@ -49,9 +49,8 @@
 ;;            http://lists.gnu.org/mailman/listinfo/tramp-devel
 ;;
 ;; For the adventurous, the current development sources are available
-;; via CVS.  You can find instructions about this at the following URL:
+;; via Git.  You can find instructions about this at the following URL:
 ;;            http://savannah.gnu.org/projects/tramp/
-;; Click on "CVS" in the navigation bar near the top.
 ;;
 ;; Don't forget to put on your asbestos longjohns, first!
 
@@ -66,6 +65,7 @@
 (defvar directory-sep-char)
 (defvar eshell-path-env)
 (defvar file-notify-descriptors)
+(defvar ls-lisp-use-insert-directory-program)
 (defvar outline-regexp)
 
 ;;; User Customizable Internal Variables:
@@ -265,15 +265,6 @@ pair of the form (KEY VALUE).  The following KEYs are defined:
     In general, the global default value shall be used, but for
     some methods, like \"su\" or \"sudo\", a shorter timeout
     might be desirable.
-  * `tramp-hostname-checker'
-    This is a function that tramp calls while setting
-    up a connection.  It is called with three arguments:
-    the target, the host, and the method description.  If
-    the hostname is unacceptable, this function should signal
-    using `tramp-error'.  If a method does not provide
-    a value here, then Tramp looks at whether the method's
-    login program uses a \"%h\" parameter.  If not, then Tramp
-    requires that the given hostname match `tramp-local-host-regexp'. 
 
 What does all this mean?  Well, you should specify `tramp-login-program'
 for all methods; this program is used to log in to the remote site.  Then,
@@ -575,11 +566,15 @@ This regexp must match both `tramp-initial-end-of-output' and
   :type 'regexp)
 
 (defcustom tramp-password-prompt-regexp
-  "^.*\\([pP]assword\\|[pP]assphrase\\).*:\^@? *"
+  (format "^.*\\(%s\\).*:\^@? *"
+         (if (boundp 'password-word-equivalents)
+             (regexp-opt (symbol-value 'password-word-equivalents))
+           "password\\|passphrase"))
   "Regexp matching password-like prompts.
 The regexp should match at end of buffer.
 
 The `sudo' program appears to insert a `^@' character into the prompt."
+  :version "24.4"
   :group 'tramp
   :type 'regexp)
 
@@ -857,7 +852,7 @@ Derived from `tramp-postfix-host-format'.")
    "\\(?:" "\\("   tramp-method-regexp "\\)" tramp-postfix-method-regexp "\\)?"
    "\\(?:" "\\("   tramp-user-regexp   "\\)" tramp-postfix-user-regexp   "\\)?"
    "\\("   "\\(?:" tramp-host-regexp   "\\|"
-                  tramp-prefix-ipv6-regexp  tramp-ipv6-regexp
+                  tramp-prefix-ipv6-regexp  "\\(?:" tramp-ipv6-regexp "\\)?"
                                             tramp-postfix-ipv6-regexp "\\)"
           "\\(?:" tramp-prefix-port-regexp  tramp-port-regexp "\\)?" "\\)?")
 "Regular expression matching a Tramp file name between prefix and postfix.")
@@ -893,8 +888,8 @@ See also `tramp-file-name-regexp'.")
 ;;;###autoload
 (defconst tramp-file-name-regexp-unified
   (if (memq system-type '(cygwin windows-nt))
-      "\\`/\\([^[/|:]\\{2,\\}\\|[^/|]\\{2,\\}]\\):"
-    "\\`/\\([^[/|:]+\\|[^/|]+]\\):")
+      "\\`/\\(\\[.*\\]\\|[^/|:]\\{2,\\}[^/|]*\\):"
+    "\\`/[^/|:][^/|]*:")
   "Value for `tramp-file-name-regexp' for unified remoting.
 Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and
 Tramp.  See `tramp-file-name-structure' for more explanations.
@@ -1565,12 +1560,13 @@ signal identifier to be raised, remaining arguments passed to
 `tramp-message'.  Finally, signal SIGNAL is raised."
   (let (tramp-message-show-message)
     (tramp-backtrace vec-or-proc)
-    (tramp-message
-     vec-or-proc 1 "%s"
-     (error-message-string
-      (list signal
-           (get signal 'error-message)
-           (apply 'format fmt-string arguments))))
+    (when vec-or-proc
+      (tramp-message
+       vec-or-proc 1 "%s"
+       (error-message-string
+       (list signal
+             (get signal 'error-message)
+             (apply 'format fmt-string arguments)))))
     (signal signal (list (apply 'format fmt-string arguments)))))
 
 (defsubst tramp-error-with-buffer
@@ -2029,8 +2025,8 @@ ARGS are the arguments OPERATION has been called with."
                  'vm-imap-move-mail 'vm-pop-move-mail 'vm-spool-move-mail))
     (save-match-data
       (cond
-       ((string-match tramp-file-name-regexp (nth 0 args)) (nth 0 args))
-       ((string-match tramp-file-name-regexp (nth 1 args)) (nth 1 args))
+       ((tramp-tramp-file-p (nth 0 args)) (nth 0 args))
+       ((tramp-tramp-file-p (nth 1 args)) (nth 1 args))
        (t (buffer-file-name (current-buffer))))))
    ;; START END FILE.
    ((eq operation 'write-region)
@@ -3012,6 +3008,38 @@ User is always nil."
 
       (tramp-run-real-handler 'find-backup-file-name (list filename)))))
 
+(defun tramp-handle-insert-directory
+  (filename switches &optional wildcard full-directory-p)
+  "Like `insert-directory' for Tramp files."
+  (unless switches (setq switches ""))
+  ;; Mark trailing "/".
+  (when (and (zerop (length (file-name-nondirectory filename)))
+            (not full-directory-p))
+    (setq switches (concat switches "F")))
+  (with-parsed-tramp-file-name (expand-file-name filename) nil
+    (with-tramp-progress-reporter v 0 (format "Opening directory %s" filename)
+      (require 'ls-lisp)
+      (let (ls-lisp-use-insert-directory-program start)
+       (tramp-run-real-handler
+        'insert-directory
+        (list filename switches wildcard full-directory-p))
+       ;; `ls-lisp' always returns full listings.  We must remove
+       ;; superfluous parts.
+       (unless (string-match "l" switches)
+         (save-excursion
+           (goto-char (point-min))
+           (while (setq start
+                        (text-property-not-all
+                         (point) (point-at-eol) 'dired-filename t))
+             (delete-region
+              start
+              (or (text-property-any start (point-at-eol) 'dired-filename t)
+                  (point-at-eol)))
+             (if (=  (point-at-bol) (point-at-eol))
+                 ;; Empty line.
+                 (delete-region (point) (progn (forward-line) (point)))
+               (forward-line)))))))))
+
 (defun tramp-handle-insert-file-contents
   (filename &optional visit beg end replace)
   "Like `insert-file-contents' for Tramp files."
@@ -3023,10 +3051,13 @@ User is always nil."
          v 3 (format "Inserting `%s'" filename)
        (unwind-protect
            (if (not (file-exists-p filename))
-               ;; We don't raise a Tramp error, because it might be
-               ;; suppressed, like in `find-file-noselect-1'.
-               (signal 'file-error
-                       (list "File not found on remote host" filename))
+               (progn
+                 ;; We don't raise a Tramp error, because it might be
+                 ;; suppressed, like in `find-file-noselect-1'.
+                 (tramp-message
+                  v 1 "File not `%s' found on remote host" filename)
+                 (signal 'file-error
+                         (list "File not found on remote host" filename)))
 
              (if (and (tramp-local-host-p v)
                       (let (file-name-handler-alist)
@@ -3150,12 +3181,18 @@ User is always nil."
       (let ((tramp-message-show-message (not nomessage)))
        (with-tramp-progress-reporter v 0 (format "Loading %s" file)
          (let ((local-copy (file-local-copy file)))
-           ;; MUST-SUFFIX doesn't exist on XEmacs, so let it default to nil.
            (unwind-protect
-               (load local-copy noerror t t)
+               (tramp-compat-load local-copy noerror t nosuffix must-suffix)
              (delete-file local-copy)))))
       t)))
 
+(defun tramp-handle-make-symbolic-link
+  (filename linkname &optional ok-if-already-exists)
+  "Like `make-symbolic-link' for Tramp files."
+  (with-parsed-tramp-file-name
+      (if (tramp-tramp-file-p filename) filename linkname) nil
+    (tramp-error v 'file-error "make-symbolic-link not supported")))
+
 (defun tramp-handle-shell-command
   (command &optional output-buffer error-buffer)
   "Like `shell-command' for Tramp files."
@@ -3258,7 +3295,9 @@ User is always nil."
       ;; "/m:h:~" does not work for completion.  We use "/m:h:~/".
       (when (string-match "~$" filename)
        (setq filename (concat filename "/"))))
-    (tramp-run-real-handler 'substitute-in-file-name (list filename))))
+    ;; We do not want to replace environment variables, again.
+    (let (process-environment)
+      (tramp-run-real-handler 'substitute-in-file-name (list filename)))))
 
 (defun tramp-handle-unhandled-file-name-directory (_filename)
   "Like `unhandled-file-name-directory' for Tramp files."
@@ -3360,7 +3399,14 @@ of."
 (defun tramp-action-password (proc vec)
   "Query the user for a password."
   (with-current-buffer (process-buffer proc)
-    (let ((enable-recursive-minibuffers t))
+    (let ((enable-recursive-minibuffers t)
+         (case-fold-search t))
+      ;; Let's check whether a wrong password has been sent already.
+      ;; Sometimes, the process returns a new password request
+      ;; immediately after rejecting the previous (wrong) one.
+      (goto-char (point-min))
+      (when (search-forward-regexp tramp-wrong-passwd-regexp nil t)
+       (tramp-clear-passwd vec))
       (tramp-check-for-regexp proc tramp-password-prompt-regexp)
       (tramp-message vec 3 "Sending %s" (match-string 1))
       ;; We don't call `tramp-send-string' in order to hide the
@@ -3446,7 +3492,8 @@ The terminal type can be configured with `tramp-terminal-type'."
 
 (defun tramp-process-one-action (proc vec actions)
   "Wait for output from the shell and perform one action."
-  (let (found todo item pattern action)
+  (let ((case-fold-search t)
+       found todo item pattern action)
     (while (not found)
       ;; Reread output once all actions have been performed.
       ;; Obviously, the output was not complete.
@@ -3468,8 +3515,8 @@ The terminal type can be configured with `tramp-terminal-type'."
 PROC and VEC indicate the remote connection to be used.  POS, if
 set, is the starting point of the region to be deleted in the
 connection buffer."
-  ;; Enable `auth-source' and `password-cache'.  We must use
-  ;; tramp-current-* variables in case we have several hops.
+  ;; Enable `auth-source'.  We must use tramp-current-* variables in
+  ;; case we have several hops.
   (tramp-set-connection-property
    (tramp-dissect-file-name
     (tramp-make-tramp-file-name
@@ -3821,9 +3868,17 @@ be granted."
        (or
         result
         (let ((file-attr
-               (tramp-get-file-property
-                vec (tramp-file-name-localname vec)
-                (concat "file-attributes-" suffix) nil))
+              (or
+               (tramp-get-file-property
+                vec (tramp-file-name-localname vec)
+                (concat "file-attributes-" suffix) nil)
+               (file-attributes
+                (tramp-make-tramp-file-name
+                 (tramp-file-name-method vec)
+                 (tramp-file-name-user vec)
+                 (tramp-file-name-host vec)
+                 (tramp-file-name-localname vec))
+                (intern suffix))))
               (remote-uid
                (tramp-get-connection-property
                 vec (concat "uid-" suffix) nil))
@@ -4037,7 +4092,7 @@ Lisp error raised when PROGRAM is nil is trapped also, returning 1.
 Furthermore, traces are written with verbosity of 6."
   (tramp-message
    (vector tramp-current-method tramp-current-user tramp-current-host nil nil)
-   6 "%s %s %s" program infile args)
+   6 "`%s %s' %s" program (mapconcat 'identity args " ") infile)
   (if (executable-find program)
       (apply 'call-process program infile destination display args)
     1))
@@ -4047,7 +4102,8 @@ Furthermore, traces are written with verbosity of 6."
   "Read a password from user (compat function).
 Consults the auth-source package.
 Invokes `password-read' if available, `read-passwd' else."
-  (let* ((key (tramp-make-tramp-file-name
+  (let* ((case-fold-search t)
+        (key (tramp-make-tramp-file-name
               tramp-current-method tramp-current-user
               tramp-current-host ""))
         (pw-prompt
@@ -4082,9 +4138,6 @@ Invokes `password-read' if available, `read-passwd' else."
                    "password" tramp-current-host tramp-current-method)))
           ;; Try the password cache.
           (when (functionp 'password-read)
-            (unless (tramp-get-connection-property
-                     v "first-password-request" nil)
-              (tramp-compat-funcall 'password-cache-remove key))
             (let ((password
                    (tramp-compat-funcall 'password-read pw-prompt key)))
               (tramp-compat-funcall 'password-cache-add key password)
@@ -4267,11 +4320,6 @@ Only works for Bourne-like shells."
 ;;   tramp-server-local-variable-alist) to define any such variables
 ;;   that they need to, which would then be let bound as appropriate
 ;;   in tramp functions.  (Jason Rumney)
-;; * IMHO, it's a drawback that currently Tramp doesn't support
-;;   Unicode in Dired file names by default.  Is it possible to
-;;   improve Tramp to set LC_ALL to "C" only for commands where Tramp
-;;   expects English?  Or just to set LC_MESSAGES to "C" if Tramp
-;;   expects only English messages?  (Juri Linkov)
 ;; * Make shadowfile.el grok Tramp filenames.  (Bug#4526, Bug#4846)
 ;; * I was wondering if it would be possible to use tramp even if I'm
 ;;   actually using sshfs.  But when I launch a command I would like