Mercurial > emacs
diff lisp/net/tramp.el @ 58540:d3f76ef9ad46
(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.
| author | Lars Hansen <larsh@soem.dk> |
|---|---|
| date | Fri, 26 Nov 2004 21:39:02 +0000 |
| parents | f15a720d0f24 |
| children | f8de46cb073f |
line wrap: on
line diff
--- a/lisp/net/tramp.el Fri Nov 26 17:45:17 2004 +0000 +++ b/lisp/net/tramp.el Fri Nov 26 21:39:02 2004 +0000 @@ -1547,20 +1547,92 @@ ;; 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 @@ (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 @@ ;; 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 @@ 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 @@ ;; ... 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 @@ ))) (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 @@ (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 @@ (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 @@ ;;; 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 @@ (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 @@ (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 @@ (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."