mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-05 11:45:45 +00:00
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.
This commit is contained in:
parent
854714efb4
commit
8400c59358
@ -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)
|
||||
|
@ -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.
|
||||
|
@ -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)
|
||||
|
Loading…
Reference in New Issue
Block a user