From 4b21759b6f06f4560e5c8d7e4c52ce5c55393957 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 9 Jun 2020 13:43:30 +0200 Subject: [PATCH] Continue implementation of tramp-crypt.el * lisp/net/tramp-crypt.el (tramp-crypt-do-encrypt-or-decrypt-file): Add leading "/" to infile. (tramp-crypt-add-directory): Fix docstring. Expand NAME. (tramp-crypt-remove-directory) (tramp-crypt-handle-file-name-all-completions) (tramp-crypt-handle-set-file-times): New defuns. (tramp-crypt-handle-file-executable-p) (tramp-crypt-handle-file-readable-p) (tramp-crypt-handle-file-system-info) (tramp-crypt-handle-set-file-modes): Fix implementation. * test/lisp/net/tramp-tests.el: Adapt call convention for (tramp--test-crypt-p). --- lisp/net/tramp-crypt.el | 87 ++++++++++++++++++++++++++---------- test/lisp/net/tramp-tests.el | 32 ++++++------- 2 files changed, 80 insertions(+), 39 deletions(-) diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index 220a4add91f..d9ba2e49f76 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -67,8 +67,6 @@ ;; If a remote directory shall not include crypted files anymore, it ;; must be indicated by the command `tramp-crypt-remove-directory'. -;; Existing crypted files will be transformed into their unencrypted -;; file names and contents. ;;; Code: @@ -160,7 +158,7 @@ If NAME doesn't belong to a crypted remote directory, retun nil." (directory-files-and-attributes . tramp-handle-directory-files-and-attributes) (dired-compress-file . ignore) - ;; (dired-uncache . tramp-crypt-handle-dired-uncache) + (dired-uncache . tramp-handle-dired-uncache) (exec-path . ignore) ;; `expand-file-name' performed by default handler. (file-accessible-directory-p . tramp-handle-file-accessible-directory-p) @@ -173,10 +171,10 @@ If NAME doesn't belong to a crypted remote directory, retun nil." (file-in-directory-p . tramp-handle-file-in-directory-p) (file-local-copy . tramp-handle-file-local-copy) (file-modes . tramp-handle-file-modes) - ;; (file-name-all-completions . tramp-crypt-handle-file-name-all-completions) + (file-name-all-completions . tramp-crypt-handle-file-name-all-completions) ;; `file-name-as-directory' performed by default handler. - ;; (file-name-case-insensitive-p . ignore) - ;; (file-name-completion . tramp-handle-file-name-completion) + (file-name-case-insensitive-p . ignore) + (file-name-completion . tramp-handle-file-name-completion) ;; `file-name-directory' performed by default handler. ;; `file-name-nondirectory' performed by default handler. ;; `file-name-sans-versions' performed by default handler. @@ -193,11 +191,11 @@ If NAME doesn't belong to a crypted remote directory, retun nil." (file-system-info . tramp-crypt-handle-file-system-info) ;; (file-truename . tramp-crypt-handle-file-truename) ;; (file-writable-p . ignore) - (find-backup-file-name . ignore) + (find-backup-file-name . tramp-handle-find-backup-file-name) ;; `get-file-buffer' performed by default handler. (insert-directory . tramp-crypt-handle-insert-directory) ;; `insert-file-contents' performed by default handler. - ;; (load . tramp-crypt-handle-load) + (load . tramp-handle-load) (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) (make-directory . tramp-crypt-handle-make-directory) ;; (make-directory-internal . tramp-crypt-handle-not-implemented) @@ -209,8 +207,8 @@ If NAME doesn't belong to a crypted remote directory, retun nil." (set-file-acl . ignore) (set-file-modes . tramp-crypt-handle-set-file-modes) (set-file-selinux-context . ignore) - ;; (set-file-times . tramp-crypt-handle-not-implemented) - ;; (set-visited-file-modtime . tramp-handle-set-visited-file-modtime) + (set-file-times . tramp-crypt-handle-set-file-times) + (set-visited-file-modtime . tramp-handle-set-visited-file-modtime) (shell-command . ignore) (start-file-process . ignore) ;; `substitute-in-file-name' performed by default handler. @@ -218,7 +216,7 @@ If NAME doesn't belong to a crypted remote directory, retun nil." ;; `tramp-set-file-uid-gid' performed by default handler. ;; (unhandled-file-name-directory . ignore) (vc-registered . ignore) - ;; (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) + (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) (write-region . tramp-handle-write-region)) "Alist of handler functions for crypt method. Operations not mentioned here will be handled by the default Emacs primitives.") @@ -434,7 +432,8 @@ If OP ist `decrypt', the basename of INFILE must be an encrypted file name." (if (eq op 'encrypt) 'raw-text coding-system-for-write))) (tramp-crypt-send-command crypt-vec "cat" (and (eq op 'encrypt) "--reverse") - (file-name-directory infile) (file-name-nondirectory infile)) + (file-name-directory infile) + (concat "/" (file-name-nondirectory infile))) (with-current-buffer (tramp-get-connection-buffer crypt-vec) (write-region nil nil outfile))))) @@ -452,18 +451,35 @@ See `tramp-crypt-do-encrypt-or-decrypt-file'." (defun tramp-crypt-add-directory (name) "Mark remote directory NAME for encryption. Files in that directory and all subdirectories will be encrypted -bofore copying to, and decrypted after copying from that +before copying to, and decrypted after copying from that directory. File names will be also encrypted." (interactive "DRemote directory name: ") (unless tramp-crypt-enabled (tramp-user-error nil "Feature is not enabled.")) (unless (and (tramp-tramp-file-p name) (file-directory-p name)) (tramp-user-error nil "%s must be an existing remote directory." name)) - (setq name (file-name-as-directory name)) + (setq name (file-name-as-directory (expand-file-name name))) (unless (member name tramp-crypt-directories) - (setq tramp-crypt-directories `(,name . ,tramp-crypt-directories))) + (setq tramp-crypt-directories (cons name tramp-crypt-directories))) (tramp-register-file-name-handlers)) +(defun tramp-crypt-remove-directory (name) + "Unmark remote directory NAME for encryption. +Existing files in that directory and its subdirectories will be +kept in their encrypted form." + (interactive "DRemote directory name: ") + (unless tramp-crypt-enabled + (tramp-user-error nil "Feature is not enabled.")) + (setq name (file-name-as-directory (expand-file-name name))) + (when (and (member name tramp-crypt-directories) + (delete + tramp-crypt-encfs-config + (directory-files name nil directory-files-no-dot-files-regexp)) + (yes-or-no-p + "There exist encrypted files, do you want to continue? ")) + (setq tramp-crypt-directories (delete name tramp-crypt-directories)) + (tramp-register-file-name-handlers))) + ;; `auth-source' requires a user. (defun tramp-crypt-dissect-file-name (name) "Return a `tramp-file-name' structure for NAME. @@ -647,18 +663,35 @@ absolute file names." (defun tramp-crypt-handle-file-executable-p (filename) "Like `file-executable-p' for Tramp files." - (tramp-crypt-run-real-handler - #'file-executable-p (list (tramp-crypt-encrypt-file-name filename)))) + (let (tramp-crypt-enabled) + (file-executable-p (tramp-crypt-encrypt-file-name filename)))) + +(defun tramp-crypt-handle-file-name-all-completions (filename directory) + "Like `file-name-all-completions' for Tramp files." + (all-completions + filename + (let* (completion-regexp-list + tramp-crypt-enabled + (directory (file-name-as-directory directory)) + (enc-dir (tramp-crypt-encrypt-file-name directory))) + (mapcar + (lambda (x) + (substring + (tramp-crypt-decrypt-file-name (concat enc-dir x)) + (length directory))) + (file-name-all-completions "" enc-dir))))) (defun tramp-crypt-handle-file-readable-p (filename) "Like `file-readable-p' for Tramp files." - (tramp-crypt-run-real-handler - #'file-readable-p (list (tramp-crypt-encrypt-file-name filename)))) + (let (tramp-crypt-enabled) + (file-readable-p (tramp-crypt-encrypt-file-name filename)))) (defun tramp-crypt-handle-file-system-info (filename) "Like `file-system-info' for Tramp files." (tramp-crypt-run-real-handler - #'file-system-info (list (tramp-crypt-encrypt-file-name filename)))) + ;; `file-system-info' exists since Emacs 27.1. Then, we can use + ;; #'file-system-info. + 'file-system-info (list (tramp-crypt-encrypt-file-name filename)))) (defun tramp-crypt-handle-insert-directory (filename switches &optional wildcard full-directory-p) @@ -714,9 +747,17 @@ absolute file names." "Like `set-file-modes' for Tramp files." (with-parsed-tramp-file-name filename nil (tramp-flush-file-properties v localname) - (tramp-crypt-run-real-handler - #'set-file-modes - (list (tramp-crypt-encrypt-file-name filename) mode flag)))) + (let (tramp-crypt-enabled) + (tramp-compat-set-file-modes + (tramp-crypt-encrypt-file-name filename) mode flag)))) + +(defun tramp-crypt-handle-set-file-times (filename &optional time flag) + "Like `set-file-times' for Tramp files." + (with-parsed-tramp-file-name filename nil + (tramp-flush-file-properties v localname) + (let (tramp-crypt-enabled) + (tramp-compat-set-file-times + (tramp-crypt-encrypt-file-name filename) time flag)))) (add-hook 'tramp-unload-hook (lambda () diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 7faa409f2f0..d578c359d79 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3815,7 +3815,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." "Check that `file-acl' and `set-file-acl' work proper." (skip-unless (tramp--test-enabled)) (skip-unless (file-acl tramp-test-temporary-file-directory)) - (skip-unless (null (tramp--test-crypt-p))) + (skip-unless (not (tramp--test-crypt-p))) ;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579. (dolist (quoted (if (and (tramp--test-expensive-test) (tramp--test-emacs27-p)) @@ -3894,7 +3894,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (skip-unless (not (equal (file-selinux-context tramp-test-temporary-file-directory) '(nil nil nil nil)))) - (skip-unless (null (tramp--test-crypt-p))) + (skip-unless (not (tramp--test-crypt-p))) ;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579. (dolist (quoted (if (and (tramp--test-expensive-test) (tramp--test-emacs27-p)) @@ -4198,7 +4198,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) - (skip-unless (null (tramp--test-crypt-p))) + (skip-unless (not (tramp--test-crypt-p))) (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let* ((tmp-name (tramp--test-make-temp-name nil quoted)) @@ -4277,7 +4277,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) - (skip-unless (null (tramp--test-crypt-p))) + (skip-unless (not (tramp--test-crypt-p))) (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let ((default-directory tramp-test-temporary-file-directory) @@ -4351,7 +4351,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) - (skip-unless (null (tramp--test-crypt-p))) + (skip-unless (not (tramp--test-crypt-p))) ;; `make-process' supports file name handlers since Emacs 27. (skip-unless (tramp--test-emacs27-p)) @@ -4522,7 +4522,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) - (skip-unless (null (tramp--test-crypt-p))) + (skip-unless (not (tramp--test-crypt-p))) ;; Since Emacs 26.1. (skip-unless (boundp 'interrupt-process-functions)) @@ -4583,7 +4583,7 @@ INPUT, if non-nil, is a string sent to the process." ;; remote processes in Emacs. That doesn't work for tramp-adb.el. (skip-unless (or (and (tramp--test-adb-p) (tramp--test-emacs27-p)) (tramp--test-sh-p))) - (skip-unless (null (tramp--test-crypt-p))) + (skip-unless (not (tramp--test-crypt-p))) (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let ((tmp-name (tramp--test-make-temp-name nil quoted)) @@ -4675,7 +4675,7 @@ INPUT, if non-nil, is a string sent to the process." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) - (skip-unless (null (tramp--test-crypt-p))) + (skip-unless (not (tramp--test-crypt-p))) ;; Prior Emacs 27, `shell-command-dont-erase-buffer' wasn't working properly. (skip-unless (tramp--test-emacs27-p)) @@ -4888,7 +4888,7 @@ INPUT, if non-nil, is a string sent to the process." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) - (skip-unless (null (tramp--test-crypt-p))) + (skip-unless (not (tramp--test-crypt-p))) (dolist (this-shell-command-to-string '(;; Synchronously. @@ -4975,7 +4975,7 @@ INPUT, if non-nil, is a string sent to the process." ;; We test it only for the mock-up connection; otherwise there might ;; be problems with the used ports. (skip-unless (and (eq tramp-syntax 'default) (tramp--test-mock-p))) - (skip-unless (null (tramp--test-crypt-p))) + (skip-unless (not (tramp--test-crypt-p))) ;; We force a reconnect, in order to have a clean environment. (dolist (dir `(,tramp-test-temporary-file-directory @@ -5080,7 +5080,7 @@ INPUT, if non-nil, is a string sent to the process." ;; remote processes in Emacs. That doesn't work for tramp-adb.el. (skip-unless (or (and (tramp--test-adb-p) (tramp--test-emacs27-p)) (tramp--test-sh-p))) - (skip-unless (null (tramp--test-crypt-p))) + (skip-unless (not (tramp--test-crypt-p))) ;; Since Emacs 26.1. (skip-unless (and (fboundp 'connection-local-set-profile-variables) (fboundp 'connection-local-set-profiles))) @@ -5137,7 +5137,7 @@ INPUT, if non-nil, is a string sent to the process." "Check `exec-path' and `executable-find'." (skip-unless (tramp--test-enabled)) (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) - (skip-unless (null (tramp--test-crypt-p))) + (skip-unless (not (tramp--test-crypt-p))) ;; Since Emacs 27.1. (skip-unless (fboundp 'exec-path)) @@ -5181,7 +5181,7 @@ INPUT, if non-nil, is a string sent to the process." "Check loooong `tramp-remote-path'." (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) - (skip-unless (null (tramp--test-crypt-p))) + (skip-unless (not (tramp--test-crypt-p))) ;; Since Emacs 27.1. (skip-unless (fboundp 'exec-path)) @@ -5246,7 +5246,7 @@ INPUT, if non-nil, is a string sent to the process." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) - (skip-unless (null (tramp--test-crypt-p))) + (skip-unless (not (tramp--test-crypt-p))) (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) ;; We must use `file-truename' for the temporary directory, in @@ -5835,7 +5835,7 @@ This requires restrictions of file name syntax." ;; We do not run on macOS due to encoding problems. See ;; Bug#36940. (when (and (tramp--test-expensive-test) (tramp--test-sh-p) - (null (tramp--test-crypt-p)) + (not (tramp--test-crypt-p)) (not (eq system-type 'darwin))) (dolist (elt files) (let ((envvar (concat "VAR_" (upcase (md5 elt)))) @@ -6168,7 +6168,7 @@ process sentinels. They shall not disturb each other." ;; remote processes in Emacs. That doesn't work for tramp-adb.el. (skip-unless (or (and (tramp--test-adb-p) (tramp--test-emacs27-p)) (tramp--test-sh-p))) - (skip-unless (null (tramp--test-crypt-p))) + (skip-unless (not (tramp--test-crypt-p))) (with-timeout (tramp--test-asynchronous-requests-timeout (tramp--test-timeout-handler)) -- 2.39.5