unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* [patch] Tramp and file attributes
@ 2004-11-14 12:32 Lars Hansen
  2004-11-27  7:39 ` Lars Hansen
  0 siblings, 1 reply; 2+ messages in thread
From: Lars Hansen @ 2004-11-14 12:32 UTC (permalink / raw)
  Cc: emacs-devel

[-- Attachment #1: Type: text/plain, Size: 2062 bytes --]

About a year ago I added the parameter id-format to the primitives
file-attributes and directory-files-and-attributes so that one can get
uid and gid as a string. I did that primarily because I like ls-lisp
very much and would like to use it together with tramp. However, ls-lisp
uses directory-files-and-attributes and tramp does not implement it. I
never got around to do anything about that, but now I finally have made
a patch (attached). Please take a look at it before I install it.
Thank you!

Description of changes:

1. New function tramp-handle-directory-files-and-attributes with perl
script tramp-perl-directory-files-and-attributes. In order to not slow
down login process, the script is sent only if needed. A new function
tramp-maybe-send-perl-script handles that. Connection property
"perl-scripts" holds a list of scripts sent.
With tramp-maybe-send-perl-script it is easy for a user to implement his
own "remote procedure" with perl.

2. tramp-handle-file-attributes-with-perl now uses
tramp-maybe-send-perl-script, the script is no longer sent by
tramp-post-connection. This should speed up initialization a bit.

3. Conversion of file mode bits to a string and and assignment of
virtual device number is collected a new function
tramp-convert-file-attributes. This function also adds tramp prefix to
symlinks if they are absolute -- that was not done before.
tramp-convert-file-attributes is used in tramp-handle-file-attributes
and tramp-handle-directory-files-and-attributes.

4. tramp-perl-file-attributes did not surround uid and gid by double
quotes when they were supposed to be a string. That is corrected.

5. Name and semantics of parameter nonnumeric is changed to id-format in
functions tramp-perl-file-attributes,
tramp-handle-file-attributes-with-perl and
tramp-handle-file-attributes-with-ls.

6. tramp-handle-insert-directory now runs the real handler when ls-lisp
is in use.

7. file-directory-files is deleted from tramp-file-name-handler-alist,
there is no such primitive and no tramp handler. So I guess it is a mistake.



[-- Attachment #2: file-attributes.patch --]
[-- Type: text/x-patch, Size: 27390 bytes --]

*** tramp.1.56.el	Sun Nov 14 10:04:02 2004
--- /home/lh/cvsroot/emacs/lisp/net/tramp.el	Sun Nov 14 12:27:22 2004
***************
*** 1547,1566 ****
  ;; The device number is returned as "-1", because there will be a virtual
  ;; device number set in `tramp-handle-file-attributes'
  (defconst tramp-perl-file-attributes "\
! \($f, $n) = @ARGV;
! @s = lstat($f);
! if (($s[2] & 0170000) == 0120000) { $l = readlink($f); $l = \"\\\"$l\\\"\"; }
! elsif (($s[2] & 0170000) == 040000) { $l = \"t\"; }
! else { $l = \"nil\" };
! $u = ($n eq \"nil\") ? $s[4] : getpwuid($s[4]);
! $g = ($n eq \"nil\") ? $s[5] : getgrgid($s[5]);
! printf(\"(%s %u %s %s (%u %u) (%u %u) (%u %u) %u %u t (%u . %u) -1)\\n\",
! $l, $s[3], $u, $g, $s[8] >> 16 & 0xffff, $s[8] & 0xffff,
! $s[9] >> 16 & 0xffff, $s[9] & 0xffff, $s[10] >> 16 & 0xffff, $s[10] & 0xffff,
! $s[7], $s[2], $s[1] >> 16 & 0xffff, $s[1] & 0xffff);"
    "Perl script to produce output suitable for use with `file-attributes'
  on the remote file system.")
  
  ;; ;; These two use uu encoding.
  ;; (defvar tramp-perl-encode "%s -e'\
  ;; print qq(begin 644 xxx\n);
--- 1547,1638 ----
  ;; The device number is returned as "-1", because there will be a virtual
  ;; device number set in `tramp-handle-file-attributes'
  (defconst tramp-perl-file-attributes "\
! @stat = lstat($ARGV[0]);
! if (($stat[2] & 0170000) == 0120000)
! {
!     $type = readlink($ARGV[0]);
!     $type = \"\\\"$type\\\"\";
! }
! elsif (($stat[2] & 0170000) == 040000)
! {
!     $type = \"t\";
! }
! else
! {
!     $type = \"nil\"
! };
! $uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) . \"\\\"\";
! $gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) . \"\\\"\";
! printf(
!     \"(%s %u %s %s (%u %u) (%u %u) (%u %u) %u %u t (%u . %u) -1)\\n\",
!     $type,
!     $stat[3],
!     $uid,
!     $gid,
!     $stat[8] >> 16 & 0xffff,
!     $stat[8] & 0xffff,
!     $stat[9] >> 16 & 0xffff,
!     $stat[9] & 0xffff,
!     $stat[10] >> 16 & 0xffff,
!     $stat[10] & 0xffff,
!     $stat[7],
!     $stat[2],
!     $stat[1] >> 16 & 0xffff,
!     $stat[1] & 0xffff
! );"
    "Perl script to produce output suitable for use with `file-attributes'
  on the remote file system.")
  
+ (defconst tramp-perl-directory-files-and-attributes "\
+ chdir($ARGV[0]);
+ opendir(DIR,\".\");
+ @list = readdir(DIR);
+ closedir(DIR);
+ $n = scalar(@list);
+ printf(\"(\\n\");
+ for($i = 0; $i < $n; $i++)
+ {
+     $filename = $list[$i];
+     @stat = lstat($filename);
+     if (($stat[2] & 0170000) == 0120000)
+     {
+         $type = readlink($filename);
+         $type = \"\\\"$type\\\"\";
+     }
+     elsif (($stat[2] & 0170000) == 040000)
+     {
+         $type = \"t\";
+     }
+     else
+     {
+         $type = \"nil\"
+     };
+     $uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) . \"\\\"\";
+     $gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) . \"\\\"\";
+     printf(
+         \"(\\\"%s\\\" %s %u %s %s (%u %u) (%u %u) (%u %u) %u %u t (%u . %u) (%u %u))\\n\",
+         $filename,
+         $type,
+         $stat[3],
+         $uid,
+         $gid,
+         $stat[8] >> 16 & 0xffff,
+         $stat[8] & 0xffff,
+         $stat[9] >> 16 & 0xffff,
+         $stat[9] & 0xffff,
+         $stat[10] >> 16 & 0xffff,
+         $stat[10] & 0xffff,
+         $stat[7],
+         $stat[2],
+         $stat[1] >> 16 & 0xffff,
+         $stat[1] & 0xffff,
+         $stat[0] >> 16 & 0xffff,
+         $stat[0] & 0xffff);
+ }
+ printf(\")\\n\");"
+   "Perl script implementing `directory-files-attributes' as Lisp `read'able
+ output.")
+ 
  ;; ;; These two use uu encoding.
  ;; (defvar tramp-perl-encode "%s -e'\
  ;; print qq(begin 644 xxx\n);
***************
*** 1759,1766 ****
      (file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
      (file-attributes . tramp-handle-file-attributes)
      (file-modes . tramp-handle-file-modes)
-     (file-directory-files . tramp-handle-file-directory-files)
      (directory-files . tramp-handle-directory-files)
      (file-name-all-completions . tramp-handle-file-name-all-completions)
      (file-name-completion . tramp-handle-file-name-completion)
      (add-name-to-file . tramp-handle-add-name-to-file)
--- 1831,1838 ----
      (file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
      (file-attributes . tramp-handle-file-attributes)
      (file-modes . tramp-handle-file-modes)
      (directory-files . tramp-handle-directory-files)
+     (directory-files-and-attributes . tramp-handle-directory-files-and-attributes)
      (file-name-all-completions . tramp-handle-file-name-all-completions)
      (file-name-completion . tramp-handle-file-name-completion)
      (add-name-to-file . tramp-handle-add-name-to-file)
***************
*** 2170,2195 ****
  ;; Daniel Pittman <daniel@danann.net>
  (defun tramp-handle-file-attributes (filename &optional id-format)
    "Like `file-attributes' for tramp files."
!   (let ((nonnumeric (and id-format (equal id-format 'string)))
! 	result)
      (with-parsed-tramp-file-name filename nil
!       (when (file-exists-p filename)
! 	;; file exists, find out stuff
! 	(save-excursion
! 	  (if (tramp-get-remote-perl multi-method method user host)
! 	      (setq result
! 		    (tramp-handle-file-attributes-with-perl
! 		     multi-method method user host localname nonnumeric))
! 	    (setq result
! 		  (tramp-handle-file-attributes-with-ls
! 		   multi-method method user host localname nonnumeric)))
! 	  ;; set virtual device number
! 	  (setcar (nthcdr 11 result)
! 		  (tramp-get-device multi-method method user host)))))
!     result))
  
  (defun tramp-handle-file-attributes-with-ls
!   (multi-method method user host localname &optional nonnumeric)
    "Implement `file-attributes' for tramp files using the ls(1) command."
    (let (symlinkp dirp
  		 res-inode res-filemodes res-numlinks
--- 2242,2262 ----
  ;; Daniel Pittman <daniel@danann.net>
  (defun tramp-handle-file-attributes (filename &optional id-format)
    "Like `file-attributes' for tramp files."
!   (when (file-exists-p filename)
!     ;; file exists, find out stuff
!     (unless id-format (setq id-format 'integer))
      (with-parsed-tramp-file-name filename nil
!       (save-excursion
!         (tramp-convert-file-attributes
!          multi-method method user host
!          (if (tramp-get-remote-perl multi-method method user host)
!              (tramp-handle-file-attributes-with-perl multi-method method user host
!                                                      localname id-format)
!            (tramp-handle-file-attributes-with-ls multi-method method user host
!                                                  localname id-format)))))))
  
  (defun tramp-handle-file-attributes-with-ls
!   (multi-method method user host localname &optional id-format)
    "Implement `file-attributes' for tramp files using the ls(1) command."
    (let (symlinkp dirp
  		 res-inode res-filemodes res-numlinks
***************
*** 2202,2208 ****
       multi-method method user host
       (format "%s %s %s"
  	     (tramp-get-ls-command multi-method method user host)
! 	     (if nonnumeric "-ild" "-ildn")
  	     (tramp-shell-quote-argument localname)))
      (tramp-wait-for-output)
      ;; parse `ls -l' output ...
--- 2269,2275 ----
       multi-method method user host
       (format "%s %s %s"
  	     (tramp-get-ls-command multi-method method user host)
! 	     (if (eq id-format 'integer) "-ildn" "-ild")
  	     (tramp-shell-quote-argument localname)))
      (tramp-wait-for-output)
      ;; parse `ls -l' output ...
***************
*** 2229,2235 ****
      ;; ... uid and gid
      (setq res-uid (read (current-buffer)))
      (setq res-gid (read (current-buffer)))
!     (unless nonnumeric
        (unless (numberp res-uid) (setq res-uid -1))
        (unless (numberp res-gid) (setq res-gid -1)))
      ;; ... size
--- 2296,2302 ----
      ;; ... uid and gid
      (setq res-uid (read (current-buffer)))
      (setq res-gid (read (current-buffer)))
!     (when (eq id-format 'integer)
        (unless (numberp res-uid) (setq res-uid -1))
        (unless (numberp res-gid) (setq res-gid -1)))
      ;; ... size
***************
*** 2274,2306 ****
       )))
  
  (defun tramp-handle-file-attributes-with-perl
!   (multi-method method user host localname &optional nonnumeric)
!   "Implement `file-attributes' for tramp files using a Perl script.
! 
! The Perl command is sent to the remote machine when the connection
! is initially created and is kept cached by the remote shell."
    (tramp-message-for-buffer multi-method method user host 10
  			    "file attributes with perl: %s"
  			    (tramp-make-tramp-file-name
  			     multi-method method user host localname))
!   (tramp-send-command
!    multi-method method user host
!    (format "tramp_file_attributes %s %s"
! 	   (tramp-shell-quote-argument localname) nonnumeric))
    (tramp-wait-for-output)
!   (let ((result (read (current-buffer))))
!     (setcar (nthcdr 8 result)
! 	    (tramp-file-mode-from-int (nth 8 result)))
!     result))
! 
! (defun tramp-get-device (multi-method method user host)
!   "Returns the virtual device number.
! If it doesn't exist, generate a new one."
!   (let ((string (tramp-make-tramp-file-name multi-method method user host "")))
!     (unless (assoc string tramp-devices)
!       (add-to-list 'tramp-devices
! 		   (list string (length tramp-devices))))
!     (list -1 (nth 1 (assoc string tramp-devices)))))
  
  (defun tramp-handle-set-visited-file-modtime (&optional time-list)
    "Like `set-visited-file-modtime' for tramp files."
--- 2341,2360 ----
       )))
  
  (defun tramp-handle-file-attributes-with-perl
!   (multi-method method user host localname &optional id-format)
!   "Implement `file-attributes' for tramp files using a Perl script."
    (tramp-message-for-buffer multi-method method user host 10
  			    "file attributes with perl: %s"
  			    (tramp-make-tramp-file-name
  			     multi-method method user host localname))
!   (tramp-maybe-send-perl-script tramp-perl-file-attributes
!                                 "tramp_file_attributes"
!                                 multi-method method user host)
!   (tramp-send-command multi-method method user host
!                       (format "tramp_file_attributes %s %s"
!                               (tramp-shell-quote-argument localname) id-format))
    (tramp-wait-for-output)
!   (read (current-buffer)))
  
  (defun tramp-handle-set-visited-file-modtime (&optional time-list)
    "Like `set-visited-file-modtime' for tramp files."
***************
*** 2628,2633 ****
--- 2682,2719 ----
  		  (push item result)))))))
        result)))
  
+ (defun tramp-handle-directory-files-and-attributes
+   (directory &optional full match nosort id-format)
+   "Like `directory-files-and-attributes' for tramp files."
+   (when (tramp-handle-file-exists-p directory)
+     (save-excursion
+       (setq directory (tramp-handle-expand-file-name directory))
+       (with-parsed-tramp-file-name directory nil
+         (tramp-maybe-send-perl-script tramp-perl-directory-files-and-attributes
+                                       "tramp_directory_files_and_attributes"
+                                       multi-method method user host)
+         (tramp-send-command multi-method method user host
+                             (format "tramp_directory_files_and_attributes %s %s"
+                                     (tramp-shell-quote-argument localname)
+                                     (or id-format 'integer)))
+         (tramp-wait-for-output)
+         (let* ((root (cons nil (read (current-buffer))))
+                (cell root))
+           (while (cdr cell)
+             (if (and match (not (string-match match (caadr cell))))
+                 ;; Remove from list
+                 (setcdr cell (cddr cell))
+               ;; Include in list
+               (setq cell (cdr cell))
+               (let ((l (car cell)))
+                 (tramp-convert-file-attributes multi-method method user host
+                                                (cdr l))
+                 ;; If FULL, make file name absolute
+                 (when full (setcar l (concat directory "/" (car l)))))))
+           (if nosort
+               (cdr root)
+             (sort (cdr root) (lambda (x y) (string< (car x) (car y))))))))))
+ 
  ;; This function should return "foo/" for directories and "bar" for
  ;; files.  We use `ls -ad' to get a list of files (including
  ;; directories), and `find . -type d \! -name . -prune' to get a list
***************
*** 3186,3268 ****
  (defun tramp-handle-insert-directory
    (filename switches &optional wildcard full-directory-p)
    "Like `insert-directory' for tramp files."
!   ;; For the moment, we assume that the remote "ls" program does not
!   ;; grok "--dired".  In the future, we should detect this on
!   ;; connection setup.
!   (when (string-match "^--dired\\s-+" switches)
!     (setq switches (replace-match "" nil t switches)))
!   (setq filename (expand-file-name filename))
!   (with-parsed-tramp-file-name filename nil
!     (tramp-message-for-buffer
!      multi-method method user host 10
!      "Inserting directory `ls %s %s', wildcard %s, fulldir %s"
!      switches filename (if wildcard "yes" "no")
!      (if full-directory-p "yes" "no"))
!     (when wildcard
!       (setq wildcard (file-name-nondirectory localname))
!       (setq localname (file-name-directory localname)))
!     (when (listp switches)
!       (setq switches (mapconcat 'identity switches " ")))
!     (unless full-directory-p
!       (setq switches (concat "-d " switches)))
!     (when wildcard
!       (setq switches (concat switches " " wildcard)))
!     (save-excursion
!       ;; If `full-directory-p', we just say `ls -l FILENAME'.
!       ;; Else we chdir to the parent directory, then say `ls -ld BASENAME'.
!       (if full-directory-p
! 	  (tramp-send-command
! 	   multi-method method user host
! 	   (format "%s %s %s"
! 		   (tramp-get-ls-command multi-method method user host)
! 		   switches
! 		   (if wildcard
! 		       localname
! 		     (tramp-shell-quote-argument (concat localname ".")))))
! 	(tramp-barf-unless-okay
! 	 multi-method method user host
! 	 (format "cd %s" (tramp-shell-quote-argument
! 			  (file-name-directory localname)))
! 	 nil 'file-error
! 	 "Couldn't `cd %s'"
! 	 (tramp-shell-quote-argument (file-name-directory localname)))
! 	(tramp-send-command
! 	 multi-method method user host
! 	 (format "%s %s %s"
! 		 (tramp-get-ls-command multi-method method user host)
! 		 switches
! 		 (if wildcard
! 		     localname
! 		   (tramp-shell-quote-argument
! 		    (file-name-nondirectory localname))))))
!       (sit-for 1)			;needed for rsh but not ssh?
!       (tramp-wait-for-output))
!     ;; The following let-binding is used by code that's commented
!     ;; out.  Let's leave the let-binding in for a while to see
!     ;; that the commented-out code is really not needed.  Commenting-out
!     ;; happened on 2003-03-13.
!     (let ((old-pos (point)))
!       (insert-buffer-substring
!        (tramp-get-buffer multi-method method user host))
!       ;; On XEmacs, we want to call (exchange-point-and-mark t), but
!       ;; that doesn't exist on Emacs, so we use this workaround instead.
!       ;; Since zmacs-region-stays doesn't exist in Emacs, this ought to
!       ;; be safe.  Thanks to Daniel Pittman <daniel@danann.net>.
!       ;;     (let ((zmacs-region-stays t))
!       ;;       (exchange-point-and-mark))
        (save-excursion
! 	(tramp-send-command multi-method method user host "cd")
! 	(tramp-wait-for-output))
!       ;; For the time being, the XEmacs kludge is commented out.
!       ;; Please test it on various XEmacs versions to see if it works.
! ;;       ;; Another XEmacs specialty follows.  What's the right way to do
! ;;       ;; it?
! ;;       (when (and (featurep 'xemacs)
! ;; 		 (eq major-mode 'dired-mode))
! ;; 	(save-excursion
! ;; 	  (require 'dired)
! ;; 	  (dired-insert-set-properties old-pos (point))))
!       )))
  
  ;; Continuation of kluge to pacify byte-compiler.
  ;;(eval-when-compile
--- 3272,3358 ----
  (defun tramp-handle-insert-directory
    (filename switches &optional wildcard full-directory-p)
    "Like `insert-directory' for tramp files."
!   (if (and (boundp 'ls-lisp-use-insert-directory-program)
!            (not ls-lisp-use-insert-directory-program))
!       (tramp-run-real-handler 'insert-directory
!                               (list filename switches wildcard full-directory-p))
!     ;; For the moment, we assume that the remote "ls" program does not
!     ;; grok "--dired".  In the future, we should detect this on
!     ;; connection setup.
!     (when (string-match "^--dired\\s-+" switches)
!       (setq switches (replace-match "" nil t switches)))
!     (setq filename (expand-file-name filename))
!     (with-parsed-tramp-file-name filename nil
!       (tramp-message-for-buffer
!        multi-method method user host 10
!        "Inserting directory `ls %s %s', wildcard %s, fulldir %s"
!        switches filename (if wildcard "yes" "no")
!        (if full-directory-p "yes" "no"))
!       (when wildcard
!         (setq wildcard (file-name-nondirectory localname))
!         (setq localname (file-name-directory localname)))
!       (when (listp switches)
!         (setq switches (mapconcat 'identity switches " ")))
!       (unless full-directory-p
!         (setq switches (concat "-d " switches)))
!       (when wildcard
!         (setq switches (concat switches " " wildcard)))
        (save-excursion
!         ;; If `full-directory-p', we just say `ls -l FILENAME'.
!         ;; Else we chdir to the parent directory, then say `ls -ld BASENAME'.
!         (if full-directory-p
!             (tramp-send-command
!              multi-method method user host
!              (format "%s %s %s"
!                      (tramp-get-ls-command multi-method method user host)
!                      switches
!                      (if wildcard
!                          localname
!                        (tramp-shell-quote-argument (concat localname ".")))))
!           (tramp-barf-unless-okay
!            multi-method method user host
!            (format "cd %s" (tramp-shell-quote-argument
!                             (file-name-directory localname)))
!            nil 'file-error
!            "Couldn't `cd %s'"
!            (tramp-shell-quote-argument (file-name-directory localname)))
!           (tramp-send-command
!            multi-method method user host
!            (format "%s %s %s"
!                    (tramp-get-ls-command multi-method method user host)
!                    switches
!                    (if wildcard
!                        localname
!                      (tramp-shell-quote-argument
!                       (file-name-nondirectory localname))))))
!         (sit-for 1)			;needed for rsh but not ssh?
!         (tramp-wait-for-output))
!       ;; The following let-binding is used by code that's commented
!       ;; out.  Let's leave the let-binding in for a while to see
!       ;; that the commented-out code is really not needed.  Commenting-out
!       ;; happened on 2003-03-13.
!       (let ((old-pos (point)))
!         (insert-buffer-substring
!          (tramp-get-buffer multi-method method user host))
!         ;; On XEmacs, we want to call (exchange-point-and-mark t), but
!         ;; that doesn't exist on Emacs, so we use this workaround instead.
!         ;; Since zmacs-region-stays doesn't exist in Emacs, this ought to
!         ;; be safe.  Thanks to Daniel Pittman <daniel@danann.net>.
!         ;;     (let ((zmacs-region-stays t))
!         ;;       (exchange-point-and-mark))
!         (save-excursion
!           (tramp-send-command multi-method method user host "cd")
!           (tramp-wait-for-output))
!         ;; For the time being, the XEmacs kludge is commented out.
!         ;; Please test it on various XEmacs versions to see if it works.
!         ;;       ;; Another XEmacs specialty follows.  What's the right way to do
!         ;;       ;; it?
!         ;;       (when (and (featurep 'xemacs)
!         ;; 		 (eq major-mode 'dired-mode))
!         ;; 	(save-excursion
!         ;; 	  (require 'dired)
!         ;; 	  (dired-insert-set-properties old-pos (point))))
!         ))))
  
  ;; Continuation of kluge to pacify byte-compiler.
  ;;(eval-when-compile
***************
*** 4679,4684 ****
--- 4769,4797 ----
  
  ;;; Internal Functions:
  
+ (defun tramp-maybe-send-perl-script (script name multi-method method user host)
+   "Define in remote shell function NAME implemented as perl SCRIPT.
+ Only send the definition if it has not already been done.
+ Function may have 0-3 parameters."
+   (let ((remote-perl (tramp-get-remote-perl multi-method method user host)))
+     (unless remote-perl (error "No remote perl"))
+     (let ((perl-scripts (tramp-get-connection-property "perl-scripts" nil
+                                                        multi-method method user host)))
+       (unless (memq name perl-scripts)
+         (with-current-buffer (tramp-get-buffer multi-method method user host)
+           (tramp-message 5 (concat "Sending the Perl script `" name "'..."))
+           (tramp-send-string multi-method method user host
+                              (concat name
+                                      " () {\n"
+                                      remote-perl
+                                      " -e '"
+                                      script
+                                      "' \"$1\" \"$2\" \"$3\" 2>/dev/null\n}"))
+           (tramp-wait-for-output)
+           (tramp-set-connection-property "perl-scripts" (cons name perl-scripts)
+                                          multi-method method user host)
+           (tramp-message 5 (concat "Sending the Perl script `" name "'...done.")))))))
+ 
  (defun tramp-set-auto-save ()
    (when (and (buffer-file-name)
               (tramp-tramp-file-p (buffer-file-name))
***************
*** 5859,5864 ****
--- 5972,5978 ----
    (tramp-wait-for-output)
    ;; Find a `perl'.
    (erase-buffer)
+   (tramp-set-connection-property "perl-scripts" nil multi-method method user host)
    (let ((tramp-remote-perl
  	 (or (tramp-find-executable multi-method method user host
  				    "perl5" tramp-remote-path nil)
***************
*** 5867,5914 ****
      (when tramp-remote-perl
        (tramp-set-connection-property "perl" tramp-remote-perl
  				     multi-method method user host)
!       ;; Set up stat in Perl if we can.
!       (when tramp-remote-perl
! 	(tramp-message 5 "Sending the Perl `file-attributes' implementation.")
! 	(tramp-send-string
! 	 multi-method method user host
! 	 (concat "tramp_file_attributes () {\n"
! 		 tramp-remote-perl
! 		 " -e '" tramp-perl-file-attributes "'"
! 		 " \"$1\" \"$2\" 2>/dev/null\n"
! 		 "}"))
! 	(tramp-wait-for-output)
! 	(unless (tramp-method-out-of-band-p multi-method method user host)
! 	  (tramp-message 5 "Sending the Perl `mime-encode' implementations.")
! 	  (tramp-send-string
! 	   multi-method method user host
! 	   (concat "tramp_encode () {\n"
! 		   (format tramp-perl-encode tramp-remote-perl)
! 		   " 2>/dev/null"
! 		   "\n}"))
! 	  (tramp-wait-for-output)
! 	  (tramp-send-string
! 	   multi-method method user host
! 	   (concat "tramp_encode_with_module () {\n"
! 		   (format tramp-perl-encode-with-module tramp-remote-perl)
! 		   " 2>/dev/null"
! 		   "\n}"))
! 	  (tramp-wait-for-output)
! 	  (tramp-message 5 "Sending the Perl `mime-decode' implementations.")
! 	  (tramp-send-string
! 	   multi-method method user host
! 	   (concat "tramp_decode () {\n"
! 		   (format tramp-perl-decode tramp-remote-perl)
! 		   " 2>/dev/null"
! 		   "\n}"))
! 	  (tramp-wait-for-output)
! 	  (tramp-send-string
! 	   multi-method method user host
! 	   (concat "tramp_decode_with_module () {\n"
! 		   (format tramp-perl-decode-with-module tramp-remote-perl)
! 		   " 2>/dev/null"
! 		   "\n}"))
! 	  (tramp-wait-for-output)))))
    ;; Find ln(1)
    (erase-buffer)
    (let ((ln (tramp-find-executable multi-method method user host
--- 5981,6017 ----
      (when tramp-remote-perl
        (tramp-set-connection-property "perl" tramp-remote-perl
  				     multi-method method user host)
!       (unless (tramp-method-out-of-band-p multi-method method user host)
!         (tramp-message 5 "Sending the Perl `mime-encode' implementations.")
!         (tramp-send-string
!          multi-method method user host
!          (concat "tramp_encode () {\n"
!                  (format tramp-perl-encode tramp-remote-perl)
!                  " 2>/dev/null"
!                  "\n}"))
!         (tramp-wait-for-output)
!         (tramp-send-string
!          multi-method method user host
!          (concat "tramp_encode_with_module () {\n"
!                  (format tramp-perl-encode-with-module tramp-remote-perl)
!                  " 2>/dev/null"
!                  "\n}"))
!         (tramp-wait-for-output)
!         (tramp-message 5 "Sending the Perl `mime-decode' implementations.")
!         (tramp-send-string
!          multi-method method user host
!          (concat "tramp_decode () {\n"
!                  (format tramp-perl-decode tramp-remote-perl)
!                  " 2>/dev/null"
!                  "\n}"))
!         (tramp-wait-for-output)
!         (tramp-send-string
!          multi-method method user host
!          (concat "tramp_decode_with_module () {\n"
!                  (format tramp-perl-decode-with-module tramp-remote-perl)
!                  " 2>/dev/null"
!                  "\n}"))
!         (tramp-wait-for-output))))
    ;; Find ln(1)
    (erase-buffer)
    (let ((ln (tramp-find-executable multi-method method user host
***************
*** 6417,6422 ****
--- 6520,6550 ----
           (t (error "Tenth char `%c' must be one of `xtT-'"
                     other-execute-or-sticky)))))))
  
+ (defun tramp-convert-file-attributes (multi-method method user host attr)
+   "Convert file-attributes ATTR generated by perl script or ls.
+ Convert file mode bits to string, add tramp prefix to absolute symlink
+ and set virtual device number. Return ATTR."
+   (unless (stringp (nth 8 attr))
+     ;; Convert file mode bits to string.
+     (setcar (nthcdr 8 attr) (tramp-file-mode-from-int (nth 8 attr))))
+   (when (and (stringp (car attr)) (file-name-absolute-p (car attr)))
+     ;; Add tramp prefix to absolute symlink.
+     (setcar attr
+             (tramp-make-tramp-file-name multi-method method user host
+                                         (car attr))))
+   ;; Set virtual device number.
+   (setcar (nthcdr 11 attr)
+           (tramp-get-device multi-method method user host))
+   attr)
+ 
+ (defun tramp-get-device (multi-method method user host)
+   "Returns the virtual device number.
+ If it doesn't exist, generate a new one."
+   (let ((string (tramp-make-tramp-file-name multi-method method user host "")))
+     (unless (assoc string tramp-devices)
+       (add-to-list 'tramp-devices
+ 		   (list string (length tramp-devices))))
+     (list -1 (nth 1 (assoc string tramp-devices)))))
  
  (defun tramp-file-mode-from-int (mode)
    "Turn an integer representing a file mode into an ls(1)-like string."

[-- Attachment #3: Type: text/plain, Size: 142 bytes --]

_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-devel

^ permalink raw reply	[flat|nested] 2+ messages in thread

end of thread, other threads:[~2004-11-27  7:39 UTC | newest]

Thread overview: 2+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2004-11-14 12:32 [patch] Tramp and file attributes Lars Hansen
2004-11-27  7:39 ` Lars Hansen

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).