master 4b21759: Continue implementation of tramp-crypt.el

[Michael Albinus]

branch: master
commit 4b21759b6f06f4560e5c8d7e4c52ce5c55393957
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>

    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 220a4ad..d9ba2e4 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 7faa409..d578c35 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))