procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Sync with Tramp repository.

Browse source 
* lisp/net/tramp-adb.el (tramp-adb-handle-start-file-process):
* lisp/net/tramp-sh.el (tramp-sh-handle-start-file-process)
* lisp/net/tramp-smb.el (tramp-smb-handle-start-file-process):
Create BUFFER if it doesn't exist.  Reported by Nikolay
Kudryavtsev <nikolay.kudryavtsev@gmail.com>.

* lisp/net/tramp-gvfs.el (tramp-gvfs-file-attributes)
(tramp-gvfs-file-attributes-with-gvfs-ls-regexp)
(tramp-gvfs-file-attributes-with-gvfs-info-regexp): New defconst.
(tramp-gvfs-get-directory-attributes)
(tramp-gvfs-get-root-attributes)
(tramp-gvfs-get-file-attributes): New defun.
(tramp-gvfs-handle-file-attributes)
(tramp-gvfs-handle-file-name-all-completions): Use them.
(tramp-gvfs-handle-file-directory-p): Use `file-truename'.
(tramp-gvfs-maybe-open-connection): Set :noquery flag for process.
(tramp-gvfs-send-command): Add locale settings to `process-environment'.
(top): Suppress D-Bus error messages during zeroconf initialization.

* lisp/net/tramp.el (tramp-unknown-id-string)
(tramp-unknown-id-integer): New defconst.
(tramp-check-cached-permissions)
* lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-attributes)
* lisp/net/tramp-sh.el (tramp-do-file-attributes-with-ls)
(tramp-convert-file-attributes, tramp-get-remote-uid)
(tramp-get-remote-gid): Use them.

* lisp/net/tramp-sh.el (tramp-display-escape-sequence-regexp):
Rename from `tramp-color-escape-sequence-regexp'.
(tramp-sh-handle-insert-directory)
(tramp-convert-file-attributes): Adapt callees.
(tramp-device-escape-sequence-regexp): New defconst.
(tramp-wait-for-output): Use it.  Reported by Matthías Páll
Gissurarson <icetritlo@gmail.com>.

* lisp/net/tramp-smb.el (tramp-smb-handle-file-name-all-completions):
Simplify.

* test/lisp/net/tramp-tests.el (tramp-test26-process-file)
(tramp-test28-shell-command):
Use `tramp-display-escape-sequence-regexp'.
This commit is contained in:
Michael Albinus 2016-05-28 12:14:58 +02:00
parent 66cd9187e3
commit 062757dca0
6 changed files with 339 additions and 205 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

28
lisp/net/tramp-adb.el
View file

