Mercurial > emacs

comparison lisp/net/tramp.el @ 47577:20336ef6b20a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Version 2.0.21 released. (tramp-handle-file-newer-than-file-p): If mtime of both files is known, return a useful result. Better error message in case one is a Tramp file and one isn't. (tramp-handle-file-local-copy, tramp-handle-write-region) (tramp-find-shell, tramp-open-connection-telnet) (tramp-open-connection-rsh, tramp-open-connection-su) (tramp-open-connection-setup-interactive-shell) (tramp-post-connection, tramp-maybe-open-connection) (tramp-method-out-of-band-p): Correct number of args for `tramp-get-rsh-program' and similar functions.
author Kai Großjohann <kgrossjo@eu.uu.net>
date Sun, 22 Sep 2002 13:55:14 +0000
parents b31c8ab7336a
children 6e910ba94c42
comparison
equal deleted inserted replaced
47576:b31c8ab7336a 47577:20336ef6b20a
70 ;;; Code: 70 ;;; Code:
71 71
72 ;; In the Tramp CVS repository, the version numer is auto-frobbed from 72 ;; In the Tramp CVS repository, the version numer is auto-frobbed from
73 ;; the Makefile, so you should edit the top-level Makefile to change 73 ;; the Makefile, so you should edit the top-level Makefile to change
74 ;; the version number. 74 ;; the version number.
75 (defconst tramp-version "2.0.20" 75 (defconst tramp-version "2.0.21"
76 "This version of tramp.") 76 "This version of tramp.")
77 77
78 (defconst tramp-bug-report-address "tramp-devel@mail.freesoftware.fsf.org" 78 (defconst tramp-bug-report-address "tramp-devel@mail.freesoftware.fsf.org"
79 "Email address to send bug reports to.") 79 "Email address to send bug reports to.")
80 80
2171 "Like `file-newer-than-file-p' for tramp files." 2171 "Like `file-newer-than-file-p' for tramp files."
2172 (cond ((not (file-exists-p file1)) 2172 (cond ((not (file-exists-p file1))
2173 nil) 2173 nil)
2174 ((not (file-exists-p file2)) 2174 ((not (file-exists-p file2))
2175 t) 2175 t)
2176 ;; We are sure both files exist at this point. We assume that 2176 ;; We are sure both files exist at this point.
2177 ;; both files are Tramp files, otherwise we issue an error
2178 ;; message. Todo: make a better error message.
2179 (t 2177 (t
2180 (save-excursion 2178 (save-excursion
2181 (with-parsed-tramp-file-name file1 v1 2179 ;; We try to get the mtime of both files. If they are not
2182 (with-parsed-tramp-file-name file2 v2 2180 ;; equal to the "dont-know" value, then we subtract the times
2183 (when (and (tramp-ange-ftp-file-name-p v1-multi-method v1-method) 2181 ;; and obtain the result.
2184 (tramp-ange-ftp-file-name-p v2-multi-method v2-method)) 2182 (let ((fa1 (file-attributes file1))
2185 (tramp-invoke-ange-ftp 'file-newer-than-file-p 2183 (fa2 (file-attributes file2)))
2186 file1 file2)) 2184 (if (and (not (equal (nth 5 fa1) '(0 0)))
2187 (unless (and (equal v1-multi-method v2-multi-method) 2185 (not (equal (nth 5 fa2) '(0 0))))
2188 (equal v1-method v2-method) 2186 (> 0 (car (subtract-time (nth 5 fa1) (nth 5 fa2))))
2189 (equal v1-user v2-user) 2187 ;; If one of them is the dont-know value, then we can
2190 (equal v1-host v2-host)) 2188 ;; still try to run a shell command on the remote host.
2191 (signal 'file-error 2189 ;; However, this only works if both files are Tramp
2192 (list "Files must have same method, user, host" 2190 ;; files and both have the same method, same user, same
2193 file1 file2))) 2191 ;; host.
2194 (unless (and (tramp-tramp-file-p file1) 2192 (unless (and (tramp-tramp-file-p file1)
2195 (tramp-tramp-file-p file2)) 2193 (tramp-tramp-file-p file2))
2196 (signal 'file-error 2194 (signal
2197 (list "Files must be tramp files on same host" 2195 'file-error
2198 file1 file2))) 2196 (list
2199 (if (tramp-get-test-groks-nt 2197 "Cannot check if Tramp file is newer than non-Tramp file"
2200 v1-multi-method v1-method v1-user v1-host) 2198 file1 file2)))
2201 (zerop (tramp-run-test2 "test" file1 file2 "-nt")) 2199 (with-parsed-tramp-file-name file1 v1
2202 (zerop (tramp-run-test2 "tramp_test_nt" file1 file2))))))))) 2200 (with-parsed-tramp-file-name file2 v2
2201 (when (and (tramp-ange-ftp-file-name-p
2202 v1-multi-method v1-method)
2203 (tramp-ange-ftp-file-name-p
2204 v2-multi-method v2-method))
2205 (tramp-invoke-ange-ftp 'file-newer-than-file-p
2206 file1 file2))
2207 (unless (and (equal v1-multi-method v2-multi-method)
2208 (equal v1-method v2-method)
2209 (equal v1-user v2-user)
2210 (equal v1-host v2-host))
2211 (signal 'file-error
2212 (list "Files must have same method, user, host"
2213 file1 file2)))
2214 (unless (and (tramp-tramp-file-p file1)
2215 (tramp-tramp-file-p file2))
2216 (signal 'file-error
2217 (list "Files must be tramp files on same host"
2218 file1 file2)))
2219 (if (tramp-get-test-groks-nt
2220 v1-multi-method v1-method v1-user v1-host)
2221 (zerop (tramp-run-test2 "test" file1 file2 "-nt"))
2222 (zerop (tramp-run-test2
2223 "tramp_test_nt" file1 file2)))))))))))
2203 2224
2204 ;; Functions implemented using the basic functions above. 2225 ;; Functions implemented using the basic functions above.
2205 2226
2206 (defun tramp-handle-file-modes (filename) 2227 (defun tramp-handle-file-modes (filename)
2207 "Like `file-modes' for tramp files." 2228 "Like `file-modes' for tramp files."
2950 (when (tramp-ange-ftp-file-name-p multi-method method) 2971 (when (tramp-ange-ftp-file-name-p multi-method method)
2951 (tramp-invoke-ange-ftp 'file-local-copy filename)) 2972 (tramp-invoke-ange-ftp 'file-local-copy filename))
2952 (let ((trampbuf (get-buffer-create "*tramp output*")) 2973 (let ((trampbuf (get-buffer-create "*tramp output*"))
2953 (rcp-program (tramp-get-rcp-program 2974 (rcp-program (tramp-get-rcp-program
2954 multi-method 2975 multi-method
2955 (tramp-find-method multi-method method user host))) 2976 (tramp-find-method multi-method method user host)
2977 user host))
2956 (rcp-args (tramp-get-rcp-args 2978 (rcp-args (tramp-get-rcp-args
2957 multi-method 2979 multi-method
2958 (tramp-find-method multi-method method user host))) 2980 (tramp-find-method multi-method method user host)
2981 user host))
2959 tmpfil) 2982 tmpfil)
2960 (unless (file-exists-p filename) 2983 (unless (file-exists-p filename)
2961 (error "Cannot make local copy of non-existing file `%s'" 2984 (error "Cannot make local copy of non-existing file `%s'"
2962 filename)) 2985 filename))
2963 (setq tmpfil (tramp-make-temp-file)) 2986 (setq tmpfil (tramp-make-temp-file))
3120 (when (tramp-ange-ftp-file-name-p multi-method method) 3143 (when (tramp-ange-ftp-file-name-p multi-method method)
3121 (tramp-invoke-ange-ftp 'write-region 3144 (tramp-invoke-ange-ftp 'write-region
3122 start end filename append visit)) 3145 start end filename append visit))
3123 (let ((curbuf (current-buffer)) 3146 (let ((curbuf (current-buffer))
3124 (rcp-program (tramp-get-rcp-program 3147 (rcp-program (tramp-get-rcp-program
3125 multi-method (tramp-find-method multi-method method user host))) 3148 multi-method (tramp-find-method multi-method method user host)
3149 user host))
3126 (rcp-args (tramp-get-rcp-args 3150 (rcp-args (tramp-get-rcp-args
3127 multi-method 3151 multi-method
3128 (tramp-find-method multi-method method user host))) 3152 (tramp-find-method multi-method method user host)
3153 user host))
3129 (rem-enc (tramp-get-remote-encoding multi-method method user host)) 3154 (rem-enc (tramp-get-remote-encoding multi-method method user host))
3130 (rem-dec (tramp-get-remote-decoding multi-method method user host)) 3155 (rem-dec (tramp-get-remote-decoding multi-method method user host))
3131 (loc-enc (tramp-get-local-encoding multi-method method user host)) 3156 (loc-enc (tramp-get-local-encoding multi-method method user host))
3132 (loc-dec (tramp-get-local-decoding multi-method method user host)) 3157 (loc-dec (tramp-get-local-decoding multi-method method user host))
3133 (trampbuf (get-buffer-create "*tramp output*")) 3158 (trampbuf (get-buffer-create "*tramp output*"))
4225 (tramp-wait-for-output) 4250 (tramp-wait-for-output)
4226 (tramp-message 4251 (tramp-message
4227 9 "Setting remote shell prompt...done") 4252 9 "Setting remote shell prompt...done")
4228 ) 4253 )
4229 (t (tramp-message 5 "Remote `%s' groks tilde expansion, good" 4254 (t (tramp-message 5 "Remote `%s' groks tilde expansion, good"
4230 (tramp-get-remote-sh multi-method method)))))) 4255 (tramp-get-remote-sh multi-method method user host))))))
4231 4256
4232 (defun tramp-check-ls-command (multi-method method user host cmd) 4257 (defun tramp-check-ls-command (multi-method method user host cmd)
4233 "Checks whether the given `ls' executable groks `-n'. 4258 "Checks whether the given `ls' executable groks `-n'.
4234 METHOD, USER and HOST specify the connection, CMD (the full path name of) 4259 METHOD, USER and HOST specify the connection, CMD (the full path name of)
4235 the `ls' executable. Returns t if CMD supports the `-n' option, nil 4260 the `ls' executable. Returns t if CMD supports the `-n' option, nil
4479 (p (apply 'start-process 4504 (p (apply 'start-process
4480 (tramp-buffer-name multi-method method user host) 4505 (tramp-buffer-name multi-method method user host)
4481 (tramp-get-buffer multi-method method user host) 4506 (tramp-get-buffer multi-method method user host)
4482 (tramp-get-telnet-program 4507 (tramp-get-telnet-program
4483 multi-method 4508 multi-method
4484 (tramp-find-method multi-method method user host)) 4509 (tramp-find-method multi-method method user host)
4510 user host)
4485 host 4511 host
4486 (tramp-get-telnet-args 4512 (tramp-get-telnet-args
4487 multi-method 4513 multi-method
4488 (tramp-find-method multi-method method user host)))) 4514 (tramp-find-method multi-method method user host)
4515 user host)))
4489 (found nil) 4516 (found nil)
4490 (pw nil)) 4517 (pw nil))
4491 (process-kill-without-query p) 4518 (process-kill-without-query p)
4492 (set-buffer (tramp-get-buffer multi-method method user host)) 4519 (set-buffer (tramp-get-buffer multi-method method user host))
4493 (erase-buffer) 4520 (erase-buffer)
4534 (let ((process-environment (copy-sequence process-environment)) 4561 (let ((process-environment (copy-sequence process-environment))
4535 (bufnam (tramp-buffer-name multi-method method user host)) 4562 (bufnam (tramp-buffer-name multi-method method user host))
4536 (buf (tramp-get-buffer multi-method method user host)) 4563 (buf (tramp-get-buffer multi-method method user host))
4537 (rsh-program (tramp-get-rsh-program 4564 (rsh-program (tramp-get-rsh-program
4538 multi-method 4565 multi-method
4539 (tramp-find-method multi-method method user host))) 4566 (tramp-find-method multi-method method user host)
4567 user host))
4540 (rsh-args (tramp-get-rsh-args 4568 (rsh-args (tramp-get-rsh-args
4541 multi-method 4569 multi-method
4542 (tramp-find-method multi-method method user host)))) 4570 (tramp-find-method multi-method method user host)
4571 user host)))
4543 ;; The following should be changed. We need a more general 4572 ;; The following should be changed. We need a more general
4544 ;; mechanism to parse extra host args. 4573 ;; mechanism to parse extra host args.
4545 (when (string-match "\\([^#]*\\)#\\(.*\\)" host) 4574 (when (string-match "\\([^#]*\\)#\\(.*\\)" host)
4546 (setq rsh-args (cons "-p" (cons (match-string 2 host) rsh-args))) 4575 (setq rsh-args (cons "-p" (cons (match-string 2 host) rsh-args)))
4547 (setq host (match-string 1 host))) 4576 (setq host (match-string 1 host)))
4607 (p (apply 'start-process 4636 (p (apply 'start-process
4608 (tramp-buffer-name multi-method method user host) 4637 (tramp-buffer-name multi-method method user host)
4609 (tramp-get-buffer multi-method method user host) 4638 (tramp-get-buffer multi-method method user host)
4610 (tramp-get-su-program 4639 (tramp-get-su-program
4611 multi-method 4640 multi-method
4612 (tramp-find-method multi-method method user host)) 4641 (tramp-find-method multi-method method user host)
4642 user host)
4613 (mapcar 4643 (mapcar
4614 '(lambda (x) 4644 '(lambda (x)
4615 (format-spec x `((?u . ,(or user "root"))))) 4645 (format-spec x `((?u . ,(or user "root")))))
4616 (tramp-get-su-args 4646 (tramp-get-su-args
4617 multi-method 4647 multi-method
4618 (tramp-find-method multi-method method user host))))) 4648 (tramp-find-method multi-method method user host)
4649 user host))))
4619 (found nil) 4650 (found nil)
4620 (pw nil)) 4651 (pw nil))
4621 (process-kill-without-query p) 4652 (process-kill-without-query p)
4622 (set-buffer (tramp-get-buffer multi-method method user host)) 4653 (set-buffer (tramp-get-buffer multi-method method user host))
4623 (tramp-process-actions p multi-method method user host 4654 (tramp-process-actions p multi-method method user host
4855 ;; sign. The following command line sets $PS1 to a sane value, and 4886 ;; sign. The following command line sets $PS1 to a sane value, and
4856 ;; works under Bourne-ish shells as well as csh-like shells. Daniel 4887 ;; works under Bourne-ish shells as well as csh-like shells. Daniel
4857 ;; Pittman reports that the unusual positioning of the single quotes 4888 ;; Pittman reports that the unusual positioning of the single quotes
4858 ;; makes it work under `rc', too. 4889 ;; makes it work under `rc', too.
4859 (process-send-string nil (format "exec env 'PS1=$ ' %s%s" 4890 (process-send-string nil (format "exec env 'PS1=$ ' %s%s"
4860 (tramp-get-remote-sh multi-method method) 4891 (tramp-get-remote-sh
4892 multi-method method user host)
4861 tramp-rsh-end-of-line)) 4893 tramp-rsh-end-of-line))
4862 (when tramp-debug-buffer 4894 (when tramp-debug-buffer
4863 (save-excursion 4895 (save-excursion
4864 (set-buffer (tramp-get-debug-buffer multi-method method user host)) 4896 (set-buffer (tramp-get-debug-buffer multi-method method user host))
4865 (goto-char (point-max)) 4897 (goto-char (point-max))
4866 (tramp-insert-with-face 4898 (tramp-insert-with-face
4867 'bold (format "$ exec env PS1='$ ' %s\n" 4899 'bold (format "$ exec env PS1='$ ' %s\n"
4868 (tramp-get-remote-sh multi-method method))))) 4900 (tramp-get-remote-sh multi-method method user host)))))
4869 (tramp-message 9 "Waiting 30s for remote `%s' to come up..." 4901 (tramp-message 9 "Waiting 30s for remote `%s' to come up..."
4870 (tramp-get-remote-sh multi-method method)) 4902 (tramp-get-remote-sh multi-method method user host))
4871 (unless (tramp-wait-for-regexp 4903 (unless (tramp-wait-for-regexp
4872 p 30 (format "\\(%s\\|%s\\)\\'" 4904 p 30 (format "\\(%s\\|%s\\)\\'"
4873 shell-prompt-pattern tramp-shell-prompt-pattern)) 4905 shell-prompt-pattern tramp-shell-prompt-pattern))
4874 (pop-to-buffer (buffer-name)) 4906 (pop-to-buffer (buffer-name))
4875 (error "Remote `%s' didn't come up. See buffer `%s' for details" 4907 (error "Remote `%s' didn't come up. See buffer `%s' for details"
4876 (tramp-get-remote-sh multi-method method) (buffer-name))) 4908 (tramp-get-remote-sh multi-method method user host)
4909 (buffer-name)))
4877 (tramp-message 9 "Setting up remote shell environment") 4910 (tramp-message 9 "Setting up remote shell environment")
4878 (tramp-discard-garbage-erase-buffer p multi-method method user host) 4911 (tramp-discard-garbage-erase-buffer p multi-method method user host)
4879 (process-send-string 4912 (process-send-string
4880 nil (format "stty -inlcr -echo kill '^U'%s" tramp-rsh-end-of-line)) 4913 nil (format "stty -inlcr -echo kill '^U'%s" tramp-rsh-end-of-line))
4881 (unless (tramp-wait-for-regexp 4914 (unless (tramp-wait-for-regexp
5097 " -e '" tramp-perl-file-attributes "' $1 2>/dev/null\n" 5130 " -e '" tramp-perl-file-attributes "' $1 2>/dev/null\n"
5098 "}")) 5131 "}"))
5099 (tramp-wait-for-output) 5132 (tramp-wait-for-output)
5100 (unless (tramp-get-rcp-program 5133 (unless (tramp-get-rcp-program
5101 multi-method 5134 multi-method
5102 (tramp-find-method multi-method method user host)) 5135 (tramp-find-method multi-method method user host)
5136 user host)
5103 (tramp-message 5 "Sending the Perl `mime-encode' implementations.") 5137 (tramp-message 5 "Sending the Perl `mime-encode' implementations.")
5104 (tramp-send-linewise 5138 (tramp-send-linewise
5105 multi-method method user host 5139 multi-method method user host
5106 (concat "tramp_encode () {\n" 5140 (concat "tramp_encode () {\n"
5107 (format tramp-perl-encode tramp-remote-perl) 5141 (format tramp-perl-encode tramp-remote-perl)
5138 (tramp-set-connection-property "ln" ln multi-method method user host))) 5172 (tramp-set-connection-property "ln" ln multi-method method user host)))
5139 (erase-buffer) 5173 (erase-buffer)
5140 ;; Find the right encoding/decoding commands to use. 5174 ;; Find the right encoding/decoding commands to use.
5141 (unless (tramp-get-rcp-program 5175 (unless (tramp-get-rcp-program
5142 multi-method 5176 multi-method
5143 (tramp-find-method multi-method method user host)) 5177 (tramp-find-method multi-method method user host)
5178 user host)
5144 (tramp-find-inline-encoding multi-method method user host)) 5179 (tramp-find-inline-encoding multi-method method user host))
5145 ;; If encoding/decoding command are given, test to see if they work. 5180 ;; If encoding/decoding command are given, test to see if they work.
5146 ;; CCC: Maybe it would be useful to run the encoder both locally and 5181 ;; CCC: Maybe it would be useful to run the encoder both locally and
5147 ;; remotely to see if they produce the same result. 5182 ;; remotely to see if they produce the same result.
5148 (let ((rem-enc (tramp-get-remote-encoding multi-method method user host)) 5183 (let ((rem-enc (tramp-get-remote-encoding multi-method method user host))
5343 (unless (and p (processp p) (memq (process-status p) '(run open))) 5378 (unless (and p (processp p) (memq (process-status p) '(run open)))
5344 (when (and p (processp p)) 5379 (when (and p (processp p))
5345 (delete-process p)) 5380 (delete-process p))
5346 (funcall (tramp-get-connection-function 5381 (funcall (tramp-get-connection-function
5347 multi-method 5382 multi-method
5348 (tramp-find-method multi-method method user host)) 5383 (tramp-find-method multi-method method user host)
5384 user host)
5349 multi-method method user host)))) 5385 multi-method method user host))))
5350 5386
5351 (defun tramp-send-command 5387 (defun tramp-send-command
5352 (multi-method method user host command &optional noerase neveropen) 5388 (multi-method method user host command &optional noerase neveropen)
5353 "Send the COMMAND to USER at HOST (logged in using METHOD). 5389 "Send the COMMAND to USER at HOST (logged in using METHOD).
5833 "Return t if this is an out-of-band method, nil otherwise. 5869 "Return t if this is an out-of-band method, nil otherwise.
5834 It is important to check for this condition, since it is not possible 5870 It is important to check for this condition, since it is not possible
5835 to enter a password for the `tramp-rcp-program'." 5871 to enter a password for the `tramp-rcp-program'."
5836 (tramp-get-rcp-program 5872 (tramp-get-rcp-program
5837 multi-method 5873 multi-method
5838 (tramp-find-method multi-method method user host))) 5874 (tramp-find-method multi-method method user host)
5875 user host))
5839 5876
5840 ;; Variables local to connection. 5877 ;; Variables local to connection.
5841 5878
5842 (defun tramp-get-ls-command (multi-method method user host) 5879 (defun tramp-get-ls-command (multi-method method user host)
5843 (save-excursion 5880 (save-excursion