* [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
* Re: [patch] Tramp and file attributes
2004-11-14 12:32 [patch] Tramp and file attributes Lars Hansen
@ 2004-11-27 7:39 ` Lars Hansen
0 siblings, 0 replies; 2+ messages in thread
From: Lars Hansen @ 2004-11-27 7:39 UTC (permalink / raw)
Cc: Kai Großjohann, Michael Albinus
FYI: Yesterday I installed my patch. So
now directory-files-and-attributes and ls-lisp works with Tramp when the
remote system has perl.
The changes does not add tramp prefix to absolute symlinks as I wrote in
my last mail -- that was a bad idea.
^ 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 external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.