tramp-ftp.el 7.43 KB
Newer Older
Michael Albinus's avatar
Michael Albinus committed
1
;;; tramp-ftp.el --- Tramp convenience functions for Ange-FTP  -*- lexical-binding:t -*-
2

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 2002-2019 Free Software Foundation, Inc.
4

Michael Albinus's avatar
Michael Albinus committed
5
;; Author: Michael Albinus <michael.albinus@gmx.de>
6
;; Keywords: comm, processes
7
;; Package: tramp
8 9 10

;; This file is part of GNU Emacs.

11
;; GNU Emacs is free software: you can redistribute it and/or modify
12
;; it under the terms of the GNU General Public License as published by
13 14
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
15 16 17 18 19 20 21

;; 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
22
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
23 24 25

;;; Commentary:

26 27
;; Convenience functions for calling Ange-FTP from Tramp.
;; Most of them are displaced from tramp.el.
28 29 30 31 32

;;; Code:

(require 'tramp)

Michael Albinus's avatar
Michael Albinus committed
33
;; Pacify byte-compiler.
34
(eval-when-compile
Michael Albinus's avatar
Michael Albinus committed
35 36 37 38
  (require 'custom))
(defvar ange-ftp-ftp-name-arg)
(defvar ange-ftp-ftp-name-res)
(defvar ange-ftp-name-format)
39 40 41 42 43

;; Disable Ange-FTP from file-name-handler-alist.
(defun tramp-disable-ange-ftp ()
  "Turn Ange-FTP off.
This is useful for unified remoting.  See
Michael Albinus's avatar
Michael Albinus committed
44 45
`tramp-file-name-structure' for details.  Requests suitable for
Ange-FTP will be forwarded to Ange-FTP.  Also see the variables
46 47 48 49 50 51 52 53 54
`tramp-ftp-method', `tramp-default-method', and
`tramp-default-method-alist'.

This function is not needed in Emacsen which include Tramp, but is
present for backward compatibility."
  (let ((a1 (rassq 'ange-ftp-hook-function file-name-handler-alist))
	(a2 (rassq 'ange-ftp-completion-hook-function file-name-handler-alist)))
    (setq file-name-handler-alist
	  (delete a1 (delete a2 file-name-handler-alist)))))
Michael Albinus's avatar
Michael Albinus committed
55 56

(eval-after-load "ange-ftp"
Michael Albinus's avatar
Michael Albinus committed
57
  '(tramp-disable-ange-ftp))
Michael Albinus's avatar
Michael Albinus committed
58

59
;;;###tramp-autoload
Michael Albinus's avatar
Michael Albinus committed
60
(defun tramp-ftp-enable-ange-ftp ()
61
  "Reenable Ange-FTP, when Tramp is unloaded."
Michael Albinus's avatar
Michael Albinus committed
62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88
  ;; The following code is commented out in Ange-FTP.

  ;;; This regexp takes care of real ange-ftp file names (with a slash
  ;;; and colon).
  ;;; Don't allow the host name to end in a period--some systems use /.:
  (or (assoc "^/[^/:]*[^/:.]:" file-name-handler-alist)
      (setq file-name-handler-alist
	    (cons '("^/[^/:]*[^/:.]:" . ange-ftp-hook-function)
		  file-name-handler-alist)))

  ;;; This regexp recognizes absolute filenames with only one component,
  ;;; for the sake of hostname completion.
  (or (assoc "^/[^/:]*\\'" file-name-handler-alist)
      (setq file-name-handler-alist
	    (cons '("^/[^/:]*\\'" . ange-ftp-completion-hook-function)
		  file-name-handler-alist)))

  ;;; This regexp recognizes absolute filenames with only one component
  ;;; on Windows, for the sake of hostname completion.
  (and (memq system-type '(ms-dos windows-nt))
       (or (assoc "^[a-zA-Z]:/[^/:]*\\'" file-name-handler-alist)
	   (setq file-name-handler-alist
		 (cons '("^[a-zA-Z]:/[^/:]*\\'" .
			 ange-ftp-completion-hook-function)
		       file-name-handler-alist)))))

(add-hook 'tramp-ftp-unload-hook 'tramp-ftp-enable-ange-ftp)
89 90

;; Define FTP method ...
91 92
;;;###tramp-autoload
(defconst tramp-ftp-method "ftp"
93
  "When this method name is used, forward all calls to Ange-FTP.")
94 95

;; ... and add it to the method list.
96
;;;###tramp-autoload
97 98
(tramp--with-startup
 (add-to-list 'tramp-methods (cons tramp-ftp-method nil))
99

100 101 102 103 104
 ;; Add some defaults for `tramp-default-method-alist'.
 (add-to-list 'tramp-default-method-alist
	      (list "\\`ftp\\." nil tramp-ftp-method))
 (add-to-list 'tramp-default-method-alist
	      (list nil "\\`\\(anonymous\\|ftp\\)\\'" tramp-ftp-method))
105

106 107 108 109
 ;; Add completion function for FTP method.
 (tramp-set-completion-function
  tramp-ftp-method
  '((tramp-parse-netrc "~/.netrc"))))
110

111
;;;###tramp-autoload
112 113 114 115 116 117
(defun tramp-ftp-file-name-handler (operation &rest args)
  "Invoke the Ange-FTP handler for OPERATION.
First arg specifies the OPERATION, second arg is a list of arguments to
pass to the OPERATION."
  (save-match-data
    (or (boundp 'ange-ftp-name-format)
Michael Albinus's avatar
Michael Albinus committed
118
	(let (file-name-handler-alist) (require 'ange-ftp)))
Kai Großjohann's avatar
Kai Großjohann committed
119
    (let ((ange-ftp-name-format
120 121 122 123
	   (list (nth 0 tramp-file-name-structure)
		 (nth 3 tramp-file-name-structure)
		 (nth 2 tramp-file-name-structure)
		 (nth 4 tramp-file-name-structure)))
124 125 126 127 128 129 130
	  ;; ange-ftp uses `ange-ftp-ftp-name-arg' and `ange-ftp-ftp-name-res'
	  ;; for optimization in `ange-ftp-ftp-name'. If Tramp wasn't active,
	  ;; there could be incorrect values from previous calls in case the
	  ;; "ftp" method is used in the Tramp file name. So we unset
	  ;; those values.
	  (ange-ftp-ftp-name-arg "")
	  (ange-ftp-ftp-name-res nil))
Kai Großjohann's avatar
Kai Großjohann committed
131
      (cond
132 133 134 135 136
       ;; If argument is a symlink, `file-directory-p' and
       ;; `file-exists-p' call the traversed file recursively. So we
       ;; cannot disable the file-name-handler this case.  We set the
       ;; connection property "started" in order to put the remote
       ;; location into the cache, which is helpful for further
137 138 139
       ;; completion.  We don't use `with-parsed-tramp-file-name',
       ;; because this returns another user but the one declared in
       ;; "~/.netrc".
Kai Großjohann's avatar
Kai Großjohann committed
140
       ((memq operation '(file-directory-p file-exists-p))
141
	(if (apply 'ange-ftp-hook-function operation args)
142
	    (let ((v (tramp-dissect-file-name (car args) t)))
143
	      (setf (tramp-file-name-method v) tramp-ftp-method)
144 145
	      (tramp-set-connection-property v "started" t))
	  nil))
146

147 148 149 150 151
       ;; If the second argument of `copy-file' or `rename-file' is a
       ;; remote file name but via FTP, ange-ftp doesn't check this.
       ;; We must copy it locally first, because there is no place in
       ;; ange-ftp for correct handling.
       ((and (memq operation '(copy-file rename-file))
Michael Albinus's avatar
Michael Albinus committed
152
	     (tramp-tramp-file-p (cadr args))
153 154 155
	     (not (tramp-ftp-file-name-p (cadr args))))
	(let* ((filename (car args))
	       (newname (cadr args))
156
	       (tmpfile (tramp-compat-make-temp-file filename))
157
	       (args (cddr args)))
158 159 160 161 162 163 164 165
	  ;; We must set `ok-if-already-exists' to t in the first
	  ;; step, because the temp file has been created already.
	  (if (eq operation 'copy-file)
	      (apply operation filename tmpfile t (cdr args))
	    (apply operation filename tmpfile t))
	  (unwind-protect
	      (rename-file tmpfile newname (car args))
	    ;; Cleanup.
166
	    (ignore-errors (delete-file tmpfile)))))
167

168
       ;; Normally, the handlers must be discarded.
169
       (t (let* ((inhibit-file-name-handlers
170 171 172 173 174 175
		  (list 'tramp-file-name-handler
			'tramp-completion-file-name-handler
			(and (eq inhibit-file-name-operation operation)
			     inhibit-file-name-handlers)))
		 (inhibit-file-name-operation operation))
	    (apply 'ange-ftp-hook-function operation args)))))))
176

177 178
;; It must be a `defsubst' in order to push the whole code into
;; tramp-loaddefs.el.  Otherwise, there would be recursive autoloading.
179 180
;;;###tramp-autoload
(defsubst tramp-ftp-file-name-p (filename)
181
  "Check if it's a filename that should be forwarded to Ange-FTP."
Michael Albinus's avatar
Michael Albinus committed
182 183 184
  (and (tramp-tramp-file-p filename)
       (string= (tramp-file-name-method (tramp-dissect-file-name filename))
		tramp-ftp-method)))
185

186
;;;###tramp-autoload
187 188 189
(tramp--with-startup
 (add-to-list 'tramp-foreign-file-name-handler-alist
	      (cons #'tramp-ftp-file-name-p #'tramp-ftp-file-name-handler)))
190 191 192 193

(add-hook 'tramp-unload-hook
	  (lambda ()
	    (unload-feature 'tramp-ftp 'force)))
194 195 196 197 198

(provide 'tramp-ftp)

;;; TODO:

199
;; * There are no backup files on FTP hosts.
200 201

;;; tramp-ftp.el ends here