;;; 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>
;; 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!
;;; Code:
-(eval-when-compile (require 'cl)) ; ignore-errors
(require 'tramp-compat)
+;; Pacify byte-compiler.
+(eval-when-compile
+ (require 'cl))
+(defvar bkup-backup-directory-info)
+(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:
(defgroup tramp nil
: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)
;; Tramp only knows how to deal with `file-name-handler-alist', not
;; the other places.
-;; Currently, we have the choice between 'ftp, 'sep, and 'url.
+;; Currently, we have the choice between 'ftp and 'sep.
;;;###autoload
(defcustom tramp-syntax
(if (featurep 'xemacs) 'sep 'ftp)
It can have the following values:
'ftp -- Ange-FTP respective EFS like syntax (GNU Emacs default)
- 'sep -- Syntax as defined for XEmacs (not available yet for GNU Emacs)
- 'url -- URL-like syntax."
+ 'sep -- Syntax as defined for XEmacs."
:group 'tramp
- :type (if (featurep 'xemacs)
- '(choice (const :tag "EFS" ftp)
- (const :tag "XEmacs" sep)
- (const :tag "URL" url))
- '(choice (const :tag "Ange-FTP" ftp)
- (const :tag "URL" url))))
+ :version "24.4"
+ :type `(choice (const :tag ,(if (featurep 'xemacs) "EFS" "Ange-FTP") ftp)
+ (const :tag "XEmacs" sep)))
(defconst tramp-prefix-format
(cond ((equal tramp-syntax 'ftp) "/")
((equal tramp-syntax 'sep) "/[")
- ((equal tramp-syntax 'url) "/")
(t (error "Wrong `tramp-syntax' defined")))
"String matching the very beginning of Tramp file names.
Used in `tramp-make-tramp-file-name'.")
(defconst tramp-postfix-method-format
(cond ((equal tramp-syntax 'ftp) ":")
((equal tramp-syntax 'sep) "/")
- ((equal tramp-syntax 'url) "://")
(t (error "Wrong `tramp-syntax' defined")))
"String matching delimiter between method and user or host names.
Used in `tramp-make-tramp-file-name'.")
(defconst tramp-prefix-ipv6-format
(cond ((equal tramp-syntax 'ftp) "[")
((equal tramp-syntax 'sep) "")
- ((equal tramp-syntax 'url) "[")
(t (error "Wrong `tramp-syntax' defined")))
"String matching left hand side of IPv6 addresses.
Used in `tramp-make-tramp-file-name'.")
(defconst tramp-postfix-ipv6-format
(cond ((equal tramp-syntax 'ftp) "]")
((equal tramp-syntax 'sep) "")
- ((equal tramp-syntax 'url) "]")
(t (error "Wrong `tramp-syntax' defined")))
"String matching right hand side of IPv6 addresses.
Used in `tramp-make-tramp-file-name'.")
(defconst tramp-prefix-port-format
(cond ((equal tramp-syntax 'ftp) "#")
((equal tramp-syntax 'sep) "#")
- ((equal tramp-syntax 'url) ":")
(t (error "Wrong `tramp-syntax' defined")))
"String matching delimiter between host names and port numbers.")
(defconst tramp-postfix-host-format
(cond ((equal tramp-syntax 'ftp) ":")
((equal tramp-syntax 'sep) "]")
- ((equal tramp-syntax 'url) "")
(t (error "Wrong `tramp-syntax' defined")))
"String matching delimiter between host names and localnames.
Used in `tramp-make-tramp-file-name'.")
"\\(?:" "\\(" 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.")
;;;###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.
XEmacs uses a separate filename syntax for Tramp and EFS.
See `tramp-file-name-structure' for more explanations.")
-;;;###autoload
-(defconst tramp-file-name-regexp-url "\\`/[^/|:]+://"
- "Value for `tramp-file-name-regexp' for URL-like remoting.
-See `tramp-file-name-structure' for more explanations.")
-
;;;###autoload
(defconst tramp-file-name-regexp
(cond ((equal tramp-syntax 'ftp) tramp-file-name-regexp-unified)
((equal tramp-syntax 'sep) tramp-file-name-regexp-separate)
- ((equal tramp-syntax 'url) tramp-file-name-regexp-url)
(t (error "Wrong `tramp-syntax' defined")))
"Regular expression matching file names handled by Tramp.
This regexp should match Tramp file names but no other file names.
XEmacs uses a separate filename syntax for Tramp and EFS.
See `tramp-file-name-structure' for more explanations.")
-;;;###autoload
-(defconst tramp-completion-file-name-regexp-url
- "\\`/[^/:]+\\(:\\(/\\(/[^/]*\\)?\\)?\\)?\\'"
- "Value for `tramp-completion-file-name-regexp' for URL-like remoting.
-See `tramp-file-name-structure' for more explanations.")
-
;;;###autoload
(defconst tramp-completion-file-name-regexp
(cond ((equal tramp-syntax 'ftp) tramp-completion-file-name-regexp-unified)
((equal tramp-syntax 'sep) tramp-completion-file-name-regexp-separate)
- ((equal tramp-syntax 'url) tramp-completion-file-name-regexp-url)
(t (error "Wrong `tramp-syntax' defined")))
"Regular expression matching file names handled by Tramp completion.
This regexp should match partial Tramp file names only.
;;; Internal functions which must come first:
+(defsubst tramp-user-error (vec-or-proc format &rest args)
+ "Signal a pilot error."
+ (apply
+ 'tramp-error vec-or-proc
+ (if (fboundp 'user-error) 'user-error 'error) format args))
+
;; Conversion functions between external representation and
;; internal data structure. Convenience functions for internal
;; data structure.
(if noninteractive
(warn "Method %s is obsolete, using %s"
result (substring result 0 -1))
- (unless (y-or-n-p (format "Method %s is obsolete, use %s? "
+ (unless (y-or-n-p (format "Method \"%s\" is obsolete, use \"%s\"? "
result (substring result 0 -1)))
- (tramp-compat-user-error "Method \"%s\" not supported" result)))
+ (tramp-user-error nil "Method \"%s\" not supported" result)))
(add-to-list 'tramp-warned-obsolete-methods result))
;; This works with the current set of `tramp-obsolete-methods'.
;; Must be improved, if their are more sophisticated replacements.
(setq result (substring result 0 -1)))
- result))
+ ;; We must mark, whether a default value has been used. Not
+ ;; applicable for XEmacs.
+ (if (or method (null result) (null (functionp 'propertize)))
+ result
+ (tramp-compat-funcall 'propertize result 'tramp-default t))))
(defun tramp-find-user (method user host)
"Return the right user string to use.
This is USER, if non-nil. Otherwise, do a lookup in
`tramp-default-user-alist'."
- (or user
- (let ((choices tramp-default-user-alist)
- luser item)
- (while choices
- (setq item (pop choices))
- (when (and (string-match (or (nth 0 item) "") (or method ""))
- (string-match (or (nth 1 item) "") (or host "")))
- (setq luser (nth 2 item))
- (setq choices nil)))
- luser)
- tramp-default-user))
+ (let ((result
+ (or user
+ (let ((choices tramp-default-user-alist)
+ luser item)
+ (while choices
+ (setq item (pop choices))
+ (when (and (string-match (or (nth 0 item) "") (or method ""))
+ (string-match (or (nth 1 item) "") (or host "")))
+ (setq luser (nth 2 item))
+ (setq choices nil)))
+ luser)
+ tramp-default-user)))
+ ;; We must mark, whether a default value has been used. Not
+ ;; applicable for XEmacs.
+ (if (or user (null result) (null (functionp 'propertize)))
+ result
+ (tramp-compat-funcall 'propertize result 'tramp-default t))))
(defun tramp-find-host (method user host)
"Return the right host string to use.
lhost)
tramp-default-host))
+(defun tramp-check-proper-method-and-host (vec)
+ "Check method and host name of VEC."
+ (let ((method (tramp-file-name-method vec))
+ (user (tramp-file-name-user vec))
+ (host (tramp-file-name-host vec))
+ (methods (mapcar 'car tramp-methods)))
+ (when (and method (not (member method methods)))
+ (tramp-cleanup-connection vec)
+ (tramp-user-error vec "Unknown method \"%s\"" method))
+ (when (and (equal tramp-syntax 'ftp) host
+ (or (null method) (get-text-property 0 'tramp-default method))
+ (or (null user) (get-text-property 0 'tramp-default user))
+ (member host methods))
+ (tramp-cleanup-connection vec)
+ (tramp-user-error vec "Host name must not match method \"%s\"" host))))
+
(defun tramp-dissect-file-name (name &optional nodefault)
"Return a `tramp-file-name' structure.
The structure consists of remote method, remote user, remote host
values."
(save-match-data
(let ((match (string-match (nth 0 tramp-file-name-structure) name)))
- (unless match (tramp-compat-user-error "Not a Tramp file name: %s" name))
+ (unless match (tramp-user-error nil "Not a Tramp file name: \"%s\"" name))
(let ((method (match-string (nth 1 tramp-file-name-structure) name))
(user (match-string (nth 2 tramp-file-name-structure) name))
(host (match-string (nth 3 tramp-file-name-structure) name))
(when (string-match tramp-prefix-ipv6-regexp host)
(setq host (replace-match "" nil t host)))
(when (string-match tramp-postfix-ipv6-regexp host)
- (setq host (replace-match "" nil t host)))
- (when (and (equal tramp-syntax 'ftp) (null method) (null user)
- (member host (mapcar 'car tramp-methods))
- (not (tramp-completion-mode-p)))
- (tramp-compat-user-error
- "Host name must not match method `%s'" host)))
+ (setq host (replace-match "" nil t host))))
(if nodefault
(vector method user host localname hop)
(vector
"Append message to debug buffer.
Message is formatted with FMT-STRING as control string and the remaining
ARGUMENTS to actually emit the message (if applicable)."
- (when (get-buffer (tramp-buffer-name vec))
- (with-current-buffer (tramp-get-debug-buffer vec)
- (goto-char (point-max))
- ;; Headline.
- (when (bobp)
- (insert
- (format
- ";; %sEmacs: %s Tramp: %s -*- mode: outline; -*-"
- (if (featurep 'sxemacs) "SX" (if (featurep 'xemacs) "X" "GNU "))
- emacs-version tramp-version)))
- (unless (bolp)
- (insert "\n"))
- ;; Timestamp.
- (let ((now (current-time)))
- (insert (format-time-string "%T." now))
- (insert (format "%06d " (nth 2 now))))
- ;; Calling Tramp function. We suppress compat and trace
- ;; functions from being displayed.
- (let ((btn 1) btf fn)
- (while (not fn)
- (setq btf (nth 1 (backtrace-frame btn)))
- (if (not btf)
- (setq fn "")
- (when (symbolp btf)
- (setq fn (symbol-name btf))
- (unless
- (and
- (string-match "^tramp" fn)
- (not
- (string-match
- (concat
- "^"
- (regexp-opt
- '("tramp-backtrace"
- "tramp-compat-condition-case-unless-debug"
- "tramp-compat-funcall"
- "tramp-compat-with-temp-message"
- "tramp-condition-case-unless-debug"
- "tramp-debug-message"
- "tramp-error"
- "tramp-error-with-buffer"
- "tramp-message")
- t)
- "$")
- fn)))
- (setq fn nil)))
- (setq btn (1+ btn))))
- ;; The following code inserts filename and line number.
- ;; Should be inactive by default, because it is time
- ;; consuming.
-; (let ((ffn (find-function-noselect (intern fn))))
-; (insert
-; (format
-; "%s:%d: "
-; (file-name-nondirectory (buffer-file-name (car ffn)))
-; (with-current-buffer (car ffn)
-; (1+ (count-lines (point-min) (cdr ffn)))))))
- (insert (format "%s " fn)))
- ;; The message.
- (insert (apply 'format fmt-string arguments)))))
+ (with-current-buffer (tramp-get-debug-buffer vec)
+ (goto-char (point-max))
+ ;; Headline.
+ (when (bobp)
+ (insert
+ (format
+ ";; %sEmacs: %s Tramp: %s -*- mode: outline; -*-"
+ (if (featurep 'sxemacs) "SX" (if (featurep 'xemacs) "X" "GNU "))
+ emacs-version tramp-version)))
+ (unless (bolp)
+ (insert "\n"))
+ ;; Timestamp.
+ (let ((now (current-time)))
+ (insert (format-time-string "%T." now))
+ (insert (format "%06d " (nth 2 now))))
+ ;; Calling Tramp function. We suppress compat and trace functions
+ ;; from being displayed.
+ (let ((btn 1) btf fn)
+ (while (not fn)
+ (setq btf (nth 1 (backtrace-frame btn)))
+ (if (not btf)
+ (setq fn "")
+ (when (symbolp btf)
+ (setq fn (symbol-name btf))
+ (unless
+ (and
+ (string-match "^tramp" fn)
+ (not
+ (string-match
+ (concat
+ "^"
+ (regexp-opt
+ '("tramp-backtrace"
+ "tramp-compat-condition-case-unless-debug"
+ "tramp-compat-funcall"
+ "tramp-compat-with-temp-message"
+ "tramp-condition-case-unless-debug"
+ "tramp-debug-message"
+ "tramp-error"
+ "tramp-error-with-buffer"
+ "tramp-message"
+ "tramp-user-error")
+ t)
+ "$")
+ fn)))
+ (setq fn nil)))
+ (setq btn (1+ btn))))
+ ;; The following code inserts filename and line number. Should
+ ;; be inactive by default, because it is time consuming.
+; (let ((ffn (find-function-noselect (intern fn))))
+; (insert
+; (format
+; "%s:%d: "
+; (file-name-nondirectory (buffer-file-name (car ffn)))
+; (with-current-buffer (car ffn)
+; (1+ (count-lines (point-min) (cdr ffn)))))))
+ (insert (format "%s " fn)))
+ ;; The message.
+ (insert (apply 'format fmt-string arguments))))
(defvar tramp-message-show-message t
"Show Tramp message in the minibuffer.
arguments))
;; Log only when there is a minimum level.
(when (>= tramp-verbose 4)
- (when (and vec-or-proc
- (processp vec-or-proc)
- (buffer-name (process-buffer vec-or-proc)))
- (with-current-buffer (process-buffer vec-or-proc)
- ;; Translate proc to vec.
- (setq vec-or-proc (tramp-dissect-file-name default-directory))))
- (when (and vec-or-proc (vectorp vec-or-proc))
+ ;; Translate proc to vec.
+ (when (processp vec-or-proc)
+ (let ((tramp-verbose 0))
+ (setq vec-or-proc
+ (tramp-get-connection-property vec-or-proc "vector" nil))))
+ ;; Do it.
+ (when (vectorp vec-or-proc)
(apply 'tramp-debug-message
vec-or-proc
(concat (format "(%d) # " level) fmt-string)
arguments)))))))
-(defsubst tramp-backtrace (vec-or-proc)
+(defsubst tramp-backtrace (&optional vec-or-proc)
"Dump a backtrace into the debug buffer.
-This function is meant for debugging purposes."
- (tramp-message vec-or-proc 10 "\n%s" (with-output-to-string (backtrace))))
+If VEC-OR-PROC is nil, the buffer *debug tramp* is used. This
+function is meant for debugging purposes."
+ (if vec-or-proc
+ (tramp-message vec-or-proc 10 "\n%s" (with-output-to-string (backtrace)))
+ (if (>= tramp-verbose 10)
+ (with-output-to-temp-buffer "*debug tramp*" (backtrace)))))
(defsubst tramp-error (vec-or-proc signal fmt-string &rest arguments)
"Emit an error.
`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
If VAR is nil, then we bind `v' to the structure and `method', `user',
`host', `localname', `hop' to the components."
- `(let* ((,(or var 'v) (tramp-dissect-file-name ,filename))
- (,(if var (intern (concat (symbol-name var) "-method")) 'method)
- (tramp-file-name-method ,(or var 'v)))
- (,(if var (intern (concat (symbol-name var) "-user")) 'user)
- (tramp-file-name-user ,(or var 'v)))
- (,(if var (intern (concat (symbol-name var) "-host")) 'host)
- (tramp-file-name-host ,(or var 'v)))
- (,(if var (intern (concat (symbol-name var) "-localname")) 'localname)
- (tramp-file-name-localname ,(or var 'v)))
- (,(if var (intern (concat (symbol-name var) "-hop")) 'hop)
- (tramp-file-name-hop ,(or var 'v))))
- ,@body))
+ (let ((bindings
+ (mapcar (lambda (elem)
+ `(,(if var (intern (format "%s-%s" var elem)) elem)
+ (,(intern (format "tramp-file-name-%s" elem))
+ ,(or var 'v))))
+ '(method user host localname hop))))
+ `(let* ((,(or var 'v) (tramp-dissect-file-name ,filename))
+ ,@bindings)
+ ;; We don't know which of those vars will be used, so we bind them all,
+ ;; and then add here a dummy use of all those variables, so we don't get
+ ;; flooded by warnings about those vars `body' didn't use.
+ (ignore ,@(mapcar #'car bindings))
+ ,@body)))
(put 'with-parsed-tramp-file-name 'lisp-indent-function 2)
(put 'with-parsed-tramp-file-name 'edebug-form-spec '(form symbolp body))
If LEVEL does not fit for visible messages, there are only traces
without a visible progress reporter."
(declare (indent 3) (debug t))
- `(let ((result "failed")
- pr tm)
+ `(progn
(tramp-message ,vec ,level "%s..." ,message)
- ;; We start a pulsing progress reporter after 3 seconds. Feature
- ;; introduced in Emacs 24.1.
- (when (and tramp-message-show-message
- ;; Display only when there is a minimum level.
- (<= ,level (min tramp-verbose 3)))
- (ignore-errors
- (setq pr (tramp-compat-funcall 'make-progress-reporter ,message)
- tm (when pr
- (run-at-time 3 0.1 'tramp-progress-reporter-update pr)))))
- (unwind-protect
- ;; Execute the body.
- (prog1 (progn ,@body) (setq result "done"))
- ;; Stop progress reporter.
- (if tm (tramp-compat-funcall 'cancel-timer tm))
- (tramp-message ,vec ,level "%s...%s" ,message result))))
+ (let ((cookie "failed")
+ (tm
+ ;; We start a pulsing progress reporter after 3 seconds. Feature
+ ;; introduced in Emacs 24.1.
+ (when (and tramp-message-show-message
+ ;; Display only when there is a minimum level.
+ (<= ,level (min tramp-verbose 3)))
+ (ignore-errors
+ (let ((pr (tramp-compat-funcall
+ #'make-progress-reporter ,message)))
+ (when pr
+ (run-at-time 3 0.1
+ #'tramp-progress-reporter-update pr)))))))
+ (unwind-protect
+ ;; Execute the body.
+ (prog1 (progn ,@body) (setq cookie "done"))
+ ;; Stop progress reporter.
+ (if tm (tramp-compat-funcall 'cancel-timer tm))
+ (tramp-message ,vec ,level "%s...%s" ,message cookie)))))
(tramp-compat-font-lock-add-keywords
'emacs-lisp-mode '("\\<with-tramp-progress-reporter\\>"))
(replace-match "/" nil t name)
name)))
-(defun tramp-cleanup (vec)
- "Cleanup connection VEC, but keep the debug buffer."
- (with-current-buffer (tramp-get-debug-buffer vec)
- ;; Keep the debug buffer.
- (rename-buffer
- (generate-new-buffer-name tramp-temp-buffer-name) 'unique)
- (tramp-cleanup-connection vec)
- (if (= (point-min) (point-max))
- (kill-buffer nil)
- (rename-buffer (tramp-debug-buffer-name vec) 'unique))
- ;; We call `tramp-get-buffer' in order to keep the debug buffer.
- (tramp-get-buffer vec)))
-
;;; Config Manipulation Functions:
;;;###tramp-autoload
;; We do not want to send any remote command.
(non-essential t))
(when
- (file-remote-p
+ (tramp-tramp-file-p
(tramp-compat-funcall
'buffer-substring-no-properties end (point-max)))
(save-excursion
'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)
(tramp-message
v 1 "Suppress received in operation %s"
(append (list operation) args))
- (tramp-cleanup v)
+ (tramp-cleanup-connection v t)
(tramp-run-real-handler operation args)))
(t result)))
(and (tramp-tramp-file-p filename)
(with-parsed-tramp-file-name filename nil
(or (not (tramp-completion-mode-p))
- (let ((p (tramp-get-connection-process v)))
+ (let* ((tramp-verbose 0)
+ (p (tramp-get-connection-process v)))
(and p (processp p) (memq (process-status p) '(run open))))))))
;; Method, host name and user name completion.
tramp-prefix-ipv6-regexp
"\\(" tramp-completion-ipv6-regexp x-nil "\\)$")
nil 1 2 nil))
- ;; "/method:user" "/[method/user" "/method://user"
+ ;; "/method:user" "/[method/user"
(tramp-completion-file-name-structure7
(list (concat tramp-prefix-regexp
"\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
"\\(" tramp-user-regexp x-nil "\\)$")
1 2 nil nil))
- ;; "/method:host" "/[method/host" "/method://host"
+ ;; "/method:host" "/[method/host"
(tramp-completion-file-name-structure8
(list (concat tramp-prefix-regexp
"\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
"\\(" tramp-host-regexp x-nil "\\)$")
1 nil 2 nil))
- ;; "/method:[ipv6" "/[method/ipv6" "/method://[ipv6"
+ ;; "/method:[ipv6" "/[method/ipv6"
(tramp-completion-file-name-structure9
(list (concat tramp-prefix-regexp
"\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
tramp-prefix-ipv6-regexp
"\\(" tramp-completion-ipv6-regexp x-nil "\\)$")
1 nil 2 nil))
- ;; "/method:user@host" "/[method/user@host" "/method://user@host"
+ ;; "/method:user@host" "/[method/user@host"
(tramp-completion-file-name-structure10
(list (concat tramp-prefix-regexp
"\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
"\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
"\\(" tramp-host-regexp x-nil "\\)$")
1 2 3 nil))
- ;; "/method:user@[ipv6" "/[method/user@ipv6" "/method://user@[ipv6"
+ ;; "/method:user@[ipv6" "/[method/user@ipv6"
(tramp-completion-file-name-structure11
(list (concat tramp-prefix-regexp
"\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
"\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
tramp-prefix-ipv6-regexp
"\\(" tramp-completion-ipv6-regexp x-nil "\\)$")
- 1 2 3 nil))
- ;; "/method: "/method:/"
- (tramp-completion-file-name-structure12
- (list
- (if (equal tramp-syntax 'url)
- (concat tramp-prefix-regexp
- "\\(" tramp-method-regexp "\\)"
- "\\(" (substring tramp-postfix-method-regexp 0 1)
- "\\|" (substring tramp-postfix-method-regexp 1 2) "\\)"
- "\\(" "\\)$")
- ;; Should not match if not URL syntax.
- (concat tramp-prefix-regexp "/$"))
- 1 3 nil nil))
- ;; "/method: "/method:/"
- (tramp-completion-file-name-structure13
- (list
- (if (equal tramp-syntax 'url)
- (concat tramp-prefix-regexp
- "\\(" tramp-method-regexp "\\)"
- "\\(" (substring tramp-postfix-method-regexp 0 1)
- "\\|" (substring tramp-postfix-method-regexp 1 2) "\\)"
- "\\(" "\\)$")
- ;; Should not match if not URL syntax.
- (concat tramp-prefix-regexp "/$"))
- 1 nil 3 nil)))
+ 1 2 3 nil)))
(mapc (lambda (structure)
(add-to-list 'result
tramp-completion-file-name-structure9
tramp-completion-file-name-structure10
tramp-completion-file-name-structure11
- tramp-completion-file-name-structure12
- tramp-completion-file-name-structure13
tramp-file-name-structure))
(delq nil result)))
(defun tramp-handle-file-remote-p (filename &optional identification connected)
"Like `file-remote-p' for Tramp files."
- (let ((tramp-verbose 3))
+ ;; We do not want traces in the debug buffer.
+ (let ((tramp-verbose (min tramp-verbose 3)))
(when (tramp-tramp-file-p filename)
(let* ((v (tramp-dissect-file-name filename))
(p (tramp-get-connection-process v))
(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."
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)
(list localname visit beg end replace)))
;; When we shall insert only a part of the file, we
- ;; copy this part.
- (when (or beg end)
+ ;; 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.
(end
(format "dd bs=1 count=%d if=%s of=%s"
end (tramp-shell-quote-argument localname)
- remote-copy)))))
+ 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
filename local-copy)))
(setq result
(insert-file-contents
- local-copy visit nil nil replace)))))
+ local-copy visit beg end replace)))))
;; Save exit.
(progn
(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."
(when p
(if (yes-or-no-p "A command is running. Kill it? ")
(ignore-errors (kill-process p))
- (tramp-compat-user-error "Shell command in progress")))
+ (tramp-user-error p "Shell command in progress")))
(if current-buffer-p
(progn
(defun tramp-handle-substitute-in-file-name (filename)
"Like `substitute-in-file-name' for Tramp files.
-\"//\" and \"/~\" substitute only in the local filename part.
-If the URL Tramp syntax is chosen, \"//\" as method delimiter and \"/~\" at
-beginning of local filename are not substituted."
+\"//\" and \"/~\" substitute only in the local filename part."
;; First, we must replace environment variables.
(setq filename (tramp-replace-environment-variables filename))
(with-parsed-tramp-file-name filename nil
- (if (equal tramp-syntax 'url)
- ;; We need to check localname only. The other parts cannot contain
- ;; "//" or "/~".
- (if (and (> (length localname) 1)
- (or (string-match "//" localname)
- (string-match "/~" localname 1)))
- (tramp-run-real-handler 'substitute-in-file-name (list filename))
- (tramp-make-tramp-file-name
- (when method (substitute-in-file-name method))
- (when user (substitute-in-file-name user))
- (when host (substitute-in-file-name host))
- (when localname
- (tramp-run-real-handler
- 'substitute-in-file-name (list localname)))))
- ;; Ignore in LOCALNAME everything before "//" or "/~".
- (when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname))
- (setq filename
- (concat (file-remote-p filename)
- (replace-match "\\1" nil nil localname)))
- ;; "/m:h:~" does not work for completion. We use "/m:h:~/".
- (when (string-match "~$" filename)
- (setq filename (concat filename "/"))))
+ ;; Ignore in LOCALNAME everything before "//" or "/~".
+ (when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname))
+ (setq filename
+ (concat (file-remote-p filename)
+ (replace-match "\\1" nil nil localname)))
+ ;; "/m:h:~" does not work for completion. We use "/m:h:~/".
+ (when (string-match "~$" filename)
+ (setq filename (concat 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)
(tramp-error
v 'file-notify-error "File notification not supported for `%s'" filename)))
-(defvar file-notify-descriptors)
(defun tramp-handle-file-notify-rm-watch (proc)
"Like `file-notify-rm-watch' for Tramp files."
;; The descriptor must be a process object.
(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
(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.
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
would yield `t'. On the other hand, the following check results in nil:
(tramp-equal-remote \"/sudo::/etc\" \"/su::/etc\")"
- (and (stringp (file-remote-p file1))
- (stringp (file-remote-p file2))
+ (and (tramp-tramp-file-p file1)
+ (tramp-tramp-file-p file2)
(string-equal (file-remote-p file1) (file-remote-p file2))))
;;;###tramp-autoload
(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))
(stringp host)
(string-match tramp-local-host-regexp host)
;; The method shall be applied to one of the shell file name
- ;; handler. `tramp-local-host-p' is also called for "smb" and
+ ;; handlers. `tramp-local-host-p' is also called for "smb" and
;; alike, where it must fail.
(tramp-get-method-parameter
(tramp-file-name-method vec) 'tramp-login-program)
;;; Auto saving to a special directory:
+(defun tramp-handle-make-auto-save-file-name ()
+ "Like `make-auto-save-file-name' for Tramp files.
+Returns a file name in `tramp-auto-save-directory' for autosaving this file."
+ (let ((tramp-auto-save-directory tramp-auto-save-directory)
+ (buffer-file-name
+ (tramp-subst-strs-in-string
+ '(("_" . "|")
+ ("/" . "_a")
+ (":" . "_b")
+ ("|" . "__")
+ ("[" . "_l")
+ ("]" . "_r"))
+ (buffer-file-name))))
+ ;; File name must be unique. This is ensured with Emacs 22 (see
+ ;; UNIQUIFY element of `auto-save-file-name-transforms'); but for
+ ;; all other cases we must do it ourselves.
+ (when (boundp 'auto-save-file-name-transforms)
+ (mapc
+ (lambda (x)
+ (when (and (string-match (car x) buffer-file-name)
+ (not (car (cddr x))))
+ (setq tramp-auto-save-directory
+ (or tramp-auto-save-directory
+ (tramp-compat-temporary-file-directory)))))
+ (symbol-value 'auto-save-file-name-transforms)))
+ ;; Create directory.
+ (when tramp-auto-save-directory
+ (setq buffer-file-name
+ (expand-file-name buffer-file-name tramp-auto-save-directory))
+ (unless (file-exists-p tramp-auto-save-directory)
+ (make-directory tramp-auto-save-directory t)))
+ ;; Run plain `make-auto-save-file-name'. There might be an advice when
+ ;; it is not a magic file name operation (since Emacs 22).
+ ;; We must deactivate it temporarily.
+ (if (not (ad-is-active 'make-auto-save-file-name))
+ (tramp-run-real-handler 'make-auto-save-file-name nil)
+ ;; else
+ (ad-deactivate 'make-auto-save-file-name)
+ (prog1
+ (tramp-run-real-handler 'make-auto-save-file-name nil)
+ (ad-activate 'make-auto-save-file-name)))))
+
(unless (tramp-exists-file-name-handler 'make-auto-save-file-name)
(defadvice make-auto-save-file-name
(around tramp-advice-make-auto-save-file-name () activate)
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))
"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
"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)
;;; Integration of eshell.el:
-(eval-when-compile
- (defvar eshell-path-env))
-
;; eshell.el keeps the path in `eshell-path-env'. We must change it
;; when `default-directory' points to another host.
(defun tramp-eshell-directory-change ()
"Set `eshell-path-env' to $PATH of the host related to `default-directory'."
(setq eshell-path-env
- (if (file-remote-p default-directory)
+ (if (tramp-tramp-file-p default-directory)
(with-parsed-tramp-file-name default-directory nil
(mapconcat
'identity
;; 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