From: Michael Albinus <michael.albinus@gmx.de>
Date: Mon, 20 Jun 2022 10:47:27 +0000 (+0200)
Subject: Fix problems with Tramp FTP and URL handler mode
X-Git-Tag: emacs-29.0.90~1447^2~1592
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=8400c59358c69574f3eeb2751b517f94abb28274;p=emacs.git

Fix problems with Tramp FTP and URL handler mode

* lisp/net/tramp-archive.el (tramp-archive-run-real-handler):
Add ;;;###tramp-autoload cookie.

* lisp/net/tramp-ftp.el (tramp-ftp-file-name-handler): Prevent invocation
of `tramp-archive-file-name-handler'.  (Bug#56078)

* lisp/url/url-tramp.el (url-tramp-convert-url-to-tramp)
(url-tramp-convert-tramp-to-url): Make them more robust.
---

diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el
index f30aa021b64..119ac54dd29 100644
--- a/lisp/net/tramp-archive.el
+++ b/lisp/net/tramp-archive.el
@@ -309,7 +309,8 @@ Operations not mentioned here will be handled by the default Emacs primitives.")
 	     #'tramp-archive-file-name-p))
     (apply #'tramp-file-name-for-operation operation args)))
 
-(defun tramp-archive-run-real-handler (operation args)
+;;;###tramp-autoload
+(progn (defun tramp-archive-run-real-handler (operation args)
   "Invoke normal file name handler for OPERATION.
 First arg specifies the OPERATION, second arg ARGS is a list of
 arguments to pass to the OPERATION."
@@ -319,7 +320,7 @@ arguments to pass to the OPERATION."
 	    ,(and (eq inhibit-file-name-operation operation)
 		  inhibit-file-name-handlers)))
 	 (inhibit-file-name-operation operation))
-    (apply operation args)))
+    (apply operation args))))
 
 ;;;###tramp-autoload
 (defun tramp-archive-file-name-handler (operation &rest args)
diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el
index ff8caa570ca..7a13760ffc9 100644
--- a/lisp/net/tramp-ftp.el
+++ b/lisp/net/tramp-ftp.el
@@ -135,12 +135,21 @@ pass to the OPERATION."
        ;; completion.  We don't use `with-parsed-tramp-file-name',
        ;; because this returns another user but the one declared in
        ;; "~/.netrc".
+       ;; For file names which look like Tramp archive files like
+       ;; "/ftp:anonymous@ftp.gnu.org:/gnu/tramp/tramp-2.0.39.tar.gz",
+       ;; we must disable tramp-archive.el, because in
+       ;; `ange-ftp-get-files' this is "normalized" by
+       ;; `file-name-as-directory' with unwelcome side side-effects.
+       ;; This disables the file archive functionality, perhaps we
+       ;; could fix this otherwise.  (Bug#56078)
        ((memq operation '(file-directory-p file-exists-p))
-	(if (apply #'ange-ftp-hook-function operation args)
+	(cl-letf (((symbol-function #'tramp-archive-file-name-handler)
+		   (lambda (operation &rest args)
+		     (tramp-archive-run-real-handler operation args))))
+	  (prog1 (apply #'ange-ftp-hook-function operation args)
 	    (let ((v (tramp-dissect-file-name (car args) t)))
 	      (setf (tramp-file-name-method v) tramp-ftp-method)
-	      (tramp-set-connection-property v "started" t))
-	  nil))
+	      (tramp-set-connection-property v "started" t)))))
 
        ;; If the second argument of `copy-file' or `rename-file' is a
        ;; remote file name but via FTP, ange-ftp doesn't check this.
diff --git a/lisp/url/url-tramp.el b/lisp/url/url-tramp.el
index 30c1961407e..2918192a45a 100644
--- a/lisp/url/url-tramp.el
+++ b/lisp/url/url-tramp.el
@@ -44,36 +44,39 @@ In case URL is not convertible, nil is returned."
          (port
           (and obj (natnump (url-portspec obj))
                (number-to-string (url-portspec obj)))))
-    (when (and obj (member (url-type obj) url-tramp-protocols))
-      (when (url-password obj)
-	(password-cache-add
-	 (tramp-make-tramp-file-name
-          (make-tramp-file-name
-	   :method (url-type obj) :user (url-user obj)
-           :host (url-host obj)))
-	 (url-password obj)))
-      (tramp-make-tramp-file-name
-       (make-tramp-file-name
-        :method (url-type obj) :user (url-user obj)
-        :host (url-host obj) :port port :localname (url-filename obj))))))
+    (if (and obj (member (url-type obj) url-tramp-protocols))
+        (progn
+          (when (url-password obj)
+	    (password-cache-add
+	     (tramp-make-tramp-file-name
+              (make-tramp-file-name
+	       :method (url-type obj) :user (url-user obj)
+               :host (url-host obj)))
+	     (url-password obj)))
+          (tramp-make-tramp-file-name
+           (make-tramp-file-name
+            :method (url-type obj) :user (url-user obj)
+            :host (url-host obj) :port port :localname (url-filename obj))))
+      url)))
 
 (defun url-tramp-convert-tramp-to-url (file)
   "Convert FILE, a Tramp file name, to a URL.
 In case FILE is not convertible, nil is returned."
-  (let* ((obj (ignore-errors (tramp-dissect-file-name file)))
+  (let* ((obj (and (tramp-tramp-file-p file) (tramp-dissect-file-name file)))
          (port
           (and obj (stringp (tramp-file-name-port obj))
                (string-to-number (tramp-file-name-port obj)))))
-    (when (and obj (member (tramp-file-name-method obj) url-tramp-protocols))
-      (url-recreate-url
-       (url-parse-make-urlobj
-	(tramp-file-name-method obj)
-	(tramp-file-name-user obj)
-	nil ; password.
-	(tramp-file-name-host obj)
-	port
-	(tramp-file-name-localname obj)
-	nil nil t))))) ; target attributes fullness.
+    (if (and obj (member (tramp-file-name-method obj) url-tramp-protocols))
+        (url-recreate-url
+         (url-parse-make-urlobj
+	  (tramp-file-name-method obj)
+	  (tramp-file-name-user obj)
+	  nil ; password.
+	  (tramp-file-name-host obj)
+	  port
+	  (tramp-file-name-localname obj)
+	  nil nil t)) ; target attributes fullness.
+      file)))
 
 ;;;###autoload
 (defun url-tramp-file-handler (operation &rest args)