emacs-diffs
[Top][All Lists]
Advanced

[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:
 



reply via email to

[Prev in Thread] Current Thread [Next in Thread]