summaryrefslogtreecommitdiff
path: root/lisp/net
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/net')
-rw-r--r--lisp/net/ange-ftp.el9
-rw-r--r--lisp/net/newst-plainview.el3
-rw-r--r--lisp/net/quickurl.el3
-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.el1151
-rw-r--r--lisp/net/tramp-cache.el37
-rw-r--r--lisp/net/tramp-cmds.el8
-rw-r--r--lisp/net/tramp-compat.el33
-rw-r--r--lisp/net/tramp-ftp.el2
-rw-r--r--lisp/net/tramp-gvfs.el27
-rw-r--r--lisp/net/tramp-sh.el350
-rw-r--r--lisp/net/tramp-smb.el27
-rw-r--r--lisp/net/tramp.el206
-rw-r--r--lisp/net/trampver.el4
17 files changed, 1639 insertions, 283 deletions
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index 1d910386403..2b8c7ae145b 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:"
@@ -5137,7 +5134,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/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..1de9feb1341 100644
--- a/lisp/net/quickurl.el
+++ b/lisp/net/quickurl.el
@@ -272,7 +272,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..0974c62c56e
--- /dev/null
+++ b/lisp/net/tramp-adb.el
@@ -0,0 +1,1151 @@
+;;; 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 must be installed on your local machine.
+;; Add the following form into your .emacs:
+;;
+;; (setq tramp-adb-sdk-dir "/path/to/android/sdk")
+;;
+;; 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-sdk-dir "~/Android/sdk"
+ "Set to the directory containing the Android SDK."
+ :type 'string
+ :version "24.4"
+ :group 'tramp)
+
+;;;###tramp-autoload
+(defconst tramp-adb-method "adb"
+ "*When this method name is used, forward all calls to Android Debug Bridge.")
+
+(defcustom tramp-adb-prompt
+ "^\\(?:[[: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))))
+
+;; This cannot be a constant, because `tramp-adb-sdk-dir' is customizable.
+(defun tramp-adb-program ()
+ "The Android Debug Bridge."
+ (expand-file-name "platform-tools/adb" tramp-adb-sdk-dir))
+
+;;;###tramp-autoload
+(defun tramp-adb-parse-device-names (ignore)
+ "Return a list of (nil host) tuples allowed to access."
+ (with-temp-buffer
+ (when (zerop (call-process (tramp-adb-program) nil t nil "devices"))
+ (let (result)
+ (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
+ ret
+ (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))
+ (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 'call-process (tramp-adb-program) nil t nil args))
+ (buffer-string))
+ (tramp-message
+ vec 6 "%s %s\n%s"
+ (tramp-adb-program) (mapconcat 'identity args " ") (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-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'."
+ (tramp-adb-send-command vec (format "%s; echo tramp_exit_status $?" command))
+ (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 "^ ")
+ (unless (zerop (read (current-buffer)))
+ (apply 'tramp-error vec 'file-error fmt args))
+ (let (buffer-read-only)
+ (delete-region (match-beginning 0) (point-max)))))
+
+(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 (format "%s; echo tramp_exit_status $?" command))
+ (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 "^ ")
+ (read (current-buffer))))
+
+(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))
+ (devices (mapcar 'cadr (tramp-adb-parse-device-names nil))))
+ (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)
+ (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)))
+
+ ;; 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..dc45a57b7c6 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.
@@ -204,9 +217,27 @@ If the value is not set for the connection, returns DEFAULT."
(setq key (copy-sequence key))
(aset key 3 nil))
(let* ((hash (gethash key tramp-cache-data))
- (value (if (hash-table-p hash)
- (gethash property hash default)
- default)))
+ (value
+ (catch 'result
+ (or
+ ;; Check for dynamic properties.
+ (and
+ (hash-table-p hash)
+ (maphash
+ (lambda (x y) (when (equal x property) (throw 'result y)))
+ hash))
+ ;; Check for static properties.
+ (and
+ (vectorp key)
+ (dolist (elt tramp-connection-properties)
+ (when (and (string-match
+ (or (nth 0 elt) "")
+ (tramp-make-tramp-file-name
+ (aref key 0) (aref key 1) (aref key 2) nil))
+ (string-equal (or (nth 1 elt) "") (or property "")))
+ (throw 'result (nth 2 elt)))))
+ ;; The default value.
+ default))))
(tramp-message key 7 "%s %s" property value)
value))
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..81c4d5ccced 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
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..7473871e564 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -384,7 +384,8 @@ Every entry is a list (NAME ADDRESS).")
(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 . tramp-gvfs-handle-file-acl)
(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)
@@ -417,6 +418,7 @@ Every entry is a list (NAME ADDRESS).")
(make-symbolic-link . ignore)
(process-file . tramp-gvfs-handle-process-file)
(rename-file . tramp-gvfs-handle-rename-file)
+ (set-file-acl . tramp-gvfs-handle-set-file-acl)
(set-file-modes . tramp-gvfs-handle-set-file-modes)
(set-file-selinux-context . tramp-gvfs-handle-set-file-selinux-context)
(set-visited-file-modtime . tramp-gvfs-handle-set-visited-file-modtime)
@@ -432,6 +434,8 @@ Every entry is a list (NAME ADDRESS).")
"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."
@@ -526,14 +530,18 @@ 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
@@ -549,8 +557,8 @@ is no information where to trace the message.")
(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))))
+ (when preserve-extended-attributes
+ (setq args (append args (list preserve-extended-attributes))))
(apply 'copy-file args))
;; Error case. Let's try it with the GVFS utilities.
@@ -649,6 +657,10 @@ is no information where to trace the message.")
(tramp-run-real-handler
'expand-file-name (list localname))))))
+(defun tramp-gvfs-handle-file-acl (filename)
+ "Like `file-acl' for Tramp files."
+ (tramp-compat-funcall 'file-acl (tramp-gvfs-fuse-file-name filename)))
+
(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))
@@ -775,6 +787,11 @@ is no information where to trace the message.")
(tramp-flush-file-property v (file-name-directory localname))
(tramp-flush-file-property v localname))))
+(defun tramp-gvfs-handle-set-file-acl (filename acl-string)
+ "Like `set-file-acl' for Tramp files."
+ (with-tramp-gvfs-error-message filename 'set-file-acl
+ (tramp-gvfs-fuse-file-name filename) acl-string))
+
(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
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 29a6344734f..7388c570874 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -109,31 +109,17 @@ 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"
+ `("scp"
(tramp-login-program "ssh")
(tramp-login-args (("-l" "%u") ("-p" "%p")
- ("-1") ("-e" "none") ("%h")))
+ ,tramp-ssh-controlmaster-template
+ ("-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-args (("-P" "%p") ("-p" "%k") ("-q") ("-r")
+ ,tramp-ssh-controlmaster-template))
(tramp-copy-keep-date t)
(tramp-copy-recursive t)
(tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null")
@@ -142,15 +128,17 @@ detected as prompt when being sent on echoing hosts, therefore.")
(tramp-default-port 22)))
;;;###tramp-autoload
(add-to-list 'tramp-methods
- '("scp2"
+ `("scp1"
(tramp-login-program "ssh")
(tramp-login-args (("-l" "%u") ("-p" "%p")
- ("-2") ("-e" "none") ("%h")))
+ ,tramp-ssh-controlmaster-template
+ ("-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 (("-2") ("-P" "%p") ("-p" "%k") ("-q") ("-r")))
+ (tramp-copy-args (("-1") ("-P" "%p") ("-p" "%k") ("-q") ("-r")
+ ,tramp-ssh-controlmaster-template))
(tramp-copy-keep-date t)
(tramp-copy-recursive t)
(tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null")
@@ -159,19 +147,17 @@ detected as prompt when being sent on echoing hosts, therefore.")
(tramp-default-port 22)))
;;;###tramp-autoload
(add-to-list 'tramp-methods
- '("scpc"
+ `("scp2"
(tramp-login-program "ssh")
(tramp-login-args (("-l" "%u") ("-p" "%p")
- ("-o" "ControlPath=%t.%%r@%%h:%%p")
- ("-o" "ControlMaster=yes")
- ("-e" "none") ("%h")))
+ ,tramp-ssh-controlmaster-template
+ ("-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 (("-P" "%p") ("-p" "%k") ("-q") ("-r")
- ("-o" "ControlPath=%t.%%r@%%h:%%p")
- ("-o" "ControlMaster=auto")))
+ (tramp-copy-args (("-2") ("-P" "%p") ("-p" "%k") ("-q") ("-r")
+ ,tramp-ssh-controlmaster-template))
(tramp-copy-keep-date t)
(tramp-copy-recursive t)
(tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null")
@@ -180,16 +166,17 @@ detected as prompt when being sent on echoing hosts, therefore.")
(tramp-default-port 22)))
;;;###tramp-autoload
(add-to-list 'tramp-methods
- '("scpx"
+ `("scpx"
(tramp-login-program "ssh")
(tramp-login-args (("-l" "%u") ("-p" "%p")
- ("-e" "none") ("-t" "-t")
- ("%h") ("/bin/sh")))
+ ,tramp-ssh-controlmaster-template
+ ("-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")
+ ,tramp-ssh-controlmaster-template))
(tramp-copy-keep-date t)
(tramp-copy-recursive t)
(tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null")
@@ -198,33 +185,22 @@ detected as prompt when being sent on echoing hosts, therefore.")
(tramp-default-port 22)))
;;;###tramp-autoload
(add-to-list 'tramp-methods
- '("sftp"
- (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 "sftp")))
-;;;###tramp-autoload
-(add-to-list 'tramp-methods
- '("rsync"
+ `("sftp"
(tramp-login-program "ssh")
- (tramp-login-args (("-l" "%u") ("-p" "%p") ("-e" "none") ("%h")))
+ (tramp-login-args (("-l" "%u") ("-p" "%p")
+ ,tramp-ssh-controlmaster-template
+ ("-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
+ (tramp-copy-program "sftp")
+ (tramp-copy-args ,tramp-ssh-controlmaster-template)))
+ ;;;###tramp-autoload
(add-to-list 'tramp-methods
- `("rsyncc"
+ `("rsync"
(tramp-login-program "ssh")
(tramp-login-args (("-l" "%u") ("-p" "%p")
- ("-o" "ControlPath=%t.%%r@%%h:%%p")
- ("-o" "ControlMaster=yes")
+ ,tramp-ssh-controlmaster-template
("-e" "none") ("%h")))
(tramp-async-args (("-q")))
(tramp-remote-shell "/bin/sh")
@@ -232,10 +208,11 @@ detected as prompt when being sent on echoing hosts, therefore.")
(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"))))
+ (,(mapconcat
+ 'identity
+ (append
+ '("ssh") tramp-ssh-controlmaster-template)
+ " "))))
(tramp-copy-keep-date t)
(tramp-copy-keep-tmpfile t)
(tramp-copy-recursive t)))
@@ -255,9 +232,11 @@ detected as prompt when being sent on echoing hosts, therefore.")
(tramp-remote-shell-args ("-c"))))
;;;###tramp-autoload
(add-to-list 'tramp-methods
- '("ssh"
+ `("ssh"
(tramp-login-program "ssh")
- (tramp-login-args (("-l" "%u") ("-p" "%p") ("-e" "none") ("%h")))
+ (tramp-login-args (("-l" "%u") ("-p" "%p")
+ ,tramp-ssh-controlmaster-template
+ ("-e" "none") ("%h")))
(tramp-async-args (("-q")))
(tramp-remote-shell "/bin/sh")
(tramp-remote-shell-args ("-c"))
@@ -267,9 +246,10 @@ detected as prompt when being sent on echoing hosts, therefore.")
(tramp-default-port 22)))
;;;###tramp-autoload
(add-to-list 'tramp-methods
- '("ssh1"
+ `("ssh1"
(tramp-login-program "ssh")
(tramp-login-args (("-l" "%u") ("-p" "%p")
+ ,tramp-ssh-controlmaster-template
("-1") ("-e" "none") ("%h")))
(tramp-async-args (("-q")))
(tramp-remote-shell "/bin/sh")
@@ -280,9 +260,10 @@ detected as prompt when being sent on echoing hosts, therefore.")
(tramp-default-port 22)))
;;;###tramp-autoload
(add-to-list 'tramp-methods
- '("ssh2"
+ `("ssh2"
(tramp-login-program "ssh")
(tramp-login-args (("-l" "%u") ("-p" "%p")
+ ,tramp-ssh-controlmaster-template
("-2") ("-e" "none") ("%h")))
(tramp-async-args (("-q")))
(tramp-remote-shell "/bin/sh")
@@ -293,11 +274,11 @@ detected as prompt when being sent on echoing hosts, therefore.")
(tramp-default-port 22)))
;;;###tramp-autoload
(add-to-list 'tramp-methods
- '("sshx"
+ `("sshx"
(tramp-login-program "ssh")
(tramp-login-args (("-l" "%u") ("-p" "%p")
- ("-e" "none") ("-t" "-t")
- ("%h") ("/bin/sh")))
+ ,tramp-ssh-controlmaster-template
+ ("-e" "none") ("-t" "-t") ("%h") ("/bin/sh")))
(tramp-async-args (("-q")))
(tramp-remote-shell "/bin/sh")
(tramp-remote-shell-args ("-c"))
@@ -473,21 +454,14 @@ detected as prompt when being sent on echoing hosts, therefore.")
(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)
@@ -538,6 +512,7 @@ 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"
,(format "TERM=%s" tramp-terminal-type)
@@ -935,6 +910,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 +961,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 +1305,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)
@@ -1528,10 +1507,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 +1635,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 +1643,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 +1902,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 +1912,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 +1981,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 +1990,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 +2001,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 +2072,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))
@@ -2370,7 +2394,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 +2404,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))
@@ -2759,6 +2804,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 +2819,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 +2966,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
@@ -4151,6 +4191,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 +4254,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 +4339,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
@@ -4413,14 +4457,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.
@@ -5026,7 +5072,9 @@ This is used internally by `tramp-file-mode-from-int'."
(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)))
+ (if (and (fboundp 'group-gid) (equal id-format 'integer))
+ (tramp-compat-funcall 'group-gid)
+ (nth 3 (tramp-compat-file-attributes "~/" id-format))))
;; Some predefined connection properties.
(defun tramp-get-inline-compress (vec prop size)
@@ -5124,34 +5172,6 @@ function cell is returned to be applied on a buffer."
(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 6710c8a5211..89648b0e9a9 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -280,15 +280,18 @@ 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
+(defvar tramp-ssh-controlmaster-template
+ (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)
+ '("-o" "ControlPath=%t.%%r@%%h:%%p"
+ "-o" "ControlMaster=auto"
+ "-o" "ControlPersist=no"))))
+ "Call ssh to detect whether it supports the ControlMaster argument.
+Return a template to be used in `tramp-methods'.")
(defcustom tramp-default-method
;; An external copy method seems to be preferred, because it performs
@@ -297,8 +300,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 +318,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.
+ tramp-ssh-controlmaster-template)
+ "scp"
+ "ssh"))
;; Fallback.
(t "ftp"))
"Default method to use for transferring files.
@@ -381,6 +385,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 +939,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 +1022,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 +1051,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:
@@ -1123,9 +1158,12 @@ If the `tramp-methods' entry does not exist, return nil."
;;;###tramp-autoload
(defun tramp-tramp-file-p (name)
- "Return t if NAME is a string with Tramp file name syntax."
+ "Return t if NAME is a string with Tramp file name syntax.
+It checks also, whether NAME is unibyte encoded."
(save-match-data
- (and (stringp name) (string-match tramp-file-name-regexp name))))
+ (and (stringp name)
+; (string-equal name (string-as-unibyte name))
+ (string-match tramp-file-name-regexp name))))
(defun tramp-find-method (method user host)
"Return the right method string to use.
@@ -1163,6 +1201,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)
@@ -1348,8 +1395,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"
@@ -1455,8 +1505,18 @@ 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))))))
+(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))))
+
(defmacro with-parsed-tramp-file-name (filename var &rest body)
"Parse a Tramp filename and make components available in the body.
@@ -1749,19 +1809,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).
@@ -1871,7 +1934,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
@@ -1922,10 +1986,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))))
@@ -1951,6 +2012,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)
@@ -1966,7 +2036,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
@@ -2019,7 +2089,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))
@@ -2746,6 +2816,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))))
@@ -2969,13 +3044,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
@@ -3847,6 +3924,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..b346d085307 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.7-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.7-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-04-23 13:31:09 +0000