Line data Source code
1 : ;;; tramp-ftp.el --- Tramp convenience functions for Ange-FTP -*- lexical-binding:t -*-
2 :
3 : ;; Copyright (C) 2002-2017 Free Software Foundation, Inc.
4 :
5 : ;; Author: Michael Albinus <michael.albinus@gmx.de>
6 : ;; Keywords: comm, processes
7 : ;; Package: tramp
8 :
9 : ;; This file is part of GNU Emacs.
10 :
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 : ;; the Free Software Foundation, either version 3 of the License, or
14 : ;; (at your option) any later version.
15 :
16 : ;; GNU Emacs is distributed in the hope that it will be useful,
17 : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 : ;; GNU General Public License for more details.
20 :
21 : ;; You should have received a copy of the GNU General Public License
22 : ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23 :
24 : ;;; Commentary:
25 :
26 : ;; Convenience functions for calling Ange-FTP from Tramp.
27 : ;; Most of them are displaced from tramp.el.
28 :
29 : ;;; Code:
30 :
31 : (require 'tramp)
32 :
33 : ;; Pacify byte-compiler.
34 : (eval-when-compile
35 : (require 'custom))
36 : (defvar ange-ftp-ftp-name-arg)
37 : (defvar ange-ftp-ftp-name-res)
38 : (defvar ange-ftp-name-format)
39 :
40 : ;; Disable Ange-FTP from file-name-handler-alist.
41 : (defun tramp-disable-ange-ftp ()
42 : "Turn Ange-FTP off.
43 : This is useful for unified remoting. See
44 : `tramp-file-name-structure' for details. Requests suitable for
45 : Ange-FTP will be forwarded to Ange-FTP. Also see the variables
46 : `tramp-ftp-method', `tramp-default-method', and
47 : `tramp-default-method-alist'.
48 :
49 : This function is not needed in Emacsen which include Tramp, but is
50 : present for backward compatibility."
51 2 : (let ((a1 (rassq 'ange-ftp-hook-function file-name-handler-alist))
52 2 : (a2 (rassq 'ange-ftp-completion-hook-function file-name-handler-alist)))
53 2 : (setq file-name-handler-alist
54 2 : (delete a1 (delete a2 file-name-handler-alist)))))
55 :
56 : (eval-after-load "ange-ftp"
57 : '(when (functionp 'tramp-disable-ange-ftp)
58 : (tramp-disable-ange-ftp)))
59 :
60 : ;;;###autoload
61 : (defun tramp-ftp-enable-ange-ftp ()
62 : "Reenable Ange-FTP, when Tramp is unloaded."
63 : ;; The following code is commented out in Ange-FTP.
64 :
65 : ;;; This regexp takes care of real ange-ftp file names (with a slash
66 : ;;; and colon).
67 : ;;; Don't allow the host name to end in a period--some systems use /.:
68 0 : (or (assoc "^/[^/:]*[^/:.]:" file-name-handler-alist)
69 0 : (setq file-name-handler-alist
70 0 : (cons '("^/[^/:]*[^/:.]:" . ange-ftp-hook-function)
71 0 : file-name-handler-alist)))
72 :
73 : ;;; This regexp recognizes absolute filenames with only one component,
74 : ;;; for the sake of hostname completion.
75 0 : (or (assoc "^/[^/:]*\\'" file-name-handler-alist)
76 0 : (setq file-name-handler-alist
77 0 : (cons '("^/[^/:]*\\'" . ange-ftp-completion-hook-function)
78 0 : file-name-handler-alist)))
79 :
80 : ;;; This regexp recognizes absolute filenames with only one component
81 : ;;; on Windows, for the sake of hostname completion.
82 0 : (and (memq system-type '(ms-dos windows-nt))
83 0 : (or (assoc "^[a-zA-Z]:/[^/:]*\\'" file-name-handler-alist)
84 0 : (setq file-name-handler-alist
85 0 : (cons '("^[a-zA-Z]:/[^/:]*\\'" .
86 : ange-ftp-completion-hook-function)
87 0 : file-name-handler-alist)))))
88 :
89 : (add-hook 'tramp-ftp-unload-hook 'tramp-ftp-enable-ange-ftp)
90 :
91 : ;; Define FTP method ...
92 : ;;;###tramp-autoload
93 : (defconst tramp-ftp-method "ftp"
94 : "When this method name is used, forward all calls to Ange-FTP.")
95 :
96 : ;; ... and add it to the method list.
97 : ;;;###tramp-autoload
98 : (add-to-list 'tramp-methods (cons tramp-ftp-method nil))
99 :
100 : ;; Add some defaults for `tramp-default-method-alist'.
101 : ;;;###tramp-autoload
102 : (add-to-list 'tramp-default-method-alist
103 : (list "\\`ftp\\." nil tramp-ftp-method))
104 : ;;;###tramp-autoload
105 : (add-to-list 'tramp-default-method-alist
106 : (list nil "\\`\\(anonymous\\|ftp\\)\\'" tramp-ftp-method))
107 :
108 : ;; Add completion function for FTP method.
109 : ;;;###tramp-autoload
110 : (eval-after-load 'tramp
111 : '(tramp-set-completion-function
112 : tramp-ftp-method
113 : '((tramp-parse-netrc "~/.netrc"))))
114 :
115 : ;;;###tramp-autoload
116 : (defun tramp-ftp-file-name-handler (operation &rest args)
117 : "Invoke the Ange-FTP handler for OPERATION.
118 : First arg specifies the OPERATION, second arg is a list of arguments to
119 : pass to the OPERATION."
120 3 : (save-match-data
121 3 : (or (boundp 'ange-ftp-name-format)
122 3 : (let (file-name-handler-alist) (require 'ange-ftp)))
123 3 : (let ((ange-ftp-name-format
124 3 : (list (nth 0 (tramp-file-name-structure))
125 3 : (nth 3 (tramp-file-name-structure))
126 3 : (nth 2 (tramp-file-name-structure))
127 3 : (nth 4 (tramp-file-name-structure))))
128 : ;; ange-ftp uses `ange-ftp-ftp-name-arg' and `ange-ftp-ftp-name-res'
129 : ;; for optimization in `ange-ftp-ftp-name'. If Tramp wasn't active,
130 : ;; there could be incorrect values from previous calls in case the
131 : ;; "ftp" method is used in the Tramp file name. So we unset
132 : ;; those values.
133 : (ange-ftp-ftp-name-arg "")
134 : (ange-ftp-ftp-name-res nil))
135 3 : (cond
136 : ;; If argument is a symlink, `file-directory-p' and
137 : ;; `file-exists-p' call the traversed file recursively. So we
138 : ;; cannot disable the file-name-handler this case. We set the
139 : ;; connection property "started" in order to put the remote
140 : ;; location into the cache, which is helpful for further
141 : ;; completion. We don't use `with-parsed-tramp-file-name',
142 : ;; because this returns another user but the one declared in
143 : ;; "~/.netrc".
144 3 : ((memq operation '(file-directory-p file-exists-p))
145 0 : (if (apply 'ange-ftp-hook-function operation args)
146 0 : (let ((v (tramp-dissect-file-name (car args) t)))
147 0 : (setf (tramp-file-name-method v) tramp-ftp-method)
148 0 : (tramp-set-connection-property v "started" t))
149 0 : nil))
150 :
151 : ;; If the second argument of `copy-file' or `rename-file' is a
152 : ;; remote file name but via FTP, ange-ftp doesn't check this.
153 : ;; We must copy it locally first, because there is no place in
154 : ;; ange-ftp for correct handling.
155 3 : ((and (memq operation '(copy-file rename-file))
156 0 : (tramp-tramp-file-p (cadr args))
157 3 : (not (tramp-ftp-file-name-p (cadr args))))
158 0 : (let* ((filename (car args))
159 0 : (newname (cadr args))
160 0 : (tmpfile (tramp-compat-make-temp-file filename))
161 0 : (args (cddr args)))
162 : ;; We must set `ok-if-already-exists' to t in the first
163 : ;; step, because the temp file has been created already.
164 0 : (if (eq operation 'copy-file)
165 0 : (apply operation filename tmpfile t (cdr args))
166 0 : (apply operation filename tmpfile t))
167 0 : (unwind-protect
168 0 : (rename-file tmpfile newname (car args))
169 : ;; Cleanup.
170 0 : (ignore-errors (delete-file tmpfile)))))
171 :
172 : ;; Normally, the handlers must be discarded.
173 3 : (t (let* ((inhibit-file-name-handlers
174 3 : (list 'tramp-file-name-handler
175 : 'tramp-completion-file-name-handler
176 3 : (and (eq inhibit-file-name-operation operation)
177 3 : inhibit-file-name-handlers)))
178 3 : (inhibit-file-name-operation operation))
179 3 : (apply 'ange-ftp-hook-function operation args)))))))
180 :
181 : ;; It must be a `defsubst' in order to push the whole code into
182 : ;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
183 : ;;;###tramp-autoload
184 : (defsubst tramp-ftp-file-name-p (filename)
185 : "Check if it's a filename that should be forwarded to Ange-FTP."
186 44914 : (string= (tramp-file-name-method (tramp-dissect-file-name filename))
187 44914 : tramp-ftp-method))
188 :
189 : ;;;###tramp-autoload
190 : (add-to-list 'tramp-foreign-file-name-handler-alist
191 : (cons 'tramp-ftp-file-name-p 'tramp-ftp-file-name-handler))
192 :
193 : (add-hook 'tramp-unload-hook
194 : (lambda ()
195 : (unload-feature 'tramp-ftp 'force)))
196 :
197 : (provide 'tramp-ftp)
198 :
199 : ;;; TODO:
200 :
201 : ;; * There are no backup files on FTP hosts.
202 :
203 : ;;; tramp-ftp.el ends here
|