diff options
| author | Michael Albinus | 2020-06-07 16:57:32 +0200 |
|---|---|---|
| committer | Michael Albinus | 2020-06-07 16:57:32 +0200 |
| commit | a6b0e7202d5ea747d99731e1228badcead80eee6 (patch) | |
| tree | cd32f4e76d5f41a7b542482221ca0031eff6fb20 | |
| parent | 54e840a8b44712eff63929c01a916531051c3e0b (diff) | |
| download | emacs-a6b0e7202d5ea747d99731e1228badcead80eee6.tar.gz emacs-a6b0e7202d5ea747d99731e1228badcead80eee6.zip | |
Add file encryption to Tramp
* lisp/net/tramp-crypt.el: New file.
* lisp/net/tramp.el (tramp-run-real-handler):
Add `tramp-crypt-file-name-handler'.
(tramp-register-file-name-handlers):
Call `tramp-register-crypt-file-name-handler'.
(tramp-handle-insert-file-contents, tramp-local-host-p): Check for
`tramp-crypt-enabled'
* test/lisp/net/tramp-tests.el (tramp--test-crypt-p): New defun.
(tramp-test24-file-acl, tramp-test25-file-selinux)
(tramp-test28-process-file, tramp-test29-start-file-process)
(tramp-test30-make-process, tramp-test31-interrupt-process)
(tramp-test32-shell-command)
(tramp-test32-shell-command-dont-erase-buffer)
(tramp-test33-environment-variables)
(tramp-test33-environment-variables-and-port-numbers)
(tramp-test34-explicit-shell-file-name, tramp-test35-exec-path)
(tramp-test35-remote-path, tramp-test36-vc-registered)
(tramp--test-check-files, tramp-test43-asynchronous-requests): Use it.
| -rw-r--r-- | lisp/net/tramp-crypt.el | 730 | ||||
| -rw-r--r-- | lisp/net/tramp.el | 15 | ||||
| -rw-r--r-- | test/lisp/net/tramp-tests.el | 20 |
3 files changed, 762 insertions, 3 deletions
diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el new file mode 100644 index 00000000000..1df38c3121b --- /dev/null +++ b/lisp/net/tramp-crypt.el | |||
| @@ -0,0 +1,730 @@ | |||
| 1 | ;;; tramp-crypt.el --- Tramp crypt utilities -*- lexical-binding:t -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2020 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Michael Albinus <michael.albinus@gmx.de> | ||
| 6 | ;; Keywords: comm, processes | ||
| 7 | ;; Package: tramp | ||
| 8 | |||
| 9 | ;; This file is part of GNU Emacs. | ||
| 10 | |||
| 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 12 | ;; it under the terms of the GNU General Public License as published by | ||
| 13 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 14 | ;; (at your option) any later version. | ||
| 15 | |||
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 19 | ;; GNU General Public License for more details. | ||
| 20 | |||
| 21 | ;; You should have received a copy of the GNU General Public License | ||
| 22 | ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. | ||
| 23 | |||
| 24 | ;;; Commentary: | ||
| 25 | |||
| 26 | ;; Access functions for crypted remote files. It uses encfs to | ||
| 27 | ;; encrypt/ decrypt the files on a remote directory. A remote | ||
| 28 | ;; directory, which shall include crypted files, must be declared in | ||
| 29 | ;; `tramp-crypt-directories' via command `tramp-crypt-add-directory'. | ||
| 30 | ;; All files in that directory, including all subdirectories, are | ||
| 31 | ;; stored there encrypted. This includes file names and directory | ||
| 32 | ;; names. | ||
| 33 | |||
| 34 | ;; This package is just responsible for the encryption part. Copying | ||
| 35 | ;; of the crypted files is still the responsibility of the remote file | ||
| 36 | ;; name handlers. | ||
| 37 | |||
| 38 | ;; A password protected encfs configuration file is created the very | ||
| 39 | ;; first time you access a crypted remote directory. It is kept in | ||
| 40 | ;; your user directory "~/.emacs.d/" with the url-encoded directory | ||
| 41 | ;; name as part of the basename, and ".encfs6.xml" as suffix. Do not | ||
| 42 | ;; loose this file and the corresponding password; otherwise there is | ||
| 43 | ;; no way to decrypt your crypted files. | ||
| 44 | |||
| 45 | ;; If the user option `tramp-crypt-save-encfs-config-remote' is | ||
| 46 | ;; non-nil (the default), the encfs configuration file ".encfs6.xml" | ||
| 47 | ;; is also be kept in the crypted remote directory. It depends, | ||
| 48 | ;; whether you regard the password protection of this file as | ||
| 49 | ;; sufficient. | ||
| 50 | |||
| 51 | ;; If you apply an operation with a quoted localname part, this | ||
| 52 | ;; localname and the corresponding file will not be encrypted/ | ||
| 53 | ;; decrypted. For example, if you have a crypted remote directory | ||
| 54 | ;; "/nextcloud:user@host:/crypted_dir", the command | ||
| 55 | ;; | ||
| 56 | ;; C-x d /nextcloud:user@host:/crypted_dir | ||
| 57 | ;; | ||
| 58 | ;; will show the directory listing with the plain file names, and the | ||
| 59 | ;; command | ||
| 60 | ;; | ||
| 61 | ;; C-x d /nextcloud:user@host:/:/crypted_dir | ||
| 62 | ;; | ||
| 63 | ;; will show the directory with the encrypted file names, and visiting | ||
| 64 | ;; a file will show its crypted contents. However, it is highly | ||
| 65 | ;; discouraged to mix crypted and not crypted files in the same | ||
| 66 | ;; directory. | ||
| 67 | |||
| 68 | ;; If a remote directory shall not include crypted files anymore, it | ||
| 69 | ;; must be indicated by the command `tramp-crypt-remove-directory'. | ||
| 70 | ;; Existing crypted files will be transformed into their unencrypted | ||
| 71 | ;; file names and contents. | ||
| 72 | |||
| 73 | ;;; Code: | ||
| 74 | |||
| 75 | (eval-when-compile (require 'cl-lib)) | ||
| 76 | (require 'tramp) | ||
| 77 | |||
| 78 | (autoload 'prop-match-beginning "text-property-search") | ||
| 79 | (autoload 'prop-match-end "text-property-search") | ||
| 80 | (autoload 'text-property-search-forward "text-property-search") | ||
| 81 | |||
| 82 | (defconst tramp-crypt-method "crypt" | ||
| 83 | "Method name for crypted remote directories.") | ||
| 84 | |||
| 85 | (defcustom tramp-crypt-encfs-program "encfs" | ||
| 86 | "Name of the encfs program." | ||
| 87 | :group 'tramp | ||
| 88 | :version "28.1" | ||
| 89 | :type 'string) | ||
| 90 | |||
| 91 | (defcustom tramp-crypt-encfsctl-program "encfsctl" | ||
| 92 | "Name of the encfsctl program." | ||
| 93 | :group 'tramp | ||
| 94 | :version "28.1" | ||
| 95 | :type 'string) | ||
| 96 | |||
| 97 | (defcustom tramp-crypt-encfs-option "--standard" | ||
| 98 | "Configuration option for encfs. | ||
| 99 | This could be either \"--standard\" or \"--paranoia\". The file | ||
| 100 | name IV chaining mode mode will always be disabled when | ||
| 101 | initializing a new crypted remote directory." | ||
| 102 | :group 'tramp | ||
| 103 | :version "28.1" | ||
| 104 | :type '(choice (const "--standard") | ||
| 105 | (const "--paranoia"))) | ||
| 106 | |||
| 107 | ;; We check only for encfs, assuming that encfsctl will be available | ||
| 108 | ;; as well. The autoloaded value is nil, the check will run when | ||
| 109 | ;; tramp-crypt.el is loaded by `tramp-crypt-add-directory'. It is a | ||
| 110 | ;; common technique to let-bind this variable to nil in order to | ||
| 111 | ;; suppress the file name operation of this package. | ||
| 112 | ;;;###tramp-autoload | ||
| 113 | (defvar tramp-crypt-enabled nil | ||
| 114 | "Non-nil when encryption support is available.") | ||
| 115 | (setq tramp-crypt-enabled (executable-find tramp-crypt-encfs-program)) | ||
| 116 | |||
| 117 | (defconst tramp-crypt-encfs-config ".encfs6.xml" | ||
| 118 | "Encfs configuration file name.") | ||
| 119 | |||
| 120 | (defcustom tramp-crypt-save-encfs-config-remote t | ||
| 121 | "Whether to keep the encfs configuration file in the crypted remote directory." | ||
| 122 | :group 'tramp | ||
| 123 | :version "28.1" | ||
| 124 | :type 'booleanp) | ||
| 125 | |||
| 126 | |||
| 127 | ;; New handlers should be added here. | ||
| 128 | ;;;###tramp-autoload | ||
| 129 | (defconst tramp-crypt-file-name-handler-alist | ||
| 130 | '(;; (access-file . tramp-crypt-handle-access-file) | ||
| 131 | ;; (add-name-to-file . tramp-crypt-handle-not-implemented) | ||
| 132 | ;; `byte-compiler-base-file-name' performed by default handler. | ||
| 133 | (copy-directory . tramp-handle-copy-directory) | ||
| 134 | (copy-file . tramp-crypt-handle-copy-file) | ||
| 135 | (delete-directory . tramp-crypt-handle-delete-directory) | ||
| 136 | (delete-file . tramp-crypt-handle-delete-file) | ||
| 137 | ;; `diff-latest-backup-file' performed by default handler. | ||
| 138 | ;; `directory-file-name' performed by default handler. | ||
| 139 | (directory-files . tramp-crypt-handle-directory-files) | ||
| 140 | (directory-files-and-attributes | ||
| 141 | . tramp-handle-directory-files-and-attributes) | ||
| 142 | (dired-compress-file . ignore) | ||
| 143 | ;; (dired-uncache . tramp-crypt-handle-dired-uncache) | ||
| 144 | (exec-path . ignore) | ||
| 145 | ;; `expand-file-name' performed by default handler. | ||
| 146 | (file-accessible-directory-p . tramp-handle-file-accessible-directory-p) | ||
| 147 | (file-acl . ignore) | ||
| 148 | (file-attributes . tramp-crypt-handle-file-attributes) | ||
| 149 | (file-directory-p . tramp-handle-file-directory-p) | ||
| 150 | (file-equal-p . tramp-handle-file-equal-p) | ||
| 151 | (file-executable-p . tramp-crypt-handle-file-executable-p) | ||
| 152 | (file-exists-p . tramp-handle-file-exists-p) | ||
| 153 | (file-in-directory-p . tramp-handle-file-in-directory-p) | ||
| 154 | (file-local-copy . tramp-handle-file-local-copy) | ||
| 155 | (file-modes . tramp-handle-file-modes) | ||
| 156 | ;; (file-name-all-completions . tramp-crypt-handle-file-name-all-completions) | ||
| 157 | ;; `file-name-as-directory' performed by default handler. | ||
| 158 | ;; (file-name-case-insensitive-p . ignore) | ||
| 159 | ;; (file-name-completion . tramp-handle-file-name-completion) | ||
| 160 | ;; `file-name-directory' performed by default handler. | ||
| 161 | ;; `file-name-nondirectory' performed by default handler. | ||
| 162 | ;; `file-name-sans-versions' performed by default handler. | ||
| 163 | (file-newer-than-file-p . tramp-handle-file-newer-than-file-p) | ||
| 164 | (file-notify-add-watch . ignore) | ||
| 165 | (file-notify-rm-watch . ignore) | ||
| 166 | (file-notify-valid-p . ignore) | ||
| 167 | ;; (file-ownership-preserved-p . ignore) | ||
| 168 | (file-readable-p . tramp-crypt-handle-file-readable-p) | ||
| 169 | (file-regular-p . tramp-handle-file-regular-p) | ||
| 170 | ;; `file-remote-p' performed by default handler. | ||
| 171 | (file-selinux-context . ignore) | ||
| 172 | (file-symlink-p . tramp-handle-file-symlink-p) | ||
| 173 | (file-system-info . tramp-crypt-handle-file-system-info) | ||
| 174 | ;; (file-truename . tramp-crypt-handle-file-truename) | ||
| 175 | ;; (file-writable-p . ignore) | ||
| 176 | (find-backup-file-name . ignore) | ||
| 177 | ;; `get-file-buffer' performed by default handler. | ||
| 178 | (insert-directory . tramp-crypt-handle-insert-directory) | ||
| 179 | ;; `insert-file-contents' performed by default handler. | ||
| 180 | ;; (load . tramp-crypt-handle-load) | ||
| 181 | (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) | ||
| 182 | (make-directory . tramp-crypt-handle-make-directory) | ||
| 183 | ;; (make-directory-internal . tramp-crypt-handle-not-implemented) | ||
| 184 | ;; (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) | ||
| 185 | (make-process . ignore) | ||
| 186 | (make-symbolic-link . tramp-handle-make-symbolic-link) | ||
| 187 | (process-file . ignore) | ||
| 188 | (rename-file . tramp-crypt-handle-rename-file) | ||
| 189 | (set-file-acl . ignore) | ||
| 190 | (set-file-modes . tramp-crypt-handle-set-file-modes) | ||
| 191 | (set-file-selinux-context . ignore) | ||
| 192 | ;; (set-file-times . tramp-crypt-handle-not-implemented) | ||
| 193 | ;; (set-visited-file-modtime . tramp-handle-set-visited-file-modtime) | ||
| 194 | (shell-command . ignore) | ||
| 195 | (start-file-process . ignore) | ||
| 196 | ;; `substitute-in-file-name' performed by default handler. | ||
| 197 | ;; (temporary-file-directory . tramp-crypt-handle-temporary-file-directory) | ||
| 198 | ;; `tramp-set-file-uid-gid' performed by default handler. | ||
| 199 | ;; (unhandled-file-name-directory . ignore) | ||
| 200 | (vc-registered . ignore) | ||
| 201 | ;; (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) | ||
| 202 | (write-region . tramp-handle-write-region)) | ||
| 203 | "Alist of handler functions for crypt method. | ||
| 204 | Operations not mentioned here will be handled by the default Emacs primitives.") | ||
| 205 | |||
| 206 | (defsubst tramp-crypt-file-name-for-operation (operation &rest args) | ||
| 207 | "Like `tramp-file-name-for-operation', but for crypted remote files." | ||
| 208 | (cl-letf (((symbol-function #'tramp-tramp-file-p) | ||
| 209 | #'tramp-crypt-file-name-p)) | ||
| 210 | (apply #'tramp-file-name-for-operation operation args))) | ||
| 211 | |||
| 212 | (defun tramp-crypt-run-real-handler (operation args) | ||
| 213 | "Invoke normal file name handler for OPERATION. | ||
| 214 | First arg specifies the OPERATION, second arg ARGS is a list of | ||
| 215 | arguments to pass to the OPERATION." | ||
| 216 | (let* ((inhibit-file-name-handlers | ||
| 217 | `(tramp-crypt-file-name-handler | ||
| 218 | . | ||
| 219 | ,(and (eq inhibit-file-name-operation operation) | ||
| 220 | inhibit-file-name-handlers))) | ||
| 221 | (inhibit-file-name-operation operation)) | ||
| 222 | (apply operation args))) | ||
| 223 | |||
| 224 | ;;;###tramp-autoload | ||
| 225 | (defun tramp-crypt-file-name-handler (operation &rest args) | ||
| 226 | "Invoke the crypted remote file related OPERATION. | ||
| 227 | First arg specifies the OPERATION, second arg ARGS is a list of | ||
| 228 | arguments to pass to the OPERATION." | ||
| 229 | (if-let ((filename (apply #'tramp-file-name-for-operation operation args)) | ||
| 230 | (fn (and (tramp-crypt-file-name-p filename) | ||
| 231 | (assoc operation tramp-crypt-file-name-handler-alist)))) | ||
| 232 | (save-match-data (apply (cdr fn) args)) | ||
| 233 | (tramp-crypt-run-real-handler operation args))) | ||
| 234 | |||
| 235 | ;;;###tramp-autoload | ||
| 236 | (progn (defun tramp-register-crypt-file-name-handler () | ||
| 237 | "Add crypt file name handler to `file-name-handler-alist'." | ||
| 238 | (when (and tramp-crypt-enabled tramp-crypt-directories) | ||
| 239 | (add-to-list 'file-name-handler-alist | ||
| 240 | (cons tramp-file-name-regexp #'tramp-crypt-file-name-handler)) | ||
| 241 | (put #'tramp-crypt-file-name-handler 'safe-magic t)))) | ||
| 242 | |||
| 243 | (tramp-register-file-name-handlers) | ||
| 244 | |||
| 245 | ;; Mark `operations' the handler is responsible for. | ||
| 246 | (put #'tramp-crypt-file-name-handler 'operations | ||
| 247 | (mapcar #'car tramp-crypt-file-name-handler-alist)) | ||
| 248 | |||
| 249 | |||
| 250 | ;; File name conversions. | ||
| 251 | |||
| 252 | ;;;###tramp-autoload | ||
| 253 | (defvar tramp-crypt-directories nil | ||
| 254 | "List of crypted remote directories.") | ||
| 255 | |||
| 256 | (defun tramp-crypt-file-name-p (name) | ||
| 257 | "Return the crypted remote directory NAME belongs to. | ||
| 258 | If NAME doesn't belong to a crypted remote directory, retun nil." | ||
| 259 | (catch 'crypt-file-name-p | ||
| 260 | (and tramp-crypt-enabled (stringp name) | ||
| 261 | (not (tramp-compat-file-name-quoted-p name)) | ||
| 262 | (not (string-suffix-p tramp-crypt-encfs-config name)) | ||
| 263 | (dolist (dir tramp-crypt-directories) | ||
| 264 | (and (string-prefix-p | ||
| 265 | dir (file-name-as-directory (expand-file-name name))) | ||
| 266 | (throw 'crypt-file-name-p dir)))))) | ||
| 267 | |||
| 268 | (defun tramp-crypt-config-file-name (vec) | ||
| 269 | "Return the encfs config file name for VEC." | ||
| 270 | (expand-file-name | ||
| 271 | (concat "tramp-" (tramp-file-name-host vec) tramp-crypt-encfs-config) | ||
| 272 | user-emacs-directory)) | ||
| 273 | |||
| 274 | (defun tramp-crypt-maybe-open-connection (vec) | ||
| 275 | "Maybe open a connection VEC. | ||
| 276 | Does not do anything if a connection is already open, but re-opens the | ||
| 277 | connection if a previous connection has died for some reason." | ||
| 278 | ;; For password handling, we need a process bound to the connection | ||
| 279 | ;; buffer. Therefore, we create a dummy process. Maybe there is a | ||
| 280 | ;; better solution? | ||
| 281 | (unless (get-buffer-process (tramp-get-connection-buffer vec)) | ||
| 282 | (let ((p (make-network-process | ||
| 283 | :name (tramp-get-connection-name vec) | ||
| 284 | :buffer (tramp-get-connection-buffer vec) | ||
| 285 | :server t :host 'local :service t :noquery t))) | ||
| 286 | (process-put p 'vector vec) | ||
| 287 | (set-process-query-on-exit-flag p nil))) | ||
| 288 | |||
| 289 | ;; The following operations must be performed w/o | ||
| 290 | ;; `tramp-crypt-file-name-handler'. | ||
| 291 | (let* (tramp-crypt-enabled | ||
| 292 | ;; Don't check for a proper method. | ||
| 293 | (non-essential t) | ||
| 294 | (remote-config | ||
| 295 | (expand-file-name | ||
| 296 | tramp-crypt-encfs-config (tramp-crypt-get-remote-dir vec))) | ||
| 297 | (local-config (tramp-crypt-config-file-name vec))) | ||
| 298 | ;; There is no local encfs6 config file. | ||
| 299 | (when (not (file-exists-p local-config)) | ||
| 300 | (if (and tramp-crypt-save-encfs-config-remote | ||
| 301 | (file-exists-p remote-config)) | ||
| 302 | ;; Copy remote encfs6 config file if possible. | ||
| 303 | (copy-file remote-config local-config 'ok 'keep) | ||
| 304 | |||
| 305 | ;; Create local encfs6 config file otherwise. | ||
| 306 | (let* ((default-directory (tramp-compat-temporary-file-directory)) | ||
| 307 | (tmpdir1 (file-name-as-directory | ||
| 308 | (tramp-compat-make-temp-file " .crypt" 'dir-flag))) | ||
| 309 | (tmpdir2 (file-name-as-directory | ||
| 310 | (tramp-compat-make-temp-file " .nocrypt" 'dir-flag)))) | ||
| 311 | ;; Enable `auth-source', unless "emacs -Q" has been called. | ||
| 312 | (tramp-set-connection-property | ||
| 313 | vec "first-password-request" tramp-cache-read-persistent-data) | ||
| 314 | (with-temp-buffer | ||
| 315 | (insert | ||
| 316 | (tramp-read-passwd | ||
| 317 | (tramp-get-connection-process vec) | ||
| 318 | (format | ||
| 319 | "New EncFS Password for %s " (tramp-crypt-get-remote-dir vec)))) | ||
| 320 | (when | ||
| 321 | (zerop | ||
| 322 | (tramp-call-process-region | ||
| 323 | vec (point-min) (point-max) | ||
| 324 | tramp-crypt-encfs-program nil (tramp-get-connection-buffer vec) | ||
| 325 | nil tramp-crypt-encfs-option "--extpass=cat" tmpdir1 tmpdir2)) | ||
| 326 | ;; Save the password. | ||
| 327 | (ignore-errors | ||
| 328 | (and (functionp tramp-password-save-function) | ||
| 329 | (funcall tramp-password-save-function))))) | ||
| 330 | |||
| 331 | ;; Write local config file. Suppress file name IV chaining mode. | ||
| 332 | (with-temp-file local-config | ||
| 333 | (insert-file-contents | ||
| 334 | (expand-file-name tramp-crypt-encfs-config tmpdir1)) | ||
| 335 | (goto-char (point-min)) | ||
| 336 | (when (search-forward | ||
| 337 | "<chainedNameIV>1</chainedNameIV>" nil 'noerror) | ||
| 338 | (replace-match "<chainedNameIV>0</chainedNameIV>"))) | ||
| 339 | |||
| 340 | ;; Unmount encfs. Delete temporary directories. | ||
| 341 | (tramp-call-process | ||
| 342 | vec tramp-crypt-encfs-program nil nil nil | ||
| 343 | "--unmount" tmpdir1 tmpdir2) | ||
| 344 | (delete-directory tmpdir1 'recursive) | ||
| 345 | (delete-directory tmpdir2) | ||
| 346 | |||
| 347 | ;; Copy local encfs6 config file to remote. | ||
| 348 | (when tramp-crypt-save-encfs-config-remote | ||
| 349 | (copy-file local-config remote-config 'ok 'keep))))))) | ||
| 350 | |||
| 351 | (defun tramp-crypt-send-command (vec &rest args) | ||
| 352 | "Send encfsctl command to connection VEC. | ||
| 353 | ARGS are the arguments." | ||
| 354 | (tramp-crypt-maybe-open-connection vec) | ||
| 355 | (with-current-buffer (tramp-get-connection-buffer vec) | ||
| 356 | (erase-buffer)) | ||
| 357 | (with-temp-buffer | ||
| 358 | (let* (;; Don't check for a proper method. | ||
| 359 | (non-essential t) | ||
| 360 | (default-directory (tramp-compat-temporary-file-directory)) | ||
| 361 | ;; We cannot add it to `process-environment', because | ||
| 362 | ;; `tramp-call-process-region' doesn't use it. | ||
| 363 | (encfs-config | ||
| 364 | (format "ENCFS6_CONFIG=%s" (tramp-crypt-config-file-name vec))) | ||
| 365 | (args (delq nil args))) | ||
| 366 | ;; Enable `auth-source', unless "emacs -Q" has been called. | ||
| 367 | (tramp-set-connection-property | ||
| 368 | vec "first-password-request" tramp-cache-read-persistent-data) | ||
| 369 | (insert | ||
| 370 | (tramp-read-passwd | ||
| 371 | (tramp-get-connection-process vec) | ||
| 372 | (format "EncFS Password for %s " (tramp-crypt-get-remote-dir vec)))) | ||
| 373 | (when (zerop | ||
| 374 | (apply | ||
| 375 | #'tramp-call-process-region vec (point-min) (point-max) | ||
| 376 | "env" nil (tramp-get-connection-buffer vec) | ||
| 377 | nil encfs-config tramp-crypt-encfsctl-program | ||
| 378 | (car args) "--extpass=cat" (cdr args))) | ||
| 379 | ;; Save the password. | ||
| 380 | (ignore-errors | ||
| 381 | (and (functionp tramp-password-save-function) | ||
| 382 | (funcall tramp-password-save-function))))))) | ||
| 383 | |||
| 384 | (defun tramp-crypt-do-encrypt-or-decrypt-file-name (op name) | ||
| 385 | "Return encrypted/ decrypted NAME if NAME belongs to a crypted directory. | ||
| 386 | OP must be `encrypt' or `decrypt'. | ||
| 387 | Otherwise, return NAME." | ||
| 388 | (if-let ((tramp-crypt-enabled t) | ||
| 389 | (dir (tramp-crypt-file-name-p name)) | ||
| 390 | ;; It must be absolute for the cache. | ||
| 391 | (localname (substring name (1- (length dir)))) | ||
| 392 | (crypt-vec (tramp-crypt-dissect-file-name dir))) | ||
| 393 | ;; Preserve trailing "/". | ||
| 394 | (funcall | ||
| 395 | (if (directory-name-p name) #'file-name-as-directory #'identity) | ||
| 396 | (concat | ||
| 397 | dir | ||
| 398 | (unless (string-equal localname "/") | ||
| 399 | (with-tramp-file-property | ||
| 400 | crypt-vec localname (concat (symbol-name op) "-file-name") | ||
| 401 | (tramp-crypt-send-command | ||
| 402 | crypt-vec (if (eq op 'encrypt) "encode" "decode") | ||
| 403 | (tramp-compat-temporary-file-directory) localname) | ||
| 404 | (with-current-buffer (tramp-get-connection-buffer crypt-vec) | ||
| 405 | (goto-char (point-min)) | ||
| 406 | (buffer-substring (point-min) (point-at-eol))))))) | ||
| 407 | ;; Nothing to do. | ||
| 408 | name)) | ||
| 409 | |||
| 410 | (defsubst tramp-crypt-encrypt-file-name (name) | ||
| 411 | "Return encrypted NAME if NAME belongs to a crypted directory. | ||
| 412 | Otherwise, return NAME." | ||
| 413 | (tramp-crypt-do-encrypt-or-decrypt-file-name 'encrypt name)) | ||
| 414 | |||
| 415 | (defsubst tramp-crypt-decrypt-file-name (name) | ||
| 416 | "Return decrypted NAME if NAME belongs to a crypted directory. | ||
| 417 | Otherwise, return NAME." | ||
| 418 | (tramp-crypt-do-encrypt-or-decrypt-file-name 'decrypt name)) | ||
| 419 | |||
| 420 | (defun tramp-crypt-do-encrypt-or-decrypt-file (op root infile outfile) | ||
| 421 | "Encrypt/ decrypt file INFILE to OUTFILE according to crypted directory ROOT. | ||
| 422 | Both files must be local files. OP must be `encrypt' or `decrypt'. | ||
| 423 | If OP ist `decrypt', the basename of INFILE must be an encrypted file name." | ||
| 424 | (when-let ((tramp-crypt-enabled t) | ||
| 425 | (dir (tramp-crypt-file-name-p root)) | ||
| 426 | (crypt-vec (tramp-crypt-dissect-file-name dir))) | ||
| 427 | (let ((coding-system-for-read | ||
| 428 | (if (eq op 'decrypt) 'raw-text coding-system-for-read)) | ||
| 429 | (coding-system-for-write | ||
| 430 | (if (eq op 'encrypt) 'raw-text coding-system-for-write))) | ||
| 431 | (tramp-crypt-send-command | ||
| 432 | crypt-vec "cat" (and (eq op 'encrypt) "--reverse") | ||
| 433 | (file-name-directory infile) (file-name-nondirectory infile)) | ||
| 434 | (with-current-buffer (tramp-get-connection-buffer crypt-vec) | ||
| 435 | (write-region nil nil outfile))))) | ||
| 436 | |||
| 437 | (defsubst tramp-crypt-encrypt-file (root infile outfile) | ||
| 438 | "Encrypt file INFILE to OUTFILE according to crypted directory ROOT. | ||
| 439 | See `tramp-crypt-do-encrypt-or-decrypt-file'." | ||
| 440 | (tramp-crypt-do-encrypt-or-decrypt-file 'encrypt root infile outfile)) | ||
| 441 | |||
| 442 | (defsubst tramp-crypt-decrypt-file (root infile outfile) | ||
| 443 | "Decrypt file INFILE to OUTFILE according to crypted directory ROOT. | ||
| 444 | See `tramp-crypt-do-encrypt-or-decrypt-file'." | ||
| 445 | (tramp-crypt-do-encrypt-or-decrypt-file 'decrypt root infile outfile)) | ||
| 446 | |||
| 447 | ;;;###tramp-autoload | ||
| 448 | (defun tramp-crypt-add-directory (name) | ||
| 449 | "Mark remote directory NAME for encryption. | ||
| 450 | Files in that directory and all subdirectories will be encrypted | ||
| 451 | bofore copying to, and decrypted after copying from that | ||
| 452 | directory. File names will be also encrypted." | ||
| 453 | (interactive "DRemote directory name: ") | ||
| 454 | (unless tramp-crypt-enabled | ||
| 455 | (tramp-user-error nil "Feature is not enabled.")) | ||
| 456 | (unless (and (tramp-tramp-file-p name) (file-directory-p name)) | ||
| 457 | (tramp-user-error nil "%s must be an existing remote directory." name)) | ||
| 458 | (setq name (file-name-as-directory name)) | ||
| 459 | (unless (member name tramp-crypt-directories) | ||
| 460 | (setq tramp-crypt-directories `(,name . ,tramp-crypt-directories))) | ||
| 461 | (tramp-register-file-name-handlers)) | ||
| 462 | |||
| 463 | ;; `auth-source' requires a user. | ||
| 464 | (defun tramp-crypt-dissect-file-name (name) | ||
| 465 | "Return a `tramp-file-name' structure for NAME. | ||
| 466 | The structure consists of the `tramp-crypt-method' method, the | ||
| 467 | local user name, the hexlified directory NAME as host, and the | ||
| 468 | localname." | ||
| 469 | (save-match-data | ||
| 470 | (if-let ((dir (tramp-crypt-file-name-p name))) | ||
| 471 | (make-tramp-file-name | ||
| 472 | :method tramp-crypt-method :user (user-login-name) | ||
| 473 | :host (url-hexify-string dir)) | ||
| 474 | (tramp-user-error nil "Not a crypted remote directory: \"%s\"" name)))) | ||
| 475 | |||
| 476 | (defun tramp-crypt-get-remote-dir (vec) | ||
| 477 | "Return the name of the crypted remote directory to be used for encfs." | ||
| 478 | (url-unhex-string (tramp-file-name-host vec))) | ||
| 479 | |||
| 480 | |||
| 481 | ;; File name primitives. | ||
| 482 | |||
| 483 | (defun tramp-crypt-do-copy-or-rename-file | ||
| 484 | (op filename newname &optional ok-if-already-exists keep-date | ||
| 485 | preserve-uid-gid preserve-extended-attributes) | ||
| 486 | "Copy or rename a remote file. | ||
| 487 | OP must be `copy' or `rename' and indicates the operation to perform. | ||
| 488 | FILENAME specifies the file to copy or rename, NEWNAME is the name of | ||
| 489 | the new file (for copy) or the new name of the file (for rename). | ||
| 490 | OK-IF-ALREADY-EXISTS means don't barf if NEWNAME exists already. | ||
| 491 | KEEP-DATE means to make sure that NEWNAME has the same timestamp | ||
| 492 | as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep | ||
| 493 | the uid and gid if both files are on the same host. | ||
| 494 | PRESERVE-EXTENDED-ATTRIBUTES is ignored. | ||
| 495 | |||
| 496 | This function is invoked by `tramp-crypt-handle-copy-file' and | ||
| 497 | `tramp-crypt-handle-rename-file'. It is an error if OP is | ||
| 498 | neither of `copy' and `rename'. FILENAME and NEWNAME must be | ||
| 499 | absolute file names." | ||
| 500 | (unless (memq op '(copy rename)) | ||
| 501 | (error "Unknown operation `%s', must be `copy' or `rename'" op)) | ||
| 502 | |||
| 503 | (setq filename (file-truename filename)) | ||
| 504 | (if (file-directory-p filename) | ||
| 505 | (progn | ||
| 506 | (copy-directory filename newname keep-date t) | ||
| 507 | (when (eq op 'rename) (delete-directory filename 'recursive))) | ||
| 508 | |||
| 509 | (let ((t1 (tramp-crypt-file-name-p filename)) | ||
| 510 | (t2 (tramp-crypt-file-name-p newname)) | ||
| 511 | (encrypt-filename (tramp-crypt-encrypt-file-name filename)) | ||
| 512 | (encrypt-newname (tramp-crypt-encrypt-file-name newname)) | ||
| 513 | (msg-operation (if (eq op 'copy) "Copying" "Renaming"))) | ||
| 514 | |||
| 515 | (with-parsed-tramp-file-name (if t1 filename newname) nil | ||
| 516 | (unless (file-exists-p filename) | ||
| 517 | (tramp-error | ||
| 518 | v tramp-file-missing | ||
| 519 | "%s file" msg-operation "No such file or directory" filename)) | ||
| 520 | (when (and (not ok-if-already-exists) (file-exists-p newname)) | ||
| 521 | (tramp-error v 'file-already-exists newname)) | ||
| 522 | (when (and (file-directory-p newname) | ||
| 523 | (not (directory-name-p newname))) | ||
| 524 | (tramp-error v 'file-error "File is a directory %s" newname)) | ||
| 525 | |||
| 526 | (with-tramp-progress-reporter | ||
| 527 | v 0 (format "%s %s to %s" msg-operation filename newname) | ||
| 528 | (if (and t1 t2 (string-equal t1 t2)) | ||
| 529 | ;; Both files are on the same crypted remote directory. | ||
| 530 | (let (tramp-crypt-enabled) | ||
| 531 | (if (eq op 'copy) | ||
| 532 | (copy-file | ||
| 533 | encrypt-filename encrypt-newname ok-if-already-exists | ||
| 534 | keep-date preserve-uid-gid preserve-extended-attributes) | ||
| 535 | (rename-file | ||
| 536 | encrypt-filename encrypt-newname ok-if-already-exists))) | ||
| 537 | |||
| 538 | (let* ((tmpdir (tramp-compat-make-temp-file filename 'dir)) | ||
| 539 | (tmpfile1 | ||
| 540 | (expand-file-name | ||
| 541 | (file-name-nondirectory encrypt-filename) tmpdir)) | ||
| 542 | (tmpfile2 | ||
| 543 | (expand-file-name | ||
| 544 | (file-name-nondirectory encrypt-newname) tmpdir)) | ||
| 545 | tramp-crypt-enabled) | ||
| 546 | (cond | ||
| 547 | ;; Source file is on a crypted remote directory. | ||
| 548 | (t1 | ||
| 549 | (if (eq op 'copy) | ||
| 550 | (copy-file | ||
| 551 | encrypt-filename tmpfile1 t keep-date preserve-uid-gid | ||
| 552 | preserve-extended-attributes) | ||
| 553 | (rename-file encrypt-filename tmpfile1 t)) | ||
| 554 | (tramp-crypt-decrypt-file t1 tmpfile1 tmpfile2) | ||
| 555 | (rename-file tmpfile2 newname ok-if-already-exists)) | ||
| 556 | ;; Target file is on a crypted remote directory. | ||
| 557 | (t2 | ||
| 558 | (if (eq op 'copy) | ||
| 559 | (copy-file | ||
| 560 | filename tmpfile1 t keep-date preserve-uid-gid | ||
| 561 | preserve-extended-attributes) | ||
| 562 | (rename-file filename tmpfile1 t)) | ||
| 563 | (tramp-crypt-encrypt-file t2 tmpfile1 tmpfile2) | ||
| 564 | (rename-file tmpfile2 encrypt-newname ok-if-already-exists))) | ||
| 565 | (delete-directory tmpdir 'recursive))) | ||
| 566 | |||
| 567 | (when (and t1 (eq op 'rename)) | ||
| 568 | (with-parsed-tramp-file-name filename v1 | ||
| 569 | (tramp-flush-file-properties v1 v1-localname))) | ||
| 570 | |||
| 571 | (when t2 | ||
| 572 | (with-parsed-tramp-file-name newname v2 | ||
| 573 | (tramp-flush-file-properties v2 v2-localname)))))))) | ||
| 574 | |||
| 575 | (defun tramp-crypt-handle-copy-file | ||
| 576 | (filename newname &optional ok-if-already-exists keep-date | ||
| 577 | preserve-uid-gid preserve-extended-attributes) | ||
| 578 | "Like `copy-file' for Tramp files." | ||
| 579 | (setq filename (expand-file-name filename) | ||
| 580 | newname (expand-file-name newname)) | ||
| 581 | ;; At least one file a Tramp file? | ||
| 582 | (if (or (tramp-tramp-file-p filename) | ||
| 583 | (tramp-tramp-file-p newname)) | ||
| 584 | (tramp-crypt-do-copy-or-rename-file | ||
| 585 | 'copy filename newname ok-if-already-exists keep-date | ||
| 586 | preserve-uid-gid preserve-extended-attributes) | ||
| 587 | (tramp-run-real-handler | ||
| 588 | #'copy-file | ||
| 589 | (list filename newname ok-if-already-exists keep-date | ||
| 590 | preserve-uid-gid preserve-extended-attributes)))) | ||
| 591 | |||
| 592 | (defun tramp-crypt-handle-delete-directory | ||
| 593 | (directory &optional recursive trash) | ||
| 594 | "Like `delete-directory' for Tramp files." | ||
| 595 | (with-parsed-tramp-file-name (expand-file-name directory) nil | ||
| 596 | (tramp-flush-directory-properties v localname) | ||
| 597 | (let (tramp-crypt-enabled) | ||
| 598 | (delete-directory | ||
| 599 | (tramp-crypt-encrypt-file-name directory) recursive trash)))) | ||
| 600 | |||
| 601 | (defun tramp-crypt-handle-delete-file (filename &optional trash) | ||
| 602 | "Like `delete-file' for Tramp files." | ||
| 603 | (with-parsed-tramp-file-name (expand-file-name filename) nil | ||
| 604 | (tramp-flush-file-properties v localname) | ||
| 605 | (tramp-crypt-run-real-handler | ||
| 606 | #'delete-file (list (tramp-crypt-encrypt-file-name filename) trash)))) | ||
| 607 | |||
| 608 | (defun tramp-crypt-handle-directory-files (directory &optional full match nosort) | ||
| 609 | "Like `directory-files' for Tramp files." | ||
| 610 | (unless (file-exists-p directory) | ||
| 611 | (tramp-error | ||
| 612 | (tramp-dissect-file-name directory) tramp-file-missing | ||
| 613 | "No such file or directory" directory)) | ||
| 614 | (when (file-directory-p directory) | ||
| 615 | (setq directory (file-name-as-directory (expand-file-name directory))) | ||
| 616 | (let* (tramp-crypt-enabled | ||
| 617 | (result | ||
| 618 | (directory-files (tramp-crypt-encrypt-file-name directory) 'full))) | ||
| 619 | (setq result | ||
| 620 | (mapcar (lambda (x) (tramp-crypt-decrypt-file-name x)) result)) | ||
| 621 | (when match | ||
| 622 | (setq result | ||
| 623 | (delq | ||
| 624 | nil | ||
| 625 | (mapcar | ||
| 626 | (lambda (x) | ||
| 627 | (when (string-match-p match (substring x (length directory))) | ||
| 628 | x)) | ||
| 629 | result)))) | ||
| 630 | (unless full | ||
| 631 | (setq result | ||
| 632 | (mapcar | ||
| 633 | (lambda (x) | ||
| 634 | (replace-regexp-in-string | ||
| 635 | (concat "^" (regexp-quote directory)) "" x)) | ||
| 636 | result))) | ||
| 637 | (if nosort result (sort result #'string<))))) | ||
| 638 | |||
| 639 | (defun tramp-crypt-handle-file-attributes (filename &optional id-format) | ||
| 640 | "Like `file-attributes' for Tramp files." | ||
| 641 | (tramp-crypt-run-real-handler | ||
| 642 | #'file-attributes (list (tramp-crypt-encrypt-file-name filename) id-format))) | ||
| 643 | |||
| 644 | (defun tramp-crypt-handle-file-executable-p (filename) | ||
| 645 | "Like `file-executable-p' for Tramp files." | ||
| 646 | (tramp-crypt-run-real-handler | ||
| 647 | #'file-executable-p (list (tramp-crypt-encrypt-file-name filename)))) | ||
| 648 | |||
| 649 | (defun tramp-crypt-handle-file-readable-p (filename) | ||
| 650 | "Like `file-readable-p' for Tramp files." | ||
| 651 | (tramp-crypt-run-real-handler | ||
| 652 | #'file-readable-p (list (tramp-crypt-encrypt-file-name filename)))) | ||
| 653 | |||
| 654 | (defun tramp-crypt-handle-file-system-info (filename) | ||
| 655 | "Like `file-system-info' for Tramp files." | ||
| 656 | (tramp-crypt-run-real-handler | ||
| 657 | #'file-system-info (list (tramp-crypt-encrypt-file-name filename)))) | ||
| 658 | |||
| 659 | (defun tramp-crypt-handle-insert-directory | ||
| 660 | (filename switches &optional wildcard full-directory-p) | ||
| 661 | "Like `insert-directory' for Tramp files." | ||
| 662 | (let (tramp-crypt-enabled) | ||
| 663 | (tramp-handle-insert-directory | ||
| 664 | (tramp-crypt-encrypt-file-name filename) | ||
| 665 | switches wildcard full-directory-p) | ||
| 666 | (let* ((filename (file-name-as-directory filename)) | ||
| 667 | (enc (tramp-crypt-encrypt-file-name filename)) | ||
| 668 | match string) | ||
| 669 | (goto-char (point-min)) | ||
| 670 | (while (setq match (text-property-search-forward 'dired-filename t t)) | ||
| 671 | (setq string | ||
| 672 | (buffer-substring | ||
| 673 | (prop-match-beginning match) (prop-match-end match)) | ||
| 674 | string (if (file-name-absolute-p string) | ||
| 675 | (tramp-crypt-decrypt-file-name string) | ||
| 676 | (substring | ||
| 677 | (tramp-crypt-decrypt-file-name (concat enc string)) | ||
| 678 | (length filename)))) | ||
| 679 | (delete-region (prop-match-beginning match) (prop-match-end match)) | ||
| 680 | (insert (propertize string 'dired-filename t)))))) | ||
| 681 | |||
| 682 | (defun tramp-crypt-handle-make-directory (dir &optional parents) | ||
| 683 | "Like `make-directory' for Tramp files." | ||
| 684 | (with-parsed-tramp-file-name (expand-file-name dir) nil | ||
| 685 | (when (and (null parents) (file-exists-p dir)) | ||
| 686 | (tramp-error v 'file-already-exists "Directory already exists %s" dir)) | ||
| 687 | (tramp-crypt-run-real-handler | ||
| 688 | #'make-directory (list (tramp-crypt-encrypt-file-name dir) parents)) | ||
| 689 | ;; When PARENTS is non-nil, DIR could be a chain of non-existent | ||
| 690 | ;; directories a/b/c/... Instead of checking, we simply flush the | ||
| 691 | ;; whole cache. | ||
| 692 | (tramp-flush-directory-properties | ||
| 693 | v (if parents "/" (file-name-directory localname))))) | ||
| 694 | |||
| 695 | (defun tramp-crypt-handle-rename-file | ||
| 696 | (filename newname &optional ok-if-already-exists) | ||
| 697 | "Like `rename-file' for Tramp files." | ||
| 698 | (setq filename (expand-file-name filename) | ||
| 699 | newname (expand-file-name newname)) | ||
| 700 | ;; At least one file a Tramp file? | ||
| 701 | (if (or (tramp-tramp-file-p filename) | ||
| 702 | (tramp-tramp-file-p newname)) | ||
| 703 | (tramp-crypt-do-copy-or-rename-file | ||
| 704 | 'rename filename newname ok-if-already-exists | ||
| 705 | 'keep-date 'preserve-uid-gid) | ||
| 706 | (tramp-run-real-handler | ||
| 707 | #'rename-file (list filename newname ok-if-already-exists)))) | ||
| 708 | |||
| 709 | (defun tramp-crypt-handle-set-file-modes (filename mode &optional flag) | ||
| 710 | "Like `set-file-modes' for Tramp files." | ||
| 711 | (with-parsed-tramp-file-name filename nil | ||
| 712 | (tramp-flush-file-properties v localname) | ||
| 713 | (tramp-crypt-run-real-handler | ||
| 714 | #'set-file-modes | ||
| 715 | (list (tramp-crypt-encrypt-file-name filename) mode flag)))) | ||
| 716 | |||
| 717 | (add-hook 'tramp-unload-hook | ||
| 718 | (lambda () | ||
| 719 | (unload-feature 'tramp-crypt 'force))) | ||
| 720 | |||
| 721 | (provide 'tramp-crypt) | ||
| 722 | |||
| 723 | ;;; TODO: | ||
| 724 | |||
| 725 | ;; * I suggest having a feature where the user can specify to always | ||
| 726 | ;; use encryption for certain host names. So if you specify a host | ||
| 727 | ;; name which is on that list (of names, or perhaps regexps?), tramp | ||
| 728 | ;; would modify the request so as to do the encryption. (Richard Stallman) | ||
| 729 | |||
| 730 | ;;; tramp-crypt.el ends here | ||
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index ee263ebe933..f1db6a7be29 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el | |||
| @@ -745,7 +745,7 @@ to be set, depending on VALUE." | |||
| 745 | tramp-postfix-host-format (tramp-build-postfix-host-format) | 745 | tramp-postfix-host-format (tramp-build-postfix-host-format) |
| 746 | tramp-postfix-host-regexp (tramp-build-postfix-host-regexp) | 746 | tramp-postfix-host-regexp (tramp-build-postfix-host-regexp) |
| 747 | tramp-remote-file-name-spec-regexp | 747 | tramp-remote-file-name-spec-regexp |
| 748 | (tramp-build-remote-file-name-spec-regexp) | 748 | (tramp-build-remote-file-name-spec-regexp) |
| 749 | tramp-file-name-structure (tramp-build-file-name-structure) | 749 | tramp-file-name-structure (tramp-build-file-name-structure) |
| 750 | tramp-file-name-regexp (tramp-build-file-name-regexp) | 750 | tramp-file-name-regexp (tramp-build-file-name-regexp) |
| 751 | tramp-completion-file-name-regexp | 751 | tramp-completion-file-name-regexp |
| @@ -2182,6 +2182,7 @@ arguments to pass to the OPERATION." | |||
| 2182 | tramp-vc-file-name-handler | 2182 | tramp-vc-file-name-handler |
| 2183 | tramp-completion-file-name-handler | 2183 | tramp-completion-file-name-handler |
| 2184 | tramp-archive-file-name-handler | 2184 | tramp-archive-file-name-handler |
| 2185 | tramp-crypt-file-name-handler | ||
| 2185 | cygwin-mount-name-hook-function | 2186 | cygwin-mount-name-hook-function |
| 2186 | cygwin-mount-map-drive-hook-function | 2187 | cygwin-mount-map-drive-hook-function |
| 2187 | . | 2188 | . |
| @@ -2484,13 +2485,16 @@ remote file names." | |||
| 2484 | (tramp-unload-file-name-handlers) | 2485 | (tramp-unload-file-name-handlers) |
| 2485 | 2486 | ||
| 2486 | ;; Add the handlers. We do not add anything to the `operations' | 2487 | ;; Add the handlers. We do not add anything to the `operations' |
| 2487 | ;; property of `tramp-file-name-handler' and | 2488 | ;; property of `tramp-file-name-handler', |
| 2488 | ;; `tramp-archive-file-name-handler', this shall be done by the | 2489 | ;; `tramp-archive-file-name-handler' and |
| 2490 | ;; `tramp-crypt-file-name-handler', this shall be done by the | ||
| 2489 | ;; respective foreign handlers. | 2491 | ;; respective foreign handlers. |
| 2490 | (add-to-list 'file-name-handler-alist | 2492 | (add-to-list 'file-name-handler-alist |
| 2491 | (cons tramp-file-name-regexp #'tramp-file-name-handler)) | 2493 | (cons tramp-file-name-regexp #'tramp-file-name-handler)) |
| 2492 | (put #'tramp-file-name-handler 'safe-magic t) | 2494 | (put #'tramp-file-name-handler 'safe-magic t) |
| 2493 | 2495 | ||
| 2496 | (tramp-register-crypt-file-name-handler) | ||
| 2497 | |||
| 2494 | (add-to-list 'file-name-handler-alist | 2498 | (add-to-list 'file-name-handler-alist |
| 2495 | (cons tramp-completion-file-name-regexp | 2499 | (cons tramp-completion-file-name-regexp |
| 2496 | #'tramp-completion-file-name-handler)) | 2500 | #'tramp-completion-file-name-handler)) |
| @@ -3497,6 +3501,9 @@ User is always nil." | |||
| 3497 | ;; copy this part. This works only for the shell file | 3501 | ;; copy this part. This works only for the shell file |
| 3498 | ;; name handlers. | 3502 | ;; name handlers. |
| 3499 | (when (and (or beg end) | 3503 | (when (and (or beg end) |
| 3504 | ;; Direct actions aren't possible for | ||
| 3505 | ;; crypted directories. | ||
| 3506 | (null tramp-crypt-enabled) | ||
| 3500 | (tramp-get-method-parameter | 3507 | (tramp-get-method-parameter |
| 3501 | v 'tramp-login-program)) | 3508 | v 'tramp-login-program)) |
| 3502 | (setq remote-copy (tramp-make-tramp-temp-file v)) | 3509 | (setq remote-copy (tramp-make-tramp-temp-file v)) |
| @@ -4649,6 +4656,8 @@ This handles also chrooted environments, which are not regarded as local." | |||
| 4649 | ;; handlers. `tramp-local-host-p' is also called for "smb" and | 4656 | ;; handlers. `tramp-local-host-p' is also called for "smb" and |
| 4650 | ;; alike, where it must fail. | 4657 | ;; alike, where it must fail. |
| 4651 | (tramp-get-method-parameter vec 'tramp-login-program) | 4658 | (tramp-get-method-parameter vec 'tramp-login-program) |
| 4659 | ;; Direct actions aren't possible for crypted directories. | ||
| 4660 | (null tramp-crypt-enabled) | ||
| 4652 | ;; The local temp directory must be writable for the other user. | 4661 | ;; The local temp directory must be writable for the other user. |
| 4653 | (file-writable-p | 4662 | (file-writable-p |
| 4654 | (tramp-make-tramp-file-name | 4663 | (tramp-make-tramp-file-name |
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 1f56baad7ce..7faa409f2f0 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el | |||
| @@ -3815,6 +3815,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." | |||
| 3815 | "Check that `file-acl' and `set-file-acl' work proper." | 3815 | "Check that `file-acl' and `set-file-acl' work proper." |
| 3816 | (skip-unless (tramp--test-enabled)) | 3816 | (skip-unless (tramp--test-enabled)) |
| 3817 | (skip-unless (file-acl tramp-test-temporary-file-directory)) | 3817 | (skip-unless (file-acl tramp-test-temporary-file-directory)) |
| 3818 | (skip-unless (null (tramp--test-crypt-p))) | ||
| 3818 | 3819 | ||
| 3819 | ;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579. | 3820 | ;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579. |
| 3820 | (dolist (quoted (if (and (tramp--test-expensive-test) (tramp--test-emacs27-p)) | 3821 | (dolist (quoted (if (and (tramp--test-expensive-test) (tramp--test-emacs27-p)) |
| @@ -3893,6 +3894,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." | |||
| 3893 | (skip-unless | 3894 | (skip-unless |
| 3894 | (not (equal (file-selinux-context tramp-test-temporary-file-directory) | 3895 | (not (equal (file-selinux-context tramp-test-temporary-file-directory) |
| 3895 | '(nil nil nil nil)))) | 3896 | '(nil nil nil nil)))) |
| 3897 | (skip-unless (null (tramp--test-crypt-p))) | ||
| 3896 | 3898 | ||
| 3897 | ;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579. | 3899 | ;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579. |
| 3898 | (dolist (quoted (if (and (tramp--test-expensive-test) (tramp--test-emacs27-p)) | 3900 | (dolist (quoted (if (and (tramp--test-expensive-test) (tramp--test-emacs27-p)) |
| @@ -4196,6 +4198,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." | |||
| 4196 | :tags '(:expensive-test) | 4198 | :tags '(:expensive-test) |
| 4197 | (skip-unless (tramp--test-enabled)) | 4199 | (skip-unless (tramp--test-enabled)) |
| 4198 | (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) | 4200 | (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) |
| 4201 | (skip-unless (null (tramp--test-crypt-p))) | ||
| 4199 | 4202 | ||
| 4200 | (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) | 4203 | (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) |
| 4201 | (let* ((tmp-name (tramp--test-make-temp-name nil quoted)) | 4204 | (let* ((tmp-name (tramp--test-make-temp-name nil quoted)) |
| @@ -4274,6 +4277,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." | |||
| 4274 | :tags '(:expensive-test) | 4277 | :tags '(:expensive-test) |
| 4275 | (skip-unless (tramp--test-enabled)) | 4278 | (skip-unless (tramp--test-enabled)) |
| 4276 | (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) | 4279 | (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) |
| 4280 | (skip-unless (null (tramp--test-crypt-p))) | ||
| 4277 | 4281 | ||
| 4278 | (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) | 4282 | (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) |
| 4279 | (let ((default-directory tramp-test-temporary-file-directory) | 4283 | (let ((default-directory tramp-test-temporary-file-directory) |
| @@ -4347,6 +4351,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." | |||
| 4347 | :tags '(:expensive-test) | 4351 | :tags '(:expensive-test) |
| 4348 | (skip-unless (tramp--test-enabled)) | 4352 | (skip-unless (tramp--test-enabled)) |
| 4349 | (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) | 4353 | (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) |
| 4354 | (skip-unless (null (tramp--test-crypt-p))) | ||
| 4350 | ;; `make-process' supports file name handlers since Emacs 27. | 4355 | ;; `make-process' supports file name handlers since Emacs 27. |
| 4351 | (skip-unless (tramp--test-emacs27-p)) | 4356 | (skip-unless (tramp--test-emacs27-p)) |
| 4352 | 4357 | ||
| @@ -4517,6 +4522,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." | |||
| 4517 | :tags '(:expensive-test) | 4522 | :tags '(:expensive-test) |
| 4518 | (skip-unless (tramp--test-enabled)) | 4523 | (skip-unless (tramp--test-enabled)) |
| 4519 | (skip-unless (tramp--test-sh-p)) | 4524 | (skip-unless (tramp--test-sh-p)) |
| 4525 | (skip-unless (null (tramp--test-crypt-p))) | ||
| 4520 | ;; Since Emacs 26.1. | 4526 | ;; Since Emacs 26.1. |
| 4521 | (skip-unless (boundp 'interrupt-process-functions)) | 4527 | (skip-unless (boundp 'interrupt-process-functions)) |
| 4522 | 4528 | ||
| @@ -4577,6 +4583,7 @@ INPUT, if non-nil, is a string sent to the process." | |||
| 4577 | ;; remote processes in Emacs. That doesn't work for tramp-adb.el. | 4583 | ;; remote processes in Emacs. That doesn't work for tramp-adb.el. |
| 4578 | (skip-unless (or (and (tramp--test-adb-p) (tramp--test-emacs27-p)) | 4584 | (skip-unless (or (and (tramp--test-adb-p) (tramp--test-emacs27-p)) |
| 4579 | (tramp--test-sh-p))) | 4585 | (tramp--test-sh-p))) |
| 4586 | (skip-unless (null (tramp--test-crypt-p))) | ||
| 4580 | 4587 | ||
| 4581 | (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) | 4588 | (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) |
| 4582 | (let ((tmp-name (tramp--test-make-temp-name nil quoted)) | 4589 | (let ((tmp-name (tramp--test-make-temp-name nil quoted)) |
| @@ -4668,6 +4675,7 @@ INPUT, if non-nil, is a string sent to the process." | |||
| 4668 | :tags '(:expensive-test) | 4675 | :tags '(:expensive-test) |
| 4669 | (skip-unless (tramp--test-enabled)) | 4676 | (skip-unless (tramp--test-enabled)) |
| 4670 | (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) | 4677 | (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) |
| 4678 | (skip-unless (null (tramp--test-crypt-p))) | ||
| 4671 | ;; Prior Emacs 27, `shell-command-dont-erase-buffer' wasn't working properly. | 4679 | ;; Prior Emacs 27, `shell-command-dont-erase-buffer' wasn't working properly. |
| 4672 | (skip-unless (tramp--test-emacs27-p)) | 4680 | (skip-unless (tramp--test-emacs27-p)) |
| 4673 | 4681 | ||
| @@ -4880,6 +4888,7 @@ INPUT, if non-nil, is a string sent to the process." | |||
| 4880 | :tags '(:expensive-test) | 4888 | :tags '(:expensive-test) |
| 4881 | (skip-unless (tramp--test-enabled)) | 4889 | (skip-unless (tramp--test-enabled)) |
| 4882 | (skip-unless (tramp--test-sh-p)) | 4890 | (skip-unless (tramp--test-sh-p)) |
| 4891 | (skip-unless (null (tramp--test-crypt-p))) | ||
| 4883 | 4892 | ||
| 4884 | (dolist (this-shell-command-to-string | 4893 | (dolist (this-shell-command-to-string |
| 4885 | '(;; Synchronously. | 4894 | '(;; Synchronously. |
| @@ -4966,6 +4975,7 @@ INPUT, if non-nil, is a string sent to the process." | |||
| 4966 | ;; We test it only for the mock-up connection; otherwise there might | 4975 | ;; We test it only for the mock-up connection; otherwise there might |
| 4967 | ;; be problems with the used ports. | 4976 | ;; be problems with the used ports. |
| 4968 | (skip-unless (and (eq tramp-syntax 'default) (tramp--test-mock-p))) | 4977 | (skip-unless (and (eq tramp-syntax 'default) (tramp--test-mock-p))) |
| 4978 | (skip-unless (null (tramp--test-crypt-p))) | ||
| 4969 | 4979 | ||
| 4970 | ;; We force a reconnect, in order to have a clean environment. | 4980 | ;; We force a reconnect, in order to have a clean environment. |
| 4971 | (dolist (dir `(,tramp-test-temporary-file-directory | 4981 | (dolist (dir `(,tramp-test-temporary-file-directory |
| @@ -5070,6 +5080,7 @@ INPUT, if non-nil, is a string sent to the process." | |||
| 5070 | ;; remote processes in Emacs. That doesn't work for tramp-adb.el. | 5080 | ;; remote processes in Emacs. That doesn't work for tramp-adb.el. |
| 5071 | (skip-unless (or (and (tramp--test-adb-p) (tramp--test-emacs27-p)) | 5081 | (skip-unless (or (and (tramp--test-adb-p) (tramp--test-emacs27-p)) |
| 5072 | (tramp--test-sh-p))) | 5082 | (tramp--test-sh-p))) |
| 5083 | (skip-unless (null (tramp--test-crypt-p))) | ||
| 5073 | ;; Since Emacs 26.1. | 5084 | ;; Since Emacs 26.1. |
| 5074 | (skip-unless (and (fboundp 'connection-local-set-profile-variables) | 5085 | (skip-unless (and (fboundp 'connection-local-set-profile-variables) |
| 5075 | (fboundp 'connection-local-set-profiles))) | 5086 | (fboundp 'connection-local-set-profiles))) |
| @@ -5126,6 +5137,7 @@ INPUT, if non-nil, is a string sent to the process." | |||
| 5126 | "Check `exec-path' and `executable-find'." | 5137 | "Check `exec-path' and `executable-find'." |
| 5127 | (skip-unless (tramp--test-enabled)) | 5138 | (skip-unless (tramp--test-enabled)) |
| 5128 | (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) | 5139 | (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) |
| 5140 | (skip-unless (null (tramp--test-crypt-p))) | ||
| 5129 | ;; Since Emacs 27.1. | 5141 | ;; Since Emacs 27.1. |
| 5130 | (skip-unless (fboundp 'exec-path)) | 5142 | (skip-unless (fboundp 'exec-path)) |
| 5131 | 5143 | ||
| @@ -5169,6 +5181,7 @@ INPUT, if non-nil, is a string sent to the process." | |||
| 5169 | "Check loooong `tramp-remote-path'." | 5181 | "Check loooong `tramp-remote-path'." |
| 5170 | (skip-unless (tramp--test-enabled)) | 5182 | (skip-unless (tramp--test-enabled)) |
| 5171 | (skip-unless (tramp--test-sh-p)) | 5183 | (skip-unless (tramp--test-sh-p)) |
| 5184 | (skip-unless (null (tramp--test-crypt-p))) | ||
| 5172 | ;; Since Emacs 27.1. | 5185 | ;; Since Emacs 27.1. |
| 5173 | (skip-unless (fboundp 'exec-path)) | 5186 | (skip-unless (fboundp 'exec-path)) |
| 5174 | 5187 | ||
| @@ -5233,6 +5246,7 @@ INPUT, if non-nil, is a string sent to the process." | |||
| 5233 | :tags '(:expensive-test) | 5246 | :tags '(:expensive-test) |
| 5234 | (skip-unless (tramp--test-enabled)) | 5247 | (skip-unless (tramp--test-enabled)) |
| 5235 | (skip-unless (tramp--test-sh-p)) | 5248 | (skip-unless (tramp--test-sh-p)) |
| 5249 | (skip-unless (null (tramp--test-crypt-p))) | ||
| 5236 | 5250 | ||
| 5237 | (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) | 5251 | (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) |
| 5238 | ;; We must use `file-truename' for the temporary directory, in | 5252 | ;; We must use `file-truename' for the temporary directory, in |
| @@ -5581,6 +5595,10 @@ This does not support some special file names." | |||
| 5581 | (string-equal | 5595 | (string-equal |
| 5582 | "docker" (file-remote-p tramp-test-temporary-file-directory 'method))) | 5596 | "docker" (file-remote-p tramp-test-temporary-file-directory 'method))) |
| 5583 | 5597 | ||
| 5598 | (defun tramp--test-crypt-p () | ||
| 5599 | "Check, whether the remote directory is crypted" | ||
| 5600 | (tramp-crypt-file-name-p tramp-test-temporary-file-directory)) | ||
| 5601 | |||
| 5584 | (defun tramp--test-ftp-p () | 5602 | (defun tramp--test-ftp-p () |
| 5585 | "Check, whether an FTP-like method is used. | 5603 | "Check, whether an FTP-like method is used. |
| 5586 | This does not support globbing characters in file names (yet)." | 5604 | This does not support globbing characters in file names (yet)." |
| @@ -5817,6 +5835,7 @@ This requires restrictions of file name syntax." | |||
| 5817 | ;; We do not run on macOS due to encoding problems. See | 5835 | ;; We do not run on macOS due to encoding problems. See |
| 5818 | ;; Bug#36940. | 5836 | ;; Bug#36940. |
| 5819 | (when (and (tramp--test-expensive-test) (tramp--test-sh-p) | 5837 | (when (and (tramp--test-expensive-test) (tramp--test-sh-p) |
| 5838 | (null (tramp--test-crypt-p)) | ||
| 5820 | (not (eq system-type 'darwin))) | 5839 | (not (eq system-type 'darwin))) |
| 5821 | (dolist (elt files) | 5840 | (dolist (elt files) |
| 5822 | (let ((envvar (concat "VAR_" (upcase (md5 elt)))) | 5841 | (let ((envvar (concat "VAR_" (upcase (md5 elt)))) |
| @@ -6149,6 +6168,7 @@ process sentinels. They shall not disturb each other." | |||
| 6149 | ;; remote processes in Emacs. That doesn't work for tramp-adb.el. | 6168 | ;; remote processes in Emacs. That doesn't work for tramp-adb.el. |
| 6150 | (skip-unless (or (and (tramp--test-adb-p) (tramp--test-emacs27-p)) | 6169 | (skip-unless (or (and (tramp--test-adb-p) (tramp--test-emacs27-p)) |
| 6151 | (tramp--test-sh-p))) | 6170 | (tramp--test-sh-p))) |
| 6171 | (skip-unless (null (tramp--test-crypt-p))) | ||
| 6152 | 6172 | ||
| 6153 | (with-timeout | 6173 | (with-timeout |
| 6154 | (tramp--test-asynchronous-requests-timeout (tramp--test-timeout-handler)) | 6174 | (tramp--test-asynchronous-requests-timeout (tramp--test-timeout-handler)) |