procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Implement access-file in Tramp

Browse source 
* lisp/net/tramp-adb.el (tramp-adb-file-name-handler-alist):
* lisp/net/tramp-archive.el (tramp-archive-file-name-handler-alist):
* lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist):
* lisp/net/tramp-rclone.el (tramp-rclone-file-name-handler-alist):
* lisp/net/tramp-sh.el (tramp-sh-file-name-handler-alist)
* lisp/net/tramp-smb.el (tramp-smb-file-name-handler-alist):
* lisp/net/tramp-sudoedit.el (tramp-sudoedit-file-name-handler-alist):
Add `access-file'.

* lisp/net/tramp-archive.el (tramp-archive-handle-access-file):
* lisp/net/tramp.el (tramp-handle-access-file): New defun.
(tramp-condition-case-unless-debug): Add declaration.
(tramp-handle-insert-directory):
* lisp/net/tramp-sh.el (tramp-sh-handle-insert-directory):
* lisp/net/tramp-smb.el (tramp-smb-handle-insert-directory):
Check, whether directory is accessible.

* test/lisp/net/tramp-archive-tests.el
(tramp-archive-test17-insert-directory)
(tramp-archive-test18-file-attributes):
* test/lisp/net/tramp-tests.el (tramp-test17-insert-directory)
(tramp-test18-file-attributes): Test error cases.
This commit is contained in:
Michael Albinus 2019-02-19 14:00:17 +01:00
parent e8b6cc9a99
commit 0a6c4479cf
10 changed files with 67 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
lisp/net/tramp-adb.el
View file

@ -88,7 +88,7 @@ It is used for TCP/IP devices."
;;;###tramp-autoload
(defconst tramp-adb-file-name-handler-alist
'((access-file . ignore)
'((access-file . tramp-handle-access-file)
(add-name-to-file . tramp-handle-add-name-to-file)
;; `byte-compiler-base-file-name' performed by default handler.
;; `copy-directory' performed by default handler.

6
lisp/net/tramp-archive.el
View file

@ -209,7 +209,7 @@ It must be supported by libarchive(3).")
;; New handlers should be added here.
;;;###tramp-autoload
(defconst tramp-archive-file-name-handler-alist
'((access-file . ignore)
'((access-file . tramp-archive-handle-access-file)
(add-name-to-file . tramp-archive-handle-not-implemented)
;; `byte-compiler-base-file-name' performed by default handler.
;; `copy-directory' performed by default handler.
@ -531,6 +531,10 @@ offered."
;; File name primitives.
(defun tramp-archive-handle-access-file (filename string)
"Like `access-file' for Tramp files."
(access-file (tramp-archive-gvfs-file-name filename) string))
(defun tramp-archive-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
preserve-uid-gid preserve-extended-attributes)

2
lisp/net/tramp-gvfs.el
View file

@ -523,7 +523,7 @@ It has been changed in GVFS 1.14.")
;; New handlers should be added here.
;;;###tramp-autoload
(defconst tramp-gvfs-file-name-handler-alist
'((access-file . ignore)
'((access-file . tramp-handle-access-file)
(add-name-to-file . tramp-handle-add-name-to-file)
;; `byte-compiler-base-file-name' performed by default handler.
;; `copy-directory' performed by default handler.

2
lisp/net/tramp-rclone.el
View file

@ -66,7 +66,7 @@
;; New handlers should be added here.
;;;###tramp-autoload
(defconst tramp-rclone-file-name-handler-alist
'((access-file . ignore)
'((access-file . tramp-handle-access-file)
(add-name-to-file . tramp-handle-add-name-to-file)
;; `byte-compiler-base-file-name' performed by default handler.
;; `copy-directory' performed by default handler.

5
lisp/net/tramp-sh.el
View file

@ -940,7 +940,7 @@ of command line.")
;; New handlers should be added here.
;;;###tramp-autoload
(defconst tramp-sh-file-name-handler-alist
'(;; `access-file' performed by default handler.
'((access-file . tramp-handle-access-file)
(add-name-to-file . tramp-sh-handle-add-name-to-file)
;; `byte-compiler-base-file-name' performed by default handler.
(copy-directory . tramp-sh-handle-copy-directory)
@ -2574,6 +2574,9 @@ The method used must be an out-of-band method."
"Like `insert-directory' for Tramp files."
(setq filename (expand-file-name filename))
(unless switches (setq switches ""))
;; Check, whether directory is accessible.
(unless wildcard
(access-file filename "Reading directory"))
(with-parsed-tramp-file-name filename nil
(if (and (featurep 'ls-lisp)
(not (symbol-value 'ls-lisp-use-insert-directory-program)))

5
lisp/net/tramp-smb.el
View file

@ -214,7 +214,7 @@ See `tramp-actions-before-shell' for more info.")
;; New handlers should be added here.
;;;###tramp-autoload
(defconst tramp-smb-file-name-handler-alist
'(;; `access-file' performed by default handler.
'((access-file . tramp-handle-access-file)
(add-name-to-file . tramp-smb-handle-add-name-to-file)
;; `byte-compiler-base-file-name' performed by default handler.
(copy-directory . tramp-smb-handle-copy-directory)
@ -994,6 +994,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; Called from `dired-add-entry'.
(setq filename (file-name-as-directory filename))
(setq filename (directory-file-name filename)))
;; Check, whether directory is accessible.
(unless wildcard
(access-file filename "Reading directory"))
(with-parsed-tramp-file-name filename nil
(with-tramp-progress-reporter v 0 (format "Opening directory %s" filename)
(save-match-data

2
lisp/net/tramp-sudoedit.el
View file

@ -63,7 +63,7 @@ See `tramp-actions-before-shell' for more info.")
;;;###tramp-autoload
(defconst tramp-sudoedit-file-name-handler-alist
'((access-file . ignore)
'((access-file . tramp-handle-access-file)
(add-name-to-file . tramp-sudoedit-handle-add-name-to-file)
(byte-compiler-base-file-name . ignore)
;; `copy-directory' performed by default handler.

11
lisp/net/tramp.el
View file

@ -2310,6 +2310,7 @@ ARGS are the arguments OPERATION has been called with."
(defmacro tramp-condition-case-unless-debug
(var bodyform &rest handlers)
"Like `condition-case-unless-debug' but `tramp-debug-on-error'."
(declare (debug condition-case) (indent 2))
`(let ((debug-on-error tramp-debug-on-error))
(condition-case-unless-debug ,var ,bodyform ,@handlers)))
@ -3060,6 +3061,13 @@ User is always nil."
(defvar tramp-handle-write-region-hook nil
"Normal hook to be run at the end of `tramp-*-handle-write-region'.")
(defun tramp-handle-access-file (filename string)
"Like `access-file' for Tramp files."
(unless (file-readable-p filename)
(tramp-error
(tramp-dissect-file-name filename) tramp-file-missing
"%s: No such file or directory %s" string filename)))
(defun tramp-handle-add-name-to-file
(filename newname &optional ok-if-already-exists)
"Like `add-name-to-file' for Tramp files."
@ -3439,6 +3447,9 @@ User is always nil."
(when (and (zerop (length (file-name-nondirectory filename)))
(not full-directory-p))
(setq switches (concat switches "F")))
;; Check, whether directory is accessible.
(unless wildcard
(access-file filename "Reading directory"))
(with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-progress-reporter v 0 (format "Opening directory %s" filename)
(require 'ls-lisp)

21
test/lisp/net/tramp-archive-tests.el
View file

@ -570,26 +570,35 @@ This checks also `file-name-as-directory', `file-name-directory',
(format
"\\(.+ %s\\( ->.+\\)?\n\\)\\{%d\\}"
(regexp-opt (directory-files tramp-archive-test-archive))
(length (directory-files tramp-archive-test-archive))))))))
(length (directory-files tramp-archive-test-archive)))))))
;; Check error case.
(with-temp-buffer
(should-error
(insert-directory
(expand-file-name "baz" tramp-archive-test-archive) nil)
:type tramp-file-missing)))
;; Cleanup.
(tramp-archive-cleanup-hash))))
(ert-deftest tramp-archive-test18-file-attributes ()
"Check `file-attributes'.
This tests also `file-readable-p' and `file-regular-p'."
This tests also `access-file', `file-readable-p' and `file-regular-p'."
:tags '(:expensive-test)
(skip-unless tramp-archive-enabled)
(let ((tmp-name1 (expand-file-name "foo.txt" tramp-archive-test-archive))
(tmp-name2 (expand-file-name "foo.lnk" tramp-archive-test-archive))
(tmp-name3 (expand-file-name "bar" tramp-archive-test-archive))
(tmp-name4 (expand-file-name "baz" tramp-archive-test-archive))
attr)
(unwind-protect
(progn
(should (file-exists-p tmp-name1))
(should (file-readable-p tmp-name1))
(should (file-regular-p tmp-name1))
(should-not (access-file tmp-name1 "error"))
;; We do not test inodes and device numbers.
(setq attr (file-attributes tmp-name1))
@ -622,7 +631,13 @@ This tests also `file-readable-p' and `file-regular-p'."
(should (file-readable-p tmp-name3))
(should-not (file-regular-p tmp-name3))
(setq attr (file-attributes tmp-name3))
(should (eq (car attr) t)))
(should (eq (car attr) t))
(should-not (access-file tmp-name3 "error"))
;; Check error case.
(should-error
(access-file tmp-name4 "error")
:type tramp-file-missing))
;; Cleanup.
(tramp-archive-cleanup-hash))))

