1547 |
;; The device number is returned as "-1", because there will be a virtual |
;; The device number is returned as "-1", because there will be a virtual |
1548 |
;; device number set in `tramp-handle-file-attributes' |
;; device number set in `tramp-handle-file-attributes' |
1549 |
(defconst tramp-perl-file-attributes "\ |
(defconst tramp-perl-file-attributes "\ |
1550 |
\($f, $n) = @ARGV; |
@stat = lstat($ARGV[0]); |
1551 |
@s = lstat($f); |
if (($stat[2] & 0170000) == 0120000) |
1552 |
if (($s[2] & 0170000) == 0120000) { $l = readlink($f); $l = \"\\\"$l\\\"\"; } |
{ |
1553 |
elsif (($s[2] & 0170000) == 040000) { $l = \"t\"; } |
$type = readlink($ARGV[0]); |
1554 |
else { $l = \"nil\" }; |
$type = \"\\\"$type\\\"\"; |
1555 |
$u = ($n eq \"nil\") ? $s[4] : getpwuid($s[4]); |
} |
1556 |
$g = ($n eq \"nil\") ? $s[5] : getgrgid($s[5]); |
elsif (($stat[2] & 0170000) == 040000) |
1557 |
printf(\"(%s %u %s %s (%u %u) (%u %u) (%u %u) %u %u t (%u . %u) -1)\\n\", |
{ |
1558 |
$l, $s[3], $u, $g, $s[8] >> 16 & 0xffff, $s[8] & 0xffff, |
$type = \"t\"; |
1559 |
$s[9] >> 16 & 0xffff, $s[9] & 0xffff, $s[10] >> 16 & 0xffff, $s[10] & 0xffff, |
} |
1560 |
$s[7], $s[2], $s[1] >> 16 & 0xffff, $s[1] & 0xffff);" |
else |
1561 |
|
{ |
1562 |
|
$type = \"nil\" |
1563 |
|
}; |
1564 |
|
$uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) . \"\\\"\"; |
1565 |
|
$gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) . \"\\\"\"; |
1566 |
|
printf( |
1567 |
|
\"(%s %u %s %s (%u %u) (%u %u) (%u %u) %u %u t (%u . %u) -1)\\n\", |
1568 |
|
$type, |
1569 |
|
$stat[3], |
1570 |
|
$uid, |
1571 |
|
$gid, |
1572 |
|
$stat[8] >> 16 & 0xffff, |
1573 |
|
$stat[8] & 0xffff, |
1574 |
|
$stat[9] >> 16 & 0xffff, |
1575 |
|
$stat[9] & 0xffff, |
1576 |
|
$stat[10] >> 16 & 0xffff, |
1577 |
|
$stat[10] & 0xffff, |
1578 |
|
$stat[7], |
1579 |
|
$stat[2], |
1580 |
|
$stat[1] >> 16 & 0xffff, |
1581 |
|
$stat[1] & 0xffff |
1582 |
|
);" |
1583 |
"Perl script to produce output suitable for use with `file-attributes' |
"Perl script to produce output suitable for use with `file-attributes' |
1584 |
on the remote file system.") |
on the remote file system.") |
1585 |
|
|
1586 |
|
(defconst tramp-perl-directory-files-and-attributes "\ |
1587 |
|
chdir($ARGV[0]); |
1588 |
|
opendir(DIR,\".\"); |
1589 |
|
@list = readdir(DIR); |
1590 |
|
closedir(DIR); |
1591 |
|
$n = scalar(@list); |
1592 |
|
printf(\"(\\n\"); |
1593 |
|
for($i = 0; $i < $n; $i++) |
1594 |
|
{ |
1595 |
|
$filename = $list[$i]; |
1596 |
|
@stat = lstat($filename); |
1597 |
|
if (($stat[2] & 0170000) == 0120000) |
1598 |
|
{ |
1599 |
|
$type = readlink($filename); |
1600 |
|
$type = \"\\\"$type\\\"\"; |
1601 |
|
} |
1602 |
|
elsif (($stat[2] & 0170000) == 040000) |
1603 |
|
{ |
1604 |
|
$type = \"t\"; |
1605 |
|
} |
1606 |
|
else |
1607 |
|
{ |
1608 |
|
$type = \"nil\" |
1609 |
|
}; |
1610 |
|
$uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) . \"\\\"\"; |
1611 |
|
$gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) . \"\\\"\"; |
1612 |
|
printf( |
1613 |
|
\"(\\\"%s\\\" %s %u %s %s (%u %u) (%u %u) (%u %u) %u %u t (%u . %u) (%u %u))\\n\", |
1614 |
|
$filename, |
1615 |
|
$type, |
1616 |
|
$stat[3], |
1617 |
|
$uid, |
1618 |
|
$gid, |
1619 |
|
$stat[8] >> 16 & 0xffff, |
1620 |
|
$stat[8] & 0xffff, |
1621 |
|
$stat[9] >> 16 & 0xffff, |
1622 |
|
$stat[9] & 0xffff, |
1623 |
|
$stat[10] >> 16 & 0xffff, |
1624 |
|
$stat[10] & 0xffff, |
1625 |
|
$stat[7], |
1626 |
|
$stat[2], |
1627 |
|
$stat[1] >> 16 & 0xffff, |
1628 |
|
$stat[1] & 0xffff, |
1629 |
|
$stat[0] >> 16 & 0xffff, |
1630 |
|
$stat[0] & 0xffff); |
1631 |
|
} |
1632 |
|
printf(\")\\n\");" |
1633 |
|
"Perl script implementing `directory-files-attributes' as Lisp `read'able |
1634 |
|
output.") |
1635 |
|
|
1636 |
;; ;; These two use uu encoding. |
;; ;; These two use uu encoding. |
1637 |
;; (defvar tramp-perl-encode "%s -e'\ |
;; (defvar tramp-perl-encode "%s -e'\ |
1638 |
;; print qq(begin 644 xxx\n); |
;; print qq(begin 644 xxx\n); |
1831 |
(file-newer-than-file-p . tramp-handle-file-newer-than-file-p) |
(file-newer-than-file-p . tramp-handle-file-newer-than-file-p) |
1832 |
(file-attributes . tramp-handle-file-attributes) |
(file-attributes . tramp-handle-file-attributes) |
1833 |
(file-modes . tramp-handle-file-modes) |
(file-modes . tramp-handle-file-modes) |
|
(file-directory-files . tramp-handle-file-directory-files) |
|
1834 |
(directory-files . tramp-handle-directory-files) |
(directory-files . tramp-handle-directory-files) |
1835 |
|
(directory-files-and-attributes . tramp-handle-directory-files-and-attributes) |
1836 |
(file-name-all-completions . tramp-handle-file-name-all-completions) |
(file-name-all-completions . tramp-handle-file-name-all-completions) |
1837 |
(file-name-completion . tramp-handle-file-name-completion) |
(file-name-completion . tramp-handle-file-name-completion) |
1838 |
(add-name-to-file . tramp-handle-add-name-to-file) |
(add-name-to-file . tramp-handle-add-name-to-file) |
2242 |
;; Daniel Pittman <daniel@danann.net> |
;; Daniel Pittman <daniel@danann.net> |
2243 |
(defun tramp-handle-file-attributes (filename &optional id-format) |
(defun tramp-handle-file-attributes (filename &optional id-format) |
2244 |
"Like `file-attributes' for tramp files." |
"Like `file-attributes' for tramp files." |
2245 |
(let ((nonnumeric (and id-format (equal id-format 'string))) |
(when (file-exists-p filename) |
2246 |
result) |
;; file exists, find out stuff |
2247 |
|
(unless id-format (setq id-format 'integer)) |
2248 |
(with-parsed-tramp-file-name filename nil |
(with-parsed-tramp-file-name filename nil |
2249 |
(when (file-exists-p filename) |
(save-excursion |
2250 |
;; file exists, find out stuff |
(tramp-convert-file-attributes |
2251 |
(save-excursion |
multi-method method user host |
2252 |
(if (tramp-get-remote-perl multi-method method user host) |
(if (tramp-get-remote-perl multi-method method user host) |
2253 |
(setq result |
(tramp-handle-file-attributes-with-perl multi-method method user host |
2254 |
(tramp-handle-file-attributes-with-perl |
localname id-format) |
2255 |
multi-method method user host localname nonnumeric)) |
(tramp-handle-file-attributes-with-ls multi-method method user host |
2256 |
(setq result |
localname id-format))))))) |
|
(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)) |
|
2257 |
|
|
2258 |
(defun tramp-handle-file-attributes-with-ls |
(defun tramp-handle-file-attributes-with-ls |
2259 |
(multi-method method user host localname &optional nonnumeric) |
(multi-method method user host localname &optional id-format) |
2260 |
"Implement `file-attributes' for tramp files using the ls(1) command." |
"Implement `file-attributes' for tramp files using the ls(1) command." |
2261 |
(let (symlinkp dirp |
(let (symlinkp dirp |
2262 |
res-inode res-filemodes res-numlinks |
res-inode res-filemodes res-numlinks |
2269 |
multi-method method user host |
multi-method method user host |
2270 |
(format "%s %s %s" |
(format "%s %s %s" |
2271 |
(tramp-get-ls-command multi-method method user host) |
(tramp-get-ls-command multi-method method user host) |
2272 |
(if nonnumeric "-ild" "-ildn") |
(if (eq id-format 'integer) "-ildn" "-ild") |
2273 |
(tramp-shell-quote-argument localname))) |
(tramp-shell-quote-argument localname))) |
2274 |
(tramp-wait-for-output) |
(tramp-wait-for-output) |
2275 |
;; parse `ls -l' output ... |
;; parse `ls -l' output ... |
2296 |
;; ... uid and gid |
;; ... uid and gid |
2297 |
(setq res-uid (read (current-buffer))) |
(setq res-uid (read (current-buffer))) |
2298 |
(setq res-gid (read (current-buffer))) |
(setq res-gid (read (current-buffer))) |
2299 |
(unless nonnumeric |
(when (eq id-format 'integer) |
2300 |
(unless (numberp res-uid) (setq res-uid -1)) |
(unless (numberp res-uid) (setq res-uid -1)) |
2301 |
(unless (numberp res-gid) (setq res-gid -1))) |
(unless (numberp res-gid) (setq res-gid -1))) |
2302 |
;; ... size |
;; ... size |
2341 |
))) |
))) |
2342 |
|
|
2343 |
(defun tramp-handle-file-attributes-with-perl |
(defun tramp-handle-file-attributes-with-perl |
2344 |
(multi-method method user host localname &optional nonnumeric) |
(multi-method method user host localname &optional id-format) |
2345 |
"Implement `file-attributes' for tramp files using a Perl script. |
"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." |
|
2346 |
(tramp-message-for-buffer multi-method method user host 10 |
(tramp-message-for-buffer multi-method method user host 10 |
2347 |
"file attributes with perl: %s" |
"file attributes with perl: %s" |
2348 |
(tramp-make-tramp-file-name |
(tramp-make-tramp-file-name |
2349 |
multi-method method user host localname)) |
multi-method method user host localname)) |
2350 |
(tramp-send-command |
(tramp-maybe-send-perl-script tramp-perl-file-attributes |
2351 |
multi-method method user host |
"tramp_file_attributes" |
2352 |
(format "tramp_file_attributes %s %s" |
multi-method method user host) |
2353 |
(tramp-shell-quote-argument localname) nonnumeric)) |
(tramp-send-command multi-method method user host |
2354 |
|
(format "tramp_file_attributes %s %s" |
2355 |
|
(tramp-shell-quote-argument localname) id-format)) |
2356 |
(tramp-wait-for-output) |
(tramp-wait-for-output) |
2357 |
(let ((result (read (current-buffer)))) |
(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))))) |
|
2358 |
|
|
2359 |
(defun tramp-handle-set-visited-file-modtime (&optional time-list) |
(defun tramp-handle-set-visited-file-modtime (&optional time-list) |
2360 |
"Like `set-visited-file-modtime' for tramp files." |
"Like `set-visited-file-modtime' for tramp files." |
2682 |
(push item result))))))) |
(push item result))))))) |
2683 |
result))) |
result))) |
2684 |
|
|
2685 |
|
(defun tramp-handle-directory-files-and-attributes |
2686 |
|
(directory &optional full match nosort id-format) |
2687 |
|
"Like `directory-files-and-attributes' for tramp files." |
2688 |
|
(when (tramp-handle-file-exists-p directory) |
2689 |
|
(save-excursion |
2690 |
|
(setq directory (tramp-handle-expand-file-name directory)) |
2691 |
|
(with-parsed-tramp-file-name directory nil |
2692 |
|
(tramp-maybe-send-perl-script tramp-perl-directory-files-and-attributes |
2693 |
|
"tramp_directory_files_and_attributes" |
2694 |
|
multi-method method user host) |
2695 |
|
(tramp-send-command multi-method method user host |
2696 |
|
(format "tramp_directory_files_and_attributes %s %s" |
2697 |
|
(tramp-shell-quote-argument localname) |
2698 |
|
(or id-format 'integer))) |
2699 |
|
(tramp-wait-for-output) |
2700 |
|
(let* ((root (cons nil (read (current-buffer)))) |
2701 |
|
(cell root)) |
2702 |
|
(while (cdr cell) |
2703 |
|
(if (and match (not (string-match match (caadr cell)))) |
2704 |
|
;; Remove from list |
2705 |
|
(setcdr cell (cddr cell)) |
2706 |
|
;; Include in list |
2707 |
|
(setq cell (cdr cell)) |
2708 |
|
(let ((l (car cell))) |
2709 |
|
(tramp-convert-file-attributes multi-method method user host |
2710 |
|
(cdr l)) |
2711 |
|
;; If FULL, make file name absolute |
2712 |
|
(when full (setcar l (concat directory "/" (car l))))))) |
2713 |
|
(if nosort |
2714 |
|
(cdr root) |
2715 |
|
(sort (cdr root) (lambda (x y) (string< (car x) (car y)))))))))) |
2716 |
|
|
2717 |
;; This function should return "foo/" for directories and "bar" for |
;; This function should return "foo/" for directories and "bar" for |
2718 |
;; files. We use `ls -ad' to get a list of files (including |
;; files. We use `ls -ad' to get a list of files (including |
2719 |
;; directories), and `find . -type d \! -name . -prune' to get a list |
;; directories), and `find . -type d \! -name . -prune' to get a list |
3272 |
(defun tramp-handle-insert-directory |
(defun tramp-handle-insert-directory |
3273 |
(filename switches &optional wildcard full-directory-p) |
(filename switches &optional wildcard full-directory-p) |
3274 |
"Like `insert-directory' for tramp files." |
"Like `insert-directory' for tramp files." |
3275 |
;; For the moment, we assume that the remote "ls" program does not |
(if (and (boundp 'ls-lisp-use-insert-directory-program) |
3276 |
;; grok "--dired". In the future, we should detect this on |
(not ls-lisp-use-insert-directory-program)) |
3277 |
;; connection setup. |
(tramp-run-real-handler 'insert-directory |
3278 |
(when (string-match "^--dired\\s-+" switches) |
(list filename switches wildcard full-directory-p)) |
3279 |
(setq switches (replace-match "" nil t switches))) |
;; For the moment, we assume that the remote "ls" program does not |
3280 |
(setq filename (expand-file-name filename)) |
;; grok "--dired". In the future, we should detect this on |
3281 |
(with-parsed-tramp-file-name filename nil |
;; connection setup. |
3282 |
(tramp-message-for-buffer |
(when (string-match "^--dired\\s-+" switches) |
3283 |
multi-method method user host 10 |
(setq switches (replace-match "" nil t switches))) |
3284 |
"Inserting directory `ls %s %s', wildcard %s, fulldir %s" |
(setq filename (expand-file-name filename)) |
3285 |
switches filename (if wildcard "yes" "no") |
(with-parsed-tramp-file-name filename nil |
3286 |
(if full-directory-p "yes" "no")) |
(tramp-message-for-buffer |
3287 |
(when wildcard |
multi-method method user host 10 |
3288 |
(setq wildcard (file-name-nondirectory localname)) |
"Inserting directory `ls %s %s', wildcard %s, fulldir %s" |
3289 |
(setq localname (file-name-directory localname))) |
switches filename (if wildcard "yes" "no") |
3290 |
(when (listp switches) |
(if full-directory-p "yes" "no")) |
3291 |
(setq switches (mapconcat 'identity switches " "))) |
(when wildcard |
3292 |
(unless full-directory-p |
(setq wildcard (file-name-nondirectory localname)) |
3293 |
(setq switches (concat "-d " switches))) |
(setq localname (file-name-directory localname))) |
3294 |
(when wildcard |
(when (listp switches) |
3295 |
(setq switches (concat switches " " wildcard))) |
(setq switches (mapconcat 'identity switches " "))) |
3296 |
(save-excursion |
(unless full-directory-p |
3297 |
;; If `full-directory-p', we just say `ls -l FILENAME'. |
(setq switches (concat "-d " switches))) |
3298 |
;; Else we chdir to the parent directory, then say `ls -ld BASENAME'. |
(when wildcard |
3299 |
(if full-directory-p |
(setq switches (concat switches " " wildcard))) |
|
(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)) |
|
3300 |
(save-excursion |
(save-excursion |
3301 |
(tramp-send-command multi-method method user host "cd") |
;; If `full-directory-p', we just say `ls -l FILENAME'. |
3302 |
(tramp-wait-for-output)) |
;; Else we chdir to the parent directory, then say `ls -ld BASENAME'. |
3303 |
;; For the time being, the XEmacs kludge is commented out. |
(if full-directory-p |
3304 |
;; Please test it on various XEmacs versions to see if it works. |
(tramp-send-command |
3305 |
;; ;; Another XEmacs specialty follows. What's the right way to do |
multi-method method user host |
3306 |
;; ;; it? |
(format "%s %s %s" |
3307 |
;; (when (and (featurep 'xemacs) |
(tramp-get-ls-command multi-method method user host) |
3308 |
;; (eq major-mode 'dired-mode)) |
switches |
3309 |
;; (save-excursion |
(if wildcard |
3310 |
;; (require 'dired) |
localname |
3311 |
;; (dired-insert-set-properties old-pos (point)))) |
(tramp-shell-quote-argument (concat localname "."))))) |
3312 |
))) |
(tramp-barf-unless-okay |
3313 |
|
multi-method method user host |
3314 |
|
(format "cd %s" (tramp-shell-quote-argument |
3315 |
|
(file-name-directory localname))) |
3316 |
|
nil 'file-error |
3317 |
|
"Couldn't `cd %s'" |
3318 |
|
(tramp-shell-quote-argument (file-name-directory localname))) |
3319 |
|
(tramp-send-command |
3320 |
|
multi-method method user host |
3321 |
|
(format "%s %s %s" |
3322 |
|
(tramp-get-ls-command multi-method method user host) |
3323 |
|
switches |
3324 |
|
(if wildcard |
3325 |
|
localname |
3326 |
|
(tramp-shell-quote-argument |
3327 |
|
(file-name-nondirectory localname)))))) |
3328 |
|
(sit-for 1) ;needed for rsh but not ssh? |
3329 |
|
(tramp-wait-for-output)) |
3330 |
|
;; The following let-binding is used by code that's commented |
3331 |
|
;; out. Let's leave the let-binding in for a while to see |
3332 |
|
;; that the commented-out code is really not needed. Commenting-out |
3333 |
|
;; happened on 2003-03-13. |
3334 |
|
(let ((old-pos (point))) |
3335 |
|
(insert-buffer-substring |
3336 |
|
(tramp-get-buffer multi-method method user host)) |
3337 |
|
;; On XEmacs, we want to call (exchange-point-and-mark t), but |
3338 |
|
;; that doesn't exist on Emacs, so we use this workaround instead. |
3339 |
|
;; Since zmacs-region-stays doesn't exist in Emacs, this ought to |
3340 |
|
;; be safe. Thanks to Daniel Pittman <daniel@danann.net>. |
3341 |
|
;; (let ((zmacs-region-stays t)) |
3342 |
|
;; (exchange-point-and-mark)) |
3343 |
|
(save-excursion |
3344 |
|
(tramp-send-command multi-method method user host "cd") |
3345 |
|
(tramp-wait-for-output)) |
3346 |
|
;; For the time being, the XEmacs kludge is commented out. |
3347 |
|
;; Please test it on various XEmacs versions to see if it works. |
3348 |
|
;; ;; Another XEmacs specialty follows. What's the right way to do |
3349 |
|
;; ;; it? |
3350 |
|
;; (when (and (featurep 'xemacs) |
3351 |
|
;; (eq major-mode 'dired-mode)) |
3352 |
|
;; (save-excursion |
3353 |
|
;; (require 'dired) |
3354 |
|
;; (dired-insert-set-properties old-pos (point)))) |
3355 |
|
)))) |
3356 |
|
|
3357 |
;; Continuation of kluge to pacify byte-compiler. |
;; Continuation of kluge to pacify byte-compiler. |
3358 |
;;(eval-when-compile |
;;(eval-when-compile |
4769 |
|
|
4770 |
;;; Internal Functions: |
;;; Internal Functions: |
4771 |
|
|
4772 |
|
(defun tramp-maybe-send-perl-script (script name multi-method method user host) |
4773 |
|
"Define in remote shell function NAME implemented as perl SCRIPT. |
4774 |
|
Only send the definition if it has not already been done. |
4775 |
|
Function may have 0-3 parameters." |
4776 |
|
(let ((remote-perl (tramp-get-remote-perl multi-method method user host))) |
4777 |
|
(unless remote-perl (error "No remote perl")) |
4778 |
|
(let ((perl-scripts (tramp-get-connection-property "perl-scripts" nil |
4779 |
|
multi-method method user host))) |
4780 |
|
(unless (memq name perl-scripts) |
4781 |
|
(with-current-buffer (tramp-get-buffer multi-method method user host) |
4782 |
|
(tramp-message 5 (concat "Sending the Perl script `" name "'...")) |
4783 |
|
(tramp-send-string multi-method method user host |
4784 |
|
(concat name |
4785 |
|
" () {\n" |
4786 |
|
remote-perl |
4787 |
|
" -e '" |
4788 |
|
script |
4789 |
|
"' \"$1\" \"$2\" \"$3\" 2>/dev/null\n}")) |
4790 |
|
(tramp-wait-for-output) |
4791 |
|
(tramp-set-connection-property "perl-scripts" (cons name perl-scripts) |
4792 |
|
multi-method method user host) |
4793 |
|
(tramp-message 5 (concat "Sending the Perl script `" name "'...done."))))))) |
4794 |
|
|
4795 |
(defun tramp-set-auto-save () |
(defun tramp-set-auto-save () |
4796 |
(when (and (buffer-file-name) |
(when (and (buffer-file-name) |
4797 |
(tramp-tramp-file-p (buffer-file-name)) |
(tramp-tramp-file-p (buffer-file-name)) |
5972 |
(tramp-wait-for-output) |
(tramp-wait-for-output) |
5973 |
;; Find a `perl'. |
;; Find a `perl'. |
5974 |
(erase-buffer) |
(erase-buffer) |
5975 |
|
(tramp-set-connection-property "perl-scripts" nil multi-method method user host) |
5976 |
(let ((tramp-remote-perl |
(let ((tramp-remote-perl |
5977 |
(or (tramp-find-executable multi-method method user host |
(or (tramp-find-executable multi-method method user host |
5978 |
"perl5" tramp-remote-path nil) |
"perl5" tramp-remote-path nil) |
5981 |
(when tramp-remote-perl |
(when tramp-remote-perl |
5982 |
(tramp-set-connection-property "perl" tramp-remote-perl |
(tramp-set-connection-property "perl" tramp-remote-perl |
5983 |
multi-method method user host) |
multi-method method user host) |
5984 |
;; Set up stat in Perl if we can. |
(unless (tramp-method-out-of-band-p multi-method method user host) |
5985 |
(when tramp-remote-perl |
(tramp-message 5 "Sending the Perl `mime-encode' implementations.") |
5986 |
(tramp-message 5 "Sending the Perl `file-attributes' implementation.") |
(tramp-send-string |
5987 |
(tramp-send-string |
multi-method method user host |
5988 |
multi-method method user host |
(concat "tramp_encode () {\n" |
5989 |
(concat "tramp_file_attributes () {\n" |
(format tramp-perl-encode tramp-remote-perl) |
5990 |
tramp-remote-perl |
" 2>/dev/null" |
5991 |
" -e '" tramp-perl-file-attributes "'" |
"\n}")) |
5992 |
" \"$1\" \"$2\" 2>/dev/null\n" |
(tramp-wait-for-output) |
5993 |
"}")) |
(tramp-send-string |
5994 |
(tramp-wait-for-output) |
multi-method method user host |
5995 |
(unless (tramp-method-out-of-band-p multi-method method user host) |
(concat "tramp_encode_with_module () {\n" |
5996 |
(tramp-message 5 "Sending the Perl `mime-encode' implementations.") |
(format tramp-perl-encode-with-module tramp-remote-perl) |
5997 |
(tramp-send-string |
" 2>/dev/null" |
5998 |
multi-method method user host |
"\n}")) |
5999 |
(concat "tramp_encode () {\n" |
(tramp-wait-for-output) |
6000 |
(format tramp-perl-encode tramp-remote-perl) |
(tramp-message 5 "Sending the Perl `mime-decode' implementations.") |
6001 |
" 2>/dev/null" |
(tramp-send-string |
6002 |
"\n}")) |
multi-method method user host |
6003 |
(tramp-wait-for-output) |
(concat "tramp_decode () {\n" |
6004 |
(tramp-send-string |
(format tramp-perl-decode tramp-remote-perl) |
6005 |
multi-method method user host |
" 2>/dev/null" |
6006 |
(concat "tramp_encode_with_module () {\n" |
"\n}")) |
6007 |
(format tramp-perl-encode-with-module tramp-remote-perl) |
(tramp-wait-for-output) |
6008 |
" 2>/dev/null" |
(tramp-send-string |
6009 |
"\n}")) |
multi-method method user host |
6010 |
(tramp-wait-for-output) |
(concat "tramp_decode_with_module () {\n" |
6011 |
(tramp-message 5 "Sending the Perl `mime-decode' implementations.") |
(format tramp-perl-decode-with-module tramp-remote-perl) |
6012 |
(tramp-send-string |
" 2>/dev/null" |
6013 |
multi-method method user host |
"\n}")) |
6014 |
(concat "tramp_decode () {\n" |
(tramp-wait-for-output)))) |
|
(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))))) |
|
6015 |
;; Find ln(1) |
;; Find ln(1) |
6016 |
(erase-buffer) |
(erase-buffer) |
6017 |
(let ((ln (tramp-find-executable multi-method method user host |
(let ((ln (tramp-find-executable multi-method method user host |
6520 |
(t (error "Tenth char `%c' must be one of `xtT-'" |
(t (error "Tenth char `%c' must be one of `xtT-'" |
6521 |
other-execute-or-sticky))))))) |
other-execute-or-sticky))))))) |
6522 |
|
|
6523 |
|
(defun tramp-convert-file-attributes (multi-method method user host attr) |
6524 |
|
"Convert file-attributes ATTR generated by perl script or ls. |
6525 |
|
Convert file mode bits to string and set virtual device number. |
6526 |
|
Return ATTR." |
6527 |
|
(unless (stringp (nth 8 attr)) |
6528 |
|
;; Convert file mode bits to string. |
6529 |
|
(setcar (nthcdr 8 attr) (tramp-file-mode-from-int (nth 8 attr)))) |
6530 |
|
;; Set virtual device number. |
6531 |
|
(setcar (nthcdr 11 attr) |
6532 |
|
(tramp-get-device multi-method method user host)) |
6533 |
|
attr) |
6534 |
|
|
6535 |
|
(defun tramp-get-device (multi-method method user host) |
6536 |
|
"Returns the virtual device number. |
6537 |
|
If it doesn't exist, generate a new one." |
6538 |
|
(let ((string (tramp-make-tramp-file-name multi-method method user host ""))) |
6539 |
|
(unless (assoc string tramp-devices) |
6540 |
|
(add-to-list 'tramp-devices |
6541 |
|
(list string (length tramp-devices)))) |
6542 |
|
(list -1 (nth 1 (assoc string tramp-devices))))) |
6543 |
|
|
6544 |
(defun tramp-file-mode-from-int (mode) |
(defun tramp-file-mode-from-int (mode) |
6545 |
"Turn an integer representing a file mode into an ls(1)-like string." |
"Turn an integer representing a file mode into an ls(1)-like string." |