comparison lisp/net/tramp.el @ 62344:5a19ff64befb

Sync with Tramp 2.0.49.

62343:4a68f3c340ab

  :group 'tramp
  :type '(repeat string))

;; Chunked sending kluge.  We set this to 500 for black-listed constellations
;; known to have a bug in `process-send-string'; some ssh connections appear
;; to drop bytes when data is sent too quickly.
(defcustom tramp-chunksize
  (when (and (not (featurep 'xemacs))
	     (memq system-type '(hpux)))
    500)
  "*If non-nil, chunksize for sending input to local process.

      (tramp-send-command
       multi-method method user host
       (mapconcat #'tramp-shell-quote-argument (cons program arguments) " "))
      (tramp-wait-for-output))
    (unless discard
      (insert-buffer (tramp-get-buffer multi-method method user host)))
    (save-excursion
      (prog1
	  (tramp-send-command-and-check multi-method method user host nil)
	(tramp-send-command multi-method method user host "cd")
	(tramp-wait-for-output)))))

           (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 <[e-mail]>.
        ;;     (let ((zmacs-region-stays t))

			 command)
	       (format "%s; tramp_old_status=$?" command)))
	    (unless asynchronous
	      (tramp-wait-for-output)))
	  (unless asynchronous
	    (insert-buffer (tramp-get-buffer multi-method method user host)))
	  (when error-buffer
	    (save-excursion
	      (unless (bufferp error-buffer)
		(setq error-buffer (get-buffer-create error-buffer)))
	      (tramp-send-command
	       multi-method method user host
	       "cat /tmp/tramp.$$.err")
	      (tramp-wait-for-output)
	      (set-buffer error-buffer)
	      (insert-buffer (tramp-get-buffer multi-method method user host))
	      (tramp-send-command-and-check
	       multi-method method user host "rm -f /tmp/tramp.$$.err")))
	  (save-excursion
	    (tramp-send-command multi-method method user host "cd")
	    (unless asynchronous

          (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))
             auto-save-default)
    (auto-save-mode 1)))
(add-hook 'find-file-hooks 'tramp-set-auto-save t)

(defun tramp-run-test (switch filename)

    (when (tramp-method-out-of-band-p multi-method method user host)
      (error "Cannot use out-of-band method `%s' with telnet connection method"
             method))
    (when multi-method
      (error "Cannot multi-connect using telnet connection method"))
    (tramp-pre-connection multi-method method user host)
    (tramp-message 7 "Opening connection for %s@%s using %s..."
		   (or user (user-login-name)) host method)
    (let ((process-environment (copy-sequence process-environment)))
      (setenv "TERM" tramp-terminal-type)
      (let* ((default-directory (tramp-temporary-file-directory))

* Actually, the rsh program to be used can be specified in the
  method parameters, see the variable `tramp-methods'."
  (save-match-data
    (when multi-method
      (error "Cannot multi-connect using rsh connection method"))
    (tramp-pre-connection multi-method method user host)
    (if (and user (not (string= user "")))
	(tramp-message 7 "Opening connection for %s@%s using %s..."
		       user host method)
      (tramp-message 7 "Opening connection at %s using %s..." host method))
    (let ((process-environment (copy-sequence process-environment))

                (string= "localhost" host)
		(string= "" host))
      (error
       "Cannot connect to different host `%s' with `su' connection method"
       host))
    (tramp-pre-connection multi-method method user host)
    (tramp-message 7 "Opening connection for `%s' using `%s'..."
		   (or user "<root>") method)
    (let ((process-environment (copy-sequence process-environment)))
      (setenv "TERM" tramp-terminal-type)
      (let* ((default-directory (tramp-temporary-file-directory))

    (unless (and (arrayp host) (not (stringp host)))
      (error "HOST must be an array of strings for multi methods"))
    (unless (and (= (length method) (length user))
                 (= (length method) (length host)))
      (error "Arrays METHOD, USER, HOST must have equal length"))
    (tramp-pre-connection multi-method method user host)
    (tramp-message 7 "Opening `%s' connection..." multi-method)
    (let ((process-environment (copy-sequence process-environment)))
      (setenv "TERM" tramp-terminal-type)
      (let* ((default-directory (tramp-temporary-file-directory))
	     ;; If we omit the conditional, we use `undecided-dos' in

		   tramp-default-password-end-of-line)))))

;; HHH: Not Changed.  This might handle the case where USER is not
;;      given in the "File name" very poorly.  Then, the local
;;      variable tramp-current-user will be set to nil.
(defun tramp-pre-connection (multi-method method user host)
  "Do some setup before actually logging in.
METHOD, USER and HOST specify the connection."
  (set-buffer (tramp-get-buffer multi-method method user host))
  (set (make-local-variable 'tramp-current-multi-method) multi-method)
  (set (make-local-variable 'tramp-current-method) method)
  (set (make-local-variable 'tramp-current-user)   user)
  (set (make-local-variable 'tramp-current-host)   host)
  (set (make-local-variable 'inhibit-eol-conversion) nil)
  (erase-buffer))

(defun tramp-open-connection-setup-interactive-shell
  (p multi-method method user host)

  (tramp-send-command-internal multi-method method user host
			       "echo foo")
  (erase-buffer)
  (tramp-send-command-internal multi-method method user host
			       "TERM=dumb; export TERM")
  ;; Try to set up the coding system correctly.
  ;; CCC this can't be the right way to do it.  Hm.
  (save-excursion
    (erase-buffer)
    (tramp-message 9 "Determining coding system")

      (unless (file-exists-p buffer-auto-save-file-name)
	(write-region "" nil buffer-auto-save-file-name))
      ;; Permissions should be set always, because there might be an old
      ;; auto-saved file belonging to another original file.  This could
      ;; be a security threat.
      (set-file-modes buffer-auto-save-file-name (file-modes bfn)))))

(unless (or (> emacs-major-version 21)
	    (and (featurep 'xemacs)
		 (= emacs-major-version 21)
		 (> emacs-minor-version 4)))

	 tramp-password-prompt-regexp
	 tramp-wrong-passwd-regexp
	 tramp-yesno-prompt-regexp
	 tramp-yn-prompt-regexp
	 tramp-terminal-prompt-regexp
	 tramp-out-of-band-prompt-regexp
	 tramp-temp-name-prefix
	 tramp-file-name-structure
	 tramp-file-name-regexp
	 tramp-multi-file-name-structure
	 tramp-multi-file-name-hop-structure

"))))

(defun tramp-append-tramp-buffers ()
  "Append Tramp buffers into the bug report."

  ;; We load mml.el from Gnus.
  (if (featurep 'xemacs)
      (load "mml" 'noerror)
    (require 'mml nil 'noerror))

  (when (and
	 ;; We don't want to add another dependency.
	 (functionp 'mml-insert-empty-tag)
	 ;; 2nd parameter since Emacs 22.
	 (condition-case nil
	     (list-buffers-noselect nil nil)
	   (t nil)))
    (let ((buffer-list
	   (delq nil
	    (mapcar '(lambda (b)
	     (when (string-match "^\\*\\(debug \\)?tramp/" (buffer-name b)) b))
	     (buffer-list))))
	  (curbuf (current-buffer)))

      ;; There is at least one Tramp buffer.
      (when buffer-list
	(switch-to-buffer (list-buffers-noselect nil buffer-list))
	(delete-other-windows)
	(setq buffer-read-only nil)
	(goto-char (point-max))
	(insert "
The buffer(s) above will be appended to this message.  If you don't want
to append a buffer because it contains sensible data, or because the buffer
is too large, you should delete the respective buffer.  The buffer(s) will
contain user and host names.  Passwords will never be included there.")

62344:5a19ff64befb

  :group 'tramp
  :type '(repeat string))

;; Chunked sending kluge.  We set this to 500 for black-listed constellations
;; known to have a bug in `process-send-string'; some ssh connections appear
;; to drop bytes when data is sent too quickly.  There is also a connection
;; buffer local variable, which is computed depending on remote host properties
;; when `tramp-chunksize' is zero or nil.
(defcustom tramp-chunksize
  (when (and (not (featurep 'xemacs))
	     (memq system-type '(hpux)))
    500)
  "*If non-nil, chunksize for sending input to local process.

      (tramp-send-command
       multi-method method user host
       (mapconcat #'tramp-shell-quote-argument (cons program arguments) " "))
      (tramp-wait-for-output))
    (unless discard
      ;; We cannot use `insert-buffer' because the tramp buffer
      ;; changes its contents before insertion due to calling
      ;; `expand-file' and alike.
      (insert
       (with-current-buffer
	   (tramp-get-buffer multi-method method user host)
	 (buffer-string))))
    (save-excursion
      (prog1
	  (tramp-send-command-and-check multi-method method user host nil)
	(tramp-send-command multi-method method user host "cd")
	(tramp-wait-for-output)))))

           (format "%s %s %s"
                   (tramp-get-ls-command multi-method method user host)
                   switches
                   (if wildcard
                       localname
		     (if (zerop (length (file-name-nondirectory 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)))
	;; We cannot use `insert-buffer' because the tramp buffer
	;; changes its contents before insertion due to calling
	;; `expand-file' and alike.
	(insert
	 (with-current-buffer
	     (tramp-get-buffer multi-method method user host)
	   (buffer-string)))
        ;; 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 <[e-mail]>.
        ;;     (let ((zmacs-region-stays t))

			 command)
	       (format "%s; tramp_old_status=$?" command)))
	    (unless asynchronous
	      (tramp-wait-for-output)))
	  (unless asynchronous
	    ;; We cannot use `insert-buffer' because the tramp buffer
	    ;; changes its contents before insertion due to calling
	    ;; `expand-file' and alike.
	    (insert
	     (with-current-buffer
		 (tramp-get-buffer multi-method method user host)
	       (buffer-string))))
	  (when error-buffer
	    (save-excursion
	      (unless (bufferp error-buffer)
		(setq error-buffer (get-buffer-create error-buffer)))
	      (tramp-send-command
	       multi-method method user host
	       "cat /tmp/tramp.$$.err")
	      (tramp-wait-for-output)
	      (set-buffer error-buffer)
	      ;; Same comment as above
	      (insert
	       (with-current-buffer
		   (tramp-get-buffer multi-method method user host)
		 (buffer-string)))
	      (tramp-send-command-and-check
	       multi-method method user host "rm -f /tmp/tramp.$$.err")))
	  (save-excursion
	    (tramp-send-command multi-method method user host "cd")
	    (unless asynchronous

          (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))
	     ;; ange-ftp has its own auto-save mechanism
	     (eq (tramp-find-foreign-file-name-handler (buffer-file-name))
		 'tramp-sh-file-name-handler)
             auto-save-default)
    (auto-save-mode 1)))
(add-hook 'find-file-hooks 'tramp-set-auto-save t)

(defun tramp-run-test (switch filename)

    (when (tramp-method-out-of-band-p multi-method method user host)
      (error "Cannot use out-of-band method `%s' with telnet connection method"
             method))
    (when multi-method
      (error "Cannot multi-connect using telnet connection method"))
    (tramp-pre-connection multi-method method user host tramp-chunksize)
    (tramp-message 7 "Opening connection for %s@%s using %s..."
		   (or user (user-login-name)) host method)
    (let ((process-environment (copy-sequence process-environment)))
      (setenv "TERM" tramp-terminal-type)
      (let* ((default-directory (tramp-temporary-file-directory))

* Actually, the rsh program to be used can be specified in the
  method parameters, see the variable `tramp-methods'."
  (save-match-data
    (when multi-method
      (error "Cannot multi-connect using rsh connection method"))
    (tramp-pre-connection multi-method method user host tramp-chunksize)
    (if (and user (not (string= user "")))
	(tramp-message 7 "Opening connection for %s@%s using %s..."
		       user host method)
      (tramp-message 7 "Opening connection at %s using %s..." host method))
    (let ((process-environment (copy-sequence process-environment))

                (string= "localhost" host)
		(string= "" host))
      (error
       "Cannot connect to different host `%s' with `su' connection method"
       host))
    (tramp-pre-connection multi-method method user host tramp-chunksize)
    (tramp-message 7 "Opening connection for `%s' using `%s'..."
		   (or user "<root>") method)
    (let ((process-environment (copy-sequence process-environment)))
      (setenv "TERM" tramp-terminal-type)
      (let* ((default-directory (tramp-temporary-file-directory))

    (unless (and (arrayp host) (not (stringp host)))
      (error "HOST must be an array of strings for multi methods"))
    (unless (and (= (length method) (length user))
                 (= (length method) (length host)))
      (error "Arrays METHOD, USER, HOST must have equal length"))
    (tramp-pre-connection multi-method method user host tramp-chunksize)
    (tramp-message 7 "Opening `%s' connection..." multi-method)
    (let ((process-environment (copy-sequence process-environment)))
      (setenv "TERM" tramp-terminal-type)
      (let* ((default-directory (tramp-temporary-file-directory))
	     ;; If we omit the conditional, we use `undecided-dos' in

		   tramp-default-password-end-of-line)))))

;; HHH: Not Changed.  This might handle the case where USER is not
;;      given in the "File name" very poorly.  Then, the local
;;      variable tramp-current-user will be set to nil.
(defun tramp-pre-connection (multi-method method user host chunksize)
  "Do some setup before actually logging in.
METHOD, USER and HOST specify the connection."
  (set-buffer (tramp-get-buffer multi-method method user host))
  (set (make-local-variable 'tramp-current-multi-method) multi-method)
  (set (make-local-variable 'tramp-current-method) method)
  (set (make-local-variable 'tramp-current-user)   user)
  (set (make-local-variable 'tramp-current-host)   host)
  (set (make-local-variable 'tramp-chunksize)      chunksize)
  (set (make-local-variable 'inhibit-eol-conversion) nil)
  (erase-buffer))

(defun tramp-open-connection-setup-interactive-shell
  (p multi-method method user host)

  (tramp-send-command-internal multi-method method user host
			       "echo foo")
  (erase-buffer)
  (tramp-send-command-internal multi-method method user host
			       "TERM=dumb; export TERM")
  (erase-buffer)
  ;; Check whether the remote host suffers from buggy `send-process-string'.
  ;; This is known for FreeBSD (see comment in `send_process', file process.c).
  ;; I've tested sending 624 bytes successfully, sending 625 bytes failed.
  ;; Emacs makes a hack when this host type is detected locally.  It cannot
  ;; handle remote hosts, though.
  (when (or (not tramp-chunksize) (zerop tramp-chunksize))
    (tramp-message 9 "Checking remote host type for `send-process-string' bug")
    (tramp-send-command-internal multi-method method user host
				 "(uname -sr) 2>/dev/null")
    (goto-char (point-min))
    (when (looking-at "FreeBSD")
      (setq tramp-chunksize 500)))

  ;; Try to set up the coding system correctly.
  ;; CCC this can't be the right way to do it.  Hm.
  (save-excursion
    (erase-buffer)
    (tramp-message 9 "Determining coding system")

      (unless (file-exists-p buffer-auto-save-file-name)
	(write-region "" nil buffer-auto-save-file-name))
      ;; Permissions should be set always, because there might be an old
      ;; auto-saved file belonging to another original file.  This could
      ;; be a security threat.
      (set-file-modes buffer-auto-save-file-name
		      (or (file-modes bfn) ?\600)))))

(unless (or (> emacs-major-version 21)
	    (and (featurep 'xemacs)
		 (= emacs-major-version 21)
		 (> emacs-minor-version 4)))

	 tramp-password-prompt-regexp
	 tramp-wrong-passwd-regexp
	 tramp-yesno-prompt-regexp
	 tramp-yn-prompt-regexp
	 tramp-terminal-prompt-regexp
	 tramp-temp-name-prefix
	 tramp-file-name-structure
	 tramp-file-name-regexp
	 tramp-multi-file-name-structure
	 tramp-multi-file-name-hop-structure

"))))

(defun tramp-append-tramp-buffers ()
  "Append Tramp buffers into the bug report."

  ;; We load message.el and mml.el from Gnus.
  (if (featurep 'xemacs)
      (progn
	(load "message" 'noerror)
	(load "mml" 'noerror))
    (require 'message nil 'noerror)
    (require 'mml nil 'noerror))
  (when (functionp 'message-mode)
    (funcall 'message-mode))
  (when (functionp 'mml-mode)
    (funcall 'mml-mode t))

  (when (and
	 (eq major-mode 'message-mode)
	 (boundp 'mml-mode)
	 (symbol-value 'mml-mode))

    (let* ((tramp-buf-regexp "\\*\\(debug \\)?tramp/")
	   (buffer-list
	    (delq nil
		  (mapcar '(lambda (b)
		     (when (string-match tramp-buf-regexp (buffer-name b)) b))
			  (buffer-list))))
	   (curbuf (current-buffer)))

      ;; There is at least one Tramp buffer.
      (when buffer-list
	(switch-to-buffer (list-buffers-noselect nil))
	(delete-other-windows)
	(setq buffer-read-only nil)
	(goto-char (point-min))
	(while (not (eobp))
	  (if (re-search-forward tramp-buf-regexp (tramp-point-at-eol) t)
	      (forward-line 1)
	    (forward-line 0)
	    (let ((start (point)))
	      (forward-line 1)
	      (kill-region start (point)))))
	(insert "
The buffer(s) above will be appended to this message.  If you don't want
to append a buffer because it contains sensible data, or because the buffer
is too large, you should delete the respective buffer.  The buffer(s) will
contain user and host names.  Passwords will never be included there.")