Commit 50bfdd5d authored by Michael Albinus's avatar Michael Albinus

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.
parent d34f67da
2014-02-19 Michael Albinus <michael.albinus@gmx.de>
* 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 <lekktu@gmail.com>
* frameset.el (frameset--reuse-frame): Remove workaround for bug#16793.
......
......@@ -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)
......
......@@ -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.
......
......@@ -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")
......
......@@ -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)
......
......@@ -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))
......
......@@ -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)))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment