From 761c630766abf5b59c9b8c8f6edde07b276ea4b4 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 25 Oct 2017 13:36:49 +0200 Subject: [PATCH] Fix Bug#28982 * admin/MAINTAINERS: Add test/lisp/url/url-tramp-tests.el. * lisp/url/url-tramp.el (url-tramp-convert-url-to-tramp) (url-tramp-convert-tramp-to-url): Adapt to recent Tramp changes. * test/lisp/url/url-tramp-tests.el: New file. (Bug#28982) --- admin/MAINTAINERS | 1 + lisp/url/url-tramp.el | 58 ++++++++++++---------- test/lisp/url/url-tramp-tests.el | 83 ++++++++++++++++++++++++++++++++ 3 files changed, 117 insertions(+), 25 deletions(-) create mode 100644 test/lisp/url/url-tramp-tests.el diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS index c13cb552a78..753a676e81a 100644 --- a/admin/MAINTAINERS +++ b/admin/MAINTAINERS @@ -62,6 +62,7 @@ Michael Albinus lisp/url/url-tramp.el doc/misc/tramp*.texi test/lisp/net/tramp-tests.el + test/lisp/url/url-tramp-tests.el D-Bus src/dbusbind.c diff --git a/lisp/url/url-tramp.el b/lisp/url/url-tramp.el index c28cf6c23a1..0b07bd0d1aa 100644 --- a/lisp/url/url-tramp.el +++ b/lisp/url/url-tramp.el @@ -37,33 +37,41 @@ They must also be covered by `url-handler-regexp'." :type '(repeat string)) (defun url-tramp-convert-url-to-tramp (url) - "Convert URL to a Tramp file name." - (let ((obj (url-generic-parse-url (and (stringp url) url)))) - (if (member (url-type obj) url-tramp-protocols) - (progn - (if (url-password obj) - (password-cache-add - (tramp-make-tramp-file-name - (url-type obj) (url-user obj) (url-host obj) "") - (url-password obj)) - (tramp-make-tramp-file-name - (url-type obj) (url-user obj) (url-host obj) (url-filename obj)))) - url))) + "Convert URL to a Tramp file name. +If URL contains a password, it will be added to the `password-data' cache. +In case URL is not convertable, nil is returned." + (let* ((obj (url-generic-parse-url (and (stringp url) url))) + (port + (and (natnump (url-portspec obj)) + (number-to-string (url-portspec obj))))) + (when (member (url-type obj) url-tramp-protocols) + (when (url-password obj) + (password-cache-add + (tramp-make-tramp-file-name + (url-type obj) (url-user obj) nil + (url-host obj) port "") + (url-password obj))) + (tramp-make-tramp-file-name + (url-type obj) (url-user obj) nil + (url-host obj) port (url-filename obj))))) (defun url-tramp-convert-tramp-to-url (file) - "Convert FILE, a Tramp file name, to a URL." - (let ((obj (ignore-errors (tramp-dissect-file-name file)))) - (if (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) - nil ; port. - (tramp-file-name-localname obj) - nil nil t)) ; target attributes fullness. - file))) + "Convert FILE, a Tramp file name, to a URL. +In case FILE is not convertable, nil is returned." + (let* ((obj (ignore-errors (tramp-dissect-file-name file))) + (port + (and (stringp (tramp-file-name-port obj)) + (string-to-number (tramp-file-name-port obj))))) + (when (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. ;;;###autoload (defun url-tramp-file-handler (operation &rest args) diff --git a/test/lisp/url/url-tramp-tests.el b/test/lisp/url/url-tramp-tests.el new file mode 100644 index 00000000000..9892cd78475 --- /dev/null +++ b/test/lisp/url/url-tramp-tests.el @@ -0,0 +1,83 @@ +;;; url-tramp-tests.el --- Test suite for Tramp / URL conversion. + +;; Copyright (C) 2017 Free Software Foundation, Inc. + +;; Author: Michael Albinus + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'url-tramp) +(require 'ert) + +(ert-deftest url-tramp-test-convert-url-to-tramp () + "Test that URLs are converted into proper Tramp file names." + (should + (string-equal + (url-tramp-convert-url-to-tramp "ftp://ftp.is.co.za/rfc/rfc1808.txt") + "/ftp:ftp.is.co.za:/rfc/rfc1808.txt")) + + (should + (string-equal + (url-tramp-convert-url-to-tramp "ssh://user@localhost") + "/ssh:user@localhost:")) + + (should + (string-equal + (url-tramp-convert-url-to-tramp "telnet://remotehost:42") + "/telnet:remotehost#42:")) + + ;; The password will be added to the cache. The password cache key + ;; is the remote file name identification of the Tramp file. + (should + (string-equal + (url-tramp-convert-url-to-tramp "scp://user:geheim@somewhere/localfile") + "/scp:user@somewhere:/localfile")) + (let ((key + (file-remote-p + (url-tramp-convert-url-to-tramp "scp://user@somewhere/localfile")))) + (should (password-in-cache-p key)) + (should (string-equal (password-read-from-cache key) "geheim")) + (password-cache-remove key) + (should-not (password-in-cache-p key))) + + ;; "http" does not belong to `url-tramp-protocols'. + (should-not (url-tramp-convert-url-to-tramp "http://www.gnu.org"))) + +(ert-deftest url-tramp-test-convert-tramp-to-url () + "Test that Tramp file names are converted into proper URLs." + (should + (string-equal + (url-tramp-convert-tramp-to-url "/ftp:ftp.is.co.za:/rfc/rfc1808.txt") + "ftp://ftp.is.co.za/rfc/rfc1808.txt")) + + (should + (string-equal + (url-tramp-convert-tramp-to-url "/ssh:user@localhost:") + "ssh://user@localhost")) + + (should + (string-equal + (url-tramp-convert-tramp-to-url "/telnet:user@remotehost#42:") + "telnet://user@remotehost:42")) + + ;; "sftp" does not belong to `url-tramp-protocols'. + (should-not (url-tramp-convert-tramp-to-url "/sftp:user@localhost:"))) + +(provide 'url-tramp-tests) + +;;; url-tramp-tests.el ends here -- 2.39.2