summaryrefslogtreecommitdiff
path: root/lisp/net
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/net')
-rw-r--r--lisp/net/ange-ftp.el29
-rw-r--r--lisp/net/eudc-bob.el4
-rw-r--r--lisp/net/eudc-export.el4
-rw-r--r--lisp/net/eudc-hotlist.el4
-rw-r--r--lisp/net/eudc-vars.el4
-rw-r--r--lisp/net/eudc.el4
-rw-r--r--lisp/net/eudcb-bbdb.el4
-rw-r--r--lisp/net/eudcb-ldap.el4
-rw-r--r--lisp/net/eudcb-ph.el4
-rw-r--r--lisp/net/net-utils.el81
-rw-r--r--lisp/net/newst-plainview.el3
-rw-r--r--lisp/net/quickurl.el6
-rw-r--r--lisp/net/rcirc.el38
-rw-r--r--lisp/net/soap-client.el6
-rw-r--r--lisp/net/socks.el2
-rw-r--r--lisp/net/tls.el16
-rw-r--r--lisp/net/tramp-adb.el1165
-rw-r--r--lisp/net/tramp-cache.el103
-rw-r--r--lisp/net/tramp-cmds.el8
-rw-r--r--lisp/net/tramp-compat.el93
-rw-r--r--lisp/net/tramp-ftp.el2
-rw-r--r--lisp/net/tramp-gvfs.el865
-rw-r--r--lisp/net/tramp-sh.el649
-rw-r--r--lisp/net/tramp-smb.el27
-rw-r--r--lisp/net/tramp.el396
-rw-r--r--lisp/net/trampver.el4
26 files changed, 2589 insertions, 936 deletions
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index 1d910386403..f6efc56023a 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -720,6 +720,7 @@ parenthesized expressions in REGEXP for the components (in that order)."
"^Data connection \\|"
"^local:\\|^Trying\\|^125 \\|^550-\\|^221 .*oodbye\\|"
"^500 .*AUTH\\|^KERBEROS\\|"
+ "^500 This security scheme is not implemented\\|"
"^504 Unknown security mechanism\\|"
"^530 Please login with USER and PASS\\|" ; non kerberized vsFTPd
"^534 Kerberos Authentication not enabled\\|"
@@ -3296,7 +3297,6 @@ system TYPE.")
(name (ange-ftp-quote-string (nth 2 parsed)))
(temp (ange-ftp-make-tmp-name host))
(binary (ange-ftp-binary-file filename))
- (buffer-file-type buffer-file-type)
(abbr (ange-ftp-abbreviate-filename filename))
(coding-system-used last-coding-system-used)
size)
@@ -3321,10 +3321,7 @@ system TYPE.")
size
(nth 1 (ange-ftp-real-insert-file-contents
temp visit beg end replace))
- coding-system-used last-coding-system-used
- ;; override autodetection of buffer file type
- ;; to ensure buffer is saved in DOS format
- buffer-file-type binary)
+ coding-system-used last-coding-system-used)
(signal 'ftp-error
(list
"Opening input file:"
@@ -4440,16 +4437,18 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
;;; Define ways of getting at unmodified Emacs primitives,
;;; turning off our handler.
-;(defun ange-ftp-run-real-handler (operation args)
-; (let ((inhibit-file-name-handlers
-; (cons 'ange-ftp-hook-function
-; (cons 'ange-ftp-completion-hook-function
-; (and (eq inhibit-file-name-operation operation)
-; inhibit-file-name-handlers))))
-; (inhibit-file-name-operation operation))
-; (apply operation args)))
+(defun ange-ftp-run-real-handler-orig (operation args)
+ (let ((inhibit-file-name-handlers
+ (cons 'ange-ftp-hook-function
+ (cons 'ange-ftp-completion-hook-function
+ (and (eq inhibit-file-name-operation operation)
+ inhibit-file-name-handlers))))
+ (inhibit-file-name-operation operation))
+ (apply operation args)))
-(defalias 'ange-ftp-run-real-handler 'tramp-run-real-handler)
+(defalias 'ange-ftp-run-real-handler
+ (if (fboundp 'tramp-run-real-handler)
+ 'tramp-run-real-handler 'ange-ftp-run-real-handler-orig))
(defun ange-ftp-real-file-name-directory (&rest args)
(ange-ftp-run-real-handler 'file-name-directory args))
@@ -5137,7 +5136,7 @@ Other orders of $ and _ seem to all work just fine.")
(forward-line 1))
;; Would like to look for a "Total" line, or a "Directory" line to
;; make sure that the listing isn't complete garbage before putting
- ;; in "." and "..", but we can't even count on all VAX's giving us
+ ;; in "." and "..", but we can't count on VMS giving us
;; either of these.
(puthash "." t tbl)
(puthash ".." t tbl))
diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el
index 45f15b14a54..106aab2ac0a 100644
--- a/lisp/net/eudc-bob.el
+++ b/lisp/net/eudc-bob.el
@@ -1,9 +1,9 @@
-;;; eudc-bob.el --- Binary Objects Support for EUDC
+;;; eudc-bob.el --- Binary Objects Support for EUDC -*- coding: utf-8 -*-
;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
-;; Maintainer: Pavel Janík <Pavel@Janik.cz>
+;; Maintainer: Pavel JanĂ­k <Pavel@Janik.cz>
;; Keywords: comm
;; Package: eudc
diff --git a/lisp/net/eudc-export.el b/lisp/net/eudc-export.el
index 690a5f15c40..b43a8c631e3 100644
--- a/lisp/net/eudc-export.el
+++ b/lisp/net/eudc-export.el
@@ -1,9 +1,9 @@
-;;; eudc-export.el --- functions to export EUDC query results
+;;; eudc-export.el --- functions to export EUDC query results -*- coding: utf-8 -*-
;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
-;; Maintainer: Pavel Janík <Pavel@Janik.cz>
+;; Maintainer: Pavel JanĂ­k <Pavel@Janik.cz>
;; Keywords: comm
;; Package: eudc
diff --git a/lisp/net/eudc-hotlist.el b/lisp/net/eudc-hotlist.el
index 0322fa766f3..a8a51b7d61b 100644
--- a/lisp/net/eudc-hotlist.el
+++ b/lisp/net/eudc-hotlist.el
@@ -1,9 +1,9 @@
-;;; eudc-hotlist.el --- hotlist management for EUDC
+;;; eudc-hotlist.el --- hotlist management for EUDC -*- coding: utf-8 -*-
;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
-;; Maintainer: Pavel Janík <Pavel@Janik.cz>
+;; Maintainer: Pavel JanĂ­k <Pavel@Janik.cz>
;; Keywords: comm
;; Package: eudc
diff --git a/lisp/net/eudc-vars.el b/lisp/net/eudc-vars.el
index c2cc0154151..d53fd83eee7 100644
--- a/lisp/net/eudc-vars.el
+++ b/lisp/net/eudc-vars.el
@@ -1,9 +1,9 @@
-;;; eudc-vars.el --- Emacs Unified Directory Client
+;;; eudc-vars.el --- Emacs Unified Directory Client -*- coding: utf-8 -*-
;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
-;; Maintainer: Pavel Janík <Pavel@Janik.cz>
+;; Maintainer: Pavel JanĂ­k <Pavel@Janik.cz>
;; Keywords: comm
;; Package: eudc
diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el
index 621b9b90879..ef09267f854 100644
--- a/lisp/net/eudc.el
+++ b/lisp/net/eudc.el
@@ -1,9 +1,9 @@
-;;; eudc.el --- Emacs Unified Directory Client
+;;; eudc.el --- Emacs Unified Directory Client -*- coding: utf-8 -*-
;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
-;; Maintainer: Pavel Janík <Pavel@Janik.cz>
+;; Maintainer: Pavel JanĂ­k <Pavel@Janik.cz>
;; Keywords: comm
;; This file is part of GNU Emacs.
diff --git a/lisp/net/eudcb-bbdb.el b/lisp/net/eudcb-bbdb.el
index 58d94622486..9f6dba703b1 100644
--- a/lisp/net/eudcb-bbdb.el
+++ b/lisp/net/eudcb-bbdb.el
@@ -1,9 +1,9 @@
-;;; eudcb-bbdb.el --- Emacs Unified Directory Client - BBDB Backend
+;;; eudcb-bbdb.el --- Emacs Unified Directory Client - BBDB Backend -*- coding: utf-8 -*-
;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
-;; Maintainer: Pavel Janík <Pavel@Janik.cz>
+;; Maintainer: Pavel JanĂ­k <Pavel@Janik.cz>
;; Keywords: comm
;; Package: eudc
diff --git a/lisp/net/eudcb-ldap.el b/lisp/net/eudcb-ldap.el
index 23eed4b3c0a..d0ba47ad753 100644
--- a/lisp/net/eudcb-ldap.el
+++ b/lisp/net/eudcb-ldap.el
@@ -1,9 +1,9 @@
-;;; eudcb-ldap.el --- Emacs Unified Directory Client - LDAP Backend
+;;; eudcb-ldap.el --- Emacs Unified Directory Client - LDAP Backend -*- coding: utf-8 -*-
;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
-;; Maintainer: Pavel Janík <Pavel@Janik.cz>
+;; Maintainer: Pavel JanĂ­k <Pavel@Janik.cz>
;; Keywords: comm
;; Package: eudc
diff --git a/lisp/net/eudcb-ph.el b/lisp/net/eudcb-ph.el
index 3033e945c24..1796f2d9806 100644
--- a/lisp/net/eudcb-ph.el
+++ b/lisp/net/eudcb-ph.el
@@ -1,9 +1,9 @@
-;;; eudcb-ph.el --- Emacs Unified Directory Client - CCSO PH/QI Backend
+;;; eudcb-ph.el --- Emacs Unified Directory Client - CCSO PH/QI Backend -*- coding: utf-8 -*-
;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
-;; Maintainer: Pavel Janík <Pavel@Janik.cz>
+;; Maintainer: Pavel JanĂ­k <Pavel@Janik.cz>
;; Keywords: comm
;; Package: eudc
diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el
index 28fd5c67ff8..9a6c7b124c7 100644
--- a/lisp/net/net-utils.el
+++ b/lisp/net/net-utils.el
@@ -54,11 +54,6 @@
:group 'comm
:version "20.3")
-(defcustom net-utils-remove-ctl-m (memq system-type '(windows-nt msdos))
- "If non-nil, remove control-Ms from output."
- :group 'net-utils
- :type 'boolean)
-
(defcustom traceroute-program
(if (eq system-type 'windows-nt)
"tracert"
@@ -285,7 +280,8 @@ This variable is only used if the variable
(define-derived-mode net-utils-mode special-mode "NetworkUtil"
"Major mode for interacting with an external network utility."
(set (make-local-variable 'font-lock-defaults)
- '((net-utils-font-lock-keywords))))
+ '((net-utils-font-lock-keywords)))
+ (setq-local revert-buffer-function #'net-utils--revert-function))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Utility functions
@@ -318,25 +314,17 @@ This variable is only used if the variable
(defun net-utils-remove-ctrl-m-filter (process output-string)
"Remove trailing control Ms."
- (let ((old-buffer (current-buffer))
- (filtered-string output-string))
- (unwind-protect
- (let ((moving))
- (set-buffer (process-buffer process))
- (let ((inhibit-read-only t))
- (setq moving (= (point) (process-mark process)))
-
- (while (string-match "\r" filtered-string)
- (setq filtered-string
- (replace-match "" nil nil filtered-string)))
-
- (save-excursion
- ;; Insert the text, moving the process-marker.
- (goto-char (process-mark process))
- (insert filtered-string)
- (set-marker (process-mark process) (point))))
- (if moving (goto-char (process-mark process))))
- (set-buffer old-buffer))))
+ (with-current-buffer (process-buffer process)
+ (save-excursion
+ (let ((inhibit-read-only t)
+ (filtered-string output-string))
+ (while (string-match "\r" filtered-string)
+ (setq filtered-string
+ (replace-match "" nil nil filtered-string)))
+ ;; Insert the text, moving the process-marker.
+ (goto-char (process-mark process))
+ (insert filtered-string)
+ (set-marker (process-mark process) (point))))))
(defun net-utils-run-program (name header program args)
"Run a network information program."
@@ -354,20 +342,38 @@ This variable is only used if the variable
;; General network utilities (diagnostic)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defun net-utils-run-simple (buffer-name program-name args)
+;; Todo: This data could be saved in a bookmark.
+(defvar net-utils--revert-cmd nil)
+
+(defun net-utils-run-simple (buffer program-name args &optional nodisplay)
"Run a network utility for diagnostic output only."
- (interactive)
- (when (get-buffer buffer-name)
- (kill-buffer buffer-name))
- (get-buffer-create buffer-name)
- (with-current-buffer buffer-name
+ (with-current-buffer (if (stringp buffer) (get-buffer-create buffer) buffer)
+ (let ((proc (get-buffer-process (current-buffer))))
+ (when proc
+ (set-process-filter proc nil)
+ (delete-process proc)))
+ (let ((inhibit-read-only t))
+ (erase-buffer))
(net-utils-mode)
+ (setq-local net-utils--revert-cmd
+ `(net-utils-run-simple ,(current-buffer)
+ ,program-name ,args nodisplay))
(set-process-filter
- (apply 'start-process (format "%s" program-name)
- buffer-name program-name args)
- 'net-utils-remove-ctrl-m-filter)
- (goto-char (point-min)))
- (display-buffer buffer-name))
+ (apply 'start-process program-name
+ (current-buffer) program-name args)
+ 'net-utils-remove-ctrl-m-filter)
+ (unless nodisplay (display-buffer (current-buffer)))))
+
+(defun net-utils--revert-function (&optional ignore-auto noconfirm)
+ (message "Reverting `%s'..." (buffer-name))
+ (apply (car net-utils--revert-cmd) (cdr net-utils--revert-cmd))
+ (let ((proc (get-buffer-process (current-buffer))))
+ (when proc
+ (set-process-sentinel
+ proc
+ (lambda (process event)
+ (when (string= event "finished\n")
+ (message "Reverting `%s' done" (process-buffer process))))))))
;;;###autoload
(defun ifconfig ()
@@ -428,9 +434,8 @@ This variable is only used if the variable
(if traceroute-program-options
(append traceroute-program-options (list target))
(list target))))
- (net-utils-run-program
+ (net-utils-run-simple
(concat "Traceroute" " " target)
- (concat "** Traceroute ** " traceroute-program " ** " target)
traceroute-program
options)))
diff --git a/lisp/net/newst-plainview.el b/lisp/net/newst-plainview.el
index 2eb04787bea..c7a3a107078 100644
--- a/lisp/net/newst-plainview.el
+++ b/lisp/net/newst-plainview.el
@@ -5,7 +5,7 @@
;; Author: Ulf Jasper <ulf.jasper@web.de>
;; Filename: newst-plainview.el
;; URL: http://www.nongnu.org/newsticker
-;; Time-stamp: "13. Mai 2011, 19:28:34 (ulf)"
+;; Time-stamp: "Mon 11-Feb-2013 20:27:11 gm on skiddaw"
;; Package: newsticker
;; ======================================================================
@@ -405,6 +405,7 @@ images."
(define-key map "sx" 'newsticker-show-extra)
(define-key map "hx" 'newsticker-hide-extra)
+ (define-key map [?\S-\ ] 'scroll-down-command)
(define-key map " " 'scroll-up-command)
(define-key map "q" 'newsticker-close-buffer)
(define-key map "p" 'newsticker-previous-item)
diff --git a/lisp/net/quickurl.el b/lisp/net/quickurl.el
index ce9ef55f499..1e05d8db336 100644
--- a/lisp/net/quickurl.el
+++ b/lisp/net/quickurl.el
@@ -94,7 +94,8 @@
:group 'abbrev
:prefix "quickurl-")
-(defcustom quickurl-url-file (convert-standard-filename "~/.quickurls")
+(defcustom quickurl-url-file
+ (locate-user-emacs-file "quickurls" ".quickurls")
"File that contains the URL list."
:type 'file
:group 'quickurl)
@@ -272,7 +273,8 @@ It also restores point after the `read'."
(defun quickurl-save-urls ()
"Save the contents of `quickurl-urls' to `quickurl-url-file'."
(with-temp-buffer
- (let ((standard-output (current-buffer)))
+ (let ((standard-output (current-buffer))
+ (print-length nil))
(princ quickurl-prefix)
(pp quickurl-urls)
(princ quickurl-postfix)
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index 3afd3aefc96..7c70ded3eaa 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -406,7 +406,7 @@ will be killed."
"The channel or user associated with this buffer.")
(defvar rcirc-urls nil
- "List of urls seen in the current buffer.")
+ "List of URLs seen in the current buffer and their start positions.")
(put 'rcirc-urls 'permanent-local t)
(defvar rcirc-timeout-seconds 600
@@ -625,7 +625,8 @@ last ping."
(rcirc-float-time))))))
(rcirc-process-list))
;; no processes, clean up timer
- (cancel-timer rcirc-keepalive-timer)
+ (when (timerp rcirc-keepalive-timer)
+ (cancel-timer rcirc-keepalive-timer))
(setq rcirc-keepalive-timer nil)))
(defun rcirc-handler-ctcp-KEEPALIVE (process target sender message)
@@ -2392,12 +2393,25 @@ keywords when no KEYWORD is given."
"\\)")
"Regexp matching URLs. Set to nil to disable URL features in rcirc.")
+;; cf cl-remove-if-not
+(defun rcirc-condition-filter (condp lst)
+ "Remove all items not satisfying condition CONDP in list LST.
+CONDP is a function that takes a list element as argument and returns
+non-nil if that element should be included. Returns a new list."
+ (delq nil (mapcar (lambda (x) (and (funcall condp x) x)) lst)))
+
(defun rcirc-browse-url (&optional arg)
- "Prompt for URL to browse based on URLs in buffer."
+ "Prompt for URL to browse based on URLs in buffer before point.
+
+If ARG is given, opens the URL in a new browser window."
(interactive "P")
- (let ((completions (mapcar (lambda (x) (cons x nil)) rcirc-urls))
- (initial-input (car rcirc-urls))
- (history (cdr rcirc-urls)))
+ (let* ((point (point))
+ (filtered (rcirc-condition-filter
+ (lambda (x) (>= point (cdr x)))
+ rcirc-urls))
+ (completions (mapcar (lambda (x) (car x)) filtered))
+ (initial-input (caar filtered))
+ (history (mapcar (lambda (x) (car x)) (cdr filtered))))
(browse-url (completing-read "rcirc browse-url: "
completions nil nil initial-input 'history)
arg)))
@@ -2441,17 +2455,19 @@ keywords when no KEYWORD is given."
(defun rcirc-markup-urls (sender response)
(while (and rcirc-url-regexp ;; nil means disable URL catching
(re-search-forward rcirc-url-regexp nil t))
- (let ((start (match-beginning 0))
- (end (match-end 0))
- (url (match-string-no-properties 0)))
+ (let* ((start (match-beginning 0))
+ (end (match-end 0))
+ (url (match-string-no-properties 0))
+ (link-text (buffer-substring-no-properties start end)))
(make-button start end
'face 'rcirc-url
'follow-link t
'rcirc-url url
'action (lambda (button)
(browse-url (button-get button 'rcirc-url))))
- ;; record the url
- (push url rcirc-urls))))
+ ;; record the url if it is not already the latest stored url
+ (when (not (string= link-text (caar rcirc-urls)))
+ (push (cons link-text start) rcirc-urls)))))
(defun rcirc-markup-keywords (sender response)
(when (and (string= response "PRIVMSG")
diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el
index 6b4bc16c111..4ba8e5b5854 100644
--- a/lisp/net/soap-client.el
+++ b/lisp/net/soap-client.el
@@ -1768,7 +1768,11 @@ operations in a WSDL document."
(url-package-name "soap-client.el")
(url-package-version "1.0")
(url-http-version "1.0")
- (url-request-data (soap-create-envelope operation parameters wsdl))
+ (url-request-data
+ ;; url-request-data expects a unibyte string already encoded...
+ (encode-coding-string
+ (soap-create-envelope operation parameters wsdl)
+ 'utf-8))
(url-mime-charset-string "utf-8;q=1, iso-8859-1;q=0.5")
(url-request-coding-system 'utf-8)
(url-http-attempt-keepalives t)
diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index 75b0ebe55ff..415397c4171 100644
--- a/lisp/net/socks.el
+++ b/lisp/net/socks.el
@@ -648,7 +648,7 @@ version.")
(progn
(setq res (buffer-substring (match-beginning 2)
(match-end 2))
- res (mapcar 'string-to-int (split-string res "\\.")))))
+ res (mapcar 'string-to-number (split-string res "\\.")))))
(kill-buffer (current-buffer)))
res)
host))
diff --git a/lisp/net/tls.el b/lisp/net/tls.el
index ed61d62182f..7fc314ef088 100644
--- a/lisp/net/tls.el
+++ b/lisp/net/tls.el
@@ -89,10 +89,14 @@ Also see `tls-success' for what the program should output after
successful negotiation."
:type
'(choice
+ (const :tag "Default list of commands"
+ ("gnutls-cli --insecure -p %p %h"
+ "gnutls-cli --insecure -p %p %h --protocols ssl3"
+ "openssl s_client -connect %h:%p -no_ssl2 -ign_eof"))
(list :tag "Choose commands"
:value
- ("gnutls-cli -p %p %h"
- "gnutls-cli -p %p %h --protocols ssl3"
+ ("gnutls-cli --insecure -p %p %h"
+ "gnutls-cli --insecure -p %p %h --protocols ssl3"
"openssl s_client -connect %h:%p -no_ssl2 -ign_eof")
(set :inline t
;; FIXME: add brief `:tag "..."' descriptions.
@@ -102,14 +106,10 @@ successful negotiation."
(const "gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h --protocols ssl3")
(const "openssl s_client -connect %h:%p -CAfile /etc/ssl/certs/ca-certificates.crt -no_ssl2 -ign_eof")
;; No trust check:
- (const "gnutls-cli -p %p %h")
- (const "gnutls-cli -p %p %h --protocols ssl3")
+ (const "gnutls-cli --insecure -p %p %h")
+ (const "gnutls-cli --insecure -p %p %h --protocols ssl3")
(const "openssl s_client -connect %h:%p -no_ssl2 -ign_eof"))
(repeat :inline t :tag "Other" (string)))
- (const :tag "Default list of commands"
- ("gnutls-cli -p %p %h"
- "gnutls-cli -p %p %h --protocols ssl3"
- "openssl s_client -connect %h:%p -no_ssl2 -ign_eof"))
(list :tag "List of commands"
(repeat :tag "Command" (string))))
:version "22.1"
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
new file mode 100644
index 00000000000..613b2067955
--- /dev/null
+++ b/lisp/net/tramp-adb.el
@@ -0,0 +1,1165 @@
+;;; tramp-adb.el --- Functions for calling Android Debug Bridge from Tramp
+
+;; Copyright (C) 2011-2013 Free Software Foundation, Inc.
+
+;; Author: Juergen Hoetzel <juergen@archlinux.org>
+;; Keywords: comm, processes
+;; Package: tramp
+
+;; This file is part of GNU Emacs.
+
+;; 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.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; The Android Debug Bridge "adb" must be installed on your local
+;; machine. If it is not in your $PATH, add the following form into
+;; your .emacs:
+;;
+;; (setq tramp-adb-program "/path/to/adb")
+;;
+;; Due to security it is not possible to access non-root devices.
+
+;;; Code:
+
+(require 'tramp)
+(require 'time-date)
+
+(defvar dired-move-to-filename-regexp)
+
+(defcustom tramp-adb-program "adb"
+ "Name of the Android Debug Bridge program."
+ :group 'tramp
+ :version "24.4"
+ :type 'string)
+
+;;;###tramp-autoload
+(defconst tramp-adb-method "adb"
+ "*When this method name is used, forward all calls to Android Debug Bridge.")
+
+(defcustom tramp-adb-prompt
+ "^\\(?:[[:digit:]]*|?\\)?\\(?:[[:alnum:]]*@[[:alnum:]]*[^#\\$]*\\)?[#\\$][[:space:]]"
+ "Regexp used as prompt in almquist shell."
+ :type 'string
+ :version "24.4"
+ :group 'tramp)
+
+(defconst tramp-adb-ls-date-regexp
+ "[[:space:]][0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9][[:space:]][0-9][0-9]:[0-9][0-9][[:space:]]")
+
+(defconst tramp-adb-ls-toolbox-regexp
+ (concat
+ "^[[:space:]]*\\([-[:alpha:]]+\\)" ; \1 permissions
+ "[[:space:]]*\\([^[:space:]]+\\)" ; \2 username
+ "[[:space:]]+\\([^[:space:]]+\\)" ; \3 group
+ "[[:space:]]+\\([[:digit:]]+\\)" ; \4 size
+ "[[:space:]]+\\([-[:digit:]]+[[:space:]][:[:digit:]]+\\)" ; \5 date
+ "[[:space:]]+\\(.*\\)$")) ; \6 filename
+
+;;;###tramp-autoload
+(add-to-list 'tramp-methods
+ `(,tramp-adb-method
+ (tramp-tmpdir "/data/local/tmp")))
+
+;;;###tramp-autoload
+(add-to-list 'tramp-default-host-alist `(,tramp-adb-method nil ""))
+
+;;;###tramp-autoload
+(eval-after-load 'tramp
+ '(tramp-set-completion-function
+ tramp-adb-method '((tramp-adb-parse-device-names ""))))
+
+;;;###tramp-autoload
+(add-to-list 'tramp-foreign-file-name-handler-alist
+ (cons 'tramp-adb-file-name-p 'tramp-adb-file-name-handler))
+
+(defconst tramp-adb-file-name-handler-alist
+ '((directory-file-name . tramp-handle-directory-file-name)
+ (dired-uncache . tramp-handle-dired-uncache)
+ (file-name-as-directory . tramp-handle-file-name-as-directory)
+ (file-name-completion . tramp-handle-file-name-completion)
+ (file-name-all-completions . tramp-adb-handle-file-name-all-completions)
+ (file-attributes . tramp-adb-handle-file-attributes)
+ (file-name-directory . tramp-handle-file-name-directory)
+ (file-name-nondirectory . tramp-handle-file-name-nondirectory)
+ (file-truename . tramp-adb-handle-file-truename)
+ (file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
+ (file-name-as-directory . tramp-handle-file-name-as-directory)
+ (file-regular-p . tramp-handle-file-regular-p)
+ (file-remote-p . tramp-handle-file-remote-p)
+ (file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
+ (file-directory-p . tramp-adb-handle-file-directory-p)
+ (file-symlink-p . tramp-handle-file-symlink-p)
+ ;; FIXME: This is too sloppy.
+ (file-executable-p . tramp-handle-file-exists-p)
+ (file-exists-p . tramp-handle-file-exists-p)
+ (file-readable-p . tramp-handle-file-exists-p)
+ (file-writable-p . tramp-adb-handle-file-writable-p)
+ (file-local-copy . tramp-adb-handle-file-local-copy)
+ (file-modes . tramp-handle-file-modes)
+ (expand-file-name . tramp-adb-handle-expand-file-name)
+ (find-backup-file-name . tramp-handle-find-backup-file-name)
+ (directory-files . tramp-handle-directory-files)
+ (directory-files-and-attributes
+ . tramp-adb-handle-directory-files-and-attributes)
+ (make-directory . tramp-adb-handle-make-directory)
+ (delete-directory . tramp-adb-handle-delete-directory)
+ (delete-file . tramp-adb-handle-delete-file)
+ (load . tramp-handle-load)
+ (insert-directory . tramp-adb-handle-insert-directory)
+ (insert-file-contents . tramp-handle-insert-file-contents)
+ (substitute-in-file-name . tramp-handle-substitute-in-file-name)
+ (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory)
+ (vc-registered . ignore) ;no vc control files on Android devices
+ (write-region . tramp-adb-handle-write-region)
+ (set-file-modes . tramp-adb-handle-set-file-modes)
+ (set-file-times . tramp-adb-handle-set-file-times)
+ (copy-file . tramp-adb-handle-copy-file)
+ (rename-file . tramp-adb-handle-rename-file)
+ (process-file . tramp-adb-handle-process-file)
+ (shell-command . tramp-adb-handle-shell-command)
+ (start-file-process . tramp-adb-handle-start-file-process))
+ "Alist of handler functions for Tramp ADB method.")
+
+;; It must be a `defsubst' in order to push the whole code into
+;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
+;;;###tramp-autoload
+(defsubst tramp-adb-file-name-p (filename)
+ "Check if it's a filename for ADB."
+ (let ((v (tramp-dissect-file-name filename)))
+ (string= (tramp-file-name-method v) tramp-adb-method)))
+
+;;;###tramp-autoload
+(defun tramp-adb-file-name-handler (operation &rest args)
+ "Invoke the ADB handler for OPERATION.
+First arg specifies the OPERATION, second arg is a list of arguments to
+pass to the OPERATION."
+ (let ((fn (assoc operation tramp-adb-file-name-handler-alist)))
+ (if fn
+ (save-match-data (apply (cdr fn) args))
+ (tramp-run-real-handler operation args))))
+
+;;;###tramp-autoload
+(defun tramp-adb-parse-device-names (ignore)
+ "Return a list of (nil host) tuples allowed to access."
+ (with-timeout (10)
+ (with-temp-buffer
+ ;; `call-process' does not react on timer under MS Windows.
+ ;; That's why we use `start-process'.
+ (let ((p (start-process
+ tramp-adb-program (current-buffer) tramp-adb-program "devices"))
+ result)
+ (tramp-compat-set-process-query-on-exit-flag p nil)
+ (while (eq 'run (process-status p))
+ (sleep-for 0.1))
+ (goto-char (point-min))
+ (while (search-forward-regexp "^\\(\\S-+\\)[[:space:]]+device$" nil t)
+ (add-to-list 'result (list nil (match-string 1))))
+ result))))
+
+(defun tramp-adb-handle-expand-file-name (name &optional dir)
+ "Like `expand-file-name' for Tramp files."
+ ;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
+ (setq dir (or dir default-directory "/"))
+ ;; Unless NAME is absolute, concat DIR and NAME.
+ (unless (file-name-absolute-p name)
+ (setq name (concat (file-name-as-directory dir) name)))
+ ;; If NAME is not a Tramp file, run the real handler.
+ (if (not (tramp-tramp-file-p name))
+ (tramp-run-real-handler 'expand-file-name (list name nil))
+ ;; Dissect NAME.
+ (with-parsed-tramp-file-name name nil
+ (unless (tramp-run-real-handler 'file-name-absolute-p (list localname))
+ (setq localname (concat "/" localname)))
+ ;; Do normal `expand-file-name' (this does "/./" and "/../").
+ ;; We bind `directory-sep-char' here for XEmacs on Windows,
+ ;; which would otherwise use backslash. `default-directory' is
+ ;; bound, because on Windows there would be problems with UNC
+ ;; shares or Cygwin mounts.
+ (let ((directory-sep-char ?/)
+ (default-directory (tramp-compat-temporary-file-directory)))
+ (tramp-make-tramp-file-name
+ method user host
+ (tramp-drop-volume-letter
+ (tramp-run-real-handler
+ 'expand-file-name (list localname))))))))
+
+(defun tramp-adb-handle-file-directory-p (filename)
+ "Like `file-directory-p' for Tramp files."
+ (car (file-attributes (file-truename filename))))
+
+;; This is derived from `tramp-sh-handle-file-truename'. Maybe the
+;; code could be shared?
+(defun tramp-adb-handle-file-truename (filename &optional counter prev-dirs)
+ "Like `file-truename' for Tramp files."
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (with-tramp-file-property v localname "file-truename"
+ (let ((result nil)) ; result steps in reverse order
+ (tramp-message v 4 "Finding true name for `%s'" filename)
+ (let* ((directory-sep-char ?/)
+ (steps (tramp-compat-split-string localname "/"))
+ (localnamedir (tramp-run-real-handler
+ 'file-name-as-directory (list localname)))
+ (is-dir (string= localname localnamedir))
+ (thisstep nil)
+ (numchase 0)
+ ;; Don't make the following value larger than
+ ;; necessary. People expect an error message in a
+ ;; timely fashion when something is wrong; otherwise
+ ;; they might think that Emacs is hung. Of course,
+ ;; correctness has to come first.
+ (numchase-limit 20)
+ symlink-target)
+ (while (and steps (< numchase numchase-limit))
+ (setq thisstep (pop steps))
+ (tramp-message
+ v 5 "Check %s"
+ (mapconcat 'identity
+ (append '("") (reverse result) (list thisstep))
+ "/"))
+ (setq symlink-target
+ (nth 0 (file-attributes
+ (tramp-make-tramp-file-name
+ method user host
+ (mapconcat 'identity
+ (append '("")
+ (reverse result)
+ (list thisstep))
+ "/")))))
+ (cond ((string= "." thisstep)
+ (tramp-message v 5 "Ignoring step `.'"))
+ ((string= ".." thisstep)
+ (tramp-message v 5 "Processing step `..'")
+ (pop result))
+ ((stringp symlink-target)
+ ;; It's a symlink, follow it.
+ (tramp-message v 5 "Follow symlink to %s" symlink-target)
+ (setq numchase (1+ numchase))
+ (when (file-name-absolute-p symlink-target)
+ (setq result nil))
+ ;; If the symlink was absolute, we'll get a string
+ ;; like "/user@host:/some/target"; extract the
+ ;; "/some/target" part from it.
+ (when (tramp-tramp-file-p symlink-target)
+ (unless (tramp-equal-remote filename symlink-target)
+ (tramp-error
+ v 'file-error
+ "Symlink target `%s' on wrong host" symlink-target))
+ (setq symlink-target localname))
+ (setq steps
+ (append (tramp-compat-split-string
+ symlink-target "/")
+ steps)))
+ (t
+ ;; It's a file.
+ (setq result (cons thisstep result)))))
+ (when (>= numchase numchase-limit)
+ (tramp-error
+ v 'file-error
+ "Maximum number (%d) of symlinks exceeded" numchase-limit))
+ (setq result (reverse result))
+ ;; Combine list to form string.
+ (setq result
+ (if result
+ (mapconcat 'identity (cons "" result) "/")
+ "/"))
+ (when (and is-dir (or (string= "" result)
+ (not (string= (substring result -1) "/"))))
+ (setq result (concat result "/"))))
+
+ (tramp-message v 4 "True name of `%s' is `%s'" filename result)
+ (tramp-make-tramp-file-name method user host result)))))
+
+(defun tramp-adb-handle-file-attributes (filename &optional id-format)
+ "Like `file-attributes' for Tramp files."
+ (unless id-format (setq id-format 'integer))
+ (ignore-errors
+ (with-parsed-tramp-file-name filename nil
+ (with-tramp-file-property
+ v localname (format "file-attributes-%s" id-format)
+ (tramp-adb-barf-unless-okay
+ v (format "%s -d -l %s"
+ (tramp-adb-get-ls-command v)
+ (tramp-shell-quote-argument localname)) "")
+ (with-current-buffer (tramp-get-buffer v)
+ (tramp-adb-sh-fix-ls-output)
+ (cdar (tramp-do-parse-file-attributes-with-ls v id-format)))))))
+
+(defun tramp-do-parse-file-attributes-with-ls (vec &optional id-format)
+ "Parse `file-attributes' for Tramp files using the ls(1) command."
+ (with-current-buffer (tramp-get-buffer vec)
+ (goto-char (point-min))
+ (let ((file-properties nil))
+ (while (re-search-forward tramp-adb-ls-toolbox-regexp nil t)
+ (let* ((mod-string (match-string 1))
+ (is-dir (eq ?d (aref mod-string 0)))
+ (is-symlink (eq ?l (aref mod-string 0)))
+ (uid (match-string 2))
+ (gid (match-string 3))
+ (size (string-to-number (match-string 4)))
+ (date (match-string 5))
+ (name (match-string 6))
+ (symlink-target
+ (and is-symlink
+ (cadr (split-string name "\\( -> \\|\n\\)")))))
+ (push (list
+ (if is-symlink
+ (car (split-string name "\\( -> \\|\n\\)"))
+ name)
+ (or is-dir symlink-target)
+ 1 ;link-count
+ ;; no way to handle numeric ids in Androids ash
+ (if (eq id-format 'integer) 0 uid)
+ (if (eq id-format 'integer) 0 gid)
+ '(0 0) ; atime
+ (date-to-time date) ; mtime
+ '(0 0) ; ctime
+ size
+ mod-string
+ ;; fake
+ t 1
+ (tramp-get-device vec))
+ file-properties)))
+ file-properties)))
+
+(defun tramp-adb-handle-directory-files-and-attributes
+ (directory &optional full match nosort id-format)
+ "Like `directory-files-and-attributes' for Tramp files."
+ (when (file-directory-p directory)
+ (with-parsed-tramp-file-name (expand-file-name directory) nil
+ (with-tramp-file-property
+ v localname (format "directory-files-attributes-%s-%s-%s-%s"
+ full match id-format nosort)
+ (tramp-adb-barf-unless-okay
+ v (format "%s -a -l %s"
+ (tramp-adb-get-ls-command v)
+ (tramp-shell-quote-argument localname)) "")
+ (with-current-buffer (tramp-get-buffer v)
+ (tramp-adb-sh-fix-ls-output)
+ (let ((result (tramp-do-parse-file-attributes-with-ls
+ v (or id-format 'integer))))
+ (when full
+ (setq result
+ (mapcar
+ (lambda (x)
+ (cons (expand-file-name (car x) directory) (cdr x)))
+ result)))
+ (unless nosort
+ (setq result
+ (sort result (lambda (x y) (string< (car x) (car y))))))
+ (delq nil
+ (mapcar (lambda (x)
+ (if (or (not match) (string-match match (car x)))
+ x))
+ result))))))))
+
+(defun tramp-adb-get-ls-command (vec)
+ (with-tramp-connection-property vec "ls"
+ (tramp-message vec 5 "Finding a suitable `ls' command")
+ (if (zerop (tramp-adb-command-exit-status
+ vec "ls --color=never -al /dev/null"))
+ ;; On CyanogenMod based system BusyBox is used and "ls" output
+ ;; coloring is enabled by default. So we try to disable it
+ ;; when possible.
+ "ls --color=never"
+ "ls")))
+
+(defun tramp-adb-get-toolbox (vec)
+ "Get shell toolbox implementation: `toolbox' for original distributions
+or `busybox' for CyanogenMod based distributions"
+ (with-tramp-connection-property vec "toolbox"
+ (tramp-message vec 5 "Checking shell toolbox implementation")
+ (cond
+ ((zerop (tramp-adb-command-exit-status vec "busybox")) 'busybox)
+ ((zerop (tramp-adb-command-exit-status vec "toolbox")) 'toolbox)
+ (t 'unknown))))
+
+(defun tramp-adb--gnu-switches-to-ash
+ (switches)
+ "Almquist shell can't handle multiple arguments.
+Convert (\"-al\") to (\"-a\" \"-l\"). Remove arguments like \"--dired\"."
+ (split-string
+ (apply 'concat
+ (mapcar (lambda (s)
+ (replace-regexp-in-string
+ "\\(.\\)" " -\\1"
+ (replace-regexp-in-string "^-" "" s)))
+ ;; FIXME: Warning about removed switches (long and non-dash).
+ (delq nil
+ (mapcar
+ (lambda (s)
+ (and (not (string-match "\\(^--\\|^[^-]\\)" s)) s))
+ switches))))))
+
+(defun tramp-adb-handle-insert-directory
+ (filename switches &optional wildcard full-directory-p)
+ "Like `insert-directory' for Tramp files."
+ (when (stringp switches)
+ (setq switches (tramp-adb--gnu-switches-to-ash (split-string switches))))
+ (with-parsed-tramp-file-name (file-truename filename) nil
+ (with-current-buffer (tramp-get-buffer v)
+ (let ((name (tramp-shell-quote-argument (directory-file-name localname)))
+ (switch-d (member "-d" switches))
+ (switch-t (member "-t" switches))
+ (switches (mapconcat 'identity (remove "-t" switches) " ")))
+ (tramp-adb-barf-unless-okay
+ v (format "%s %s %s" (tramp-adb-get-ls-command v) switches name)
+ "Cannot insert directory listing: %s" filename)
+ (unless switch-d
+ ;; We insert also filename/. and filename/.., because "ls" doesn't.
+ (narrow-to-region (point) (point))
+ (ignore-errors
+ (tramp-adb-barf-unless-okay
+ v (format "%s -d %s %s %s"
+ (tramp-adb-get-ls-command v)
+ switches
+ (concat (file-name-as-directory name) ".")
+ (concat (file-name-as-directory name) ".."))
+ "Cannot insert directory listing: %s" filename))
+ (widen))
+ (tramp-adb-sh-fix-ls-output switch-t)))
+ (insert-buffer-substring (tramp-get-buffer v))))
+
+(defun tramp-adb-sh-fix-ls-output (&optional sort-by-time)
+ "Insert dummy 0 in empty size columns.
+Androids \"ls\" command doesn't insert size column for directories:
+Emacs dired can't find files."
+ (save-excursion
+ ;; Insert missing size.
+ (goto-char (point-min))
+ (while
+ (search-forward-regexp
+ "[[:space:]]\\([[:space:]][0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9][[:space:]]\\)" nil t)
+ (replace-match "0\\1" "\\1" nil)
+ ;; Insert missing "/".
+ (when (looking-at "[0-9][0-9]:[0-9][0-9][[:space:]]+$")
+ (end-of-line)
+ (insert "/")))
+ ;; Sort entries.
+ (let* ((lines (split-string (buffer-string) "\n" t))
+ (sorted-lines
+ (sort
+ lines
+ (if sort-by-time
+ 'tramp-adb-ls-output-time-less-p
+ 'tramp-adb-ls-output-name-less-p))))
+ (delete-region (point-min) (point-max))
+ (insert " " (mapconcat 'identity sorted-lines "\n ")))
+ ;; Add final newline.
+ (goto-char (point-max))
+ (unless (= (point) (line-beginning-position))
+ (insert "\n"))))
+
+
+(defun tramp-adb-ls-output-time-less-p (a b)
+ "Sort \"ls\" output by time, descending."
+ (let (time-a time-b)
+ (string-match tramp-adb-ls-date-regexp a)
+ (setq time-a (apply 'encode-time (parse-time-string (match-string 0 a))))
+ (string-match tramp-adb-ls-date-regexp b)
+ (setq time-b (apply 'encode-time (parse-time-string (match-string 0 b))))
+ (tramp-time-less-p time-b time-a)))
+
+(defun tramp-adb-ls-output-name-less-p (a b)
+ "Sort \"ls\" output by name, ascending."
+ (let (posa posb)
+ (string-match dired-move-to-filename-regexp a)
+ (setq posa (match-end 0))
+ (string-match dired-move-to-filename-regexp b)
+ (setq posb (match-end 0))
+ (string-lessp (substring a posa) (substring b posb))))
+
+(defun tramp-adb-handle-make-directory (dir &optional parents)
+ "Like `make-directory' for Tramp files."
+ (setq dir (expand-file-name dir))
+ (with-parsed-tramp-file-name dir nil
+ (when parents
+ (let ((par (expand-file-name ".." dir)))
+ (unless (file-directory-p par)
+ (make-directory par parents))))
+ (tramp-adb-barf-unless-okay
+ v (format "mkdir %s" (tramp-shell-quote-argument localname))
+ "Couldn't make directory %s" dir)
+ (tramp-flush-directory-property v (file-name-directory localname))))
+
+(defun tramp-adb-handle-delete-directory (directory &optional recursive)
+ "Like `delete-directory' for Tramp files."
+ (setq directory (expand-file-name directory))
+ (with-parsed-tramp-file-name directory nil
+ (tramp-flush-file-property v (file-name-directory localname))
+ (tramp-flush-directory-property v localname)
+ (tramp-adb-barf-unless-okay
+ v (format "%s %s"
+ (if recursive "rm -r" "rmdir")
+ (tramp-shell-quote-argument localname))
+ "Couldn't delete %s" directory)))
+
+(defun tramp-adb-handle-delete-file (filename &optional trash)
+ "Like `delete-file' for Tramp files."
+ (setq filename (expand-file-name filename))
+ (with-parsed-tramp-file-name filename nil
+ (tramp-flush-file-property v (file-name-directory localname))
+ (tramp-flush-file-property v localname)
+ (tramp-adb-barf-unless-okay
+ v (format "rm %s" (tramp-shell-quote-argument localname))
+ "Couldn't delete %s" filename)))
+
+(defun tramp-adb-handle-file-name-all-completions (filename directory)
+ "Like `file-name-all-completions' for Tramp files."
+ (all-completions
+ filename
+ (with-parsed-tramp-file-name directory nil
+ (with-tramp-file-property v localname "file-name-all-completions"
+ (save-match-data
+ (tramp-adb-send-command
+ v (format "%s %s"
+ (tramp-adb-get-ls-command v)
+ (tramp-shell-quote-argument localname)))
+ (mapcar
+ (lambda (f)
+ (if (file-directory-p f)
+ (file-name-as-directory f)
+ f))
+ (with-current-buffer (tramp-get-buffer v)
+ (delq
+ nil
+ (mapcar
+ (lambda (l) (and (not (string-match "^[[:space:]]*$" l)) l))
+ (split-string (buffer-string) "\n"))))))))))
+
+(defun tramp-adb-handle-file-local-copy (filename)
+ "Like `file-local-copy' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (unless (file-exists-p (file-truename filename))
+ (tramp-error
+ v 'file-error
+ "Cannot make local copy of non-existing file `%s'" filename))
+ (let ((tmpfile (tramp-compat-make-temp-file filename)))
+ (with-tramp-progress-reporter
+ v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
+ (when (tramp-adb-execute-adb-command v "pull" localname tmpfile)
+ (delete-file tmpfile)
+ (tramp-error
+ v 'file-error "Cannot make local copy of file `%s'" filename))
+ (set-file-modes tmpfile (file-modes filename)))
+ tmpfile)))
+
+(defun tramp-adb-handle-file-writable-p (filename)
+ "Like `tramp-sh-handle-file-writable-p'.
+But handle the case, if the \"test\" command is not available."
+ (with-parsed-tramp-file-name filename nil
+ (with-tramp-file-property v localname "file-writable-p"
+ (if (tramp-adb-find-test-command v)
+ (if (file-exists-p filename)
+ (zerop
+ (tramp-adb-command-exit-status
+ v (format "test -w %s" (tramp-shell-quote-argument localname))))
+ (and
+ (file-directory-p (file-name-directory filename))
+ (file-writable-p (file-name-directory filename))))
+
+ ;; Missing "test" command on Android < 4.
+ (let ((rw-path "/data/data"))
+ (tramp-message
+ v 5
+ "Not implemented yet (assuming \"/data/data\" is writable): %s"
+ localname)
+ (and (>= (length localname) (length rw-path))
+ (string= (substring localname 0 (length rw-path))
+ rw-path)))))))
+
+(defun tramp-adb-handle-write-region
+ (start end filename &optional append visit lockname confirm)
+ "Like `write-region' for Tramp files."
+ (setq filename (expand-file-name filename))
+ (with-parsed-tramp-file-name filename nil
+ (when append
+ (tramp-error
+ v 'file-error "Cannot append to file using Tramp (`%s')" filename))
+ (when (and confirm (file-exists-p filename))
+ (unless (y-or-n-p (format "File %s exists; overwrite anyway? "
+ filename))
+ (tramp-error v 'file-error "File not overwritten")))
+ ;; We must also flush the cache of the directory, because
+ ;; `file-attributes' reads the values from there.
+ (tramp-flush-file-property v (file-name-directory localname))
+ (tramp-flush-file-property v localname)
+ (let* ((curbuf (current-buffer))
+ (tmpfile (tramp-compat-make-temp-file filename)))
+ (tramp-run-real-handler
+ 'write-region
+ (list start end tmpfile append 'no-message lockname confirm))
+ (with-tramp-progress-reporter
+ v 3 (format "Moving tmp file %s to %s" tmpfile filename)
+ (unwind-protect
+ (when (tramp-adb-execute-adb-command v "push" tmpfile localname)
+ (tramp-error v 'file-error "Cannot write: `%s' filename"))
+ (delete-file tmpfile)))
+
+ (unless (equal curbuf (current-buffer))
+ (tramp-error
+ v 'file-error
+ "Buffer has changed from `%s' to `%s'" curbuf (current-buffer))))))
+
+(defun tramp-adb-handle-set-file-modes (filename mode)
+ "Like `set-file-modes' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (tramp-flush-file-property v localname)
+ (tramp-adb-barf-unless-okay
+ v (format "chmod %s %s" (tramp-compat-decimal-to-octal mode) localname)
+ "Error while changing file's mode %s" filename)))
+
+(defun tramp-adb-handle-set-file-times (filename &optional time)
+ "Like `set-file-times' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (tramp-flush-file-property v localname)
+ (let ((time (if (or (null time) (equal time '(0 0)))
+ (current-time)
+ time)))
+ (tramp-adb-command-exit-status
+ ;; use shell arithmetic because of Emacs integer size limit
+ v (format "touch -t $(( %d * 65536 + %d )) %s"
+ (car time) (cadr time)
+ (tramp-shell-quote-argument localname))))))
+
+(defun tramp-adb-handle-copy-file
+ (filename newname &optional ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes)
+ "Like `copy-file' for Tramp files.
+PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
+ (setq filename (expand-file-name filename)
+ newname (expand-file-name newname))
+
+ (if (file-directory-p filename)
+ (tramp-file-name-handler 'copy-directory filename newname keep-date t)
+ (with-tramp-progress-reporter
+ (tramp-dissect-file-name (if (file-remote-p filename) filename newname))
+ 0 (format "Copying %s to %s" filename newname)
+
+ (let ((tmpfile (file-local-copy filename)))
+
+ (if tmpfile
+ ;; Remote filename.
+ (condition-case err
+ (rename-file tmpfile newname ok-if-already-exists)
+ ((error quit)
+ (delete-file tmpfile)
+ (signal (car err) (cdr err))))
+
+ ;; Remote newname.
+ (when (file-directory-p newname)
+ (setq newname
+ (expand-file-name (file-name-nondirectory filename) newname)))
+
+ (with-parsed-tramp-file-name newname nil
+ (when (and (not ok-if-already-exists)
+ (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+
+ ;; We must also flush the cache of the directory, because
+ ;; `file-attributes' reads the values from there.
+ (tramp-flush-file-property v (file-name-directory localname))
+ (tramp-flush-file-property v localname)
+ (when (tramp-adb-execute-adb-command v "push" filename localname)
+ (tramp-error
+ v 'file-error "Cannot copy `%s' `%s'" filename newname))))))
+
+ ;; KEEP-DATE handling.
+ (when keep-date
+ (set-file-times newname (nth 5 (file-attributes filename))))))
+
+(defun tramp-adb-handle-rename-file
+ (filename newname &optional ok-if-already-exists)
+ "Like `rename-file' for Tramp files."
+ (setq filename (expand-file-name filename)
+ newname (expand-file-name newname))
+
+ (with-parsed-tramp-file-name
+ (if (file-remote-p filename) filename newname) nil
+ (with-tramp-progress-reporter
+ v 0 (format "Renaming %s to %s" newname filename)
+
+ (if (and (tramp-equal-remote filename newname)
+ (not (file-directory-p filename)))
+ (progn
+ (when (and (not ok-if-already-exists)
+ (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+ ;; We must also flush the cache of the directory, because
+ ;; `file-attributes' reads the values from there.
+ (tramp-flush-file-property v (file-name-directory localname))
+ (tramp-flush-file-property v localname)
+ ;; Short track.
+ (tramp-adb-barf-unless-okay
+ v (format
+ "mv %s %s"
+ (tramp-file-name-handler 'file-remote-p filename 'localname)
+ localname)
+ "Error renaming %s to %s" filename newname))
+
+ ;; Rename by copy.
+ (copy-file filename newname ok-if-already-exists t t)
+ (delete-file filename)))))
+
+(defun tramp-adb-handle-process-file
+ (program &optional infile destination display &rest args)
+ "Like `process-file' for Tramp files."
+ ;; The implementation is not complete yet.
+ (when (and (numberp destination) (zerop destination))
+ (error "Implementation does not handle immediate return"))
+
+ (with-parsed-tramp-file-name default-directory nil
+ (let (command input tmpinput stderr tmpstderr outbuf ret)
+ ;; Compute command.
+ (setq command (mapconcat 'tramp-shell-quote-argument
+ (cons program args) " "))
+ ;; Determine input.
+ (if (null infile)
+ (setq input "/dev/null")
+ (setq infile (expand-file-name infile))
+ (if (tramp-equal-remote default-directory infile)
+ ;; INFILE is on the same remote host.
+ (setq input (with-parsed-tramp-file-name infile nil localname))
+ ;; INFILE must be copied to remote host.
+ (setq input (tramp-make-tramp-temp-file v)
+ tmpinput (tramp-make-tramp-file-name method user host input))
+ (copy-file infile tmpinput t)))
+ (when input (setq command (format "%s <%s" command input)))
+
+ ;; Determine output.
+ (cond
+ ;; Just a buffer.
+ ((bufferp destination)
+ (setq outbuf destination))
+ ;; A buffer name.
+ ((stringp destination)
+ (setq outbuf (get-buffer-create destination)))
+ ;; (REAL-DESTINATION ERROR-DESTINATION)
+ ((consp destination)
+ ;; output.
+ (cond
+ ((bufferp (car destination))
+ (setq outbuf (car destination)))
+ ((stringp (car destination))
+ (setq outbuf (get-buffer-create (car destination))))
+ ((car destination)
+ (setq outbuf (current-buffer))))
+ ;; stderr.
+ (cond
+ ((stringp (cadr destination))
+ (setcar (cdr destination) (expand-file-name (cadr destination)))
+ (if (tramp-equal-remote default-directory (cadr destination))
+ ;; stderr is on the same remote host.
+ (setq stderr (with-parsed-tramp-file-name
+ (cadr destination) nil localname))
+ ;; stderr must be copied to remote host. The temporary
+ ;; file must be deleted after execution.
+ (setq stderr (tramp-make-tramp-temp-file v)
+ tmpstderr (tramp-make-tramp-file-name
+ method user host stderr))))
+ ;; stderr to be discarded.
+ ((null (cadr destination))
+ (setq stderr "/dev/null"))))
+ ;; 't
+ (destination
+ (setq outbuf (current-buffer))))
+ (when stderr (setq command (format "%s 2>%s" command stderr)))
+
+ ;; Send the command. It might not return in time, so we protect
+ ;; it. Call it in a subshell, in order to preserve working
+ ;; directory.
+ (condition-case nil
+ (progn
+ (setq ret 0)
+ (tramp-adb-barf-unless-okay
+ v (format "(cd %s; %s)"
+ (tramp-shell-quote-argument localname) command)
+ "")
+ ;; We should show the output anyway.
+ (when outbuf
+ (with-current-buffer outbuf
+ (insert-buffer-substring (tramp-get-connection-buffer v)))
+ (when display (display-buffer outbuf))))
+ ;; When the user did interrupt, we should do it also. We use
+ ;; return code -1 as marker.
+ (quit
+ (kill-buffer (tramp-get-connection-buffer v))
+ (setq ret -1))
+ ;; Handle errors.
+ (error
+ (kill-buffer (tramp-get-connection-buffer v))
+ (setq ret 1)))
+
+ ;; Provide error file.
+ (when tmpstderr (rename-file tmpstderr (cadr destination) t))
+
+ ;; Cleanup. We remove all file cache values for the connection,
+ ;; because the remote process could have changed them.
+ (when tmpinput (delete-file tmpinput))
+
+ ;; `process-file-side-effects' has been introduced with GNU
+ ;; Emacs 23.2. If set to `nil', no remote file will be changed
+ ;; by `program'. If it doesn't exist, we assume its default
+ ;; value 't'.
+ (unless (and (boundp 'process-file-side-effects)
+ (not (symbol-value 'process-file-side-effects)))
+ (tramp-flush-directory-property v ""))
+
+ ;; Return exit status.
+ (if (equal ret -1)
+ (keyboard-quit)
+ ret))))
+
+(defun tramp-adb-handle-shell-command
+ (command &optional output-buffer error-buffer)
+ "Like `shell-command' for Tramp files."
+ (let* ((asynchronous (string-match "[ \t]*&[ \t]*\\'" command))
+ ;; We cannot use `shell-file-name' and `shell-command-switch',
+ ;; they are variables of the local host.
+ (args (list "sh" "-c" (substring command 0 asynchronous)))
+ current-buffer-p
+ (output-buffer
+ (cond
+ ((bufferp output-buffer) output-buffer)
+ ((stringp output-buffer) (get-buffer-create output-buffer))
+ (output-buffer
+ (setq current-buffer-p t)
+ (current-buffer))
+ (t (get-buffer-create
+ (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) error-buffer)
+ (with-parsed-tramp-file-name default-directory nil
+ (list output-buffer (tramp-make-tramp-temp-file v)))
+ output-buffer))
+ (p (get-buffer-process output-buffer)))
+
+ ;; Check whether there is another process running. Tramp does not
+ ;; support 2 (asynchronous) processes in parallel.
+ (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")))
+
+ (if current-buffer-p
+ (progn
+ (barf-if-buffer-read-only)
+ (push-mark nil t))
+ (with-current-buffer output-buffer
+ (setq buffer-read-only nil)
+ (erase-buffer)))
+
+ (if (and (not current-buffer-p) (integerp asynchronous))
+ (prog1
+ ;; Run the process.
+ (apply 'start-file-process "*Async Shell*" buffer args)
+ ;; Display output.
+ (pop-to-buffer output-buffer)
+ (setq mode-line-process '(":%s"))
+ (shell-mode))
+
+ (prog1
+ ;; Run the process.
+ (apply 'process-file (car args) nil buffer nil (cdr args))
+ ;; Insert error messages if they were separated.
+ (when (listp buffer)
+ (with-current-buffer error-buffer
+ (insert-file-contents (cadr buffer)))
+ (delete-file (cadr buffer)))
+ (if current-buffer-p
+ ;; This is like exchange-point-and-mark, but doesn't
+ ;; activate the mark. It is cleaner to avoid activation,
+ ;; even though the command loop would deactivate the mark
+ ;; because we inserted text.
+ (goto-char (prog1 (mark t)
+ (set-marker (mark-marker) (point)
+ (current-buffer))))
+ ;; There's some output, display it.
+ (when (with-current-buffer output-buffer (> (point-max) (point-min)))
+ (if (functionp 'display-message-or-buffer)
+ (tramp-compat-funcall 'display-message-or-buffer output-buffer)
+ (pop-to-buffer output-buffer))))))))
+
+;; We use BUFFER also as connection buffer during setup. Because of
+;; this, its original contents must be saved, and restored once
+;; connection has been setup.
+(defun tramp-adb-handle-start-file-process (name buffer program &rest args)
+ "Like `start-file-process' for Tramp files."
+ (with-parsed-tramp-file-name default-directory nil
+ ;; When PROGRAM is nil, we should provide a tty. This is not
+ ;; possible here.
+ (unless (stringp program)
+ (tramp-error v 'file-error "PROGRAM must be a string"))
+
+ (let ((command
+ (format "cd %s; %s"
+ (tramp-shell-quote-argument localname)
+ (mapconcat 'tramp-shell-quote-argument
+ (cons program args) " ")))
+ (tramp-process-connection-type
+ (or (null program) tramp-process-connection-type))
+ (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
+ (name1 name)
+ (i 0))
+
+ (unless buffer
+ ;; BUFFER can be nil. We use a temporary buffer.
+ (setq buffer (generate-new-buffer tramp-temp-buffer-name)))
+ (while (get-process name1)
+ ;; NAME must be unique as process name.
+ (setq i (1+ i)
+ name1 (format "%s<%d>" name i)))
+ (setq name name1)
+ ;; Set the new process properties.
+ (tramp-set-connection-property v "process-name" name)
+ (tramp-set-connection-property v "process-buffer" buffer)
+
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (unwind-protect
+ ;; We catch this event. Otherwise, `start-process' could
+ ;; be called on the local host.
+ (save-excursion
+ (save-restriction
+ ;; Activate narrowing in order to save BUFFER
+ ;; contents. Clear also the modification time;
+ ;; otherwise we might be interrupted by
+ ;; `verify-visited-file-modtime'.
+ (let ((buffer-undo-list t)
+ (buffer-read-only nil)
+ (mark (point)))
+ (clear-visited-file-modtime)
+ (narrow-to-region (point-max) (point-max))
+ ;; We call `tramp-adb-maybe-open-connection', in
+ ;; order to cleanup the prompt afterwards.
+ (tramp-adb-maybe-open-connection v)
+ (widen)
+ (delete-region mark (point))
+ (narrow-to-region (point-max) (point-max))
+ ;; Send the command.
+ (let ((tramp-adb-prompt (regexp-quote command)))
+ (tramp-adb-send-command v command))
+ (let ((p (tramp-get-connection-process v)))
+ ;; Set query flag and process marker for this
+ ;; process. We ignore errors, because the process
+ ;; could have finished already.
+ (ignore-errors
+ (tramp-compat-set-process-query-on-exit-flag p t)
+ (set-marker (process-mark p) (point)))
+ ;; Return process.
+ p))))
+
+ ;; Save exit.
+ (if (string-match tramp-temp-buffer-name (buffer-name))
+ (ignore-errors
+ (set-process-buffer (tramp-get-connection-process v) nil)
+ (kill-buffer (current-buffer)))
+ (set-buffer-modified-p bmp))
+ (tramp-set-connection-property v "process-name" nil)
+ (tramp-set-connection-property v "process-buffer" nil))))))
+
+;; Helper functions.
+
+(defun tramp-adb-execute-adb-command (vec &rest args)
+ "Returns nil on success error-output on failure."
+ (when (> (length (tramp-file-name-host vec)) 0)
+ (setq args (append (list "-s" (tramp-file-name-host vec)) args)))
+ (with-temp-buffer
+ (prog1
+ (unless
+ (zerop (apply 'tramp-call-process tramp-adb-program nil t nil args))
+ (buffer-string))
+ (tramp-message vec 6 "%s" (buffer-string)))))
+
+(defun tramp-adb-find-test-command (vec)
+ "Checks, whether the ash has a builtin \"test\" command.
+This happens for Android >= 4.0."
+ (with-tramp-connection-property vec "test"
+ (zerop (tramp-adb-command-exit-status vec "type test"))))
+
+;; Connection functions
+
+(defun tramp-adb-send-command (vec command)
+ "Send the COMMAND to connection VEC."
+ (tramp-adb-maybe-open-connection vec)
+ (tramp-message vec 6 "%s" command)
+ (tramp-send-string vec command)
+ ;; fixme: Race condition
+ (tramp-adb-wait-for-output (tramp-get-connection-process vec))
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (save-excursion
+ (goto-char (point-min))
+ ;; We can't use stty to disable echo of command.
+ (delete-matching-lines (regexp-quote command))
+ ;; When the local machine is W32, there are still trailing ^M.
+ ;; There must be a better solution by setting the correct coding
+ ;; system, but this requires changes in core Tramp.
+ (goto-char (point-min))
+ (while (re-search-forward "\r+$" nil t)
+ (replace-match "" nil nil)))))
+
+(defun tramp-adb-command-exit-status
+ (vec command)
+ "Run COMMAND and return its exit status.
+Sends `echo $?' along with the COMMAND for checking the exit status. If
+COMMAND is nil, just sends `echo $?'. Returns the exit status found."
+ (tramp-adb-send-command
+ vec (if command
+ (format "%s; echo tramp_exit_status $?" command)
+ "echo tramp_exit_status $?"))
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (goto-char (point-max))
+ (unless (re-search-backward "tramp_exit_status [0-9]+" nil t)
+ (tramp-error
+ vec 'file-error "Couldn't find exit status of `%s'" command))
+ (skip-chars-forward "^ ")
+ (prog1
+ (read (current-buffer))
+ (let (buffer-read-only)
+ (delete-region (match-beginning 0) (point-max))))))
+
+(defun tramp-adb-barf-unless-okay (vec command fmt &rest args)
+ "Run COMMAND, check exit status, throw error if exit status not okay.
+FMT and ARGS are passed to `error'."
+ (unless (zerop (tramp-adb-command-exit-status vec command))
+ (apply 'tramp-error vec 'file-error fmt args)))
+
+(defun tramp-adb-wait-for-output (proc &optional timeout)
+ "Wait for output from remote command."
+ (unless (buffer-live-p (process-buffer proc))
+ (delete-process proc)
+ (tramp-error proc 'file-error "Process `%s' not available, try again" proc))
+ (with-current-buffer (process-buffer proc)
+ (if (tramp-wait-for-regexp proc timeout tramp-adb-prompt)
+ (let (buffer-read-only)
+ (goto-char (point-min))
+ ;; ADB terminal sends "^H" sequences.
+ (when (re-search-forward "<\b+" (point-at-eol) t)
+ (forward-line 1)
+ (delete-region (point-min) (point)))
+ ;; Delete the prompt.
+ (goto-char (point-min))
+ (when (re-search-forward tramp-adb-prompt (point-at-eol) t)
+ (forward-line 1)
+ (delete-region (point-min) (point)))
+ (goto-char (point-max))
+ (re-search-backward tramp-adb-prompt nil t)
+ (delete-region (point) (point-max)))
+ (if timeout
+ (tramp-error
+ proc 'file-error
+ "[[Remote adb prompt `%s' not found in %d secs]]"
+ tramp-adb-prompt timeout)
+ (tramp-error
+ proc 'file-error
+ "[[Remote prompt `%s' not found]]" tramp-adb-prompt)))))
+
+(defun tramp-adb-maybe-open-connection (vec)
+ "Maybe open a connection VEC.
+Does not do anything if a connection is already open, but re-opens the
+connection if a previous connection has died for some reason."
+ (let* ((buf (tramp-get-connection-buffer vec))
+ (p (get-buffer-process buf))
+ (host (tramp-file-name-host vec))
+ (user (tramp-file-name-user vec))
+ (devices (mapcar 'cadr (tramp-adb-parse-device-names nil))))
+
+ ;; Maybe we know already that "su" is not supported. We cannot
+ ;; use a connection property, because we have not checked yet
+ ;; whether it is still the same device.
+ (when (and user (not (tramp-get-file-property vec "" "su-command-p" t)))
+ (tramp-error vec 'file-error "Cannot switch to user `%s'" user))
+
+ (unless
+ (and p (processp p) (memq (process-status p) '(run open)))
+ (save-match-data
+ (when (and p (processp p)) (delete-process p))
+ (if (not devices)
+ (tramp-error vec 'file-error "No device connected"))
+ (if (and (> (length host) 0) (not (member host devices)))
+ (tramp-error vec 'file-error "Device %s not connected" host))
+ (if (and (> (length devices) 1) (zerop (length host)))
+ (tramp-error
+ vec 'file-error
+ "Multiple Devices connected: No Host/Device specified"))
+ (with-tramp-progress-reporter vec 3 "Opening adb shell connection"
+ (let* ((coding-system-for-read 'utf-8-dos) ;is this correct?
+ (process-connection-type tramp-process-connection-type)
+ (args (if (> (length host) 0)
+ (list "-s" host "shell")
+ (list "shell")))
+ (p (let ((default-directory
+ (tramp-compat-temporary-file-directory)))
+ (apply 'start-process (tramp-get-connection-name vec) buf
+ tramp-adb-program args))))
+ (tramp-message
+ vec 6 "%s" (mapconcat 'identity (process-command p) " "))
+ ;; Wait for initial prompt.
+ (tramp-adb-wait-for-output p 30)
+ (unless (eq 'run (process-status p))
+ (tramp-error vec 'file-error "Terminated!"))
+ (tramp-compat-set-process-query-on-exit-flag p nil)
+
+ ;; Check whether the properties have been changed. If
+ ;; yes, this is a strong indication that we must expire all
+ ;; connection properties. We start again.
+ (tramp-message vec 5 "Checking system information")
+ (tramp-adb-send-command
+ vec "echo \\\"`getprop ro.product.model` `getprop ro.product.version` `getprop ro.build.version.release`\\\"")
+ (let ((old-getprop
+ (tramp-get-connection-property vec "getprop" nil))
+ (new-getprop
+ (tramp-set-connection-property
+ vec "getprop"
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ ;; Read the expression.
+ (goto-char (point-min))
+ (read (current-buffer))))))
+ (when (and (stringp old-getprop)
+ (not (string-equal old-getprop new-getprop)))
+ (tramp-cleanup vec)
+ (tramp-message
+ vec 3
+ "Connection reset, because remote host changed from `%s' to `%s'"
+ old-getprop new-getprop)
+ (tramp-adb-maybe-open-connection vec)))
+
+ ;; Change user if indicated.
+ (when user
+ (tramp-adb-send-command vec (format "su %s" user))
+ (unless (zerop (tramp-adb-command-exit-status vec nil))
+ (delete-process p)
+ (tramp-set-file-property vec "" "su-command-p" nil)
+ (tramp-error
+ vec 'file-error "Cannot switch to user `%s'" user)))
+
+ ;; Set "remote-path" connection property. This is needed
+ ;; for eshell.
+ (tramp-adb-send-command vec "echo \\\"$PATH\\\"")
+ (tramp-set-connection-property
+ vec "remote-path"
+ (split-string
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ ;; Read the expression.
+ (goto-char (point-min))
+ (read (current-buffer)))
+ ":" 'omit-nulls))))))))
+
+(provide 'tramp-adb)
+;;; tramp-adb.el ends here
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index d1ef1739bf7..13a955ff579 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -58,6 +58,19 @@
(defvar tramp-cache-data (make-hash-table :test 'equal)
"Hash table for remote files properties.")
+;;;###tramp-autoload
+(defcustom tramp-connection-properties nil
+ "List of static connection properties.
+Every entry has the form (REGEXP PROPERTY VALUE). The regexp
+matches remote file names. It can be nil. PROPERTY is a string,
+and VALUE the corresponding value. They are used, if there is no
+matching entry in for PROPERTY in `tramp-cache-data'."
+ :group 'tramp
+ :version "24.4"
+ :type '(repeat (list (choice :tag "File Name regexp" regexp (const nil))
+ (choice :tag " Property" string)
+ (choice :tag " Value" sexp))))
+
(defcustom tramp-persistency-file-name
(cond
;; GNU Emacs.
@@ -85,16 +98,30 @@
(defvar tramp-cache-data-changed nil
"Whether persistent cache data have been changed.")
+(defun tramp-get-hash-table (key)
+ "Returns the hash table for KEY.
+If it doesn't exist yet, it is created and initialized with
+matching entries of `tramp-connection-properties'."
+ (or (gethash key tramp-cache-data)
+ (let ((hash
+ (puthash key (make-hash-table :test 'equal) tramp-cache-data)))
+ (when (vectorp key)
+ (dolist (elt tramp-connection-properties)
+ (when (string-match
+ (or (nth 0 elt) "")
+ (tramp-make-tramp-file-name
+ (aref key 0) (aref key 1) (aref key 2) nil))
+ (tramp-set-connection-property key (nth 1 elt) (nth 2 elt)))))
+ hash)))
+
;;;###tramp-autoload
-(defun tramp-get-file-property (vec file property default)
- "Get the PROPERTY of FILE from the cache context of VEC.
+(defun tramp-get-file-property (key file property default)
+ "Get the PROPERTY of FILE from the cache context of KEY.
Returns DEFAULT if not set."
;; Unify localname.
- (setq vec (copy-sequence vec))
- (aset vec 3 (tramp-run-real-handler 'directory-file-name (list file)))
- (let* ((hash (or (gethash vec tramp-cache-data)
- (puthash vec (make-hash-table :test 'equal)
- tramp-cache-data)))
+ (setq key (copy-sequence key))
+ (aset key 3 (tramp-run-real-handler 'directory-file-name (list file)))
+ (let* ((hash (tramp-get-hash-table key))
(value (when (hash-table-p hash) (gethash property hash))))
(if
;; We take the value only if there is any, and
@@ -112,7 +139,7 @@ Returns DEFAULT if not set."
(setq value (cdr value))
(setq value default))
- (tramp-message vec 8 "%s %s %s" file property value)
+ (tramp-message key 8 "%s %s %s" file property value)
(when (>= tramp-verbose 10)
(let* ((var (intern (concat "tramp-cache-get-count-" property)))
(val (or (ignore-errors (symbol-value var)) 0)))
@@ -120,18 +147,16 @@ Returns DEFAULT if not set."
value))
;;;###tramp-autoload
-(defun tramp-set-file-property (vec file property value)
- "Set the PROPERTY of FILE to VALUE, in the cache context of VEC.
+(defun tramp-set-file-property (key file property value)
+ "Set the PROPERTY of FILE to VALUE, in the cache context of KEY.
Returns VALUE."
;; Unify localname.
- (setq vec (copy-sequence vec))
- (aset vec 3 (tramp-run-real-handler 'directory-file-name (list file)))
- (let ((hash (or (gethash vec tramp-cache-data)
- (puthash vec (make-hash-table :test 'equal)
- tramp-cache-data))))
+ (setq key (copy-sequence key))
+ (aset key 3 (tramp-run-real-handler 'directory-file-name (list file)))
+ (let ((hash (tramp-get-hash-table key)))
;; We put the timestamp there.
(puthash property (cons (current-time) value) hash)
- (tramp-message vec 8 "%s %s %s" file property value)
+ (tramp-message key 8 "%s %s %s" file property value)
(when (>= tramp-verbose 10)
(let* ((var (intern (concat "tramp-cache-set-count-" property)))
(val (or (ignore-errors (symbol-value var)) 0)))
@@ -139,26 +164,26 @@ Returns VALUE."
value))
;;;###tramp-autoload
-(defun tramp-flush-file-property (vec file)
- "Remove all properties of FILE in the cache context of VEC."
+(defun tramp-flush-file-property (key file)
+ "Remove all properties of FILE in the cache context of KEY."
;; Remove file property of symlinks.
- (let ((truename (tramp-get-file-property vec file "file-truename" nil)))
+ (let ((truename (tramp-get-file-property key file "file-truename" nil)))
(when (and (stringp truename)
(not (string-equal file truename)))
- (tramp-flush-file-property vec truename)))
+ (tramp-flush-file-property key truename)))
;; Unify localname.
- (setq vec (copy-sequence vec))
- (aset vec 3 (tramp-run-real-handler 'directory-file-name (list file)))
- (tramp-message vec 8 "%s" file)
- (remhash vec tramp-cache-data))
+ (setq key (copy-sequence key))
+ (aset key 3 (tramp-run-real-handler 'directory-file-name (list file)))
+ (tramp-message key 8 "%s" file)
+ (remhash key tramp-cache-data))
;;;###tramp-autoload
-(defun tramp-flush-directory-property (vec directory)
- "Remove all properties of DIRECTORY in the cache context of VEC.
+(defun tramp-flush-directory-property (key directory)
+ "Remove all properties of DIRECTORY in the cache context of KEY.
Remove also properties of all files in subdirectories."
(let ((directory (tramp-run-real-handler
'directory-file-name (list directory))))
- (tramp-message vec 8 "%s" directory)
+ (tramp-message key 8 "%s" directory)
(maphash
(lambda (key value)
(when (and (stringp (tramp-file-name-localname key))
@@ -203,7 +228,7 @@ If the value is not set for the connection, returns DEFAULT."
(when (vectorp key)
(setq key (copy-sequence key))
(aset key 3 nil))
- (let* ((hash (gethash key tramp-cache-data))
+ (let* ((hash (tramp-get-hash-table key))
(value (if (hash-table-p hash)
(gethash property hash default)
default)))
@@ -220,15 +245,19 @@ PROPERTY is set persistent when KEY is a vector."
(when (vectorp key)
(setq key (copy-sequence key))
(aset key 3 nil))
- (let ((hash (or (gethash key tramp-cache-data)
- (puthash key (make-hash-table :test 'equal)
- tramp-cache-data))))
+ (let ((hash (tramp-get-hash-table key)))
(puthash property value hash)
(setq tramp-cache-data-changed t)
(tramp-message key 7 "%s %s" property value)
value))
;;;###tramp-autoload
+(defun tramp-connection-property-p (key property)
+ "Check whether named PROPERTY of a connection is defined.
+KEY identifies the connection, it is either a process or a vector."
+ (not (eq (tramp-get-connection-property key property 'undef) 'undef)))
+
+;;;###tramp-autoload
(defun tramp-flush-connection-property (key)
"Remove all properties identified by KEY.
KEY identifies the connection, it is either a process or a vector."
@@ -241,10 +270,8 @@ KEY identifies the connection, it is either a process or a vector."
key 7 "%s %s" key
(let ((hash (gethash key tramp-cache-data))
properties)
- (if (hash-table-p hash)
- (maphash
- (lambda (x y) (add-to-list 'properties x 'append))
- (gethash key tramp-cache-data)))
+ (when (hash-table-p hash)
+ (maphash (lambda (x y) (add-to-list 'properties x 'append)) hash))
properties))
(setq tramp-cache-data-changed t)
(remhash key tramp-cache-data))
@@ -365,7 +392,11 @@ for all methods. Resulting data are derived from connection history."
(while (setq element (pop list))
(setq key (pop element))
(while (setq item (pop element))
- (tramp-set-connection-property key (pop item) (car item)))))
+ ;; We set only values which are not contained in
+ ;; `tramp-connection-properties'. The cache is
+ ;; initialized properly by side effect.
+ (unless (tramp-connection-property-p key (car item))
+ (tramp-set-connection-property key (pop item) (car item))))))
(setq tramp-cache-data-changed nil))
(file-error
;; Most likely because the file doesn't exist yet. No message.
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index 58469b22447..462f0d88367 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -186,7 +186,7 @@ This includes password cache, file cache, connection cache, buffers."
'tramp-load-report-modules ; pre-hook
'tramp-append-tramp-buffers ; post-hook
- "\
+ (propertize "\n" 'display "\
Enter your bug report in this message, including as much detail
as you possibly can about the problem, what you did to cause it
and what the local and remote machines are.
@@ -209,7 +209,7 @@ contents of the *tramp/foo* buffer and the *debug tramp/foo*
buffer in your bug report.
--bug report follows this line--
-"))))
+")))))
(defun tramp-reporter-dump-variable (varsym mailbuf)
"Pretty-print the value of the variable in symbol VARSYM."
@@ -348,10 +348,10 @@ the debug buffer(s).")
(kill-buffer nil)
(switch-to-buffer curbuf)
(goto-char (point-max))
- (insert "\n\
+ (insert (propertize "\n" 'display "\n\
This is a special notion of the `gnus/message' package. If you
use another mail agent (by copying the contents of this buffer)
-please ensure that the buffers are attached to your email.\n\n")
+please ensure that the buffers are attached to your email.\n\n"))
(dolist (buffer buffer-list)
(tramp-compat-funcall
'mml-insert-empty-tag 'part 'type "text/plain"
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index ae91dc35b71..d4115352b34 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -52,6 +52,7 @@
(require 'format-spec)
(require 'shell)
+ (require 'trampver)
(require 'tramp-loaddefs)
;; As long as password.el is not part of (X)Emacs, it shouldn't be
@@ -71,22 +72,6 @@
(require 'timer-funcs)
(require 'timer))
- ;; We check whether `start-file-process' is bound.
- ;; Note: we deactivate this. There are problems, at least in SXEmacs.
- (unless t;(fboundp 'start-file-process)
-
- ;; tramp-util offers integration into other (X)Emacs packages like
- ;; compile.el, gud.el etc. Not necessary in Emacs 23.
- (eval-after-load "tramp"
- '(require 'tramp-util))
-
- ;; Make sure that we get integration with the VC package. When it
- ;; is loaded, we need to pull in the integration module. Not
- ;; necessary in Emacs 23.
- (eval-after-load "vc"
- (eval-after-load "tramp"
- '(require 'tramp-vc))))
-
;; Avoid byte-compiler warnings if the byte-compiler supports this.
;; Currently, XEmacs supports this.
(when (featurep 'xemacs)
@@ -112,7 +97,8 @@
;; `remote-file-name-inhibit-cache' has been introduced with Emacs 24.1.
;; Besides `t', `nil', and integer, we use also timestamps (as
;; returned by `current-time') internally.
- (defvar remote-file-name-inhibit-cache nil)
+ (unless (boundp 'remote-file-name-inhibit-cache)
+ (defvar remote-file-name-inhibit-cache nil))
;; For not existing functions, or functions with a changed argument
;; list, there are compiler warnings. We want to avoid them in
@@ -132,9 +118,7 @@
;; mechanism.
;; `file-remote-p' has been introduced with Emacs 22. The version
- ;; of XEmacs is not a magic file name function (yet); this is
- ;; corrected in tramp-util.el. Here it is sufficient if the
- ;; function exists.
+ ;; of XEmacs is not a magic file name function (yet).
(unless (fboundp 'file-remote-p)
(defalias 'file-remote-p
(lambda (file &optional identification connected)
@@ -322,16 +306,17 @@ Not actually used. Use `(format \"%o\" i)' instead?"
(wrong-number-of-arguments (file-attributes filename))))))
;; PRESERVE-UID-GID does not exist in XEmacs.
-;; PRESERVE-SELINUX-CONTEXT has been introduced with Emacs 24.1.
+;; PRESERVE-EXTENDED-ATTRIBUTES has been introduced with Emacs 24.1
+;; (as PRESERVE-SELINUX-CONTEXT), and renamed in Emacs 24.3.
(defun tramp-compat-copy-file
(filename newname &optional ok-if-already-exists keep-date
- preserve-uid-gid preserve-selinux-context)
+ preserve-uid-gid preserve-extended-attributes)
"Like `copy-file' for Tramp files (compat function)."
(cond
- (preserve-selinux-context
+ (preserve-extended-attributes
(tramp-compat-funcall
'copy-file filename newname ok-if-already-exists keep-date
- preserve-uid-gid preserve-selinux-context))
+ preserve-uid-gid preserve-extended-attributes))
(preserve-uid-gid
(tramp-compat-funcall
'copy-file filename newname ok-if-already-exists keep-date
@@ -399,25 +384,30 @@ Not actually used. Use `(format \"%o\" i)' instead?"
trash)))
(delete-file filename)))))
-;; RECURSIVE has been introduced with Emacs 23.2.
-(defun tramp-compat-delete-directory (directory &optional recursive)
+;; RECURSIVE has been introduced with Emacs 23.2. TRASH has been
+;; introduced with Emacs 24.1.
+(defun tramp-compat-delete-directory (directory &optional recursive trash)
"Like `delete-directory' for Tramp files (compat function)."
- (if (null recursive)
- (delete-directory directory)
- (condition-case nil
- (tramp-compat-funcall 'delete-directory directory recursive)
- ;; This Emacs version does not support the RECURSIVE flag. We
- ;; use the implementation from Emacs 23.2.
- (wrong-number-of-arguments
- (setq directory (directory-file-name (expand-file-name directory)))
- (if (not (file-symlink-p directory))
- (mapc (lambda (file)
- (if (eq t (car (file-attributes file)))
- (tramp-compat-delete-directory file recursive)
- (delete-file file)))
- (directory-files
- directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")))
- (delete-directory directory)))))
+ (condition-case nil
+ (cond
+ (trash
+ (tramp-compat-funcall 'delete-directory directory recursive trash))
+ (recursive
+ (tramp-compat-funcall 'delete-directory directory recursive))
+ (t
+ (delete-directory directory)))
+ ;; This Emacs version does not support the RECURSIVE or TRASH flag. We
+ ;; use the implementation from Emacs 23.2.
+ (wrong-number-of-arguments
+ (setq directory (directory-file-name (expand-file-name directory)))
+ (if (not (file-symlink-p directory))
+ (mapc (lambda (file)
+ (if (eq t (car (file-attributes file)))
+ (tramp-compat-delete-directory file recursive trash)
+ (tramp-compat-delete-file file trash)))
+ (directory-files
+ directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")))
+ (delete-directory directory))))
;; `number-sequence' does not exist in XEmacs. Implementation is
;; taken from Emacs 23.
@@ -448,20 +438,6 @@ This is, the first, empty, element is omitted. In XEmacs, the first
element is not omitted."
(delete "" (split-string string pattern)))
-(defun tramp-compat-call-process
- (program &optional infile destination display &rest args)
- "Calls `call-process' on the local host.
-This is needed because for some Emacs flavors Tramp has
-defadvised `call-process' to behave like `process-file'. The
-Lisp error raised when PROGRAM is nil is trapped also, returning 1."
- (let ((default-directory
- (if (file-remote-p default-directory)
- (tramp-compat-temporary-file-directory)
- default-directory)))
- (if (executable-find program)
- (apply 'call-process program infile destination display args)
- 1)))
-
(defun tramp-compat-process-running-p (process-name)
"Returns `t' if system process PROCESS-NAME is running for `user-login-name'."
(when (stringp process-name)
@@ -543,6 +519,11 @@ EOL-TYPE can be one of `dos', `unix', or `mac'."
"`dos', `unix', or `mac'")))))
(t (error "Can't change EOL conversion -- is MULE missing?"))))
+;; `user-error' has been added to Emacs 24.3.
+(defun tramp-compat-user-error (format &rest args)
+ "Signal a pilot error."
+ (apply (if (fboundp 'user-error) 'user-error 'error) format args))
+
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-compat 'force)))
diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el
index d4e246da2f0..7d266d4d172 100644
--- a/lisp/net/tramp-ftp.el
+++ b/lisp/net/tramp-ftp.el
@@ -200,6 +200,8 @@ pass to the OPERATION."
(inhibit-file-name-operation operation))
(apply 'ange-ftp-hook-function operation args)))))))
+;; It must be a `defsubst' in order to push the whole code into
+;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
;;;###tramp-autoload
(defsubst 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-gvfs.el b/lisp/net/tramp-gvfs.el
index 7dbd073a8f9..7c3b393873c 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -24,24 +24,28 @@
;;; Commentary:
;; Access functions for the GVFS daemon from Tramp. Tested with GVFS
-;; 1.0.2 (Ubuntu 8.10, Gnome 2.24). It has been reported also to run
+;; 1.0 (Ubuntu 8.10, Gnome 2.24). It has been reported also to run
;; with GVFS 0.2.5 (Ubuntu 8.04, Gnome 2.22), but there is an
;; incompatibility with the mount_info structure, which has been
;; worked around.
-;; It has also been tested with GVFS 1.6.2 (Ubuntu 10.04, Gnome 2.30),
+;; It has also been tested with GVFS 1.6 (Ubuntu 10.04, Gnome 2.30),
;; where the default_location has been added to mount_info (see
;; <https://bugzilla.gnome.org/show_bug.cgi?id=561998>.
+;; With GVFS 1.14 (Ubuntu 12.10, Gnome 3.6) the interfaces have been
+;; changed, again. So we must introspect the D-Bus interfaces.
+
;; All actions to mount a remote location, and to retrieve mount
;; information, are performed by D-Bus messages. File operations
;; themselves are performed via the mounted filesystem in ~/.gvfs.
;; Consequently, GNU Emacs 23.1 with enabled D-Bus bindings is a
;; precondition.
-;; The GVFS D-Bus interface is said to be unstable. There are even no
-;; introspection data. The interface, as discovered during
-;; development time, is given in respective comments.
+;; The GVFS D-Bus interface is said to be unstable. There were even
+;; no introspection data before GVFS 1.14. The interface, as
+;; discovered during development time, is given in respective
+;; comments.
;; The customer option `tramp-gvfs-methods' contains the list of
;; supported connection methods. Per default, these are "dav",
@@ -147,8 +151,9 @@
;; Emacs 23 on some system types. We don't call `dbus-ping', because
;; this would load dbus.el.
(unless (and (tramp-compat-funcall 'dbus-get-unique-name :session)
- (tramp-compat-process-running-p "gvfs-fuse-daemon"))
- (error "Package `tramp-gvfs' not supported"))
+ (or (tramp-compat-process-running-p "gvfs-fuse-daemon")
+ (tramp-compat-process-running-p "gvfsd-fuse")))
+ (tramp-compat-user-error "Package `tramp-gvfs' not supported"))
(defconst tramp-gvfs-path-mounttracker "/org/gtk/vfs/mounttracker"
"The object path of the GVFS daemon.")
@@ -156,6 +161,35 @@
(defconst tramp-gvfs-interface-mounttracker "org.gtk.vfs.MountTracker"
"The mount tracking interface in the GVFS daemon.")
+;; Introspection data exist since GVFS 1.14. If there are no such
+;; data, we expect an earlier interface.
+(defconst tramp-gvfs-methods-mounttracker
+ (dbus-introspect-get-method-names
+ :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker
+ tramp-gvfs-interface-mounttracker)
+ "The list of supported methods of the mount tracking interface.")
+
+(defconst tramp-gvfs-listmounts
+ (if (member "ListMounts" tramp-gvfs-methods-mounttracker)
+ "ListMounts"
+ "listMounts")
+ "The name of the \"listMounts\" method.
+It has been changed in GVFS 1.14.")
+
+(defconst tramp-gvfs-mountlocation
+ (if (member "MountLocation" tramp-gvfs-methods-mounttracker)
+ "MountLocation"
+ "mountLocation")
+ "The name of the \"mountLocation\" method.
+It has been changed in GVFS 1.14.")
+
+(defconst tramp-gvfs-mountlocation-signature
+ (dbus-introspect-get-signature
+ :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker
+ tramp-gvfs-interface-mounttracker tramp-gvfs-mountlocation)
+ "The D-Bus signature of the \"mountLocation\" method.
+It has been changed in GVFS 1.14.")
+
;; <interface name='org.gtk.vfs.MountTracker'>
;; <method name='listMounts'>
;; <arg name='mount_info_list'
@@ -376,21 +410,22 @@ Every entry is a list (NAME ADDRESS).")
(delete-file . tramp-gvfs-handle-delete-file)
;; `diff-latest-backup-file' performed by default handler.
(directory-file-name . tramp-handle-directory-file-name)
- (directory-files . tramp-gvfs-handle-directory-files)
+ (directory-files . tramp-handle-directory-files)
(directory-files-and-attributes
- . tramp-gvfs-handle-directory-files-and-attributes)
+ . tramp-handle-directory-files-and-attributes)
(dired-call-process . ignore)
(dired-compress-file . ignore)
(dired-uncache . tramp-handle-dired-uncache)
;; `executable-find' is not official yet. performed by default handler.
(expand-file-name . tramp-gvfs-handle-expand-file-name)
- ;; `file-accessible-directory-p' performed by default handler.
+ (file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
+ (file-acl . ignore)
(file-attributes . tramp-gvfs-handle-file-attributes)
(file-directory-p . tramp-gvfs-handle-file-directory-p)
(file-executable-p . tramp-gvfs-handle-file-executable-p)
- (file-exists-p . tramp-gvfs-handle-file-exists-p)
+ (file-exists-p . tramp-handle-file-exists-p)
(file-local-copy . tramp-gvfs-handle-file-local-copy)
- ;; `file-modes' performed by default handler.
+ (file-modes . tramp-handle-file-modes)
(file-name-all-completions . tramp-gvfs-handle-file-name-all-completions)
(file-name-as-directory . tramp-handle-file-name-as-directory)
(file-name-completion . tramp-handle-file-name-completion)
@@ -402,7 +437,7 @@ Every entry is a list (NAME ADDRESS).")
(file-readable-p . tramp-gvfs-handle-file-readable-p)
(file-regular-p . tramp-handle-file-regular-p)
(file-remote-p . tramp-handle-file-remote-p)
- (file-selinux-context . tramp-gvfs-handle-file-selinux-context)
+ (file-selinux-context . ignore)
(file-symlink-p . tramp-handle-file-symlink-p)
;; `file-truename' performed by default handler.
(file-writable-p . tramp-gvfs-handle-file-writable-p)
@@ -415,23 +450,25 @@ Every entry is a list (NAME ADDRESS).")
(make-directory . tramp-gvfs-handle-make-directory)
(make-directory-internal . ignore)
(make-symbolic-link . ignore)
- (process-file . tramp-gvfs-handle-process-file)
+ (process-file . ignore)
(rename-file . tramp-gvfs-handle-rename-file)
- (set-file-modes . tramp-gvfs-handle-set-file-modes)
- (set-file-selinux-context . tramp-gvfs-handle-set-file-selinux-context)
+ (set-file-acl . ignore)
+ (set-file-modes . ignore)
+ (set-file-selinux-context . ignore)
(set-visited-file-modtime . tramp-gvfs-handle-set-visited-file-modtime)
- (shell-command . tramp-gvfs-handle-shell-command)
- (start-file-process . tramp-gvfs-handle-start-file-process)
+ (shell-command . ignore)
+ (start-file-process . ignore)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory)
(vc-registered . ignore)
- (verify-visited-file-modtime
- . tramp-gvfs-handle-verify-visited-file-modtime)
+ ;; `verify-visited-file-modtime' performed by default handler.
(write-region . tramp-gvfs-handle-write-region)
)
"Alist of handler functions for Tramp GVFS method.
Operations not mentioned here will be handled by the default Emacs primitives.")
+;; It must be a `defsubst' in order to push the whole code into
+;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
;;;###tramp-autoload
(defsubst tramp-gvfs-file-name-p (filename)
"Check if it's a filename handled by the GVFS daemon."
@@ -457,11 +494,30 @@ pass to the OPERATION."
(add-to-list 'tramp-foreign-file-name-handler-alist
(cons 'tramp-gvfs-file-name-p 'tramp-gvfs-file-name-handler)))
+
+;; D-Bus helper function.
+
+(defun tramp-gvfs-dbus-string-to-byte-array (string)
+ "Like `dbus-string-to-byte-array' but add trailing \\0 if needed."
+ (dbus-string-to-byte-array
+ (if (string-match "^(aya{sv})" tramp-gvfs-mountlocation-signature)
+ (concat string (string 0)) string)))
+
+(defun tramp-gvfs-dbus-byte-array-to-string (byte-array)
+ "Like `dbus-byte-array-to-string' but remove trailing \\0 if exists."
+ ;; The byte array could be a variant. Take care.
+ (let ((byte-array
+ (if (and (consp byte-array) (atom (car byte-array)))
+ byte-array (car byte-array))))
+ (dbus-byte-array-to-string
+ (if (and (consp byte-array) (zerop (car (last byte-array))))
+ (butlast byte-array) byte-array))))
+
(defun tramp-gvfs-stringify-dbus-message (message)
"Convert a D-Bus message into readable UTF8 strings, used for traces."
(cond
((and (consp message) (characterp (car message)))
- (format "%S" (dbus-byte-array-to-string message)))
+ (format "%S" (tramp-gvfs-dbus-byte-array-to-string message)))
((consp message)
(mapcar 'tramp-gvfs-stringify-dbus-message message))
((stringp message)
@@ -526,85 +582,104 @@ is no information where to trace the message.")
(tramp-message tramp-gvfs-dbus-event-vector 10 "%S" event)
(tramp-error tramp-gvfs-dbus-event-vector 'file-error "%s" (cadr err))))
-(add-hook 'dbus-event-error-functions 'tramp-gvfs-dbus-event-error)
+;; `dbus-event-error-hooks' has been renamed to `dbus-event-error-functions'.
+(add-hook
+ (if (boundp 'dbus-event-error-functions)
+ 'dbus-event-error-functions 'dbus-event-error-hooks)
+ 'tramp-gvfs-dbus-event-error)
;; File name primitives.
(defun tramp-gvfs-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
- preserve-uid-gid preserve-selinux-context)
+ preserve-uid-gid preserve-extended-attributes)
"Like `copy-file' for Tramp files."
(with-parsed-tramp-file-name
(if (tramp-tramp-file-p filename) filename newname) nil
- (with-tramp-progress-reporter
- v 0 (format "Copying %s to %s" filename newname)
- (condition-case err
- (let ((args
- (list
- (if (tramp-gvfs-file-name-p filename)
- (tramp-gvfs-fuse-file-name filename)
- filename)
- (if (tramp-gvfs-file-name-p newname)
- (tramp-gvfs-fuse-file-name newname)
- newname)
- ok-if-already-exists keep-date preserve-uid-gid)))
- (when preserve-selinux-context
- (setq args (append args (list preserve-selinux-context))))
- (apply 'copy-file args))
-
- ;; Error case. Let's try it with the GVFS utilities.
- (error
- (tramp-message v 4 "`copy-file' failed, trying `gvfs-copy'")
- (unless
- (zerop
- (let ((args
- (append (if (or keep-date preserve-uid-gid)
- (list "--preserve")
- nil)
- (list
- (tramp-gvfs-url-file-name filename)
- (tramp-gvfs-url-file-name newname)))))
- (apply 'tramp-gvfs-send-command v "gvfs-copy" args)))
- ;; Propagate the error.
- (tramp-error v (car err) "%s" (cdr err)))))))
-
- (when (file-remote-p newname)
- (with-parsed-tramp-file-name newname nil
- (tramp-flush-file-property v (file-name-directory localname))
- (tramp-flush-file-property v localname))))
-
-(defun tramp-gvfs-handle-delete-directory (directory &optional recursive)
+
+ (when (and (not ok-if-already-exists) (file-exists-p newname))
+ (tramp-error
+ v 'file-already-exists "File %s already exists" newname))
+
+ (if (or (and (tramp-tramp-file-p filename)
+ (not (tramp-gvfs-file-name-p filename)))
+ (and (tramp-tramp-file-p newname)
+ (not (tramp-gvfs-file-name-p newname))))
+
+ ;; We cannot copy directly.
+ (let ((tmpfile (tramp-compat-make-temp-file filename)))
+ (cond
+ (preserve-extended-attributes
+ (copy-file
+ filename tmpfile t keep-date preserve-uid-gid
+ preserve-extended-attributes))
+ (preserve-uid-gid
+ (copy-file filename tmpfile t keep-date preserve-uid-gid))
+ (t
+ (copy-file filename tmpfile t keep-date)))
+ (rename-file tmpfile newname ok-if-already-exists))
+
+ ;; Direct copy.
+ (with-tramp-progress-reporter
+ v 0 (format "Copying %s to %s" filename newname)
+ (unless
+ (let ((args
+ (append (if (or keep-date preserve-uid-gid)
+ (list "--preserve")
+ nil)
+ (list
+ (tramp-gvfs-url-file-name filename)
+ (tramp-gvfs-url-file-name newname)))))
+ (apply 'tramp-gvfs-send-command v "gvfs-copy" args))
+ ;; Propagate the error.
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (goto-char (point-min))
+ (tramp-error-with-buffer
+ nil v 'file-error
+ "Copying failed, see buffer `%s' for details." (buffer-name)))))
+
+ (when (file-remote-p newname)
+ (with-parsed-tramp-file-name newname nil
+ (tramp-flush-file-property v (file-name-directory localname))
+ (tramp-flush-file-property v localname))))))
+
+(defun tramp-gvfs-handle-delete-directory (directory &optional recursive trash)
"Like `delete-directory' for Tramp files."
- (tramp-compat-delete-directory
- (tramp-gvfs-fuse-file-name directory) recursive))
+ (when (and recursive (not (file-symlink-p directory)))
+ (mapc (lambda (file)
+ (if (eq t (car (file-attributes file)))
+ (tramp-compat-delete-directory file recursive trash)
+ (tramp-compat-delete-file file trash)))
+ (directory-files
+ directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")))
+ (with-parsed-tramp-file-name directory nil
+ (tramp-flush-file-property v (file-name-directory localname))
+ (tramp-flush-directory-property v localname)
+ (unless
+ (tramp-gvfs-send-command
+ v (if (and trash delete-by-moving-to-trash) "gvfs-trash" "gvfs-rm")
+ (tramp-gvfs-url-file-name directory))
+ ;; Propagate the error.
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (goto-char (point-min))
+ (tramp-error-with-buffer
+ nil v 'file-error "Couldn't delete %s" directory)))))
(defun tramp-gvfs-handle-delete-file (filename &optional trash)
"Like `delete-file' for Tramp files."
- (tramp-compat-delete-file (tramp-gvfs-fuse-file-name filename) trash))
-
-(defun tramp-gvfs-handle-directory-files
- (directory &optional full match nosort)
- "Like `directory-files' for Tramp files."
- (let ((fuse-file-name (tramp-gvfs-fuse-file-name directory)))
- (mapcar
- (lambda (x)
- (if (string-match fuse-file-name x)
- (replace-match directory t t x)
- x))
- (directory-files fuse-file-name full match nosort))))
-
-(defun tramp-gvfs-handle-directory-files-and-attributes
- (directory &optional full match nosort id-format)
- "Like `directory-files-and-attributes' for Tramp files."
- (let ((fuse-file-name (tramp-gvfs-fuse-file-name directory)))
- (mapcar
- (lambda (x)
- (when (string-match fuse-file-name (car x))
- (setcar x (replace-match directory t t (car x))))
- x)
- (directory-files-and-attributes
- fuse-file-name full match nosort id-format))))
+ (with-parsed-tramp-file-name filename nil
+ (tramp-flush-file-property v (file-name-directory localname))
+ (tramp-flush-directory-property v localname)
+ (unless
+ (tramp-gvfs-send-command
+ v (if (and trash delete-by-moving-to-trash) "gvfs-trash" "gvfs-rm")
+ (tramp-gvfs-url-file-name filename))
+ ;; Propagate the error.
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (goto-char (point-min))
+ (tramp-error-with-buffer
+ nil v 'file-error "Couldn't delete %s" filename)))))
(defun tramp-gvfs-handle-expand-file-name (name &optional dir)
"Like `expand-file-name' for Tramp files."
@@ -651,19 +726,134 @@ is no information where to trace the message.")
(defun tramp-gvfs-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
- (file-attributes (tramp-gvfs-fuse-file-name filename) id-format))
+ (unless id-format (setq id-format 'integer))
+ ;; Don't modify `last-coding-system-used' by accident.
+ (let ((last-coding-system-used last-coding-system-used)
+ dirp res-symlink-target res-numlinks res-uid res-gid res-access
+ res-mod res-change res-size res-filemodes res-inode res-device)
+ (with-parsed-tramp-file-name filename nil
+ (with-tramp-file-property
+ v localname (format "file-attributes-%s" id-format)
+ (tramp-message v 5 "file attributes: %s" localname)
+ (tramp-gvfs-send-command
+ v "gvfs-info" (tramp-gvfs-url-file-name filename))
+ ;; Parse output ...
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (goto-char (point-min))
+ (when (re-search-forward "attributes:" nil t)
+ ;; ... directory or symlink
+ (goto-char (point-min))
+ (setq dirp (if (re-search-forward "type:\\s-+directory" nil t) t))
+ (goto-char (point-min))
+ (setq res-symlink-target
+ (if (re-search-forward
+ "standard::symlink-target:\\s-+\\(\\S-+\\)" nil t)
+ (match-string 1)))
+ ;; ... number links
+ (goto-char (point-min))
+ (setq res-numlinks
+ (if (re-search-forward "unix::nlink:\\s-+\\([0-9]+\\)" nil t)
+ (string-to-number (match-string 1)) 0))
+ ;; ... uid and gid
+ (goto-char (point-min))
+ (setq res-uid
+ (or (if (eq id-format 'integer)
+ (if (re-search-forward
+ "unix::uid:\\s-+\\([0-9]+\\)" nil t)
+ (string-to-number (match-string 1)))
+ (if (re-search-forward
+ "owner::user:\\s-+\\(\\S-+\\)" nil t)
+ (match-string 1)))
+ (tramp-get-local-uid id-format)))
+ (setq res-gid
+ (or (if (eq id-format 'integer)
+ (if (re-search-forward
+ "unix::gid:\\s-+\\([0-9]+\\)" nil t)
+ (string-to-number (match-string 1)))
+ (if (re-search-forward
+ "owner::group:\\s-+\\(\\S-+\\)" nil t)
+ (match-string 1)))
+ (tramp-get-local-gid id-format)))
+ ;; ... last access, modification and change time
+ (goto-char (point-min))
+ (setq res-access
+ (if (re-search-forward
+ "time::access:\\s-+\\([0-9]+\\)" nil t)
+ (seconds-to-time (string-to-number (match-string 1)))
+ '(0 0)))
+ (goto-char (point-min))
+ (setq res-mod
+ (if (re-search-forward
+ "time::modified:\\s-+\\([0-9]+\\)" nil t)
+ (seconds-to-time (string-to-number (match-string 1)))
+ '(0 0)))
+ (goto-char (point-min))
+ (setq res-change
+ (if (re-search-forward
+ "time::changed:\\s-+\\([0-9]+\\)" nil t)
+ (seconds-to-time (string-to-number (match-string 1)))
+ '(0 0)))
+ ;; ... size
+ (goto-char (point-min))
+ (setq res-size
+ (if (re-search-forward
+ "standard::size:\\s-+\\([0-9]+\\)" nil t)
+ (string-to-number (match-string 1)) 0))
+ ;; ... file mode flags
+ (goto-char (point-min))
+ (setq res-filemodes
+ (if (re-search-forward "unix::mode:\\s-+\\([0-9]+\\)" nil t)
+ (tramp-file-mode-from-int (match-string 1))
+ (if dirp "drwx------" "-rwx------")))
+ ;; ... inode and device
+ (goto-char (point-min))
+ (setq res-inode
+ (if (re-search-forward "unix::inode:\\s-+\\([0-9]+\\)" nil t)
+ (string-to-number (match-string 1))
+ (tramp-get-inode v)))
+ (goto-char (point-min))
+ (setq res-device
+ (if (re-search-forward "unix::device:\\s-+\\([0-9]+\\)" nil t)
+ (string-to-number (match-string 1))
+ (tramp-get-device v)))
+
+ ;; Return data gathered.
+ (list
+ ;; 0. t for directory, string (name linked to) for
+ ;; symbolic link, or nil.
+ (or dirp res-symlink-target)
+ ;; 1. Number of links to file.
+ res-numlinks
+ ;; 2. File uid.
+ res-uid
+ ;; 3. File gid.
+ res-gid
+ ;; 4. Last access time, as a list of integers.
+ ;; 5. Last modification time, likewise.
+ ;; 6. Last status change time, likewise.
+ res-access res-mod res-change
+ ;; 7. Size in bytes (-1, if number is out of range).
+ res-size
+ ;; 8. File modes.
+ res-filemodes
+ ;; 9. t if file's gid would change if file were deleted
+ ;; and recreated.
+ nil
+ ;; 10. Inode number.
+ res-inode
+ ;; 11. Device number.
+ res-device
+ )))))))
(defun tramp-gvfs-handle-file-directory-p (filename)
"Like `file-directory-p' for Tramp files."
- (file-directory-p (tramp-gvfs-fuse-file-name filename)))
+ (eq t (car (file-attributes filename))))
(defun tramp-gvfs-handle-file-executable-p (filename)
"Like `file-executable-p' for Tramp files."
- (file-executable-p (tramp-gvfs-fuse-file-name filename)))
-
-(defun tramp-gvfs-handle-file-exists-p (filename)
- "Like `file-exists-p' for Tramp files."
- (file-exists-p (tramp-gvfs-fuse-file-name filename)))
+ (with-parsed-tramp-file-name filename nil
+ (with-tramp-file-property v localname "file-executable-p"
+ (tramp-check-cached-permissions v ?x))))
(defun tramp-gvfs-handle-file-local-copy (filename)
"Like `file-local-copy' for Tramp files."
@@ -679,153 +869,221 @@ is no information where to trace the message.")
(defun tramp-gvfs-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
(unless (save-match-data (string-match "/" filename))
- (file-name-all-completions filename (tramp-gvfs-fuse-file-name directory))))
+ (with-parsed-tramp-file-name (expand-file-name directory) nil
+
+ (all-completions
+ filename
+ (mapcar
+ 'list
+ (or
+ ;; Try cache entries for filename, filename with last
+ ;; character removed, filename with last two characters
+ ;; removed, ..., and finally the empty string - all
+ ;; concatenated to the local directory name.
+ (let ((remote-file-name-inhibit-cache
+ (or remote-file-name-inhibit-cache
+ tramp-completion-reread-directory-timeout)))
+
+ ;; This is inefficient for very long filenames, pity
+ ;; `reduce' is not available...
+ (car
+ (apply
+ 'append
+ (mapcar
+ (lambda (x)
+ (let ((cache-hit
+ (tramp-get-file-property
+ v
+ (concat localname (substring filename 0 x))
+ "file-name-all-completions"
+ nil)))
+ (when cache-hit (list cache-hit))))
+ ;; We cannot use a length of 0, because file properties
+ ;; for "foo" and "foo/" are identical.
+ (tramp-compat-number-sequence (length filename) 1 -1)))))
+
+ ;; Cache expired or no matching cache entry found so we need
+ ;; to perform a remote operation.
+ (let ((result '("." ".."))
+ entry)
+ ;; Get a list of directories and files.
+ (tramp-gvfs-send-command
+ v "gvfs-ls" (tramp-gvfs-url-file-name directory))
+
+ ;; Now grab the output.
+ (with-temp-buffer
+ (insert-buffer-substring (tramp-get-connection-buffer v))
+ (goto-char (point-max))
+ (while (zerop (forward-line -1))
+ (setq entry (buffer-substring (point) (point-at-eol)))
+ (when (string-match filename entry)
+ (if (file-directory-p (expand-file-name entry directory))
+ (push (concat entry "/") result)
+ (push entry result)))))
+
+ ;; Because the remote op went through OK we know the
+ ;; directory we `cd'-ed to exists.
+ (tramp-set-file-property v localname "file-exists-p" t)
+
+ ;; Because the remote op went through OK we know every
+ ;; file listed by `ls' exists.
+ (mapc (lambda (entry)
+ (tramp-set-file-property
+ v (concat localname entry) "file-exists-p" t))
+ result)
+
+ ;; Store result in the cache.
+ (tramp-set-file-property
+ v (concat localname filename)
+ "file-name-all-completions" result))))))))
(defun tramp-gvfs-handle-file-readable-p (filename)
"Like `file-readable-p' for Tramp files."
- (file-readable-p (tramp-gvfs-fuse-file-name filename)))
-
-(defun tramp-gvfs-handle-file-selinux-context (filename)
- "Like `file-selinux-context' for Tramp files."
- (tramp-compat-funcall
- 'file-selinux-context (tramp-gvfs-fuse-file-name filename)))
+ (with-parsed-tramp-file-name filename nil
+ (with-tramp-file-property v localname "file-executable-p"
+ (tramp-check-cached-permissions v ?r))))
(defun tramp-gvfs-handle-file-writable-p (filename)
"Like `file-writable-p' for Tramp files."
- (file-writable-p (tramp-gvfs-fuse-file-name filename)))
+ (with-parsed-tramp-file-name filename nil
+ (with-tramp-file-property v localname "file-writable-p"
+ (if (file-exists-p filename)
+ (tramp-check-cached-permissions v ?w)
+ ;; If file doesn't exist, check if directory is writable.
+ (and (file-directory-p (file-name-directory filename))
+ (file-writable-p (file-name-directory filename)))))))
(defun tramp-gvfs-handle-insert-directory
(filename switches &optional wildcard full-directory-p)
"Like `insert-directory' for Tramp files."
- (insert-directory
- (tramp-gvfs-fuse-file-name filename) switches wildcard full-directory-p))
+ ;; gvfs-* output is hard to parse. So we let `ls-lisp' do the job.
+ (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)
+ (tramp-run-real-handler
+ 'insert-directory
+ (list filename switches wildcard full-directory-p))))))
(defun tramp-gvfs-handle-insert-file-contents
(filename &optional visit beg end replace)
"Like `insert-file-contents' for Tramp files."
- (unwind-protect
- (let ((fuse-file-name (tramp-gvfs-fuse-file-name filename))
- (result
- (insert-file-contents
- (tramp-gvfs-fuse-file-name filename) visit beg end replace)))
- (when (string-match fuse-file-name (car result))
- (setcar result (replace-match filename t t (car result))))
- result)
- (setq buffer-file-name filename)))
+ (barf-if-buffer-read-only)
+ (setq filename (expand-file-name filename))
+ (let (tmpfile result)
+ (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))
+
+ (setq tmpfile (file-local-copy filename)
+ result (insert-file-contents tmpfile visit beg end replace)))
+ ;; Save exit.
+ (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 (stringp tmpfile)
+ (delete-file tmpfile)))
+
+ ;; Result.
+ (list filename (cadr result))))
(defun tramp-gvfs-handle-make-directory (dir &optional parents)
"Like `make-directory' for Tramp files."
(with-parsed-tramp-file-name dir nil
- (condition-case err
- (with-tramp-gvfs-error-message dir 'make-directory
- (tramp-gvfs-fuse-file-name dir) parents)
-
- ;; Error case. Let's try it with the GVFS utilities.
- (error
- (tramp-message v 4 "`make-directory' failed, trying `gvfs-mkdir'")
- (unless
- (zerop
- (tramp-gvfs-send-command
- v "gvfs-mkdir" (tramp-gvfs-url-file-name dir)))
- ;; Propagate the error.
- (tramp-error v (car err) "%s" (cdr err)))))))
-
-(defun tramp-gvfs-handle-process-file
- (program &optional infile destination display &rest args)
- "Like `process-file' for Tramp files."
- (let ((default-directory (tramp-gvfs-fuse-file-name default-directory)))
- (apply 'call-process program infile destination display args)))
+ (unless
+ (apply
+ 'tramp-gvfs-send-command v "gvfs-mkdir"
+ (if parents
+ (list "-p" (tramp-gvfs-url-file-name dir))
+ (list (tramp-gvfs-url-file-name dir))))
+ ;; Propagate the error.
+ (tramp-error v 'file-error "Couldn't make directory %s" dir))))
(defun tramp-gvfs-handle-rename-file
(filename newname &optional ok-if-already-exists)
"Like `rename-file' for Tramp files."
(with-parsed-tramp-file-name
(if (tramp-tramp-file-p filename) filename newname) nil
- (with-tramp-progress-reporter
- v 0 (format "Renaming %s to %s" filename newname)
- (condition-case err
- (rename-file
- (if (tramp-gvfs-file-name-p filename)
- (tramp-gvfs-fuse-file-name filename)
- filename)
- (if (tramp-gvfs-file-name-p newname)
- (tramp-gvfs-fuse-file-name newname)
- newname)
- ok-if-already-exists)
-
- ;; Error case. Let's try it with the GVFS utilities.
- (error
- (tramp-message v 4 "`rename-file' failed, trying `gvfs-move'")
- (unless
- (zerop
- (tramp-gvfs-send-command
- v "gvfs-move"
- (tramp-gvfs-url-file-name filename)
- (tramp-gvfs-url-file-name newname)))
- ;; Propagate the error.
- (tramp-error v (car err) "%s" (cdr err)))))))
-
- (when (file-remote-p filename)
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-property v (file-name-directory localname))
- (tramp-flush-file-property v localname)))
- (when (file-remote-p newname)
- (with-parsed-tramp-file-name newname nil
- (tramp-flush-file-property v (file-name-directory localname))
- (tramp-flush-file-property v localname))))
+ (when (and (not ok-if-already-exists) (file-exists-p newname))
+ (tramp-error
+ v 'file-already-exists "File %s already exists" newname))
-(defun tramp-gvfs-handle-set-file-modes (filename mode)
- "Like `set-file-modes' for Tramp files."
- (with-tramp-gvfs-error-message filename 'set-file-modes
- (tramp-gvfs-fuse-file-name filename) mode))
+ (if (or (and (tramp-tramp-file-p filename)
+ (not (tramp-gvfs-file-name-p filename)))
+ (and (tramp-tramp-file-p newname)
+ (not (tramp-gvfs-file-name-p newname))))
-(defun tramp-gvfs-handle-set-file-selinux-context (filename context)
- "Like `set-file-selinux-context' for Tramp files."
- (with-tramp-gvfs-error-message filename 'set-file-selinux-context
- (tramp-gvfs-fuse-file-name filename) context))
+ ;; We cannot move directly.
+ (let ((tmpfile (tramp-compat-make-temp-file filename)))
+ (rename-file filename tmpfile t)
+ (rename-file tmpfile newname ok-if-already-exists))
+
+ ;; Direct move.
+ (with-tramp-progress-reporter
+ v 0 (format "Renaming %s to %s" filename newname)
+ (unless
+ (tramp-gvfs-send-command
+ v "gvfs-move"
+ (tramp-gvfs-url-file-name filename)
+ (tramp-gvfs-url-file-name newname))
+ ;; Propagate the error.
+ (with-current-buffer (tramp-get-buffer v)
+ (goto-char (point-min))
+ (tramp-error-with-buffer
+ nil v 'file-error
+ "Renaming failed, see buffer `%s' for details." (buffer-name)))))
+
+ (when (file-remote-p filename)
+ (with-parsed-tramp-file-name filename nil
+ (tramp-flush-file-property v (file-name-directory localname))
+ (tramp-flush-file-property v localname)))
+
+ (when (file-remote-p newname)
+ (with-parsed-tramp-file-name newname nil
+ (tramp-flush-file-property v (file-name-directory localname))
+ (tramp-flush-file-property v localname))))))
(defun tramp-gvfs-handle-set-visited-file-modtime (&optional time-list)
"Like `set-visited-file-modtime' for Tramp files."
- (let ((buffer-file-name (tramp-gvfs-fuse-file-name (buffer-file-name))))
- (set-visited-file-modtime time-list)))
-
-(defun tramp-gvfs-handle-shell-command
- (command &optional output-buffer error-buffer)
- "Like `shell-command' for Tramp files."
- (let ((default-directory (tramp-gvfs-fuse-file-name default-directory)))
- (shell-command command output-buffer error-buffer)))
-
-(defun tramp-gvfs-handle-start-file-process (name buffer program &rest args)
- "Like `start-file-process' for Tramp files."
- (let ((default-directory (tramp-gvfs-fuse-file-name default-directory)))
- (apply 'start-process name buffer program args)))
-
-(defun tramp-gvfs-handle-verify-visited-file-modtime (buf)
- "Like `verify-visited-file-modtime' for Tramp files."
- (with-current-buffer buf
- (let ((buffer-file-name (tramp-gvfs-fuse-file-name (buffer-file-name))))
- (verify-visited-file-modtime buf))))
+ (unless (buffer-file-name)
+ (error "Can't set-visited-file-modtime: buffer `%s' not visiting a file"
+ (buffer-name)))
+ (unless time-list
+ (let ((f (buffer-file-name)))
+ (with-parsed-tramp-file-name f nil
+ (let ((remote-file-name-inhibit-cache t)
+ (attr (file-attributes f)))
+ ;; '(-1 65535) means file doesn't exists yet.
+ (setq time-list (or (nth 5 attr) '(-1 65535)))))))
+ ;; We use '(0 0) as a don't-know value.
+ (unless (not (equal time-list '(0 0)))
+ (tramp-run-real-handler 'set-visited-file-modtime (list time-list))))
(defun tramp-gvfs-handle-write-region
(start end filename &optional append visit lockname confirm)
"Like `write-region' for Tramp files."
(with-parsed-tramp-file-name filename nil
- (condition-case err
- (with-tramp-gvfs-error-message filename 'write-region
- start end (tramp-gvfs-fuse-file-name filename)
- append visit lockname confirm)
-
- ;; Error case. Let's try rename.
- (error
- (let ((tmpfile (tramp-compat-make-temp-file filename)))
- (tramp-message v 4 "`write-region' failed, trying `rename-file'")
- (write-region start end tmpfile)
- (condition-case nil
- (rename-file tmpfile filename)
- (error
- (delete-file tmpfile)
- (tramp-error v (car err) "%s" (cdr err)))))))
+ ;; XEmacs takes a coding system as the seventh argument, not `confirm'.
+ (when (and (not (featurep 'xemacs)) confirm (file-exists-p filename))
+ (unless (y-or-n-p (format "File %s exists; overwrite anyway? " filename))
+ (tramp-error v 'file-error "File not overwritten")))
+
+ (let ((tmpfile (tramp-compat-make-temp-file filename)))
+ (write-region start end tmpfile)
+ (condition-case nil
+ (rename-file tmpfile filename)
+ (error
+ (delete-file tmpfile)
+ (tramp-error
+ v 'file-error "Couldn't write region to `%s'" filename))))
+
+ (tramp-flush-file-property v (file-name-directory localname))
+ (tramp-flush-file-property v localname)
;; Set file modification time.
(when (or (eq visit t) (stringp visit))
@@ -842,19 +1100,27 @@ is no information where to trace the message.")
(defun tramp-gvfs-url-file-name (filename)
"Return FILENAME in URL syntax."
;; "/" must NOT be hexlified.
- (let ((url-unreserved-chars (append '(?/) url-unreserved-chars)))
- (url-recreate-url
- (if (tramp-tramp-file-p filename)
- (with-parsed-tramp-file-name (file-truename filename) nil
- (when (string-match tramp-user-with-domain-regexp user)
- (setq user
- (concat (match-string 2 user) ";" (match-string 2 user))))
- (url-parse-make-urlobj
- method user nil
- (tramp-file-name-real-host v) (tramp-file-name-port v)
- (url-hexify-string localname)))
- (url-parse-make-urlobj
- "file" nil nil nil nil (url-hexify-string (file-truename filename)))))))
+ (let ((url-unreserved-chars (append '(?/) url-unreserved-chars))
+ result)
+ (setq
+ result
+ (url-recreate-url
+ (if (tramp-tramp-file-p filename)
+ (with-parsed-tramp-file-name filename nil
+ (when (and user (string-match tramp-user-with-domain-regexp user))
+ (setq user
+ (concat (match-string 2 user) ";" (match-string 1 user))))
+ (url-parse-make-urlobj
+ method (url-hexify-string user) nil
+ (tramp-file-name-real-host v) (tramp-file-name-port v)
+ (url-hexify-string localname) nil nil t))
+ (url-parse-make-urlobj
+ "file" nil nil nil nil
+ (url-hexify-string (file-truename filename)) nil nil t))))
+ (when (tramp-tramp-file-p filename)
+ (with-parsed-tramp-file-name filename nil
+ (tramp-message v 10 "remote file `%s' is URL `%s'" filename result)))
+ result))
(defun tramp-gvfs-object-path (filename)
"Create a D-Bus object path from FILENAME."
@@ -995,24 +1261,26 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"."
;; were changes in the entries, we cannot access dedicated
;; elements.
(while (stringp (car elt)) (setq elt (cdr elt)))
- (let* ((fuse-mountpoint (dbus-byte-array-to-string (cadr elt)))
+ (let* ((fuse-mountpoint (tramp-gvfs-dbus-byte-array-to-string (cadr elt)))
(mount-spec (caddr elt))
- (default-location (dbus-byte-array-to-string (cadddr elt)))
- (method (dbus-byte-array-to-string
+ (default-location (tramp-gvfs-dbus-byte-array-to-string
+ (cadddr elt)))
+ (method (tramp-gvfs-dbus-byte-array-to-string
(cadr (assoc "type" (cadr mount-spec)))))
- (user (dbus-byte-array-to-string
+ (user (tramp-gvfs-dbus-byte-array-to-string
(cadr (assoc "user" (cadr mount-spec)))))
- (domain (dbus-byte-array-to-string
+ (domain (tramp-gvfs-dbus-byte-array-to-string
(cadr (assoc "domain" (cadr mount-spec)))))
- (host (dbus-byte-array-to-string
+ (host (tramp-gvfs-dbus-byte-array-to-string
(cadr (or (assoc "host" (cadr mount-spec))
(assoc "server" (cadr mount-spec))))))
- (port (dbus-byte-array-to-string
+ (port (tramp-gvfs-dbus-byte-array-to-string
(cadr (assoc "port" (cadr mount-spec)))))
- (ssl (dbus-byte-array-to-string
+ (ssl (tramp-gvfs-dbus-byte-array-to-string
(cadr (assoc "ssl" (cadr mount-spec)))))
- (prefix (concat (dbus-byte-array-to-string (car mount-spec))
- (dbus-byte-array-to-string
+ (prefix (concat (tramp-gvfs-dbus-byte-array-to-string
+ (car mount-spec))
+ (tramp-gvfs-dbus-byte-array-to-string
(cadr (assoc "share" (cadr mount-spec)))))))
(when (string-match "^smb" method)
(setq method "smb"))
@@ -1030,7 +1298,7 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"."
v 6 "%s %s"
signal-name (tramp-gvfs-stringify-dbus-message mount-info))
(tramp-set-file-property v "/" "list-mounts" 'undef)
- (if (string-equal signal-name "unmounted")
+ (if (string-equal (downcase signal-name) "unmounted")
(tramp-set-file-property v "/" "fuse-mountpoint" nil)
;; Set prefix, mountpoint and location.
(unless (string-equal prefix "/")
@@ -1043,11 +1311,19 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"."
:session nil tramp-gvfs-path-mounttracker
tramp-gvfs-interface-mounttracker "mounted"
'tramp-gvfs-handler-mounted-unmounted)
+(dbus-register-signal
+ :session nil tramp-gvfs-path-mounttracker
+ tramp-gvfs-interface-mounttracker "Mounted"
+ 'tramp-gvfs-handler-mounted-unmounted)
(dbus-register-signal
:session nil tramp-gvfs-path-mounttracker
tramp-gvfs-interface-mounttracker "unmounted"
'tramp-gvfs-handler-mounted-unmounted)
+(dbus-register-signal
+ :session nil tramp-gvfs-path-mounttracker
+ tramp-gvfs-interface-mounttracker "Unmounted"
+ 'tramp-gvfs-handler-mounted-unmounted)
(defun tramp-gvfs-connection-mounted-p (vec)
"Check, whether the location is already mounted."
@@ -1059,30 +1335,33 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"."
(with-tramp-file-property vec "/" "list-mounts"
(with-tramp-dbus-call-method vec t
:session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker
- tramp-gvfs-interface-mounttracker "listMounts"))
+ tramp-gvfs-interface-mounttracker tramp-gvfs-listmounts))
nil)
;; Jump over the first elements of the mount info. Since there
;; were changes in the entries, we cannot access dedicated
;; elements.
(while (stringp (car elt)) (setq elt (cdr elt)))
- (let* ((fuse-mountpoint (dbus-byte-array-to-string (cadr elt)))
+ (let* ((fuse-mountpoint (tramp-gvfs-dbus-byte-array-to-string
+ (cadr elt)))
(mount-spec (caddr elt))
- (default-location (dbus-byte-array-to-string (cadddr elt)))
- (method (dbus-byte-array-to-string
+ (default-location (tramp-gvfs-dbus-byte-array-to-string
+ (cadddr elt)))
+ (method (tramp-gvfs-dbus-byte-array-to-string
(cadr (assoc "type" (cadr mount-spec)))))
- (user (dbus-byte-array-to-string
+ (user (tramp-gvfs-dbus-byte-array-to-string
(cadr (assoc "user" (cadr mount-spec)))))
- (domain (dbus-byte-array-to-string
+ (domain (tramp-gvfs-dbus-byte-array-to-string
(cadr (assoc "domain" (cadr mount-spec)))))
- (host (dbus-byte-array-to-string
+ (host (tramp-gvfs-dbus-byte-array-to-string
(cadr (or (assoc "host" (cadr mount-spec))
(assoc "server" (cadr mount-spec))))))
- (port (dbus-byte-array-to-string
+ (port (tramp-gvfs-dbus-byte-array-to-string
(cadr (assoc "port" (cadr mount-spec)))))
- (ssl (dbus-byte-array-to-string
+ (ssl (tramp-gvfs-dbus-byte-array-to-string
(cadr (assoc "ssl" (cadr mount-spec)))))
- (prefix (concat (dbus-byte-array-to-string (car mount-spec))
- (dbus-byte-array-to-string
+ (prefix (concat (tramp-gvfs-dbus-byte-array-to-string
+ (car mount-spec))
+ (tramp-gvfs-dbus-byte-array-to-string
(cadr (assoc "share" (cadr mount-spec)))))))
(when (string-match "^smb" method)
(setq method "smb"))
@@ -1109,6 +1388,14 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"."
(tramp-set-file-property vec "/" "default-location" default-location)
(throw 'mounted t)))))))
+(defun tramp-gvfs-mount-spec-entry (key value)
+ "Construct a mount-spec entry to be used in a mount_spec.
+It was \"a(say)\", but has changed to \"a{sv})\"."
+ (if (string-match "^(aya{sv})" tramp-gvfs-mountlocation-signature)
+ (list :dict-entry key
+ (list :variant (tramp-gvfs-dbus-string-to-byte-array value)))
+ (list :struct key (tramp-gvfs-dbus-string-to-byte-array value))))
+
(defun tramp-gvfs-mount-spec (vec)
"Return a mount-spec for \"org.gtk.vfs.MountTracker.mountLocation\"."
(let* ((method (tramp-file-name-method vec))
@@ -1128,38 +1415,32 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"."
(cond
((string-equal "smb" method)
(string-match "^/?\\([^/]+\\)" localname)
- `((:struct "type" ,(dbus-string-to-byte-array "smb-share"))
- (:struct "server" ,(dbus-string-to-byte-array host))
- (:struct "share" ,(dbus-string-to-byte-array
- (match-string 1 localname)))))
+ (list (tramp-gvfs-mount-spec-entry "type" "smb-share")
+ (tramp-gvfs-mount-spec-entry "server" host)
+ (tramp-gvfs-mount-spec-entry "share" (match-string 1 localname))))
((string-equal "obex" method)
- `((:struct "type" ,(dbus-string-to-byte-array method))
- (:struct "host" ,(dbus-string-to-byte-array
- (concat "[" (tramp-bluez-address host) "]")))))
+ (list (tramp-gvfs-mount-spec-entry "type" method)
+ (tramp-gvfs-mount-spec-entry
+ "host" (concat "[" (tramp-bluez-address host) "]"))))
((string-match "^dav" method)
- `((:struct "type" ,(dbus-string-to-byte-array "dav"))
- (:struct "host" ,(dbus-string-to-byte-array host))
- (:struct "ssl" ,(dbus-string-to-byte-array ssl))))
+ (list (tramp-gvfs-mount-spec-entry "type" "dav")
+ (tramp-gvfs-mount-spec-entry "host" host)
+ (tramp-gvfs-mount-spec-entry "ssl" ssl)))
(t
- `((:struct "type" ,(dbus-string-to-byte-array method))
- (:struct "host" ,(dbus-string-to-byte-array host)))))))
+ (list (tramp-gvfs-mount-spec-entry "type" method)
+ (tramp-gvfs-mount-spec-entry "host" host))))))
(when user
(add-to-list
- 'mount-spec
- `(:struct "user" ,(dbus-string-to-byte-array user))
- 'append))
+ 'mount-spec (tramp-gvfs-mount-spec-entry "user" user) 'append))
(when domain
(add-to-list
- 'mount-spec
- `(:struct "domain" ,(dbus-string-to-byte-array domain))
- 'append))
+ 'mount-spec (tramp-gvfs-mount-spec-entry "domain" domain) 'append))
(when port
(add-to-list
- 'mount-spec
- `(:struct "port" ,(dbus-string-to-byte-array (number-to-string port)))
+ 'mount-spec (tramp-gvfs-mount-spec-entry "port" (number-to-string port))
'append))
(when (and (string-match "^dav" method)
@@ -1167,7 +1448,7 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"."
(setq mount-pref (match-string 0 localname)))
;; Return.
- `(:struct ,(dbus-string-to-byte-array mount-pref) ,mount-spec)))
+ `(:struct ,(tramp-gvfs-dbus-string-to-byte-array mount-pref) ,mount-spec)))
;; Connection functions
@@ -1184,10 +1465,10 @@ connection if a previous connection has died for some reason."
;; For password handling, we need a process bound to the connection
;; buffer. Therefore, we create a dummy process. Maybe there is a
;; better solution?
- (unless (get-buffer-process (tramp-get-buffer vec))
+ (unless (get-buffer-process (tramp-get-connection-buffer vec))
(let ((p (make-network-process
:name (tramp-buffer-name vec)
- :buffer (tramp-get-buffer vec)
+ :buffer (tramp-get-connection-buffer vec)
:server t :host 'local :service t)))
(tramp-compat-set-process-query-on-exit-flag p nil)))
@@ -1195,10 +1476,15 @@ connection if a previous connection has died for some reason."
(let* ((method (tramp-file-name-method vec))
(user (tramp-file-name-user vec))
(host (tramp-file-name-host vec))
+ (localname (tramp-file-name-localname vec))
(object-path
(tramp-gvfs-object-path
(tramp-make-tramp-file-name method user host ""))))
+ (when (and (string-equal method "smb")
+ (string-equal localname "/"))
+ (tramp-error vec 'file-error "Filename must contain a Windows share"))
+
(with-tramp-progress-reporter
vec 3
(if (zerop (length user))
@@ -1214,20 +1500,35 @@ connection if a previous connection has died for some reason."
:session dbus-service-emacs object-path
tramp-gvfs-interface-mountoperation "askPassword"
'tramp-gvfs-handler-askpassword)
+ (dbus-register-method
+ :session dbus-service-emacs object-path
+ tramp-gvfs-interface-mountoperation "AskPassword"
+ 'tramp-gvfs-handler-askpassword)
;; There could be a callback of "askQuestion" when adding fingerprint.
(dbus-register-method
:session dbus-service-emacs object-path
tramp-gvfs-interface-mountoperation "askQuestion"
'tramp-gvfs-handler-askquestion)
+ (dbus-register-method
+ :session dbus-service-emacs object-path
+ tramp-gvfs-interface-mountoperation "AskQuestion"
+ 'tramp-gvfs-handler-askquestion)
;; The call must be asynchronously, because of the "askPassword"
;; or "askQuestion"callbacks.
- (with-tramp-dbus-call-method vec nil
- :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker
- tramp-gvfs-interface-mounttracker "mountLocation"
- (tramp-gvfs-mount-spec vec) (dbus-get-unique-name :session)
- :object-path object-path)
+ (if (string-match "(so)$" tramp-gvfs-mountlocation-signature)
+ (with-tramp-dbus-call-method vec nil
+ :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker
+ tramp-gvfs-interface-mounttracker tramp-gvfs-mountlocation
+ (tramp-gvfs-mount-spec vec)
+ `(:struct :string ,(dbus-get-unique-name :session)
+ :object-path ,object-path))
+ (with-tramp-dbus-call-method vec nil
+ :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker
+ tramp-gvfs-interface-mounttracker tramp-gvfs-mountlocation
+ (tramp-gvfs-mount-spec vec)
+ :string (dbus-get-unique-name :session) :object-path object-path))
;; We must wait, until the mount is applied. This will be
;; indicated by the "mounted" signal, i.e. the "fuse-mountpoint"
@@ -1250,22 +1551,30 @@ connection if a previous connection has died for some reason."
(tramp-get-file-property vec "/" "fuse-mountpoint" "") "/")
(tramp-error vec 'file-error "FUSE mount denied"))
- ;; We set the connection property "started" in order to put the
- ;; remote location into the cache, which is helpful for further
- ;; completion.
- (tramp-set-connection-property vec "started" t)))))
+ ;; In `tramp-check-cached-permissions', the connection
+ ;; properties {uig,gid}-{integer,string} are used. We set
+ ;; them to their local counterparts.
+ (tramp-set-connection-property
+ vec "uid-integer" (tramp-get-local-uid 'integer))
+ (tramp-set-connection-property
+ vec "gid-integer" (tramp-get-local-gid 'integer))
+ (tramp-set-connection-property
+ vec "uid-string" (tramp-get-local-uid 'string))
+ (tramp-set-connection-property
+ vec "gid-string" (tramp-get-local-gid 'string))))))
(defun tramp-gvfs-send-command (vec command &rest args)
"Send the COMMAND with its ARGS to connection VEC.
COMMAND is usually a command from the gvfs-* utilities.
-`call-process' is applied, and its return code is returned."
+`call-process' is applied, and it returns `t' if the return code is zero."
(let (result)
- (with-current-buffer (tramp-get-buffer vec)
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (tramp-gvfs-maybe-open-connection vec)
(erase-buffer)
(tramp-message vec 6 "%s %s" command (mapconcat 'identity args " "))
- (setq result (apply 'tramp-compat-call-process command nil t nil args))
- (tramp-message vec 6 "%s" (buffer-string))
- result)))
+ (setq result (apply 'tramp-call-process command nil t nil args))
+ (tramp-message vec 6 "\n%s" (buffer-string))
+ (zerop result))))
;; D-Bus BLUEZ functions.
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 29a6344734f..e45c2cf8511 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -109,69 +109,15 @@ detected as prompt when being sent on echoing hosts, therefore.")
(tramp-copy-keep-date t)))
;;;###tramp-autoload
(add-to-list 'tramp-methods
- '("scp"
- (tramp-login-program "ssh")
- (tramp-login-args (("-l" "%u") ("-p" "%p") ("-e" "none") ("%h")))
- (tramp-async-args (("-q")))
- (tramp-remote-shell "/bin/sh")
- (tramp-remote-shell-args ("-c"))
- (tramp-copy-program "scp")
- (tramp-copy-args (("-P" "%p") ("-p" "%k") ("-q") ("-r")))
- (tramp-copy-keep-date t)
- (tramp-copy-recursive t)
- (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null")
- ("-o" "UserKnownHostsFile=/dev/null")
- ("-o" "StrictHostKeyChecking=no")))
- (tramp-default-port 22)))
-;;;###tramp-autoload
-(add-to-list 'tramp-methods
- '("scp1"
- (tramp-login-program "ssh")
- (tramp-login-args (("-l" "%u") ("-p" "%p")
- ("-1") ("-e" "none") ("%h")))
- (tramp-async-args (("-q")))
- (tramp-remote-shell "/bin/sh")
- (tramp-remote-shell-args ("-c"))
- (tramp-copy-program "scp")
- (tramp-copy-args (("-1") ("-P" "%p") ("-p" "%k") ("-q") ("-r")))
- (tramp-copy-keep-date t)
- (tramp-copy-recursive t)
- (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null")
- ("-o" "UserKnownHostsFile=/dev/null")
- ("-o" "StrictHostKeyChecking=no")))
- (tramp-default-port 22)))
-;;;###tramp-autoload
-(add-to-list 'tramp-methods
- '("scp2"
- (tramp-login-program "ssh")
- (tramp-login-args (("-l" "%u") ("-p" "%p")
- ("-2") ("-e" "none") ("%h")))
- (tramp-async-args (("-q")))
- (tramp-remote-shell "/bin/sh")
- (tramp-remote-shell-args ("-c"))
- (tramp-copy-program "scp")
- (tramp-copy-args (("-2") ("-P" "%p") ("-p" "%k") ("-q") ("-r")))
- (tramp-copy-keep-date t)
- (tramp-copy-recursive t)
- (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null")
- ("-o" "UserKnownHostsFile=/dev/null")
- ("-o" "StrictHostKeyChecking=no")))
- (tramp-default-port 22)))
-;;;###tramp-autoload
-(add-to-list 'tramp-methods
- '("scpc"
+ '("scp"
(tramp-login-program "ssh")
- (tramp-login-args (("-l" "%u") ("-p" "%p")
- ("-o" "ControlPath=%t.%%r@%%h:%%p")
- ("-o" "ControlMaster=yes")
+ (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
("-e" "none") ("%h")))
(tramp-async-args (("-q")))
(tramp-remote-shell "/bin/sh")
(tramp-remote-shell-args ("-c"))
(tramp-copy-program "scp")
- (tramp-copy-args (("-P" "%p") ("-p" "%k") ("-q") ("-r")
- ("-o" "ControlPath=%t.%%r@%%h:%%p")
- ("-o" "ControlMaster=auto")))
+ (tramp-copy-args (("-P" "%p") ("-p" "%k") ("-q") ("-r") ("%c")))
(tramp-copy-keep-date t)
(tramp-copy-recursive t)
(tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null")
@@ -182,14 +128,14 @@ detected as prompt when being sent on echoing hosts, therefore.")
(add-to-list 'tramp-methods
'("scpx"
(tramp-login-program "ssh")
- (tramp-login-args (("-l" "%u") ("-p" "%p")
- ("-e" "none") ("-t" "-t")
- ("%h") ("/bin/sh")))
+ (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
+ ("-e" "none") ("-t" "-t") ("%h") ("/bin/sh")))
(tramp-async-args (("-q")))
(tramp-remote-shell "/bin/sh")
(tramp-remote-shell-args ("-c"))
(tramp-copy-program "scp")
- (tramp-copy-args (("-P" "%p") ("-p" "%k") ("-q") ("-r")))
+ (tramp-copy-args (("-P" "%p") ("-p" "%k")
+ ("-q") ("-r") ("%c")))
(tramp-copy-keep-date t)
(tramp-copy-recursive t)
(tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null")
@@ -200,42 +146,25 @@ detected as prompt when being sent on echoing hosts, therefore.")
(add-to-list 'tramp-methods
'("sftp"
(tramp-login-program "ssh")
- (tramp-login-args (("-l" "%u") ("-p" "%p") ("-e" "none") ("%h")))
+ (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
+ ("-e" "none") ("%h")))
(tramp-async-args (("-q")))
(tramp-remote-shell "/bin/sh")
(tramp-remote-shell-args ("-c"))
- (tramp-copy-program "sftp")))
-;;;###tramp-autoload
+ (tramp-copy-program "sftp")
+ (tramp-copy-args ("%c"))))
+ ;;;###tramp-autoload
(add-to-list 'tramp-methods
'("rsync"
(tramp-login-program "ssh")
- (tramp-login-args (("-l" "%u") ("-p" "%p") ("-e" "none") ("%h")))
- (tramp-async-args (("-q")))
- (tramp-remote-shell "/bin/sh")
- (tramp-remote-shell-args ("-c"))
- (tramp-copy-program "rsync")
- (tramp-copy-args (("-e" "ssh") ("-t" "%k") ("-r")))
- (tramp-copy-keep-date t)
- (tramp-copy-keep-tmpfile t)
- (tramp-copy-recursive t)))
-;;;###tramp-autoload
-(add-to-list 'tramp-methods
- `("rsyncc"
- (tramp-login-program "ssh")
- (tramp-login-args (("-l" "%u") ("-p" "%p")
- ("-o" "ControlPath=%t.%%r@%%h:%%p")
- ("-o" "ControlMaster=yes")
+ (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
("-e" "none") ("%h")))
(tramp-async-args (("-q")))
(tramp-remote-shell "/bin/sh")
(tramp-remote-shell-args ("-c"))
(tramp-copy-program "rsync")
(tramp-copy-args (("-t" "%k") ("-r")))
- (tramp-copy-env (("RSYNC_RSH")
- (,(concat
- "ssh"
- " -o ControlPath=%t.%%r@%%h:%%p"
- " -o ControlMaster=auto"))))
+ (tramp-copy-env (("RSYNC_RSH") ("ssh" "%c")))
(tramp-copy-keep-date t)
(tramp-copy-keep-tmpfile t)
(tramp-copy-recursive t)))
@@ -257,33 +186,8 @@ detected as prompt when being sent on echoing hosts, therefore.")
(add-to-list 'tramp-methods
'("ssh"
(tramp-login-program "ssh")
- (tramp-login-args (("-l" "%u") ("-p" "%p") ("-e" "none") ("%h")))
- (tramp-async-args (("-q")))
- (tramp-remote-shell "/bin/sh")
- (tramp-remote-shell-args ("-c"))
- (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null")
- ("-o" "UserKnownHostsFile=/dev/null")
- ("-o" "StrictHostKeyChecking=no")))
- (tramp-default-port 22)))
-;;;###tramp-autoload
-(add-to-list 'tramp-methods
- '("ssh1"
- (tramp-login-program "ssh")
- (tramp-login-args (("-l" "%u") ("-p" "%p")
- ("-1") ("-e" "none") ("%h")))
- (tramp-async-args (("-q")))
- (tramp-remote-shell "/bin/sh")
- (tramp-remote-shell-args ("-c"))
- (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null")
- ("-o" "UserKnownHostsFile=/dev/null")
- ("-o" "StrictHostKeyChecking=no")))
- (tramp-default-port 22)))
-;;;###tramp-autoload
-(add-to-list 'tramp-methods
- '("ssh2"
- (tramp-login-program "ssh")
- (tramp-login-args (("-l" "%u") ("-p" "%p")
- ("-2") ("-e" "none") ("%h")))
+ (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
+ ("-e" "none") ("%h")))
(tramp-async-args (("-q")))
(tramp-remote-shell "/bin/sh")
(tramp-remote-shell-args ("-c"))
@@ -295,9 +199,8 @@ detected as prompt when being sent on echoing hosts, therefore.")
(add-to-list 'tramp-methods
'("sshx"
(tramp-login-program "ssh")
- (tramp-login-args (("-l" "%u") ("-p" "%p")
- ("-e" "none") ("-t" "-t")
- ("%h") ("/bin/sh")))
+ (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
+ ("-e" "none") ("-t" "-t") ("%h") ("/bin/sh")))
(tramp-async-args (("-q")))
(tramp-remote-shell "/bin/sh")
(tramp-remote-shell-args ("-c"))
@@ -351,14 +254,6 @@ detected as prompt when being sent on echoing hosts, therefore.")
(tramp-default-port 22)))
;;;###tramp-autoload
(add-to-list 'tramp-methods
- '("plink1"
- (tramp-login-program "plink")
- (tramp-login-args (("-l" "%u") ("-P" "%p") ("-1" "-ssh") ("%h")))
- (tramp-remote-shell "/bin/sh")
- (tramp-remote-shell-args ("-c"))
- (tramp-default-port 22)))
-;;;###tramp-autoload
-(add-to-list 'tramp-methods
`("plinkx"
(tramp-login-program "plink")
;; ("%h") must be a single element, see
@@ -471,23 +366,12 @@ detected as prompt when being sent on echoing hosts, therefore.")
(tramp-set-completion-function "rcp" tramp-completion-function-alist-rsh)
(tramp-set-completion-function "remcp" tramp-completion-function-alist-rsh)
(tramp-set-completion-function "scp" tramp-completion-function-alist-ssh)
- (tramp-set-completion-function "scp1" tramp-completion-function-alist-ssh)
- (tramp-set-completion-function "scp2" tramp-completion-function-alist-ssh)
- (tramp-set-completion-function "scpc" tramp-completion-function-alist-ssh)
(tramp-set-completion-function "scpx" tramp-completion-function-alist-ssh)
(tramp-set-completion-function "sftp" tramp-completion-function-alist-ssh)
(tramp-set-completion-function "rsync" tramp-completion-function-alist-ssh)
- (tramp-set-completion-function
- "rsyncc" tramp-completion-function-alist-ssh)
(tramp-set-completion-function "rsh" tramp-completion-function-alist-rsh)
(tramp-set-completion-function "remsh" tramp-completion-function-alist-rsh)
(tramp-set-completion-function "ssh" tramp-completion-function-alist-ssh)
- (tramp-set-completion-function "ssh1" tramp-completion-function-alist-ssh)
- (tramp-set-completion-function "ssh2" tramp-completion-function-alist-ssh)
- (tramp-set-completion-function
- "ssh1_old" tramp-completion-function-alist-ssh)
- (tramp-set-completion-function
- "ssh2_old" tramp-completion-function-alist-ssh)
(tramp-set-completion-function "sshx" tramp-completion-function-alist-ssh)
(tramp-set-completion-function
"telnet" tramp-completion-function-alist-telnet)
@@ -498,8 +382,6 @@ detected as prompt when being sent on echoing hosts, therefore.")
"krlogin" tramp-completion-function-alist-rsh)
(tramp-set-completion-function "plink" tramp-completion-function-alist-ssh)
(tramp-set-completion-function
- "plink1" tramp-completion-function-alist-ssh)
- (tramp-set-completion-function
"plinkx" tramp-completion-function-alist-putty)
(tramp-set-completion-function "pscp" tramp-completion-function-alist-ssh)
(tramp-set-completion-function "fcp" tramp-completion-function-alist-ssh)))
@@ -538,8 +420,9 @@ as given in your `~/.profile'."
(const :tag "Private Directories" tramp-own-remote-path)
(string :tag "Directory"))))
+;;;###tramp-autoload
(defcustom tramp-remote-process-environment
- `("HISTFILE=$HOME/.tramp_history" "HISTSIZE=1" "LC_ALL=C"
+ `("HISTFILE=$HOME/.tramp_history" "HISTSIZE=1" "TMOUT=0" "LC_ALL=C"
,(format "TERM=%s" tramp-terminal-type)
"EMACS=t" ;; Deprecated.
,(format "INSIDE_EMACS='%s,tramp:%s'" emacs-version tramp-version)
@@ -884,6 +767,16 @@ while (my $data = <STDIN>) {
Escape sequence %s is replaced with name of Perl binary.
This string is passed to `format', so percent characters need to be doubled.")
+(defconst tramp-perl-pack
+ "%s -e 'binmode STDIN; binmode STDOUT; print pack(q{u*}, join q{}, <>)'"
+ "Perl program to use for encoding a file.
+Escape sequence %s is replaced with name of Perl binary.")
+
+(defconst tramp-perl-unpack
+ "%s -e 'binmode STDIN; binmode STDOUT; print unpack(q{u*}, join q{}, <>)'"
+ "Perl program to use for decoding a file.
+Escape sequence %s is replaced with name of Perl binary.")
+
(defconst tramp-vc-registered-read-file-names
"echo \"(\"
while read file; do
@@ -905,25 +798,6 @@ existence, and file readability. Input shall be read via
here-document, otherwise the command could exceed maximum length
of command line.")
-(defconst tramp-file-mode-type-map
- '((0 . "-") ; Normal file (SVID-v2 and XPG2)
- (1 . "p") ; fifo
- (2 . "c") ; character device
- (3 . "m") ; multiplexed character device (v7)
- (4 . "d") ; directory
- (5 . "?") ; Named special file (XENIX)
- (6 . "b") ; block device
- (7 . "?") ; multiplexed block device (v7)
- (8 . "-") ; regular file
- (9 . "n") ; network special file (HP-UX)
- (10 . "l") ; symlink
- (11 . "?") ; ACL shadow inode (Solaris, not userspace)
- (12 . "s") ; socket
- (13 . "D") ; door special (Solaris)
- (14 . "w")) ; whiteout (BSD)
- "A list of file types returned from the `stat' system call.
-This is used to map a mode number to a permission string.")
-
;; New handlers should be added here. The following operations can be
;; handled using the normal primitives: file-name-sans-versions,
;; get-file-buffer.
@@ -935,6 +809,7 @@ This is used to map a mode number to a permission string.")
(file-name-nondirectory . tramp-handle-file-name-nondirectory)
(file-truename . tramp-sh-handle-file-truename)
(file-exists-p . tramp-sh-handle-file-exists-p)
+ (file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
(file-directory-p . tramp-sh-handle-file-directory-p)
(file-executable-p . tramp-sh-handle-file-executable-p)
(file-readable-p . tramp-sh-handle-file-readable-p)
@@ -985,6 +860,8 @@ This is used to map a mode number to a permission string.")
(verify-visited-file-modtime . tramp-sh-handle-verify-visited-file-modtime)
(file-selinux-context . tramp-sh-handle-file-selinux-context)
(set-file-selinux-context . tramp-sh-handle-set-file-selinux-context)
+ (file-acl . tramp-sh-handle-file-acl)
+ (set-file-acl . tramp-sh-handle-set-file-acl)
(vc-registered . tramp-sh-handle-vc-registered))
"Alist of handler functions.
Operations not mentioned here will be handled by the normal Emacs functions.")
@@ -1327,7 +1204,8 @@ target of the symlink differ."
(let ((f (buffer-file-name))
coding-system-used)
(with-parsed-tramp-file-name f nil
- (let* ((attr (file-attributes f))
+ (let* ((remote-file-name-inhibit-cache t)
+ (attr (file-attributes f))
;; '(-1 65535) means file doesn't exists yet.
(modtime (or (nth 5 attr) '(-1 65535))))
(when (boundp 'last-coding-system-used)
@@ -1431,7 +1309,7 @@ of."
(utc (not (featurep 'xemacs))))
(tramp-send-command-and-check
v (format "%s touch -t %s %s"
- (if utc "TZ=UTC; export TZ;" "")
+ (if utc "env TZ=UTC" "")
(if utc
(format-time-string "%Y%m%d%H%M.%S" time t)
(format-time-string "%Y%m%d%H%M.%S" time))
@@ -1441,7 +1319,7 @@ of."
;; without `set-file-times', this function is an alias for this.
;; We are local, so we don't need the UTC settings.
(zerop
- (tramp-compat-call-process
+ (tramp-call-process
"touch" nil nil nil "-t"
(format-time-string "%Y%m%d%H%M.%S" time)
(tramp-shell-quote-argument filename)))))
@@ -1475,7 +1353,7 @@ be non-negative integers."
;; `set-file-uid-gid'. On W32 "chown" might not work.
(let ((uid (or (and (natnump uid) uid) (tramp-get-local-uid 'integer)))
(gid (or (and (natnump gid) gid) (tramp-get-local-gid 'integer))))
- (tramp-compat-call-process
+ (tramp-call-process
"chown" nil nil nil
(format "%d:%d" uid gid) (tramp-shell-quote-argument filename))))))
@@ -1528,10 +1406,49 @@ be non-negative integers."
(if (stringp (nth 3 context))
(format "--range=%s" (nth 3 context)) "")
(tramp-shell-quote-argument localname))))
- (tramp-set-file-property v localname "file-selinux-context" context)
- (tramp-set-file-property v localname "file-selinux-context" 'undef)))
- ;; We always return nil.
- nil)
+ (progn
+ (tramp-set-file-property v localname "file-selinux-context" context)
+ t)
+ (tramp-set-file-property v localname "file-selinux-context" 'undef)
+ nil)))
+
+(defun tramp-remote-acl-p (vec)
+ "Check, whether ACL is enabled on the remote host."
+ (with-tramp-connection-property (tramp-get-connection-process vec) "acl-p"
+ (tramp-send-command-and-check vec "getfacl /")))
+
+(defun tramp-sh-handle-file-acl (filename)
+ "Like `file-acl' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (with-tramp-file-property v localname "file-acl"
+ (when (and (tramp-remote-acl-p v)
+ (tramp-send-command-and-check
+ v (format
+ "getfacl -ac %s 2>/dev/null"
+ (tramp-shell-quote-argument localname))))
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (goto-char (point-max))
+ (delete-blank-lines)
+ (when (> (point-max) (point-min))
+ (tramp-compat-funcall
+ 'substring-no-properties (buffer-string))))))))
+
+(defun tramp-sh-handle-set-file-acl (filename acl-string)
+ "Like `set-file-acl' for Tramp files."
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (if (and (stringp acl-string) (tramp-remote-acl-p v)
+ (progn
+ (tramp-send-command
+ v (format "setfacl --set-file=- %s <<'EOF'\n%s\nEOF\n"
+ (tramp-shell-quote-argument localname) acl-string))
+ (tramp-send-command-and-check v nil)))
+ ;; Success.
+ (progn
+ (tramp-set-file-property v localname "file-acl" acl-string)
+ t)
+ ;; In case of errors, we return `nil'.
+ (tramp-set-file-property v localname "file-acl-string" 'undef)
+ nil)))
;; Simple functions using the `test' command.
@@ -1617,7 +1534,7 @@ be non-negative integers."
(and (tramp-run-test "-d" (file-name-directory filename))
(tramp-run-test "-w" (file-name-directory filename)))))))
-(defun tramp-sh-handle-file-ownership-preserved-p (filename)
+(defun tramp-sh-handle-file-ownership-preserved-p (filename &optional group)
"Like `file-ownership-preserved-p' for Tramp files."
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property v localname "file-ownership-preserved-p"
@@ -1625,7 +1542,10 @@ be non-negative integers."
;; Return t if the file doesn't exist, since it's true that no
;; information would be lost by an (attempted) delete and create.
(or (null attributes)
- (= (nth 2 attributes) (tramp-get-remote-uid v 'integer)))))))
+ (and
+ (= (nth 2 attributes) (tramp-get-remote-uid v 'integer))
+ (or (not group)
+ (= (nth 3 attributes) (tramp-get-remote-gid v 'integer)))))))))
;; Directory listings.
@@ -1881,7 +1801,7 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'"
(defun tramp-sh-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
- preserve-uid-gid preserve-selinux-context)
+ preserve-uid-gid preserve-extended-attributes)
"Like `copy-file' for Tramp files."
(setq filename (expand-file-name filename))
(setq newname (expand-file-name newname))
@@ -1891,13 +1811,13 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'"
(tramp-tramp-file-p newname))
(tramp-do-copy-or-rename-file
'copy filename newname ok-if-already-exists keep-date
- preserve-uid-gid preserve-selinux-context))
+ preserve-uid-gid preserve-extended-attributes))
;; Compat section.
- (preserve-selinux-context
+ (preserve-extended-attributes
(tramp-run-real-handler
'copy-file
(list filename newname ok-if-already-exists keep-date
- preserve-uid-gid preserve-selinux-context)))
+ preserve-uid-gid preserve-extended-attributes)))
(preserve-uid-gid
(tramp-run-real-handler
'copy-file
@@ -1960,7 +1880,7 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'"
(defun tramp-do-copy-or-rename-file
(op filename newname &optional ok-if-already-exists keep-date
- preserve-uid-gid preserve-selinux-context)
+ preserve-uid-gid preserve-extended-attributes)
"Copy or rename a remote file.
OP must be `copy' or `rename' and indicates the operation to perform.
FILENAME specifies the file to copy or rename, NEWNAME is the name of
@@ -1969,7 +1889,7 @@ OK-IF-ALREADY-EXISTS means don't barf if NEWNAME exists already.
KEEP-DATE means to make sure that NEWNAME has the same timestamp
as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep
the uid and gid if both files are on the same host.
-PRESERVE-SELINUX-CONTEXT activates selinux commands.
+PRESERVE-EXTENDED-ATTRIBUTES activates selinux and acl commands.
This function is invoked by `tramp-sh-handle-copy-file' and
`tramp-sh-handle-rename-file'. It is an error if OP is neither
@@ -1980,8 +1900,8 @@ file names."
(let ((t1 (tramp-tramp-file-p filename))
(t2 (tramp-tramp-file-p newname))
(length (nth 7 (file-attributes (file-truename filename))))
- (context (and preserve-selinux-context
- (apply 'file-selinux-context (list filename))))
+ (attributes (and preserve-extended-attributes
+ (apply 'file-extended-attributes (list filename))))
pr tm)
(with-parsed-tramp-file-name (if t1 filename newname) nil
@@ -2051,8 +1971,11 @@ file names."
;; One of them must be a Tramp file.
(error "Tramp implementation says this cannot happen")))
- ;; Handle `preserve-selinux-context'.
- (when context (apply 'set-file-selinux-context (list newname context)))
+ ;; Handle `preserve-extended-attributes'. We ignore possible
+ ;; errors, because ACL strings could be incompatible.
+ (when attributes
+ (ignore-errors
+ (apply 'set-file-extended-attributes (list newname attributes))))
;; In case of `rename', we must flush the cache of the source file.
(when (and t1 (eq op 'rename))
@@ -2250,7 +2173,7 @@ The method used must be an out-of-band method."
(t2 (tramp-tramp-file-p newname))
(orig-vec (tramp-dissect-file-name (if t1 filename newname)))
copy-program copy-args copy-env copy-keep-date port spec
- source target)
+ options source target)
(with-parsed-tramp-file-name (if t1 filename newname) nil
(if (and t1 t2)
@@ -2318,9 +2241,11 @@ The method used must be an out-of-band method."
user (or user "")
port (or port "")
spec (format-spec-make
- ?h host ?u user ?p port
?t (tramp-get-connection-property
- (tramp-get-connection-process v) "temp-file" "")
+ (tramp-get-connection-process v) "temp-file" ""))
+ options (format-spec tramp-ssh-controlmaster-options spec)
+ spec (format-spec-make
+ ?h host ?u user ?p port ?c options
?k (if keep-date " " ""))
copy-program (tramp-get-method-parameter
method 'tramp-copy-program)
@@ -2370,7 +2295,7 @@ The method used must be an out-of-band method."
v "process-buffer" (current-buffer))
(while copy-env
(tramp-message
- orig-vec 5 "%s=\"%s\"" (car copy-env) (cadr copy-env))
+ orig-vec 6 "%s=\"%s\"" (car copy-env) (cadr copy-env))
(setenv (pop copy-env) (pop copy-env)))
;; Use an asynchronous process. By this, password can
@@ -2380,17 +2305,38 @@ The method used must be an out-of-band method."
;; last longer than 60 secs.
(let ((p (let ((default-directory
(tramp-compat-temporary-file-directory)))
- (apply 'start-process
+ (apply 'start-process-shell-command
(tramp-get-connection-name v)
(tramp-get-connection-buffer v)
copy-program
- (append copy-args (list source target))))))
+ (append
+ copy-args
+ (list
+ (shell-quote-argument source)
+ (shell-quote-argument target)
+ "&&" "echo" "tramp_exit_status" "0"
+ "||" "echo" "tramp_exit_status" "1"))))))
(tramp-message
orig-vec 6 "%s"
(mapconcat 'identity (process-command p) " "))
(tramp-compat-set-process-query-on-exit-flag p nil)
(tramp-process-actions
- p v nil tramp-actions-copy-out-of-band)))
+ p v nil tramp-actions-copy-out-of-band)
+
+ ;; Check the return code.
+ (goto-char (point-max))
+ (unless
+ (re-search-backward "tramp_exit_status [0-9]+" nil t)
+ (tramp-error
+ orig-vec 'file-error
+ "Couldn't find exit status of `%s'" (process-command p)))
+ (skip-chars-forward "^ ")
+ (unless (zerop (read (current-buffer)))
+ (forward-line -1)
+ (tramp-error
+ orig-vec 'file-error
+ "Error copying: `%s'"
+ (buffer-substring (point-min) (point-at-eol))))))
;; Reset the transfer process properties.
(tramp-message orig-vec 6 "\n%s" (buffer-string))
@@ -2561,10 +2507,13 @@ This is like `dired-recursive-delete-directory' for Tramp files."
(if full-directory-p "yes" "no"))
;; If `full-directory-p', we just say `ls -l FILENAME'.
;; Else we chdir to the parent directory, then say `ls -ld BASENAME'.
+ ;; "--dired" returns byte positions. Therefore, the file names
+ ;; must be encoded, which is guaranteed by "LC_ALL=en_US.utf8
+ ;; LC_CTYPE=''".
(if full-directory-p
(tramp-send-command
v
- (format "%s %s %s 2>/dev/null"
+ (format "env LC_ALL=en_US.utf8 LC_CTYPE='' %s %s %s 2>/dev/null"
(tramp-get-ls-command v)
switches
(if wildcard
@@ -2580,7 +2529,7 @@ This is like `dired-recursive-delete-directory' for Tramp files."
(tramp-run-real-handler 'file-name-directory (list localname))))
(tramp-send-command
v
- (format "%s %s %s"
+ (format "env LC_ALL=en_US.utf8 LC_CTYPE='' %s %s %s 2>/dev/null"
(tramp-get-ls-command v)
switches
(if (or wildcard
@@ -2626,6 +2575,13 @@ This is like `dired-recursive-delete-directory' for Tramp files."
(while (re-search-forward tramp-color-escape-sequence-regexp nil t)
(replace-match "")))
+ ;; Decode the output, it could be multibyte.
+ (decode-coding-region
+ beg (point-max)
+ (or file-name-coding-system
+ (and (boundp 'default-file-name-coding-system)
+ (symbol-value 'default-file-name-coding-system))))
+
;; The inserted file could be from somewhere else.
(when (and (not wildcard) (not full-directory-p))
(goto-char (point-max))
@@ -2759,6 +2715,8 @@ the result will be a local, non-Tramp, filename."
(with-current-buffer (tramp-get-connection-buffer v)
(unwind-protect
+ ;; We catch this event. Otherwise, `start-process' could
+ ;; be called on the local host.
(save-excursion
(save-restriction
;; Activate narrowing in order to save BUFFER
@@ -2772,31 +2730,34 @@ the result will be a local, non-Tramp, filename."
(narrow-to-region (point-max) (point-max))
;; We call `tramp-maybe-open-connection', in order
;; to cleanup the prompt afterwards.
- (tramp-maybe-open-connection v)
- (widen)
- (delete-region mark (point))
- (narrow-to-region (point-max) (point-max))
- ;; Now do it.
- (if command
- ;; Send the command.
- (tramp-send-command v command nil t) ; nooutput
- ;; Check, whether a pty is associated.
- (unless (tramp-compat-process-get
- (tramp-get-connection-process v) 'remote-tty)
- (tramp-error
- v 'file-error
- "pty association is not supported for `%s'" name))))
- (let ((p (tramp-get-connection-process v)))
- ;; Set query flag for this process. We ignore errors,
- ;; because the process could have finished already.
- (ignore-errors
- (tramp-compat-set-process-query-on-exit-flag p t))
- ;; Return process.
- p)))
+ (catch 'suppress
+ (tramp-maybe-open-connection v)
+ (widen)
+ (delete-region mark (point))
+ (narrow-to-region (point-max) (point-max))
+ ;; Now do it.
+ (if command
+ ;; Send the command.
+ (tramp-send-command v command nil t) ; nooutput
+ ;; Check, whether a pty is associated.
+ (unless (tramp-compat-process-get
+ (tramp-get-connection-process v) 'remote-tty)
+ (tramp-error
+ v 'file-error
+ "pty association is not supported for `%s'" name))))
+ (let ((p (tramp-get-connection-process v)))
+ ;; Set query flag and process marker for this
+ ;; process. We ignore errors, because the process
+ ;; could have finished already.
+ (ignore-errors
+ (tramp-compat-set-process-query-on-exit-flag p t)
+ (set-marker (process-mark p) (point)))
+ ;; Return process.
+ p))))
;; Save exit.
(if (string-match tramp-temp-buffer-name (buffer-name))
- (progn
+ (ignore-errors
(set-process-buffer (tramp-get-connection-process v) nil)
(kill-buffer (current-buffer)))
(set-buffer-modified-p bmp))
@@ -2916,16 +2877,6 @@ the result will be a local, non-Tramp, filename."
(keyboard-quit)
ret))))
-(defun tramp-sh-handle-call-process-region
- (start end program &optional delete buffer display &rest args)
- "Like `call-process-region' for Tramp files."
- (let ((tmpfile (tramp-compat-make-temp-file "")))
- (write-region start end tmpfile)
- (when delete (delete-region start end))
- (unwind-protect
- (apply 'call-process program tmpfile buffer display args)
- (delete-file tmpfile))))
-
(defun tramp-sh-handle-file-local-copy (filename)
"Like `file-local-copy' for Tramp files."
(with-parsed-tramp-file-name filename nil
@@ -2950,40 +2901,39 @@ the result will be a local, non-Tramp, filename."
(rem-enc
(save-excursion
(with-tramp-progress-reporter
- v 3 (format "Encoding remote file %s" filename)
+ v 3
+ (format "Encoding remote file `%s' with `%s'" filename rem-enc)
(tramp-barf-unless-okay
v (format rem-enc (tramp-shell-quote-argument localname))
"Encoding remote file failed"))
- (if (functionp loc-dec)
- ;; If local decoding is a function, we call it. We
- ;; must disable multibyte, because
- ;; `uudecode-decode-region' doesn't handle it
- ;; correctly.
- (with-temp-buffer
- (set-buffer-multibyte nil)
- (insert-buffer-substring (tramp-get-buffer v))
- (with-tramp-progress-reporter
- v 3 (format "Decoding remote file %s with function %s"
- filename loc-dec)
+ (with-tramp-progress-reporter
+ v 3 (format "Decoding local file `%s' with `%s'"
+ tmpfile loc-dec)
+ (if (functionp loc-dec)
+ ;; If local decoding is a function, we call it.
+ ;; We must disable multibyte, because
+ ;; `uudecode-decode-region' doesn't handle it
+ ;; correctly.
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert-buffer-substring (tramp-get-buffer v))
(funcall loc-dec (point-min) (point-max))
;; Unset `file-name-handler-alist'. Otherwise,
;; epa-file gets confused.
(let (file-name-handler-alist
(coding-system-for-write 'binary))
- (write-region (point-min) (point-max) tmpfile))))
-
- ;; If tramp-decoding-function is not defined for this
- ;; method, we invoke tramp-decoding-command instead.
- (let ((tmpfile2 (tramp-compat-make-temp-file filename)))
- ;; Unset `file-name-handler-alist'. Otherwise,
- ;; epa-file gets confused.
- (let (file-name-handler-alist
- (coding-system-for-write 'binary))
- (write-region (point-min) (point-max) tmpfile2))
- (with-tramp-progress-reporter
- v 3 (format "Decoding remote file %s with command %s"
- filename loc-dec)
+ (write-region (point-min) (point-max) tmpfile)))
+
+ ;; If tramp-decoding-function is not defined for this
+ ;; method, we invoke tramp-decoding-command instead.
+ (let ((tmpfile2 (tramp-compat-make-temp-file filename)))
+ ;; Unset `file-name-handler-alist'. Otherwise,
+ ;; epa-file gets confused.
+ (let (file-name-handler-alist
+ (coding-system-for-write 'binary))
+ (with-current-buffer (tramp-get-buffer v)
+ (write-region (point-min) (point-max) tmpfile2)))
(unwind-protect
(tramp-call-local-coding-command
loc-dec tmpfile2 tmpfile)
@@ -3208,28 +3158,25 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
(with-temp-buffer
(set-buffer-multibyte nil)
;; Use encoding function or command.
- (if (functionp loc-enc)
- (with-tramp-progress-reporter
- v 3 (format "Encoding region using function `%s'"
- loc-enc)
- (let ((coding-system-for-read 'binary))
- (insert-file-contents-literally tmpfile))
- ;; The following `let' is a workaround for the
- ;; base64.el that comes with pgnus-0.84. If
- ;; both of the following conditions are
+ (with-tramp-progress-reporter
+ v 3 (format "Encoding local file `%s' using `%s'"
+ tmpfile loc-enc)
+ (if (functionp loc-enc)
+ ;; The following `let' is a workaround for
+ ;; the base64.el that comes with pgnus-0.84.
+ ;; If both of the following conditions are
;; satisfied, it tries to write to a local
;; file in default-directory, but at this
;; point, default-directory is remote.
;; (`call-process-region' can't write to
;; remote files, it seems.) The file in
;; question is a tmp file anyway.
- (let ((default-directory
+ (let ((coding-system-for-read 'binary)
+ (default-directory
(tramp-compat-temporary-file-directory)))
- (funcall loc-enc (point-min) (point-max))))
+ (insert-file-contents-literally tmpfile)
+ (funcall loc-enc (point-min) (point-max)))
- (with-tramp-progress-reporter
- v 3 (format "Encoding region using command `%s'"
- loc-enc)
(unless (zerop (tramp-call-local-coding-command
loc-enc tmpfile t))
(tramp-error
@@ -3242,8 +3189,8 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
;; writes to remote file. Because this happens on
;; the remote host, we cannot use the function.
(with-tramp-progress-reporter
- v 3
- (format "Decoding region into remote file %s" filename)
+ v 3 (format "Decoding remote file `%s' using `%s'"
+ filename rem-dec)
(goto-char (point-max))
(unless (bolp) (newline))
(tramp-send-command
@@ -3263,7 +3210,7 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
(erase-buffer)
(and
;; cksum runs locally, if possible.
- (zerop (tramp-compat-call-process "cksum" tmpfile t))
+ (zerop (tramp-call-process "cksum" tmpfile t))
;; cksum runs remotely.
(tramp-send-command-and-check
v
@@ -3441,6 +3388,9 @@ Only send the definition if it has not already been done."
(unless (member name scripts)
(with-tramp-progress-reporter vec 5 (format "Sending script `%s'" name)
;; The script could contain a call of Perl. This is masked with `%s'.
+ (when (and (string-match "%s" script)
+ (not (tramp-get-remote-perl vec)))
+ (tramp-error vec 'file-error "No Perl available on remote host"))
(tramp-barf-unless-okay
vec
(format "%s () {\n%s\n}" name
@@ -3870,11 +3820,6 @@ process to set up. VEC specifies the connection."
(tramp-send-command
vec (format "unset %s" (mapconcat 'identity unset " ")) t))))
-;; CCC: We should either implement a Perl version of base64 encoding
-;; and decoding. Then we just use that in the last item. The other
-;; alternative is to use the Perl version of UU encoding. But then
-;; we need a Lisp version of uuencode.
-;;
;; Old text from documentation of tramp-methods:
;; Using a uuencode/uudecode inline method is discouraged, please use one
;; of the base64 methods instead since base64 encoding is much more
@@ -3891,11 +3836,9 @@ process to set up. VEC specifies the connection."
(autoload 'uudecode-decode-region "uudecode")
(defconst tramp-local-coding-commands
- '((b64 base64-encode-region base64-decode-region)
+ `((b64 base64-encode-region base64-decode-region)
(uu tramp-uuencode-region uudecode-decode-region)
- (pack
- "perl -e 'binmode STDIN; binmode STDOUT; print pack(q{u*}, join q{}, <>)'"
- "perl -e 'binmode STDIN; binmode STDOUT; print unpack(q{u*}, join q{}, <>)'"))
+ (pack ,(format tramp-perl-pack "perl") ,(format tramp-perl-unpack "perl")))
"List of local coding commands for inline transfer.
Each item is a list that looks like this:
@@ -3930,9 +3873,7 @@ with the encoded or decoded results, respectively.")
(uu "uuencode xxx" "uudecode -o -")
(uu "uuencode xxx" "uudecode -p")
(uu "uuencode xxx" tramp-uudecode)
- (pack
- "perl -e 'binmode STDIN; binmode STDOUT; print pack(q{u*}, join q{}, <>)'"
- "perl -e 'binmode STDIN; binmode STDOUT; print unpack(q{u*}, join q{}, <>)'"))
+ (pack tramp-perl-pack tramp-perl-unpack))
"List of remote coding commands for inline transfer.
Each item is a list that looks like this:
@@ -4073,7 +4014,7 @@ INPUT can also be nil which means `/dev/null'.
OUTPUT can be a string (which specifies a filename), or t (which
means standard output and thus the current buffer), or nil (which
means discard it)."
- (tramp-compat-call-process
+ (tramp-call-process
tramp-encoding-shell
(when (and input (not (string-match "%s" cmd))) input)
(if (eq output t) t nil)
@@ -4081,7 +4022,7 @@ means discard it)."
tramp-encoding-command-switch
(concat
(if (string-match "%s" cmd) (format cmd input) cmd)
- (if (stringp output) (concat "> " output) ""))))
+ (if (stringp output) (concat " >" output) ""))))
(defconst tramp-inline-compress-commands
'(("gzip" "gzip -d")
@@ -4110,7 +4051,7 @@ Goes through the list `tramp-inline-compress-commands'."
decompress (nth 1 item))
(tramp-message
vec 5
- "Checking local compress command `%s', `%s' for sanity"
+ "Checking local compress commands `%s', `%s' for sanity"
compress decompress)
(unless
(zerop
@@ -4126,7 +4067,7 @@ Goes through the list `tramp-inline-compress-commands'."
(throw 'next nil))
(tramp-message
vec 5
- "Checking remote compress command `%s', `%s' for sanity"
+ "Checking remote compress commands `%s', `%s' for sanity"
compress decompress)
(unless (tramp-send-command-and-check
vec (format "echo %s | %s | %s" magic compress decompress) t)
@@ -4151,6 +4092,9 @@ Goes through the list `tramp-inline-compress-commands'."
(tramp-message
vec 2 "Couldn't find an inline transfer compress command")))))
+(defvar tramp-gw-tunnel-method)
+(defvar tramp-gw-socks-method)
+
(defun tramp-compute-multi-hops (vec)
"Expands VEC according to `tramp-default-proxies-alist'.
Gateway hops are already opened."
@@ -4211,10 +4155,11 @@ Gateway hops are already opened."
(setq choices tramp-default-proxies-alist)))))
;; Handle gateways.
- (when (string-match
- (format
- "^\\(%s\\|%s\\)$" tramp-gw-tunnel-method tramp-gw-socks-method)
- (tramp-file-name-method (car target-alist)))
+ (when (and (boundp 'tramp-gw-tunnel-method) (boundp 'tramp-gw-socks-method)
+ (string-match
+ (format
+ "^\\(%s\\|%s\\)$" tramp-gw-tunnel-method tramp-gw-socks-method)
+ (tramp-file-name-method (car target-alist))))
(let ((gw (pop target-alist))
(hop (pop target-alist)))
;; Is the method prepared for gateways?
@@ -4295,7 +4240,7 @@ connection if a previous connection has died for some reason."
(car tramp-current-connection)))
(> (tramp-time-diff
(current-time) (cdr tramp-current-connection))
- 5))
+ (or tramp-connection-min-time-diff 0)))
(throw 'suppress 'suppress))
;; If too much time has passed since last command was sent, look
@@ -4352,6 +4297,9 @@ connection if a previous connection has died for some reason."
(setenv "PROMPT_COMMAND")
(setenv "PS1" tramp-initial-end-of-output)
(let* ((target-alist (tramp-compute-multi-hops vec))
+ ;; We will apply `tramp-ssh-controlmaster-options'
+ ;; only for the first hop.
+ (options tramp-ssh-controlmaster-options)
(process-connection-type tramp-process-connection-type)
(process-adaptive-read-buffering nil)
(coding-system-for-read nil)
@@ -4413,14 +4361,16 @@ connection if a previous connection has died for some reason."
;; temporary file has another name, and it is
;; created and protected by ssh. It is also
;; removed by ssh when the connection is
- ;; closed.
+ ;; closed. The temporary file name is cached
+ ;; in the main connection process, therefore
+ ;; we cannot use `tramp-get-connection-process'.
(tmpfile
- (tramp-set-connection-property
- p "temp-file"
- (make-temp-name
- (expand-file-name
- tramp-temp-name-prefix
- (tramp-compat-temporary-file-directory)))))
+ (with-tramp-connection-property
+ (get-process (tramp-buffer-name vec)) "temp-file"
+ (make-temp-name
+ (expand-file-name
+ tramp-temp-name-prefix
+ (tramp-compat-temporary-file-directory)))))
spec r-shell)
;; Add arguments for asynchronous processes.
@@ -4454,8 +4404,10 @@ connection if a previous connection has died for some reason."
l-host (or l-host "")
l-user (or l-user "")
l-port (or l-port "")
+ spec (format-spec-make ?t tmpfile)
+ options (format-spec options spec)
spec (format-spec-make
- ?h l-host ?u l-user ?p l-port ?t tmpfile)
+ ?h l-host ?u l-user ?p l-port ?c options)
command
(concat
;; We do not want to see the trailing local
@@ -4482,7 +4434,8 @@ connection if a previous connection has died for some reason."
(tramp-message
vec 3 "Found remote shell prompt on `%s'" l-host))
;; Next hop.
- (setq target-alist (cdr target-alist)))
+ (setq options ""
+ target-alist (cdr target-alist)))
;; Make initial shell settings.
(tramp-open-connection-setup-interactive-shell p vec))))
@@ -4684,76 +4637,6 @@ Return ATTR."
(tramp-get-device vec))
attr))
-(defun tramp-check-cached-permissions (vec access)
- "Check `file-attributes' caches for VEC.
-Return t if according to the cache access type ACCESS is known to
-be granted."
- (let ((result nil)
- (offset (cond
- ((eq ?r access) 1)
- ((eq ?w access) 2)
- ((eq ?x access) 3))))
- (dolist (suffix '("string" "integer") result)
- (setq
- result
- (or
- result
- (let ((file-attr
- (tramp-get-file-property
- vec (tramp-file-name-localname vec)
- (concat "file-attributes-" suffix) nil))
- (remote-uid
- (tramp-get-connection-property
- vec (concat "uid-" suffix) nil))
- (remote-gid
- (tramp-get-connection-property
- vec (concat "gid-" suffix) nil)))
- (and
- file-attr
- (or
- ;; Not a symlink
- (eq t (car file-attr))
- (null (car file-attr)))
- (or
- ;; World accessible.
- (eq access (aref (nth 8 file-attr) (+ offset 6)))
- ;; User accessible and owned by user.
- (and
- (eq access (aref (nth 8 file-attr) offset))
- (equal remote-uid (nth 2 file-attr)))
- ;; Group accessible and owned by user's
- ;; principal group.
- (and
- (eq access (aref (nth 8 file-attr) (+ offset 3)))
- (equal remote-gid (nth 3 file-attr)))))))))))
-
-(defun tramp-file-mode-from-int (mode)
- "Turn an integer representing a file mode into an ls(1)-like string."
- (let ((type (cdr
- (assoc (logand (lsh mode -12) 15) tramp-file-mode-type-map)))
- (user (logand (lsh mode -6) 7))
- (group (logand (lsh mode -3) 7))
- (other (logand (lsh mode -0) 7))
- (suid (> (logand (lsh mode -9) 4) 0))
- (sgid (> (logand (lsh mode -9) 2) 0))
- (sticky (> (logand (lsh mode -9) 1) 0)))
- (setq user (tramp-file-mode-permissions user suid "s"))
- (setq group (tramp-file-mode-permissions group sgid "s"))
- (setq other (tramp-file-mode-permissions other sticky "t"))
- (concat type user group other)))
-
-(defun tramp-file-mode-permissions (perm suid suid-text)
- "Convert a permission bitset into a string.
-This is used internally by `tramp-file-mode-from-int'."
- (let ((r (> (logand perm 4) 0))
- (w (> (logand perm 2) 0))
- (x (> (logand perm 1) 0)))
- (concat (or (and r "r") "-")
- (or (and w "w") "-")
- (or (and suid x suid-text) ; suid, execute
- (and suid (upcase suid-text)) ; suid, !execute
- (and x "x") "-")))) ; !suid
-
(defun tramp-shell-case-fold (string)
"Converts STRING to shell glob pattern which ignores case."
(mapconcat
@@ -5022,12 +4905,6 @@ This is used internally by `tramp-file-mode-from-int'."
;; The command might not always return a number.
(if (and (equal id-format 'integer) (not (integerp res))) -1 res))))
-(defun tramp-get-local-uid (id-format)
- (if (equal id-format 'integer) (user-uid) (user-login-name)))
-
-(defun tramp-get-local-gid (id-format)
- (nth 3 (tramp-compat-file-attributes "~/" id-format)))
-
;; Some predefined connection properties.
(defun tramp-get-inline-compress (vec prop size)
"Return the compress command related to PROP.
@@ -5104,10 +4981,12 @@ function cell is returned to be applied on a buffer."
;; Windows shells need the program file name after
;; the pipe symbol be quoted if they use forward
;; slashes as directory separators.
- (if (and (string-match "local" prop)
- (memq system-type '(windows-nt)))
- "(%s | \"%s\" >%%s)"
- "(%s | %s >%%s)")
+ (cond
+ ((and (string-match "local" prop)
+ (memq system-type '(windows-nt)))
+ "(%s | \"%s\")")
+ ((string-match "local" prop) "(%s | %s)")
+ (t "(%s | %s >%%s)"))
coding compress))
(compress
(format
@@ -5120,38 +4999,12 @@ function cell is returned to be applied on a buffer."
"(%s <%%s | %s)")
compress coding))
((string-match "decoding" prop)
- (format "%s >%%s" coding))
+ (cond
+ ((string-match "local" prop) (format "%s" coding))
+ (t (format "%s >%%s" coding))))
(t
(format "%s <%%s" coding)))))))
-;;; 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)
- (with-parsed-tramp-file-name default-directory nil
- (mapconcat
- 'identity
- (tramp-get-remote-path v)
- ":"))
- (getenv "PATH"))))
-
-(eval-after-load "esh-util"
- '(progn
- (tramp-eshell-directory-change)
- (add-hook 'eshell-directory-change-hook
- 'tramp-eshell-directory-change)
- (add-hook 'tramp-unload-hook
- (lambda ()
- (remove-hook 'eshell-directory-change-hook
- 'tramp-eshell-directory-change)))))
-
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-sh 'force)))
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index b4bf10d4715..65c52ae4f3c 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -195,6 +195,7 @@ See `tramp-actions-before-shell' for more info.")
(dired-uncache . tramp-handle-dired-uncache)
(expand-file-name . tramp-smb-handle-expand-file-name)
(file-accessible-directory-p . tramp-smb-handle-file-directory-p)
+ (file-acl . tramp-smb-handle-file-acl)
(file-attributes . tramp-smb-handle-file-attributes)
(file-directory-p . tramp-smb-handle-file-directory-p)
(file-executable-p . tramp-handle-file-exists-p)
@@ -227,8 +228,9 @@ See `tramp-actions-before-shell' for more info.")
(make-symbolic-link . tramp-smb-handle-make-symbolic-link)
(process-file . tramp-smb-handle-process-file)
(rename-file . tramp-smb-handle-rename-file)
+ (set-file-acl . ignore)
(set-file-modes . tramp-smb-handle-set-file-modes)
- ;; `set-file-selinux-context' performed by default handler.
+ (set-file-selinux-context . ignore)
(set-file-times . ignore)
(set-visited-file-modtime . ignore)
(shell-command . tramp-handle-shell-command)
@@ -265,6 +267,8 @@ This can be used to disable echo etc."
:type 'string
:version "24.3")
+;; It must be a `defsubst' in order to push the whole code into
+;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
;;;###tramp-autoload
(defsubst tramp-smb-file-name-p (filename)
"Check if it's a filename for SMB servers."
@@ -485,10 +489,10 @@ pass to the OPERATION."
(defun tramp-smb-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
- preserve-uid-gid preserve-selinux-context)
+ preserve-uid-gid preserve-extended-attributes)
"Like `copy-file' for Tramp files.
KEEP-DATE has no effect in case NEWNAME resides on an SMB server.
-PRESERVE-UID-GID and PRESERVE-SELINUX-CONTEXT are completely ignored."
+PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(setq filename (expand-file-name filename)
newname (expand-file-name newname))
(with-tramp-progress-reporter
@@ -637,6 +641,23 @@ PRESERVE-UID-GID and PRESERVE-SELINUX-CONTEXT are completely ignored."
method user host
(tramp-run-real-handler 'expand-file-name (list localname))))))
+(defun tramp-smb-handle-file-acl (filename)
+ "Like `file-acl' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (with-tramp-file-property v localname "file-acl"
+ (when (tramp-smb-send-command
+ v (format "getfacl \"%s\"" (tramp-smb-get-localname v)))
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (goto-char (point-min))
+ (while (looking-at "^#")
+ (forward-line)
+ (delete-region (point-min) (point)))
+ (goto-char (point-max))
+ (delete-blank-lines)
+ (when (> (point-max) (point-min))
+ (tramp-compat-funcall
+ 'substring-no-properties (buffer-string))))))))
+
(defun tramp-smb-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
(unless id-format (setq id-format 'integer))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index c4c8efcbfe8..4ec3a4b7829 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -220,7 +220,8 @@ pair of the form (KEY VALUE). The following KEYs are defined:
argument. By this, arguments like (\"-l\" \"%u\") are optional.
\"%t\" is replaced by the temporary file name produced with
`tramp-make-tramp-temp-file'. \"%k\" indicates the keep-date
- parameter of a program, if exists.
+ parameter of a program, if exists. \"%c\" adds additional
+ `tramp-ssh-controlmaster-options' options for the first hop.
* `tramp-async-args'
When an asynchronous process is started, we know already that
the connection works. Therefore, we can pass additional
@@ -280,15 +281,24 @@ started on the local host. You should specify a remote host
`localhost' or the name of the local host. Another host name is
useful only in combination with `tramp-default-proxies-alist'.")
-(defun tramp-detect-ssh-controlmaster ()
- "Call ssh to detect whether it supports the ControlMaster argument.
-This function may return nil when the argument is supported, but
-shouldn't return t when it isn't."
- (ignore-errors
- (with-temp-buffer
- (call-process "ssh" nil t nil "-o" "ControlMaster")
- (goto-char (point-min))
- (search-forward-regexp "Missing ControlMaster argument" nil t))))
+;;;###tramp-autoload
+(defconst tramp-ssh-controlmaster-options
+ (let ((result ""))
+ (ignore-errors
+ (with-temp-buffer
+ (call-process "ssh" nil t nil "-o" "ControlMaster")
+ (goto-char (point-min))
+ (when (search-forward-regexp "Missing ControlMaster argument" nil t)
+ (setq result "-o ControlPath=%t.%%r@%%h:%%p -o ControlMaster=auto")))
+ (when result
+ (with-temp-buffer
+ (call-process "ssh" nil t nil "-o" "ControlPersist")
+ (goto-char (point-min))
+ (when (search-forward-regexp "Missing ControlPersist argument" nil t)
+ (setq result (concat result " -o ControlPersist=no"))))))
+ result)
+ "Call ssh to detect whether it supports the Control* arguments.
+Return a string to be used in `tramp-methods'.")
(defcustom tramp-default-method
;; An external copy method seems to be preferred, because it performs
@@ -297,8 +307,9 @@ shouldn't return t when it isn't."
;; permanent password queries. Either a password agent like
;; "ssh-agent" or "Pageant" shall run, or the optional
;; password-cache.el or auth-sources.el packages shall be active for
- ;; password caching. "scpc" is chosen if we detect that the user is
- ;; running OpenSSH 4.0 or newer.
+ ;; password caching. If we detect that the user is running OpenSSH
+ ;; 4.0 or newer, we could reuse the connection, which calls also for
+ ;; an external method.
(cond
;; PuTTY is installed. We don't take it, if it is installed on a
;; non-windows system, or pscp from the pssh (parallel ssh) package
@@ -314,16 +325,16 @@ shouldn't return t when it isn't."
"plink"))
;; There is an ssh installation.
((executable-find "scp")
- (cond
- ((tramp-detect-ssh-controlmaster) "scpc")
- ((or (fboundp 'password-read)
- (fboundp 'auth-source-user-or-password)
- (fboundp 'auth-source-search)
- ;; ssh-agent is running.
- (getenv "SSH_AUTH_SOCK")
- (getenv "SSH_AGENT_PID"))
- "scp")
- (t "ssh")))
+ (if (or (fboundp 'password-read)
+ (fboundp 'auth-source-user-or-password)
+ (fboundp 'auth-source-search)
+ ;; ssh-agent is running.
+ (getenv "SSH_AUTH_SOCK")
+ (getenv "SSH_AGENT_PID")
+ ;; We could reuse the connection.
+ (> (length tramp-ssh-controlmaster-options) 0))
+ "scp"
+ "ssh"))
;; Fallback.
(t "ftp"))
"Default method to use for transferring files.
@@ -381,6 +392,23 @@ Useful for su and sudo methods mostly."
:group 'tramp
:type 'string)
+;;;###tramp-autoload
+(defcustom tramp-default-host-alist nil
+ "Default host to use for specific method/user pairs.
+This is an alist of items (METHOD USER HOST). The first matching item
+specifies the host to use for a file name which does not specify a
+host. METHOD and HOST are regular expressions or nil, which is
+interpreted as a regular expression which always matches. If no entry
+matches, the variable `tramp-default-host' takes effect.
+
+If the file name does not specify the method, lookup is done using the
+empty string for the method name."
+ :group 'tramp
+ :version "24.4"
+ :type '(repeat (list (choice :tag "Method regexp" regexp sexp)
+ (choice :tag " User regexp" regexp sexp)
+ (choice :tag " Host name" string (const nil)))))
+
(defcustom tramp-default-proxies-alist nil
"Route to be followed for specific host/user pairs.
This is an alist of items (HOST USER PROXY). The first matching
@@ -918,7 +946,7 @@ See `tramp-file-name-structure' for more explanations.")
This regexp should match partial Tramp file names only.
Please note that the entry in `file-name-handler-alist' is made when
-this file (tramp.el) is loaded. This means that this variable must be set
+this file \(tramp.el\) is loaded. This means that this variable must be set
before loading tramp.el. Alternatively, `file-name-handler-alist' can be
updated after changing this variable.
@@ -1001,11 +1029,25 @@ this variable to be set as well."
;; for an override of the system default.
(defcustom tramp-process-connection-type t
"Overrides `process-connection-type' for connections from Tramp.
-Tramp binds process-connection-type to the value given here before
+Tramp binds `process-connection-type' to the value given here before
opening a connection to a remote host."
:group 'tramp
:type '(choice (const nil) (const t) (const pty)))
+(defcustom tramp-connection-min-time-diff 5
+ "Defines seconds between two consecutive connection attempts.
+This is necessary as self defense mechanism, in order to avoid
+yo-yo connection attempts when the remote host is unavailable.
+
+A value of 0 or `nil' suppresses this check. This might be
+necessary, when several out-of-order copy operations are
+performed, or when several asynchronous processes will be started
+in a short time frame. In those cases it is recommended to
+let-bind this variable."
+ :group 'tramp
+ :version "24.4"
+ :type '(choice (const nil) integer))
+
(defcustom tramp-completion-reread-directory-timeout 10
"Defines seconds since last remote command before rereading a directory.
A remote directory might have changed its contents. In order to
@@ -1016,7 +1058,7 @@ have been gone since last remote command execution. A value of `t'
would require an immediate reread during filename completion, `nil'
means to use always cached values for the directory contents."
:group 'tramp
- :type '(choice (const nil) integer))
+ :type '(choice (const nil) (const t) integer))
;;; Internal Variables:
@@ -1125,23 +1167,48 @@ If the `tramp-methods' entry does not exist, return nil."
(defun tramp-tramp-file-p (name)
"Return t if NAME is a string with Tramp file name syntax."
(save-match-data
- (and (stringp name) (string-match tramp-file-name-regexp name))))
+ (and (stringp name)
+ (string-match tramp-file-name-regexp name))))
+
+;; Obsoleted with Tramp 2.2.7.
+(defconst tramp-obsolete-methods
+ '("ssh1" "ssh2" "scp1" "scp2" "scpc" "rsyncc" "plink1")
+ "Obsolete methods.")
+
+(defvar tramp-warned-obsolete-methods nil
+ "Which methods the user has been warned to be obsolete.")
(defun tramp-find-method (method user host)
"Return the right method string to use.
This is METHOD, if non-nil. Otherwise, do a lookup in
-`tramp-default-method-alist'."
- (or method
- (let ((choices tramp-default-method-alist)
- lmethod item)
- (while choices
- (setq item (pop choices))
- (when (and (string-match (or (nth 0 item) "") (or host ""))
- (string-match (or (nth 1 item) "") (or user "")))
- (setq lmethod (nth 2 item))
- (setq choices nil)))
- lmethod)
- tramp-default-method))
+`tramp-default-method-alist'. It maps also obsolete methods to
+their replacement."
+ (let ((result
+ (or method
+ (let ((choices tramp-default-method-alist)
+ lmethod item)
+ (while choices
+ (setq item (pop choices))
+ (when (and (string-match (or (nth 0 item) "") (or host ""))
+ (string-match (or (nth 1 item) "") (or user "")))
+ (setq lmethod (nth 2 item))
+ (setq choices nil)))
+ lmethod)
+ tramp-default-method)))
+ ;; This is needed for a transition period only.
+ (when (member result tramp-obsolete-methods)
+ (unless (member result tramp-warned-obsolete-methods)
+ (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? "
+ result (substring result 0 -1)))
+ (tramp-compat-user-error "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))
(defun tramp-find-user (method user host)
"Return the right user string to use.
@@ -1163,6 +1230,15 @@ This is USER, if non-nil. Otherwise, do a lookup in
"Return the right host string to use.
This is HOST, if non-nil. Otherwise, it is `tramp-default-host'."
(or (and (> (length host) 0) host)
+ (let ((choices tramp-default-host-alist)
+ lhost item)
+ (while choices
+ (setq item (pop choices))
+ (when (and (string-match (or (nth 0 item) "") (or method ""))
+ (string-match (or (nth 1 item) "") (or user "")))
+ (setq lhost (nth 2 item))
+ (setq choices nil)))
+ lhost)
tramp-default-host))
(defun tramp-dissect-file-name (name &optional nodefault)
@@ -1173,7 +1249,7 @@ non-nil, the file name parts are not expanded to their default
values."
(save-match-data
(let ((match (string-match (nth 0 tramp-file-name-structure) name)))
- (unless match (error "Not a Tramp file name: %s" name))
+ (unless match (tramp-compat-user-error "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))
@@ -1183,7 +1259,12 @@ values."
(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))))
+ (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)))
(if nodefault
(vector method user host localname hop)
(vector
@@ -1299,7 +1380,7 @@ The outline level is equal to the verbosity of the Tramp message."
(get-buffer-create (tramp-debug-buffer-name vec))
(when (bobp)
(setq buffer-undo-list t)
- ;; So it does not get loaded while outline-regexp is let-bound.
+ ;; So it does not get loaded while `outline-regexp' is let-bound.
(require 'outline)
;; Activate `outline-mode'. This runs `text-mode-hook' and
;; `outline-mode-hook'. We must prevent that local processes
@@ -1350,8 +1431,11 @@ ARGS to actually emit the message (if applicable)."
(concat
"^"
(regexp-opt
- '("tramp-compat-funcall"
+ '("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"
@@ -1426,12 +1510,18 @@ applicable)."
(concat (format "(%d) # " level) fmt-string)
args)))))))
+(defsubst tramp-backtrace (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))))
+
(defsubst tramp-error (vec-or-proc signal fmt-string &rest args)
"Emit an error.
VEC-OR-PROC identifies the connection to use, SIGNAL is the
signal identifier to be raised, remaining args 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
@@ -1457,6 +1547,11 @@ an input event arrives. The other arguments are passed to `tramp-error'."
(or (and (bufferp buffer) buffer)
(and (processp vec-or-proc) (process-buffer vec-or-proc))
(tramp-get-connection-buffer vec-or-proc)))
+ (when (string-equal fmt-string "Process died")
+ (message
+ "%s\n %s"
+ "Tramp failed to connect. If this happens repeatedly, try"
+ "`M-x tramp-cleanup-this-connection'"))
(sit-for 30))))))
(defmacro with-parsed-tramp-file-name (filename var &rest body)
@@ -1622,7 +1717,7 @@ Example:
;; Windows registry.
(and (memq system-type '(cygwin windows-nt))
(zerop
- (tramp-compat-call-process
+ (tramp-call-process
"reg" nil nil nil "query" (nth 1 (car v)))))
;; Configuration file.
(file-exists-p (nth 1 (car v)))))
@@ -1744,19 +1839,22 @@ value of `default-file-modes', without execute permissions."
(logand (default-file-modes) (tramp-compat-octal-to-decimal "0666"))))
(defun tramp-replace-environment-variables (filename)
- "Replace environment variables in FILENAME.
+ "Replace environment variables in FILENAME.
Return the string with the replaced variables."
- (save-match-data
- (let ((idx (string-match "$\\(\\w+\\)" filename)))
- ;; `$' is coded as `$$'.
- (when (and idx
- (or (zerop idx) (not (eq ?$ (aref filename (1- idx)))))
- (getenv (match-string 1 filename)))
- (setq filename
- (replace-match
- (substitute-in-file-name (match-string 0 filename))
- t nil filename)))
- filename)))
+ (or (ignore-errors
+ (tramp-compat-funcall 'substitute-env-vars filename 'only-defined))
+ ;; We need an own implementation.
+ (save-match-data
+ (let ((idx (string-match "$\\(\\w+\\)" filename)))
+ ;; `$' is coded as `$$'.
+ (when (and idx
+ (or (zerop idx) (not (eq ?$ (aref filename (1- idx)))))
+ (getenv (match-string 1 filename)))
+ (setq filename
+ (replace-match
+ (substitute-in-file-name (match-string 0 filename))
+ t nil filename)))
+ filename))))
;; In XEmacs, electricity is implemented via a key map for ?/ and ?~,
;; which calls corresponding functions (see minibuf.el).
@@ -1866,7 +1964,8 @@ ARGS are the arguments OPERATION has been called with."
;; Emacs 22+ only.
'set-file-times
;; Emacs 24+ only.
- 'file-selinux-context 'set-file-selinux-context
+ 'file-acl 'file-selinux-context
+ 'set-file-acl 'set-file-selinux-context
;; XEmacs only.
'abbreviate-file-name 'create-file-buffer
'dired-file-modtime 'dired-make-compressed-filename
@@ -1917,10 +2016,7 @@ ARGS are the arguments OPERATION has been called with."
;; Emacs 23+ only.
'start-file-process
;; XEmacs only.
- 'dired-print-file 'dired-shell-call-process
- ;; nowhere yet.
- 'executable-find 'start-process
- 'call-process 'call-process-region))
+ 'dired-print-file 'dired-shell-call-process))
default-directory)
;; Unknown file primitive.
(t (error "unknown file I/O primitive: %s" operation))))
@@ -1946,6 +2042,15 @@ ARGS are the arguments OPERATION has been called with."
res (cdr elt))))
res))))
+(defvar tramp-debug-on-error nil
+ "Like `debug-on-error' but used Tramp internal.")
+
+(defmacro tramp-condition-case-unless-debug
+ (var bodyform &rest handlers)
+ "Like `condition-case-unless-debug' but `tramp-debug-on-error'."
+ `(let ((debug-on-error tramp-debug-on-error))
+ (tramp-compat-condition-case-unless-debug ,var ,bodyform ,@handlers)))
+
;; Main function.
;;;###autoload
(defun tramp-file-name-handler (operation &rest args)
@@ -1961,7 +2066,7 @@ Falls back to normal file name handler if no Tramp file name handler exists."
(with-parsed-tramp-file-name filename nil
;; Call the backend function.
(if foreign
- (tramp-compat-condition-case-unless-debug err
+ (tramp-condition-case-unless-debug err
(let ((sf (symbol-function foreign))
result)
;; Some packages set the default directory to a
@@ -2014,7 +2119,7 @@ Falls back to normal file name handler if no Tramp file name handler exists."
;; in order to give the user a chance to correct the
;; file name in the minibuffer.
;; In order to get a full backtrace, one could apply
- ;; (setq debug-on-error t debug-on-signal t)
+ ;; (setq tramp-debug-on-error t)
(error
(cond
((and completion (zerop (length localname))
@@ -2664,7 +2769,7 @@ User may be nil."
User is always nil."
(if (memq system-type '(windows-nt))
(with-temp-buffer
- (when (zerop (tramp-compat-call-process
+ (when (zerop (tramp-call-process
"reg" nil t nil "query" registry-or-dirname))
(goto-char (point-min))
(loop while (not (eobp)) collect
@@ -2741,6 +2846,11 @@ User is always nil."
(if (or dir-p (file-directory-p dir)) dir (file-name-directory dir)) nil
(tramp-flush-directory-property v localname)))
+(defun tramp-handle-file-accessible-directory-p (filename)
+ "Like `file-accessible-directory-p' for Tramp files."
+ (and (file-directory-p filename)
+ (file-executable-p filename)))
+
(defun tramp-handle-file-exists-p (filename)
"Like `file-exists-p' for Tramp files."
(not (null (file-attributes filename))))
@@ -2964,13 +3074,15 @@ User is always nil."
(setq tramp-temp-buffer-file-name local-copy))
;; We must ensure that `file-coding-system-alist'
- ;; matches `local-copy'.
+ ;; 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 nil nil nil replace)))))
+ local-copy visit nil nil replace)))))
;; Save exit.
(progn
@@ -3065,7 +3177,7 @@ User is always nil."
(when p
(if (yes-or-no-p "A command is running. Kill it? ")
(ignore-errors (kill-process p))
- (error "Shell command in progress")))
+ (tramp-compat-user-error "Shell command in progress")))
(if current-buffer-p
(progn
@@ -3547,6 +3659,107 @@ would yield `t'. On the other hand, the following check results in nil:
(t (error "Tenth char `%c' must be one of `xtT-'"
other-execute-or-sticky)))))))
+(defconst tramp-file-mode-type-map
+ '((0 . "-") ; Normal file (SVID-v2 and XPG2)
+ (1 . "p") ; fifo
+ (2 . "c") ; character device
+ (3 . "m") ; multiplexed character device (v7)
+ (4 . "d") ; directory
+ (5 . "?") ; Named special file (XENIX)
+ (6 . "b") ; block device
+ (7 . "?") ; multiplexed block device (v7)
+ (8 . "-") ; regular file
+ (9 . "n") ; network special file (HP-UX)
+ (10 . "l") ; symlink
+ (11 . "?") ; ACL shadow inode (Solaris, not userspace)
+ (12 . "s") ; socket
+ (13 . "D") ; door special (Solaris)
+ (14 . "w")) ; whiteout (BSD)
+ "A list of file types returned from the `stat' system call.
+This is used to map a mode number to a permission string.")
+
+;;;###tramp-autoload
+(defun tramp-file-mode-from-int (mode)
+ "Turn an integer representing a file mode into an ls(1)-like string."
+ (let ((type (cdr
+ (assoc (logand (lsh mode -12) 15) tramp-file-mode-type-map)))
+ (user (logand (lsh mode -6) 7))
+ (group (logand (lsh mode -3) 7))
+ (other (logand (lsh mode -0) 7))
+ (suid (> (logand (lsh mode -9) 4) 0))
+ (sgid (> (logand (lsh mode -9) 2) 0))
+ (sticky (> (logand (lsh mode -9) 1) 0)))
+ (setq user (tramp-file-mode-permissions user suid "s"))
+ (setq group (tramp-file-mode-permissions group sgid "s"))
+ (setq other (tramp-file-mode-permissions other sticky "t"))
+ (concat type user group other)))
+
+(defun tramp-file-mode-permissions (perm suid suid-text)
+ "Convert a permission bitset into a string.
+This is used internally by `tramp-file-mode-from-int'."
+ (let ((r (> (logand perm 4) 0))
+ (w (> (logand perm 2) 0))
+ (x (> (logand perm 1) 0)))
+ (concat (or (and r "r") "-")
+ (or (and w "w") "-")
+ (or (and suid x suid-text) ; suid, execute
+ (and suid (upcase suid-text)) ; suid, !execute
+ (and x "x") "-")))) ; !suid
+
+;;;###tramp-autoload
+(defun tramp-get-local-uid (id-format)
+ (if (equal id-format 'integer) (user-uid) (user-login-name)))
+
+;;;###tramp-autoload
+(defun tramp-get-local-gid (id-format)
+ (if (and (fboundp 'group-gid) (equal id-format 'integer))
+ (tramp-compat-funcall 'group-gid)
+ (nth 3 (tramp-compat-file-attributes "~/" id-format))))
+
+;;;###tramp-autoload
+(defun tramp-check-cached-permissions (vec access)
+ "Check `file-attributes' caches for VEC.
+Return t if according to the cache access type ACCESS is known to
+be granted."
+ (let ((result nil)
+ (offset (cond
+ ((eq ?r access) 1)
+ ((eq ?w access) 2)
+ ((eq ?x access) 3))))
+ (dolist (suffix '("string" "integer") result)
+ (setq
+ result
+ (or
+ result
+ (let ((file-attr
+ (tramp-get-file-property
+ vec (tramp-file-name-localname vec)
+ (concat "file-attributes-" suffix) nil))
+ (remote-uid
+ (tramp-get-connection-property
+ vec (concat "uid-" suffix) nil))
+ (remote-gid
+ (tramp-get-connection-property
+ vec (concat "gid-" suffix) nil)))
+ (and
+ file-attr
+ (or
+ ;; Not a symlink
+ (eq t (car file-attr))
+ (null (car file-attr)))
+ (or
+ ;; World accessible.
+ (eq access (aref (nth 8 file-attr) (+ offset 6)))
+ ;; User accessible and owned by user.
+ (and
+ (eq access (aref (nth 8 file-attr) offset))
+ (equal remote-uid (nth 2 file-attr)))
+ ;; Group accessible and owned by user's
+ ;; principal group.
+ (and
+ (eq access (aref (nth 8 file-attr) (+ offset 3)))
+ (equal remote-gid (nth 3 file-attr)))))))))))
+
;;;###tramp-autoload
(defun tramp-local-host-p (vec)
"Return t if this points to the local host, nil otherwise."
@@ -3684,6 +3897,24 @@ ALIST is of the form ((FROM . TO) ...)."
;;; Compatibility functions section:
+(defun tramp-call-process
+ (program &optional infile destination display &rest args)
+ "Calls `call-process' on the local host.
+This is needed because for some Emacs flavors Tramp has
+defadvised `call-process' to behave like `process-file'. The
+Lisp error raised when PROGRAM is nil is trapped also, returning 1.
+Furthermore, traces are written with verbosity of 6."
+ (let ((default-directory
+ (if (file-remote-p default-directory)
+ (tramp-compat-temporary-file-directory)
+ default-directory)))
+ (tramp-message
+ (vector tramp-current-method tramp-current-user tramp-current-host nil nil)
+ 6 "%s %s %s" program infile args)
+ (if (executable-find program)
+ (apply 'call-process program infile destination display args)
+ 1)))
+
;;;###tramp-autoload
(defun tramp-read-passwd (proc &optional prompt)
"Read a password from user (compat function).
@@ -3842,6 +4073,39 @@ Only works for Bourne-like shells."
t t result)))
result))))
+;;; 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)
+ (with-parsed-tramp-file-name default-directory nil
+ (mapconcat
+ 'identity
+ (or
+ ;; When `tramp-own-remote-path' is in `tramp-remote-path',
+ ;; the remote path is only set in the session cache.
+ (tramp-get-connection-property
+ (tramp-get-connection-process v) "remote-path" nil)
+ (tramp-get-connection-property v "remote-path" nil))
+ ":"))
+ (getenv "PATH"))))
+
+(eval-after-load "esh-util"
+ '(progn
+ (tramp-eshell-directory-change)
+ (add-hook 'eshell-directory-change-hook
+ 'tramp-eshell-directory-change)
+ (add-hook 'tramp-unload-hook
+ (lambda ()
+ (remove-hook 'eshell-directory-change-hook
+ 'tramp-eshell-directory-change)))))
+
;; Checklist for `tramp-unload-hook'
;; - Unload all `tramp-*' packages
;; - Reset `file-name-handler-alist'
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index 993fbda6dd7..0e54cd60d98 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -31,7 +31,7 @@
;; should be changed only there.
;;;###tramp-autoload
-(defconst tramp-version "2.2.6-24.3"
+(defconst tramp-version "2.2.8-pre"
"This version of Tramp.")
;;;###tramp-autoload
@@ -44,7 +44,7 @@
(= emacs-major-version 21)
(>= emacs-minor-version 4)))
"ok"
- (format "Tramp 2.2.6-24.3 is not fit for %s"
+ (format "Tramp 2.2.8-pre is not fit for %s"
(when (string-match "^.*$" (emacs-version))
(match-string 0 (emacs-version)))))))
(unless (string-match "\\`ok\\'" x) (error "%s" x)))
generated by cgit v1.2.3 (git 2.39.1) at 2025-05-30 23:51:09 +0000