@ -934,20 +934,22 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(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))
(let* ((buffer
(if buffer
(get-buffer-create buffer)
;; BUFFER can be nil. We use a temporary buffer.
(generate-new-buffer tramp-temp-buffer-name)))
(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)

399
lisp/net/tramp-gvfs.el
View file

@ -407,6 +407,42 @@ Every entry is a list (NAME ADDRESS).")
(defconst tramp-hal-interface-device "org.freedesktop.Hal.Device"
"The device interface of the HAL daemon.")
(defconst tramp-gvfs-file-attributes
'("type"
"standard::display-name"
;; We don't need this one. It is used as delimeter in case the
;; display name contains spaces, which is hard to parse.
"standard::icon"
"standard::symlink-target"
"unix::nlink"
"unix::uid"
"owner::user"
"unix::gid"
"owner::group"
"time::access"
"time::modified"
"time::changed"
"standard::size"
"unix::mode"
"access::can-read"
"access::can-write"
"access::can-execute"
"unix::inode"
"unix::device")
"GVFS file attributes.")
(defconst tramp-gvfs-file-attributes-with-gvfs-ls-regexp
(concat "[[:blank:]]"
(regexp-opt tramp-gvfs-file-attributes t)
"=\\([^[:blank:]]+\\)")
"Regexp to parse GVFS file attributes with `gvfs-ls'.")
(defconst tramp-gvfs-file-attributes-with-gvfs-info-regexp
(concat "^[[:blank:]]*"
(regexp-opt tramp-gvfs-file-attributes t)
":[[:blank:]]+\\(.*\\)$")
"Regexp to parse GVFS file attributes with `gvfs-info'.")
;; New handlers should be added here.
(defconst tramp-gvfs-file-name-handler-alist
@ -784,127 +820,185 @@ file names."
(tramp-run-real-handler
'expand-file-name (list localname))))))
(defun tramp-gvfs-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
(unless id-format (setq id-format 'integer))
(defun tramp-gvfs-get-directory-attributes (directory)
"Return GVFS attributes association list of all files in DIRECTORY."
(ignore-errors
;; Don't modify `last-coding-system-used' by accident.
(let ((last-coding-system-used last-coding-system-used)
(process-environment (cons "LC_MESSAGES=C" process-environment))
dirp res-symlink-target res-numlinks res-uid res-gid res-access
res-mod res-change res-size res-filemodes res-inode res-device)
result)
(with-parsed-tramp-file-name directory nil
(with-tramp-file-property v localname "directory-gvfs-attributes"
(tramp-message v 5 "directory gvfs attributes: %s" localname)
;; Send command.
(tramp-gvfs-send-command
v "gvfs-ls" "-h" "-n" "-a"
(mapconcat 'identity tramp-gvfs-file-attributes ",")
(tramp-gvfs-url-file-name directory))
;; Parse output ...
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
(while (re-search-forward
(concat "^\\(.+\\)[[:blank:]]"
"\\([[:digit:]]+\\)[[:blank:]]"
"(\\(.+\\))[[:blank:]]"
"standard::display-name=\\(.+\\)[[:blank:]]"
"standard::icon=")
(point-at-eol) t)
(let ((item (list (cons "standard::display-name" (match-string 4))
(cons "type" (match-string 3))
(cons "standard::size" (match-string 2))
(match-string 1))))
(while (re-search-forward
tramp-gvfs-file-attributes-with-gvfs-ls-regexp
(point-at-eol) t)
(push (cons (match-string 1) (match-string 2)) item))
(push (nreverse item) result))
(forward-line)))
result)))))
(defun tramp-gvfs-get-root-attributes (filename)
"Return GVFS attributes association list of FILENAME."
(ignore-errors
;; Don't modify `last-coding-system-used' by accident.
(let ((last-coding-system-used last-coding-system-used)
result)
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property
v localname (format "file-attributes-%s" id-format)
(tramp-message v 5 "file attributes: %s" localname)
(with-tramp-file-property v localname "file-gvfs-attributes"
(tramp-message v 5 "file gvfs attributes: %s" localname)
;; Send command.
(tramp-gvfs-send-command
v "gvfs-info" (tramp-gvfs-url-file-name filename))
;; Parse output ...
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
(when (re-search-forward "attributes:" nil t)
;; ... directory or symlink
(goto-char (point-min))
(setq dirp (if (re-search-forward "type: directory" nil t) t))
(goto-char (point-min))
(setq res-symlink-target
(if (re-search-forward
"standard::symlink-target: \\(.+\\)$" nil t)
(match-string 1)))
;; ... number links
(goto-char (point-min))
(setq res-numlinks
(if (re-search-forward "unix::nlink: \\([0-9]+\\)" nil t)
(string-to-number (match-string 1)) 0))
;; ... uid and gid
(goto-char (point-min))
(setq res-uid
(if (eq id-format 'integer)
(if (re-search-forward "unix::uid: \\([0-9]+\\)" nil t)
(string-to-number (match-string 1))
-1)
(if (re-search-forward "owner::user: \\(.+\\)$" nil t)
(match-string 1)
"UNKNOWN")))
(setq res-gid
(if (eq id-format 'integer)
(if (re-search-forward "unix::gid: \\([0-9]+\\)" nil t)
(string-to-number (match-string 1))
-1)
(if (re-search-forward "owner::group: \\(.+\\)$" nil t)
(match-string 1)
"UNKNOWN")))
;; ... last access, modification and change time
(goto-char (point-min))
(setq res-access
(if (re-search-forward "time::access: \\([0-9]+\\)" nil t)
(seconds-to-time (string-to-number (match-string 1)))
'(0 0)))
(goto-char (point-min))
(setq res-mod
(if (re-search-forward "time::modified: \\([0-9]+\\)" nil t)
(seconds-to-time (string-to-number (match-string 1)))
'(0 0)))
(goto-char (point-min))
(setq res-change
(if (re-search-forward "time::changed: \\([0-9]+\\)" nil t)
(seconds-to-time (string-to-number (match-string 1)))
'(0 0)))
;; ... size
(goto-char (point-min))
(setq res-size
(if (re-search-forward "standard::size: \\([0-9]+\\)" nil t)
(string-to-number (match-string 1)) 0))
;; ... file mode flags
(goto-char (point-min))
(setq res-filemodes
(if (re-search-forward "unix::mode: \\([0-9]+\\)" nil t)
(tramp-file-mode-from-int
(string-to-number (match-string 1)))
(if dirp "drwx------" "-rwx------")))
;; ... inode and device
(goto-char (point-min))
(setq res-inode
(if (re-search-forward "unix::inode: \\([0-9]+\\)" nil t)
(string-to-number (match-string 1))
(tramp-get-inode v)))
(goto-char (point-min))
(setq res-device
(if (re-search-forward "unix::device: \\([0-9]+\\)" nil t)
(string-to-number (match-string 1))
(tramp-get-device v)))
(while (re-search-forward
tramp-gvfs-file-attributes-with-gvfs-info-regexp nil t)
(push (cons (match-string 1) (match-string 2)) result))
result))))))
;; Return data gathered.
(list
;; 0. t for directory, string (name linked to) for
;; symbolic link, or nil.
(or dirp res-symlink-target)
;; 1. Number of links to file.
res-numlinks
;; 2. File uid.
res-uid
;; 3. File gid.
res-gid
;; 4. Last access time, as a list of integers.
;; 5. Last modification time, likewise.
;; 6. Last status change time, likewise.
res-access res-mod res-change
;; 7. Size in bytes (-1, if number is out of range).
res-size
;; 8. File modes.
res-filemodes
;; 9. t if file's gid would change if file were deleted
;; and recreated.
nil
;; 10. Inode number.
res-inode
;; 11. Device number.
res-device
))))))))
(defun tramp-gvfs-get-file-attributes (filename)
"Return GVFS attributes association list of FILENAME."
(setq filename (directory-file-name (expand-file-name filename)))
(with-parsed-tramp-file-name filename nil
(if (or
(and (string-match "^\\(afp\\|smb\\)$" method)
(string-match "^/?\\([^/]+\\)$" localname))
(string-equal localname "/"))
(tramp-gvfs-get-root-attributes filename)
(assoc
(file-name-nondirectory filename)
(tramp-gvfs-get-directory-attributes (file-name-directory filename))))))
(defun tramp-gvfs-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
(unless id-format (setq id-format 'integer))
(ignore-errors
(let ((attributes (tramp-gvfs-get-file-attributes filename))
dirp res-symlink-target res-numlinks res-uid res-gid res-access
res-mod res-change res-size res-filemodes res-inode res-device)
(when attributes
;; ... directory or symlink
(setq dirp (if (equal "directory" (cdr (assoc "type" attributes))) t))
(setq res-symlink-target
(cdr (assoc "standard::symlink-target" attributes)))
;; ... number links
(setq res-numlinks
(string-to-number
(or (cdr (assoc "unix::nlink" attributes)) "0")))
;; ... uid and gid
(setq res-uid
(if (eq id-format 'integer)
(string-to-number
(or (cdr (assoc "unix::uid" attributes))
(format "%s" tramp-unknown-id-integer)))
(or (cdr (assoc "owner::user" attributes))
(cdr (assoc "unix::uid" attributes))
tramp-unknown-id-string)))
(setq res-gid
(if (eq id-format 'integer)
(string-to-number
(or (cdr (assoc "unix::gid" attributes))
(format "%s" tramp-unknown-id-integer)))
(or (cdr (assoc "owner::group" attributes))
(cdr (assoc "unix::gid" attributes))
tramp-unknown-id-string)))
;; ... last access, modification and change time
(setq res-access
(seconds-to-time
(string-to-number
(or (cdr (assoc "time::access" attributes)) "0"))))
(setq res-mod
(seconds-to-time
(string-to-number
(or (cdr (assoc "time::modified" attributes)) "0"))))
(setq res-change
(seconds-to-time
(string-to-number
(or (cdr (assoc "time::changed" attributes)) "0"))))
;; ... size
(setq res-size
(string-to-number
(or (cdr (assoc "standard::size" attributes)) "0")))
;; ... file mode flags
(setq res-filemodes
(let ((n (cdr (assoc "unix::mode" attributes))))
(if n
(tramp-file-mode-from-int (string-to-number n))
(format
"%s%s%s%s------"
(if dirp "d" "-")
(if (equal (cdr (assoc "access::can-read" attributes))
"FALSE")
"-" "r")
(if (equal (cdr (assoc "access::can-write" attributes))
"FALSE")
"-" "w")
(if (equal (cdr (assoc "access::can-execute" attributes))
"FALSE")
"-" "x")))))
;; ... inode and device
(setq res-inode
(let ((n (cdr (assoc "unix::inode" attributes))))
(if n
(string-to-number n)
(tramp-get-inode (tramp-dissect-file-name filename)))))
(setq res-device
(let ((n (cdr (assoc "unix::device" attributes))))
(if n
(string-to-number n)
(tramp-get-device (tramp-dissect-file-name filename)))))
;; Return data gathered.
(list
;; 0. t for directory, string (name linked to) for
;; symbolic link, or nil.
(or dirp res-symlink-target)
;; 1. Number of links to file.
res-numlinks
;; 2. File uid.
res-uid
;; 3. File gid.
res-gid
;; 4. Last access time, as a list of integers.
;; 5. Last modification time, likewise.
;; 6. Last status change time, likewise.
res-access res-mod res-change
;; 7. Size in bytes (-1, if number is out of range).
res-size
;; 8. File modes.
res-filemodes
;; 9. t if file's gid would change if file were deleted
;; and recreated.
nil
;; 10. Inode number.
res-inode
;; 11. Device number.
res-device
)))))
(defun tramp-gvfs-handle-file-directory-p (filename)
"Like `file-directory-p' for Tramp files."
(eq t (car (file-attributes filename))))
(eq t (car (file-attributes (file-truename filename)))))
(defun tramp-gvfs-handle-file-executable-p (filename)
"Like `file-executable-p' for Tramp files."
@ -961,22 +1055,18 @@ file names."
;; Cache expired or no matching cache entry found so we need
;; to perform a remote operation.
(let ((result '("." ".."))
(let ((result '("./" "../"))
entry)
;; Get a list of directories and files.
(tramp-gvfs-send-command
v "gvfs-ls" "-h" (tramp-gvfs-url-file-name directory))
;; Now grab the output.
(with-temp-buffer
(insert-buffer-substring (tramp-get-connection-buffer v))
(goto-char (point-max))
(while (zerop (forward-line -1))
(setq entry (buffer-substring (point) (point-at-eol)))
(when (string-match filename entry)
(if (file-directory-p (expand-file-name entry directory))
(push (concat entry "/") result)
(push entry result)))))
(dolist (item (tramp-gvfs-get-directory-attributes directory))
(setq entry
(or ;; Use display-name if available (google-drive).
;(cdr (assoc "standard::display-name" item))
(car item)))
(when (string-match filename entry)
(if (string-equal (cdr (assoc "type" item)) "directory")
(push (file-name-as-directory entry) result)
(push entry result))))
;; Because the remote op went through OK we know the
;; directory we `cd'-ed to exists.
@ -1528,7 +1618,7 @@ connection if a previous connection has died for some reason."
(let ((p (make-network-process
:name (tramp-buffer-name vec)
:buffer (tramp-get-connection-buffer vec)
:server t :host 'local :service t)))
:server t :host 'local :service t :noquery t)))
(set-process-query-on-exit-flag p nil)))
(unless (tramp-gvfs-connection-mounted-p vec)
@ -1635,10 +1725,17 @@ connection if a previous connection has died for some reason."
"Send the COMMAND with its ARGS to connection VEC.
COMMAND is usually a command from the gvfs-* utilities.
`call-process' is applied, and it returns t if the return code is zero."
(with-current-buffer (tramp-get-connection-buffer vec)
(tramp-gvfs-maybe-open-connection vec)
(erase-buffer)
(zerop (apply 'tramp-call-process vec command nil t nil args))))
(let* ((locale (tramp-get-local-locale vec))
(process-environment
(append
`(,(format "LANG=%s" locale)
,(format "LANGUAGE=%s" locale)
,(format "LC_ALL=%s" locale))
process-environment)))
(with-current-buffer (tramp-get-connection-buffer vec)
(tramp-gvfs-maybe-open-connection vec)
(erase-buffer)
(zerop (apply 'tramp-call-process vec command nil t nil args)))))
;; D-Bus BLUEZ functions.
@ -1772,35 +1869,37 @@ This uses \"avahi-browse\" in case D-Bus is not enabled in Avahi."
;; Add completion functions for AFP, DAV, DAVS, SFTP and SMB methods.
(when tramp-gvfs-enabled
(zeroconf-init tramp-gvfs-zeroconf-domain)
(if (zeroconf-list-service-types)
(progn
;; Suppress D-Bus error messages.
(let (tramp-gvfs-dbus-event-vector)
(zeroconf-init tramp-gvfs-zeroconf-domain)
(if (zeroconf-list-service-types)
(progn
(tramp-set-completion-function
"afp" '((tramp-zeroconf-parse-device-names "_afpovertcp._tcp")))
(tramp-set-completion-function
"dav" '((tramp-zeroconf-parse-device-names "_webdav._tcp")))
(tramp-set-completion-function
"davs" '((tramp-zeroconf-parse-device-names "_webdav._tcp")))
(tramp-set-completion-function
"sftp" '((tramp-zeroconf-parse-device-names "_ssh._tcp")
(tramp-zeroconf-parse-device-names "_workstation._tcp")))
(when (member "smb" tramp-gvfs-methods)
(tramp-set-completion-function
"smb" '((tramp-zeroconf-parse-device-names "_smb._tcp")))))
(when (executable-find "avahi-browse")
(tramp-set-completion-function
"afp" '((tramp-zeroconf-parse-device-names "_afpovertcp._tcp")))
"afp" '((tramp-gvfs-parse-device-names "_afpovertcp._tcp")))
(tramp-set-completion-function
"dav" '((tramp-zeroconf-parse-device-names "_webdav._tcp")))
"dav" '((tramp-gvfs-parse-device-names "_webdav._tcp")))
(tramp-set-completion-function
"davs" '((tramp-zeroconf-parse-device-names "_webdav._tcp")))
"davs" '((tramp-gvfs-parse-device-names "_webdav._tcp")))
(tramp-set-completion-function
"sftp" '((tramp-zeroconf-parse-device-names "_ssh._tcp")
(tramp-zeroconf-parse-device-names "_workstation._tcp")))
"sftp" '((tramp-gvfs-parse-device-names "_ssh._tcp")
(tramp-gvfs-parse-device-names "_workstation._tcp")))
(when (member "smb" tramp-gvfs-methods)
(tramp-set-completion-function
"smb" '((tramp-zeroconf-parse-device-names "_smb._tcp")))))
(when (executable-find "avahi-browse")
(tramp-set-completion-function
"afp" '((tramp-gvfs-parse-device-names "_afpovertcp._tcp")))
(tramp-set-completion-function
"dav" '((tramp-gvfs-parse-device-names "_webdav._tcp")))
(tramp-set-completion-function
"davs" '((tramp-gvfs-parse-device-names "_webdav._tcp")))
(tramp-set-completion-function
"sftp" '((tramp-gvfs-parse-device-names "_ssh._tcp")
(tramp-gvfs-parse-device-names "_workstation._tcp")))
(when (member "smb" tramp-gvfs-methods)
(tramp-set-completion-function
"smb" '((tramp-gvfs-parse-device-names "_smb._tcp")))))))
"smb" '((tramp-gvfs-parse-device-names "_smb._tcp"))))))))
;; D-Bus SYNCE functions.

57
lisp/net/tramp-sh.el
View file

@ -84,8 +84,12 @@ e.g. \"$HOME/.sh_history\"."
(string :tag "Redirect to a file")))
;;;###tramp-autoload
(defconst tramp-color-escape-sequence-regexp "\e[[;0-9]+m"
"Escape sequences produced by the \"ls\" command.")
(defconst tramp-display-escape-sequence-regexp "\e[[;0-9]+m"
"Terminal control escape sequences for display attributes.")
;;;###tramp-autoload
(defconst tramp-device-escape-sequence-regexp "\e[[0-9]+n"
"Terminal control escape sequences for device status.")
;; ksh on OpenBSD 4.5 requires that $PS1 contains a `#' character for
;; root users. It uses the `$' character for other users. In order
@ -1339,8 +1343,10 @@ target of the symlink differ."
(setq res-gid (read (current-buffer)))
(if (eq id-format 'integer)
(progn
(unless (numberp res-uid) (setq res-uid -1))
(unless (numberp res-gid) (setq res-gid -1)))
(unless (numberp res-uid)
(setq res-uid tramp-unknown-id-integer))
(unless (numberp res-gid)
(setq res-gid tramp-unknown-id-integer)))
(progn
(unless (stringp res-uid) (setq res-uid (symbol-name res-uid)))
(unless (stringp res-gid) (setq res-gid (symbol-name res-gid)))))
@ -2836,7 +2842,8 @@ The method used must be an out-of-band method."
(unless
(string-match "color" (tramp-get-connection-property v "ls" ""))
(goto-char beg)
(while (re-search-forward tramp-color-escape-sequence-regexp nil t)
(while
(re-search-forward tramp-display-escape-sequence-regexp nil t)
(replace-match "")))
;; Decode the output, it could be multibyte.
@ -2934,7 +2941,12 @@ the result will be a local, non-Tramp, file name."
(defun tramp-sh-handle-start-file-process (name buffer program &rest args)
"Like `start-file-process' for Tramp files."
(with-parsed-tramp-file-name (expand-file-name default-directory) nil
(let* (;; When PROGRAM matches "*sh", and the first arg is "-c",
(let* ((buffer
(if buffer
(get-buffer-create buffer)
;; BUFFER can be nil. We use a temporary buffer.
(generate-new-buffer tramp-temp-buffer-name)))
;; When PROGRAM matches "*sh", and the first arg is "-c",
;; it might be that the arguments exceed the command line
;; length. Therefore, we modify the command.
(heredoc (and (stringp program)
@ -2992,9 +3004,6 @@ the result will be a local, non-Tramp, file name."
;; `eshell' and friends.
(tramp-current-connection nil))
(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)
@ -4030,7 +4039,7 @@ file exists and nonzero exit status otherwise."
shell)
(setq shell
(with-tramp-connection-property vec "remote-shell"
;; CCC: "root" does not exist always, see QNAP 459.
;; CCC: "root" does not exist always, see my QNAP TS-459.
;; Which check could we apply instead?
(tramp-send-command vec "echo ~root" t)
(if (or (string-match "^~root$" (buffer-string))
@ -5000,7 +5009,12 @@ function waits for output unless NOOUTPUT is set."
(with-current-buffer (process-buffer proc)
(let* (;; Initially, `tramp-end-of-output' is "#$ ". There might
;; be leading escape sequences, which must be ignored.
(regexp (format "[^#$\n]*%s\r?$" (regexp-quote tramp-end-of-output)))
;; Busyboxes built with the EDITING_ASK_TERMINAL config
;; option send also escape sequences, which must be
;; ignored.
(regexp (format "[^#$\n]*%s\\(%s\\)?\r?$"
(regexp-quote tramp-end-of-output)
tramp-device-escape-sequence-regexp))
;; Sometimes, the commands do not return a newline but a
;; null byte before the shell prompt, for example "git
;; ls-files -c -z ...".
@ -5103,16 +5117,17 @@ Return ATTR."
(when attr
;; Remove color escape sequences from symlink.
(when (stringp (car attr))
(while (string-match tramp-color-escape-sequence-regexp (car attr))
(while (string-match tramp-display-escape-sequence-regexp (car attr))
(setcar attr (replace-match "" nil nil (car attr)))))
;; Convert uid and gid. Use -1 as indication of unusable value.
;; Convert uid and gid. Use `tramp-unknown-id-integer' as
;; indication of unusable value.
(when (and (numberp (nth 2 attr)) (< (nth 2 attr) 0))
(setcar (nthcdr 2 attr) -1))
(setcar (nthcdr 2 attr) tramp-unknown-id-integer))
(when (and (floatp (nth 2 attr))
(<= (nth 2 attr) most-positive-fixnum))
(setcar (nthcdr 2 attr) (round (nth 2 attr))))
(when (and (numberp (nth 3 attr)) (< (nth 3 attr) 0))
(setcar (nthcdr 3 attr) -1))
(setcar (nthcdr 3 attr) tramp-unknown-id-integer))
(when (and (floatp (nth 3 attr))
(<= (nth 3 attr) most-positive-fixnum))
(setcar (nthcdr 3 attr) (round (nth 3 attr))))
@ -5556,8 +5571,10 @@ Return ATTR."
(tramp-get-remote-uid-with-python vec id-format))))))
;; Ensure there is a valid result.
(cond
((and (equal id-format 'integer) (not (integerp res))) -1)
((and (equal id-format 'string) (not (stringp res))) "UNKNOWN")
((and (equal id-format 'integer) (not (integerp res)))
tramp-unknown-id-integer)
((and (equal id-format 'string) (not (stringp res)))
tramp-unknown-id-string)
(t res)))))
(defun tramp-get-remote-gid-with-id (vec id-format)
@ -5600,8 +5617,10 @@ Return ATTR."
(tramp-get-remote-gid-with-python vec id-format))))))
;; Ensure there is a valid result.
(cond
((and (equal id-format 'integer) (not (integerp res))) -1)
((and (equal id-format 'string) (not (stringp res))) "UNKNOWN")
((and (equal id-format 'integer) (not (integerp res)))
tramp-unknown-id-integer)
((and (equal id-format 'string) (not (stringp res)))
tramp-unknown-id-string)
(t res)))))
;; Some predefined connection properties.

31
lisp/net/tramp-smb.el
View file

@ -910,14 +910,13 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(with-parsed-tramp-file-name directory nil
(with-tramp-file-property v localname "file-name-all-completions"
(save-match-data
(let ((entries (tramp-smb-get-file-entries directory)))
(mapcar
(lambda (x)
(list
(if (string-match "d" (nth 1 x))
(file-name-as-directory (nth 0 x))
(nth 0 x))))
entries)))))))
(mapcar
(lambda (x)
(list
(if (string-match "d" (nth 1 x))
(file-name-as-directory (nth 0 x))
(nth 0 x))))
(tramp-smb-get-file-entries directory)))))))
(defun tramp-smb-handle-file-writable-p (filename)
"Like `file-writable-p' for Tramp files."
@ -1389,16 +1388,18 @@ target of the symlink differ."
(defun tramp-smb-handle-start-file-process (name buffer program &rest args)
"Like `start-file-process' for Tramp files."
(with-parsed-tramp-file-name default-directory nil
(let ((command (mapconcat 'identity (cons program args) " "))
(bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
(name1 name)
(i 0))
(let* ((buffer
(if buffer
(get-buffer-create buffer)
;; BUFFER can be nil. We use a temporary buffer.
(generate-new-buffer tramp-temp-buffer-name)))
(command (mapconcat 'identity (cons program args) " "))
(bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
(name1 name)
(i 0))
(unwind-protect
(save-excursion
(save-restriction
(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)

17
lisp/net/tramp.el
View file

@ -774,6 +774,12 @@ Derived from `tramp-postfix-host-format'.")
(defconst tramp-localname-regexp ".*$"
"Regexp matching localnames.")
(defconst tramp-unknown-id-string "UNKNOWN"
"String used to denote an unknown user or group")
(defconst tramp-unknown-id-integer -1
"Integer used to denote an unknown user or group")
;;; File name format:
(defconst tramp-remote-file-name-spec-regexp
@ -3834,7 +3840,10 @@ be granted."
vec (concat "uid-" suffix) nil))
(remote-gid
(tramp-get-connection-property
vec (concat "gid-" suffix) nil)))
vec (concat "gid-" suffix) nil))
(unknown-id
(if (string-equal suffix "string")
tramp-unknown-id-string tramp-unknown-id-integer)))
(and
file-attr
(or
@ -3847,12 +3856,14 @@ be granted."
;; User accessible and owned by user.
(and
(eq access (aref (nth 8 file-attr) offset))
(equal remote-uid (nth 2 file-attr)))
(or (equal remote-uid (nth 2 file-attr))
(equal unknown-id (nth 2 file-attr))))
;; Group accessible and owned by user's
;; principal group.
(and
(eq access (aref (nth 8 file-attr) (+ offset 3)))
(equal remote-gid (nth 3 file-attr)))))))))))
(or (equal remote-gid (nth 3 file-attr))
(equal unknown-id (nth 3 file-attr))))))))))))
;;;###tramp-autoload
(defun tramp-local-host-p (vec)

12
test/lisp/net/tramp-tests.el
View file

@ -1468,7 +1468,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(should (zerop (process-file "ls" nil t nil fnnd)))
;; `ls' could produce colorized output.
(goto-char (point-min))
(while (re-search-forward tramp-color-escape-sequence-regexp nil t)
(while
(re-search-forward tramp-display-escape-sequence-regexp nil t)
(replace-match "" nil nil))
(should (string-equal (format "%s\n" fnnd) (buffer-string)))
(should-not (get-buffer-window (current-buffer) t))
@ -1478,7 +1479,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(should (zerop (process-file "ls" nil t t fnnd)))
;; `ls' could produce colorized output.
(goto-char (point-min))
(while (re-search-forward tramp-color-escape-sequence-regexp nil t)
(while
(re-search-forward tramp-display-escape-sequence-regexp nil t)
(replace-match "" nil nil))
(should
(string-equal (format "%s\n%s\n" fnnd fnnd) (buffer-string)))
@ -1581,7 +1583,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(format "ls %s" (file-name-nondirectory tmp-name)) (current-buffer))
;; `ls' could produce colorized output.
(goto-char (point-min))
(while (re-search-forward tramp-color-escape-sequence-regexp nil t)
(while (re-search-forward tramp-display-escape-sequence-regexp nil t)
(replace-match "" nil nil))
(should
(string-equal
@ -1604,7 +1606,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(accept-process-output (get-buffer-process (current-buffer)) 1)))
;; `ls' could produce colorized output.
(goto-char (point-min))
(while (re-search-forward tramp-color-escape-sequence-regexp nil t)
(while (re-search-forward tramp-display-escape-sequence-regexp nil t)
(replace-match "" nil nil))
;; There might be a nasty "Process *Async Shell* finished" message.
(goto-char (point-min))
@ -1633,7 +1635,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(accept-process-output (get-buffer-process (current-buffer)) 1)))
;; `ls' could produce colorized output.
(goto-char (point-min))
(while (re-search-forward tramp-color-escape-sequence-regexp nil t)
(while (re-search-forward tramp-display-escape-sequence-regexp nil t)
(replace-match "" nil nil))
;; There might be a nasty "Process *Async Shell* finished" message.
(goto-char (point-min))