lisp/url/url-tramp.el

   1 ;;; url-tramp.el --- file-name-handler magic invoking Tramp for some protocols
   2
   3 ;; Copyright (C) 2014-2017 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 <http://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   (let ((obj (url-generic-parse-url (and (stringp url) url))))
  42     (if (member (url-type obj) url-tramp-protocols)
  43         (progn
  44           (if (url-password obj)
  45               (password-cache-add
  46                (tramp-make-tramp-file-name
  47                 (url-type obj) (url-user obj) (url-host obj) "")
  48                (url-password obj))
  49             (tramp-make-tramp-file-name
  50              (url-type obj) (url-user obj) (url-host obj) (url-filename obj))))
  51       url)))
  52
  53 (defun url-tramp-convert-tramp-to-url (file)
  54   "Convert FILE, a Tramp file name, to a URL."
  55   (let ((obj (ignore-errors (tramp-dissect-file-name file))))
  56     (if (member (tramp-file-name-method obj) url-tramp-protocols)
  57         (url-recreate-url
  58          (url-parse-make-urlobj
  59           (tramp-file-name-method obj)
  60           (tramp-file-name-user obj)
  61           nil ; password.
  62           (tramp-file-name-host obj)
  63           nil ; port.
  64           (tramp-file-name-localname obj)
  65           nil nil t)) ; target attributes fullness.
  66       file)))
  67
  68 ;;;###autoload
  69 (defun url-tramp-file-handler (operation &rest args)
  70   "Function called from the `file-name-handler-alist' routines.
  71 OPERATION is what needs to be done.  ARGS are the arguments that
  72 would have been passed to OPERATION."
  73   (let ((default-directory (url-tramp-convert-url-to-tramp default-directory))
  74         (args (mapcar 'url-tramp-convert-url-to-tramp args)))
  75     (url-tramp-convert-tramp-to-url (apply operation args))))
  76
  77 (provide 'url-tramp)
  78
  79 ;;; url-tramp.el ends here