diff options
Diffstat (limited to 'lisp/net')
| -rw-r--r-- | lisp/net/tramp-adb.el | 32 | ||||
| -rw-r--r-- | lisp/net/tramp-gvfs.el | 455 | ||||
| -rw-r--r-- | lisp/net/tramp-sh.el | 263 | ||||
| -rw-r--r-- | lisp/net/tramp-smb.el | 37 | ||||
| -rw-r--r-- | lisp/net/tramp.el | 37 |
5 files changed, 418 insertions, 406 deletions
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 5940b713958..1281dbbd72d 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -535,7 +535,7 @@ Emacs dired can't find files." "Like `file-name-all-completions' for Tramp files." (all-completions filename - (with-parsed-tramp-file-name directory nil + (with-parsed-tramp-file-name (expand-file-name directory) nil (with-tramp-file-property v localname "file-name-all-completions" (save-match-data (tramp-adb-send-command @@ -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)) - - (unless buffer - ;; BUFFER can be nil. We use a temporary buffer. - (setq buffer (generate-new-buffer tramp-temp-buffer-name))) + (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)) + (while (get-process name1) ;; NAME must be unique as process name. (setq i (1+ i) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 098d40e7cc0..ac390e5d5a6 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -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 delimiter 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))) - - ;; 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 - )))))))) + (while (re-search-forward + tramp-gvfs-file-attributes-with-gvfs-info-regexp nil t) + (push (cons (match-string 1) (match-string 2)) result)) + result)))))) + +(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." @@ -926,73 +1020,21 @@ file names." (defun tramp-gvfs-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." (unless (save-match-data (string-match "/" filename)) - (with-parsed-tramp-file-name (expand-file-name directory) nil - - (all-completions - filename - (mapcar - 'list - (or - ;; Try cache entries for filename, filename with last - ;; character removed, filename with last two characters - ;; removed, ..., and finally the empty string - all - ;; concatenated to the local directory name. - (let ((remote-file-name-inhibit-cache - (or remote-file-name-inhibit-cache - tramp-completion-reread-directory-timeout))) - - ;; This is inefficient for very long filenames, pity - ;; `reduce' is not available... - (car - (apply - 'append - (mapcar - (lambda (x) - (let ((cache-hit - (tramp-get-file-property - v - (concat localname (substring filename 0 x)) - "file-name-all-completions" - nil))) - (when cache-hit (list cache-hit)))) - ;; We cannot use a length of 0, because file properties - ;; for "foo" and "foo/" are identical. - (number-sequence (length filename) 1 -1))))) - - ;; Cache expired or no matching cache entry found so we need - ;; to perform a remote operation. - (let ((result '("." "..")) + (all-completions + filename + (with-parsed-tramp-file-name (expand-file-name directory) nil + (with-tramp-file-property v localname "file-name-all-completions" + (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))))) - - ;; Because the remote op went through OK we know the - ;; directory we `cd'-ed to exists. - (tramp-set-file-property v localname "file-exists-p" t) - - ;; Because the remote op went through OK we know every - ;; file listed by `ls' exists. - (mapc (lambda (entry) - (tramp-set-file-property - v (concat localname entry) "file-exists-p" t)) - result) - - ;; Store result in the cache. - (tramp-set-file-property - v (concat localname filename) - "file-name-all-completions" result)))))))) + (dolist (item (tramp-gvfs-get-directory-attributes directory) result) + (setq entry + (or ;; Use display-name if available (google-drive). + ;(cdr (assoc "standard::display-name" item)) + (car item))) + (if (string-equal (cdr (assoc "type" item)) "directory") + (push (file-name-as-directory entry) result) + (push entry result))))))))) (defun tramp-gvfs-handle-file-notify-add-watch (file-name flags _callback) "Like `file-notify-add-watch' for Tramp files." @@ -1528,7 +1570,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 +1677,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 +1821,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. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 14c6f949853..e9f78b7d1ce 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -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 @@ -658,29 +662,19 @@ Escape sequence %s is replaced with name of Perl binary. This string is passed to `format', so percent characters need to be doubled.") (defconst tramp-perl-file-name-all-completions - "%s -e 'sub case { - my $str = shift; - if ($ARGV[2]) { - return lc($str); - } - else { - return $str; - } -} + "%s -e ' opendir(d, $ARGV[0]) || die(\"$ARGV[0]: $!\\nfail\\n\"); @files = readdir(d); closedir(d); foreach $f (@files) { - if (case(substr($f, 0, length($ARGV[1]))) eq case($ARGV[1])) { - if (-d \"$ARGV[0]/$f\") { - print \"$f/\\n\"; - } - else { - print \"$f\\n\"; - } + if (-d \"$ARGV[0]/$f\") { + print \"$f/\\n\"; + } + else { + print \"$f\\n\"; } } print \"ok\\n\" -' \"$1\" \"$2\" \"$3\" 2>/dev/null" +' \"$1\" 2>/dev/null" "Perl script to produce output suitable for use with `file-name-all-completions' on the remote file system. Escape sequence %s is replaced with name of Perl binary. This string is @@ -1339,8 +1333,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))))) @@ -1862,135 +1858,63 @@ be non-negative integers." (defun tramp-sh-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." (unless (save-match-data (string-match "/" filename)) - (with-parsed-tramp-file-name (expand-file-name directory) nil + (all-completions + filename + (with-parsed-tramp-file-name (expand-file-name directory) nil + (with-tramp-file-property v localname "file-name-all-completions" + (let (result) + ;; Get a list of directories and files, including reliably + ;; tagging the directories with a trailing "/". Because I + ;; rock. --daniel@danann.net + (tramp-send-command + v + (if (tramp-get-remote-perl v) + (progn + (tramp-maybe-send-script + v tramp-perl-file-name-all-completions + "tramp_perl_file_name_all_completions") + (format "tramp_perl_file_name_all_completions %s" + (tramp-shell-quote-argument localname))) + + (format (concat + "(cd %s 2>&1 && %s -a 2>/dev/null" + " | while IFS= read f; do" + " if %s -d \"$f\" 2>/dev/null;" + " then \\echo \"$f/\"; else \\echo \"$f\"; fi; done" + " && \\echo ok) || \\echo fail") + (tramp-shell-quote-argument localname) + (tramp-get-ls-command v) + (tramp-get-test-command v)))) - (all-completions - filename - (mapcar - 'list - (or - ;; Try cache entries for `filename', `filename' with last - ;; character removed, `filename' with last two characters - ;; removed, ..., and finally the empty string - all - ;; concatenated to the local directory name. - (let ((remote-file-name-inhibit-cache - (or remote-file-name-inhibit-cache - tramp-completion-reread-directory-timeout))) - - ;; This is inefficient for very long file names, pity - ;; `reduce' is not available... - (car - (apply - 'append - (mapcar - (lambda (x) - (let ((cache-hit - (tramp-get-file-property - v - (concat localname (substring filename 0 x)) - "file-name-all-completions" - nil))) - (when cache-hit (list cache-hit)))) - ;; We cannot use a length of 0, because file properties - ;; for "foo" and "foo/" are identical. - (number-sequence (length filename) 1 -1))))) - - ;; Cache expired or no matching cache entry found so we need - ;; to perform a remote operation. - (let (result) - ;; Get a list of directories and files, including reliably - ;; tagging the directories with a trailing '/'. Because I - ;; rock. --daniel@danann.net - - ;; Changed to perform `cd' in the same remote op and only - ;; get entries starting with `filename'. Capture any `cd' - ;; error messages. Ensure any `cd' and `echo' aliases are - ;; ignored. - (tramp-send-command - v - (if (tramp-get-remote-perl v) - (progn - (tramp-maybe-send-script - v tramp-perl-file-name-all-completions - "tramp_perl_file_name_all_completions") - (format "tramp_perl_file_name_all_completions %s %s %d" - (tramp-shell-quote-argument localname) - (tramp-shell-quote-argument filename) - (if read-file-name-completion-ignore-case 1 0))) - - (format (concat - "(cd %s 2>&1 && (%s -a %s 2>/dev/null" - ;; `ls' with wildcard might fail with `Argument - ;; list too long' error in some corner cases; if - ;; `ls' fails after `cd' succeeded, chances are - ;; that's the case, so let's retry without - ;; wildcard. This will return "too many" entries - ;; but that isn't harmful. - " || %s -a 2>/dev/null)" - " | while IFS= read f; do" - " if %s -d \"$f\" 2>/dev/null;" - " then \\echo \"$f/\"; else \\echo \"$f\"; fi; done" - " && \\echo ok) || \\echo fail") - (tramp-shell-quote-argument localname) - (tramp-get-ls-command v) - ;; When `filename' is empty, just `ls' without - ;; `filename' argument is more efficient than `ls *' - ;; for very large directories and might avoid the - ;; `Argument list too long' error. - ;; - ;; With and only with wildcard, we need to add - ;; `-d' to prevent `ls' from descending into - ;; sub-directories. - (if (zerop (length filename)) - "." - (format "-d %s*" (tramp-shell-quote-argument filename))) - (tramp-get-ls-command v) - (tramp-get-test-command v)))) - - ;; Now grab the output. - (with-current-buffer (tramp-get-buffer v) - (goto-char (point-max)) - - ;; Check result code, found in last line of output. - (forward-line -1) - (if (looking-at "^fail$") - (progn - ;; Grab error message from line before last line - ;; (it was put there by `cd 2>&1'). - (forward-line -1) - (tramp-error - v 'file-error - "tramp-sh-handle-file-name-all-completions: %s" - (buffer-substring (point) (point-at-eol)))) - ;; For peace of mind, if buffer doesn't end in `fail' - ;; then it should end in `ok'. If neither are in the - ;; buffer something went seriously wrong on the remote - ;; side. - (unless (looking-at "^ok$") - (tramp-error - v 'file-error - "\ + ;; Now grab the output. + (with-current-buffer (tramp-get-buffer v) + (goto-char (point-max)) + + ;; Check result code, found in last line of output. + (forward-line -1) + (if (looking-at "^fail$") + (progn + ;; Grab error message from line before last line + ;; (it was put there by `cd 2>&1'). + (forward-line -1) + (tramp-error + v 'file-error + "tramp-sh-handle-file-name-all-completions: %s" + (buffer-substring (point) (point-at-eol)))) + ;; For peace of mind, if buffer doesn't end in `fail' + ;; then it should end in `ok'. If neither are in the + ;; buffer something went seriously wrong on the remote + ;; side. + (unless (looking-at "^ok$") + (tramp-error + v 'file-error + "\ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" - (tramp-shell-quote-argument localname) (buffer-string)))) - - (while (zerop (forward-line -1)) - (push (buffer-substring (point) (point-at-eol)) result))) - - ;; Because the remote op went through OK we know the - ;; directory we `cd'-ed to exists. - (tramp-set-file-property v localname "file-exists-p" t) - - ;; Because the remote op went through OK we know every - ;; file listed by `ls' exists. - (mapc (lambda (entry) - (tramp-set-file-property - v (concat localname entry) "file-exists-p" t)) - result) + (tramp-shell-quote-argument localname) (buffer-string)))) - ;; Store result in the cache. - (tramp-set-file-property - v (concat localname filename) - "file-name-all-completions" result)))))))) + (while (zerop (forward-line -1)) + (push (buffer-substring (point) (point-at-eol)) result))) + result)))))) ;; cp, mv and ln @@ -2836,7 +2760,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 +2859,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 +2922,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 +3957,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)) @@ -4790,7 +4717,7 @@ connection if a previous connection has died for some reason." (options (tramp-ssh-controlmaster-options vec)) (process-connection-type tramp-process-connection-type) (process-adaptive-read-buffering nil) - ;; There are unfortune settings for "cmdproxy" on + ;; There are unfortunate settings for "cmdproxy" on ;; W32 systems. (process-coding-system-alist nil) (coding-system-for-read nil) @@ -5000,7 +4927,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 +5035,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 +5489,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 +5535,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. diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index c4dde050c83..fbd7cd30008 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -663,8 +663,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." result))) ;; Sort them if necessary. (unless nosort (setq result (sort result 'string-lessp))) - ;; Remove double entries. - (delete-dups result))) + result)) (defun tramp-smb-handle-expand-file-name (name &optional dir) "Like `expand-file-name' for Tramp files." @@ -907,17 +906,17 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." "Like `file-name-all-completions' for Tramp files." (all-completions filename - (with-parsed-tramp-file-name directory nil + (with-parsed-tramp-file-name (expand-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))))))) + (delete-dups + (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) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 28fc9c748bb..e3755533b9d 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -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 @@ -2861,11 +2867,21 @@ User is always nil." (error "tramp-handle-file-name-completion invoked on non-tramp directory `%s'" directory)) - (try-completion - filename - (mapcar 'list (file-name-all-completions filename directory)) - (when predicate - (lambda (x) (funcall predicate (expand-file-name (car x) directory)))))) + (let (hits-ignored-extensions) + (or + (try-completion + filename (file-name-all-completions filename directory) + (lambda (x) + (when (funcall (or predicate 'identity) (expand-file-name x directory)) + (not + (and + completion-ignored-extensions + (string-match + (concat (regexp-opt completion-ignored-extensions 'paren) "$") x) + ;; We remember the hit. + (push x hits-ignored-extensions)))))) + ;; No match. So we try again for ignored files. + (try-completion filename hits-ignored-extensions)))) (defun tramp-handle-file-name-directory (file) "Like `file-name-directory' but aware of Tramp files." @@ -3834,7 +3850,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 +3866,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) |