From: Michael Albinus Date: Wed, 17 Feb 2021 17:04:35 +0000 (+0100) Subject: Further Tramp code cleanup X-Git-Tag: emacs-28.0.90~3681 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=e5f50f32f76bab2607d77f0dc51cf81ec0c1e232;p=emacs.git 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) : 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. --- diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index c2e9fe66dfd..6d602157344 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 097f25ea85e..f0bbe31cea0 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 e946d73e66c..9d4e04ca689 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 96f7d9a89b9..a7f4c9be82c 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 bcdc014daba..57301994074 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 26ec910ecc8..4519c34d36e 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 0a60b791822..e181365162e 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 e33075ec6f5..e99e43938f2 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 ced3e93fc09..abd92219b27 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 f4883923f6a..9a83fa66761 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: