From 50bfdd5d78aa015d9032da7e6376665243f3f3b1 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 19 Feb 2014 20:24:32 +0100 Subject: [PATCH] Some Tramp minor fixes, found during test campaign. * net/tramp-adb.el (tramp-adb-file-name-handler-alist) [make-symbolic-link]: Use `tramp-handle-make-symbolic-link'. * net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist) [make-symbolic-link]: Use `tramp-handle-make-symbolic-link'. (tramp-gvfs-maybe-open-connection): Set always connection properties, even if target is mounted already. * net/tramp-sh.el (tramp-color-escape-sequence-regexp): Set tramp-autoload cookie. (tramp-get-remote-touch): New defun. (tramp-sh-handle-set-file-times): Use it. (tramp-sh-handle-directory-files-and-attributes): Use `tramp-handle-directory-files-and-attributes' if neither stat nor perl are available on the remote host. * net/tramp-smb.el (tramp-smb-handle-insert-directory): Mark trailing "/". Write long listing only when "l" belongs to the switches. * net/tramp.el (tramp-handle-make-symbolic-link): New defun. (tramp-check-cached-permissions): Call `file-attributes' if the cache is empty. * net/trampver.el: Update release number. --- lisp/ChangeLog | 27 ++++++++++ lisp/net/tramp-adb.el | 2 +- lisp/net/tramp-gvfs.el | 28 +++++----- lisp/net/tramp-sh.el | 136 +++++++++++++++++++++++++++++++------------------ lisp/net/tramp-smb.el | 67 +++++++++++++----------- lisp/net/tramp.el | 21 ++++++-- lisp/net/trampver.el | 4 +- 7 files changed, 186 insertions(+), 99 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index f65b33e679f..733c83f467c 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,30 @@ +2014-02-19 Michael Albinus + + * net/tramp.el (tramp-handle-make-symbolic-link): New defun. + (tramp-check-cached-permissions): Call `file-attributes' if the + cache is empty. + + * net/tramp-adb.el (tramp-adb-file-name-handler-alist) + [make-symbolic-link]: Use `tramp-handle-make-symbolic-link'. + + * net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist) + [make-symbolic-link]: Use `tramp-handle-make-symbolic-link'. + (tramp-gvfs-maybe-open-connection): Set always connection + properties, even if target is mounted already. + + * net/tramp-sh.el (tramp-color-escape-sequence-regexp): + Set tramp-autoload cookie. + (tramp-get-remote-touch): New defun. + (tramp-sh-handle-set-file-times): Use it. + (tramp-sh-handle-directory-files-and-attributes): + Use `tramp-handle-directory-files-and-attributes' if neither stat + nor perl are available on the remote host. + + * net/tramp-smb.el (tramp-smb-handle-insert-directory): Mark trailing + "/". Write long listing only when "l" belongs to the switches. + + * net/trampver.el: Update release number. + 2014-02-19 Juanma Barranquero * frameset.el (frameset--reuse-frame): Remove workaround for bug#16793. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 2cb5ece10dd..8f2098c136b 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -140,7 +140,7 @@ (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-directory . tramp-adb-handle-make-directory) (make-directory-internal . ignore) - (make-symbolic-link . ignore) + (make-symbolic-link . tramp-handle-make-symbolic-link) (process-file . tramp-adb-handle-process-file) (rename-file . tramp-adb-handle-rename-file) (set-file-acl . ignore) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 13bc3719655..38b53afea45 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -457,7 +457,7 @@ Every entry is a list (NAME ADDRESS).") (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-directory . tramp-gvfs-handle-make-directory) (make-directory-internal . ignore) - (make-symbolic-link . ignore) + (make-symbolic-link . tramp-handle-make-symbolic-link) (process-file . ignore) (rename-file . tramp-gvfs-handle-rename-file) (set-file-acl . ignore) @@ -1547,19 +1547,19 @@ connection if a previous connection has died for some reason." ;; is marked with the fuse-mountpoint "/". We shall react. (when (string-equal (tramp-get-file-property vec "/" "fuse-mountpoint" "") "/") - (tramp-error vec 'file-error "FUSE mount denied")) - - ;; In `tramp-check-cached-permissions', the connection - ;; properties {uig,gid}-{integer,string} are used. We set - ;; them to their local counterparts. - (tramp-set-connection-property - vec "uid-integer" (tramp-get-local-uid 'integer)) - (tramp-set-connection-property - vec "gid-integer" (tramp-get-local-gid 'integer)) - (tramp-set-connection-property - vec "uid-string" (tramp-get-local-uid 'string)) - (tramp-set-connection-property - vec "gid-string" (tramp-get-local-gid 'string)))))) + (tramp-error vec 'file-error "FUSE mount denied"))))) + + ;; In `tramp-check-cached-permissions', the connection properties + ;; {uig,gid}-{integer,string} are used. We set them to their local + ;; counterparts. + (with-tramp-connection-property + vec "uid-integer" (tramp-get-local-uid 'integer)) + (with-tramp-connection-property + vec "gid-integer" (tramp-get-local-gid 'integer)) + (with-tramp-connection-property + vec "uid-string" (tramp-get-local-uid 'string)) + (with-tramp-connection-property + vec "gid-string" (tramp-get-local-gid 'string))) (defun tramp-gvfs-send-command (vec command &rest args) "Send the COMMAND with its ARGS to connection VEC. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index fc906b343cb..4284fecf14f 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -60,6 +60,7 @@ files conditionalize this setup based on the TERM environment variable." :group 'tramp :type 'string) +;;;###tramp-autoload (defconst tramp-color-escape-sequence-regexp "\e[[;0-9]+m" "Escape sequences produced by the \"ls\" command.") @@ -1305,22 +1306,29 @@ of." "Like `set-file-times' for Tramp files." (if (tramp-tramp-file-p filename) (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)) - ;; With GNU Emacs, `format-time-string' has an optional - ;; parameter UNIVERSAL. This is preferred, because we - ;; could handle the case when the remote host is located - ;; in a different time zone as the local host. - (utc (not (featurep 'xemacs)))) - (tramp-send-command-and-check - v (format "%s touch -t %s %s" - (if utc "env TZ=UTC" "") - (if utc - (format-time-string "%Y%m%d%H%M.%S" time t) - (format-time-string "%Y%m%d%H%M.%S" time)) - (tramp-shell-quote-argument localname))))) + (when (tramp-get-remote-touch v) + (tramp-flush-file-property v localname) + (let ((time (if (or (null time) (equal time '(0 0))) + (current-time) + time)) + ;; With GNU Emacs, `format-time-string' has an + ;; optional parameter UNIVERSAL. This is preferred, + ;; because we could handle the case when the remote + ;; host is located in a different time zone as the + ;; local host. + (utc (not (featurep 'xemacs)))) + (tramp-send-command-and-check + v (format + "%s %s %s %s" + (if utc "env TZ=UTC" "") + (tramp-get-remote-touch v) + (if (tramp-get-connection-property v "touch-t" nil) + (format "-t %s" + (if utc + (format-time-string "%Y%m%d%H%M.%S" time t) + (format-time-string "%Y%m%d%H%M.%S" time))) + "") + (tramp-shell-quote-argument localname)))))) ;; We handle also the local part, because in older Emacsen, ;; without `set-file-times', this function is an alias for this. @@ -1562,39 +1570,45 @@ be non-negative integers." (defun tramp-sh-handle-directory-files-and-attributes (directory &optional full match nosort id-format) "Like `directory-files-and-attributes' for Tramp files." - (unless id-format (setq id-format 'integer)) - (when (file-directory-p directory) - (setq directory (expand-file-name directory)) - (let* ((temp - (copy-tree - (with-parsed-tramp-file-name directory nil - (with-tramp-file-property - v localname - (format "directory-files-and-attributes-%s" id-format) - (save-excursion - (mapcar - (lambda (x) - (cons (car x) - (tramp-convert-file-attributes v (cdr x)))) - (cond - ((tramp-get-remote-stat v) - (tramp-do-directory-files-and-attributes-with-stat - v localname id-format)) - ((tramp-get-remote-perl v) - (tramp-do-directory-files-and-attributes-with-perl - v localname id-format))))))))) - result item) - - (while temp - (setq item (pop temp)) - (when (or (null match) (string-match match (car item))) - (when full - (setcar item (expand-file-name (car item) directory))) - (push item result))) - - (if nosort - result - (sort result (lambda (x y) (string< (car x) (car y)))))))) + (if (with-parsed-tramp-file-name directory nil + (not (or (tramp-get-remote-stat v) (tramp-get-remote-perl v)))) + (tramp-handle-directory-files-and-attributes + directory full match nosort id-format) + + ;; Do it directly. + (unless id-format (setq id-format 'integer)) + (when (file-directory-p directory) + (setq directory (expand-file-name directory)) + (let* ((temp + (copy-tree + (with-parsed-tramp-file-name directory nil + (with-tramp-file-property + v localname + (format "directory-files-and-attributes-%s" id-format) + (save-excursion + (mapcar + (lambda (x) + (cons (car x) + (tramp-convert-file-attributes v (cdr x)))) + (cond + ((tramp-get-remote-stat v) + (tramp-do-directory-files-and-attributes-with-stat + v localname id-format)) + ((tramp-get-remote-perl v) + (tramp-do-directory-files-and-attributes-with-perl + v localname id-format))))))))) + result item) + + (while temp + (setq item (pop temp)) + (when (or (null match) (string-match match (car item))) + (when full + (setcar item (expand-file-name (car item) directory))) + (push item result))) + + (if nosort + result + (sort result (lambda (x y) (string< (car x) (car y))))))))) (defun tramp-do-directory-files-and-attributes-with-perl (vec localname &optional id-format) @@ -4999,6 +5013,30 @@ Return ATTR." (tramp-message vec 5 "Finding a suitable `trash' command") (tramp-find-executable vec "trash" (tramp-get-remote-path vec)))) +(defun tramp-get-remote-touch (vec) + (with-tramp-connection-property vec "touch" + (tramp-message vec 5 "Finding a suitable `touch' command") + (let ((result (tramp-find-executable + vec "touch" (tramp-get-remote-path vec))) + (tmpfile + (make-temp-name + (expand-file-name + tramp-temp-name-prefix (tramp-get-remote-tmpdir vec))))) + ;; Busyboxes do support the "-t" option only when they have been + ;; built with the DESKTOP config option. Let's check it. + (when result + (tramp-set-connection-property + vec "touch-t" + (tramp-send-command-and-check + vec + (format + "%s -t %s %s" + result + (format-time-string "%Y%m%d%H%M.%S" (current-time)) + (tramp-file-name-handler 'file-remote-p tmpfile 'localname)))) + (delete-file tmpfile)) + result))) + (defun tramp-get-remote-gvfs-monitor-dir (vec) (with-tramp-connection-property vec "gvfs-monitor-dir" (tramp-message vec 5 "Finding a suitable `gvfs-monitor-dir' command") diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 97a892f9858..43e2c494ece 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -929,6 +929,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." "Like `insert-directory' for Tramp files." (setq filename (expand-file-name filename)) (unless switches (setq switches "")) + ;; Mark trailing "/". + (when (and (zerop (length (file-name-nondirectory filename))) + (not full-directory-p)) + (setq switches (concat switches "F"))) (if full-directory-p ;; Called from `dired-add-entry'. (setq filename (file-name-as-directory filename)) @@ -991,38 +995,41 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (mapc (lambda (x) (when (not (zerop (length (nth 0 x)))) - (let ((attr - (when (tramp-smb-get-stat-capability v) - (ignore-errors - (file-attributes filename 'string))))) - (insert - (format - "%10s %3d %-8s %-8s %8s %s " - (or (nth 8 attr) (nth 1 x)) ; mode - (or (nth 1 attr) 1) ; inode - (or (nth 2 attr) "nobody") ; uid - (or (nth 3 attr) "nogroup") ; gid - (or (nth 7 attr) (nth 2 x)) ; size - (format-time-string - (if (tramp-time-less-p - (tramp-time-subtract (current-time) (nth 3 x)) - tramp-half-a-year) - "%b %e %R" - "%b %e %Y") - (nth 3 x)))) ; date - ;; We mark the file name. The inserted name could be - ;; from somewhere else, so we use the relative file - ;; name of `default-directory'. - (let ((start (point))) + (when (string-match "l" switches) + (let ((attr + (when (tramp-smb-get-stat-capability v) + (ignore-errors + (file-attributes filename 'string))))) (insert (format - "%s\n" - (file-relative-name - (expand-file-name - (nth 0 x) (file-name-directory filename))))) - (put-text-property start (1- (point)) 'dired-filename t)) - (forward-line) - (beginning-of-line)))) + "%10s %3d %-8s %-8s %8s %s " + (or (nth 8 attr) (nth 1 x)) ; mode + (or (nth 1 attr) 1) ; inode + (or (nth 2 attr) "nobody") ; uid + (or (nth 3 attr) "nogroup") ; gid + (or (nth 7 attr) (nth 2 x)) ; size + (format-time-string + (if (tramp-time-less-p + (tramp-time-subtract (current-time) (nth 3 x)) + tramp-half-a-year) + "%b %e %R" + "%b %e %Y") + (nth 3 x)))))) ; date + + ;; We mark the file name. The inserted name could be + ;; from somewhere else, so we use the relative file name + ;; of `default-directory'. + (let ((start (point))) + (insert + (format + "%s\n" + (file-relative-name + (expand-file-name + (nth 0 x) (file-name-directory filename)) + (when full-directory-p (file-name-directory filename))))) + (put-text-property start (1- (point)) 'dired-filename t)) + (forward-line) + (beginning-of-line))) entries))))) (defun tramp-smb-handle-make-directory (dir &optional parents) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 8ac654c70ab..aa9881be997 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3150,6 +3150,13 @@ User is always nil." (delete-file local-copy))))) t))) +(defun tramp-handle-make-symbolic-link + (filename linkname &optional ok-if-already-exists) + "Like `make-symbolic-link' for Tramp files." + (with-parsed-tramp-file-name + (if (tramp-tramp-file-p filename) filename linkname) nil + (tramp-error v 'file-error "make-symbolic-link not supported"))) + (defun tramp-handle-shell-command (command &optional output-buffer error-buffer) "Like `shell-command' for Tramp files." @@ -3819,9 +3826,17 @@ be granted." (or result (let ((file-attr - (tramp-get-file-property - vec (tramp-file-name-localname vec) - (concat "file-attributes-" suffix) nil)) + (or + (tramp-get-file-property + vec (tramp-file-name-localname vec) + (concat "file-attributes-" suffix) nil) + (file-attributes + (tramp-make-tramp-file-name + (tramp-file-name-method vec) + (tramp-file-name-user vec) + (tramp-file-name-host vec) + (tramp-file-name-localname vec)) + suffix))) (remote-uid (tramp-get-connection-property vec (concat "uid-" suffix) nil)) diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 077aedb4d5f..1ee6e6ad025 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.9" +(defconst tramp-version "2.2.9-24.4" "This version of Tramp.") ;;;###tramp-autoload @@ -44,7 +44,7 @@ (= emacs-major-version 21) (>= emacs-minor-version 4))) "ok" - (format "Tramp 2.2.9 is not fit for %s" + (format "Tramp 2.2.9-24.4 is not fit for %s" (when (string-match "^.*$" (emacs-version)) (match-string 0 (emacs-version))))))) (unless (string-match "\\`ok\\'" x) (error "%s" x))) -- 2.11.4.GIT