[Emacs-diffs] trunk r116481: Some Tramp minor fixes, found during test campaign.

[Michael Albinus]

------------------------------------------------------------
revno: 116481
revision-id: address@hidden
parent: address@hidden
committer: Michael Albinus <address@hidden>
branch nick: trunk
timestamp: Wed 2014-02-19 20:24:32 +0100
message:
  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.
modified:
  lisp/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-1432
  lisp/net/tramp-adb.el          trampadb.el-20121204164216-03wyr5miam215d7f-1
  lisp/net/tramp-gvfs.el         
trampgvfs.el-20091113204419-o5vbwnq5f7feedwu-10898
  lisp/net/tramp-sh.el           trampsh.el-20100913133439-a1faifh29eqoi4nh-1
  lisp/net/tramp-smb.el          
trampsmb.el-20091113204419-o5vbwnq5f7feedwu-2515
  lisp/net/tramp.el              tramp.el-20091113204419-o5vbwnq5f7feedwu-2427
  lisp/net/trampver.el           
trampver.el-20091113204419-o5vbwnq5f7feedwu-2564

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2014-02-19 11:01:35 +0000
+++ b/lisp/ChangeLog    2014-02-19 19:24:32 +0000
@@ -1,3 +1,30 @@
+2014-02-19  Michael Albinus  <address@hidden>
+
+       * 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  <address@hidden>
 
        * frameset.el (frameset--reuse-frame): Remove workaround for bug#16793.

=== modified file 'lisp/net/tramp-adb.el'
--- a/lisp/net/tramp-adb.el     2014-01-01 07:43:34 +0000
+++ b/lisp/net/tramp-adb.el     2014-02-19 19:24:32 +0000
@@ -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)

=== modified file 'lisp/net/tramp-gvfs.el'
--- a/lisp/net/tramp-gvfs.el    2014-01-01 07:43:34 +0000
+++ b/lisp/net/tramp-gvfs.el    2014-02-19 19:24:32 +0000
@@ -457,7 +457,7 @@
     (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 @@
        ;; 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"))
+         (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))))))
+  ;; 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.

=== modified file 'lisp/net/tramp-sh.el'
--- a/lisp/net/tramp-sh.el      2014-02-10 13:54:33 +0000
+++ b/lisp/net/tramp-sh.el      2014-02-19 19:24:32 +0000
@@ -60,6 +60,7 @@
   :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 @@
   "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 @@
 (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 @@
     (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")

=== modified file 'lisp/net/tramp-smb.el'
--- a/lisp/net/tramp-smb.el     2014-01-01 07:43:34 +0000
+++ b/lisp/net/tramp-smb.el     2014-02-19 19:24:32 +0000
@@ -929,6 +929,10 @@
   "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 @@
        (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)))))
+            (when (string-match "l" switches)
+              (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)))
               (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)))
-                (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))))
+                "%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)

=== modified file 'lisp/net/tramp.el'
--- a/lisp/net/tramp.el 2014-01-17 18:24:09 +0000
+++ b/lisp/net/tramp.el 2014-02-19 19:24:32 +0000
@@ -3150,6 +3150,13 @@
              (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 @@
        (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))

=== modified file 'lisp/net/trampver.el'
--- a/lisp/net/trampver.el      2014-02-16 17:23:00 +0000
+++ b/lisp/net/trampver.el      2014-02-19 19:24:32 +0000
@@ -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)))