;; 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);
(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)
;; 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
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 ...
;; ... 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
)))
(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."
(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
(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
;;; 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))
(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)
(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
(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."