]> code.delx.au - gnu-emacs/blobdiff - lisp/net/tramp.el
Merge from origin/emacs-24
[gnu-emacs] / lisp / net / tramp.el
index 17259c691597bd0b069d601540c46126fb882ecf..dc62ceeceb998d7ae63db3d91234546fdf84fc37 100644 (file)
@@ -1604,11 +1604,13 @@ an input event arrives.  The other arguments are passed to `tramp-error'."
        (when (and buf
                   tramp-message-show-message
                   (not (zerop tramp-verbose))
-                  (not (tramp-completion-mode-p)))
+                  (not (tramp-completion-mode-p))
+                  ;; Show only when Emacs has started already.
+                  (current-message))
          (let ((enable-recursive-minibuffers t))
            ;; `tramp-error' does not show messages.  So we must do it
            ;; ourselves.
-           (message fmt-string arguments)
+           (apply 'message fmt-string arguments)
            ;; Show buffer.
            (pop-to-buffer buf)
            (discard-input)
@@ -2148,13 +2150,13 @@ Falls back to normal file name handler if no Tramp file name handler exists."
                       ((eq result 'non-essential)
                        (tramp-message
                         v 5 "Non-essential received in operation %s"
-                        (append (list operation) args))
+                        (cons operation args))
                        (tramp-run-real-handler operation args))
                       ((eq result 'suppress)
                        (let (tramp-message-show-message)
                          (tramp-message
                           v 1 "Suppress received in operation %s"
-                          (append (list operation) args))
+                          (cons operation args))
                          (tramp-cleanup-connection v t)
                          (tramp-run-real-handler operation args)))
                       (t result)))
@@ -2164,7 +2166,7 @@ Falls back to normal file name handler if no Tramp file name handler exists."
                   (let (tramp-message-show-message)
                     (tramp-message
                      v 1 "Interrupt received in operation %s"
-                     (append (list operation) args)))
+                     (cons operation args)))
                   ;; Propagate the quit signal.
                   (signal (car err) (cdr err)))
 