26
test/lisp/net/tramp-tests.el
View file

@ -2730,7 +2730,14 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
(format
"\\(.+ %s\\( ->.+\\)?\n\\)\\{%d\\}"
(regexp-opt (directory-files tmp-name1))
(length (directory-files tmp-name1))))))))
(length (directory-files tmp-name1)))))))
;; Check error case. We do not check for the error type,
;; because ls-lisp returns `file-error', and native Tramp
;; returns `file-missing'.
(delete-directory tmp-name1 'recursive)
(with-temp-buffer
(should-error (insert-directory tmp-name1 nil))))
;; Cleanup.
(ignore-errors (delete-directory tmp-name1 'recursive))))))
@ -2856,8 +2863,8 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
(ert-deftest tramp-test18-file-attributes ()
"Check `file-attributes'.
This tests also `file-readable-p', `file-regular-p' and
`file-ownership-preserved-p'."
This tests also `access-file', `file-readable-p',
`file-regular-p' and `file-ownership-preserved-p'."
(skip-unless (tramp--test-enabled))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
@ -2878,6 +2885,9 @@ This tests also `file-readable-p', `file-regular-p' and
attr)
(unwind-protect
(progn
(should-error
(access-file tmp-name1 "error")
:type tramp-file-missing)
;; `file-ownership-preserved-p' should return t for
;; non-existing files. It is implemented only in tramp-sh.el.
(when (tramp--test-sh-p)
@ -2886,6 +2896,7 @@ This tests also `file-readable-p', `file-regular-p' and
(should (file-exists-p tmp-name1))
(should (file-readable-p tmp-name1))
(should (file-regular-p tmp-name1))
(should-not (access-file tmp-name1 "error"))
(when (tramp--test-sh-p)
(should (file-ownership-preserved-p tmp-name1 'group)))
@ -2910,11 +2921,15 @@ This tests also `file-readable-p', `file-regular-p' and
(should (stringp (nth 3 attr))) ;; Gid.
(tramp--test-ignore-make-symbolic-link-error
(should-error
(access-file tmp-name2 "error")
:type tramp-file-missing)
(when (tramp--test-sh-p)
(should (file-ownership-preserved-p tmp-name2 'group)))
(make-symbolic-link tmp-name1 tmp-name2)
(should (file-exists-p tmp-name2))
(should (file-symlink-p tmp-name2))
(should-not (access-file tmp-name2 "error"))
(when (tramp--test-sh-p)
(should (file-ownership-preserved-p tmp-name2 'group)))
(setq attr (file-attributes tmp-name2))
@ -2953,6 +2968,7 @@ This tests also `file-readable-p', `file-regular-p' and
(should (file-exists-p tmp-name1))
(should (file-readable-p tmp-name1))
(should-not (file-regular-p tmp-name1))
(should-not (access-file tmp-name1 ""))
(when (tramp--test-sh-p)
(should (file-ownership-preserved-p tmp-name1 'group)))
(setq attr (file-attributes tmp-name1))
@ -5590,8 +5606,8 @@ Since it unloads Tramp, it shall be the last test to run."
;; * Fix `tramp-test06-directory-file-name' for `ftp'.
;; * Investigate, why `tramp-test11-copy-file' and `tramp-test12-rename-file'
;; do not work properly for `nextcloud'.
;; * Fix `tramp-test29-start-file-process' on MS Windows (`process-send-eof'?).
;; * Fix `tramp-test31-interrupt-process', timeout doesn't work reliably.
;; * Fix `tramp-test29-start-file-process' and
;; `tramp-test30-make-process' on MS Windows (`process-send-eof'?).
;; * Fix Bug#16928 in `tramp-test43-asynchronous-requests'.
(provide 'tramp-tests)