aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMichael Albinus2020-06-12 20:17:02 +0200
committerMichael Albinus2020-06-12 20:17:02 +0200
commit459bd56f46af8cd7c29965600c46387282c3c93f (patch)
tree47f2f4b4b0071db3df38da22b8fadfea43ec9345
parent54efe18959591faa1087051c878abe470f53a28f (diff)
downloademacs-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.texi7
-rw-r--r--lisp/net/tramp-adb.el100
-rw-r--r--lisp/net/tramp-crypt.el120
-rw-r--r--lisp/net/tramp-gvfs.el2
-rw-r--r--lisp/net/tramp-sh.el56
-rw-r--r--lisp/net/tramp.el25
-rw-r--r--test/lisp/net/tramp-tests.el3
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
1189it 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
1732multi-hop file names like 1729multi-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},
1734where @samp{box} is the name of the vagrant box. 1731where @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
2657use it in production systems!
2658
2658Sometimes, it is desirable to protect files located on remote 2659Sometimes, it is desirable to protect files located on remote
2659directories, like cloud storages. In order to do this, you might 2660directories, like cloud storages. In order to do this, you might
2660instruct @value{tramp} to encrypt all files copied to a given remote 2661instruct @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.
354ARGS are the arguments." 354ARGS 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.
387OP must be `encrypt' or `decrypt'. 388OP must be `encrypt' or `decrypt'. Raise an error if this fails.
388Otherwise, return NAME." 389Otherwise, 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.
423Both files must be local files. OP must be `encrypt' or `decrypt'. 427Both files must be local files. OP must be `encrypt' or `decrypt'.
424If OP ist `decrypt', the basename of INFILE must be an encrypted file name." 428If OP ist `decrypt', the basename of INFILE must be an encrypted file name.
429Raise 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