From 0f205eeefa5af8c4a61fd26c58ff3c4af9106728 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 24 Aug 2007 05:27:22 +0000 Subject: [PATCH] * net/tramp.el (tramp-local-host-p): New defun. (tramp-handle-file-local-copy, tramp-handle-write-region): Implement fast track when being on the local host. (tramp-file-name-handler): Don't set "started" property. It shall be reserved for the "ftp" method. (tramp-make-copy-program-file-name): Use `tramp-file-name-real-host'. * net/tramp-ftp.el (top): Autoload `tramp-set-connection-property'. (tramp-ftp-file-name-handler): Set "started" property. --- lisp/ChangeLog | 14 +++- lisp/net/tramp-ftp.el | 31 +++++---- lisp/net/tramp.el | 150 +++++++++++++++++++++++------------------- 3 files changed, 114 insertions(+), 81 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index cac2d1c269f..e6d8ec1b3e1 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,15 @@ +2007-08-24 Michael Albinus + + * net/tramp.el (tramp-local-host-p): New defun. + (tramp-handle-file-local-copy, tramp-handle-write-region): + Implement fast track when being on the local host. + (tramp-file-name-handler): Don't set "started" property. It shall + be reserved for the "ftp" method. + (tramp-make-copy-program-file-name): Use `tramp-file-name-real-host'. + + * net/tramp-ftp.el (top): Autoload `tramp-set-connection-property'. + (tramp-ftp-file-name-handler): Set "started" property. + 2007-08-24 Ulrich Mueller (tiny change) * files.el (backup-buffer-copy): Don't wrap delete in @@ -1630,7 +1642,7 @@ Sync with Tramp 2.1.10. - * net/tramp.el (tramp-get-ls-command): Fyx typo. + * net/tramp.el (tramp-get-ls-command): Fix typo. * net/trampver.el: Update release number. diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el index f3d7a3aadf1..6fe069636f7 100644 --- a/lisp/net/tramp-ftp.el +++ b/lisp/net/tramp-ftp.el @@ -30,6 +30,7 @@ ;;; Code: (require 'tramp) +(autoload 'tramp-set-connection-property "tramp-cache") (eval-when-compile (require 'custom)) @@ -137,19 +138,25 @@ pass to the OPERATION." (ange-ftp-ftp-name-arg "") (ange-ftp-ftp-name-res nil)) (cond - ;; If argument is a symlink, `file-directory-p' and `file-exists-p' - ;; call the traversed file recursively. So we cannot disable the - ;; file-name-handler this case. + ;; If argument is a symlink, `file-directory-p' and + ;; `file-exists-p' call the traversed file recursively. So we + ;; cannot disable the file-name-handler this case. We set the + ;; connection property "started" in order to put the remote + ;; location into the cache, which is helpful for further + ;; completion. ((memq operation '(file-directory-p file-exists-p)) - (apply 'ange-ftp-hook-function operation args)) - ;; Normally, the handlers must be discarded - (t (let* ((inhibit-file-name-handlers - (list 'tramp-file-name-handler - 'tramp-completion-file-name-handler - (and (eq inhibit-file-name-operation operation) - inhibit-file-name-handlers))) - (inhibit-file-name-operation operation)) - (apply 'ange-ftp-hook-function operation args))))))) + (if (apply 'ange-ftp-hook-function operation args) + (with-parsed-tramp-file-name (car args) nil + (tramp-set-connection-property v "started" t)) + nil)) + ;; Normally, the handlers must be discarded. + (t (let* ((inhibit-file-name-handlers + (list 'tramp-file-name-handler + 'tramp-completion-file-name-handler + (and (eq inhibit-file-name-operation operation) + inhibit-file-name-handlers))) + (inhibit-file-name-operation operation)) + (apply 'ange-ftp-hook-function operation args))))))) (defun tramp-ftp-file-name-p (filename) "Check if it's a filename that should be forwarded to Ange-FTP." diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 9f326800f0e..85f9287fca8 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3665,14 +3665,9 @@ beginning of local filename are not substituted." (defun tramp-handle-file-local-copy (filename) "Like `file-local-copy' for Tramp files." + (with-parsed-tramp-file-name filename nil - (let (;; We used to bind the following as late as possible. - ;; loc-dec was bound directly before the if statement that - ;; checks them. But the functions tramp-get-* might invoke - ;; the "are you awake" check in `tramp-maybe-open-connection', - ;; which is an unfortunate time since we rely on the buffer - ;; contents at that spot. - (rem-enc (tramp-get-remote-coding v "remote-encoding")) + (let ((rem-enc (tramp-get-remote-coding v "remote-encoding")) (loc-dec (tramp-get-local-coding v "local-decoding")) tmpfil) (unless (file-exists-p filename) @@ -3681,55 +3676,59 @@ beginning of local filename are not substituted." "Cannot make local copy of non-existing file `%s'" filename)) (setq tmpfil (tramp-make-temp-file filename)) - (cond ((and (tramp-method-out-of-band-p v) - (> (nth 7 (file-attributes filename)) - tramp-copy-size-limit)) - ;; `copy-file' handles out-of-band methods - (copy-file filename tmpfil t t)) - - (rem-enc - ;; Use inline encoding for file transfer. - (save-excursion - (tramp-message v 5 "Encoding remote file %s..." filename) - (tramp-barf-unless-okay - v - (concat rem-enc " < " (tramp-shell-quote-argument localname)) - "Encoding remote file failed") - - (tramp-message v 5 "Decoding remote file %s..." filename) - ;; Here is where loc-dec used to be let-bound. - (if (and (symbolp loc-dec) (fboundp loc-dec)) - ;; If local decoding is a function, we call it. We - ;; must disable multibyte, because - ;; `uudecode-decode-region' doesn't handle it - ;; correctly. - (unwind-protect - (with-temp-buffer - (set-buffer-multibyte nil) - (insert-buffer-substring (tramp-get-buffer v)) - (tramp-message - v 5 "Decoding remote file %s with function %s..." - filename loc-dec) - (funcall loc-dec (point-min) (point-max)) - (let ((coding-system-for-write 'binary)) - (write-region (point-min) (point-max) tmpfil)))) - ;; If tramp-decoding-function is not defined for this - ;; method, we invoke tramp-decoding-command instead. - (let ((tmpfil2 (tramp-make-temp-file filename))) - (let ((coding-system-for-write 'binary)) - (write-region (point-min) (point-max) tmpfil2)) - (tramp-message - v 5 "Decoding remote file %s with command %s..." - filename loc-dec) - (tramp-call-local-coding-command - loc-dec tmpfil2 tmpfil) - (delete-file tmpfil2))) - (tramp-message v 5 "Decoding remote file %s...done" filename) - ;; Set proper permissions. - (set-file-modes tmpfil (file-modes filename)))) - - (t (tramp-error - v 'file-error "Wrong method specification for `%s'" method))) + (cond + ;; Fast track on local machine. + ((tramp-local-host-p v) + (tramp-do-copy-or-rename-file-directly 'copy v localname tmpfil t) + (tramp-send-command v (format "chown %s %s" (user-login-name) tmpfil))) + + ;; `copy-file' handles out-of-band methods. + ((and (tramp-method-out-of-band-p v) + (> (nth 7 (file-attributes filename)) tramp-copy-size-limit)) + (copy-file filename tmpfil t t)) + + ;; Use inline encoding for file transfer. + (rem-enc + (save-excursion + (tramp-message v 5 "Encoding remote file %s..." filename) + (tramp-barf-unless-okay + v (format "%s < %s" rem-enc (tramp-shell-quote-argument localname)) + "Encoding remote file failed") + (tramp-message v 5 "Encoding remote file %s...done" filename) + + (tramp-message v 5 "Decoding remote file %s..." filename) + (if (and (symbolp loc-dec) (fboundp loc-dec)) + ;; If local decoding is a function, we call it. We must + ;; disable multibyte, because `uudecode-decode-region' + ;; doesn't handle it correctly. + (unwind-protect + (with-temp-buffer + (set-buffer-multibyte nil) + (insert-buffer-substring (tramp-get-buffer v)) + (tramp-message + v 5 "Decoding remote file %s with function %s..." + filename loc-dec) + (funcall loc-dec (point-min) (point-max)) + (let ((coding-system-for-write 'binary)) + (write-region (point-min) (point-max) tmpfil)))) + ;; If tramp-decoding-function is not defined for this + ;; method, we invoke tramp-decoding-command instead. + (let ((tmpfil2 (tramp-make-temp-file filename))) + (let ((coding-system-for-write 'binary)) + (write-region (point-min) (point-max) tmpfil2)) + (tramp-message + v 5 "Decoding remote file %s with command %s..." + filename loc-dec) + (tramp-call-local-coding-command loc-dec tmpfil2 tmpfil) + (delete-file tmpfil2))) + (tramp-message v 5 "Decoding remote file %s...done" filename) + ;; Set proper permissions. + (set-file-modes tmpfil (file-modes filename)))) + + ;; Oops, I don't know what to do. + (t (tramp-error + v 'file-error "Wrong method specification for `%s'" method))) + (run-hooks 'tramp-handle-file-local-copy-hook) tmpfil))) @@ -3927,20 +3926,26 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file." ;; the backup file. This case `save-buffer' handles ;; permissions. (when modes (set-file-modes tmpfil modes)) + ;; This is a bit lengthy due to the different methods possible for ;; file transfer. First, we check whether the method uses an rcp ;; program. If so, we call it. Otherwise, both encoding and ;; decoding command must be specified. However, if the method ;; _also_ specifies an encoding function, then that is used for ;; encoding the contents of the tmp file. - (cond ((and (tramp-method-out-of-band-p v) + (cond ;; Fast track on local machine. + ((tramp-local-host-p v) + (tramp-do-copy-or-rename-file-directly + 'rename v tmpfil localname t)) + + ;; `copy-file' handles out-of-band methods + ((and (tramp-method-out-of-band-p v) (integerp start) (> (- end start) tramp-copy-size-limit)) - ;; `copy-file' handles out-of-band methods - (copy-file tmpfil filename t t)) + (rename-file tmpfil filename t)) + ;; Use inline file transfer (rem-dec - ;; Use inline file transfer ;; Encode tmpfil (tramp-message v 5 "Encoding region...") (unwind-protect @@ -4025,14 +4030,19 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file." filename rem-dec))) (tramp-message v 5 "Decoding region into remote file %s...done" filename) - (tramp-flush-file-property v localname)))) + (tramp-flush-file-property v localname)) + + ;; Save exit. + (delete-file tmpfil))) + + ;; That's not expected. (t (tramp-error v 'file-error (concat "Method `%s' should specify both encoding and " "decoding command or an rcp program") method))) - (delete-file tmpfil) + (when (or (eq visit t) (stringp visit)) (set-visited-file-modtime ;; We must pass modtime explicitely, because filename can be different @@ -4198,10 +4208,7 @@ Falls back to normal file name handler if no tramp file name handler exists." filename) ;; 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)) + (foreign (apply foreign operation args)) ;; Nothing to do for us. (t (tramp-run-real-handler operation args))))))) @@ -6502,8 +6509,7 @@ necessary only. This function will be used in file name completion." (defun tramp-make-copy-program-file-name (vec) "Create a file name suitable to be passed to `rcp' and workalikes." (let ((user (tramp-file-name-user vec)) - (host (car (split-string - (tramp-file-name-host vec) tramp-prefix-port-regexp))) + (host (tramp-file-name-real-host vec)) (localname (tramp-shell-quote-argument (tramp-file-name-localname vec)))) (if (not (zerop (length user))) @@ -6514,6 +6520,14 @@ necessary only. This function will be used in file name completion." "Return t if this is an out-of-band method, nil otherwise." (tramp-get-method-parameter (tramp-file-name-method vec) 'tramp-copy-program)) +(defun tramp-local-host-p (vec) + "Return t if this points to the local host, nil otherwise." + (let ((host (tramp-file-name-real-host vec))) + (and + (stringp host) + (string-match + (concat "^" (regexp-opt (list "localhost" (system-name)) t) "$") host)))) + ;; Variables local to connection. (defun tramp-get-remote-path (vec) -- 2.39.2