diff options
| author | Michael Albinus | 2020-06-12 20:17:02 +0200 |
|---|---|---|
| committer | Michael Albinus | 2020-06-12 20:17:02 +0200 |
| commit | 459bd56f46af8cd7c29965600c46387282c3c93f (patch) | |
| tree | 47f2f4b4b0071db3df38da22b8fadfea43ec9345 | |
| parent | 54efe18959591faa1087051c878abe470f53a28f (diff) | |
| download | emacs-459bd56f46af8cd7c29965600c46387282c3c93f.tar.gz emacs-459bd56f46af8cd7c29965600c46387282c3c93f.zip | |
Further fixes while testing tramp-crypt
* doc/misc/tramp.texi (External methods): Remove experimental note
for rclone.
(Keeping files encrypted): Mark file encryption as experimental.
* lisp/net/tramp-adb.el (tramp-adb-file-name-handler-alist):
Use `tramp-handle-file-truename'.
(tramp-adb-handle-file-truename): Remove.
* lisp/net/tramp-crypt.el (tramp-crypt-file-name-handler-alist):
Add `file-writable-p'.
(tramp-crypt-send-command): Return t if no error.
(tramp-crypt-do-encrypt-or-decrypt-file-name)
(tramp-crypt-do-encrypt-or-decrypt-file): Raise an error if it fails.
(tramp-crypt-do-copy-or-rename-file): Flush file properties also
when copying a directory.
(tramp-crypt-handle-file-writable-p): New defun.
(tramp-crypt-handle-insert-directory): Check for library
`text-property-search'.
* lisp/net/tramp-gvfs.el (tramp-gvfs-handle-set-file-uid-gid):
Rename from `tramp-gvfs-set-file-uid-gid'.
* lisp/net/tramp-sh.el (tramp-sh-handle-file-truename):
Use `tramp-handle-file-truename' as fallback.
* lisp/net/tramp.el (tramp-handle-file-truename):
Let-bind `tramp-crypt-enabled' to nil.
(tramp-handle-write-region): Set also file ownership.
* test/lisp/net/tramp-tests.el (tramp-test17-insert-directory):
Skip if needed.
| -rw-r--r-- | doc/misc/tramp.texi | 7 | ||||
| -rw-r--r-- | lisp/net/tramp-adb.el | 100 | ||||
| -rw-r--r-- | lisp/net/tramp-crypt.el | 120 | ||||
| -rw-r--r-- | lisp/net/tramp-gvfs.el | 2 | ||||
| -rw-r--r-- | lisp/net/tramp-sh.el | 56 | ||||
| -rw-r--r-- | lisp/net/tramp.el | 25 | ||||
| -rw-r--r-- | test/lisp/net/tramp-tests.el | 3 |
7 files changed, 97 insertions, 216 deletions
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 176d3a5b1e0..eb0bf743bec 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi | |||
| @@ -1185,9 +1185,6 @@ for accessing the system storage, you shall prefer this. | |||
| 1185 | @ref{GVFS-based methods} for example, methods @option{gdrive} and | 1185 | @ref{GVFS-based methods} for example, methods @option{gdrive} and |
| 1186 | @option{nextcloud}. | 1186 | @option{nextcloud}. |
| 1187 | 1187 | ||
| 1188 | @strong{Note}: The @option{rclone} method is experimental, don't use | ||
| 1189 | it in production systems! | ||
| 1190 | |||
| 1191 | @end table | 1188 | @end table |
| 1192 | 1189 | ||
| 1193 | 1190 | ||
| @@ -1732,6 +1729,7 @@ Convenience method to access vagrant boxes. It is often used in | |||
| 1732 | multi-hop file names like | 1729 | multi-hop file names like |
| 1733 | @file{@value{prefix}vagrant@value{postfixhop}box|sudo@value{postfixhop}box@value{postfix}/path/to/file}, | 1730 | @file{@value{prefix}vagrant@value{postfixhop}box|sudo@value{postfixhop}box@value{postfix}/path/to/file}, |
| 1734 | where @samp{box} is the name of the vagrant box. | 1731 | where @samp{box} is the name of the vagrant box. |
| 1732 | |||
| 1735 | @end table | 1733 | @end table |
| 1736 | 1734 | ||
| 1737 | 1735 | ||
| @@ -2655,6 +2653,9 @@ to direct all auto saves to that location. | |||
| 2655 | @section Protect remote files by encryption | 2653 | @section Protect remote files by encryption |
| 2656 | @cindex Encrypt remote directories | 2654 | @cindex Encrypt remote directories |
| 2657 | 2655 | ||
| 2656 | @strong{Note}: File encryption in @value{tramp} is experimental, don't | ||
| 2657 | use it in production systems! | ||
| 2658 | |||
| 2658 | Sometimes, it is desirable to protect files located on remote | 2659 | Sometimes, it is desirable to protect files located on remote |
| 2659 | directories, like cloud storages. In order to do this, you might | 2660 | directories, like cloud storages. In order to do this, you might |
| 2660 | instruct @value{tramp} to encrypt all files copied to a given remote | 2661 | instruct @value{tramp} to encrypt all files copied to a given remote |
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index b4a080ee0f6..fb98805cc39 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el | |||
| @@ -136,7 +136,7 @@ It is used for TCP/IP devices." | |||
| 136 | (file-selinux-context . tramp-handle-file-selinux-context) | 136 | (file-selinux-context . tramp-handle-file-selinux-context) |
| 137 | (file-symlink-p . tramp-handle-file-symlink-p) | 137 | (file-symlink-p . tramp-handle-file-symlink-p) |
| 138 | (file-system-info . tramp-adb-handle-file-system-info) | 138 | (file-system-info . tramp-adb-handle-file-system-info) |
| 139 | (file-truename . tramp-adb-handle-file-truename) | 139 | (file-truename . tramp-handle-file-truename) |
| 140 | (file-writable-p . tramp-adb-handle-file-writable-p) | 140 | (file-writable-p . tramp-adb-handle-file-writable-p) |
| 141 | (find-backup-file-name . tramp-handle-find-backup-file-name) | 141 | (find-backup-file-name . tramp-handle-find-backup-file-name) |
| 142 | ;; `get-file-buffer' performed by default handler. | 142 | ;; `get-file-buffer' performed by default handler. |
| @@ -227,104 +227,6 @@ ARGUMENTS to pass to the OPERATION." | |||
| 227 | (string-to-number (match-string 2)))) | 227 | (string-to-number (match-string 2)))) |
| 228 | (* 1024 (string-to-number (match-string 3))))))))) | 228 | (* 1024 (string-to-number (match-string 3))))))))) |
| 229 | 229 | ||
| 230 | ;; This is derived from `tramp-sh-handle-file-truename'. Maybe the | ||
| 231 | ;; code could be shared? | ||
| 232 | (defun tramp-adb-handle-file-truename (filename) | ||
| 233 | "Like `file-truename' for Tramp files." | ||
| 234 | ;; Preserve trailing "/". | ||
| 235 | (funcall | ||
| 236 | (if (directory-name-p filename) #'file-name-as-directory #'identity) | ||
| 237 | ;; Quote properly. | ||
| 238 | (funcall | ||
| 239 | (if (tramp-compat-file-name-quoted-p filename) | ||
| 240 | #'tramp-compat-file-name-quote #'identity) | ||
| 241 | (with-parsed-tramp-file-name | ||
| 242 | (tramp-compat-file-name-unquote (expand-file-name filename)) nil | ||
| 243 | (tramp-make-tramp-file-name | ||
| 244 | v | ||
| 245 | (with-tramp-file-property v localname "file-truename" | ||
| 246 | (let (result) ; result steps in reverse order | ||
| 247 | (tramp-message v 4 "Finding true name for `%s'" filename) | ||
| 248 | (let* ((steps (split-string localname "/" 'omit)) | ||
| 249 | (localnamedir (tramp-run-real-handler | ||
| 250 | 'file-name-as-directory (list localname))) | ||
| 251 | (is-dir (string= localname localnamedir)) | ||
| 252 | (thisstep nil) | ||
| 253 | (numchase 0) | ||
| 254 | ;; Don't make the following value larger than | ||
| 255 | ;; necessary. People expect an error message in a | ||
| 256 | ;; timely fashion when something is wrong; otherwise | ||
| 257 | ;; they might think that Emacs is hung. Of course, | ||
| 258 | ;; correctness has to come first. | ||
| 259 | (numchase-limit 20) | ||
| 260 | symlink-target) | ||
| 261 | (while (and steps (< numchase numchase-limit)) | ||
| 262 | (setq thisstep (pop steps)) | ||
| 263 | (tramp-message | ||
| 264 | v 5 "Check %s" | ||
| 265 | (string-join | ||
| 266 | (append '("") (reverse result) (list thisstep)) "/")) | ||
| 267 | (setq symlink-target | ||
| 268 | (tramp-compat-file-attribute-type | ||
| 269 | (file-attributes | ||
| 270 | (tramp-make-tramp-file-name | ||
| 271 | v | ||
| 272 | (string-join | ||
| 273 | (append | ||
| 274 | '("") (reverse result) (list thisstep)) "/"))))) | ||
| 275 | (cond ((string= "." thisstep) | ||
| 276 | (tramp-message v 5 "Ignoring step `.'")) | ||
| 277 | ((string= ".." thisstep) | ||
| 278 | (tramp-message v 5 "Processing step `..'") | ||
| 279 | (pop result)) | ||
| 280 | ((stringp symlink-target) | ||
| 281 | ;; It's a symlink, follow it. | ||
| 282 | (tramp-message v 5 "Follow symlink to %s" symlink-target) | ||
| 283 | (setq numchase (1+ numchase)) | ||
| 284 | (when (file-name-absolute-p symlink-target) | ||
| 285 | (setq result nil)) | ||
| 286 | ;; If the symlink was absolute, we'll get a string | ||
| 287 | ;; like "/user@host:/some/target"; extract the | ||
| 288 | ;; "/some/target" part from it. | ||
| 289 | (when (tramp-tramp-file-p symlink-target) | ||
| 290 | (unless (tramp-equal-remote filename symlink-target) | ||
| 291 | (tramp-error | ||
| 292 | v 'file-error | ||
| 293 | "Symlink target `%s' on wrong host" symlink-target)) | ||
| 294 | (setq symlink-target localname)) | ||
| 295 | (setq steps | ||
| 296 | (append (split-string symlink-target "/" 'omit) | ||
| 297 | steps))) | ||
| 298 | (t | ||
| 299 | ;; It's a file. | ||
| 300 | (setq result (cons thisstep result))))) | ||
| 301 | (when (>= numchase numchase-limit) | ||
| 302 | (tramp-error | ||
| 303 | v 'file-error | ||
| 304 | "Maximum number (%d) of symlinks exceeded" numchase-limit)) | ||
| 305 | (setq result (reverse result)) | ||
| 306 | ;; Combine list to form string. | ||
| 307 | (setq result | ||
| 308 | (if result | ||
| 309 | (string-join (cons "" result) "/") | ||
| 310 | "/")) | ||
| 311 | (when (and is-dir (or (string-empty-p result) | ||
| 312 | (not (string= (substring result -1) "/")))) | ||
| 313 | (setq result (concat result "/")))) | ||
| 314 | |||
| 315 | ;; Detect cycle. | ||
| 316 | (when (and (file-symlink-p filename) | ||
| 317 | (string-equal result localname)) | ||
| 318 | (tramp-error | ||
| 319 | v 'file-error | ||
| 320 | "Apparent cycle of symbolic links for %s" filename)) | ||
| 321 | ;; If the resulting localname looks remote, we must quote it | ||
| 322 | ;; for security reasons. | ||
| 323 | (when (file-remote-p result) | ||
| 324 | (setq result (tramp-compat-file-name-quote result 'top))) | ||
| 325 | (tramp-message v 4 "True name of `%s' is `%s'" localname result) | ||
| 326 | result))))))) | ||
| 327 | |||
| 328 | (defun tramp-adb-handle-file-attributes (filename &optional id-format) | 230 | (defun tramp-adb-handle-file-attributes (filename &optional id-format) |
| 329 | "Like `file-attributes' for Tramp files." | 231 | "Like `file-attributes' for Tramp files." |
| 330 | (unless id-format (setq id-format 'integer)) | 232 | (unless id-format (setq id-format 'integer)) |
diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index 664f4413473..e63d83628a3 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el | |||
| @@ -24,7 +24,7 @@ | |||
| 24 | ;;; Commentary: | 24 | ;;; Commentary: |
| 25 | 25 | ||
| 26 | ;; Access functions for crypted remote files. It uses encfs to | 26 | ;; Access functions for crypted remote files. It uses encfs to |
| 27 | ;; encrypt/ decrypt the files on a remote directory. A remote | 27 | ;; encrypt / decrypt the files on a remote directory. A remote |
| 28 | ;; directory, which shall include crypted files, must be declared in | 28 | ;; directory, which shall include crypted files, must be declared in |
| 29 | ;; `tramp-crypt-directories' via command `tramp-crypt-add-directory'. | 29 | ;; `tramp-crypt-directories' via command `tramp-crypt-add-directory'. |
| 30 | ;; All files in that directory, including all subdirectories, are | 30 | ;; All files in that directory, including all subdirectories, are |
| @@ -189,8 +189,8 @@ If NAME doesn't belong to a crypted remote directory, retun nil." | |||
| 189 | (file-selinux-context . ignore) | 189 | (file-selinux-context . ignore) |
| 190 | (file-symlink-p . tramp-handle-file-symlink-p) | 190 | (file-symlink-p . tramp-handle-file-symlink-p) |
| 191 | (file-system-info . tramp-crypt-handle-file-system-info) | 191 | (file-system-info . tramp-crypt-handle-file-system-info) |
| 192 | ;; (file-truename . tramp-crypt-handle-file-truename) | 192 | ;; `file-truename' performed by default handler. |
| 193 | ;; (file-writable-p . ignore) | 193 | (file-writable-p . tramp-crypt-handle-file-writable-p) |
| 194 | (find-backup-file-name . tramp-handle-find-backup-file-name) | 194 | (find-backup-file-name . tramp-handle-find-backup-file-name) |
| 195 | ;; `get-file-buffer' performed by default handler. | 195 | ;; `get-file-buffer' performed by default handler. |
| 196 | (insert-directory . tramp-crypt-handle-insert-directory) | 196 | (insert-directory . tramp-crypt-handle-insert-directory) |
| @@ -351,7 +351,7 @@ connection if a previous connection has died for some reason." | |||
| 351 | 351 | ||
| 352 | (defun tramp-crypt-send-command (vec &rest args) | 352 | (defun tramp-crypt-send-command (vec &rest args) |
| 353 | "Send encfsctl command to connection VEC. | 353 | "Send encfsctl command to connection VEC. |
| 354 | ARGS are the arguments." | 354 | ARGS are the arguments. It returns t if ran successful, and nil otherwise." |
| 355 | (tramp-crypt-maybe-open-connection vec) | 355 | (tramp-crypt-maybe-open-connection vec) |
| 356 | (with-current-buffer (tramp-get-connection-buffer vec) | 356 | (with-current-buffer (tramp-get-connection-buffer vec) |
| 357 | (erase-buffer)) | 357 | (erase-buffer)) |
| @@ -380,11 +380,12 @@ ARGS are the arguments." | |||
| 380 | ;; Save the password. | 380 | ;; Save the password. |
| 381 | (ignore-errors | 381 | (ignore-errors |
| 382 | (and (functionp tramp-password-save-function) | 382 | (and (functionp tramp-password-save-function) |
| 383 | (funcall tramp-password-save-function))))))) | 383 | (funcall tramp-password-save-function))) |
| 384 | t)))) | ||
| 384 | 385 | ||
| 385 | (defun tramp-crypt-do-encrypt-or-decrypt-file-name (op name) | 386 | (defun tramp-crypt-do-encrypt-or-decrypt-file-name (op name) |
| 386 | "Return encrypted/ decrypted NAME if NAME belongs to a crypted directory. | 387 | "Return encrypted / decrypted NAME if NAME belongs to a crypted directory. |
| 387 | OP must be `encrypt' or `decrypt'. | 388 | OP must be `encrypt' or `decrypt'. Raise an error if this fails. |
| 388 | Otherwise, return NAME." | 389 | Otherwise, return NAME." |
| 389 | (if-let ((tramp-crypt-enabled t) | 390 | (if-let ((tramp-crypt-enabled t) |
| 390 | (dir (tramp-crypt-file-name-p name)) | 391 | (dir (tramp-crypt-file-name-p name)) |
| @@ -399,9 +400,12 @@ Otherwise, return NAME." | |||
| 399 | (unless (string-equal localname "/") | 400 | (unless (string-equal localname "/") |
| 400 | (with-tramp-file-property | 401 | (with-tramp-file-property |
| 401 | crypt-vec localname (concat (symbol-name op) "-file-name") | 402 | crypt-vec localname (concat (symbol-name op) "-file-name") |
| 402 | (tramp-crypt-send-command | 403 | (unless (tramp-crypt-send-command |
| 403 | crypt-vec (if (eq op 'encrypt) "encode" "decode") | 404 | crypt-vec (if (eq op 'encrypt) "encode" "decode") |
| 404 | (tramp-compat-temporary-file-directory) localname) | 405 | (tramp-compat-temporary-file-directory) localname) |
| 406 | (tramp-error | ||
| 407 | crypt-vec "%s of file name %s failed." | ||
| 408 | (if (eq op 'encrypt) "Encoding" "Decoding") name)) | ||
| 405 | (with-current-buffer (tramp-get-connection-buffer crypt-vec) | 409 | (with-current-buffer (tramp-get-connection-buffer crypt-vec) |
| 406 | (goto-char (point-min)) | 410 | (goto-char (point-min)) |
| 407 | (buffer-substring (point-min) (point-at-eol))))))) | 411 | (buffer-substring (point-min) (point-at-eol))))))) |
| @@ -419,9 +423,10 @@ Otherwise, return NAME." | |||
| 419 | (tramp-crypt-do-encrypt-or-decrypt-file-name 'decrypt name)) | 423 | (tramp-crypt-do-encrypt-or-decrypt-file-name 'decrypt name)) |
| 420 | 424 | ||
| 421 | (defun tramp-crypt-do-encrypt-or-decrypt-file (op root infile outfile) | 425 | (defun tramp-crypt-do-encrypt-or-decrypt-file (op root infile outfile) |
| 422 | "Encrypt/ decrypt file INFILE to OUTFILE according to crypted directory ROOT. | 426 | "Encrypt / decrypt file INFILE to OUTFILE according to crypted directory ROOT. |
| 423 | Both files must be local files. OP must be `encrypt' or `decrypt'. | 427 | Both files must be local files. OP must be `encrypt' or `decrypt'. |
| 424 | If OP ist `decrypt', the basename of INFILE must be an encrypted file name." | 428 | If OP ist `decrypt', the basename of INFILE must be an encrypted file name. |
| 429 | Raise an error if this fails." | ||
| 425 | (when-let ((tramp-crypt-enabled t) | 430 | (when-let ((tramp-crypt-enabled t) |
| 426 | (dir (tramp-crypt-file-name-p root)) | 431 | (dir (tramp-crypt-file-name-p root)) |
| 427 | (crypt-vec (tramp-crypt-dissect-file-name dir))) | 432 | (crypt-vec (tramp-crypt-dissect-file-name dir))) |
| @@ -429,10 +434,13 @@ If OP ist `decrypt', the basename of INFILE must be an encrypted file name." | |||
| 429 | (if (eq op 'decrypt) 'binary coding-system-for-read)) | 434 | (if (eq op 'decrypt) 'binary coding-system-for-read)) |
| 430 | (coding-system-for-write | 435 | (coding-system-for-write |
| 431 | (if (eq op 'encrypt) 'binary coding-system-for-write))) | 436 | (if (eq op 'encrypt) 'binary coding-system-for-write))) |
| 432 | (tramp-crypt-send-command | 437 | (unless (tramp-crypt-send-command |
| 433 | crypt-vec "cat" (and (eq op 'encrypt) "--reverse") | 438 | crypt-vec "cat" (and (eq op 'encrypt) "--reverse") |
| 434 | (file-name-directory infile) | 439 | (file-name-directory infile) |
| 435 | (concat "/" (file-name-nondirectory infile))) | 440 | (concat "/" (file-name-nondirectory infile))) |
| 441 | (tramp-error | ||
| 442 | crypt-vec "%s of file %s failed." | ||
| 443 | (if (eq op 'encrypt) "Encrypting" "Decrypting") infile)) | ||
| 436 | (with-current-buffer (tramp-get-connection-buffer crypt-vec) | 444 | (with-current-buffer (tramp-get-connection-buffer crypt-vec) |
| 437 | (write-region nil nil outfile))))) | 445 | (write-region nil nil outfile))))) |
| 438 | 446 | ||
| @@ -520,16 +528,17 @@ absolute file names." | |||
| 520 | (error "Unknown operation `%s', must be `copy' or `rename'" op)) | 528 | (error "Unknown operation `%s', must be `copy' or `rename'" op)) |
| 521 | 529 | ||
| 522 | (setq filename (file-truename filename)) | 530 | (setq filename (file-truename filename)) |
| 523 | (if (file-directory-p filename) | 531 | (let ((t1 (tramp-crypt-file-name-p filename)) |
| 524 | (progn | 532 | (t2 (tramp-crypt-file-name-p newname)) |
| 525 | (copy-directory filename newname keep-date t) | 533 | (encrypt-filename (tramp-crypt-encrypt-file-name filename)) |
| 526 | (when (eq op 'rename) (delete-directory filename 'recursive))) | 534 | (encrypt-newname (tramp-crypt-encrypt-file-name newname)) |
| 527 | 535 | (msg-operation (if (eq op 'copy) "Copying" "Renaming"))) | |
| 528 | (let ((t1 (tramp-crypt-file-name-p filename)) | 536 | |
| 529 | (t2 (tramp-crypt-file-name-p newname)) | 537 | (if (file-directory-p filename) |
| 530 | (encrypt-filename (tramp-crypt-encrypt-file-name filename)) | 538 | (progn |
| 531 | (encrypt-newname (tramp-crypt-encrypt-file-name newname)) | 539 | (copy-directory filename newname keep-date t) |
| 532 | (msg-operation (if (eq op 'copy) "Copying" "Renaming"))) | 540 | (when (eq op 'rename) |
| 541 | (delete-directory filename 'recursive))) | ||
| 533 | 542 | ||
| 534 | (with-parsed-tramp-file-name (if t1 filename newname) nil | 543 | (with-parsed-tramp-file-name (if t1 filename newname) nil |
| 535 | (unless (file-exists-p filename) | 544 | (unless (file-exists-p filename) |
| @@ -581,15 +590,15 @@ absolute file names." | |||
| 581 | (rename-file filename tmpfile1 t)) | 590 | (rename-file filename tmpfile1 t)) |
| 582 | (tramp-crypt-encrypt-file t2 tmpfile1 tmpfile2) | 591 | (tramp-crypt-encrypt-file t2 tmpfile1 tmpfile2) |
| 583 | (rename-file tmpfile2 encrypt-newname ok-if-already-exists))) | 592 | (rename-file tmpfile2 encrypt-newname ok-if-already-exists))) |
| 584 | (delete-directory tmpdir 'recursive))) | 593 | (delete-directory tmpdir 'recursive)))))) |
| 585 | 594 | ||
| 586 | (when (and t1 (eq op 'rename)) | 595 | (when (and t1 (eq op 'rename)) |
| 587 | (with-parsed-tramp-file-name filename v1 | 596 | (with-parsed-tramp-file-name filename v1 |
| 588 | (tramp-flush-file-properties v1 v1-localname))) | 597 | (tramp-flush-file-properties v1 v1-localname))) |
| 589 | 598 | ||
| 590 | (when t2 | 599 | (when t2 |
| 591 | (with-parsed-tramp-file-name newname v2 | 600 | (with-parsed-tramp-file-name newname v2 |
| 592 | (tramp-flush-file-properties v2 v2-localname)))))))) | 601 | (tramp-flush-file-properties v2 v2-localname))))) |
| 593 | 602 | ||
| 594 | (defun tramp-crypt-handle-copy-file | 603 | (defun tramp-crypt-handle-copy-file |
| 595 | (filename newname &optional ok-if-already-exists keep-date | 604 | (filename newname &optional ok-if-already-exists keep-date |
| @@ -692,28 +701,35 @@ absolute file names." | |||
| 692 | ;; #'file-system-info. | 701 | ;; #'file-system-info. |
| 693 | 'file-system-info (list (tramp-crypt-encrypt-file-name filename)))) | 702 | 'file-system-info (list (tramp-crypt-encrypt-file-name filename)))) |
| 694 | 703 | ||
| 704 | (defun tramp-crypt-handle-file-writable-p (filename) | ||
| 705 | "Like `file-writable-p' for Tramp files." | ||
| 706 | (let (tramp-crypt-enabled) | ||
| 707 | (file-writable-p (tramp-crypt-encrypt-file-name filename)))) | ||
| 708 | |||
| 695 | (defun tramp-crypt-handle-insert-directory | 709 | (defun tramp-crypt-handle-insert-directory |
| 696 | (filename switches &optional wildcard full-directory-p) | 710 | (filename switches &optional wildcard full-directory-p) |
| 697 | "Like `insert-directory' for Tramp files." | 711 | "Like `insert-directory' for Tramp files." |
| 698 | (let (tramp-crypt-enabled) | 712 | ;; This package has been added to Emacs 27.1. |
| 699 | (tramp-handle-insert-directory | 713 | (when (load "text-property-search" 'noerror 'nomessage) |
| 700 | (tramp-crypt-encrypt-file-name filename) | 714 | (let (tramp-crypt-enabled) |
| 701 | switches wildcard full-directory-p) | 715 | (tramp-handle-insert-directory |
| 702 | (let* ((filename (file-name-as-directory filename)) | 716 | (tramp-crypt-encrypt-file-name filename) |
| 703 | (enc (tramp-crypt-encrypt-file-name filename)) | 717 | switches wildcard full-directory-p) |
| 704 | match string) | 718 | (let* ((filename (file-name-as-directory filename)) |
| 705 | (goto-char (point-min)) | 719 | (enc (tramp-crypt-encrypt-file-name filename)) |
| 706 | (while (setq match (text-property-search-forward 'dired-filename t t)) | 720 | match string) |
| 707 | (setq string | 721 | (goto-char (point-min)) |
| 708 | (buffer-substring | 722 | (while (setq match (text-property-search-forward 'dired-filename t t)) |
| 709 | (prop-match-beginning match) (prop-match-end match)) | 723 | (setq string |
| 710 | string (if (file-name-absolute-p string) | 724 | (buffer-substring |
| 711 | (tramp-crypt-decrypt-file-name string) | 725 | (prop-match-beginning match) (prop-match-end match)) |
| 712 | (substring | 726 | string (if (file-name-absolute-p string) |
| 713 | (tramp-crypt-decrypt-file-name (concat enc string)) | 727 | (tramp-crypt-decrypt-file-name string) |
| 714 | (length filename)))) | 728 | (substring |
| 715 | (delete-region (prop-match-beginning match) (prop-match-end match)) | 729 | (tramp-crypt-decrypt-file-name (concat enc string)) |
| 716 | (insert (propertize string 'dired-filename t)))))) | 730 | (length filename)))) |
| 731 | (delete-region (prop-match-beginning match) (prop-match-end match)) | ||
| 732 | (insert (propertize string 'dired-filename t))))))) | ||
| 717 | 733 | ||
| 718 | (defun tramp-crypt-handle-make-directory (dir &optional parents) | 734 | (defun tramp-crypt-handle-make-directory (dir &optional parents) |
| 719 | "Like `make-directory' for Tramp files." | 735 | "Like `make-directory' for Tramp files." |
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 704d65cd55e..89e9b132304 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el | |||
| @@ -1589,7 +1589,7 @@ If FILE-SYSTEM is non-nil, return file system attributes." | |||
| 1589 | (current-time) | 1589 | (current-time) |
| 1590 | time))))) | 1590 | time))))) |
| 1591 | 1591 | ||
| 1592 | (defun tramp-gvfs-set-file-uid-gid (filename &optional uid gid) | 1592 | (defun tramp-gvfs-handle-set-file-uid-gid (filename &optional uid gid) |
| 1593 | "Like `tramp-set-file-uid-gid' for Tramp files." | 1593 | "Like `tramp-set-file-uid-gid' for Tramp files." |
| 1594 | (with-parsed-tramp-file-name filename nil | 1594 | (with-parsed-tramp-file-name filename nil |
| 1595 | (tramp-flush-file-properties v localname) | 1595 | (tramp-flush-file-properties v localname) |
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index a3ce436e42a..bcbb7240ec6 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el | |||
| @@ -1153,59 +1153,9 @@ component is used as the target of the symlink." | |||
| 1153 | (tramp-shell-quote-argument localname))))) | 1153 | (tramp-shell-quote-argument localname))))) |
| 1154 | 1154 | ||
| 1155 | ;; Do it yourself. | 1155 | ;; Do it yourself. |
| 1156 | (t (let ((steps (split-string localname "/" 'omit)) | 1156 | (t (setq |
| 1157 | (thisstep nil) | 1157 | result |
| 1158 | (numchase 0) | 1158 | (tramp-file-local-name (tramp-handle-file-truename filename))))) |
| 1159 | ;; Don't make the following value larger than | ||
| 1160 | ;; necessary. People expect an error message in a | ||
| 1161 | ;; timely fashion when something is wrong; | ||
| 1162 | ;; otherwise they might think that Emacs is hung. | ||
| 1163 | ;; Of course, correctness has to come first. | ||
| 1164 | (numchase-limit 20) | ||
| 1165 | symlink-target) | ||
| 1166 | (while (and steps (< numchase numchase-limit)) | ||
| 1167 | (setq thisstep (pop steps)) | ||
| 1168 | (tramp-message | ||
| 1169 | v 5 "Check %s" | ||
| 1170 | (string-join | ||
| 1171 | (append '("") (reverse result) (list thisstep)) "/")) | ||
| 1172 | (setq symlink-target | ||
| 1173 | (tramp-compat-file-attribute-type | ||
| 1174 | (file-attributes | ||
| 1175 | (tramp-make-tramp-file-name | ||
| 1176 | v | ||
| 1177 | (string-join | ||
| 1178 | (append | ||
| 1179 | '("") (reverse result) (list thisstep)) "/") | ||
| 1180 | 'nohop)))) | ||
| 1181 | (cond ((string= "." thisstep) | ||
| 1182 | (tramp-message v 5 "Ignoring step `.'")) | ||
| 1183 | ((string= ".." thisstep) | ||
| 1184 | (tramp-message v 5 "Processing step `..'") | ||
| 1185 | (pop result)) | ||
| 1186 | ((stringp symlink-target) | ||
| 1187 | ;; It's a symlink, follow it. | ||
| 1188 | (tramp-message | ||
| 1189 | v 5 "Follow symlink to %s" symlink-target) | ||
| 1190 | (setq numchase (1+ numchase)) | ||
| 1191 | (when (file-name-absolute-p symlink-target) | ||
| 1192 | (setq result nil)) | ||
| 1193 | (setq steps | ||
| 1194 | (append | ||
| 1195 | (split-string symlink-target "/" 'omit) | ||
| 1196 | steps))) | ||
| 1197 | (t | ||
| 1198 | ;; It's a file. | ||
| 1199 | (setq result (cons thisstep result))))) | ||
| 1200 | (when (>= numchase numchase-limit) | ||
| 1201 | (tramp-error | ||
| 1202 | v 'file-error | ||
| 1203 | "Maximum number (%d) of symlinks exceeded" numchase-limit)) | ||
| 1204 | (setq result (reverse result) | ||
| 1205 | ;; Combine list to form string. | ||
| 1206 | result | ||
| 1207 | (if result (string-join (cons "" result) "/") "/")) | ||
| 1208 | (when (string-empty-p result) (setq result "/"))))) | ||
| 1209 | 1159 | ||
| 1210 | ;; Detect cycle. | 1160 | ;; Detect cycle. |
| 1211 | (when (and (file-symlink-p filename) | 1161 | (when (and (file-symlink-p filename) |
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index f1db6a7be29..b045e411093 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el | |||
| @@ -3381,6 +3381,8 @@ User is always nil." | |||
| 3381 | ;; something is wrong; otherwise they might think that Emacs | 3381 | ;; something is wrong; otherwise they might think that Emacs |
| 3382 | ;; is hung. Of course, correctness has to come first. | 3382 | ;; is hung. Of course, correctness has to come first. |
| 3383 | (numchase-limit 20) | 3383 | (numchase-limit 20) |
| 3384 | ;; Unquoting could enable encryption. | ||
| 3385 | tramp-crypt-enabled | ||
| 3384 | symlink-target) | 3386 | symlink-target) |
| 3385 | (with-parsed-tramp-file-name result v1 | 3387 | (with-parsed-tramp-file-name result v1 |
| 3386 | ;; We cache only the localname. | 3388 | ;; We cache only the localname. |
| @@ -3900,7 +3902,11 @@ of." | |||
| 3900 | 3902 | ||
| 3901 | (let ((tmpfile (tramp-compat-make-temp-file filename)) | 3903 | (let ((tmpfile (tramp-compat-make-temp-file filename)) |
| 3902 | (modes (tramp-default-file-modes | 3904 | (modes (tramp-default-file-modes |
| 3903 | filename (and (eq mustbenew 'excl) 'nofollow)))) | 3905 | filename (and (eq mustbenew 'excl) 'nofollow))) |
| 3906 | (uid (tramp-compat-file-attribute-user-id | ||
| 3907 | (file-attributes filename 'integer))) | ||
| 3908 | (gid (tramp-compat-file-attribute-group-id | ||
| 3909 | (file-attributes filename 'integer)))) | ||
| 3904 | (when (and append (file-exists-p filename)) | 3910 | (when (and append (file-exists-p filename)) |
| 3905 | (copy-file filename tmpfile 'ok)) | 3911 | (copy-file filename tmpfile 'ok)) |
| 3906 | ;; The permissions of the temporary file should be set. If | 3912 | ;; The permissions of the temporary file should be set. If |
| @@ -3919,15 +3925,18 @@ of." | |||
| 3919 | (error | 3925 | (error |
| 3920 | (delete-file tmpfile) | 3926 | (delete-file tmpfile) |
| 3921 | (tramp-error | 3927 | (tramp-error |
| 3922 | v 'file-error "Couldn't write region to `%s'" filename)))) | 3928 | v 'file-error "Couldn't write region to `%s'" filename))) |
| 3923 | 3929 | ||
| 3924 | (tramp-flush-file-properties v localname) | 3930 | (tramp-flush-file-properties v localname) |
| 3925 | 3931 | ||
| 3926 | ;; Set file modification time. | 3932 | ;; Set file modification time. |
| 3927 | (when (or (eq visit t) (stringp visit)) | 3933 | (when (or (eq visit t) (stringp visit)) |
| 3928 | (set-visited-file-modtime | 3934 | (set-visited-file-modtime |
| 3929 | (tramp-compat-file-attribute-modification-time | 3935 | (tramp-compat-file-attribute-modification-time |
| 3930 | (file-attributes filename)))) | 3936 | (file-attributes filename)))) |
| 3937 | |||
| 3938 | ;; Set the ownership. | ||
| 3939 | (tramp-set-file-uid-gid filename uid gid)) | ||
| 3931 | 3940 | ||
| 3932 | ;; The end. | 3941 | ;; The end. |
| 3933 | (when (and (null noninteractive) | 3942 | (when (and (null noninteractive) |
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 578da4171c7..9667b34c667 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el | |||
| @@ -2925,6 +2925,9 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." | |||
| 2925 | ;; (this is performed by `dired'). If FULL is nil, it shows just | 2925 | ;; (this is performed by `dired'). If FULL is nil, it shows just |
| 2926 | ;; one file. So we refrain from testing. | 2926 | ;; one file. So we refrain from testing. |
| 2927 | (skip-unless (not (tramp--test-ange-ftp-p))) | 2927 | (skip-unless (not (tramp--test-ange-ftp-p))) |
| 2928 | ;; `insert-directory' of crypted remote directories works only since | ||
| 2929 | ;; Emacs 27.1. | ||
| 2930 | (skip-unless (or (not (tramp--test-crypt-p)) (tramp--test-emacs27-p))) | ||
| 2928 | 2931 | ||
| 2929 | (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) | 2932 | (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) |
| 2930 | (let* ((tmp-name1 | 2933 | (let* ((tmp-name1 |