lisp/url/url-tramp.el

   1 ;;; url-tramp.el --- file-name-handler magic invoking Tramp for some protocols
   2
   3 ;; Copyright (C) 2014-2018 Free Software Foundation, Inc.
   4
   5 ;; Author: Michael Albinus <michael.albinus@gmx.de>
   6 ;; Keywords: comm, data, processes, hypermedia
   7
   8 ;; This file is part of GNU Emacs.
   9 ;;
  10 ;; GNU Emacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;;; Code:
  26
  27 (require 'url-parse)
  28 (require 'tramp)
  29 (require 'password-cache)
  30
  31 ;;;###autoload
  32 (defcustom url-tramp-protocols '("ftp" "ssh" "scp" "rsync" "telnet")
  33   "List of URL protocols for which the work is handled by Tramp.
  34 They must also be covered by `url-handler-regexp'."
  35   :group 'url
  36   :version "25.1"
  37   :type '(repeat string))
  38
  39 (defun url-tramp-convert-url-to-tramp (url)
  40   "Convert URL to a Tramp file name.
  41 If URL contains a password, it will be added to the `password-data' cache.
  42 In case URL is not convertible, nil is returned."
  43   (let* ((obj (url-generic-parse-url (and (stringp url) url)))
  44          (port
  45           (and (natnump (url-portspec obj))
  46                (number-to-string (url-portspec obj)))))
  47     (when (member (url-type obj) url-tramp-protocols)
  48       (when (url-password obj)
  49         (password-cache-add
  50          (tramp-make-tramp-file-name
  51           (url-type obj) (url-user obj) nil
  52           (url-host obj) port "")
  53          (url-password obj)))
  54       (tramp-make-tramp-file-name
  55        (url-type obj) (url-user obj) nil
  56        (url-host obj) port (url-filename obj)))))
  57
  58 (defun url-tramp-convert-tramp-to-url (file)
  59   "Convert FILE, a Tramp file name, to a URL.
  60 In case FILE is not convertible, nil is returned."
  61   (let* ((obj (ignore-errors (tramp-dissect-file-name file)))
  62          (port
  63           (and (stringp (tramp-file-name-port obj))
  64                (string-to-number (tramp-file-name-port obj)))))
  65     (when (member (tramp-file-name-method obj) url-tramp-protocols)
  66       (url-recreate-url
  67        (url-parse-make-urlobj
  68         (tramp-file-name-method obj)
  69         (tramp-file-name-user obj)
  70         nil ; password.
  71         (tramp-file-name-host obj)
  72         port
  73         (tramp-file-name-localname obj)
  74         nil nil t))))) ; target attributes fullness.
  75
  76 ;;;###autoload
  77 (defun url-tramp-file-handler (operation &rest args)
  78   "Function called from the `file-name-handler-alist' routines.
  79 OPERATION is what needs to be done.  ARGS are the arguments that
  80 would have been passed to OPERATION."
  81   (let ((default-directory (url-tramp-convert-url-to-tramp default-directory))
  82         (args (mapcar 'url-tramp-convert-url-to-tramp args)))
  83     (url-tramp-convert-tramp-to-url (apply operation args))))
  84
  85 (provide 'url-tramp)
  86
  87 ;;; url-tramp.el ends here