Fix some minor Tramp problems

* lisp/net/tramp-gvfs.el (tramp-gvfs-maybe-open-connection):
Check, that `tramp-password-save-function' is a function.

* lisp/net/tramp-smb.el (tramp-smb-handle-file-system-info):
Check, that there is a share.

* lisp/net/tramp.el (outline-regexp): Declare.
(tramp-get-debug-buffer): Let-bind `signal-hook-function'.

* test/lisp/net/tramp-tests.el (tramp-test04-substitute-in-file-name):
Skip some tests for Emacs 24 and 25; they let Emacs crash.
This commit is contained in:
Michael Albinus 2019-10-31 11:13:13 +01:00
parent e168bb7386
commit bdb33af39d
4 changed files with 65 additions and 55 deletions

View file

@ -1911,7 +1911,9 @@ connection if a previous connection has died for some reason."
(tramp-error vec 'file-error "FUSE mount denied"))
;; Save the password.
(ignore-errors (funcall tramp-password-save-function))
(ignore-errors
(and (functionp tramp-password-save-function)
(funcall tramp-password-save-function)))
;; Set connection-local variables.
(tramp-set-connection-local-variables vec)

View file

@ -946,29 +946,31 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(unless (file-directory-p filename)
(setq filename (file-name-directory filename)))
(with-parsed-tramp-file-name (expand-file-name filename) nil
(tramp-message v 5 "file system info: %s" localname)
(tramp-smb-send-command v (format "du %s/*" (tramp-smb-get-localname v)))
(with-current-buffer (tramp-get-connection-buffer v)
(let (total avail blocksize)
(goto-char (point-min))
(forward-line)
(when (looking-at
(eval-when-compile
(concat "[[:space:]]*\\([[:digit:]]+\\)"
" blocks of size \\([[:digit:]]+\\)"
"\\. \\([[:digit:]]+\\) blocks available")))
(setq blocksize (string-to-number (match-string 2))
total (* blocksize (string-to-number (match-string 1)))
avail (* blocksize (string-to-number (match-string 3)))))
(forward-line)
(when (looking-at "Total number of bytes: \\([[:digit:]]+\\)")
;; The used number of bytes is not part of the result. As
;; side effect, we store it as file property.
(tramp-set-file-property
v localname "used-bytes" (string-to-number (match-string 1))))
;; Result.
(when (and total avail)
(list total (- total avail) avail)))))))
(when (tramp-smb-get-share v)
(tramp-message v 5 "file system info: %s" localname)
(tramp-smb-send-command
v (format "du %s/*" (tramp-smb-get-localname v)))
(with-current-buffer (tramp-get-connection-buffer v)
(let (total avail blocksize)
(goto-char (point-min))
(forward-line)
(when (looking-at
(eval-when-compile
(concat "[[:space:]]*\\([[:digit:]]+\\)"
" blocks of size \\([[:digit:]]+\\)"
"\\. \\([[:digit:]]+\\) blocks available")))
(setq blocksize (string-to-number (match-string 2))
total (* blocksize (string-to-number (match-string 1)))
avail (* blocksize (string-to-number (match-string 3)))))
(forward-line)
(when (looking-at "Total number of bytes: \\([[:digit:]]+\\)")
;; The used number of bytes is not part of the result.
;; As side effect, we store it as file property.
(tramp-set-file-property
v localname "used-bytes" (string-to-number (match-string 1))))
;; Result.
(when (and total avail)
(list total (- total avail) avail))))))))
(defun tramp-smb-handle-file-writable-p (filename)
"Like `file-writable-p' for Tramp files."

View file

@ -64,6 +64,7 @@
(require 'cl-lib)
(declare-function netrc-parse "netrc")
(defvar auto-save-file-name-transforms)
(defvar outline-regexp)
;;; User Customizable Internal Variables:
@ -1650,7 +1651,8 @@ The outline level is equal to the verbosity of the Tramp message."
;; Furthermore, `outline-regexp' must have the correct value
;; already, because it is used by `font-lock-compile-keywords'.
(let ((default-directory (tramp-compat-temporary-file-directory))
(outline-regexp tramp-debug-outline-regexp))
(outline-regexp tramp-debug-outline-regexp)
signal-hook-function)
(outline-mode))
(set (make-local-variable 'outline-regexp) tramp-debug-outline-regexp)
(set (make-local-variable 'outline-level) 'tramp-debug-outline-level)

View file

@ -1956,36 +1956,40 @@ properly. BODY shall not contain a timeout."
(substitute-in-file-name "/method:host:/:/path//foo")
"/method:host:/:/path//foo"))
(should
(string-equal (substitute-in-file-name "/method:host://~foo") "/~foo"))
(should
(string-equal
(substitute-in-file-name "/method:host:/~foo") "/method:host:/~foo"))
(should
(string-equal
(substitute-in-file-name "/method:host:/path//~foo") "/~foo"))
;; (substitute-in-file-name "/path/~foo") expands only for a local
;; user "foo" to "/~foo"". Otherwise, it doesn't expand.
(should
(string-equal
(substitute-in-file-name
"/method:host:/path/~foo") "/method:host:/path/~foo"))
;; Quoting local part.
(should
(string-equal
(substitute-in-file-name "/method:host:/://~foo")
"/method:host:/://~foo"))
(should
(string-equal
(substitute-in-file-name "/method:host:/:/~foo") "/method:host:/:/~foo"))
(should
(string-equal
(substitute-in-file-name
"/method:host:/:/path//~foo") "/method:host:/:/path//~foo"))
(should
(string-equal
(substitute-in-file-name
"/method:host:/:/path/~foo") "/method:host:/:/path/~foo"))
;; Forwhatever reasons, the following tests let Emacs crash for
;; Emacs 24 and Emacs 25, occasionally. No idea what's up.
(when (or (tramp--test-emacs26-p) (tramp--test-emacs27-p))
(should
(string-equal (substitute-in-file-name "/method:host://~foo") "/~foo"))
(should
(string-equal
(substitute-in-file-name "/method:host:/~foo") "/method:host:/~foo"))
(should
(string-equal
(substitute-in-file-name "/method:host:/path//~foo") "/~foo"))
;; (substitute-in-file-name "/path/~foo") expands only for a local
;; user "foo" to "/~foo"". Otherwise, it doesn't expand.
(should
(string-equal
(substitute-in-file-name
"/method:host:/path/~foo") "/method:host:/path/~foo"))
;; Quoting local part.
(should
(string-equal
(substitute-in-file-name "/method:host:/://~foo")
"/method:host:/://~foo"))
(should
(string-equal
(substitute-in-file-name
"/method:host:/:/~foo") "/method:host:/:/~foo"))
(should
(string-equal
(substitute-in-file-name
"/method:host:/:/path//~foo") "/method:host:/:/path//~foo"))
(should
(string-equal
(substitute-in-file-name
"/method:host:/:/path/~foo") "/method:host:/:/path/~foo")))
(let (process-environment)
(should