@@ -2251,8 +2253,9 @@ Falls back to normal file name handler if no Tramp file name handler exists."
 ;;;###autoload
 (progn (defun tramp-autoload-file-name-handler (operation &rest args)
   "Load Tramp file name handler, and perform OPERATION."
-  ;; Avoid recursive loading of tramp.el.
-  (let ((default-directory temporary-file-directory))
+  ;; Avoid recursive loading of tramp.el.  `temporary-file-directory'
+  ;; does not exist in XEmacs, so we must use something else.
+  (let ((default-directory (or (symbol-value 'temporary-file-directory) "/")))
     (load "tramp" nil t))
   (apply operation args)))
 
@@ -2966,8 +2969,8 @@ User is always nil."
   (cond
    ((not (file-exists-p file1)) nil)
    ((not (file-exists-p file2)) t)
-   (t (tramp-time-less-p (nth 5 (file-attributes file2))
-                        (nth 5 (file-attributes file1))))))
+   (t (time-less-p (nth 5 (file-attributes file2))
+                  (nth 5 (file-attributes file1))))))
 
 (defun tramp-handle-file-regular-p (filename)
   "Like `file-regular-p' for Tramp files."
@@ -3083,115 +3086,118 @@ User is always nil."
   (setq filename (expand-file-name filename))
   (let (result local-copy remote-copy)
     (with-parsed-tramp-file-name filename nil
-      (with-tramp-progress-reporter
-         v 3 (format "Inserting `%s'" filename)
-       (unwind-protect
-           (if (not (file-exists-p 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)
-                        (file-readable-p localname)))
-                 ;; Short track: if we are on the local host, we can
-                 ;; run directly.
-                 (setq result
-                       (tramp-run-real-handler
-                        'insert-file-contents
-                        (list localname visit beg end replace)))
-
-               ;; When we shall insert only a part of the file, we
-               ;; copy this part.  This works only for the shell file
-               ;; name handlers.
-               (when (and (or beg end)
-                          (tramp-get-method-parameter
-                           (tramp-file-name-method v) 'tramp-login-program))
-                 (setq remote-copy (tramp-make-tramp-temp-file v))
-                 ;; This is defined in tramp-sh.el.  Let's assume
-                 ;; this is loaded already.
-                 (tramp-compat-funcall
-                  'tramp-send-command
-                  v
-                  (cond
-                   ((and beg end)
-                    (format "dd bs=1 skip=%d if=%s count=%d of=%s"
-                            beg (tramp-shell-quote-argument localname)
-                            (- end beg) remote-copy))
-                   (beg
-                    (format "dd bs=1 skip=%d if=%s of=%s"
-                            beg (tramp-shell-quote-argument localname)
-                            remote-copy))
-                   (end
-                    (format "dd bs=1 count=%d if=%s of=%s"
-                            end (tramp-shell-quote-argument localname)
-                            remote-copy))))
-                 (setq tramp-temp-buffer-file-name nil beg nil end nil))
-
-               ;; `insert-file-contents-literally' takes care to
-               ;; avoid calling jka-compr.  By let-binding
-               ;; `inhibit-file-name-operation', we propagate that
-               ;; care to the `file-local-copy' operation.
-               (setq local-copy
-                     (let ((inhibit-file-name-operation
-                            (when (eq inhibit-file-name-operation
-                                      'insert-file-contents)
-                              'file-local-copy)))
-                       (cond
-                        ((stringp remote-copy)
-                         (file-local-copy
-                          (tramp-make-tramp-file-name
-                           method user host remote-copy)))
-                        ((stringp tramp-temp-buffer-file-name)
-                         (copy-file filename tramp-temp-buffer-file-name 'ok)
-                         tramp-temp-buffer-file-name)
-                        (t (file-local-copy filename)))))
-
-               ;; When the file is not readable for the owner, it
-               ;; cannot be inserted, even if it is readable for the
-               ;; group or for everybody.
-               (set-file-modes
-                local-copy (tramp-compat-octal-to-decimal "0600"))
-
-               (when (and (null remote-copy)
-                          (tramp-get-method-parameter
-                           method 'tramp-copy-keep-tmpfile))
-                 ;; We keep the local file for performance reasons,
-                 ;; useful for "rsync".
-                 (setq tramp-temp-buffer-file-name local-copy))
-
-               ;; We must ensure that `file-coding-system-alist'
-               ;; matches `local-copy'.  We must also use `visit',
-               ;; otherwise there might be an error in the
-               ;; `revert-buffer' function under XEmacs.
-               (let ((file-coding-system-alist
-                      (tramp-find-file-name-coding-system-alist
-                       filename local-copy)))
-                 (setq result
-                       (insert-file-contents
-                        local-copy visit beg end replace)))))
-
-         ;; Save exit.
-         (progn
-           (when visit
-             (setq buffer-file-name filename)
-             (setq buffer-read-only (not (file-writable-p filename)))
-             (set-visited-file-modtime)
-             (set-buffer-modified-p nil))
-           (when (and (stringp local-copy)
-                      (or remote-copy (null tramp-temp-buffer-file-name)))
-             (delete-file local-copy))
-           (when (stringp remote-copy)
-             (delete-file
-              (tramp-make-tramp-file-name method user host remote-copy)))))))
-
-    ;; Result.
-    (list (expand-file-name filename)
-         (cadr result))))
+      (unwind-protect
+         (if (not (file-exists-p filename))
+             (tramp-error
+              v 'file-error "File `%s' not found on remote host" filename)
+
+           (with-tramp-progress-reporter
+               v 3 (format "Inserting `%s'" filename)
+             (condition-case err
+                 (if (and (tramp-local-host-p v)
+                          (let (file-name-handler-alist)
+                            (file-readable-p localname)))
+                     ;; Short track: if we are on the local host, we can
+                     ;; run directly.
+                     (setq result
+                           (tramp-run-real-handler
+                            'insert-file-contents
+                            (list localname visit beg end replace)))
+
+                   ;; When we shall insert only a part of the file, we
+                   ;; copy this part.  This works only for the shell file
+                   ;; name handlers.
+                   (when (and (or beg end)
+                              (tramp-get-method-parameter
+                               (tramp-file-name-method v)
+                               'tramp-login-program))
+                     (setq remote-copy (tramp-make-tramp-temp-file v))
+                     ;; This is defined in tramp-sh.el.  Let's assume
+                     ;; this is loaded already.
+                     (tramp-compat-funcall
+                      'tramp-send-command
+                      v
+                      (cond
+                       ((and beg end)
+                        (format "dd bs=1 skip=%d if=%s count=%d of=%s"
+                                beg (tramp-shell-quote-argument localname)
+                                (- end beg) remote-copy))
+                       (beg
+                        (format "dd bs=1 skip=%d if=%s of=%s"
+                                beg (tramp-shell-quote-argument localname)
+                                remote-copy))
+                       (end
+                        (format "dd bs=1 count=%d if=%s of=%s"
+                                end (tramp-shell-quote-argument localname)
+                                remote-copy))))
+                     (setq tramp-temp-buffer-file-name nil beg nil end nil))
+
+                   ;; `insert-file-contents-literally' takes care to
+                   ;; avoid calling jka-compr.  By let-binding
+                   ;; `inhibit-file-name-operation', we propagate that
+                   ;; care to the `file-local-copy' operation.
+                   (setq local-copy
+                         (let ((inhibit-file-name-operation
+                                (when (eq inhibit-file-name-operation
+                                          'insert-file-contents)
+                                  'file-local-copy)))
+                           (cond
+                            ((stringp remote-copy)
+                             (file-local-copy
+                              (tramp-make-tramp-file-name
+                               method user host remote-copy)))
+                            ((stringp tramp-temp-buffer-file-name)
+                             (copy-file
+                              filename tramp-temp-buffer-file-name 'ok)
+                             tramp-temp-buffer-file-name)
+                            (t (file-local-copy filename)))))
+
+                   ;; When the file is not readable for the owner, it
+                   ;; cannot be inserted, even if it is readable for the
+                   ;; group or for everybody.
+                   (set-file-modes
+                    local-copy (tramp-compat-octal-to-decimal "0600"))
+
+                   (when (and (null remote-copy)
+                              (tramp-get-method-parameter
+                               method 'tramp-copy-keep-tmpfile))
+                     ;; We keep the local file for performance reasons,
+                     ;; useful for "rsync".
+                     (setq tramp-temp-buffer-file-name local-copy))
+
+                   ;; We must ensure that `file-coding-system-alist'
+                   ;; matches `local-copy'.  We must also use `visit',
+                   ;; otherwise there might be an error in the
+                   ;; `revert-buffer' function under XEmacs.
+                   (let ((file-coding-system-alist
+                          (tramp-find-file-name-coding-system-alist
+                           filename local-copy)))
+                     (setq result
+                           (insert-file-contents
+                            local-copy visit beg end replace))))
+               (error
+                (add-hook 'find-file-not-found-functions
+                          `(lambda () (signal ',(car err) ',(cdr err)))
+                          nil t)
+                (signal (car err) (cdr err))))))
+
+       ;; Save exit.
+       (progn
+         (when visit
+           (setq buffer-file-name filename)
+           (setq buffer-read-only (not (file-writable-p filename)))
+           (set-visited-file-modtime)
+           (set-buffer-modified-p nil))
+         (when (and (stringp local-copy)
+                    (or remote-copy (null tramp-temp-buffer-file-name)))
+           (delete-file local-copy))
+         (when (stringp remote-copy)
+           (delete-file
+            (tramp-make-tramp-file-name method user host remote-copy)))))
+
+      ;; Result.
+      (list (expand-file-name filename)
+           (cadr result)))))
 
 (defun tramp-handle-load (file &optional noerror nomessage nosuffix must-suffix)
   "Like `load' for Tramp files."
@@ -3223,7 +3229,7 @@ User is always nil."
       t)))
 
 (defun tramp-handle-make-symbolic-link
-  (filename linkname &optional ok-if-already-exists)
+  (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
@@ -3289,11 +3295,12 @@ User is always nil."
            ;; Run the process.
            (setq p (apply 'start-file-process "*Async Shell*" buffer args))
          ;; Display output.
-         (pop-to-buffer output-buffer)
-         (setq mode-line-process '(":%s"))
-         (shell-mode)
-         (set-process-sentinel p 'shell-command-sentinel)
-         (set-process-filter p 'comint-output-filter))
+         (with-current-buffer output-buffer
+           (display-buffer output-buffer '(nil (allow-no-window . t)))
+           (setq mode-line-process '(":%s"))
+           (shell-mode)
+           (set-process-sentinel p 'shell-command-sentinel)
+           (set-process-filter p 'comint-output-filter)))
 
       (prog1
          ;; Run the process.
@@ -3441,9 +3448,9 @@ of."
       ;; 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)
+      (unless (tramp-get-connection-property vec "first-password-request" nil)
        (tramp-clear-passwd vec))
+      (goto-char (point-min))
       (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
@@ -3605,15 +3612,19 @@ connection buffer."
 This is needed in order to hide `last-coding-system-used', which is set
 for process communication also."
   (with-current-buffer (process-buffer proc)
-    (tramp-message proc 10 "%s %s" proc (process-status proc))
-    (let (buffer-read-only last-coding-system-used)
+    ;; FIXME: If there is a gateway process, we need communication
+    ;; between several processes.  Too complicate to implement, so we
+    ;; read output from all proceeses.
+    (let ((p (if (tramp-get-connection-property proc "gateway" nil) nil proc))
+         buffer-read-only last-coding-system-used)
       ;; Under Windows XP, accept-process-output doesn't return
       ;; sometimes.  So we add an additional timeout.
       (with-timeout ((or timeout 1))
        (if (featurep 'xemacs)
-           (accept-process-output proc timeout timeout-msecs)
-         (accept-process-output proc timeout timeout-msecs (and proc t)))))
-    (tramp-message proc 10 "\n%s" (buffer-string))))
+           (accept-process-output p timeout timeout-msecs)
+         (accept-process-output p timeout timeout-msecs (and proc t))))
+      (tramp-message proc 10 "%s %s %s\n%s"
+                    proc (process-status proc) p (buffer-string)))))
 
 (defun tramp-check-for-regexp (proc regexp)
   "Check, whether REGEXP is contained in process buffer of PROC.
@@ -3916,7 +3927,8 @@ be granted."
                  (tramp-file-name-method vec)
                  (tramp-file-name-user vec)
                  (tramp-file-name-host vec)
-                 (tramp-file-name-localname vec))
+                 (tramp-file-name-localname vec)
+                 (tramp-file-name-hop vec))
                 (intern suffix))))
               (remote-uid
                (tramp-get-connection-property
@@ -4167,7 +4179,8 @@ Invokes `password-read' if available, `read-passwd' else."
                (tramp-check-for-regexp proc tramp-password-prompt-regexp)
                (format "%s for %s " (capitalize (match-string 1)) key))))
         ;; We suspend the timers while reading the password.
-         (stimers (with-timeout-suspend))
+         (stimers (and (functionp 'with-timeout-suspend)
+                      (tramp-compat-funcall 'with-timeout-suspend)))
         auth-info auth-passwd)
 
     (unwind-protect
@@ -4178,25 +4191,27 @@ Invokes `password-read' if available, `read-passwd' else."
               ;; it's bound.  `auth-source-user-or-password' is an
               ;; obsoleted function, it has been replaced by
               ;; `auth-source-search'.
-              (and (boundp 'auth-sources)
-                   (tramp-get-connection-property
-                    v "first-password-request" nil)
-                   ;; Try with Tramp's current method.
-                   (if (fboundp 'auth-source-search)
-                       (setq auth-info
-                             (tramp-compat-funcall
-                              'auth-source-search
-                              :max 1
-                              :user (or tramp-current-user t)
-                              :host tramp-current-host
-                              :port tramp-current-method)
-                             auth-passwd (plist-get (nth 0 auth-info) :secret)
-                             auth-passwd (if (functionp auth-passwd)
-                                             (funcall auth-passwd)
-                                           auth-passwd))
-                     (tramp-compat-funcall
-                      'auth-source-user-or-password
-                      "password" tramp-current-host tramp-current-method)))
+              (ignore-errors
+                (and (boundp 'auth-sources)
+                     (tramp-get-connection-property
+                      v "first-password-request" nil)
+                     ;; Try with Tramp's current method.
+                     (if (fboundp 'auth-source-search)
+                         (setq auth-info
+                               (tramp-compat-funcall
+                                'auth-source-search
+                                :max 1
+                                :user (or tramp-current-user t)
+                                :host tramp-current-host
+                                :port tramp-current-method)
+                               auth-passwd (plist-get
+                                            (nth 0 auth-info) :secret)
+                               auth-passwd (if (functionp auth-passwd)
+                                               (funcall auth-passwd)
+                                             auth-passwd))
+                       (tramp-compat-funcall
+                        'auth-source-user-or-password
+                        "password" tramp-current-host tramp-current-method))))
               ;; Try the password cache.
               (when (functionp 'password-read)
                 (let ((password
@@ -4207,7 +4222,8 @@ Invokes `password-read' if available, `read-passwd' else."
               (read-passwd pw-prompt))
            (tramp-set-connection-property v "first-password-request" nil)))
       ;; Reenable the timers.
-      (with-timeout-unsuspend stimers))))
+      (and (functionp 'with-timeout-unsuspend)
+          (tramp-compat-funcall 'with-timeout-unsuspend stimers)))))
 
 ;;;###tramp-autoload
 (defun tramp-clear-passwd (vec)
@@ -4232,26 +4248,6 @@ Invokes `password-read' if available, `read-passwd' else."
     ("oct" . 10) ("nov" . 11) ("dec" . 12))
   "Alist mapping month names to integers.")
 
-;; FIXME: Shouldn't this also look at any subseconds parts of T1 and T2?
-;;;###tramp-autoload
-(defun tramp-time-less-p (t1 t2)
-  "Say whether time value T1 is less than time value T2."
-  (unless t1 (setq t1 '(0 0)))
-  (unless t2 (setq t2 '(0 0)))
-  (or (< (car t1) (car t2))
-      (and (= (car t1) (car t2))
-          (< (nth 1 t1) (nth 1 t2)))))
-
-;; FIXME: Shouldn't this also look at any subseconds parts of T1 and T2?
-(defun tramp-time-subtract (t1 t2)
-  "Subtract two time values.
-Return the difference in the format of a time value."
-  (unless t1 (setq t1 '(0 0)))
-  (unless t2 (setq t2 '(0 0)))
-  (let ((borrow (< (cadr t1) (cadr t2))))
-    (list (- (car t1) (car t2) (if borrow 1 0))
-         (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
-
 ;;;###tramp-autoload
 (defun tramp-time-diff (t1 t2)
   "Return the difference between the two times, in seconds.
@@ -4270,7 +4266,7 @@ T1 and T2 are time values (as returned by `current-time' for example)."
          (if (< (length t1) 3) (append t1 '(0)) t1)
          (if (< (length t2) 3) (append t2 '(0)) t2)))
         (t
-        (let ((time (tramp-time-subtract t1 t2)))
+        (let ((time (time-subtract t1 t2)))
           (+ (* (car time) 65536.0)
              (cadr time)
              (/ (or (nth 2 time) 0) 1000000.0))))))