mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-05 11:45:45 +00:00
(tramp-handle-directory-files-and-attributes): New function.
(tramp-perl-directory-files-and-attributes): New constant. (tramp-file-name-handler-alist): Delete file-directory-files, add directory-files-and-attributes. (tramp-perl-file-attributes): Surround uid and gid by double quotes. Change parameter id-format from nonnumeric. (tramp-convert-file-attributes): New function. (tramp-handle-file-attributes): Use it. (tramp-maybe-send-perl-script): New function. (tramp-handle-file-attributes-with-perl): Use it. Don't convert file mode. Change parameter id-format from nonnumeric. (tramp-handle-file-attributes-with-ls): Change parameter id-format from nonnumeric. (tramp-post-connection): Don't send tramp-perl-file-attributes script. Reset connection property "perl-scripts". (tramp-handle-insert-directory): Run real handler when ls-lisp is in use.
This commit is contained in:
Lars Hansen
parent
3a0ab7ecf3
commit
c82c572724
@ -1,3 +1,24 @@
|
||||
2004-11-26 Lars Hansen <larsh@math.ku.dk>
|
||||
|
||||
* tramp.el (tramp-handle-directory-files-and-attributes): New
|
||||
function.
|
||||
(tramp-perl-directory-files-and-attributes): New constant.
|
||||
(tramp-file-name-handler-alist): Delete file-directory-files, add
|
||||
directory-files-and-attributes.
|
||||
(tramp-perl-file-attributes): Surround uid and gid by double
|
||||
quotes. Change parameter id-format from nonnumeric.
|
||||
(tramp-convert-file-attributes): New function.
|
||||
(tramp-handle-file-attributes): Use it.
|
||||
(tramp-maybe-send-perl-script): New function.
|
||||
(tramp-handle-file-attributes-with-perl): Use it. Don't convert
|
||||
file mode. Change parameter id-format from nonnumeric.
|
||||
(tramp-handle-file-attributes-with-ls): Change parameter id-format
|
||||
from nonnumeric.
|
||||
(tramp-post-connection): Don't send tramp-perl-file-attributes
|
||||
script. Reset connection property "perl-scripts".
|
||||
(tramp-handle-insert-directory): Run real handler when ls-lisp is
|
||||
in use.
|
||||
|
||||
2004-11-26 Lars Hansen <larsh@math.ku.dk>
|
||||
|
||||
* desktop.el (desktop-read): Replace mapcar with mapc.
|
||||
|
||||
@ -1547,20 +1547,92 @@ them we have this shell function.")
|
||||
;; 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);"
|
||||
@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,8 +1831,8 @@ on the FILENAME argument, even if VISIT was a string.")
|
||||
(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)
|
||||
(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,26 +2242,21 @@ target of the symlink differ."
|
||||
;; 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)
|
||||
(when (file-exists-p filename)
|
||||
;; file exists, find out stuff
|
||||
(unless id-format (setq id-format 'integer))
|
||||
(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))
|
||||
(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 nonnumeric)
|
||||
(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,7 +2269,7 @@ target of the symlink differ."
|
||||
multi-method method user host
|
||||
(format "%s %s %s"
|
||||
(tramp-get-ls-command multi-method method user host)
|
||||
(if nonnumeric "-ild" "-ildn")
|
||||
(if (eq id-format 'integer) "-ildn" "-ild")
|
||||
(tramp-shell-quote-argument localname)))
|
||||
(tramp-wait-for-output)
|
||||
;; parse `ls -l' output ...
|
||||
@ -2229,7 +2296,7 @@ target of the symlink differ."
|
||||
;; ... uid and gid
|
||||
(setq res-uid (read (current-buffer)))
|
||||
(setq res-gid (read (current-buffer)))
|
||||
(unless nonnumeric
|
||||
(when (eq id-format 'integer)
|
||||
(unless (numberp res-uid) (setq res-uid -1))
|
||||
(unless (numberp res-gid) (setq res-gid -1)))
|
||||
;; ... size
|
||||
@ -2274,33 +2341,20 @@ target of the symlink differ."
|
||||
)))
|
||||
|
||||
(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."
|
||||
(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-send-command
|
||||
multi-method method user host
|
||||
(format "tramp_file_attributes %s %s"
|
||||
(tramp-shell-quote-argument localname) nonnumeric))
|
||||
(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)
|
||||
(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)))))
|
||||
(read (current-buffer)))
|
||||
|
||||
(defun tramp-handle-set-visited-file-modtime (&optional time-list)
|
||||
"Like `set-visited-file-modtime' for tramp files."
|
||||
@ -2628,6 +2682,38 @@ if the remote host can't provide the modtime."
|
||||
(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,83 +3272,87 @@ This is like `dired-recursive-delete-directory' for tramp files."
|
||||
(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))
|
||||
(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
|
||||
(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))))
|
||||
)))
|
||||
;; 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,6 +4769,29 @@ User may be nil."
|
||||
|
||||
;;; 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,6 +5972,7 @@ locale to C and sets up the remote shell search path."
|
||||
(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,48 +5981,37 @@ locale to C and sets up the remote shell search path."
|
||||
(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)))))
|
||||
(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,6 +6520,26 @@ If `tramp-discard-garbage' is nil, just erase buffer."
|
||||
(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 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))))
|
||||
;; 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."
|
||||
|
||||
Loading…
Reference in New Issue
Block a user