[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master e5f50f3: Further Tramp code cleanup
From: |
Michael Albinus |
Subject: |
master e5f50f3: Further Tramp code cleanup |
Date: |
Wed, 17 Feb 2021 12:04:42 -0500 (EST) |
branch: master
commit e5f50f32f76bab2607d77f0dc51cf81ec0c1e232
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>
Further Tramp code cleanup
* doc/misc/tramp.texi (Predefined connection information):
Mention "about-args".
* lisp/net/tramp-cmds.el (tramp-version): Adapt docstring.
* lisp/net/tramp.el (tramp-handle-expand-file-name):
* lisp/net/tramp-gvfs.el (tramp-gvfs-handle-expand-file-name):
* lisp/net/tramp-sh.el (tramp-sh-handle-expand-file-name)
* lisp/net/tramp-smb.el (tramp-smb-handle-expand-file-name):
* lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-expand-file-name):
Handle local "/..".
* lisp/net/tramp-rclone.el (tramp-methods) <rclone>:
Adapt `tramp-mount-args'.
(tramp-rclone-flush-directory-cache): Remove.
(tramp-rclone-do-copy-or-rename-file)
(tramp-rclone-handle-delete-directory)
(tramp-rclone-handle-delete-file)
(tramp-rclone-handle-make-directory): Don't use that function.
(tramp-rclone-maybe-open-connection): Fix use of `tramp-mount-args'.
* lisp/net/trampver.el (tramp-inside-emacs): New defun.
* lisp/net/tramp.el (tramp-handle-make-process):
* lisp/net/tramp-sh.el (tramp-sh-handle-make-process)
(tramp-sh-handle-process-file, tramp-open-shell): Use it.
(tramp-get-env-with-u-option): Remove.
* test/lisp/net/tramp-tests.el (tramp-test05-expand-file-name-top):
New test.
---
doc/misc/tramp.texi | 6 ++--
lisp/net/tramp-cmds.el | 2 +-
lisp/net/tramp-gvfs.el | 3 ++
lisp/net/tramp-rclone.el | 71 ++++++++------------------------------------
lisp/net/tramp-sh.el | 39 +++++++-----------------
lisp/net/tramp-smb.el | 3 ++
lisp/net/tramp-sudoedit.el | 3 ++
lisp/net/tramp.el | 8 ++---
lisp/net/trampver.el | 5 ++++
test/lisp/net/tramp-tests.el | 14 +++++++--
10 files changed, 57 insertions(+), 97 deletions(-)
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index c2e9fe6..6d60215 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -2083,10 +2083,12 @@ there is no effect of this property.
@item @t{"mount-args"}@*
@t{"copyto-args"}@*
-@t{"moveto-args"}
+@t{"moveto-args"}@*
+@t{"about-args"}
These properties keep optional flags to the different @option{rclone}
-operations. Their default value is @code{nil}.
+operations. See their default values in @code{tramp-methods} if you
+want to change their values.
@end itemize
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index 097f25e..f0bbe31 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -465,7 +465,7 @@ For details, see `tramp-rename-files'."
;;;###tramp-autoload
(defun tramp-version (arg)
- "Print version number of tramp.el in minibuffer or current buffer."
+ "Print version number of tramp.el in echo area or current buffer."
(interactive "P")
(if arg (insert tramp-version) (message tramp-version)))
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index e946d73..9d4e04c 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -1172,6 +1172,9 @@ file names."
;; There might be a double slash. Remove this.
(while (string-match "//" localname)
(setq localname (replace-match "/" t t localname)))
+ ;; Do not keep "/..".
+ (when (string-match-p "^/\\.\\.?$" localname)
+ (setq localname "/"))
;; No tilde characters in file name, do normal
;; `expand-file-name' (this does "/./" and "/../").
(tramp-make-tramp-file-name
diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el
index 96f7d9a..a7f4c9b 100644
--- a/lisp/net/tramp-rclone.el
+++ b/lisp/net/tramp-rclone.el
@@ -53,7 +53,12 @@
(tramp--with-startup
(add-to-list 'tramp-methods
`(,tramp-rclone-method
- (tramp-mount-args nil)
+ ;; Be careful changing "--dir-cache-time", this could
+ ;; delay visibility of files. Since we use Tramp's
+ ;; internal cache for file attributes, there shouldn't
+ ;; be serious performance penalties when set to 0.
+ (tramp-mount-args
+ ("--no-unicode-normalization" "--dir-cache-time" "0s"))
(tramp-copyto-args nil)
(tramp-moveto-args nil)
(tramp-about-args ("--full"))))
@@ -247,24 +252,13 @@ file names."
"Error %s `%s' `%s'" msg-operation filename newname)))
(when (and t1 (eq op 'rename))
- (with-parsed-tramp-file-name filename v1
- (tramp-flush-file-properties v1 v1-localname)
- (when (tramp-rclone-file-name-p filename)
- (tramp-rclone-flush-directory-cache v1)
- ;; The mount point's directory cache might need time
- ;; to flush.
- (while (file-exists-p filename)
- (tramp-flush-file-properties v1 v1-localname)))))
+ (while (file-exists-p filename)
+ (with-parsed-tramp-file-name filename v1
+ (tramp-flush-file-properties v1 v1-localname))))
(when t2
(with-parsed-tramp-file-name newname v2
- (tramp-flush-file-properties v2 v2-localname)
- (when (tramp-rclone-file-name-p newname)
- (tramp-rclone-flush-directory-cache v2)
- ;; The mount point's directory cache might need time
- ;; to flush.
- (while (not (file-exists-p newname))
- (tramp-flush-file-properties v2 v2-localname))))))))))
+ (tramp-flush-file-properties v2 v2-localname))))))))
(defun tramp-rclone-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
@@ -288,13 +282,11 @@ file names."
"Like `delete-directory' for Tramp files."
(with-parsed-tramp-file-name (expand-file-name directory) nil
(tramp-flush-directory-properties v localname)
- (tramp-rclone-flush-directory-cache v)
(delete-directory (tramp-rclone-local-file-name directory) recursive
trash)))
(defun tramp-rclone-handle-delete-file (filename &optional trash)
"Like `delete-file' for Tramp files."
(with-parsed-tramp-file-name (expand-file-name filename) nil
- (tramp-rclone-flush-directory-cache v)
(delete-file (tramp-rclone-local-file-name filename) trash)
(tramp-flush-file-properties v localname)))
@@ -420,8 +412,7 @@ file names."
;; whole file cache.
(tramp-flush-file-properties v localname)
(tramp-flush-directory-properties
- v (if parents "/" (file-name-directory localname)))
- (tramp-rclone-flush-directory-cache v)))
+ v (if parents "/" (file-name-directory localname)))))
(defun tramp-rclone-handle-rename-file
(filename newname &optional ok-if-already-exists)
@@ -467,39 +458,6 @@ file names."
mount)
(match-string 1 mount)))))))
-(defun tramp-rclone-flush-directory-cache (vec)
- "Flush directory cache of VEC mount."
- (let ((rclone-pid
- ;; Identify rclone process.
- (when (tramp-get-connection-process vec)
- (with-tramp-connection-property
- (tramp-get-connection-process vec) "rclone-pid"
- (catch 'pid
- (dolist
- (pid
- ;; Until Emacs 25, `process-attributes' could
- ;; crash Emacs for some processes. So we use
- ;; "pidof", which might not work everywhere.
- (if (<= emacs-major-version 25)
- (let ((default-directory
- (tramp-compat-temporary-file-directory)))
- (mapcar
- #'string-to-number
- (split-string
- (shell-command-to-string "pidof rclone"))))
- (list-system-processes)))
- (and (string-match-p
- (regexp-quote
- (format "rclone mount %s:" (tramp-file-name-host vec)))
- (or (cdr (assoc 'args (process-attributes pid))) ""))
- (throw 'pid pid))))))))
- ;; Send a SIGHUP in order to flush directory cache.
- (when rclone-pid
- (tramp-message
- vec 6 "Send SIGHUP %d: %s"
- rclone-pid (cdr (assoc 'args (process-attributes rclone-pid))))
- (signal-process rclone-pid 'SIGHUP))))
-
(defun tramp-rclone-local-file-name (filename)
"Return local mount name of FILENAME."
(setq filename (tramp-compat-file-name-unquote (expand-file-name filename)))
@@ -572,7 +530,7 @@ connection if a previous connection has died for some
reason."
`("mount" ,(concat host ":/")
,(tramp-rclone-mount-point vec)
;; This could be nil.
- ,(tramp-get-method-parameter vec 'tramp-mount-args))))
+ ,@(tramp-get-method-parameter vec 'tramp-mount-args))))
(while (not (file-exists-p (tramp-make-tramp-file-name vec 'noloc)))
(tramp-cleanup-connection vec 'keep-debug 'keep-password))
@@ -607,9 +565,4 @@ The command is the list of strings ARGS."
(provide 'tramp-rclone)
-;;; TODO:
-
-;; * If possible, get rid of "rclone mount". Maybe it is more
-;; performant then.
-
;;; tramp-rclone.el ends here
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index bcdc014..5730199 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -2818,6 +2818,9 @@ the result will be a local, non-Tramp, file name."
;; expands to "/". Remove this.
(while (string-match "//" localname)
(setq localname (replace-match "/" t t localname)))
+ ;; Do not keep "/..".
+ (when (string-match-p "^/\\.\\.?$" localname)
+ (setq localname "/"))
;; No tilde characters in file name, do normal
;; `expand-file-name' (this does "/./" and "/../").
;; `default-directory' is bound, because on Windows there would
@@ -2927,16 +2930,11 @@ alternative implementation will be used."
elt (default-toplevel-value 'process-environment))
(if (string-match-p "=" elt)
(setq env (append env `(,elt)))
- (if (tramp-get-env-with-u-option v)
- (setq env (append `("-u" ,elt) env))
- (setq uenv (cons elt uenv)))))))
+ (setq uenv (cons elt uenv))))))
+ (env (setenv-internal
+ env "INSIDE_EMACS" (tramp-inside-emacs) 'keep))
(command
(when (stringp program)
- (setenv-internal
- env "INSIDE_EMACS"
- (concat (or (getenv "INSIDE_EMACS") emacs-version)
- ",tramp:" tramp-version)
- 'keep)
(format "cd %s && %s exec %s %s env %s %s"
(tramp-shell-quote-argument localname)
(if uenv
@@ -3147,14 +3145,8 @@ alternative implementation will be used."
(or (member elt (default-toplevel-value 'process-environment))
(if (string-match-p "=" elt)
(setq env (append env `(,elt)))
- (if (tramp-get-env-with-u-option v)
- (setq env (append `("-u" ,elt) env))
- (setq uenv (cons elt uenv))))))
- (setenv-internal
- env "INSIDE_EMACS"
- (concat (or (getenv "INSIDE_EMACS") emacs-version)
- ",tramp:" tramp-version)
- 'keep)
+ (setq uenv (cons elt uenv)))))
+ (setenv-internal env "INSIDE_EMACS" (tramp-inside-emacs) 'keep)
(when env
(setq command
(format
@@ -4307,10 +4299,9 @@ file exists and nonzero exit status otherwise."
(tramp-send-command
vec (format
(concat
- "exec env TERM='%s' INSIDE_EMACS='%s,tramp:%s' "
+ "exec env TERM='%s' INSIDE_EMACS='%s' "
"ENV=%s %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s -i")
- tramp-terminal-type
- (or (getenv "INSIDE_EMACS") emacs-version) tramp-version
+ tramp-terminal-type (tramp-inside-emacs)
(or (getenv-internal "ENV" tramp-remote-process-environment) "")
(if (stringp tramp-histfile-override)
(format "HISTFILE=%s"
@@ -5945,16 +5936,6 @@ This command is returned only if
`delete-by-moving-to-trash' is non-nil."
(tramp-file-local-name tmpfile) (tramp-file-local-name tmpfile)))
(delete-file tmpfile)))))
-(defun tramp-get-env-with-u-option (vec)
- "Check, whether the remote `env' command supports the -u option."
- (with-tramp-connection-property vec "env-u-option"
- (tramp-message vec 5 "Checking, whether `env -u' works")
- ;; Option "-u" is a GNU extension.
- (tramp-send-command-and-check
- vec (format "env FOO=foo env -u FOO 2>%s | grep -qv FOO"
- (tramp-get-remote-null-device vec))
- t)))
-
;; Some predefined connection properties.
(defun tramp-get-inline-compress (vec prop size)
"Return the compress command related to PROP.
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 26ec910..4519c34 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -743,6 +743,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
;; Make the file name absolute.
(unless (tramp-run-real-handler #'file-name-absolute-p (list localname))
(setq localname (concat "/" localname)))
+ ;; Do not keep "/..".
+ (when (string-match-p "^/\\.\\.?$" localname)
+ (setq localname "/"))
;; No tilde characters in file name, do normal
;; `expand-file-name' (this does "/./" and "/../").
(tramp-make-tramp-file-name
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index 0a60b79..e181365 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -364,6 +364,9 @@ the result will be a local, non-Tramp, file name."
(when (string-equal uname "~")
(setq uname (concat uname user)))
(setq localname (concat uname fname))))
+ ;; Do not keep "/..".
+ (when (string-match-p "^/\\.\\.?$" localname)
+ (setq localname "/"))
;; Do normal `expand-file-name' (this does "~user/", "/./" and "/../").
(tramp-make-tramp-file-name v (expand-file-name localname))))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index e33075e..e99e439 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -3163,6 +3163,9 @@ User is always nil."
(with-parsed-tramp-file-name name nil
(unless (tramp-run-real-handler #'file-name-absolute-p (list localname))
(setq localname (concat "/" localname)))
+ ;; Do not keep "/..".
+ (when (string-match-p "^/\\.\\.?$" localname)
+ (setq localname "/"))
;; Do normal `expand-file-name' (this does "/./" and "/../").
;; `default-directory' is bound, because on Windows there would
;; be problems with UNC shares or Cygwin mounts.
@@ -3811,10 +3814,7 @@ It does not support `:stderr'."
elt (default-toplevel-value
'process-environment))))
(setq env (cons elt env)))))
(env (setenv-internal
- env "INSIDE_EMACS"
- (concat (or (getenv "INSIDE_EMACS") emacs-version)
- ",tramp:" tramp-version)
- 'keep))
+ env "INSIDE_EMACS" (tramp-inside-emacs) 'keep))
(env (mapcar #'tramp-shell-quote-argument (delq nil env)))
;; Quote command.
(command (mapconcat #'tramp-shell-quote-argument command " "))
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index ced3e93..abd9221 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -80,6 +80,11 @@
(replace-regexp-in-string "\n" "" (emacs-version))))))
(unless (string-equal "ok" x) (error "%s" x)))
+(defun tramp-inside-emacs ()
+ "Version string provided by INSIDE_EMACS enmvironment variable."
+ (concat (or (getenv "INSIDE_EMACS") emacs-version)
+ ",tramp:" tramp-version))
+
;; Tramp versions integrated into Emacs. If a user option declares a
;; `:package-version' which doesn't belong to an integrated Tramp
;; version, it must be added here as well (see `tramp-syntax', for
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index f488392..9a83fa6 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -2182,6 +2182,16 @@ is greater than 10.
(expand-file-name ".." "./"))
(concat (file-remote-p tramp-test-temporary-file-directory) "/"))))
+(ert-deftest tramp-test05-expand-file-name-top ()
+ "Check `expand-file-name'."
+ (skip-unless (tramp--test-enabled))
+ (skip-unless (not (tramp--test-ange-ftp-p)))
+
+ (let ((dir (concat (file-remote-p tramp-test-temporary-file-directory) "/")))
+ (dolist (local '("." ".."))
+ (should (string-equal (expand-file-name local dir) dir))
+ (should (string-equal (expand-file-name (concat dir local)) dir)))))
+
(ert-deftest tramp-test06-directory-file-name ()
"Check `directory-file-name'.
This checks also `file-name-as-directory', `file-name-directory',
@@ -6730,8 +6740,8 @@ Since it unloads Tramp, it shall be the last test to run."
If INTERACTIVE is non-nil, the tests are run interactively."
(interactive "p")
(funcall
- (if interactive
- #'ert-run-tests-interactively #'ert-run-tests-batch) "^tramp"))
+ (if interactive #'ert-run-tests-interactively #'ert-run-tests-batch)
+ "^tramp"))
;; TODO:
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- master e5f50f3: Further Tramp code cleanup,
Michael Albinus <=