|
98
|
1 ;; -*-Emacs-Lisp-*-
|
|
|
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
3 ;;
|
|
|
4 ;; File: efs.el
|
|
|
5 ;; Release: $efs release: 1.15 $
|
|
116
|
6 ;; Version: #Revision: 1.56 $
|
|
98
|
7 ;; RCS:
|
|
|
8 ;; Description: Transparent FTP support for the original GNU Emacs
|
|
|
9 ;; from FSF and Lucid Emacs
|
|
|
10 ;; Authors: Andy Norman <ange@hplb.hpl.hp.com>,
|
|
|
11 ;; Sandy Rutherford <sandy@ibm550.sissa.it>
|
|
|
12 ;; Created: Thu Oct 12 14:00:05 1989 (as ange-ftp)
|
|
|
13 ;;
|
|
|
14 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
15
|
|
|
16 ;;; The following restrictions apply to all of the files in the efs
|
|
|
17 ;;; distribution.
|
|
|
18 ;;;
|
|
|
19 ;;; Copyright (C) 1993 Andy Norman / Sandy Rutherford
|
|
|
20 ;;;
|
|
|
21 ;;; Authors:
|
|
|
22 ;;; Andy Norman (ange@hplb.hpl.hp.com)
|
|
|
23 ;;; Sandy Rutherford (sandy@ibm550.sissa.it)
|
|
|
24 ;;;
|
|
|
25 ;;; The authors of some of the sub-files of efs are different
|
|
|
26 ;;; from the above. We are very grateful to people who have
|
|
|
27 ;;; contributed code to efs.
|
|
|
28 ;;;
|
|
|
29 ;;; This program is free software; you can redistribute it and/or modify
|
|
|
30 ;;; it under the terms of the GNU General Public License as published by
|
|
|
31 ;;; the Free Software Foundation; either version 1, or (at your option)
|
|
|
32 ;;; any later version.
|
|
|
33 ;;;
|
|
|
34 ;;; This program is distributed in the hope that it will be useful,
|
|
|
35 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
36 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
37 ;;; GNU General Public License for more details.
|
|
|
38 ;;;
|
|
|
39 ;;; A copy of the GNU General Public License can be obtained from this
|
|
|
40 ;;; program's authors (send electronic mail to ange@hplb.hpl.hp.com) or
|
|
|
41 ;;; from the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,
|
|
|
42 ;;; MA 02139, USA.
|
|
|
43
|
|
|
44 ;;; Description:
|
|
|
45 ;;;
|
|
|
46 ;;; This package attempts to make accessing files and directories on
|
|
|
47 ;;; remote computers from within GNU Emacs as simple and transparent
|
|
|
48 ;;; as possible. Currently all remote files are accessed using FTP.
|
|
|
49 ;;; The goal is to make the entire internet accessible as a virtual
|
|
|
50 ;;; file system.
|
|
|
51
|
|
|
52 ;;; Acknowledgements: << please add to this list >>
|
|
|
53 ;;;
|
|
|
54 ;;; Corny de Souza for writing efs-mpe.el.
|
|
|
55 ;;; Jamie Zawinski for writing efs-ti-twenex.el and efs-ti-explorer.el
|
|
|
56 ;;; Joe Wells for writing the first pass at vms support for ange-ftp.el.
|
|
|
57 ;;; Sebastian Kremer for helping with dired support.
|
|
|
58 ;;; Ishikawa Ichiro for MULE support.
|
|
|
59 ;;;
|
|
|
60 ;;; Many other people have contributed code, advice, and beta testing
|
|
|
61 ;;; (sometimes without even realizing it) to both ange-ftp and efs:
|
|
|
62 ;;;
|
|
|
63 ;;; Rob Austein, Doug Bagley, Andy Caiger, Jim Franklin, Noah
|
|
|
64 ;;; Friedman, Aksnes Knut-Havard, Elmar Heeb, John Interrante, Roland
|
|
|
65 ;;; McGrath, Jeff Morgenthaler, Mike Northam, Jens Petersen, Jack
|
|
|
66 ;;; Repenning, Joerg-Martin Schwarz, Michael Sperber, Svein Tjemsland,
|
|
|
67 ;;; Andy Whitcroft, Raymond A. Wiker
|
|
|
68 ;;;
|
|
|
69 ;;; Also, thank you to all the people on the efs-testers mailing list.
|
|
|
70 ;;;
|
|
|
71
|
|
|
72 ;;; --------------------------------------------------------------
|
|
|
73 ;;; Documentation:
|
|
|
74 ;;; --------------------------------------------------------------
|
|
|
75 ;;;
|
|
114
|
76 ;;; If you have any problems with efs, please read this section
|
|
|
77 ;;; *before* submitting a bug report.
|
|
98
|
78
|
|
|
79 ;;; Installation:
|
|
|
80 ;;;
|
|
|
81 ;;; For byte compiling the efs package, a Makefile is provided.
|
|
|
82 ;;; You should follow the instructions at the top of the Makefile.
|
|
|
83 ;;; If you have any problems, please let us know so that we can fix
|
|
|
84 ;;; them for other users. Don't even consider using efs without
|
|
|
85 ;;; byte compiling it. It will be far too slow.
|
|
|
86 ;;;
|
|
|
87 ;;; If you decide to byte compile efs by hand, it is important that
|
|
|
88 ;;; the file efs-defun.el be byte compiled first, followed by efs.el.
|
|
|
89 ;;; The other files may be byte compiled in any order.
|
|
|
90 ;;;
|
|
|
91 ;;; To use efs, simply put the byte compiled files in your load path
|
|
|
92 ;;; and add
|
|
|
93 ;;;
|
|
|
94 ;;; (require 'efs)
|
|
|
95 ;;;
|
|
100
|
96 ;;; in your .emacs file. Note this takes awhile, and some users have
|
|
|
97 ;;; found this to be unbearably slow. Therefore ...
|
|
98
|
98 ;;;
|
|
|
99 ;;; If you would like efs to be autoloaded when you attempt to access
|
|
|
100 ;;; a remote file, put
|
|
|
101 ;;;
|
|
|
102 ;;; (require 'efs-auto)
|
|
|
103 ;;;
|
|
|
104 ;;; in your .emacs file. Note that there are some limitations associated
|
|
|
105 ;;; with autoloading efs. A discussion of them is given at the top of
|
|
|
106 ;;; efs-auto.el.
|
|
|
107
|
|
|
108 ;;; Configuration variables:
|
|
|
109 ;;;
|
|
|
110 ;;; It is important that you read through the section on user customization
|
|
|
111 ;;; variables (search forward for the string ">>>"). If your local network
|
|
|
112 ;;; is not fully connected to the internet, but accesses the internet only
|
|
|
113 ;;; via a gateway, then it is vital to set the appropriate variables to
|
|
|
114 ;;; inform efs about the geometry of your local network. Also, see the
|
|
|
115 ;;; paragraph on gateways below.
|
|
|
116
|
|
|
117 ;;; Usage:
|
|
|
118 ;;;
|
|
|
119 ;;; Once installed, efs operates largely transparently. All files
|
|
|
120 ;;; normally accessible to you on the internet, become part of a large
|
|
|
121 ;;; virtual file system. These files are accessed using an extended
|
|
|
122 ;;; file name syntax. To access file <path> on remote host <host> by
|
|
|
123 ;;; logging in as user <user>, you simply specify the full path of the
|
|
|
124 ;;; file as /<user>@<host>:<path>. Nearly all GNU Emacs file handling
|
|
|
125 ;;; functions work for remote files. It is not possible to access
|
|
|
126 ;;; remote files using shell commands in an emacs *shell* buffer, as such
|
|
|
127 ;;; commands are passed directly to the shell, and not handled by emacs.
|
|
|
128 ;;; FTP is the underlying utility that efs uses to operate on remote files.
|
|
|
129 ;;;
|
|
|
130 ;;; For example, if find-file is given a filename of:
|
|
|
131 ;;;
|
|
|
132 ;;; /ange@anorman:/tmp/notes
|
|
|
133 ;;;
|
|
|
134 ;;; then efs will spawn an FTP process, connect to the host 'anorman' as
|
|
|
135 ;;; user 'ange', get the file '/tmp/notes' and pop up a buffer containing the
|
|
|
136 ;;; contents of that file as if it were on the local file system. If efs
|
|
|
137 ;;; needed a password to connect then it would prompt the user in the
|
|
|
138 ;;; minibuffer. For further discussion of the efs path syntax, see the
|
|
|
139 ;;; paragraph on extended file name syntax below.
|
|
|
140
|
|
|
141 ;;; Ports:
|
|
|
142 ;;;
|
|
|
143 ;;; efs supports the use of nonstandard ports on remote hosts.
|
|
|
144 ;;; To specify that port <port> should be used, give the host name as
|
|
|
145 ;;; host#<port>. Host names may be given in this form anywhere that efs
|
|
|
146 ;;; normally expects a host name. This includes in the .netrc file.
|
|
|
147 ;;; Logically, efs treats different ports to correspond to different
|
|
|
148 ;;; remote hosts.
|
|
|
149
|
|
|
150 ;;; Extended filename syntax:
|
|
|
151 ;;;
|
|
|
152 ;;; The default full efs path syntax is
|
|
|
153 ;;;
|
|
|
154 ;;; /<user>@<host>#<port>:<path>
|
|
|
155 ;;;
|
|
|
156 ;;; Both the `#<port>' and `<user>@' may be omitted.
|
|
|
157 ;;;
|
|
|
158 ;;; If the `#<port>' is omitted, then the default port is taken to be 21,
|
|
|
159 ;;; the usual FTP port. For most users, the port syntax will only
|
|
|
160 ;;; very rarely be necessary.
|
|
|
161 ;;;
|
|
|
162 ;;; If the `<user>@' is omitted, then efs will use a default user. If a
|
|
|
163 ;;; login token is specified in your .netrc file, then this will be used as
|
|
|
164 ;;; the default user for <host>. Otherwise, it is determined based on the
|
|
|
165 ;;; value of the variable efs-default-user.
|
|
|
166 ;;;
|
|
|
167 ;;; This efs path syntax can be customised to a certain extent by
|
|
|
168 ;;; changing a number of variables in the subsection Internal Variables.
|
|
|
169 ;;; To undertake such a customization requires some knowledge about the
|
|
|
170 ;;; internal workings of efs.
|
|
|
171
|
|
|
172 ;;; Passwords:
|
|
|
173 ;;;
|
|
|
174 ;;; A password is required for each host / user pair. This will be
|
|
|
175 ;;; prompted for when needed, unless already set by calling
|
|
|
176 ;;; efs-set-passwd, or specified in a *valid* ~/.netrc file.
|
|
|
177 ;;;
|
|
|
178 ;;; When efs prompts for a password, it provides defaults from its
|
|
|
179 ;;; cache of currently known passwords. The defaults are ordered such
|
|
|
180 ;;; that passwords for accounts which have the same user name as the
|
|
|
181 ;;; login which is currently underway have priority. You can cycle
|
|
|
182 ;;; through your list of defaults with C-n to cycle forwards and C-p
|
|
|
183 ;;; to cycle backwards. The list is circular.
|
|
|
184
|
|
|
185 ;;; Passwords for user "anonymous":
|
|
|
186 ;;;
|
|
|
187 ;;; Passwords for the user "anonymous" (or "ftp") are handled
|
|
|
188 ;;; specially. The variable efs-generate-anonymous-password controls
|
|
|
189 ;;; what happens. If the value of this variable is a string, then this
|
|
|
190 ;;; is used as the password; if non-nil, then a password is created
|
|
|
191 ;;; from the name of the user and the hostname of the machine on which
|
|
|
192 ;;; GNU Emacs is running; if nil (the default) then the user is
|
|
|
193 ;;; prompted for a password as normal.
|
|
|
194
|
|
|
195 ;;; "Dumb" UNIX hosts:
|
|
|
196 ;;;
|
|
|
197 ;;; The FTP servers on some UNIX machines have problems if the "ls"
|
|
|
198 ;;; command is used. efs will try to correct for this automatically,
|
|
|
199 ;;; and send the "dir" command instead. If it fails, you can call the
|
|
|
200 ;;; function efs-add-host, and give the host type as dumb-unix. Note
|
|
|
201 ;;; that this change will take effect for the current GNU Emacs
|
|
|
202 ;;; session only. To make this specification for future emacs
|
|
|
203 ;;; sessions, put
|
|
|
204 ;;;
|
|
|
205 ;;; (efs-add-host 'dumb-unix "hostname")
|
|
|
206 ;;;
|
|
|
207 ;;; in your .emacs file. Also, please report any failure to automatically
|
|
|
208 ;;; recognize dumb unix to the "bugs" address given below, so that we can
|
|
|
209 ;;; fix the auto recognition code.
|
|
|
210
|
|
|
211 ;;; File name completion:
|
|
|
212 ;;;
|
|
|
213 ;;; Full file-name completion is supported on every type of remote
|
|
|
214 ;;; host. To do filename completion, efs needs a listing from the
|
|
|
215 ;;; remote host. Therefore, for very slow connections, it might not
|
|
|
216 ;;; save any time. However, the listing is cached, so subsequent uses
|
|
|
217 ;;; of file-name completion will be just as fast as for local file
|
|
|
218 ;;; names.
|
|
|
219
|
|
|
220 ;;; FTP processes:
|
|
|
221 ;;;
|
|
|
222 ;;; When efs starts up an FTP process, it leaves it running for speed
|
|
|
223 ;;; purposes. Some FTP servers will close the connection after a period of
|
|
|
224 ;;; time, but efs should be able to quietly reconnect the next time that
|
|
|
225 ;;; the process is needed.
|
|
|
226 ;;;
|
|
|
227 ;;; The FTP process will be killed should the associated "*ftp user@host*"
|
|
|
228 ;;; buffer be deleted. This should not cause efs any grief.
|
|
|
229
|
|
|
230 ;;; Showing background FTP activity on the mode-line:
|
|
|
231 ;;;
|
|
|
232 ;;; After efs is loaded, the command efs-display-ftp-activity will cause
|
|
|
233 ;;; background FTP activity to be displayed on the mode line. The variable
|
|
|
234 ;;; efs-mode-line-format is used to determine how this data is displayed.
|
|
|
235 ;;; efs does not continuously track the number of active sessions, as this
|
|
|
236 ;;; would cause the display to change too rapidly. Rather, it uses a heuristic
|
|
|
237 ;;; algorithm to determine when there is a significant change in FTP activity.
|
|
|
238
|
|
|
239 ;;; File types:
|
|
|
240 ;;;
|
|
|
241 ;;; By default efs will assume that all files are ASCII. If a file
|
|
|
242 ;;; being transferred matches the value of efs-binary-file-name-regexp
|
|
|
243 ;;; then the file will be assumed to be a binary file, and efs will
|
|
|
244 ;;; transfer it using "type image". ASCII files will be transferred
|
|
|
245 ;;; using a transfer type which efs computes to be correct according
|
|
|
246 ;;; to its knowledge of the file system of the remote host. The
|
|
|
247 ;;; command `efs-prompt-for-transfer-type' toggles the variable
|
|
|
248 ;;; `efs-prompt-for-transfer-type'. When this variable is non-nil, efs
|
|
|
249 ;;; will prompt the user for the transfer type to use for every FTP
|
|
|
250 ;;; transfer. Having this set all the time is annoying, but it is
|
|
|
251 ;;; useful to give special treatment to a small set of files.
|
|
|
252 ;;; There is also variable efs-text-file-name-regexp. This is tested before
|
|
|
253 ;;; efs-binary-file-name-regexp, so if you set efs-text-file-name-regexp
|
|
|
254 ;;; to a non-trivial regular expression, and efs-binary-file-name-regexp
|
|
|
255 ;;; to ".*", the result will to make image the default tranfer type.
|
|
|
256 ;;;
|
|
|
257 ;;; Also, if you set efs-treat-crlf-as-nl, then efs will use type image
|
|
|
258 ;;; to transfer files between hosts whose file system differ only in that
|
|
|
259 ;;; one specifies end of line as CR-LF, and the other as NL. This is useful
|
|
|
260 ;;; if you are transferring files between UNIX and DOS machines, and have a
|
|
|
261 ;;; package such as dos-mode.el, that handles the extra ^M's.
|
|
|
262
|
|
|
263 ;;; Account passwords:
|
|
|
264 ;;;
|
|
|
265 ;;; Some FTP servers require an additional password which is sent by
|
|
|
266 ;;; the ACCOUNT command. efs will detect this and prompt the user for
|
|
|
267 ;;; an account password if the server expects one. Also, an account
|
|
|
268 ;;; password can be set by calling efs-set-account, or by specifying
|
|
|
269 ;;; an account token in the .netrc file.
|
|
|
270 ;;;
|
|
|
271 ;;; Some operating systems, such as CMS, require that ACCOUNT be used to
|
|
|
272 ;;; give a write access password for minidisks. efs-set-account can be used
|
|
|
273 ;;; to set a write password for a specific minidisk. Also, tokens of the form
|
|
|
274 ;;; minidisk <minidisk name> <password>
|
|
|
275 ;;; may be added to host lines in your .netrc file. Minidisk tokens must be
|
|
|
276 ;;; at the end of the host line, however there may be an arbitrary number of
|
|
|
277 ;;; them for any given host.
|
|
|
278
|
|
|
279 ;;; Preloading:
|
|
|
280 ;;;
|
|
|
281 ;;; efs can be preloaded, but must be put in the site-init.el file and
|
|
|
282 ;;; not the site-load.el file in order for the documentation strings for the
|
|
|
283 ;;; functions being overloaded to be available.
|
|
|
284
|
|
|
285 ;;; Status reports:
|
|
|
286 ;;;
|
|
|
287 ;;; Most efs commands that talk to the FTP process output a status
|
|
|
288 ;;; message on what they are doing. In addition, efs can take advantage
|
|
|
289 ;;; of the FTP client's HASH command to display the status of transferring
|
|
|
290 ;;; files and listing directories. See the documentation for the variables
|
|
|
291 ;;; efs-hash-mark-size, efs-send-hash and efs-verbose for more details.
|
|
|
292
|
|
|
293 ;;; Caching of directory information:
|
|
|
294 ;;;
|
|
|
295 ;;; efs keeps an internal cache of file listings from remote hosts.
|
|
|
296 ;;; If this cache gets out of synch, it can be renewed by reverting a
|
|
|
297 ;;; dired buffer for the appropriate directory (dired-revert is usually
|
|
|
298 ;;; bound to "g").
|
|
|
299 ;;;
|
|
|
300 ;;; Alternatively, you can add the following two lines to your .emacs file
|
|
|
301 ;;; if you want C-r to refresh efs's cache whilst doing filename
|
|
|
302 ;;; completion.
|
|
|
303 ;;; (define-key minibuffer-local-completion-map "\C-r" 'efs-re-read-dir)
|
|
|
304 ;;; (define-key minibuffer-local-must-match-map "\C-r" 'efs-re-read-dir)
|
|
|
305
|
|
|
306 ;;; Gateways:
|
|
|
307 ;;;
|
|
114
|
308 ;;; Sometimes it is necessary for the FTP process to be run on a different
|
|
98
|
309 ;;; machine than the machine running GNU Emacs. This can happen when the
|
|
|
310 ;;; local machine has restrictions on what hosts it can access.
|
|
|
311 ;;;
|
|
|
312 ;;; efs has support for running the ftp process on a different (gateway)
|
|
|
313 ;;; machine. The way it works is as follows:
|
|
|
314 ;;;
|
|
|
315 ;;; 1) Set the variable 'efs-gateway-host' to the name of a machine
|
|
|
316 ;;; that doesn't have the access restrictions. If you need to use
|
|
|
317 ;;; a nonstandard port to access this host for gateway use, then
|
|
|
318 ;;; specify efs-gateway-host as "<hostname>#<port>".
|
|
|
319 ;;;
|
|
|
320 ;;; 2) Set the variable 'efs-ftp-local-host-regexp' to a regular expression
|
|
|
321 ;;; that matches hosts that can be contacted from running a local ftp
|
|
|
322 ;;; process, but fails to match hosts that can't be accessed locally. For
|
|
|
323 ;;; example:
|
|
|
324 ;;;
|
|
|
325 ;;; "\\.hp\\.com$\\|^[^.]*$"
|
|
|
326 ;;;
|
|
|
327 ;;; will match all hosts that are in the .hp.com domain, or don't have an
|
|
|
328 ;;; explicit domain in their name, but will fail to match hosts with
|
|
|
329 ;;; explicit domains or that are specified by their ip address.
|
|
|
330 ;;;
|
|
|
331 ;;; 3) Set the variable `efs-local-host-regexp' to machines that you have
|
|
|
332 ;;; direct TCP/IP access. In other words, you must be able to ping these
|
|
|
333 ;;; hosts. Usually, efs-ftp-local-host-regexp and efs-local-host-regexp
|
|
|
334 ;;; will be the same. However, they will differ for so-called transparent
|
|
|
335 ;;; gateways. See #7 below for more details.
|
|
|
336 ;;;
|
|
|
337 ;;; 4) Set the variable 'efs-gateway-tmp-name-template' to the name of
|
|
|
338 ;;; a directory plus an identifying filename prefix for making temporary
|
|
|
339 ;;; files on the gateway. For example: "/tmp/hplose/ange/efs"
|
|
|
340 ;;;
|
|
|
341 ;;; 5) If the gateway and the local host share cross-mounted directories,
|
|
|
342 ;;; set the value of `efs-gateway-mounted-dirs-alist' accordingly. It
|
|
|
343 ;;; is particularly useful, but not mandatory, that the directory
|
|
|
344 ;;; of `efs-gateway-tmp-name-template' be cross-mounted.
|
|
|
345 ;;;
|
|
|
346 ;;; 6) Set the variable `efs-gateway-type' to the type gateway that you have.
|
|
|
347 ;;; This variable is a list, the first element of which is a symbol
|
|
|
348 ;;; denoting the type of gateway. Following elements give further
|
|
|
349 ;;; data on the gateway.
|
|
|
350 ;;;
|
|
|
351 ;;; Supported gateway types:
|
|
|
352 ;;;
|
|
|
353 ;;; a) local:
|
|
|
354 ;;; This means that your local host is itself the gateway. However,
|
|
|
355 ;;; it is necessary to use a different FTP client to gain access to
|
|
|
356 ;;; the outside world. If the name of the FTP client were xftp, you might
|
|
|
357 ;;; set efs-gateway-type to
|
|
|
358 ;;;
|
|
|
359 ;;; (list 'local "xftp" efs-ftp-program-args)
|
|
|
360 ;;;
|
|
|
361 ;;; If xftp required special arguments, then give them in place of
|
|
|
362 ;;; efs-ftp-program-args. See the documentation for efs-ftp-program-args
|
|
|
363 ;;; for the syntax.
|
|
|
364 ;;;
|
|
|
365 ;;; b) proxy:
|
|
|
366 ;;; This indicates that your gateway works by first FTP'ing to it, and
|
|
|
367 ;;; then issuing a USER command of the form
|
|
|
368 ;;;
|
|
|
369 ;;; USER <username>@<host>
|
|
|
370 ;;;
|
|
|
371 ;;; In this case, you might set efs-gateway-type to
|
|
|
372 ;;;
|
|
|
373 ;;; (list 'proxy "ftp" efs-ftp-program-args)
|
|
|
374 ;;;
|
|
|
375 ;;; If you need to use a nonstandard client, such as iftp, give this
|
|
|
376 ;;; instead of "ftp". If this client needs to take special arguments,
|
|
|
377 ;;; give them instead of efs-ftp-program-args.
|
|
|
378 ;;;
|
|
|
379 ;;; c) remsh:
|
|
|
380 ;;; For this type of gateway, you need to start a remote shell on
|
|
|
381 ;;; your gateway, using either remsh or rsh. You should set
|
|
|
382 ;;; efs-gateway-type to something like
|
|
|
383 ;;;
|
|
|
384 ;;; (list 'remsh "remsh" nil "ftp" efs-ftp-program-args)
|
|
|
385 ;;;
|
|
|
386 ;;; If you use rsh instead of remsh, change the second element from
|
|
|
387 ;;; "remsh" to "rsh". Note that the symbol indicating the gateway
|
|
|
388 ;;; type should still be 'remsh. If you want to pass arguments
|
|
|
389 ;;; to the remsh program, give them as the third element. For example,
|
|
|
390 ;;; if you need to specify a user, make this (list "-l" "sandy").
|
|
|
391 ;;; If you need to use a nonstandard FTP client, specify that as the fourth
|
|
|
392 ;;; element. If your FTP client needs to be given special arguments,
|
|
|
393 ;;; give them instead of efs-ftp-program-args.
|
|
|
394 ;;;
|
|
|
395 ;;; d) interactive:
|
|
|
396 ;;; This indicates that you need to establish a login on the gateway,
|
|
|
397 ;;; using either telnet or rlogin.
|
|
|
398 ;;; You should set efs-gateway-type to something like
|
|
|
399 ;;;
|
|
|
400 ;;; (list 'interactive "rlogin" nil "exec ftp" efs-ftp-program-args)
|
|
|
401 ;;;
|
|
|
402 ;;; If you need to use telnet, then give "telnet" in place of the second
|
|
|
403 ;;; element "rlogin". If your login program needs to be given arguments,
|
|
|
404 ;;; then they should be given in the third slot. The fourth element
|
|
|
405 ;;; is for the name of the FTP client program. Giving this as "exec ftp",
|
|
|
406 ;;; instead of "ftp", ensures that you are logged out if the FTP client
|
|
|
407 ;;; dies. If the FTP client takes special arguments, give these instead
|
|
|
408 ;;; of efs-ftp-program-args. Furthermore, you should see the documentation
|
|
|
409 ;;; at the top of efs-gwp.el. You may need to set the variables
|
|
|
410 ;;; efs-gwp-setup-term-command, and efs-gwp-prompt-pattern.
|
|
|
411 ;;;
|
|
|
412 ;;; e) raptor:
|
|
|
413 ;;; This is a type of gateway where efs is expected to specify a gateway
|
|
|
414 ;;; user, and send a password for this user using the ACCOUNT command.
|
|
|
415 ;;; For example, to log in to foobar.edu as sandy, while using the account
|
|
|
416 ;;; ange on the gateway, the following commands would be sent:
|
|
|
417 ;;;
|
|
|
418 ;;; open raptorgate.com
|
|
|
419 ;;; quote USER sandy@foobar.edu ange
|
|
|
420 ;;; quote pass <sandy's password on foobar>
|
|
|
421 ;;; quote account <ange's password on raptorgate>
|
|
|
422 ;;;
|
|
|
423 ;;; For such a gateway, you would set efs-gateway-type to
|
|
|
424 ;;;
|
|
|
425 ;;; (list 'raptor efs-ftp-program efs-ftp-program-args <GATEWAY USER>)
|
|
|
426 ;;;
|
|
|
427 ;;; where <GATEWAY USER> is the name of your account on the gateway. In
|
|
|
428 ;;; the above example, this would be "ange". You can set your gateway
|
|
|
429 ;;; password by simply setting an account password for the gateway host.
|
|
|
430 ;;; This can be done with either efs-set-account, or within your .netrc
|
|
|
431 ;;; file. If no password is set, you will be prompted for one.
|
|
|
432 ;;;
|
|
|
433 ;;; f) interlock:
|
|
|
434 ;;; This is a type of gateway where you are expected to send a PASS
|
|
|
435 ;;; command after opening the connection to the gateway.
|
|
|
436 ;;; The precise login sequence is
|
|
|
437 ;;;
|
|
|
438 ;;; open interlockgate
|
|
|
439 ;;; quote PASS <sandy's password on interlockgate>
|
|
|
440 ;;; quote USER sandy@foobar.edu
|
|
|
441 ;;; quote PASS <sandy's password on foobar.edu>
|
|
|
442 ;;;
|
|
|
443 ;;; For such a gateway, you should set efs-gateway-type to
|
|
|
444 ;;;
|
|
|
445 ;;; (list 'interlock efs-ftp-program efs-ftp-program-args)
|
|
|
446 ;;;
|
|
|
447 ;;; If you need to use a nonstandard name for your FTP client,
|
|
|
448 ;;; then replace efs-ftp-program with this name. If your FTP client
|
|
|
449 ;;; needs to take nonstandard arguments, then replace efs-ftp-program-args
|
|
|
450 ;;; with these arguments. See efs-ftp-program-args <V> for the required
|
|
|
451 ;;; syntax.
|
|
|
452 ;;;
|
|
|
453 ;;; If your gateway returns both a 220 code and a 331 code to the
|
|
|
454 ;;; "open interlockgate" command, then you should add a regular
|
|
|
455 ;;; expression to efs-skip-msgs <V> that matches the 220 response.
|
|
|
456 ;;; Returning two response codes to a single FTP command is not permitted
|
|
|
457 ;;; in RFC 959. It is not possible for efs to ignore the 220 by default,
|
|
|
458 ;;; because than it would hang for interlock installations which do not
|
|
|
459 ;;; require a password.
|
|
|
460 ;;;
|
|
|
461 ;;; g) kerberos:
|
|
|
462 ;;; With this gateway, you need to authenticate yourself by getting a
|
|
|
463 ;;; kerberos "ticket" first. Usually, this is done with the kinit program.
|
|
|
464 ;;; Once authenticated, you connect to foobar.com as user sandy with the
|
|
|
465 ;;; sequence: (Note that the "-n" argument inhibits automatic login.
|
|
|
466 ;;; Although, in manual use you probably don't use it, efs always uses it.)
|
|
|
467 ;;;
|
|
|
468 ;;; iftp -n
|
|
|
469 ;;; open foobar.com
|
|
|
470 ;;; user sandy@foobar.com
|
|
|
471 ;;;
|
|
|
472 ;;; You should set efs-gateway-type to something like
|
|
|
473 ;;;
|
|
|
474 ;;; (list 'kerberos "iftp" efs-ftp-program-args "kinit" <KINIT-ARGS>)
|
|
|
475 ;;;
|
|
|
476 ;;; If you use an FTP client other than iftp, insert its name instead
|
|
|
477 ;;; of "iftp" above. If your FTP client needs special arguments, give
|
|
|
478 ;;; them as a list of strings in place of efs-ftp-program-args. If
|
|
|
479 ;;; the program that you use to collect a ticket in not called "kinit",
|
|
|
480 ;;; then give its name in place of "kinit" above. <KINIT-ARGS> should be
|
|
|
481 ;;; any arguments that you need to pass to your kinit program, given as a
|
|
|
482 ;;; list of strings. Most likely, you will give this as nil.
|
|
|
483 ;;;
|
|
|
484 ;;; See the file efs-kerberos.el for more configuration variables. If you
|
|
|
485 ;;; need to adjust any of these variables, please report this to us so that
|
|
|
486 ;;; we can fix them for other users.
|
|
|
487 ;;;
|
|
|
488 ;;; If efs detects that you are not authenticated to use the gateway, it
|
|
|
489 ;;; will run the kinit program automatically, prompting you for a password.
|
|
|
490 ;;; If you give a password in your .netrc file for login the value of
|
|
|
491 ;;; efs-gateway-host <V> and user kerberos, then efs will use this to
|
|
|
492 ;;; obtain gateway authentication.
|
|
|
493 ;;;
|
|
|
494 ;;; 7) Transparent gateways:
|
|
|
495 ;;;
|
|
|
496 ;;; If your gateway is completely transparent (for example it uses
|
|
|
497 ;;; socks), then you should set efs-gateway-type to nil. Also,
|
|
|
498 ;;; set efs-ftp-local-host-regexp to ".*". However, efs-local-host-regexp,
|
|
|
499 ;;; must still be set to a regular expression matching hosts in your local
|
|
|
500 ;;; domain. efs uses this to determine which machines that it can
|
|
|
501 ;;; open-network-stream to. Furthermore, you should still set
|
|
|
502 ;;; efs-gateway-host to the name of your gateway machine. That way efs
|
|
|
503 ;;; will know that this is a special machine having direct TCP/IP access
|
|
|
504 ;;; to both hosts in the outside world, and hosts in your local domain.
|
|
|
505 ;;;
|
|
|
506 ;;; 8) Common Problems with Gateways:
|
|
|
507 ;;;
|
|
|
508 ;;; a) Spurious 220 responses:
|
|
|
509 ;;; Some proxy-style gateways (eg gateway type 'proxy or 'raptor),
|
|
|
510 ;;; return two 3-digit FTP reply codes to the USER command.
|
|
|
511 ;;; For example:
|
|
|
512 ;;;
|
|
|
513 ;;; open gateway.weird
|
|
|
514 ;;; 220 Connected to gateway.weird
|
|
|
515 ;;; quote USER sandy@foobar
|
|
|
516 ;;; 220 Connected to foobar
|
|
|
517 ;;; 331 Password required for sandy
|
|
|
518 ;;;
|
|
|
519 ;;; This is wrong, according to the FT Protocol. Each command must return
|
|
|
520 ;;; exactly one 3-digit reply code. It may be preceded by continuation
|
|
|
521 ;;; lines. What should really be returned is:
|
|
|
522 ;;;
|
|
|
523 ;;; quote USER sandy@foobar
|
|
|
524 ;;; 331-Connected to foobar.
|
|
|
525 ;;; 331 Password required for sandy.
|
|
|
526 ;;;
|
|
|
527 ;;; or even
|
|
|
528 ;;;
|
|
|
529 ;;; quote USER sandy@foobar
|
|
|
530 ;;; 331-220 Connected to foobar.
|
|
|
531 ;;; 331 Password required for sandy.
|
|
|
532 ;;;
|
|
|
533 ;;; Even though the "331-220" looks strange, it is correct protocol, and
|
|
|
534 ;;; efs will parse it properly.
|
|
|
535 ;;;
|
|
|
536 ;;; If your gateway is returning a spurious 220 to USER, a work-around
|
|
|
537 ;;; is to add a regular expression to `efs-skip-msgs' that matches
|
|
|
538 ;;; this line. It must not match the 220 line returned to the open
|
|
|
539 ;;; command. This work-around may not work, as some system FTP clients
|
|
|
540 ;;; also get confused by the spurious 220. In this case, the only
|
|
|
541 ;;; solution is to patch the gateway server. In either case, please
|
|
|
542 ;;; send a bug report to the author of your gateway software.
|
|
|
543 ;;;
|
|
|
544 ;;; b) Case-sensitive parsing of FTP commands:
|
|
|
545 ;;; Some gateway servers seem to treat FTP commands case-sensitively.
|
|
|
546 ;;; This is incorrect, as RFC 959 clearly states that FTP commands
|
|
|
547 ;;; are always to be case-insensitive. If this is a problem with your
|
|
|
548 ;;; gateway server, you should send a bug report to its author.
|
|
|
549 ;;; If efs is using a case for FTP commands that does not suit your server,
|
|
|
550 ;;; a possible work-around is to edit the efs source so that the required
|
|
|
551 ;;; case is used. However, we will not be making any changes to the
|
|
|
552 ;;; standard efs distribution to support this type of server behaviour.
|
|
|
553 ;;; If you need help changing the efs source, you should enquire with the
|
|
|
554 ;;; efs-help mailing list.
|
|
|
555 ;;;
|
|
|
556
|
|
|
557 ;;; ---------------------------------------------------------------
|
|
|
558 ;;; Tips for using efs:
|
|
|
559 ;;; ---------------------------------------------------------------
|
|
|
560
|
|
|
561 ;;; 1) Beware of compressing files on non-UNIX hosts. efs will do it by
|
|
|
562 ;;; copying the file to the local machine, compressing it there, and then
|
|
|
563 ;;; sending it back. Binary file transfers between machines of different
|
|
|
564 ;;; architectures can be a risky business. Test things out first on some
|
|
|
565 ;;; test files. See "Bugs" below. Also, note that efs sometimes
|
|
|
566 ;;; copies files by moving them through the local machine. Again,
|
|
|
567 ;;; be careful when doing this with binary files on non-Unix
|
|
|
568 ;;; machines.
|
|
|
569 ;;;
|
|
|
570 ;;; 2) Beware that dired over ftp will use your setting of dired-no-confirm
|
|
|
571 ;;; (list of dired commands for which confirmation is not asked).
|
|
|
572 ;;; You might want to reconsider your setting of this variable,
|
|
|
573 ;;; because you might want confirmation for more commands on remote
|
|
|
574 ;;; direds than on local direds. For example, I strongly recommend
|
|
|
575 ;;; that you not include compress in this list. If there is enough
|
|
|
576 ;;; demand it might be a good idea to have an alist
|
|
|
577 ;;; efs-dired-no-confirm of pairs ( TYPE . LIST ), where TYPE is an
|
|
|
578 ;;; operating system type and LIST is a list of commands for which
|
|
|
579 ;;; confirmation would be suppressed. Then remote dired listings
|
|
|
580 ;;; would take their (buffer-local) value of dired-no-confirm from
|
|
|
581 ;;; this alist. Who votes for this?
|
|
|
582 ;;;
|
|
|
583 ;;; 3) Some combinations of FTP clients and servers break and get out of sync
|
|
|
584 ;;; when asked to list a non-existent directory. Some of the ai.mit.edu
|
|
|
585 ;;; machines cause this problem for some FTP clients. Using
|
|
|
586 ;;; efs-kill-ftp-process can be used to restart the ftp process, which
|
|
|
587 ;;; should get things back in synch.
|
|
|
588 ;;;
|
|
|
589 ;;; 4) Some ftp servers impose a length limit on the password that can
|
|
|
590 ;;; be sent. If this limit is exceeded they may bomb in an
|
|
|
591 ;;; incomprehensible way. This sort of behaviour is common with
|
|
|
592 ;;; MVS servers. Therefore, you should beware of this possibility
|
|
|
593 ;;; if you are generating a long password (like an email address)
|
|
|
594 ;;; with efs-generate-anonymous-password.
|
|
|
595 ;;;
|
|
|
596 ;;; 5) Some antiquated FTP servers hang when asked for an RNFR command.
|
|
|
597 ;;; efs sometimes uses this to test whether its local cache is stale.
|
|
|
598 ;;; If your server for HOST hangs when asked for this command, put
|
|
|
599 ;;; (efs-set-host-property HOST 'rnfr-failed t)
|
|
|
600 ;;; in your efs-ftp-startup-function-alist entry for HOST.
|
|
|
601 ;;;
|
|
|
602
|
|
|
603 ;;; -----------------------------------------------------------------------
|
|
|
604 ;;; Where to get the latest version of efs:
|
|
|
605 ;;; -----------------------------------------------------------------------
|
|
|
606 ;;;
|
|
|
607 ;;; The authors are grateful to anyone or any organization which
|
|
|
608 ;;; provides anonymous FTP distribution for efs.
|
|
|
609 ;;;
|
|
|
610 ;;;
|
|
|
611 ;;; Europe:
|
|
|
612 ;;;
|
|
|
613 ;;; Switzerland
|
|
|
614 ;;; /anonymous@itp.ethz.ch:/sandy/efs/
|
|
|
615 ;;;
|
|
|
616 ;;; North America:
|
|
|
617 ;;;
|
|
|
618 ;;; Massachusetts, USA
|
|
|
619 ;;; /anonymous@alpha.gnu.ai.mit.edu:/efs/
|
|
|
620 ;;;
|
|
|
621 ;;; California, USA
|
|
|
622 ;;; /anonymous@ftp.hmc.edu:/pub/emacs/packages/efs/
|
|
|
623 ;;;
|
|
|
624 ;;; Australia and New Zealand:
|
|
|
625 ;;;
|
|
|
626 ;;; ????????????
|
|
|
627 ;;;
|
|
|
628 ;;; Japan:
|
|
|
629 ;;;
|
|
|
630 ;;; ????????????
|
|
|
631
|
|
|
632 ;;; ---------------------------------------------------------------------
|
|
|
633 ;;; Non-UNIX support:
|
|
|
634 ;;; ---------------------------------------------------------------------
|
|
|
635
|
|
|
636 ;;; efs has full support, incuding file name completion and tree dired
|
|
|
637 ;;; for:
|
|
|
638 ;;;
|
|
|
639 ;;; VMS, CMS, MTS, MVS, ti-twenex, ti-explorer (the last two are lisp
|
|
|
640 ;;; machines), TOPS-20, DOS (running the Distinct, Novell, FTP
|
|
|
641 ;;; software, NCSA, Microsoft in both unix and DOS mode, Super TCP, and
|
|
|
642 ;;; Hellsoft FTP servers), unix descriptive listings (dl), KA9Q, OS/2,
|
|
|
643 ;;; VOS, NOS/VE, CMS running the KNET server, Tandem's Guardian OS, COKE
|
|
|
644 ;;;
|
|
|
645 ;;; efs should be able to automatically recognize any of the operating
|
|
|
646 ;;; systems and FTP servers that it supports. Please report any
|
|
|
647 ;;; failure to do so to the "bugs" address below. You can specify a
|
|
|
648 ;;; certain host as being of a given host type with the command
|
|
|
649 ;;;
|
|
|
650 ;;; (efs-add-host <host-type> <host>)
|
|
|
651 ;;;
|
|
|
652 ;;; <host-type> is a symbol, <host> is a string. If this command is
|
|
|
653 ;;; used interactively, then <host-type> is prompted for with
|
|
|
654 ;;; completion. Some host types have regexps that can be used to
|
|
|
655 ;;; specify a class of host names as being of a certain type. Note
|
|
|
656 ;;; that if you specify a host as being of a certain type, efs does
|
|
|
657 ;;; not verify that that is really the type of the host. This calls
|
|
|
658 ;;; for caution when using regexps to specify host types, as an
|
|
|
659 ;;; inadvertent match to a regexp might have unpleasant consequences.
|
|
|
660 ;;;
|
|
|
661 ;;; See the respective efs-TYPE.el files for more information.
|
|
|
662 ;;; When or if we get a tex info file, it should contain some more
|
|
|
663 ;;; details on the non-unix support.
|
|
|
664
|
|
|
665 ;;; ------------------------------------------------------------------
|
|
|
666 ;;; Bugs and other things that go clunk in the night:
|
|
|
667 ;;; ------------------------------------------------------------------
|
|
|
668
|
|
|
669 ;;; How to report a bug:
|
|
|
670 ;;; --------------------
|
|
|
671 ;;;
|
|
|
672 ;;; Type M-x efs-report-bug
|
|
|
673 ;;; or
|
|
|
674 ;;; send mail to efs-bugs@cuckoo.hpl.hp.com.
|
|
|
675 ;;;
|
|
|
676 ;;; efs is a "free" program. This means that you didn't (or shouldn't
|
|
|
677 ;;; have) paid anything for it. It also means that nobody is paid to
|
|
|
678 ;;; maintain it, and the authors weren't paid for writing it.
|
|
|
679 ;;; Therefore, please try to write your bug report in a clear and
|
|
|
680 ;;; complete fashion. It will greatly enhance the probability that
|
|
|
681 ;;; something will be done about your problem.
|
|
|
682 ;;;
|
|
|
683 ;;; Note that efs relies heavily in cached information, so the bug may
|
|
|
684 ;;; depend in a complicated fashion on commands that were performed on
|
|
|
685 ;;; remote files from the beginning of your emacs session. Trying to
|
|
|
686 ;;; reproduce your bug starting from a fresh emacs session is usually
|
|
|
687 ;;; a good idea.
|
|
|
688 ;;;
|
|
|
689
|
|
|
690 ;;; Fan/hate mail:
|
|
|
691 ;;; --------------
|
|
|
692 ;;;
|
|
|
693 ;;; efs has its own mailing list called efs-help. All users of efs
|
|
|
694 ;;; are welcome to subscribe (see below) and to discuss aspects of
|
|
|
695 ;;; efs. New versions of efs are posted periodically to the mailing
|
|
|
696 ;;; list.
|
|
|
697 ;;;
|
|
|
698 ;;; To [un]subscribe to efs-help, or to report mailer problems with the
|
|
|
699 ;;; list, please mail one of the following addresses:
|
|
|
700 ;;;
|
|
|
701 ;;; efs-help-request@cuckoo.hpl.hp.com
|
|
|
702 ;;; or
|
|
|
703 ;;; efs-help-request%cuckoo.hpl.hp.com@hplb.hpl.hp.com
|
|
|
704 ;;;
|
|
|
705 ;;; Please don't forget the -request part.
|
|
|
706 ;;;
|
|
|
707 ;;; For mail to be posted directly to efs-help, send to one of the
|
|
|
708 ;;; following addresses:
|
|
|
709 ;;;
|
|
|
710 ;;; efs-help@cuckoo.hpl.hp.com
|
|
|
711 ;;; or
|
|
|
712 ;;; efs-help%cuckoo.hpl.hp.com@hplb.hpl.hp.com
|
|
|
713 ;;;
|
|
|
714 ;;; Alternatively, there is a mailing list that only gets
|
|
|
715 ;;; announcements of new efs releases. This is called efs-announce,
|
|
|
716 ;;; and can be subscribed to by e-mailing to the -request address as
|
|
|
717 ;;; above. Please make it clear in the request which mailing list you
|
|
|
718 ;;; wish to join.
|
|
|
719 ;;;
|
|
|
720
|
|
|
721 ;;; Known bugs:
|
|
|
722 ;;; -----------
|
|
|
723 ;;;
|
|
|
724 ;;; If you hit a bug in this list, please report it anyway. Most of
|
|
|
725 ;;; the bugs here remain unfixed because they are considered too
|
|
|
726 ;;; esoteric to be a high priority. If one of them gets reported
|
|
|
727 ;;; enough, we will likely change our view on that.
|
|
|
728 ;;;
|
|
|
729 ;;; 1) efs does not check to make sure that when creating a new file,
|
|
|
730 ;;; you provide a valid filename for the remote operating system.
|
|
|
731 ;;; If you do not, then the remote FTP server will most likely
|
|
|
732 ;;; translate your filename in some way. This may cause efs to
|
|
|
733 ;;; get confused about what exactly is the name of the file.
|
|
|
734 ;;;
|
|
|
735 ;;; 2) For CMS support, we send too many cd's. Since cd's are cheap, I haven't
|
|
|
736 ;;; worried about this too much. Eventually, we should have some caching
|
|
|
737 ;;; of the current minidisk. This is complicated by the fact that some
|
|
|
738 ;;; CMS servers lie about the current minidisk, so sending redundant
|
|
|
739 ;;; cd's helps us recover in this case.
|
|
|
740 ;;;
|
|
|
741 ;;; 3) The code to do compression of files over ftp is not as careful as it
|
|
|
742 ;;; should be. It deletes the old remote version of the file, before
|
|
|
743 ;;; actually checking if the local to remote transfer of the compressed
|
|
|
744 ;;; file succeeds. Of course to delete the original version of the file
|
|
|
745 ;;; after transferring the compressed version back is also dangerous,
|
|
|
746 ;;; because some OS's have severe restrictions on the length of filenames,
|
|
|
747 ;;; and when the compressed version is copied back the "-Z" or ".Z" may be
|
|
|
748 ;;; truncated. Then, efs would delete the only remaining version of
|
|
|
749 ;;; the file. Maybe efs should make backups when it compresses files
|
|
|
750 ;;; (of course, the backup "~" could also be truncated off, sigh...).
|
|
|
751 ;;; Suggestions?
|
|
|
752 ;;;
|
|
|
753 ;;; 4) If a dir listing is attempted for an empty directory on (at least
|
|
|
754 ;;; some) VMS hosts, an ftp error is given. This is really an ftp bug, and
|
|
|
755 ;;; I don't know how to get efs work to around it.
|
|
|
756 ;;;
|
|
|
757 ;;; 5) efs gets confused by directories containing file names with
|
|
|
758 ;;; embedded newlines. A temporary solution is to add "q" to your
|
|
|
759 ;;; dired listing switches. As long as your dired listing switches
|
|
|
760 ;;; also contain "l" and either "a" or "A", efs will use these
|
|
|
761 ;;; switches to get listings for its internal cache. The "q" switch
|
|
|
762 ;;; should force listings to be exactly one file per line. You
|
|
|
763 ;;; still will not be able to access a file with embedded newlines,
|
|
|
764 ;;; but at least it won't mess up the parsing of the rest of the files.
|
|
|
765 ;;;
|
|
|
766 ;;; 6) efs cannot parse symlinks which have an embedded " -> "
|
|
|
767 ;;; in their name. It's alright to have an embedded " -> " in the name
|
|
|
768 ;;; of any other type of file. A fix is possible, but probably not worth
|
|
|
769 ;;; the trouble. If you disagree, send us a bug report.
|
|
|
770 ;;;
|
|
|
771 ;;; 7) efs doesn't handle context-dep. files in H-switch listings on
|
|
|
772 ;;; HP's. It wouldn't be such a big roaring deal to fix this. I'm
|
|
|
773 ;;; waiting until I get an actual bug report though.
|
|
|
774 ;;;
|
|
|
775 ;;; 8) If a hard link is added or deleted, efs will not update its
|
|
|
776 ;;; internal cache of the link count for other names of the file.
|
|
|
777 ;;; This may cause file-nlinks to return incorrectly. Reverting
|
|
|
778 ;;; any dired buffer containing other names for the file will
|
|
|
779 ;;; cause the file data to be updated, including the link counts.
|
|
|
780 ;;; A fix for this problem is known and will be eventually
|
|
|
781 ;;; implemented. How it is implemented will depend on how we decide
|
|
|
782 ;;; to handle inodes. See below.
|
|
|
783 ;;;
|
|
|
784 ;;; 9) efs is unable to parse R-switch listings from remote unix hosts.
|
|
|
785 ;;; This is inefficient, because efs will insist on doing individual
|
|
|
786 ;;; listings of the subdirectories to get its file information.
|
|
|
787 ;;; This may be fixed if there is enough demand.
|
|
|
788 ;;;
|
|
|
789 ;;; 10) In file-attributes, efs returns a fake inode number. Of course
|
|
|
790 ;;; this is necessary, but this inode number is not even necessarily
|
|
|
791 ;;; unique. It is simply the sum of the characters (treated as
|
|
|
792 ;;; integers) in the host name, user name, and file name. Possible
|
|
|
793 ;;; ways to get a unique inode number are:
|
|
|
794 ;;; a) Simply keep a count of all remote file in the cache, and
|
|
|
795 ;;; return the file's position in this count as a negative number.
|
|
|
796 ;;; b) For unix systems, we could actually get at the real inode
|
|
|
797 ;;; number on the remote host, by adding an "i" to the ls switches.
|
|
|
798 ;;; The inode numbers would then be removed from the listing
|
|
|
799 ;;; returned by efs-ls, if the caller hadn't requested the "i"
|
|
|
800 ;;; switch. We could then make a unique number out of the host name
|
|
|
801 ;;; and the real inode number.
|
|
|
802 ;;;
|
|
|
803 ;;; 11) efs tries to determine if a file is readable or writable by comparing
|
|
|
804 ;;; the file modes, file owner, and user name under which it is logged
|
|
|
805 ;;; into the remote host. This does not take into account groups.
|
|
|
806 ;;; We simply assume that the user belongs to all groups. As a result
|
|
|
807 ;;; we may assume that a file is writable, when in fact it is not.
|
|
|
808 ;;; Groups are tough to handle correctly over FTP. Suggestions?
|
|
|
809 ;;; (For new FTP servers, can do a "QUOTE SITE EXEC groups" to
|
|
|
810 ;;; handle this.)
|
|
|
811
|
|
|
812 ;;; -----------------------------------------------------------
|
|
|
813 ;;; Technical information on this package:
|
|
|
814 ;;; -----------------------------------------------------------
|
|
|
815
|
|
|
816 ;;; efs hooks onto the following functions using the
|
|
|
817 ;;; file-name-handler-alist. Depending on which version of emacs you
|
|
|
818 ;;; are using, not all of these functions may access this alist. In
|
|
|
819 ;;; this case, efs overloads the definitions of these functions with
|
|
|
820 ;;; versions that do access the file-name-handler-alist. These
|
|
|
821 ;;; overloads are done in efs's version-specific files.
|
|
|
822 ;;;
|
|
|
823 ;;; abbreviate-file-name
|
|
|
824 ;;; backup-buffer
|
|
|
825 ;;; copy-file
|
|
|
826 ;;; create-file-buffer
|
|
|
827 ;;; delete-directory
|
|
|
828 ;;; delete-file
|
|
|
829 ;;; directory-file-name
|
|
|
830 ;;; directory-files
|
|
|
831 ;;; file-attributes
|
|
|
832 ;;; file-directory-p
|
|
|
833 ;;; file-exists-p
|
|
|
834 ;;; file-local-copy
|
|
|
835 ;;; file-modes
|
|
|
836 ;;; file-name-all-completions
|
|
|
837 ;;; file-name-as-directory
|
|
|
838 ;;; file-name-completion
|
|
|
839 ;;; file-name-directory
|
|
|
840 ;;; file-name-nondirectory
|
|
|
841 ;;; file-name-sans-versions
|
|
|
842 ;;; file-newer-than-file-p
|
|
|
843 ;;; file-readable-p
|
|
|
844 ;;; file-executable-p
|
|
|
845 ;;; file-accessible-directory-p
|
|
|
846 ;;; file-symlink-p
|
|
|
847 ;;; file-writable-p
|
|
|
848 ;;; get-file-buffer
|
|
|
849 ;;; insert-directory
|
|
|
850 ;;; insert-file-contents
|
|
|
851 ;;; list-directory
|
|
|
852 ;;; make-directory-internal
|
|
|
853 ;;; rename-file
|
|
|
854 ;;; set-file-modes
|
|
|
855 ;;; set-visited-file-modtime
|
|
|
856 ;;; substitute-in-file-name
|
|
|
857 ;;; verify-visited-file-modtime
|
|
|
858 ;;; write-region
|
|
|
859 ;;;
|
|
|
860 ;;; The following functions are overloaded in efs.el, because they cannot
|
|
|
861 ;;; be handled via the file-name-handler-alist.
|
|
|
862 ;;;
|
|
|
863 ;;; expand-file-name
|
|
|
864 ;;; load
|
|
|
865 ;;; read-file-name-internal (Emacs 18, only)
|
|
|
866 ;;; require
|
|
|
867 ;;;
|
|
|
868 ;;; The following dired functions are handled by hooking them into the
|
|
|
869 ;;; the file-name-handler-alist. This is done in efs-dired.el.
|
|
|
870 ;;;
|
|
|
871 ;;; efs-dired-compress-file
|
|
|
872 ;;; eds-dired-print-file
|
|
|
873 ;;; efs-dired-make-compressed-filename
|
|
|
874 ;;; efs-compress-file
|
|
|
875 ;;; efs-dired-print-file
|
|
|
876 ;;; efs-dired-create-directory
|
|
|
877 ;;; efs-dired-recursive-delete-directory
|
|
|
878 ;;; efs-dired-uncache
|
|
|
879 ;;; efs-dired-call-process
|
|
|
880 ;;;
|
|
|
881 ;;; In efs-dired.el, the following dired finctions are overloaded.
|
|
|
882 ;;;
|
|
|
883 ;;; dired-collect-file-versions
|
|
|
884 ;;; dired-find-file
|
|
|
885 ;;; dired-flag-backup-files
|
|
|
886 ;;; dired-get-filename
|
|
|
887 ;;; dired-insert-headerline
|
|
|
888 ;;; dired-move-to-end-of-filename
|
|
|
889 ;;; dired-move-to-filename
|
|
|
890 ;;; dired-run-shell-command
|
|
|
891 ;;;
|
|
|
892 ;;; efs makes use of the following hooks
|
|
|
893 ;;;
|
|
|
894 ;;; diff-load-hook
|
|
|
895 ;;; dired-before-readin-hook
|
|
|
896 ;;; find-file-hooks
|
|
|
897 ;;; dired-grep-load-hook
|
|
|
898
|
|
|
899 ;;; LISPDIR ENTRY for the Elisp Archive:
|
|
|
900 ;;;
|
|
|
901 ;;; LCD Archive Entry:
|
|
|
902 ;;; efs|Andy Norman and Sandy Rutherford
|
|
|
903 ;;; |ange@hplb.hpl.hp.com and sandy@ibm550.sissa.it
|
|
|
904 ;;; |transparent FTP Support for GNU Emacs
|
|
116
|
905 ;;; |$Date: 1997/03/28 02:28:27 $|$efs release: 1.15 beta $|
|
|
98
|
906
|
|
|
907 ;;; Host and listing type notation:
|
|
|
908 ;;;
|
|
|
909 ;;; The functions efs-host-type and efs-listing-type, and the
|
|
|
910 ;;; variable efs-dired-host-type follow the following conventions
|
|
|
911 ;;; for remote host types.
|
|
|
912 ;;;
|
|
|
913 ;;; nil = local host type, whatever that is (probably unix).
|
|
|
914 ;;; Think nil as in "not a remote host". This value is used by
|
|
|
915 ;;; efs-dired-host-type for local buffers.
|
|
|
916 ;;; (efs-host-type nil) => nil
|
|
|
917 ;;;
|
|
|
918 ;;; 'type = a remote host of TYPE type.
|
|
|
919 ;;;
|
|
|
920 ;;; 'type:list = a remote host using listing type 'type:list.
|
|
|
921 ;;; This is currently used for Unix dl (descriptive
|
|
|
922 ;;; listings), when efs-dired-host-type is set to
|
|
|
923 ;;; 'unix:dl, and to support the myriad of DOS FTP
|
|
|
924 ;;; servers.
|
|
|
925
|
|
|
926 ;;; Supported host and listing types:
|
|
|
927 ;;;
|
|
|
928 ;;; unknown, unix, dumb-unix, bsd-unix, sysV-unix, next-unix,
|
|
|
929 ;;; super-dumb-unix, dumb-apollo-unix,
|
|
|
930 ;;; apollo-unix, unix:dl, dos-distinct, ka9q, dos, dos:ftp, dos:novell,
|
|
|
931 ;;; dos:ncsa, dos:winsock, vos, hell, dos:microsoft, super-dumb-unix
|
|
|
932 ;;; vms, cms, mts, mvs, mvs:tcp mvs:nih tops-20, mpe, ti-twenex,
|
|
|
933 ;;; ti-explorer, os2, vos,
|
|
|
934 ;;; vms:full, guardian, ms-unix (This is the Microsoft NT Windows server
|
|
|
935 ;;; in unix mode.), plan9, unix:unknown, nos-ve (actually NOS/VE).
|
|
|
936
|
|
|
937 ;;; Host and listing type hierarchy:
|
|
|
938 ;;;
|
|
|
939 ;;; unknown: unix, dumb-unix, sysV-unix, bsd-unix, next-unix, apollo-unix,
|
|
|
940 ;;; ka9q, dos-distinct, unix:dl, hell,
|
|
|
941 ;;; super-dumb-unix, dumb-apollo-unix
|
|
|
942 ;;; unix: sysV-unix, bsd-unix, next-unix, apollo-unix, unix:dl
|
|
|
943 ;;; dos: dos:ftp, dos:novell, dos:ncsa, dos:microsoft, dos:winsock
|
|
|
944 ;;; dumb-unix:
|
|
|
945 ;;; bsd-unix:
|
|
|
946 ;;; sysV-unix:
|
|
|
947 ;;; next-unix:
|
|
|
948 ;;; apollo-unix:
|
|
|
949 ;;; dumb-apollo-unix:
|
|
|
950 ;;; unix:dl:
|
|
|
951 ;;; unix:unknown: unix:dl, unix
|
|
|
952 ;;; super-dumb-unix:
|
|
|
953 ;;; dos-distinct:
|
|
|
954 ;;; dos:ftp:
|
|
|
955 ;;; dos:novell:
|
|
|
956 ;;; dos:microsoft
|
|
|
957 ;;; ka9q:
|
|
|
958 ;;; vms: vms:full
|
|
|
959 ;;; cms:
|
|
|
960 ;;; mts:
|
|
|
961 ;;; mvs: mvs:tcp, mvs:nih
|
|
|
962 ;;; mvs:tcp:
|
|
|
963 ;;; mvs:nih:
|
|
|
964 ;;; tops-20:
|
|
|
965 ;;; ti-twenex:
|
|
|
966 ;;; ti-explorer:
|
|
|
967 ;;; os2:
|
|
|
968 ;;; vos:
|
|
|
969 ;;; vms:full:
|
|
|
970 ;;; dos:ncsa:
|
|
|
971 ;;; dos:winsock:
|
|
|
972 ;;; vos:
|
|
|
973 ;;; hell:
|
|
|
974 ;;; guardian:
|
|
|
975 ;;; ms-unix:
|
|
|
976 ;;; plan9:
|
|
|
977 ;;; nos-ve:
|
|
|
978 ;;; coke:
|
|
|
979 ;;;
|
|
|
980
|
|
|
981
|
|
|
982 ;;;; ================================================================
|
|
|
983 ;;;; >0
|
|
|
984 ;;;; Table of Contents for efs.el
|
|
|
985 ;;;; ================================================================
|
|
|
986 ;;
|
|
|
987 ;; Each section of efs.el is labelled by >#, where # is the number of
|
|
|
988 ;; the section.
|
|
|
989 ;;
|
|
|
990 ;; 1. Provisions, requirements, and autoloads.
|
|
|
991 ;; 2. Variable definitions.
|
|
|
992 ;; 3. Utilities.
|
|
|
993 ;; 4. Hosts, users, accounts, and passwords.
|
|
|
994 ;; 5. FTP client process and server responses.
|
|
|
995 ;; 6. Sending commands to the FTP server.
|
|
|
996 ;; 7. Parsing and storing remote file system data.
|
|
|
997 ;; 8. Redefinitions of standard GNU Emacs functions.
|
|
|
998 ;; 9. Multiple host type support.
|
|
|
999 ;; 10. Attaching onto the appropriate emacs version.
|
|
|
1000
|
|
|
1001
|
|
|
1002 ;;;; ================================================================
|
|
|
1003 ;;;; >1
|
|
|
1004 ;;;; General provisions, requirements, and autoloads.
|
|
|
1005 ;;;; Host type, and local emacs type dependent loads, and autoloads
|
|
|
1006 ;;;; are in the last two sections of this file.
|
|
|
1007 ;;;; ================================================================
|
|
|
1008
|
|
|
1009 ;;;; ----------------------------------------------------------------
|
|
|
1010 ;;;; Provide the package (Do this now to avoid an infinite loop)
|
|
|
1011 ;;;; ----------------------------------------------------------------
|
|
|
1012
|
|
|
1013 (provide 'efs)
|
|
|
1014
|
|
|
1015 ;;;; ----------------------------------------------------------------
|
|
|
1016 ;;;; Our requirements.
|
|
|
1017 ;;;; ----------------------------------------------------------------
|
|
|
1018
|
|
|
1019 (require 'backquote)
|
|
|
1020 (require 'comint)
|
|
|
1021 (require 'efs-defun)
|
|
|
1022 (require 'efs-netrc)
|
|
|
1023 (require 'efs-cu)
|
|
|
1024 (require 'efs-ovwrt)
|
|
|
1025 ;; Do this last, as it installs efs into the file-name-handler-alist.
|
|
|
1026 (require 'efs-fnh)
|
|
|
1027
|
|
|
1028 (autoload 'efs-report-bug "efs-report" "Submit a bug report for efs." t)
|
|
|
1029 (autoload 'efs-gwp-start "efs-gwp" ; For interactive gateways.
|
|
|
1030 "Login to the gateway machine and fire up an FTP client.")
|
|
|
1031 (autoload 'efs-kerberos-login "efs-kerberos")
|
|
|
1032 (autoload 'efs-insert-directory "efs-dired" "Insert a directory listing.")
|
|
|
1033 (autoload 'efs-set-mdtm-of "efs-cp-p")
|
|
|
1034 (autoload 'diff-latest-backup-file "diff")
|
|
|
1035 (autoload 'read-passwd "passwd" "Read a password from the minibuffer." t)
|
|
|
1036
|
|
|
1037
|
|
|
1038 ;;;; ============================================================
|
|
|
1039 ;;;; >2
|
|
|
1040 ;;;; Variable Definitions
|
|
|
1041 ;;;; **** The user configuration variables are in ****
|
|
|
1042 ;;;; **** the second subsection of this section. ****
|
|
|
1043 ;;;; ============================================================
|
|
|
1044
|
|
|
1045 ;;;; ------------------------------------------------------------
|
|
|
1046 ;;;; Constant Definitions
|
|
|
1047 ;;;; ------------------------------------------------------------
|
|
|
1048
|
|
|
1049 (defconst efs-version
|
|
|
1050 (concat (substring "$efs release: 1.15 $" 14 -2)
|
|
|
1051 "/"
|
|
116
|
1052 (substring "#Revision: 1.56 $" 11 -2)))
|
|
98
|
1053
|
|
|
1054 (defconst efs-time-zero 1970) ; we count time from midnight, Jan 1, 1970 GMT.
|
|
|
1055
|
|
|
1056 (defconst efs-dumb-host-types
|
|
|
1057 '(dumb-unix super-dumb-unix vms cms mts ti-twenex ti-explorer dos mvs
|
|
|
1058 tops-20 mpe ka9q dos-distinct os2 vos hell guardian
|
|
|
1059 netware cms-knet nos-ve coke dumb-apollo-unix)
|
|
|
1060 "List of host types that can't take UNIX ls-style listing options.")
|
|
|
1061 ;; dos-distinct only ignores ls switches; it doesn't barf.
|
|
|
1062 ;; Still treat it as dumb.
|
|
|
1063
|
|
|
1064 (defconst efs-unix-host-types
|
|
|
1065 '(unix sysV-unix bsd-unix next-unix apollo-unix dumb-unix
|
|
|
1066 dumb-apollo-unix super-dumb-unix)
|
|
|
1067 "List of unix host types.")
|
|
|
1068
|
|
|
1069 (defconst efs-version-host-types '(vms tops-20 ti-twenex ti-explorer)
|
|
|
1070 "List of host-types which associated a version number to all files.
|
|
|
1071 This is not the same as associating version numbers to only backup files.")
|
|
|
1072 ;; Note that on these systems,
|
|
|
1073 ;; (file-name-sans-versions EXISTING-FILE) does not exist as a file.
|
|
|
1074
|
|
|
1075 (defconst efs-single-extension-host-types
|
|
|
1076 '(vms tops-20 ti-twenex ti-explorer cms mvs dos ka9q dos-distinct hell
|
|
|
1077 netware ms-unix plan9 cms-knet nos-ve)
|
|
|
1078 "List of host types which allow at most one extension on a file name.
|
|
|
1079 Extensions are deliminated by \".\". In addition, these host-types must
|
|
|
1080 allow \"-\" in file names, because it will be used to add additional extensions
|
|
|
1081 to indicate compressed files.")
|
|
|
1082
|
|
|
1083 (defconst efs-idle-host-types
|
|
|
1084 (append '(coke unknown) efs-unix-host-types))
|
|
|
1085 ;; List of host types for which it is possible that the SITE IDLE command
|
|
|
1086 ;; is supported.
|
|
|
1087
|
|
|
1088 (defconst efs-listing-types
|
|
|
1089 '(unix:dl unix:unknown
|
|
|
1090 dos:novell dos:ftp dos:ncsa dos:microsoft dos:stcp dos:winsock
|
|
|
1091 mvs:nih mvs:tcp mvs:tcp
|
|
|
1092 vms:full)
|
|
|
1093 "List of supported listing types")
|
|
|
1094
|
|
|
1095 (defconst efs-nlist-listing-types
|
|
|
1096 '(vms:full))
|
|
|
1097 ;; Listing types which give a long useless listing when asked for a
|
|
|
1098 ;; LIST. For these, use an NLST instead. This can only be done
|
|
|
1099 ;; when there is some way to distinguish directories from
|
|
|
1100 ;; plain files in an NLST.
|
|
|
1101
|
|
|
1102 (defconst efs-opaque-gateways '(remsh interactive))
|
|
|
1103 ;; List of gateway types for which we need to do explicit file handling on
|
|
|
1104 ;; the gateway machine.
|
|
|
1105
|
|
|
1106 ;;;; ------------------------------------------------------------------
|
|
|
1107 ;;;; User customization variables. Please read through these carefully.
|
|
|
1108 ;;;; ------------------------------------------------------------------
|
|
|
1109
|
|
|
1110 ;;;>>>> If you are not fully connected to the internet, <<<<
|
|
|
1111 ;;;>>>> and need to use a gateway (no matter how transparent) <<<<
|
|
|
1112 ;;;>>>> you will need to set some of the following variables. <<<<
|
|
|
1113 ;;;>>>> Read the documentation carefully. <<<<
|
|
|
1114
|
|
|
1115 (defvar efs-local-host-regexp ".*"
|
|
|
1116 "Regexp to match names of local hosts.
|
|
|
1117 These are hosts to which it is possible to obtain a direct internet
|
|
|
1118 connection. Even if the host is accessible by a very transparent FTP gateway,
|
|
|
1119 it does not qualify as a local host. The test to determine if machine A is
|
|
|
1120 local to your machine is if it is possible to ftp from A _back_ to your
|
|
|
1121 local machine. Also, open-network-stream must be able to reach the host
|
|
|
1122 in question.")
|
|
|
1123
|
|
|
1124 (defvar efs-ftp-local-host-regexp ".*"
|
|
|
1125 "Regexp to match the names of hosts reachable by a direct ftp connection.
|
|
|
1126 This regexp should match the names of hosts which can be reached using ftp,
|
|
|
1127 without requiring any explicit connection to a gateway. If you have a smart
|
|
|
1128 ftp client which is able to transparently go through a gateway, this will
|
|
|
1129 differ from `efs-local-host-regexp'.")
|
|
|
1130
|
|
|
1131 (defvar efs-gateway-host nil
|
|
|
1132 "If non-nil, this must be the name of your ftp gateway machine.
|
|
|
1133 If your net world is divided into two domains according to
|
|
|
1134 `efs-local-ftp-host-regexp', set this variable to the name of the
|
|
|
1135 gateway machine.")
|
|
|
1136
|
|
|
1137 (defvar efs-gateway-type nil
|
|
|
1138 "Specifies which type of gateway you wish efs to use.
|
|
|
1139 This should be a list, the first element of which is a symbol denoting the
|
|
|
1140 gateway type, and following elements give data on how to use the gateway.
|
|
|
1141
|
|
|
1142 The following possibilities are supported:
|
|
|
1143
|
|
|
1144 '(local FTP-PROGRAM FTP-PROGRAM-ARGS)
|
|
|
1145 This means that your local host is itself the gateway. However,
|
|
|
1146 you need to run a special FTP client to access outside hosts.
|
|
|
1147 FTP-PROGRAM should be the name of this FTP client, and FTP-PROGRAM-ARGS
|
|
|
1148 is a list of arguments to pass to it \(probably set this to the value of
|
|
|
1149 efs-ftp-program-args <V>\). Note that if your gateway is of this type,
|
|
|
1150 then you would set efs-gateway-host to nil.
|
|
|
1151
|
|
|
1152 '(proxy FTP-PROGRAM FTP-PROGRAM-ARGS)
|
|
|
1153 This indicates that your gateway works by first FTP'ing to it, and
|
|
|
1154 then giving a USER command of the form \"USER <username>@<host>\".
|
|
|
1155 FTP-PROGRAM is the FTP program to use to connect to the gateway; this
|
|
|
1156 is most likely \"ftp\". FTP-PROGRAM-ARGS is a list of arguments to
|
|
|
1157 pass to it. You likely want this to be set to the value of
|
|
|
1158 efs-ftp-program-args <V>. If the connection to the gateway FTP server
|
|
|
1159 is to be on a port different from 21, set efs-gateway-host to
|
|
|
1160 \"<host>#<port>\".
|
|
|
1161
|
|
|
1162 '(raptor FTP-PROGRAM FTP-PROGRAM-ARGS USER)
|
|
|
1163 This is for the gateway called raptor by Eagle. After connecting to the
|
|
|
1164 the gateway, the command \"user <user>@host USER\" is issued to login
|
|
|
1165 as <user> on <host>, where USER is an authentication username for the
|
|
|
1166 gateway. After issuing the password for the remote host, efs will
|
|
|
1167 send the password for USER on efs-gateway-host <V> as an account command.
|
|
|
1168
|
|
|
1169 '(interlock FTP-PROGRAM FTP-PROGRAM-ARGS)
|
|
|
1170 This is for the interlock gateway. The exact login sequence is to
|
|
|
1171 connect to the gateway specified by efs-gateway-host <V>, send the
|
|
|
1172 gateway password with a PASS command, send the command
|
|
|
1173 \"user <user>@<host>\" to connect to remote host <host> as user <user>,
|
|
|
1174 and finally to send the password for <user> on <host> with a second
|
|
|
1175 PASS command.
|
|
|
1176
|
|
|
1177 '(kerberos FTP-PROGRAM FTP-PROGRAM-ARGS KINIT-PROGRAM KINIT-PROGRAM-ARGS)
|
|
|
1178 This is for the kerberos gateway where you need to run a program (kinit) to
|
|
|
1179 obtain a ticket for gateway authroization first. FTP-PROGRAM should be
|
|
|
1180 the name of the FTP client that you use to connect to the gateway. This
|
|
|
1181 may likely be \"iftp\". FTP-PROGRAM-ARGS are the arguments that you need
|
|
|
1182 to pass to FTP-PROGRAM. This is probably the value of
|
|
|
1183 efs-ftp-program-args <V>. KINIT-PROGRAM is the name of the program to
|
|
|
1184 run in order to obtain a ticket. This is probably \"kinit\".
|
|
|
1185 KINIT-PROGRAM-ARGS is a list og strings indicating any arguments that you
|
|
|
1186 need to pass to KINIT-PROGRAM. Most likely this is nil.
|
|
|
1187
|
|
|
1188 '(remsh GATEWAY-PROGRAM GATEWAY-PROGRAM-ARGS FTP-PROGRAM FTP-PROGRAM-ARGS)
|
|
|
1189 This indicates that you wish to run FTP on your gateway using a remote shell.
|
|
|
1190 GATEWAY-PROGRAM is the name of the program to use to start a remote shell.
|
|
|
1191 It is assumed that it is not necessary to provide a password to start
|
|
|
1192 this remote shell. Likely values are \"remsh\" or \"rsh\".
|
|
|
1193 GATEWAY-PROGRAM-ARGS is a list of arguments to pass to GATEWAY-PROGRAM.
|
|
|
1194 FTP-PROGRAM is the name of the FTP program on the gateway. A likely setting
|
|
|
1195 of this is \"ftp\". FTP-PROGRAM-ARGS is a list of arguments to pass to
|
|
|
1196 FTP-PROGRAM. Most likely these should be set to the value of
|
|
|
1197 efs-ftp-program-args <V>.
|
|
|
1198
|
|
|
1199 '(interactive GATEWAY-PROGRAM GATEWAY-PROGRAM-ARGS FTP-PROGRAM
|
|
|
1200 FTP-PROGRAM-ARGS)
|
|
|
1201 This indicates that you need to start an interactive login on your gatway,
|
|
|
1202 using rlogin, telnet, or something similar. GATEWAY-PROGRAM is the name
|
|
|
1203 of the program to use to log in to the gateway, and GATEWAY-PROGRAM-ARGS
|
|
|
1204 is a list of arguments to pass to it. FTP-PROGRAM is the name of the FTP
|
|
|
1205 program on the gateway. A likely setting for this variable would be
|
|
|
1206 \"exec ftp\". FTP-PROGRAM-ARGS is a list of arguments to pass
|
|
|
1207 to FTP-PROGRAM. You probably want to set these to the same value as
|
|
|
1208 efs-ftp-program-args <V>. If you are using this option, read the
|
|
|
1209 documentation at the top of efs-gwp.el, and see
|
|
|
1210 efs-gwp-setup-term-command <V>.")
|
|
|
1211
|
|
|
1212 (defvar efs-gateway-hash-mark-size nil
|
|
|
1213 "*Value of `efs-hash-mark-size' for FTP clients on `efs-gateway-host'.
|
|
|
1214 See the documentation of these variables for more information.")
|
|
|
1215
|
|
|
1216 (defvar efs-gateway-incoming-binary-hm-size nil
|
|
|
1217 "*Value of `efs-incoming-binary-hm-size' for `efs-gateway-host'.
|
|
|
1218 See documentation of these variables for more information.")
|
|
|
1219
|
|
|
1220 (defvar efs-gateway-tmp-name-template "/tmp/efs"
|
|
|
1221 "Template used to create temporary files when ftp-ing through a gateway.
|
|
|
1222 This should be the name of the file on the gateway, and not necessarily
|
|
|
1223 the name on the local host.")
|
|
|
1224
|
|
|
1225 (defvar efs-gateway-mounted-dirs-alist nil
|
|
|
1226 "An alist of directories cross-mounted between the gateway and local host.
|
|
|
1227 Each entry is of the form \( DIR1 . DIR2 \), where DIR1 is the name of the
|
|
|
1228 directory on the local host, and DIR2 is its name on the remote host. Both
|
|
|
1229 DIR1 and DIR2 must be specified in directory syntax, i.e. end in a slash.
|
|
|
1230 Note that we will assume that subdirs of DIR1 and DIR2 are also accessible
|
|
|
1231 on both machines.")
|
|
|
1232
|
|
|
1233 (defvar efs-gateway-ftp-prompt-regexp "^\\(ftp\\|Ftp\\|FTP\\)> *"
|
|
|
1234 "*Regular expression to match the prompt of the gateway FTP client.")
|
|
|
1235
|
|
|
1236 ;;; End of gateway config variables.
|
|
|
1237
|
|
|
1238 (defvar efs-tmp-name-template "/tmp/efs"
|
|
|
1239 "Template used to create temporary files.
|
|
|
1240 If you are worried about security, make this a directory in some
|
|
|
1241 bomb-proof cave somewhere. efs does clean up its temp files, but
|
|
|
1242 they do live for short periods of time.")
|
|
|
1243
|
|
|
1244 (defvar efs-generate-anonymous-password t
|
|
|
1245 "*If t, use a password of `user@host' when logging in as the anonymous user.
|
|
|
1246 `host' is generated by the function `efs-system-fqdn'. If `system name' returns
|
|
|
1247 a fully qualified domain name, `efs-system-fqdn' will return this. Otherwise,
|
|
|
1248 it will attempt to use nslookup to obtain a fully qualified domain name. If
|
|
|
1249 this is unsuccessful, the returned value will be the same as `system-name',
|
|
|
1250 whether this is a fully qualified domain name or not.
|
|
|
1251
|
|
|
1252 If a string then use that as the password.
|
|
|
1253
|
|
|
1254 If nil then prompt the user for a password.
|
|
|
1255
|
|
|
1256 Beware that some operating systems, such as MVS, restrict substantially
|
|
|
1257 the password length. The login will fail with a weird error message
|
|
|
1258 if you exceed it.")
|
|
|
1259
|
|
|
1260 (defvar efs-high-security-hosts nil
|
|
|
1261 "*Indicates host user pairs for which passwords should not be cached.
|
|
|
1262 If non-nil, should be a regexp matching user@host constructions for which
|
|
|
1263 efs should not store passwords in its internal cache.")
|
|
|
1264
|
|
|
1265 ;; The following regexps are tested in the following order:
|
|
|
1266 ;; efs-binary-file-host-regexp, efs-36-bit-binary-file-name-regexp,
|
|
|
1267 ;; efs-binary-file-name-regexp, efs-text-file-name-regexp.
|
|
|
1268 ;; File names which match nothing are transferred in 'image mode.
|
|
|
1269
|
|
|
1270 ;; If we're not careful, we're going to blow the regexp stack here.
|
|
|
1271 ;; Probably should move to a list of regexps. Slower, but safer.
|
|
|
1272 ;; This is not a problem in Emacs 19.
|
|
|
1273 (defvar efs-binary-file-name-regexp
|
|
|
1274 (concat "\\." ; the dot
|
|
|
1275 ;; extensions
|
|
|
1276 "\\([zZ]\\|t?gz\\|lzh\\|arc\\|zip\\|zoo\\|ta[rz]\\|dvi\\|sit\\|"
|
|
|
1277 "ps\\|elc\\|gif\\|Z-part-..\\|tpz\\|exe\\|[jm]pg\\|TZ[a-z]?\\|lib\\)"
|
|
|
1278 "\\(~\\|~[0-9]+~\\)?$" ; backups
|
|
|
1279 "\\|"
|
|
|
1280 ;; UPPER CASE LAND
|
|
|
1281 "\\."
|
|
|
1282 "\\(ARC\\|ELC\\|TAGS\\|EXE\\|ZIP\\|DVI\|ZOO\\|GIF\\|T?GZ\\|"
|
|
|
1283 "[JM]PG\\)"
|
|
|
1284 "\\([.#;][0-9]+\\)?$" ; versions
|
|
|
1285 )
|
|
|
1286 "*Files whose names match this regexp will be considered to be binary.
|
|
|
1287 By binary here, we mean 8-bit binary files (the usual unix binary files).
|
|
|
1288 If nil, no files will be considered to be binary.")
|
|
|
1289
|
|
|
1290 (defvar efs-binary-file-host-regexp nil
|
|
|
1291 "*All files on hosts matching this regexp are treated as 8-bit binary.
|
|
|
1292 Setting this to nil, inhibits this feature.")
|
|
|
1293
|
|
|
1294 (defvar efs-36-bit-binary-file-name-regexp nil
|
|
|
1295 "*Files whose names match this regexp will be considered to PDP 10 binaries.
|
|
|
1296 These are 36-bit word-aligned binary files. This is really only relevant for
|
|
|
1297 files on PDP 10's, and similar machines. If nil, no files will be considered
|
|
|
1298 to be PDP 10 binaries.")
|
|
|
1299
|
|
|
1300 (defvar efs-text-file-name-regexp ".*"
|
|
|
1301 "*Files whose names match this regexp will be considered to be text files.")
|
|
|
1302
|
|
|
1303 (defvar efs-prompt-for-transfer-type nil
|
|
|
1304 "*If non-nil, efs will prompt for the transfer type for each file transfer.
|
|
|
1305 The command efs-prompt-for-transfer-type can be used to toggle its value.")
|
|
|
1306
|
|
|
1307 (defvar efs-treat-crlf-as-nl nil
|
|
|
1308 "*Controls how file systems using CRLF as end of line are treated.
|
|
|
1309 If non-nil, such file systems will be considered equivalent to those which use
|
|
|
1310 LF as end of line. This is particularly relevant to transfers between DOS
|
|
|
1311 systems and UNIX. Setting this to be non-nil will cause all file transfers
|
|
|
1312 between DOS and UNIX systems to use be image or binary transfers.")
|
|
|
1313
|
|
|
1314 (defvar efs-send-hash t
|
|
|
1315 "*If non-nil, send the HASH command to the FTP client.")
|
|
|
1316
|
|
|
1317 (defvar efs-hash-mark-size nil
|
|
|
1318 "*Default size, in bytes, between hash-marks when transferring a file.
|
|
|
1319 If this is nil then efs will attempt to assign a value based on the
|
|
|
1320 output of the HASH command. Also, if this variable is incorrectly set,
|
|
|
1321 then efs will try to correct it based on the size of the last file
|
|
|
1322 transferred, and the number hashes outputed by the client during the
|
|
|
1323 transfer.
|
|
|
1324
|
|
|
1325 The variable `efs-gateway-hash-mark-size' defines the corresponding value
|
|
|
1326 for the FTP client on the gateway, if you are using a gateway.
|
|
|
1327
|
|
|
1328 Some client-server combinations do not correctly compute the number of hash
|
|
|
1329 marks for incoming binary transfers. In this case, a separate variable
|
|
|
1330 `efs-incoming-binary-hm-size' can be used to set a default value of the
|
|
|
1331 hash mark size for incoming binary transfers.")
|
|
|
1332
|
|
|
1333 (defvar efs-incoming-binary-hm-size nil
|
|
|
1334 "*Default hash mark size for incoming binary transfers.
|
|
|
1335 If this is nil, incoming binary transfers will use `efs-hash-mark-size' as
|
|
|
1336 the default. See the documentation of this variable for more details.")
|
|
|
1337
|
|
|
1338 (defvar efs-verbose t
|
|
|
1339 "*If non-NIL then be chatty about interaction with the FTP process.
|
|
|
1340 If 0 do not give % transferred reports for asynchronous commands and status
|
|
|
1341 reports for commands verifying file modtimes, but report on everything else.")
|
|
|
1342
|
|
|
1343 (defvar efs-message-interval 0
|
|
|
1344 "*Defines the minimum time in seconds between status messages.
|
|
|
1345 A new status message is not displayed, if one has already been given
|
|
|
1346 within this period of time.")
|
|
|
1347
|
|
|
1348 (defvar efs-max-ftp-buffer-size 3000
|
|
|
1349 "*Maximum size in characters of FTP process buffer, before it is trimmed.
|
|
|
1350 The buffer is trimmed to approximately half this size. Setting this to nil
|
|
|
1351 inhibits trimming of FTP process buffers.")
|
|
|
1352
|
|
|
1353 (defvar efs-ls-cache-max 5
|
|
|
1354 "*Maximum number of directory listings to be cached in efs-ls-cache.")
|
|
|
1355
|
|
|
1356 (defvar efs-mode-line-format " ftp(%d)"
|
|
|
1357 "Format string used to determine how FTP activity is shown on the mode line.
|
|
|
1358 It is passed to format, with second argument the number of active FTP
|
|
|
1359 sessions as an integer.")
|
|
|
1360
|
|
|
1361 (defvar efs-show-host-type-in-dired t
|
|
|
1362 "If non-nil, show the system type on the mode line of remote dired buffers.")
|
|
|
1363
|
|
|
1364 (defvar efs-ftp-activity-function nil
|
|
|
1365 "Function called to indicate FTP activity.
|
|
|
1366 It must have exactly one argument, the number of active FTP sessions as an
|
|
|
1367 integer.")
|
|
|
1368
|
|
|
1369 (defvar efs-ftp-program-name "ftp"
|
|
|
1370 "Name of FTP program to run.")
|
|
|
1371
|
|
|
1372 (defvar efs-ftp-program-args '("-i" "-n" "-g" "-v")
|
|
|
1373 "*A list of arguments passed to the FTP program when started.")
|
|
|
1374
|
|
|
1375 (defvar efs-ftp-prompt-regexp "^\\(ftp\\|Ftp\\|FTP\\)> *"
|
|
|
1376 "*Regular expression to match the prompt of your FTP client.")
|
|
|
1377
|
|
|
1378 (defvar efs-nslookup-program "nslookup"
|
|
|
1379 "*If non-NIL then a string naming nslookup program." )
|
|
|
1380
|
|
|
1381 (defvar efs-nslookup-on-connect nil
|
|
|
1382 "*If non-NIL then use nslookup to resolve the host name before connecting.")
|
|
|
1383
|
|
|
1384 (defvar efs-nslookup-threshold 1000
|
|
|
1385 "How many iterations efs waits on the nslookup program.
|
|
|
1386 Applies when nslookup is used to compute a fully qualified domain name
|
|
|
1387 for the local host, in the case when `system-name' does not return one.
|
|
|
1388 If you set this to nil, efs will wait an arbitrary amount of time to get
|
|
|
1389 output.")
|
|
|
1390
|
|
|
1391 (defvar efs-make-backup-files efs-unix-host-types
|
|
|
1392 "*A list of operating systems for which efs will make Emacs backup files.
|
|
|
1393 The backup files are made on the remote host.
|
|
|
1394
|
|
|
1395 For example:
|
|
|
1396 '\(unix sysV-unix bsd-unix apollo-unix dumb-unix\) makes sense, but
|
|
|
1397 '\(unix vms\) would be silly, since vms makes its own backups.")
|
|
|
1398
|
|
|
1399 ;; Is this variable really useful? We should try to figure a way to
|
|
|
1400 ;; do local copies on a remote machine that doesn't take forever.
|
|
|
1401 (defvar efs-backup-by-copying nil
|
|
|
1402 "*Version of `backup by copying' for remote files.
|
|
|
1403 If non-nil, remote files will be backed up by copying, instead of by renaming.
|
|
|
1404 Note the copying will be done by moving the file through the local host -- a
|
|
|
1405 very time consuming operation.")
|
|
|
1406
|
|
|
1407 ;;; Auto-save variables. Relevant for auto-save.el
|
|
|
1408
|
|
|
1409 (defvar efs-auto-save 0
|
|
|
1410 "*If 1, allows efs files to be auto-saved.
|
|
|
1411 If 0, suppresses auto-saving of efs files.
|
|
|
1412 Don't use any other value.")
|
|
|
1413
|
|
|
1414 (defvar efs-auto-save-remotely nil
|
|
|
1415 "*Determines where remote files are auto-saved.
|
|
|
1416
|
|
|
1417 If nil, auto-saves for remote files will be written in `auto-save-directory'
|
|
|
1418 or `auto-save-directory-fallback' if this isn't defined.
|
|
|
1419
|
|
|
1420 If non-nil, causes the auto-save file for an efs file to be written in
|
|
|
1421 the remote directory containing the file, rather than in a local directory.
|
|
|
1422 For remote files, this overrides a non-nil `auto-save-directory'. Local files
|
|
|
1423 are unaffected. If you want to use this feature, you probably only want to
|
|
|
1424 set this true in a few buffers, rather than globally. You might want to give
|
|
|
1425 each buffer its own value using `make-variable-buffer-local'. It is usually
|
|
|
1426 a good idea to auto-save remote files locally, because it is not only faster,
|
|
|
1427 but provides protection against a connection going down.
|
|
|
1428
|
|
|
1429 See also variable `efs-auto-save'.")
|
|
|
1430
|
|
|
1431 (defvar efs-short-circuit-to-remote-root nil
|
|
|
1432 "*Defines whether \"//\" short-circuits to the remote or local root.")
|
|
|
1433
|
|
|
1434 ;; Can we somehow grok this from system type? No.
|
|
|
1435 (defvar efs-local-apollo-unix
|
|
|
1436 (eq 0 (string-match "//" (or (getenv "HOME") (getenv "SHELL") "")))
|
|
|
1437 "*Defines whether the local machine is an apollo running Domain.
|
|
|
1438 This variable has nothing to do with efs, and should be basic to all
|
|
|
1439 of emacs.")
|
|
|
1440
|
|
|
1441 (defvar efs-root-umask nil
|
|
|
1442 "*umask to use for root logins.")
|
|
|
1443
|
|
|
1444 (defvar efs-anonymous-umask nil
|
|
|
1445 "*umask to use for anonymous logins.")
|
|
|
1446
|
|
|
1447 (defvar efs-umask nil
|
|
|
1448 "*umask to use for efs sessions.
|
|
|
1449 If this is nil, then the setting of umask on the local host is used.")
|
|
|
1450
|
|
|
1451 ;; Eliminate these variables when Sun gets around to getting its FTP server
|
|
|
1452 ;; out of the stone age.
|
|
|
1453 (defvar efs-ding-on-umask-failure t
|
|
|
1454 "*Ring the bell if the umask command fails on a unix host. Many servers don't
|
|
|
1455 support this command, so if you get a lot of annoying failures, set this
|
|
|
1456 to nil.")
|
|
|
1457
|
|
|
1458 (defvar efs-ding-on-chmod-failure t
|
|
|
1459 "*Ring the bell if the chmod command fails on a unix host. Some servers don't
|
|
|
1460 support this command, so if you get a lot of annoying failures, set this
|
|
|
1461 to nil.")
|
|
|
1462
|
|
|
1463 ;; Please let us know if you can contribute more entries to this guessing game.
|
|
|
1464 (defvar efs-nlist-cmd
|
|
|
1465 (cond
|
|
|
1466 ;; Covers Ultrix, SunOS, and NeXT.
|
|
|
1467 ((eq system-type 'berkeley-unix)
|
|
|
1468 "ls")
|
|
|
1469 ((memq system-type '(hpux aix-v3 silicon-graphics-unix))
|
|
|
1470 "nlist")
|
|
|
1471 ;; Blind guess
|
|
|
1472 ("ls"))
|
|
|
1473 "*FTP client command for getting a brief listing (NLST) from the FTP server.
|
|
|
1474 We try to guess this based on the local system-type, but obviously if you
|
|
|
1475 are using a gateway, you'll have to set it yourself.")
|
|
|
1476
|
|
|
1477 (defvar efs-compute-remote-buffer-file-truename nil
|
|
|
1478 "*If non-nil, `buffer-file-truename' will be computed for remote buffers.
|
|
|
1479 In emacs 19, each buffer has a local variable, `buffer-file-truename',
|
|
|
1480 which is used to ensure that symbolic links will not confuse emacs into
|
|
|
1481 visiting the same file with two buffers. This variable is computed by
|
|
|
1482 chasing all symbolic links in `buffer-file-name', both at the level of the
|
|
|
1483 file and at the level of all parent directories. Since this operation can be
|
|
|
1484 very time-consuming over FTP, this variable can be used to inhibit it.")
|
|
|
1485
|
|
|
1486 (defvar efs-buffer-name-case nil
|
|
|
1487 "*Selects the case used for buffer names of case-insensitive file names.
|
|
|
1488 Case-insensitive file names are files on hosts whose host type is in
|
|
|
1489 `efs-case-insensitive-host-types'.
|
|
|
1490
|
|
|
1491 If this is 'up upper case is used, if it is 'down lower case is used.
|
|
|
1492 If this has any other value, the case is inherited from the name used
|
|
|
1493 to access the file.")
|
|
|
1494
|
|
|
1495 (defvar efs-fancy-buffer-names "%s@%s"
|
|
|
1496 "Format used to compute names of buffers attached to remote files.
|
|
|
1497
|
|
|
1498 If this is nil, buffer names are computed in the usual way.
|
|
|
1499
|
|
|
1500 If it is a string, then the it is passed to format with second and third
|
|
|
1501 arguments the host name and file name.
|
|
|
1502
|
|
|
1503 Otherwise, it is assumed to be function taking three arguments, the host name,
|
|
|
1504 the user name, and the truncated file name. It should returns the name to
|
|
|
1505 be used for the buffer.")
|
|
|
1506
|
|
|
1507 (defvar efs-verify-anonymous-modtime nil
|
|
|
1508 "*Determines if efs checks modtimes for remote files on anonymous logins.
|
|
|
1509 If non-nil, efs runs `verify-visited-file-modtime' for remote files on
|
|
|
1510 anonymous ftp logins. Since verify-visited-file-modtime slows things down,
|
|
|
1511 and most people aren't editing files on anonymous ftp logins, this is nil
|
|
|
1512 by default.")
|
|
|
1513
|
|
|
1514 (defvar efs-verify-modtime-host-regexp ".*"
|
|
|
1515 "*Regexp to match host names for which efs checks file modtimes.
|
|
|
1516 If non-nil, efs will run `verify-visited-file-modtime' for remote
|
|
|
1517 files on hosts matching this regexp. If nil, verify-visited-file-modtime
|
|
|
1518 is supressed for all remote hosts. This is tested before
|
|
|
1519 `efs-verify-anonymous-modtime'.")
|
|
|
1520
|
|
|
1521 (defvar efs-maximize-idle nil
|
|
|
1522 "*If non-nil, efs will attempt to maximize the idle time out period.
|
|
|
1523 At some idle moment in the connection after login, efs will attempt to
|
|
|
1524 set the idle time out period to the maximum amount allowed by the server.
|
|
|
1525 It applies only to non-anonymous logins on unix hosts.")
|
|
|
1526
|
|
|
1527 (defvar efs-expire-ftp-buffers t
|
|
|
1528 "*If non-nil ftp buffers will be expired.
|
|
|
1529 The buffers will be killed either after `efs-ftp-buffer-expire-time' has
|
|
|
1530 elapsed with no activity, or the remote FTP server has timed out.")
|
|
|
1531
|
|
|
1532 (defvar efs-ftp-buffer-expire-time nil
|
|
|
1533 "*If non-nil, the time after which ftp buffers will be expired.
|
|
|
1534 If nil, ftp buffers will be expired only when the remote server has timed out.
|
|
|
1535 If an integer, ftp buffers will be expired either when the remote server
|
|
|
1536 has timed out, or when this many seconds on inactivity has elapsed.")
|
|
|
1537
|
|
|
1538 ;; If you need to increase this variable much, it is likely that
|
|
|
1539 ;; the true problem is timing errors between the efs process filter
|
|
|
1540 ;; and the FTP server. This could either be caused by the server
|
|
|
1541 ;; not following RFC959 response codes, or a bug in efs. In either
|
|
|
1542 ;; case please report the problem to us. If it's a bug, we'll fix it.
|
|
|
1543 ;; If the server is at fault we may try to do something. Our rule
|
|
|
1544 ;; of thumb is that we will support non-RFC959 behaviour, as long as
|
|
|
1545 ;; it doesn't risk breaking efs for servers which behave properly.
|
|
|
1546
|
|
|
1547 (defvar efs-retry-time 5
|
|
|
1548 "*Number of seconds to wait before retrying if data doesn't arrive.
|
|
|
1549 The FTP command isn't retried, rather efs just takes a second look
|
|
|
1550 for the data file. This might need to be increased for very slow FTP
|
|
|
1551 clients.")
|
|
|
1552
|
|
|
1553 (defvar efs-pty-check-threshold 1000
|
|
|
1554 "*How long efs waits before deciding that it doesn't have a pty.
|
|
|
1555 Specifically it is the number of iterations through `accept-process-output'
|
|
|
1556 that `efs-pty-p' waits before deciding that the pty is really a pipe.
|
|
|
1557 Set this to nil to inhibit checking for pty's. If efs seems to be
|
|
|
1558 mistaking some pty's for pipes, try increasing this number.")
|
|
|
1559
|
|
|
1560 (defvar efs-pty-check-retry-time 5
|
|
|
1561 "*Number of seconds that efs waits before retrying a pty check.
|
|
|
1562 This can be lengthened, if your FTP client is slow to start.")
|
|
|
1563
|
|
|
1564 (defvar efs-suppress-abort-recursive-edit-and-then nil
|
|
|
1565 "*If non-nil, `efs-abort-recursive-edit-and-then' will not run its function.
|
|
|
1566 This means that when a recursive edit is in progress, automatic popping of the
|
|
|
1567 FTP process buffer, and automatic popping of the bug report buffer will not
|
|
|
1568 work. `efs-abort-recursive-edit-and-then' works by forking a \"sleep 0\"
|
|
|
1569 process. On some unix implementations the forked process might be of the same
|
|
|
1570 size as the original GNU Emacs process. Forking such a large process just to
|
|
|
1571 do a \"sleep 0\" is probably not good.")
|
|
|
1572
|
|
|
1573 (defvar efs-ftp-buffer-format "*ftp %s@%s*"
|
|
|
1574 "Format to construct the name of FTP process buffers.
|
|
|
1575 This string is fed to `format' with second and third arguments the user
|
|
|
1576 name and host name.")
|
|
|
1577 ;; This does not affect the process name of the FTP client process.
|
|
|
1578 ;; That is always *ftp USER@HOST*
|
|
|
1579
|
|
|
1580 (defvar efs-debug-ftp-connection nil
|
|
|
1581 "*If non-nil, the user will be permitted to debug the FTP connection.
|
|
|
1582 This means that typing a C-g to the FTP process filter will give the user
|
|
|
1583 the option to type commands at the FTP connection. Normally, the connection
|
|
|
1584 is killed first. Note that doing this may result in the FTP process filter
|
|
|
1585 getting out of synch with the FTP client, so using this feature routinely
|
|
|
1586 isn't recommended.")
|
|
|
1587
|
|
|
1588 ;;; Hooks and crooks.
|
|
|
1589
|
|
|
1590 (defvar efs-ftp-startup-hook nil
|
|
|
1591 "Hook to run immediately after starting the FTP client.
|
|
|
1592 This hook is run before the FTP OPEN command is sent.")
|
|
|
1593
|
|
|
1594 (defvar efs-ftp-startup-function-alist nil
|
|
|
1595 "Association list of functions to running after FTP login.
|
|
|
1596 This should be an alist of the form '\(\(REGEXP . FUNCTION\) ...\), where
|
|
|
1597 REGEXP is a regular expression matched against the name of the remote host,
|
|
|
1598 and FUNCTION is a function of two arguments, HOST and USER. REGEXP is
|
|
|
1599 compared to the host name with `case-fold-search' bound to t. Only the first
|
|
|
1600 match in the alist is run.")
|
|
|
1601
|
|
|
1602 (defvar efs-load-hook nil
|
|
|
1603 "Hook to run immediately after loading efs.el.
|
|
|
1604 You can use it to alter definitions in efs.el, but why would you want
|
|
|
1605 to do such a thing?")
|
|
|
1606
|
|
|
1607 ;;;; -----------------------------------------------------------
|
|
|
1608 ;;;; Regexps for parsing FTP server responses.
|
|
|
1609 ;;;; -----------------------------------------------------------
|
|
|
1610 ;;;
|
|
|
1611 ;;; If you have to tune these variables, please let us know, so that
|
|
|
1612 ;;; we can get them right in the next release.
|
|
|
1613
|
|
|
1614 (defvar efs-multi-msgs
|
|
|
1615 ;; RFC959 compliant codes
|
|
|
1616 "^[1-5][0-5][0-7]-")
|
|
|
1617 ;; Regexp to match the start of an FTP server multiline reply.
|
|
|
1618
|
|
|
1619 (defvar efs-skip-msgs
|
|
|
1620 ;; RFC959 compliant codes
|
|
|
1621 (concat
|
|
|
1622 "^110 \\|" ; Restart marker reply.
|
|
|
1623 "^125 \\|" ; Data connection already open; transfer starting.
|
|
|
1624 "^150 ")) ; File status OK; about to open connection.
|
|
|
1625 ;; Regexp to match an FTP server response which we wish to ignore.
|
|
|
1626
|
|
|
1627 (defvar efs-cmd-ok-msgs
|
|
|
1628 ;; RFC959 compliant
|
|
|
1629 "^200 \\|^227 ")
|
|
|
1630 ;; Regexp to match the server command OK response.
|
|
|
1631 ;; Because PORT commands return this we usually ignore it. However, it is
|
|
|
1632 ;; a valid response for TYPE, SITE, and a few other commands (cf. RFC 959).
|
|
|
1633 ;; If we are explicitly sending a PORT, or one of these other commands,
|
|
|
1634 ;; then we don't want to ignore this response code. Also use this to match
|
|
|
1635 ;; the return code for PASV, as some clients burp these things out at odd
|
|
|
1636 ;; times.
|
|
|
1637
|
|
|
1638 (defvar efs-pending-msgs
|
|
|
1639 ;; RFC959 compliant
|
|
|
1640 "^350 ") ; Requested file action, pending further information.
|
|
|
1641 ;; Regexp to match the \"requested file action, pending further information\"
|
|
|
1642 ;; message. These are usually ignored, except if we are using RNFR to test for
|
|
|
1643 ;; file existence.
|
|
|
1644
|
|
|
1645 (defvar efs-cmd-ok-cmds
|
|
|
1646 (concat
|
|
|
1647 "^quote port \\|^type \\|^quote site \\|^chmod \\|^quote noop\\|"
|
|
|
1648 "^quote pasv"))
|
|
|
1649 ;; Regexp to match commands for which efs-cmd-ok-msgs is a valid server
|
|
|
1650 ;; response for success.
|
|
|
1651
|
|
|
1652 (defvar efs-passwd-cmds
|
|
|
1653 "^quote pass \\|^quote acct \\|^quote site gpass ")
|
|
|
1654 ;; Regexp to match commands for sending passwords.
|
|
|
1655 ;; All text following (match-end 0) will be replaced by "Turtle Power!"
|
|
|
1656
|
|
|
1657 (defvar efs-bytes-received-msgs
|
|
|
1658 ;; Strictly a client response
|
|
|
1659 "^[0-9]+ bytes ")
|
|
|
1660 ;; Regexp to match the reply from the FTP client that it has finished
|
|
|
1661 ;; receiving data.
|
|
|
1662
|
|
|
1663 (defvar efs-server-confused-msgs
|
|
|
1664 ;; ka9q uses this to indicate an incorrectly set transfer mode, and
|
|
|
1665 ;; then does send a second completion code for the command. This does
|
|
|
1666 ;; *not* conform to RFC959.
|
|
|
1667 "^100 Warning: type is ")
|
|
|
1668 ;; Regexp to match non-standard response from the FTP server. This can
|
|
|
1669 ;; sometimes be the result of an incorrectly set transfer mode. In this case
|
|
|
1670 ;; we do not rely on the server to tell us when the data transfer is complete,
|
|
|
1671 ;; but check with the client.
|
|
|
1672
|
|
|
1673 (defvar efs-good-msgs
|
|
|
1674 (concat
|
|
|
1675 ;; RFC959 compliant codes
|
|
|
1676 "^2[01345][0-7] \\|" ; 2yz = positive completion reply
|
|
|
1677 "^22[02-7] \\|" ; 221 = successful logout
|
|
|
1678 ; (Sometimes get this with a timeout,
|
|
|
1679 ; so treat as fatal.)
|
|
|
1680 "^3[0-5][0-7] \\|" ; 3yz = positive intermediate reply
|
|
|
1681 ;; client codes
|
|
|
1682 "^[Hh]ash mark "))
|
|
|
1683 ;; Response to indicate that the requested action was successfully completed.
|
|
|
1684
|
|
|
1685 (defvar efs-failed-msgs
|
|
|
1686 (concat
|
|
|
1687 ;; RFC959 compliant codes
|
|
|
1688 "^120 \\|" ; Service ready in nnn minutes.
|
|
|
1689 "^450 \\|" ; File action not taken; file is unavailable, or busy.
|
|
|
1690 "^452 \\|" ; Insufficient storage space on system.
|
|
|
1691 "^5[0-5][0-7] \\|" ; Permanent negative reply codes.
|
|
|
1692 ;; When clients tell us that a file doesn't exist, or can't access.
|
|
|
1693 "^\\(local: +\\)?/[^ ]* +"
|
|
|
1694 "\\([Nn]o such file or directory\\|[Nn]ot a plain file\\|"
|
|
|
1695 "The file access permissions do not allow \\|Is a directory\\b\\)"))
|
|
|
1696 ;; Regexp to match responses for failed commands. However, the ftp connection
|
|
|
1697 ;; is assumed to be good.
|
|
|
1698
|
|
|
1699 (defvar efs-fatal-msgs
|
|
|
1700 (concat
|
|
|
1701 ;; RFC959 codes
|
|
|
1702 "^221 \\|" ; Service closing control connection.
|
|
|
1703 "^421 \\|" ; Service not available.
|
|
|
1704 "^425 \\|" ; Can't open data connection.
|
|
|
1705 "^426 \\|" ; Connection closed, transfer aborted.
|
|
|
1706 "^451 \\|" ; Requested action aborted, local error in processing.
|
|
|
1707 ;; RFC959 non-compliant codes
|
|
|
1708 "^552 Maximum Idle Time Exceded\\.$\\|" ; Hellsoft server uses this to
|
|
|
1709 ; indicate a timeout. 552 is
|
|
|
1710 ; supposed to be used for exceeded
|
|
|
1711 ; storage allocation. Note that
|
|
|
1712 ; they also misspelled the error
|
|
|
1713 ; message.
|
|
|
1714 ;; client problems
|
|
|
1715 "^ftp: \\|^Not connected\\|^rcmd: \\|^No control connection\\|"
|
|
|
1716 "^unknown host\\|: unknown host$\\|^lost connection\\|"
|
|
|
1717 "^[Ss]egmentation fault\\|"
|
|
|
1718 ;; Make sure that the "local: " isn't just a message about a file.
|
|
|
1719 "^local: [^/]\\|"
|
|
|
1720 ;; Gateways
|
|
|
1721 "^iftp: cannot authenticate to server\\b"
|
|
|
1722 ))
|
|
|
1723 ;; Regexp to match responses that something has gone drastically wrong with
|
|
|
1724 ;; either the client, server, or connection. We kill the ftp process, and start
|
|
|
1725 ;; anew.
|
|
|
1726
|
|
|
1727 (defvar efs-unknown-response-msgs
|
|
|
1728 "^[0-9][0-9][0-9] ")
|
|
|
1729 ;; Regexp to match server response codes that we don't understand. This
|
|
|
1730 ;; is tested after all the other regexp, so it can match everything.
|
|
|
1731
|
|
|
1732 (defvar efs-pasv-msgs
|
|
|
1733 ;; According to RFC959.
|
|
|
1734 "^227 .*(\\([0-9]+,[0-9]+,[0-9]+,[0-9]+,[0-9]+,[0-9]+\\))$")
|
|
|
1735 ;; Matches the output of a PASV. (match-beginning 1) and (match-end 1)
|
|
|
1736 ;; must bracket the IP address and port.
|
|
|
1737
|
|
|
1738 (defvar efs-syst-msgs "^215 \\|^210 ")
|
|
|
1739 ;; 215 is RFC959. Plan 9 FTP server returns a 210. 210 is not assigned in
|
|
|
1740 ;; RFC 959.
|
|
|
1741 ;; The plan 9 people tell me that they fixed this. -- sr 18/4/94
|
|
|
1742 ;; Matches the output of a SYST.
|
|
|
1743
|
|
|
1744 (defvar efs-mdtm-msgs
|
|
|
1745 (concat
|
|
|
1746 "^213 [0-9][0-9][0-9][0-9][0-9][0-9][0-9]"
|
|
|
1747 "[0-9][0-9][0-9][0-9][0-9][0-9][0-9]$"))
|
|
|
1748 ;; Regexp to match the output of a quote mdtm command.
|
|
|
1749
|
|
|
1750 (defvar efs-idle-msgs
|
|
|
1751 "^200 [^0-9]+ \\([0-9]+\\)[^0-9]* max \\([0-9]+\\)")
|
|
|
1752 ;; Regexp to match the output of a SITE IDLE command.
|
|
|
1753 ;; Match 1 should refer to the current idle time, and match 2 the maximum
|
|
|
1754 ;; idle time.
|
|
|
1755
|
|
|
1756 (defvar efs-write-protect-msgs "^532 ") ; RFC959
|
|
|
1757 ;; Regexp to match a server ressponse to indicate that a STOR failed
|
|
|
1758 ;; because of insufficient write privileges.
|
|
|
1759
|
|
|
1760 (defvar efs-hash-mark-msgs
|
|
|
1761 "[hH]ash mark [^0-9]*\\([0-9]+\\)")
|
|
|
1762 ;; Regexp matching the FTP client's output upon doing a HASH command.
|
|
|
1763
|
|
|
1764 (defvar efs-xfer-size-msgs
|
|
|
1765 (concat
|
|
|
1766 ;; UN*X
|
|
|
1767 "^150 .* connection for .* (\\([0-9]+\\) bytes)\\|"
|
|
|
1768 ;; Wollongong VMS server.
|
|
|
1769 "^125 .* transfer started for .* (\\([0-9]+\\) bytes)\\|"
|
|
|
1770 ;; TOPS-20 server
|
|
|
1771 "^150 .* retrieve of .* ([0-9]+ pages?, \\([0-9]+\\) 7-bit bytes)"))
|
|
|
1772 ;; Regular expression used to determine the number of bytes
|
|
|
1773 ;; in a FTP transfer. The first (match-beginning #) which is non-nil is assumed
|
|
|
1774 ;; to give the size.
|
|
|
1775
|
|
|
1776 (defvar efs-expand-dir-msgs "^550 \\([^: ]+\\):")
|
|
|
1777 ;; Regexp to match the error response from a "get ~sandy".
|
|
|
1778 ;; By parsing the error, we can get a quick expansion of ~sandy
|
|
|
1779 ;; According to RFC 959, should be a 550.
|
|
|
1780
|
|
|
1781 (defvar efs-gateway-fatal-msgs
|
|
|
1782 "No route to host\\|Connection closed\\|No such host\\|Login incorrect")
|
|
|
1783 ;; Regular expression matching messages from the rlogin / telnet process that
|
|
|
1784 ;; indicates that logging in to the gateway machine has gone wrong.
|
|
|
1785
|
|
|
1786 (defvar efs-too-many-users-msgs
|
|
|
1787 ;; The test for "two many" is because some people can't spell.
|
|
|
1788 ;; I allow for up to two adjectives before "users".
|
|
|
1789 (concat
|
|
|
1790 "\\b[Tt][wo]o many\\( +[^ \n]+\\)?\\( +[^ \n]+\\)? +users\\b\\|"
|
|
|
1791 "\\btry back later\\b"))
|
|
|
1792 ;; Regular expresion to match what servers output when there are too many
|
|
|
1793 ;; anonymous logins. It is assumed that this is part of a 530 or 530- response
|
|
|
1794 ;; to USER or PASS.
|
|
|
1795
|
|
|
1796 ;;;; -------------------------------------------------------------
|
|
|
1797 ;;;; Buffer local FTP process variables
|
|
|
1798 ;;;; -------------------------------------------------------------
|
|
|
1799
|
|
|
1800 ;;; Variables buffer local to the process buffers are
|
|
|
1801 ;;; named with the prefix efs-process-
|
|
|
1802
|
|
|
1803 (defvar efs-process-q nil)
|
|
|
1804 ;; List of functions to be performed asynch.
|
|
|
1805 (make-variable-buffer-local 'efs-process-q)
|
|
|
1806
|
|
|
1807 (defvar efs-process-cmd-waiting nil)
|
|
|
1808 ;; Set to t if a process has a synchronous cmd waiting to execute.
|
|
|
1809 ;; In this case, it will allow the synch. cmd to run before returning to
|
|
|
1810 ;; the cmd queue.
|
|
|
1811 (make-variable-buffer-local 'efs-process-cmd-waiting)
|
|
|
1812
|
|
|
1813 (defvar efs-process-server-confused nil)
|
|
|
1814 (make-variable-buffer-local 'efs-process-server-confused)
|
|
|
1815
|
|
|
1816 (defvar efs-process-cmd nil)
|
|
|
1817 ;; The command currently being executed, as a string.
|
|
|
1818 (make-variable-buffer-local 'efs-process-cmd)
|
|
|
1819
|
|
|
1820 (defvar efs-process-xfer-size 0)
|
|
|
1821 (make-variable-buffer-local 'efs-process-xfer-size)
|
|
|
1822
|
|
|
1823 (defvar efs-process-umask nil)
|
|
|
1824 ;; nil if the umask hash not been set
|
|
|
1825 ;; an integer (the umask) if the umask has been set
|
|
|
1826 (make-variable-buffer-local 'efs-process-umask)
|
|
|
1827
|
|
|
1828 (defvar efs-process-idle-time nil)
|
|
|
1829 ;; If non-nil, the idle time of the server in seconds.
|
|
|
1830 (make-variable-buffer-local 'efs-process-idle-time)
|
|
|
1831
|
|
|
1832 (defvar efs-process-busy nil)
|
|
|
1833 (make-variable-buffer-local 'efs-process-busy)
|
|
|
1834
|
|
|
1835 (defvar efs-process-result-line "")
|
|
|
1836 (make-variable-buffer-local 'efs-process-result-line)
|
|
|
1837
|
|
|
1838 (defvar efs-process-result nil)
|
|
|
1839 (make-variable-buffer-local 'efs-process-result)
|
|
|
1840
|
|
|
1841 (defvar efs-process-result-cont-lines "")
|
|
|
1842 (make-variable-buffer-local 'efs-process-result-cont-lines)
|
|
|
1843
|
|
|
1844 (defvar efs-process-msg "")
|
|
|
1845 (make-variable-buffer-local 'efs-process-msg)
|
|
|
1846
|
|
|
1847 (defvar efs-process-nowait nil)
|
|
|
1848 (make-variable-buffer-local 'efs-process-nowait)
|
|
|
1849
|
|
|
1850 (defvar efs-process-string "")
|
|
|
1851 (make-variable-buffer-local 'efs-process-string)
|
|
|
1852
|
|
|
1853 (defvar efs-process-continue nil)
|
|
|
1854 (make-variable-buffer-local 'efs-process-continue)
|
|
|
1855
|
|
|
1856 (defvar efs-process-hash-mark-count 0)
|
|
|
1857 (make-variable-buffer-local 'efs-process-hash-mark-count)
|
|
|
1858
|
|
|
1859 (defvar efs-process-hash-mark-unit nil)
|
|
|
1860 (make-variable-buffer-local 'efs-process-hash-mark-unit)
|
|
|
1861
|
|
|
1862 (defvar efs-process-last-percent -1)
|
|
|
1863 (make-variable-buffer-local 'efs-process-last-percent)
|
|
|
1864
|
|
|
1865 (defvar efs-process-host nil)
|
|
|
1866 (make-variable-buffer-local 'efs-process-host)
|
|
|
1867
|
|
|
1868 (defvar efs-process-user nil)
|
|
|
1869 (make-variable-buffer-local 'efs-process-user)
|
|
|
1870
|
|
|
1871 (defvar efs-process-host-type nil)
|
|
|
1872 ;; Holds the host-type as a string, for showing it on the mode line.
|
|
|
1873 (make-variable-buffer-local 'efs-process-host-type)
|
|
|
1874
|
|
|
1875 (defvar efs-process-xfer-type nil)
|
|
|
1876 ;; Set to one of 'ascii, 'ebcdic, 'image, 'tenex, or nil to indicate
|
|
|
1877 ;; the current setting of the transfer type for the connection. nil means
|
|
|
1878 ;; that we don't know.
|
|
|
1879 (make-variable-buffer-local 'efs-process-xfer-type)
|
|
|
1880
|
|
|
1881 (defvar efs-process-client-altered-xfer-type nil)
|
|
|
1882 ;; Sometimes clients alter the xfer type, such as doing
|
|
|
1883 ;; an ls it is changed to ascii. If we are using quoted commands
|
|
|
1884 ;; to do xfers the client doesn't get a chance to set it back.
|
|
|
1885 (make-variable-buffer-local 'efs-process-client-altered-xfer-type)
|
|
|
1886
|
|
|
1887 (defvar efs-process-prompt-regexp nil)
|
|
|
1888 ;; local value of prompt of FTP client.
|
|
|
1889 (make-variable-buffer-local 'efs-process-prompt-regexp)
|
|
|
1890
|
|
|
1891 (defvar efs-process-cmd-counter 0)
|
|
|
1892 ;; Counts FTP commands, mod 16.
|
|
|
1893 (make-variable-buffer-local 'efs-process-cmd-counter)
|
|
|
1894
|
|
|
1895 ;;;; ------------------------------------------------------------
|
|
|
1896 ;;;; General Internal Variables.
|
|
|
1897 ;;;; ------------------------------------------------------------
|
|
|
1898
|
|
|
1899 ;;; For the byte compiler
|
|
|
1900 ;;
|
|
|
1901 ;; These variables are usually unbound. We are just notifying the
|
|
|
1902 ;; byte compiler that we know what we are doing.
|
|
|
1903
|
|
|
1904 (defvar bv-length) ; getting file versions.
|
|
|
1905 (defvar default-file-name-handler-alist) ; for file-name-handler-alist
|
|
|
1906 (defvar efs-completion-dir) ; for file name completion predicates
|
|
|
1907 (defvar dired-directory) ; for default actions in interactive specs
|
|
|
1908 (defvar dired-local-variables-file) ; for inhibiting child look ups
|
|
|
1909 (defvar dired-in-query) ; don't clobber dired queries with stat messages
|
|
|
1910 (defvar after-load-alist) ; in case we're in emacs 18.
|
|
|
1911 (defvar comint-last-input-start)
|
|
|
1912 (defvar comint-last-input-end)
|
|
|
1913 (defvar explicit-shell-file-name)
|
|
|
1914
|
|
|
1915 ;;; fluid vars
|
|
|
1916
|
|
|
1917 (defvar efs-allow-child-lookup t)
|
|
|
1918 ;; let-bind to nil, if want to inhibit child lookups.
|
|
|
1919
|
|
|
1920 (defvar efs-nested-cmd nil)
|
|
|
1921 ;; let-bound to t, when a cmd is executed by a cont or pre-cont.
|
|
|
1922 ;; Such cmds will never end by looking at the next item in the queue,
|
|
|
1923 ;; if they are run synchronously, but rely on their calling function
|
|
|
1924 ;; to do this.
|
|
|
1925
|
|
|
1926 ;;; polling ftp buffers
|
|
|
1927
|
|
|
1928 (defvar efs-ftp-buffer-poll-time 300
|
|
|
1929 "Period, in seconds, which efs will poll ftp buffers for activity.
|
|
|
1930 Used for expiring \(killing\) inactive ftp buffers.")
|
|
|
1931
|
|
|
1932 (defconst efs-ftp-buffer-alist nil)
|
|
|
1933 ;; alist of ftp buffers, and the total number of seconds that they
|
|
|
1934 ;; have been idle.
|
|
|
1935
|
|
|
1936 ;;; load extensions
|
|
|
1937
|
|
|
1938 (defvar efs-load-lisp-extensions '(".elc" ".el" "")
|
|
|
1939 "List of extensions to try when loading lisp files.")
|
|
|
1940
|
|
|
1941 ;;; mode-line
|
|
|
1942
|
|
|
1943 (defvar efs-mode-line-string "")
|
|
|
1944 ;; Stores the string that efs displays on the mode line.
|
|
|
1945
|
|
|
1946 ;;; data & temporary buffers
|
|
|
1947
|
|
|
1948 (defvar efs-data-buffer-name " *ftp data*")
|
|
|
1949 ;; Buffer name to hold directory listing data received from ftp process.
|
|
|
1950
|
|
|
1951 (defvar efs-data-buffer-name-2 " *ftp data-2*")
|
|
|
1952 ;; A second buffer name in which to hold directory listings.
|
|
|
1953 ;; Used for listings which are made during another directory listing.
|
|
|
1954
|
|
|
1955 ;;; process names
|
|
|
1956
|
|
|
1957 (defvar efs-ctime-process-name-format "*efs ctime %s*")
|
|
|
1958 ;; Passed to format with second arg the host name.
|
|
|
1959
|
|
|
1960 ;;; For temporary files.
|
|
|
1961
|
|
|
1962 ;; This is a list of symbols.
|
|
|
1963 (defconst efs-tmp-name-files ())
|
|
|
1964 ;; Here is where these symbols live:
|
|
|
1965 (defconst efs-tmp-name-obarray (make-vector 7 0))
|
|
|
1966 ;; We put our version of the emacs PID here:
|
|
|
1967 (defvar efs-pid nil)
|
|
|
1968
|
|
|
1969 ;;; For abort-recursive-edit
|
|
|
1970
|
|
|
1971 (defvar efs-abort-recursive-edit-data nil)
|
|
|
1972 (defvar efs-abort-recursive-edit-delay 5)
|
|
|
1973 ;; Number of seconds after which efs-abort-recursive-edit-and-then
|
|
|
1974 ;; will decide not to runs its sentinel. The assumption is that something
|
|
|
1975 ;; went wrong.
|
|
|
1976
|
|
|
1977 ;;; hashtables (Use defconst's to clobber any user silliness.)
|
|
|
1978
|
|
|
1979 (defconst efs-files-hashtable (efs-make-hashtable 97))
|
|
|
1980 ;; Hash table for storing directories and their respective files.
|
|
|
1981
|
|
|
1982 (defconst efs-expand-dir-hashtable (efs-make-hashtable))
|
|
|
1983 ;; Hash table of tilde expansions for remote directories.
|
|
|
1984
|
|
|
1985 (defconst efs-ls-converter-hashtable (efs-make-hashtable 37))
|
|
|
1986 ;; Hashtable for storing functions to convert listings from one
|
|
|
1987 ;; format to another. Keys are the required switches, and the values
|
|
|
1988 ;; are alist of the form ((SWITCHES . CONVERTER)...) where is SWITCHES
|
|
|
1989 ;; are the listing switches for the original listing, and CONVERTER is a
|
|
|
1990 ;; function of one-variable, the listing-type, to do the conversion
|
|
|
1991 ;; on data in the current buffer. SWITCHES is either a string, or nil.
|
|
|
1992 ;; nil means that the listing can be converted from cache in
|
|
|
1993 ;; efs-files-hashtable, a string from cache in efs-ls-cache. For the latter,
|
|
|
1994 ;; listings with no switches (dumb listings), represent SWITCHES as a string
|
|
|
1995 ;; consisting only of the ASCII null character.
|
|
|
1996
|
|
|
1997 ;;; cache variables (Use defconst's to clobber any user sillines.)
|
|
|
1998
|
|
|
1999 (defconst efs-ls-cache nil
|
|
|
2000 "List of results from efs-ls.
|
|
|
2001 Each entry is a list of four elements, the file listed, the switches used
|
|
|
2002 \(nil if none\), the listing string, and whether this string has already been
|
|
|
2003 parsed.")
|
|
|
2004
|
|
|
2005 (defvar efs-ls-uncache nil)
|
|
|
2006 ;; let-bind this to t, if you want to be sure that efs-ls will replace any
|
|
|
2007 ;; cache entries.
|
|
|
2008
|
|
|
2009 ;; This is a cache to see if the user has changed
|
|
|
2010 ;; completion-ignored-extensions.
|
|
|
2011 (defconst efs-completion-ignored-extensions completion-ignored-extensions
|
|
|
2012 "This variable is internal to efs. Do not set.
|
|
|
2013 See completion-ignored-extensions, instead.")
|
|
|
2014
|
|
|
2015 ;; We cache the regexp we use for completion-ignored-extensions. This
|
|
|
2016 ;; saves building a string every time we do completion. String construction
|
|
|
2017 ;; is costly in emacs.
|
|
|
2018 (defconst efs-completion-ignored-pattern
|
|
|
2019 (mapconcat (function
|
|
|
2020 (lambda (s) (if (stringp s)
|
|
|
2021 (concat (regexp-quote s) "$")
|
|
|
2022 "/"))) ; / never in filename
|
|
|
2023 efs-completion-ignored-extensions
|
|
|
2024 "\\|")
|
|
|
2025 "This variable is internal to efs. Do not set.
|
|
|
2026 See completion-ignored-extensions, instead.")
|
|
|
2027
|
|
|
2028 (defvar efs-system-fqdn nil
|
|
|
2029 "Cached value of the local systems' fully qualified domain name.")
|
|
|
2030
|
|
|
2031 ;;; The file-type-alist
|
|
|
2032
|
|
|
2033 ;; efs-file-type-alist is an alist indexed by host-type
|
|
|
2034 ;; which stores data on how files are structured on the given
|
|
|
2035 ;; host-type. Each entry is a list of three elements. The first is the
|
|
|
2036 ;; definition of a `byte', the second the native character representation,
|
|
|
2037 ;; and the third, the file structure.
|
|
|
2038 ;;
|
|
|
2039 ;; Meanings of the symbols:
|
|
|
2040 ;; ------------------------
|
|
|
2041 ;; The byte symbols:
|
|
|
2042 ;; 8-bit = bytes of 8-bits
|
|
|
2043 ;; 36-bit-wa = 36-bit word aligned. Precisely, the addressing unit is that
|
|
|
2044 ;; of a PDP-10 using the "<440700,,0> byte pointer".
|
|
|
2045 ;;
|
|
|
2046 ;; The native character set symbols:
|
|
|
2047 ;; 8-ascii = 8-bit NVT-ASCII
|
|
|
2048 ;; 7-ascii = 7-bit ascii as on a PDP-10
|
|
|
2049 ;; ebcdic = EBCDIC as on an IBM mainframe
|
|
|
2050 ;; lispm = the native character set on a lispm (Symbolics and LMI)
|
|
|
2051 ;; mts = native character representation in the Michigan Terminal System
|
|
|
2052 ;; (which runs on IBM and Amdal mainframes), similar to ebcdic
|
|
|
2053 ;;
|
|
|
2054 ;; The file structure symbols:
|
|
|
2055 ;;
|
|
|
2056 ;; file-nl = data is stored as a contiguous sequence of data bytes
|
|
|
2057 ;; with EOL denoted by <NL>.
|
|
|
2058 ;; file-crlf = data is stored as a contiguous sequence of data bytes
|
|
|
2059 ;; with EOL denoted by <CR-LF>
|
|
|
2060 ;; record = data is stored as a sequence of records
|
|
|
2061 ;; file-lispm = data as stored on a lispm. i.e. a sequence of bits
|
|
|
2062 ;; with EOL denoted by character code 138 (?)
|
|
|
2063 ;;
|
|
|
2064 ;; If we've messed anything up here, please let us know.
|
|
|
2065
|
|
|
2066 (defvar efs-file-type-alist
|
|
|
2067 '((unix . (8-bit 8-ascii file-nl))
|
|
|
2068 (sysV-unix . (8-bit 8-ascii file-nl))
|
|
|
2069 (bsd-unix . (8-bit 8-ascii file-nl))
|
|
|
2070 (apollo-unix . (8-bit 8-ascii file-nl))
|
|
|
2071 (dumb-apollo-unix . (8-bit 8-ascii file-nl))
|
|
|
2072 (dumb-unix . (8-bit 8-ascii file-nl))
|
|
|
2073 (super-dumb-unix . (8-bit 8-ascii file-nl))
|
|
|
2074 (guardian . (8-bit ascii file-nl))
|
|
|
2075 (plan9 . (8-bit 8-ascii file-nl))
|
|
|
2076 (dos . (8-bit 8-ascii file-crlf))
|
|
|
2077 (ms-unix . (8-bit 8-ascii file-crlf))
|
|
|
2078 (netware . (8-bit 8-ascii file-crlf))
|
|
|
2079 (os2 . (8-bit 8-ascii file-crlf))
|
|
|
2080 (tops-20 . (36-bit-wa 7-ascii file-crlf))
|
|
|
2081 (mpe . (8-bit 8-ascii record))
|
|
|
2082 (mvs . (8-bit ebcdic record))
|
|
|
2083 (cms . (8-bit ebcdic record))
|
|
|
2084 (cms-knet . (8-bit ebcdic record))
|
|
|
2085 (mts . (8-bit mts record)) ; mts seems to have its own char rep.
|
|
|
2086 ; Seems to be close to ebcdic, but not the same.
|
|
|
2087 (dos-distinct . (8-bit 8-ascii file-crlf))
|
|
|
2088 (ka9q . (8-bit 8-ascii file-crlf))
|
|
|
2089 (vms . (8-bit 8-ascii record)) ; The mysteries of VMS's RMS.
|
|
|
2090 (hell . (8-bit 8-ascii file-crlf))
|
|
|
2091 (vos . (8-bit 8-ascii record))
|
|
|
2092 (ti-explorer . (8-bit lispm file-lispm)) ; lispms use a file structure, but
|
|
|
2093 ; use an out of range char to
|
|
|
2094 ; indicate EOL.
|
|
|
2095 (ti-twenex . (8-bit lispm file-lispm))
|
|
|
2096 (nos-ve . (8-bit 8-ascii record))
|
|
|
2097 (coke . (8-bit 8-ascii file-nl)) ; only support 8-bit beverages
|
|
|
2098 (nil . (8-bit 8-ascii file-nl)))) ; the local host
|
|
|
2099
|
|
|
2100 ;;; Status messages
|
|
|
2101
|
|
|
2102 (defvar efs-last-message-time -86400) ; yesterday
|
|
|
2103 ;; The time of the last efs status message. c.f. efs-message-interval
|
|
|
2104
|
|
|
2105 ;;; For handling dir listings
|
|
|
2106
|
|
|
2107 ;; This MUST match all the way to to the start of the filename.
|
|
|
2108 ;; This version corresponds to what dired now uses (sandy, 14.1.93)
|
|
|
2109 (defvar efs-month-and-time-regexp
|
|
|
2110 (concat
|
|
|
2111 " \\([0-9]+\\) +" ; file size
|
|
|
2112 "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|June?\\|July?\\|Aug\\|Sep\\|Oct"
|
|
|
2113 ; June and July are for HP-UX 9.0
|
|
|
2114 "\\|Nov\\|Dec\\) \\([ 0-3][0-9]\\)\\("
|
|
|
2115 " [012][0-9]:[0-6][0-9] \\|" ; time
|
|
|
2116 " [12][90][0-9][0-9] \\|" ; year on IRIX, NeXT, SunOS, ULTRIX, Apollo
|
|
|
2117 ; HP-UX, A/UX
|
|
|
2118 " [12][90][0-9][0-9] \\)" ; year on AIX
|
|
|
2119 ))
|
|
|
2120
|
|
|
2121 (defvar efs-month-alist
|
|
|
2122 '(("Jan" . 1) ("Feb". 2) ("Mar" . 3) ("Apr" . 4) ("May" . 5) ("Jun" . 6)
|
|
|
2123 ("June" . 6) ("Jul" . 7) ("July" . 7) ("Aug" . 8) ("Sep" . 9) ("Oct" . 10)
|
|
|
2124 ("Nov" . 11) ("Dec" . 12)))
|
|
|
2125
|
|
|
2126 ;; Matches the file modes, link number, and owner string.
|
|
|
2127 ;; The +/- is for extended file access permissions.
|
|
|
2128 (defvar efs-modes-links-owner-regexp
|
|
|
2129 (concat
|
|
|
2130 "\\([^ ][-r][-w][^ ][-r][-w][^ ][-r][-w][^ ]\\)[-+]? *\\([0-9]+\\)"
|
|
|
2131 " +\\([^ ]+\\) "))
|
|
|
2132
|
|
|
2133 ;;;; ---------------------------------------------------------------
|
|
|
2134 ;;;; efs-dired variables
|
|
|
2135 ;;;; ---------------------------------------------------------------
|
|
|
2136
|
|
|
2137 ;; These variables must be here, instead of in efs-dired.el, because
|
|
|
2138 ;; the efs-HOST-TYPE.el files need to add to it.
|
|
|
2139 (defvar efs-dired-re-exe-alist nil
|
|
|
2140 "Association list of regexps which match file lines of executable files.")
|
|
|
2141
|
|
|
2142 (defvar efs-dired-re-dir-alist nil
|
|
|
2143 "Association list of regexps which match file lines of subdirectories.")
|
|
|
2144
|
|
|
2145 (defvar efs-dired-host-type nil
|
|
|
2146 "Host type of a dired buffer. \(buffer local\)")
|
|
|
2147 (make-variable-buffer-local 'efs-dired-host-type)
|
|
|
2148
|
|
|
2149 (defvar efs-dired-listing-type nil
|
|
|
2150 "Listing type of a dired buffer. \(buffer local\)")
|
|
|
2151 (make-variable-buffer-local 'efs-dired-listing-type)
|
|
|
2152
|
|
|
2153 (defvar efs-dired-listing-type-string nil)
|
|
|
2154 (make-variable-buffer-local 'efs-dired-listing-type-string)
|
|
|
2155
|
|
|
2156 ;;;; -------------------------------------------------------------
|
|
|
2157 ;;;; New error symbols.
|
|
|
2158 ;;;; -------------------------------------------------------------
|
|
|
2159
|
|
|
2160 (put 'ftp-error 'error-conditions '(ftp-error file-error error))
|
|
|
2161 ;; (put 'ftp-error 'error-message "FTP error")
|
|
|
2162
|
|
|
2163
|
|
|
2164 ;;;; =============================================================
|
|
|
2165 ;;;; >3
|
|
|
2166 ;;;; Utilities
|
|
|
2167 ;;;; =============================================================
|
|
|
2168
|
|
|
2169 ;;; -------------------------------------------------------------------
|
|
|
2170 ;;; General Macros (Make sure that macros are defined before they're
|
|
|
2171 ;;; used, for the byte compiler.
|
|
|
2172 ;;; -------------------------------------------------------------------
|
|
|
2173
|
|
|
2174 (defmacro efs-kbd-quit-protect (proc &rest body)
|
|
|
2175 ;; When an efs function controlling an FTP connection gets a kbd-quit
|
|
|
2176 ;; this tries to make sure that everything unwinds consistently.
|
|
|
2177 (let ((temp (make-symbol "continue")))
|
|
|
2178 (list 'let
|
|
|
2179 (list '(quit-flag nil)
|
|
|
2180 '(inhibit-quit nil)
|
|
|
2181 (list temp t))
|
|
|
2182 (list
|
|
|
2183 'while temp
|
|
|
2184 (list 'setq temp nil)
|
|
|
2185 (list
|
|
|
2186 'condition-case nil
|
|
|
2187 (cons 'progn
|
|
|
2188 body)
|
|
|
2189 (list 'quit
|
|
|
2190 (list 'setq temp
|
|
|
2191 (list 'efs-kbd-quit-protect-cover-quit proc))))))))
|
|
|
2192
|
|
|
2193 (defun efs-kbd-quit-protect-cover-quit (proc)
|
|
|
2194 ;; This function exists to keep the macro expansion of the
|
|
|
2195 ;; efs-kbd-quit-protect down to a reasonable size.
|
|
|
2196 (let ((pop-up-windows t)
|
|
|
2197 (buff (get-buffer (process-buffer proc)))
|
|
|
2198 res)
|
|
|
2199 (if (save-window-excursion
|
|
|
2200 (if buff
|
|
|
2201 (progn
|
|
|
2202 (pop-to-buffer buff)
|
|
|
2203 (goto-char (point-max))
|
|
|
2204 (recenter (- (window-height)
|
|
|
2205 2))))
|
|
|
2206 (setq res (efs-kill-ftp-buffer-with-prompt proc buff)))
|
|
|
2207 (progn
|
|
|
2208 (if (eq res 0)
|
|
|
2209 (if (eq (selected-window)
|
|
|
2210 (minibuffer-window))
|
|
|
2211 (efs-abort-recursive-edit-and-then
|
|
|
2212 (function
|
|
|
2213 (lambda (buff)
|
|
|
2214 (if (get-buffer buff)
|
|
|
2215 (display-buffer buff))))
|
|
|
2216 buff)
|
|
|
2217 (if (get-buffer buff)
|
|
|
2218 (display-buffer buff))
|
|
|
2219 (signal 'quit nil))
|
|
|
2220 (if (eq (selected-window) (minibuffer-window))
|
|
|
2221 (abort-recursive-edit)
|
|
|
2222 (signal (quote quit) nil)))
|
|
|
2223 nil)
|
|
|
2224 (sit-for 0)
|
|
|
2225 (message "Waiting on %s..." (or (car (efs-parse-proc-name proc))
|
|
|
2226 "a whim"))
|
|
|
2227 t)))
|
|
|
2228
|
|
|
2229 (put 'efs-kbd-quit-protect 'lisp-indent-hook 1)
|
|
|
2230
|
|
|
2231 (defmacro efs-save-buffer-excursion (&rest forms)
|
|
|
2232 "Execute FORMS, restoring the current buffer afterwards.
|
|
|
2233 Unlike, save-excursion, this does not restore the point."
|
|
|
2234 (let ((temp (make-symbol "saved-buff")))
|
|
|
2235 (list 'let
|
|
|
2236 (list (list temp '(current-buffer)))
|
|
|
2237 (list 'unwind-protect
|
|
|
2238 (cons 'progn forms)
|
|
|
2239 (list 'condition-case nil
|
|
|
2240 (list 'set-buffer temp)
|
|
|
2241 '(error nil))))))
|
|
|
2242
|
|
|
2243 (put 'efs-save-buffer-excursion 'lisp-indent-hook 0)
|
|
|
2244
|
|
|
2245 (defmacro efs-unquote-dollars (string)
|
|
|
2246 ;; Unquote $$'s to $'s in STRING.
|
|
|
2247 (` (let ((string (, string))
|
|
|
2248 (start 0)
|
|
|
2249 new)
|
|
|
2250 (while (string-match "\\$\\$" string start)
|
|
|
2251 (setq new (concat new (substring
|
|
|
2252 string start (1+ (match-beginning 0))))
|
|
|
2253 start (match-end 0)))
|
|
|
2254 (if new
|
|
|
2255 (concat new (substring string start))
|
|
|
2256 string))))
|
|
|
2257
|
|
|
2258 (defmacro efs-get-file-part (path)
|
|
|
2259 ;; Given PATH, return the file part used for looking up the file's entry
|
|
|
2260 ;; in a hashtable.
|
|
|
2261 ;; This need not be the same thing as file-name-nondirectory.
|
|
|
2262 (` (let ((file (file-name-nondirectory (, path))))
|
|
|
2263 (if (string-equal file "")
|
|
|
2264 "."
|
|
|
2265 file))))
|
|
|
2266
|
|
|
2267 (defmacro efs-ftp-path-macro (path)
|
|
|
2268 ;; Just a macro version of efs-ftp-path, for speed critical
|
|
|
2269 ;; situations. Could use (inline ...) instead, but not everybody
|
|
|
2270 ;; uses the V19 byte-compiler. Also, doesn't call efs-save-match-data,
|
|
|
2271 ;; but assumes that the calling function does it.
|
|
|
2272 (`
|
|
|
2273 (let ((path (, path)))
|
|
|
2274 (or (string-equal path efs-ftp-path-arg)
|
|
|
2275 (setq efs-ftp-path-res
|
|
|
2276 (and (string-match efs-path-regexp path)
|
|
|
2277 (let ((host (substring path (match-beginning 2)
|
|
|
2278 (match-end 2)))
|
|
|
2279 (user (and (match-beginning 1)
|
|
|
2280 (substring path (match-beginning 1)
|
|
|
2281 (1- (match-end 1)))))
|
|
|
2282 (rpath (substring path (1+ (match-end 2)))))
|
|
|
2283 (list (if (string-equal host "")
|
|
|
2284 (setq host (system-name))
|
|
|
2285 host)
|
|
|
2286 (or user (efs-get-user host))
|
|
|
2287 rpath)))
|
|
|
2288 ;; Set this last, in case efs-get-user calls this function,
|
|
|
2289 ;; which would modify an earlier setting.
|
|
|
2290 efs-ftp-path-arg path))
|
|
|
2291 efs-ftp-path-res)))
|
|
|
2292
|
|
|
2293 (defmacro efs-canonize-switches (switches)
|
|
|
2294 ;; Converts a switches string, into a lexographically ordered string,
|
|
|
2295 ;; omitting - and spaces. Should we remove duplicate characters too?
|
|
|
2296 (` (if (, switches)
|
|
|
2297 (mapconcat
|
|
|
2298 'char-to-string
|
|
|
2299 (sort (delq ?- (delq ?\ (mapcar 'identity (, switches)))) '<) "")
|
|
|
2300 ;; For the purpose of interning in a hashtable, represent the nil
|
|
|
2301 ;; switches, as a string consisting of the ascii null character.
|
|
|
2302 (char-to-string 0))))
|
|
|
2303
|
|
|
2304 (defmacro efs-canonize-file-name (fn)
|
|
|
2305 ;; Canonizes the case of file names.
|
|
|
2306 (` (let ((parsed (efs-ftp-path (, fn))))
|
|
|
2307 (if parsed
|
|
|
2308 (let ((host (car parsed)))
|
|
|
2309 (if (memq (efs-host-type host) efs-case-insensitive-host-types)
|
|
|
2310 (downcase (, fn))
|
|
|
2311 (format efs-path-format-string (nth 1 parsed) (downcase host)
|
|
|
2312 (nth 2 parsed))))
|
|
|
2313 (, fn)))))
|
|
|
2314
|
|
|
2315 (defmacro efs-get-files-hashtable-entry (fn)
|
|
|
2316 (` (efs-get-hash-entry (efs-canonize-file-name (, fn)) efs-files-hashtable)))
|
|
|
2317
|
|
|
2318 ;;;; ------------------------------------------------------------
|
|
|
2319 ;;;; Utility Functions
|
|
|
2320 ;;;; ------------------------------------------------------------
|
|
|
2321
|
|
|
2322 (defun efs-kill-ftp-buffer-with-prompt (proc buffer)
|
|
|
2323 ;; Does a 3-way prompt to kill a ftp PROC and BUFFER.
|
|
|
2324 ;; Returns t if buffer was killed, 0 if only process, nil otherwise.
|
|
|
2325 (let ((inhibit-quit t)
|
|
|
2326 (cursor-in-echo-area t)
|
|
|
2327 char)
|
|
|
2328 (message
|
|
|
2329 (if efs-debug-ftp-connection
|
|
|
2330 "Kill ftp process and buffer (y[es], n[o], c[lose], d[ebug] ) "
|
|
|
2331 "Kill ftp process and buffer? (y or n, c to only close process) "))
|
|
|
2332 (setq char (read-char))
|
|
|
2333 (prog1
|
|
|
2334 (cond
|
|
|
2335 ((memq char '(?y ?Y ?\ ))
|
|
|
2336 (set-process-sentinel proc nil)
|
|
|
2337 (condition-case nil
|
|
|
2338 (kill-buffer buffer)
|
|
|
2339 (error nil))
|
|
|
2340 t)
|
|
|
2341 ((memq char '(?c ?C))
|
|
|
2342 (set-process-sentinel proc nil)
|
|
|
2343 (condition-case nil
|
|
|
2344 (save-excursion
|
|
|
2345 (set-buffer buffer)
|
|
|
2346 (setq efs-process-busy nil
|
|
|
2347 efs-process-q nil)
|
|
|
2348 (delete-process proc))
|
|
|
2349 (error nil))
|
|
|
2350 0)
|
|
|
2351 ((memq char '(?n ?N))
|
|
|
2352 (message "")
|
|
|
2353 nil)
|
|
|
2354 ((and efs-debug-ftp-connection
|
|
|
2355 (memq char '(?d ?D)))
|
|
|
2356 (condition-case nil
|
|
|
2357 (save-excursion
|
|
|
2358 (set-buffer buffer)
|
|
|
2359 (setq efs-process-busy nil
|
|
|
2360 efs-process-q nil))
|
|
|
2361 (error nil))
|
|
|
2362 0)
|
|
|
2363 (t
|
|
|
2364 (message
|
|
|
2365 (if efs-debug-ftp-connection
|
|
|
2366 "Type one of y, n, c or d."
|
|
|
2367 "Type one of y, n or c."))
|
|
|
2368 (ding)
|
|
|
2369 (sit-for 1)
|
|
|
2370 (setq quit-flag nil)
|
|
|
2371 (efs-kill-ftp-buffer-with-prompt proc buffer))))))
|
|
|
2372
|
|
|
2373 (defun efs-barf-if-not-directory (directory)
|
|
|
2374 ;; Signal an error if DIRECTORY is not one.
|
|
|
2375 (or (file-directory-p directory)
|
|
|
2376 (signal 'file-error
|
|
|
2377 (list "Opening directory"
|
|
|
2378 (if (file-exists-p directory)
|
|
|
2379 "not a directory"
|
|
|
2380 "no such file or directory")
|
|
|
2381 directory))))
|
|
|
2382
|
|
|
2383 (defun efs-call-cont (cont &rest args)
|
|
|
2384 "Call the function specified by CONT.
|
|
|
2385 CONT can be either a function or a list of a function and some args.
|
|
|
2386 The first parameters passed to the function will be ARGS. The remaining
|
|
|
2387 args will be taken from CONT if a list was passed."
|
|
|
2388 (if cont
|
|
|
2389 (let ((efs-nested-cmd t)) ; let-bound so that conts don't pop any queues
|
|
|
2390 (efs-save-buffer-excursion
|
|
|
2391 (if (and (listp cont)
|
|
|
2392 (not (eq (car cont) 'lambda)))
|
|
|
2393 (apply (car cont) (append args (cdr cont)))
|
|
|
2394 (apply cont args))))))
|
|
|
2395
|
|
|
2396 (defun efs-replace-path-component (fullpath path)
|
|
|
2397 "For FULLPATH matching efs-path-regexp replace the path component with PATH."
|
|
|
2398 (efs-save-match-data
|
|
|
2399 (if (string-match efs-path-root-regexp fullpath)
|
|
|
2400 (concat (substring fullpath 0 (match-end 0)) path)
|
|
|
2401 path)))
|
|
|
2402
|
|
|
2403 (defun efs-abort-recursive-edit-and-then (fun &rest args)
|
|
|
2404 ;; Does an abort-recursive-edit, and runs fun _after_ emacs returns to
|
|
|
2405 ;; top level.
|
|
|
2406 (if (get-process "efs-abort-recursive-edit")
|
|
|
2407 ;; Don't queue these things. Clean them out.
|
|
|
2408 (delete-process "efs-abort-recursive-edit"))
|
|
|
2409 (or efs-suppress-abort-recursive-edit-and-then
|
|
|
2410 (progn
|
|
|
2411 (setq efs-abort-recursive-edit-data (cons (nth 1 (current-time))
|
|
|
2412 (cons fun args)))
|
|
|
2413 (condition-case nil
|
|
|
2414 (set-process-sentinel
|
|
|
2415 (let ((default-directory exec-directory)
|
|
|
2416 (process-connection-type nil))
|
|
|
2417 (start-process "efs-abort-recursive-edit" nil "sleep" "0"))
|
|
|
2418 (function
|
|
|
2419 (lambda (proc string)
|
|
|
2420 (let ((data efs-abort-recursive-edit-data))
|
|
|
2421 (setq efs-abort-recursive-edit-data)
|
|
|
2422 (if (and data
|
|
|
2423 (integerp (car data))
|
|
|
2424 (<= (- (nth 1 (current-time)) (car data))
|
|
|
2425 efs-abort-recursive-edit-delay))
|
|
|
2426 (apply (nth 1 data) (nthcdr 2 data)))))))
|
|
|
2427 (error nil))))
|
|
|
2428 (abort-recursive-edit))
|
|
|
2429
|
|
|
2430 (defun efs-occur-in-string (char string)
|
|
|
2431 ;; Return the number of occurrences of CHAR in STRING.
|
|
|
2432 (efs-save-match-data
|
|
|
2433 (let ((regexp (regexp-quote (char-to-string char)))
|
|
|
2434 (count 0)
|
|
|
2435 (start 0))
|
|
|
2436 (while (string-match regexp string start)
|
|
|
2437 (setq start (match-end 0)
|
|
|
2438 count (1+ count)))
|
|
|
2439 count)))
|
|
|
2440
|
|
|
2441 (defun efs-parse-proc-name (proc)
|
|
|
2442 ;; Parses the name of process to return a list \(host user\).
|
|
|
2443 (efs-save-match-data
|
|
|
2444 (let ((name (process-name proc)))
|
|
|
2445 (and name
|
|
|
2446 (string-match "^\\*ftp \\([^@]*\\)@\\([^*]+\\)\\*$" name)
|
|
|
2447 (list (substring name (match-beginning 2) (match-end 2))
|
|
|
2448 (substring name (match-beginning 1) (match-end 1)))))))
|
|
|
2449
|
|
|
2450 ;;;; ------------------------------------------------------------
|
|
|
2451 ;;;; Of Geography, connectivity, and the internet... Gateways.
|
|
|
2452 ;;;; ------------------------------------------------------------
|
|
|
2453
|
|
|
2454 (defun efs-use-gateway-p (host &optional opaque-p)
|
|
|
2455 ;; Returns whether to access this host via a gateway.
|
|
|
2456 ;; Returns the gateway type as a symbol. See efs-gateway-type <V>.
|
|
|
2457 ;; If optional OPAQUE-P is non-nil, only returns non-nil if the gateway
|
|
|
2458 ;; type is in the list efs-opaque-gateways <V>.
|
|
|
2459 (and efs-gateway-type
|
|
|
2460 host ;local host is nil
|
|
|
2461 (efs-save-match-data
|
|
|
2462 (and (not (string-match efs-ftp-local-host-regexp host))
|
|
|
2463 (let ((type (car efs-gateway-type)))
|
|
|
2464 (if opaque-p
|
|
|
2465 (and (memq type efs-opaque-gateways) type)
|
|
|
2466 type))))))
|
|
|
2467
|
|
|
2468 (defun efs-local-to-gateway-filename (filename &optional reverse)
|
|
|
2469 ;; Converts a FILENAME on the local host to its name on the gateway,
|
|
|
2470 ;; using efs-gateway-mounted-dirs-alist. If REVERSE is non-nil, does just
|
|
|
2471 ;; that. If the there is no corresponding name because non of its parent
|
|
|
2472 ;; directories are mounted, returns nil.
|
|
|
2473 (if efs-gateway-mounted-dirs-alist
|
|
|
2474 (let ((len (length filename))
|
|
|
2475 (alist efs-gateway-mounted-dirs-alist)
|
|
|
2476 result elt elt-len)
|
|
|
2477 (if reverse
|
|
|
2478 (while (setq elt (car alist))
|
|
|
2479 (if (and (>= len (setq elt-len (length (cdr elt))))
|
|
|
2480 (string-equal (cdr elt) (substring filename 0 elt-len)))
|
|
|
2481 (setq result (concat (car elt)
|
|
|
2482 (substring filename elt-len))
|
|
|
2483 alist nil)
|
|
|
2484 (setq alist (cdr alist))))
|
|
|
2485 (while (setq elt (car alist))
|
|
|
2486 (if (and (>= len (setq elt-len (length (car elt))))
|
|
|
2487 (string-equal (car elt) (substring filename 0 elt-len)))
|
|
|
2488 (setq result (concat (cdr elt)
|
|
|
2489 (substring filename elt-len))
|
|
|
2490 alist nil)
|
|
|
2491 (setq alist (cdr alist)))))
|
|
|
2492 result)))
|
|
|
2493
|
|
|
2494 ;;; ------------------------------------------------------------
|
|
|
2495 ;;; Enhanced message support.
|
|
|
2496 ;;; ------------------------------------------------------------
|
|
|
2497
|
|
|
2498 (defun efs-message (fmt &rest args)
|
|
|
2499 "Output the given message, truncating to the size of the minibuffer window."
|
|
|
2500 (let ((msg (apply (function format) fmt args))
|
|
|
2501 (max (window-width (minibuffer-window))))
|
|
|
2502 (if (>= (length msg) max)
|
|
|
2503 (setq msg (concat "> " (substring msg (- 3 max)))))
|
|
|
2504 (message "%s" msg)))
|
|
|
2505
|
|
|
2506 (defun efs-message-p ()
|
|
|
2507 ;; Returns t, if efs is allowed to display a status message.
|
|
|
2508 (not
|
|
|
2509 (or (and (boundp 'dired-in-query) dired-in-query)
|
|
|
2510 (boundp 'search-message)
|
|
|
2511 cursor-in-echo-area
|
|
|
2512 (and (/= efs-message-interval 0)
|
|
|
2513 (let ((diff (- efs-last-message-time
|
|
|
2514 (setq efs-last-message-time
|
|
|
2515 (nth 1 (current-time))))))
|
|
|
2516 (and
|
|
|
2517 (> diff (- efs-message-interval))
|
|
|
2518 (< diff 0))))))) ; in case the clock wraps.
|
|
|
2519
|
|
|
2520 (efs-define-fun efs-relativize-filename (file &optional dir new)
|
|
|
2521 "Abbreviate the given filename relative to DIR .
|
|
|
2522 If DIR is nil, use the value of `default-directory' for the currently selected
|
|
|
2523 window. If the optional parameter NEW is given and the
|
|
|
2524 non-directory parts match, only return the directory part of the file."
|
|
|
2525 (let* ((dir (or dir (save-excursion
|
|
|
2526 (set-buffer (window-buffer (selected-window)))
|
|
|
2527 default-directory)))
|
|
|
2528 (dlen (length dir))
|
|
|
2529 (result file))
|
|
|
2530 (and (> (length file) dlen)
|
|
|
2531 (string-equal (substring file 0 dlen) dir)
|
|
|
2532 (setq result (substring file dlen)))
|
|
|
2533 (and new
|
|
|
2534 (string-equal (file-name-nondirectory result)
|
|
|
2535 (file-name-nondirectory new))
|
|
|
2536 (or (setq result (file-name-directory result))
|
|
|
2537 (setq result "./")))
|
|
|
2538 (abbreviate-file-name result)))
|
|
|
2539
|
|
|
2540 ;;; ------------------------------------------------------------
|
|
|
2541 ;;; Temporary file location and deletion...
|
|
|
2542 ;;; ------------------------------------------------------------
|
|
|
2543
|
|
|
2544 (defun efs-get-pid ()
|
|
|
2545 ;; Half-hearted attempt to get the current process's id.
|
|
|
2546 (setq efs-pid (substring (make-temp-name "") 1)))
|
|
|
2547
|
|
|
2548 (defun efs-make-tmp-name (host1 host2)
|
|
|
2549 ;; Returns the name of a new temp file, for moving data between HOST1
|
|
|
2550 ;; and HOST2. This temp file must be directly accessible to the
|
|
|
2551 ;; FTP client connected to HOST1. Using nil for either HOST1 or
|
|
|
2552 ;; HOST2 means the local host. The return value is actually a list
|
|
|
2553 ;; whose car is the name of the temp file wrto to the local host
|
|
|
2554 ;; and whose cdr is the name of the temp file wrto to the host
|
|
|
2555 ;; on which the client connected to HOST1 is running. If the gateway
|
|
|
2556 ;; is only accessible by FTP, then the car of this may be in efs extended
|
|
|
2557 ;; file name syntax.
|
|
|
2558 (let ((pid (or efs-pid (efs-get-pid)))
|
|
|
2559 (start ?a)
|
|
|
2560 file entry template rem-template template-len)
|
|
|
2561 ;; Compute the templates.
|
|
|
2562 (if (null (and host1 (efs-use-gateway-p host1 t)))
|
|
|
2563 ;; file must be local
|
|
|
2564 (if (null (and host2 (efs-use-gateway-p host2 t)))
|
|
|
2565 (setq template efs-tmp-name-template)
|
|
|
2566 (setq template (or (efs-local-to-gateway-filename
|
|
|
2567 efs-gateway-tmp-name-template t)
|
|
|
2568 efs-tmp-name-template)))
|
|
|
2569 ;; file must be on the gateway -- make sure that the gateway
|
|
|
2570 ;; configuration is sensible.
|
|
|
2571 (efs-save-match-data
|
|
|
2572 (or (string-match efs-ftp-local-host-regexp efs-gateway-host)
|
|
|
2573 (error "Gateway %s must be directly ftp accessible."
|
|
|
2574 efs-gateway-host)))
|
|
|
2575 (setq rem-template efs-gateway-tmp-name-template
|
|
|
2576 template (or (efs-local-to-gateway-filename
|
|
|
2577 efs-gateway-tmp-name-template t)
|
|
|
2578 (format efs-path-format-string
|
|
|
2579 (efs-get-user efs-gateway-host)
|
|
|
2580 efs-gateway-host
|
|
|
2581 efs-gateway-tmp-name-template))
|
|
|
2582 template-len (length template)))
|
|
|
2583 ;; Compute a new file name.
|
|
|
2584 (while (let (efs-verbose)
|
|
|
2585 (setq file (format "%s%c%s" template start pid)
|
|
|
2586 entry (intern file efs-tmp-name-obarray))
|
|
|
2587 (or (memq entry efs-tmp-name-files)
|
|
|
2588 (file-exists-p file)))
|
|
|
2589 (if (> (setq start (1+ start)) ?z)
|
|
|
2590 (progn
|
|
|
2591 (setq template (concat template "X"))
|
|
|
2592 (setq start ?a))))
|
|
|
2593 (setq efs-tmp-name-files
|
|
|
2594 (cons entry efs-tmp-name-files))
|
|
|
2595 (if rem-template
|
|
|
2596 (cons file (concat rem-template (substring file template-len)))
|
|
|
2597 (cons file file))))
|
|
|
2598
|
|
|
2599 (defun efs-del-tmp-name (temp)
|
|
|
2600 ;; Deletes file TEMP, a string.
|
|
|
2601 (setq efs-tmp-name-files
|
|
|
2602 (delq (intern temp efs-tmp-name-obarray)
|
|
|
2603 efs-tmp-name-files))
|
|
|
2604 (condition-case ()
|
|
|
2605 (let (efs-verbose)
|
|
|
2606 (delete-file temp))
|
|
|
2607 (error nil)))
|
|
|
2608
|
|
|
2609
|
|
|
2610 ;;;; ==============================================================
|
|
|
2611 ;;;; >4
|
|
|
2612 ;;;; Hosts, Users, Accounts, and Passwords
|
|
|
2613 ;;;; ==============================================================
|
|
|
2614 ;;;
|
|
|
2615 ;;; A lot of the support for this type of thing is in efs-netrc.el.
|
|
|
2616
|
|
|
2617 ;;;; ------------------------------------------------------------
|
|
|
2618 ;;;; Password support.
|
|
|
2619 ;;;; ------------------------------------------------------------
|
|
|
2620
|
|
|
2621 (defun efs-lookup-passwd (host user)
|
|
|
2622 ;; Look up the password for HOST and USER.
|
|
|
2623 (let ((ent (efs-get-host-user-property host user 'passwd)))
|
|
|
2624 (and ent (efs-code-string ent))))
|
|
|
2625
|
|
|
2626 (defun efs-system-fqdn ()
|
|
|
2627 "Returns a fully qualified domain name for the current host, if possible."
|
|
|
2628 (or efs-system-fqdn
|
|
|
2629 (setq efs-system-fqdn
|
|
|
2630 (let ((sys (system-name)))
|
|
|
2631 (if (string-match "\\." sys)
|
|
|
2632 sys
|
|
|
2633 (if efs-nslookup-program
|
|
|
2634 (let ((proc (let ((default-directory exec-directory)
|
|
|
2635 (process-connection-type nil))
|
|
|
2636 (start-process " *nslookup*" " *nslookup*"
|
|
|
2637 efs-nslookup-program sys)))
|
|
|
2638 (res sys)
|
|
|
2639 (n 0))
|
|
|
2640 (process-kill-without-query proc)
|
|
|
2641 (save-excursion
|
|
|
2642 (set-buffer (process-buffer proc))
|
|
|
2643 (let ((quit-flag nil)
|
|
|
2644 (inhibit-quit nil))
|
|
|
2645 (if efs-nslookup-threshold
|
|
|
2646 (progn
|
|
|
2647 (while (and (memq (process-status proc)
|
|
|
2648 '(run open))
|
|
|
2649 (< n efs-nslookup-threshold))
|
|
|
2650 (accept-process-output)
|
|
|
2651 (setq n (1+ n)))
|
|
|
2652 (if (>= n efs-nslookup-threshold)
|
|
|
2653 (progn
|
|
|
2654 (with-output-to-temp-buffer "*Help*"
|
|
|
2655 (princ (format "\
|
|
|
2656 efs is unable to determine a fully qualified domain name
|
|
|
2657 for the local host to send as an anonymous ftp password.
|
|
|
2658
|
|
|
2659 The function `system-name' is not returning a fully qualified
|
|
|
2660 domain name. An attempt to obtain a fully qualified domain name
|
|
|
2661 with `efs-nslookup-program' (currently set to \"%s\") has
|
|
|
2662 elicited no response from that program. Consider setting
|
|
|
2663 `efs-generate-anonymous-password' to an email address for anonymous
|
|
|
2664 ftp passwords.
|
|
|
2665
|
|
|
2666 For more information see the documentation (use C-h v) for the
|
|
|
2667 variables `efs-nslookup-program' and `efs-nslookup-threshold'."
|
|
|
2668 efs-nslookup-program)))
|
|
|
2669 (error "No response from %s"
|
|
|
2670 efs-nslookup-program))))
|
|
|
2671 (while (memq (process-status proc) '(run open))
|
|
|
2672 (accept-process-output proc)))
|
|
|
2673 (goto-char (point-min))
|
|
|
2674 (if (re-search-forward
|
|
|
2675 (format "^Name: *\\(%s\\.[^ \n\t]+\\)"
|
|
|
2676 sys) nil t)
|
|
|
2677 (setq res (buffer-substring
|
|
|
2678 (match-beginning 1)
|
|
|
2679 (match-end 1)))
|
|
|
2680 (kill-buffer (current-buffer)))))
|
|
|
2681 res)
|
|
|
2682 sys))))))
|
|
|
2683
|
|
|
2684 (defun efs-passwd-unique-list (alist)
|
|
|
2685 ;; Preserving the relative order of ALIST, remove all entries with duplicate
|
|
|
2686 ;; cars.
|
|
|
2687 (let (result)
|
|
|
2688 (while alist
|
|
|
2689 (or (assoc (car alist) result)
|
|
|
2690 (setq result (cons (car alist) result)))
|
|
|
2691 (setq alist (cdr alist)))
|
|
|
2692 (nreverse result)))
|
|
|
2693
|
|
|
2694 (defun efs-get-passwd-list (user host)
|
|
|
2695 ;; Returns an alist of the form '((pass host user) ...).
|
|
|
2696 ;; The order is essentially arbitrary, except that entries with user
|
|
|
2697 ;; equal to USER will appear first. Followed by entries with host equal to
|
|
|
2698 ;; HOST. Also, there will be no entries with duplicate values of pass.
|
|
|
2699 (efs-parse-netrc)
|
|
|
2700 (let* ((user-template (concat "/" user))
|
|
|
2701 (ulen (length user-template))
|
|
|
2702 (hlen (length host))
|
|
|
2703 primaries secondaries tertiaries)
|
|
|
2704 (efs-save-match-data
|
|
|
2705 (efs-map-hashtable
|
|
|
2706 (function
|
|
|
2707 (lambda (key passwd)
|
|
|
2708 (cond ((null passwd) nil)
|
|
|
2709 ((and (> (length key) ulen)
|
|
|
2710 (string-equal user-template
|
|
|
2711 (substring key (- ulen))))
|
|
|
2712 (setq primaries (cons (list (efs-code-string passwd)
|
|
|
2713 (substring key 0 (- ulen))
|
|
|
2714 (substring user-template 1))
|
|
|
2715 primaries)))
|
|
|
2716 ((and (> (length key) hlen)
|
|
|
2717 (string-equal host (substring key 0 hlen))
|
|
|
2718 (memq (aref key hlen) '(?/ ?.)))
|
|
|
2719 (if (string-match "/" key hlen)
|
|
|
2720 (setq secondaries
|
|
|
2721 (cons (list (efs-code-string passwd)
|
|
|
2722 (substring key 0 (match-beginning 0))
|
|
|
2723 (substring key (match-end 0)))
|
|
|
2724 secondaries))))
|
|
|
2725 ((string-match "/" key)
|
|
|
2726 (setq tertiaries
|
|
|
2727 (cons (list (efs-code-string passwd)
|
|
|
2728 (substring key 0 (match-beginning 0))
|
|
|
2729 (substring key (match-end 0)))
|
|
|
2730 tertiaries))))))
|
|
|
2731 efs-host-user-hashtable 'passwd))
|
|
|
2732 (efs-passwd-unique-list (nconc primaries secondaries tertiaries))))
|
|
|
2733
|
|
|
2734 (defun efs-get-passwd (host user)
|
|
|
2735 "Given a HOST and USER, return the FTP password, prompting if it was not
|
|
|
2736 previously set."
|
|
|
2737 (efs-parse-netrc)
|
|
|
2738
|
|
|
2739 ;; look up password in the hash table first; user might have overriden the
|
|
|
2740 ;; defaults.
|
|
|
2741 (cond ((efs-lookup-passwd host user))
|
|
|
2742
|
|
|
2743 ;; see if default user and password set from the .netrc file.
|
|
|
2744 ((and (stringp efs-default-user)
|
|
|
2745 efs-default-password
|
|
|
2746 (string-equal user efs-default-user))
|
|
|
2747 (copy-sequence efs-default-password))
|
|
|
2748
|
|
|
2749 ;; anonymous ftp password is handled specially since there is an
|
|
|
2750 ;; unwritten rule about how that is used on the Internet.
|
|
|
2751 ((and (efs-anonymous-p user)
|
|
|
2752 efs-generate-anonymous-password)
|
|
|
2753 (if (stringp efs-generate-anonymous-password)
|
|
|
2754 (copy-sequence efs-generate-anonymous-password)
|
|
|
2755 (concat (user-login-name) "@" (efs-system-fqdn))))
|
|
|
2756
|
|
|
2757 ;; see if same user has logged in to other hosts; if so then prompt
|
|
|
2758 ;; with the password that was used there.
|
|
|
2759 (t
|
|
|
2760 (let (others defaults passwd)
|
|
|
2761 (unwind-protect
|
|
|
2762 (progn
|
|
|
2763 (setq others (efs-get-passwd-list user host)
|
|
|
2764 defaults (mapcar
|
|
|
2765 (function
|
|
|
2766 (lambda (x)
|
|
|
2767 (cons
|
|
|
2768 (format
|
|
|
2769 "Passwd for %s@%s (same as %s@%s): "
|
|
|
2770 user host (nth 2 x) (nth 1 x))
|
|
|
2771 (car x))))
|
|
|
2772 others))
|
|
|
2773 (setq passwd
|
|
|
2774 (read-passwd
|
|
|
2775 (or defaults
|
|
|
2776 (format "Password for %s@%s: " user host)))))
|
|
|
2777 (while others
|
|
|
2778 (fillarray (car (car others)) 0)
|
|
|
2779 (setq others (cdr others))))
|
|
|
2780 (or (null passwd)
|
|
|
2781 (and efs-high-security-hosts
|
|
|
2782 (efs-save-match-data
|
|
|
2783 (string-match efs-high-security-hosts
|
|
|
2784 (format "%s@%s" user host))))
|
|
|
2785 (efs-set-passwd host user passwd))
|
|
|
2786 passwd))))
|
|
|
2787
|
|
|
2788 ;;;; ------------------------------------------------------------
|
|
|
2789 ;;;; Account support
|
|
|
2790 ;;;; ------------------------------------------------------------
|
|
|
2791
|
|
|
2792 (defun efs-get-account (host user &optional minidisk really)
|
|
|
2793 "Given a HOST, USER, and optional MINIDISK return the FTP account password.
|
|
|
2794 If the optional REALLY argument is given, prompts the user if it can't find
|
|
|
2795 one."
|
|
|
2796 (efs-parse-netrc)
|
|
|
2797 (let ((account (if minidisk
|
|
|
2798 (efs-get-hash-entry
|
|
|
2799 (concat (downcase host) "/" user "/" minidisk)
|
|
|
2800 efs-minidisk-hashtable
|
|
|
2801 (memq (efs-host-type host)
|
|
|
2802 efs-case-insensitive-host-types))
|
|
|
2803 (efs-get-host-user-property host user 'account))))
|
|
|
2804 (if account
|
|
|
2805 (efs-code-string account)
|
|
|
2806 ;; Do we really want to send the default-account passwd for all
|
|
|
2807 ;; minidisks?
|
|
|
2808 (if (and (stringp efs-default-user)
|
|
|
2809 (string-equal user efs-default-user)
|
|
|
2810 efs-default-account)
|
|
|
2811 efs-default-account
|
|
|
2812 (and really
|
|
|
2813 (let ((acct
|
|
|
2814 (read-passwd
|
|
|
2815 (if minidisk
|
|
|
2816 (format
|
|
|
2817 "Write access password for minidisk %s on %s@%s: "
|
|
|
2818 minidisk user host)
|
|
|
2819 (format
|
|
|
2820 "Account password for %s@%s: " user host)))))
|
|
|
2821 (or (and efs-high-security-hosts
|
|
|
2822 (efs-save-match-data
|
|
|
2823 efs-high-security-hosts
|
|
|
2824 (format "%s@%s" user host)))
|
|
|
2825 (efs-set-account host user minidisk acct))
|
|
|
2826 acct))))))
|
|
|
2827
|
|
|
2828 ;;;; -------------------------------------------------------------
|
|
|
2829 ;;;; Special classes of users.
|
|
|
2830 ;;;; -------------------------------------------------------------
|
|
|
2831
|
|
|
2832 (defun efs-anonymous-p (user)
|
|
|
2833 ;; Returns t if USER should be treated as an anonymous FTP login.
|
|
|
2834 (let ((user (downcase user)))
|
|
|
2835 (or (string-equal user "anonymous") (string-equal user "ftp"))))
|
|
|
2836
|
|
|
2837
|
|
|
2838 ;;;; =============================================================
|
|
|
2839 ;;;; >5
|
|
|
2840 ;;;; FTP client process, and server responses
|
|
|
2841 ;;;; =============================================================
|
|
|
2842
|
|
|
2843 ;;;; ---------------------------------------------------------
|
|
|
2844 ;;;; Support for asynch process queues.
|
|
|
2845 ;;;; ---------------------------------------------------------
|
|
|
2846
|
|
|
2847 (defun efs-add-to-queue (host user item)
|
|
|
2848 "To the end of the command queue for HOST and USER, adds ITEM.
|
|
|
2849 Does nothing if there is no process buffer for HOST and USER."
|
|
|
2850 (let ((buff (efs-ftp-process-buffer host user)))
|
|
|
2851 (if (get-buffer buff)
|
|
|
2852 (save-excursion
|
|
|
2853 (set-buffer buff)
|
|
|
2854 (setq efs-process-q
|
|
|
2855 (nconc efs-process-q (list item)))))))
|
|
|
2856
|
|
|
2857 ;;;; -------------------------------------------------------
|
|
|
2858 ;;;; Error recovery for the process filter.
|
|
|
2859 ;;;; -------------------------------------------------------
|
|
|
2860
|
|
|
2861 ;;; Could make this better, but it's such an unlikely error to hit.
|
|
|
2862 (defun efs-process-scream-and-yell (line)
|
|
|
2863 (let* ((buff (buffer-name (current-buffer)))
|
|
|
2864 (host (and (string-match "@\\(.*\\)\\*$" buff)
|
|
|
2865 (substring buff (match-beginning 1) (match-end 1)))))
|
|
|
2866 (with-output-to-temp-buffer "*Help*"
|
|
|
2867 (princ
|
|
|
2868 (concat
|
|
|
2869 "efs is unable to identify the following reply code
|
|
|
2870 from the ftp server " host ":\n\n" line "
|
|
|
2871
|
|
|
2872 Please send a bug report to ange@hplb.hpl.hp.com.
|
|
|
2873 In your report include a transcript of your\n"
|
|
|
2874 buff " buffer."))))
|
|
|
2875 (error "Unable to identify server code."))
|
|
|
2876
|
|
|
2877 (defun efs-error (host user msg)
|
|
|
2878 "Signal \'ftp-error for the FTP connection for HOST and USER.
|
|
|
2879 The error gives the string MSG as text. The process buffer for the FTP
|
|
|
2880 is popped up in another window."
|
|
|
2881 (let ((cur (selected-window))
|
|
|
2882 (pop-up-windows t)
|
|
|
2883 (buff (get-buffer (efs-ftp-process-buffer host user))))
|
|
|
2884 (if buff
|
|
|
2885 (progn
|
|
|
2886 (pop-to-buffer buff)
|
|
|
2887 (goto-char (point-max))
|
|
|
2888 (select-window cur))))
|
|
|
2889 (signal 'ftp-error (list (format "FTP Error: %s" msg))))
|
|
|
2890
|
|
|
2891 ;;;; --------------------------------------------------------------------
|
|
|
2892 ;;;; Process filter and supporting functions for handling FTP codes.
|
|
|
2893 ;;;; --------------------------------------------------------------------
|
|
|
2894
|
|
|
2895 (defun efs-process-handle-line (line proc)
|
|
|
2896 ;; Look at the given LINE from the ftp process PROC and try to catagorize it.
|
|
|
2897 (cond ((string-match efs-xfer-size-msgs line)
|
|
|
2898 (let ((n 1))
|
|
|
2899 ;; this loop will bomb with an args out of range error at 10
|
|
|
2900 (while (not (match-beginning n))
|
|
|
2901 (setq n (1+ n)))
|
|
|
2902 (setq efs-process-xfer-size
|
|
|
2903 (ash (string-to-int (substring line
|
|
|
2904 (match-beginning n)
|
|
|
2905 (match-end n)))
|
|
|
2906 -10))))
|
|
|
2907
|
|
|
2908 ((string-match efs-multi-msgs line)
|
|
|
2909 (setq efs-process-result-cont-lines
|
|
|
2910 (concat efs-process-result-cont-lines line "\n")))
|
|
|
2911
|
|
|
2912 ((string-match efs-skip-msgs line))
|
|
|
2913
|
|
|
2914 ((string-match efs-cmd-ok-msgs line)
|
|
|
2915 (if (string-match efs-cmd-ok-cmds efs-process-cmd)
|
|
|
2916 (setq efs-process-busy nil
|
|
|
2917 efs-process-result nil
|
|
|
2918 efs-process-result-line line)))
|
|
|
2919
|
|
|
2920 ((string-match efs-pending-msgs line)
|
|
|
2921 (if (string-match "^quote rnfr " efs-process-cmd)
|
|
|
2922 (setq efs-process-busy nil
|
|
|
2923 efs-process-result nil
|
|
|
2924 efs-process-result-line line)))
|
|
|
2925
|
|
|
2926 ((string-match efs-bytes-received-msgs line)
|
|
|
2927 (if efs-process-server-confused
|
|
|
2928 (setq efs-process-busy nil
|
|
|
2929 efs-process-result nil
|
|
|
2930 efs-process-result-line line)))
|
|
|
2931
|
|
|
2932 ((string-match efs-server-confused-msgs line)
|
|
|
2933 (setq efs-process-server-confused t))
|
|
|
2934
|
|
|
2935 ((string-match efs-good-msgs line)
|
|
|
2936 (setq efs-process-busy nil
|
|
|
2937 efs-process-result nil
|
|
|
2938 efs-process-result-line line))
|
|
|
2939
|
|
|
2940 ((string-match efs-fatal-msgs line)
|
|
|
2941 (set-process-sentinel proc nil)
|
|
|
2942 (delete-process proc)
|
|
|
2943 (setq efs-process-busy nil
|
|
|
2944 efs-process-result 'fatal
|
|
|
2945 efs-process-result-line line))
|
|
|
2946
|
|
|
2947 ((string-match efs-failed-msgs line)
|
|
|
2948 (setq efs-process-busy nil
|
|
|
2949 efs-process-result 'failed
|
|
|
2950 efs-process-result-line line))
|
|
|
2951
|
|
|
2952 ((string-match efs-unknown-response-msgs line)
|
|
|
2953 (setq efs-process-busy nil
|
|
|
2954 efs-process-result 'weird
|
|
|
2955 efs-process-result-line line)
|
|
|
2956 (efs-process-scream-and-yell line))))
|
|
|
2957
|
|
|
2958 (efs-define-fun efs-process-log-string (proc str)
|
|
|
2959 ;; For a given PROCESS, log the given STRING at the end of its
|
|
|
2960 ;; associated buffer.
|
|
|
2961 (let ((buff (get-buffer (process-buffer proc))))
|
|
|
2962 (if buff
|
|
|
2963 (efs-save-buffer-excursion
|
|
|
2964 (set-buffer buff)
|
|
|
2965 (comint-output-filter proc str)))))
|
|
|
2966
|
|
|
2967 (defun efs-process-filter (proc str)
|
|
|
2968 ;; Build up a complete line of output from the ftp PROCESS and pass it
|
|
|
2969 ;; on to efs-process-handle-line to deal with.
|
|
|
2970 (let ((inhibit-quit t)
|
|
|
2971 (buffer (get-buffer (process-buffer proc)))
|
|
|
2972 (efs-default-directory default-directory))
|
|
|
2973
|
|
|
2974 ;; see if the buffer is still around... it could have been deleted.
|
|
|
2975 (if buffer
|
|
|
2976 (efs-save-buffer-excursion
|
|
|
2977 (set-buffer (process-buffer proc))
|
|
|
2978 (efs-save-match-data
|
|
|
2979
|
|
|
2980 ;; handle hash mark printing
|
|
|
2981 (if efs-process-busy
|
|
|
2982 (setq str (efs-process-handle-hash str)
|
|
|
2983 efs-process-string (concat efs-process-string str)))
|
|
|
2984 (efs-process-log-string proc str)
|
|
|
2985 (while (and efs-process-busy
|
|
|
2986 (string-match "\n" efs-process-string))
|
|
|
2987 (let ((line (substring efs-process-string
|
|
|
2988 0
|
|
|
2989 (match-beginning 0))))
|
|
|
2990 (setq efs-process-string (substring
|
|
|
2991 efs-process-string
|
|
|
2992 (match-end 0)))
|
|
|
2993 ;; If we are in synch with the client, we should
|
|
|
2994 ;; never get prompts in the wrong place. Just to be safe,
|
|
|
2995 ;; chew them off.
|
|
|
2996 (while (string-match efs-process-prompt-regexp line)
|
|
|
2997 (setq line (substring line (match-end 0))))
|
|
|
2998 (efs-process-handle-line line proc)))
|
|
|
2999
|
|
|
3000 ;; has the ftp client finished? if so then do some clean-up
|
|
|
3001 ;; actions.
|
|
|
3002 (if (not efs-process-busy)
|
|
|
3003 (progn
|
|
|
3004 (efs-correct-hash-mark-size)
|
|
|
3005 ;; reset process-kill-without-query
|
|
|
3006 (process-kill-without-query proc)
|
|
|
3007 ;; issue the "done" message since we've finished.
|
|
|
3008 (if (and efs-process-msg
|
|
|
3009 (efs-message-p)
|
|
|
3010 (null efs-process-result))
|
|
|
3011 (progn
|
|
|
3012
|
|
|
3013 (efs-message "%s...done" efs-process-msg)
|
|
|
3014 (setq efs-process-msg nil)))
|
|
|
3015
|
|
|
3016 (if (and efs-process-nowait
|
|
|
3017 (null efs-process-cmd-waiting))
|
|
|
3018
|
|
|
3019 (progn
|
|
|
3020 ;; Is there a continuation we should be calling?
|
|
|
3021 ;; If so, we'd better call it, making sure we
|
|
|
3022 ;; only call it once.
|
|
|
3023 (if efs-process-continue
|
|
|
3024 (let ((cont efs-process-continue))
|
|
|
3025 (setq efs-process-continue nil)
|
|
|
3026 (efs-call-cont
|
|
|
3027 cont
|
|
|
3028 efs-process-result
|
|
|
3029 efs-process-result-line
|
|
|
3030 efs-process-result-cont-lines)))
|
|
|
3031 ;; If the cmd was run asynch, run the next
|
|
|
3032 ;; cmd from the queue. For synch cmds, this
|
|
|
3033 ;; is done by efs-send-cmd. For asynch
|
|
|
3034 ;; cmds we don't care about
|
|
|
3035 ;; efs-nested-cmd, since nothing is
|
|
|
3036 ;; waiting for the cmd to complete. If
|
|
|
3037 ;; efs-process-cmd-waiting is t, exit
|
|
|
3038 ;; to let this command run.
|
|
|
3039 (if (and efs-process-q
|
|
|
3040 ;; Be careful to check efs-process-busy
|
|
|
3041 ;; again, because the cont may have started
|
|
|
3042 ;; some new ftp action.
|
|
|
3043 ;; wheels within wheels...
|
|
|
3044 (null efs-process-busy))
|
|
|
3045 (let ((next (car efs-process-q)))
|
|
|
3046 (setq efs-process-q
|
|
|
3047 (cdr efs-process-q))
|
|
|
3048 (apply 'efs-send-cmd
|
|
|
3049 efs-process-host
|
|
|
3050 efs-process-user
|
|
|
3051 next))))
|
|
|
3052
|
|
|
3053 (if efs-process-continue
|
|
|
3054 (let ((cont efs-process-continue))
|
|
|
3055 (setq efs-process-continue nil)
|
|
|
3056 (efs-call-cont
|
|
|
3057 cont
|
|
|
3058 efs-process-result
|
|
|
3059 efs-process-result-line
|
|
|
3060 efs-process-result-cont-lines))))
|
|
|
3061
|
|
|
3062 ;; Update the mode line
|
|
|
3063 ;; We can't test nowait to see if we changed the
|
|
|
3064 ;; modeline in the first place, because conts
|
|
|
3065 ;; may be running now, which will confuse the issue.
|
|
|
3066 ;; The logic is simpler if we update the modeline
|
|
|
3067 ;; before the cont, but then the user sees the
|
|
|
3068 ;; modeline track the cont execution. It's dizzying.
|
|
|
3069 (if (and (or efs-mode-line-format
|
|
|
3070 efs-ftp-activity-function)
|
|
|
3071 (null efs-process-busy))
|
|
|
3072 (efs-update-mode-line)))))
|
|
|
3073
|
|
|
3074 ;; Trim buffer, if required.
|
|
|
3075 (and efs-max-ftp-buffer-size
|
|
|
3076 (zerop efs-process-cmd-counter)
|
|
|
3077 (> (point-max) efs-max-ftp-buffer-size)
|
|
|
3078 (= (point-min) 1) ; who knows, the user may have narrowed.
|
|
|
3079 (null (get-buffer-window (current-buffer)))
|
|
|
3080 (save-excursion
|
|
|
3081 (goto-char (/ efs-max-ftp-buffer-size 2))
|
|
|
3082 (forward-line 1)
|
|
|
3083 (delete-region (point-min) (point))))))))
|
|
|
3084
|
|
|
3085 ;;;; ------------------------------------------------------------------
|
|
|
3086 ;;;; Functions for counting hashes and reporting on bytes transferred.
|
|
|
3087 ;;;; ------------------------------------------------------------------
|
|
|
3088
|
|
|
3089 (defun efs-set-xfer-size (host user bytes)
|
|
|
3090 ;; Set the size of the next FTP transfer in bytes.
|
|
|
3091 (let ((proc (efs-get-process host user)))
|
|
|
3092 (if proc
|
|
|
3093 (let ((buf (process-buffer proc)))
|
|
|
3094 (if buf
|
|
|
3095 (save-excursion
|
|
|
3096 (set-buffer buf)
|
|
|
3097 (setq efs-process-xfer-size (ash bytes -10))))))))
|
|
|
3098
|
|
|
3099 (defun efs-guess-incoming-bin-hm-size ()
|
|
|
3100 ;; Guess at the hash mark size for incoming binary transfers by taking
|
|
|
3101 ;; the average value for such transfers to other hosts.
|
|
|
3102 (let ((total 0)
|
|
|
3103 (n 0))
|
|
|
3104 (efs-map-hashtable
|
|
|
3105 (function
|
|
|
3106 (lambda (host hm-size)
|
|
|
3107 (if hm-size (setq total (+ total hm-size)
|
|
|
3108 n (1+ n)))))
|
|
|
3109 efs-host-hashtable
|
|
|
3110 'incoming-bin-hm-size)
|
|
|
3111 (and (> n 0) (/ total n))))
|
|
|
3112
|
|
|
3113 (defun efs-set-hash-mark-unit (host user &optional incoming)
|
|
|
3114 ;; Sets the value of efs-process-hash-mark-unit according to the xfer-type.
|
|
|
3115 ;; efs-hash-mark-unit is the number of bytes represented by a hash mark,
|
|
|
3116 ;; in units of 16. If INCOMING is non-nil, the xfer will be a GET.
|
|
|
3117 (if efs-send-hash
|
|
|
3118 (let ((buff (efs-ftp-process-buffer host user))
|
|
|
3119 (gate-p (efs-use-gateway-p host t)))
|
|
|
3120 (if buff
|
|
|
3121 (save-excursion
|
|
|
3122 (set-buffer buff)
|
|
|
3123 (setq efs-process-hash-mark-unit
|
|
|
3124 (ash (or
|
|
|
3125 (and incoming (eq efs-process-xfer-type 'image)
|
|
|
3126 (or (efs-get-host-property
|
|
|
3127 host 'incoming-bin-hm-size)
|
|
|
3128 (if gate-p
|
|
|
3129 efs-gateway-incoming-binary-hm-size
|
|
|
3130 efs-incoming-binary-hm-size)
|
|
|
3131 (let ((guess
|
|
|
3132 (efs-guess-incoming-bin-hm-size)))
|
|
|
3133 (and guess
|
|
|
3134 (efs-set-host-property
|
|
|
3135 host 'incoming-bin-hm-size
|
|
|
3136 guess)))))
|
|
|
3137 (if gate-p
|
|
|
3138 efs-gateway-hash-mark-size
|
|
|
3139 efs-hash-mark-size)
|
|
|
3140 1024) ; make sure that we have some integer
|
|
|
3141 -4)))))))
|
|
|
3142
|
|
|
3143 (defun efs-correct-hash-mark-size ()
|
|
|
3144 ;; Corrects the value of efs-{ascii,binary}-hash-mark-size.
|
|
|
3145 ;; Must be run in the process buffer.
|
|
|
3146 (and efs-send-hash
|
|
|
3147 efs-process-hash-mark-unit
|
|
|
3148 (> efs-process-xfer-size 0)
|
|
|
3149 (< efs-process-xfer-size 524288) ; 2^19, prevent overflows
|
|
|
3150 (> efs-process-hash-mark-count 0)
|
|
|
3151 (or (> efs-process-last-percent 100)
|
|
|
3152 (< (ash (* efs-process-hash-mark-unit
|
|
|
3153 (1+ efs-process-hash-mark-count )) -6)
|
|
|
3154 efs-process-xfer-size))
|
|
|
3155 (let ((val (ash (/ (ash efs-process-xfer-size 6)
|
|
|
3156 efs-process-hash-mark-count) 4)))
|
|
|
3157 (if (and (eq efs-process-xfer-type 'image)
|
|
|
3158 (>= (length efs-process-cmd) 4)
|
|
|
3159 (string-equal (downcase (substring efs-process-cmd 0 4))
|
|
|
3160 "get "))
|
|
|
3161 (efs-set-host-property efs-process-host 'incoming-bin-hm-size val)
|
|
|
3162 (set (if (efs-use-gateway-p efs-process-host t)
|
|
|
3163 'efs-gateway-hash-mark-size
|
|
|
3164 'efs-hash-mark-size)
|
|
|
3165 val)))))
|
|
|
3166
|
|
|
3167 (defun efs-process-handle-hash (str)
|
|
|
3168 ;; Remove hash marks from STRING and display count so far.
|
|
|
3169 (if (string-match "^#+$" str)
|
|
|
3170 (progn
|
|
|
3171 (setq efs-process-hash-mark-count
|
|
|
3172 (+ efs-process-hash-mark-count
|
|
|
3173 (- (match-end 0) (match-beginning 0))))
|
|
|
3174 (and
|
|
|
3175 efs-process-msg
|
|
|
3176 efs-process-hash-mark-unit
|
|
|
3177 (not (and efs-process-nowait
|
|
|
3178 (or (eq efs-verbose 0)
|
|
|
3179 (eq (selected-window) (minibuffer-window)))))
|
|
|
3180 (efs-message-p)
|
|
|
3181 (let* ((big (> efs-process-hash-mark-count 65536)) ; 2^16
|
|
|
3182 (kbytes (if big
|
|
|
3183 (* efs-process-hash-mark-unit
|
|
|
3184 (ash efs-process-hash-mark-count -6))
|
|
|
3185 (ash (* efs-process-hash-mark-unit
|
|
|
3186 efs-process-hash-mark-count)
|
|
|
3187 -6))))
|
|
|
3188 (if (zerop efs-process-xfer-size)
|
|
|
3189 (or (zerop kbytes)
|
|
|
3190 (efs-message "%s...%dk" efs-process-msg kbytes))
|
|
|
3191 (let ((percent (if big
|
|
|
3192 (/ (* 100 (ash kbytes -7))
|
|
|
3193 (ash efs-process-xfer-size -7))
|
|
|
3194 (/ (* 100 kbytes) efs-process-xfer-size))))
|
|
|
3195 ;; Don't display %'s betwwen 100 and 110
|
|
|
3196 (and (> percent 100) (< percent 110) (setq percent 100))
|
|
|
3197 ;; cut out the redisplay of identical %-age messages.
|
|
|
3198 (or (eq percent efs-process-last-percent)
|
|
|
3199 (progn
|
|
|
3200 (setq efs-process-last-percent percent)
|
|
|
3201 (efs-message "%s...%d%%" efs-process-msg percent)))))))
|
|
|
3202 (concat (substring str 0 (match-beginning 0))
|
|
|
3203 (and (/= (length str) (match-end 0))
|
|
|
3204 (substring str (1+ (match-end 0))))))
|
|
|
3205 str))
|
|
|
3206
|
|
|
3207 ;;;; ------------------------------------------------------------------
|
|
|
3208 ;;;; Keeping track of the number of active background connections.
|
|
|
3209 ;;;; ------------------------------------------------------------------
|
|
|
3210
|
|
|
3211 (defun efs-ftp-processes-active ()
|
|
|
3212 ;; Return the number of FTP processes busy.
|
|
|
3213 (save-excursion
|
|
|
3214 (length
|
|
|
3215 (delq nil
|
|
|
3216 (mapcar
|
|
|
3217 (function
|
|
|
3218 (lambda (buff)
|
|
|
3219 (set-buffer buff)
|
|
|
3220 (and (boundp 'efs-process-busy)
|
|
|
3221 efs-process-busy)))
|
|
|
3222 (buffer-list))))))
|
|
|
3223
|
|
|
3224 (defun efs-update-mode-line ()
|
|
|
3225 ;; Updates the mode with FTP activity, and runs `efs-ftp-activity-function'.
|
|
|
3226 (let ((num (efs-ftp-processes-active)))
|
|
|
3227 (if efs-mode-line-format
|
|
|
3228 (progn
|
|
|
3229 (if (zerop num)
|
|
|
3230 (setq efs-mode-line-string "")
|
|
|
3231 (setq efs-mode-line-string (format efs-mode-line-format num)))
|
|
|
3232 ;; fake emacs into re-calculating all the mode lines.
|
|
|
3233 (save-excursion (set-buffer (other-buffer)))
|
|
|
3234 (set-buffer-modified-p (buffer-modified-p))))
|
|
|
3235 (if efs-ftp-activity-function
|
|
|
3236 (funcall efs-ftp-activity-function num))))
|
|
|
3237
|
|
116
|
3238 ;;;###autoload
|
|
98
|
3239 (defun efs-display-ftp-activity ()
|
|
116
|
3240 "Displays the number of active background ftp sessions in the modeline.
|
|
98
|
3241 Uses the variable `efs-mode-line-format' to determine how this will be
|
|
|
3242 displayed."
|
|
|
3243 (interactive)
|
|
|
3244 (or (memq 'efs-mode-line-string global-mode-string)
|
|
|
3245 (if global-mode-string
|
|
|
3246 (nconc global-mode-string '(efs-mode-line-string))
|
|
|
3247 (setq global-mode-string '("" efs-mode-line-string)))))
|
|
|
3248
|
|
|
3249 ;;;; -------------------------------------------------------------------
|
|
|
3250 ;;;; Expiring inactive ftp buffers.
|
|
|
3251 ;;;; -------------------------------------------------------------------
|
|
|
3252
|
|
|
3253 (defun efs-start-polling ()
|
|
|
3254 ;; Start polling FTP buffers, to look for idle ones.
|
|
|
3255 (or (null efs-expire-ftp-buffers)
|
|
|
3256 (let ((proc (get-process "efs poll")))
|
|
|
3257 (or (and proc (eq (process-status proc) 'run))))
|
|
|
3258 (let ((default-directory exec-directory)
|
|
|
3259 (process-connection-type nil)
|
|
|
3260 new-proc)
|
|
|
3261 (condition-case nil
|
|
|
3262 (delete-process "efs poll")
|
|
|
3263 (error nil))
|
|
|
3264 (setq new-proc (start-process
|
|
|
3265 "efs poll" nil
|
|
|
3266 (concat exec-directory "wakeup")
|
|
|
3267 (int-to-string efs-ftp-buffer-poll-time)))
|
|
|
3268 (set-process-filter new-proc (function efs-expire-ftp-buffers-filter))
|
|
|
3269 (process-kill-without-query new-proc))))
|
|
|
3270
|
|
|
3271 (defun efs-connection-visited-p (host user)
|
|
|
3272 ;; Returns t if there are any buffers visiting files on HOST and USER.
|
|
|
3273 (save-excursion
|
|
|
3274 (let ((list (buffer-list))
|
|
|
3275 (case-fold (memq (efs-host-type host)
|
|
|
3276 efs-case-insensitive-host-types))
|
|
|
3277 (visited nil)
|
|
|
3278 parsed)
|
|
|
3279 (setq host (downcase host))
|
|
|
3280 (if case-fold (setq user (downcase user)))
|
|
|
3281 (while list
|
|
|
3282 (set-buffer (car list))
|
|
|
3283 (if (or (and buffer-file-name
|
|
|
3284 (setq parsed (efs-ftp-path buffer-file-name))
|
|
|
3285 (string-equal host (downcase (car parsed)))
|
|
|
3286 (string-equal user (if case-fold
|
|
|
3287 (downcase (nth 1 parsed))
|
|
|
3288 (nth 1 parsed))))
|
|
|
3289 (and (boundp 'dired-directory)
|
|
|
3290 (stringp dired-directory)
|
|
|
3291 efs-dired-host-type
|
|
|
3292 (setq parsed (efs-ftp-path dired-directory))
|
|
|
3293 (string-equal host (downcase (car parsed)))
|
|
|
3294 (string-equal user (if case-fold
|
|
|
3295 (downcase (nth 1 parsed))
|
|
|
3296 (nth 1 parsed)))))
|
|
|
3297 (setq visited t
|
|
|
3298 list nil)
|
|
|
3299 (setq list (cdr list))))
|
|
|
3300 visited)))
|
|
|
3301
|
|
|
3302 (defun efs-expire-ftp-buffers-filter (proc string)
|
|
|
3303 ;; Check all ftp buffers, and kill them if they have been inactive
|
|
|
3304 ;; for the minimum of efs-ftp-buffer-expire-time and their local
|
|
|
3305 ;; time out time.
|
|
|
3306 (if efs-expire-ftp-buffers
|
|
|
3307 (let ((list (buffer-list))
|
|
|
3308 new-alist)
|
|
|
3309 (save-excursion
|
|
|
3310 (while list
|
|
|
3311 (set-buffer (car list))
|
|
|
3312 (if (eq major-mode 'efs-mode)
|
|
|
3313 (let* ((proc (get-buffer-process (current-buffer)))
|
|
|
3314 (proc-p (and proc (memq (process-status proc)
|
|
|
3315 '(run open)))))
|
|
|
3316 (if (or efs-ftp-buffer-expire-time
|
|
|
3317 efs-process-idle-time
|
|
|
3318 (null proc-p))
|
|
|
3319 (let ((elt (assq (car list) efs-ftp-buffer-alist))
|
|
|
3320 (wind-p (get-buffer-window (car list))))
|
|
|
3321 (if (or (null elt) (buffer-modified-p)
|
|
|
3322 efs-process-busy wind-p)
|
|
|
3323 (progn
|
|
|
3324 (setq new-alist (cons (cons (car list) 0)
|
|
|
3325 new-alist))
|
|
|
3326 (or wind-p (set-buffer-modified-p nil)))
|
|
|
3327 (let ((idle (+ (cdr elt)
|
|
|
3328 efs-ftp-buffer-poll-time)))
|
|
|
3329 (if (and proc-p
|
|
|
3330 (< idle
|
|
|
3331 (if efs-ftp-buffer-expire-time
|
|
|
3332 (if efs-process-idle-time
|
|
|
3333 (min efs-ftp-buffer-expire-time
|
|
|
3334 efs-process-idle-time)
|
|
|
3335 efs-ftp-buffer-expire-time)
|
|
|
3336 efs-process-idle-time)))
|
|
|
3337 (progn
|
|
|
3338 (setq new-alist (cons (cons (car list) idle)
|
|
|
3339 new-alist))
|
|
|
3340 (set-buffer-modified-p nil))
|
|
|
3341 ;; If there are still buffers for host & user,
|
|
|
3342 ;; don't wipe the cache.
|
|
|
3343 (and proc
|
|
|
3344 (efs-connection-visited-p
|
|
|
3345 efs-process-host efs-process-user)
|
|
|
3346 (set-process-sentinel proc nil))
|
|
|
3347 (kill-buffer (car list)))))))))
|
|
|
3348 (setq list (cdr list))))
|
|
|
3349 (setq efs-ftp-buffer-alist new-alist))
|
|
|
3350 (condition-case nil
|
|
|
3351 (delete-process "efs poll")
|
|
|
3352 (error nil))))
|
|
|
3353
|
|
|
3354 ;;;; -------------------------------------------------------------------
|
|
|
3355 ;;;; When the FTP client process dies...
|
|
|
3356 ;;;; -------------------------------------------------------------------
|
|
|
3357
|
|
|
3358 (defun efs-process-sentinel (proc str)
|
|
|
3359 ;; When ftp process changes state, nuke all file-entries in cache.
|
|
|
3360 (let ((buff (process-buffer proc)))
|
|
|
3361 ;; If the client dies, make sure that efs doesn't think that
|
|
|
3362 ;; there is a running process.
|
|
|
3363 (save-excursion
|
|
|
3364 (condition-case nil
|
|
|
3365 (progn
|
|
|
3366 (set-buffer buff)
|
|
|
3367 (setq efs-process-busy nil))
|
|
|
3368 (error nil)))
|
|
|
3369 (let ((parsed (efs-parse-proc-name proc)))
|
|
|
3370 (if parsed
|
|
|
3371 (progn
|
|
|
3372 (apply 'efs-wipe-file-entries parsed)
|
|
|
3373 (apply 'efs-wipe-from-ls-cache parsed))))
|
|
|
3374 (if (or efs-mode-line-format efs-ftp-activity-function)
|
|
|
3375 (efs-update-mode-line))))
|
|
|
3376
|
|
|
3377 (defun efs-kill-ftp-process (buffer)
|
|
|
3378 "Kill an FTP connection and its associated process buffer.
|
|
|
3379 If the BUFFER's visited file name or default-directory is an efs remote
|
|
|
3380 file name, it is the connection for that file name that is killed."
|
|
|
3381 (interactive "bKill FTP process associated with buffer: ")
|
|
|
3382 (or buffer (setq buffer (current-buffer)))
|
|
|
3383 (save-excursion
|
|
|
3384 (set-buffer buffer)
|
|
|
3385 (if (eq major-mode 'efs-mode)
|
|
|
3386 (kill-buffer buffer)
|
|
|
3387 (let ((file (or (buffer-file-name) default-directory)))
|
|
|
3388 (if file
|
|
|
3389 (let ((parsed (efs-ftp-path (expand-file-name file))))
|
|
|
3390 (if parsed
|
|
|
3391 (let ((host (nth 0 parsed))
|
|
|
3392 (user (nth 1 parsed)))
|
|
|
3393 (kill-buffer
|
|
|
3394 (efs-ftp-process-buffer host user))))))))))
|
|
|
3395
|
|
|
3396 (defun efs-close-ftp-process (buffer)
|
|
|
3397 "Close an FTP connection.
|
|
|
3398 This kills the FTP client process, but unlike `efs-kill-ftp-process' this
|
|
|
3399 neither kills the process buffer, nor deletes cached data for the connection."
|
|
|
3400 (interactive "bClose FTP process associated with buffer: ")
|
|
|
3401 (or buffer (setq buffer (current-buffer)))
|
|
|
3402 (save-excursion
|
|
|
3403 (set-buffer buffer)
|
|
|
3404 (if (eq major-mode 'efs-mode)
|
|
|
3405 (let ((process (get-buffer-process buffer)))
|
|
|
3406 (if process
|
|
|
3407 (progn
|
|
|
3408 (set-process-sentinel process nil)
|
|
|
3409 (setq efs-process-busy nil
|
|
|
3410 efs-process-q nil)
|
|
|
3411 (if (or efs-mode-line-format efs-ftp-activity-function)
|
|
|
3412 (efs-update-mode-line))
|
|
|
3413 (delete-process process))))
|
|
|
3414 (let ((file (or (buffer-file-name) default-directory)))
|
|
|
3415 (if file
|
|
|
3416 (let ((parsed (efs-ftp-path (expand-file-name file))))
|
|
|
3417 (if parsed
|
|
|
3418 (let ((process (get-process
|
|
|
3419 (format "*ftp %s@%s*"
|
|
|
3420 (nth 1 parsed) (car parsed)))))
|
|
|
3421 (if process
|
|
|
3422 (progn
|
|
|
3423 (set-buffer (process-buffer process))
|
|
|
3424 (set-process-sentinel process nil)
|
|
|
3425 (setq efs-process-busy nil
|
|
|
3426 efs-process-q nil)
|
|
|
3427 (if (or efs-mode-line-format
|
|
|
3428 efs-ftp-activity-function)
|
|
|
3429 (efs-update-mode-line))
|
|
|
3430 (delete-process process)))))))))))
|
|
|
3431
|
|
|
3432 (defun efs-ping-ftp-connection (buffer)
|
|
|
3433 "Ping a connection by sending a NOOP command.
|
|
|
3434 Useful for waking up a possible expired connection."
|
|
|
3435 (interactive "bPing FTP connection associated with buffer: ")
|
|
|
3436 (or buffer (setq buffer (current-buffer)))
|
|
|
3437 (efs-save-buffer-excursion
|
|
|
3438 (set-buffer buffer)
|
|
|
3439 (let (file host user parsed)
|
|
|
3440 (if (or (and (eq major-mode 'efs-mode)
|
|
|
3441 (setq host efs-process-host
|
|
|
3442 user efs-process-user))
|
|
|
3443 (and (setq file (or (buffer-file-name) default-directory))
|
|
|
3444 (setq parsed (efs-ftp-path file))
|
|
|
3445 (setq host (car parsed)
|
|
|
3446 user (nth 1 parsed))))
|
|
|
3447 (or (car
|
|
|
3448 (efs-send-cmd
|
|
|
3449 host user '(quote noop)
|
|
|
3450 (format "Pinging connection %s@%s" user host)))
|
|
|
3451 (message "Connection %s@%s is alive." user host))))))
|
|
|
3452
|
|
|
3453 (defun efs-display-ftp-process-buffer (buffer)
|
|
|
3454 "Displays the FTP process buffer associated with the current buffer."
|
|
|
3455 (interactive "bDisplay FTP buffer associated with buffer: ")
|
|
|
3456 (if (null buffer) (setq buffer (current-buffer)))
|
|
|
3457 (let ((file (or (buffer-file-name) default-directory))
|
|
|
3458 parsed proc-buffer)
|
|
|
3459 (if (and file (setq parsed (efs-ftp-path file))
|
|
|
3460 (setq proc-buffer (get-buffer (efs-ftp-process-buffer
|
|
|
3461 (car parsed)
|
|
|
3462 (nth 1 parsed)))))
|
|
|
3463 (display-buffer proc-buffer)
|
|
|
3464 (error "Buffer %s not associated with an FTP process" buffer))))
|
|
|
3465
|
|
|
3466 ;;;; -------------------------------------------------------------------
|
|
|
3467 ;;;; Starting the FTP client process
|
|
|
3468 ;;;; -------------------------------------------------------------------
|
|
|
3469
|
|
|
3470 (defun efs-ftp-process-buffer (host user)
|
|
|
3471 "Return name of the process buffer for ftp process for HOST and USER."
|
|
|
3472 ;; Host names on the internet are case-insensitive.
|
|
|
3473 (format efs-ftp-buffer-format user (downcase host)))
|
|
|
3474
|
|
|
3475 (defun efs-pty-check (proc threshold)
|
|
|
3476 ;; Checks to see if PROC is a pty. Beware, it clobbers the process
|
|
|
3477 ;; filter, so run this before you set the filter.
|
|
|
3478 ;; THRESHOLD is an integer to tell it how long to wait for output.
|
|
|
3479 (sit-for 0) ; Update the display before doing any waiting.
|
|
|
3480 (let ((efs-pipe-p t)
|
|
|
3481 (n 0))
|
|
|
3482 (set-process-filter proc (function (lambda (proc string)
|
|
|
3483 (setq efs-pipe-p nil))))
|
|
|
3484 (while (and (< n threshold) efs-pipe-p)
|
|
|
3485 (accept-process-output)
|
|
|
3486 (setq n (1+ n)))
|
|
|
3487 (if efs-pipe-p
|
|
|
3488 (progn
|
|
|
3489 (sit-for 0) ; update display
|
|
|
3490 ;; Use a sleep-for as I don't want pty-checking to depend
|
|
|
3491 ;; on pending input.
|
|
|
3492 (sleep-for efs-pty-check-retry-time)))
|
|
|
3493 (accept-process-output)
|
|
|
3494 (if efs-pipe-p
|
|
|
3495 (if (or noninteractive
|
|
|
3496 (progn
|
|
|
3497 ;; in case the user typed something during the wait.
|
|
|
3498 (discard-input)
|
|
|
3499 (y-or-n-p
|
|
|
3500 (format "%s seems not a pty. Kill? " proc))))
|
|
|
3501 (progn
|
|
|
3502 (kill-buffer (process-buffer proc))
|
|
|
3503 (if (eq (selected-window) (minibuffer-window))
|
|
|
3504 (abort-recursive-edit)
|
|
|
3505 (signal 'quit nil))))
|
|
|
3506 ;; Need to send a \n to make sure, because sometimes we get the startup
|
|
|
3507 ;; prompt from a pipe.
|
|
|
3508 (sit-for 0)
|
|
|
3509 (process-send-string proc "\n")
|
|
|
3510 (setq efs-pipe-p t
|
|
|
3511 n 0)
|
|
|
3512 (while (and (< n threshold) efs-pipe-p)
|
|
|
3513 (accept-process-output)
|
|
|
3514 (setq n (1+ n)))
|
|
|
3515 (if efs-pipe-p
|
|
|
3516 (progn
|
|
|
3517 (sit-for 0)
|
|
|
3518 (sleep-for efs-pty-check-retry-time)))
|
|
|
3519 (accept-process-output)
|
|
|
3520 (if (and efs-pipe-p
|
|
|
3521 (or noninteractive
|
|
|
3522 (progn
|
|
|
3523 ;; in case the user typed something during the wait.
|
|
|
3524 (discard-input)
|
|
|
3525 (y-or-n-p
|
|
|
3526 (format "%s seems not a pty. Kill? " proc)))))
|
|
|
3527 (progn
|
|
|
3528 (kill-buffer (process-buffer proc))
|
|
|
3529 (if (eq (selected-window) (minibuffer-window))
|
|
|
3530 (abort-recursive-edit)
|
|
|
3531 (signal 'quit nil)))))))
|
|
|
3532
|
|
|
3533 (defun efs-start-process (host user name)
|
|
|
3534 "Spawn a new ftp process ready to connect to machine HOST as USER.
|
|
|
3535 If HOST is only ftp-able through a gateway machine then spawn a shell
|
|
|
3536 on the gateway machine to do the ftp instead. NAME is the name of the
|
|
|
3537 process."
|
|
|
3538 (let* ((use-gateway (efs-use-gateway-p host))
|
|
|
3539 (buffer (get-buffer-create (efs-ftp-process-buffer host user)))
|
|
|
3540 (process-connection-type t)
|
|
|
3541 (opaque-p (memq use-gateway efs-opaque-gateways))
|
|
|
3542 proc)
|
|
|
3543 (save-excursion
|
|
|
3544 (set-buffer buffer)
|
|
|
3545 (efs-mode host user (if opaque-p
|
|
|
3546 efs-gateway-ftp-prompt-regexp
|
|
|
3547 efs-ftp-prompt-regexp)))
|
|
|
3548 (cond
|
|
|
3549 ((null use-gateway)
|
|
|
3550 (message "Opening FTP connection to %s..." host)
|
|
|
3551 (setq proc (apply 'start-process name buffer efs-ftp-program-name
|
|
|
3552 efs-ftp-program-args)))
|
|
|
3553 ((eq use-gateway 'interactive)
|
|
|
3554 (setq proc (efs-gwp-start host user name)))
|
|
|
3555 ((eq use-gateway 'remsh)
|
|
|
3556 (message "Opening FTP connection to %s via %s..." host efs-gateway-host)
|
|
|
3557 (setq proc (apply 'start-process name buffer (nth 1 efs-gateway-type)
|
|
|
3558 (append (list efs-gateway-host)
|
|
|
3559 (nth 2 efs-gateway-type)
|
|
|
3560 (list (nth 3 efs-gateway-type))
|
|
|
3561 (nth 4 efs-gateway-type)))))
|
|
|
3562 ((memq use-gateway '(proxy raptor interlock kerberos))
|
|
|
3563 (message "Opening FTP connection to %s via %s..." host efs-gateway-host)
|
|
|
3564 (setq proc (apply 'start-process name buffer (nth 1 efs-gateway-type)
|
|
|
3565 (nth 2 efs-gateway-type))))
|
|
|
3566 ((eq use-gateway 'local)
|
|
|
3567 (message "Opening FTP connection to %s..." host)
|
|
|
3568 (setq proc (apply 'start-process name buffer (nth 1 efs-gateway-type)
|
|
|
3569 (nth 2 efs-gateway-type))))
|
|
|
3570 ((error "Never heard of gateway type %s" use-gateway)))
|
|
|
3571 (process-kill-without-query proc)
|
|
|
3572 (if opaque-p
|
|
|
3573 (accept-process-output proc)
|
|
|
3574 (if efs-pty-check-threshold
|
|
|
3575 (efs-pty-check proc efs-pty-check-threshold)
|
|
|
3576 (accept-process-output proc)))
|
|
|
3577 (set-process-sentinel proc (function efs-process-sentinel))
|
|
|
3578 (set-process-filter proc (function efs-process-filter))
|
|
|
3579 (efs-start-polling)
|
|
|
3580 (save-excursion
|
|
|
3581 (set-buffer buffer)
|
|
|
3582 (goto-char (point-max))
|
|
|
3583 (set-marker (process-mark proc) (point)))
|
|
|
3584 proc))
|
|
|
3585
|
|
|
3586 (defun efs-get-process-internal (host user)
|
|
|
3587 ;; Get's the first process for HOST and USER. If HOST runs a
|
|
|
3588 ;; a case insignificant OS, then case is not considered in USER.
|
|
|
3589 (let ((list (process-list))
|
|
|
3590 (case-fold (memq (efs-host-type host)
|
|
|
3591 efs-case-insensitive-host-types))
|
|
|
3592 (len (+ (length host) (length user) 7))
|
|
|
3593 fmt name found)
|
|
|
3594 (setq host (downcase host))
|
|
|
3595 (if case-fold (setq user (downcase user)))
|
|
|
3596 (while (and (not found) list)
|
|
|
3597 (setq name (process-name (car list)))
|
|
|
3598 (if (and (= (length name) len)
|
|
|
3599 (string-equal (substring name 0 5) "*ftp ")
|
|
|
3600 (string-equal
|
|
|
3601 (if case-fold (downcase (substring name 5)) (substring name 5))
|
|
|
3602 (or fmt (setq fmt (format "%s@%s*" user host))))
|
|
|
3603 (memq (process-status (car list)) '(run open)))
|
|
|
3604 (setq found (car list))
|
|
|
3605 (setq list (cdr list))))
|
|
|
3606 found))
|
|
|
3607
|
|
|
3608 ;; efs-guess-host-type calls this
|
|
|
3609 ;; function recursively. The (if (and proc... avoids an infinite
|
|
|
3610 ;; loop. We should make sure that this won't hang things if the
|
|
|
3611 ;; connection goes wrong.
|
|
|
3612
|
|
|
3613 (defun efs-get-process (host user)
|
|
|
3614 "Return the process object for the FTP process for HOST and USER.
|
|
|
3615 Create a new process if needed."
|
|
|
3616
|
|
|
3617 (let ((proc (efs-get-process-internal host user)))
|
|
|
3618 (if (and proc (memq (process-status proc) '(run open)))
|
|
|
3619 proc
|
|
|
3620
|
|
|
3621 ;; Make sure that the process isn't around in some strange state.
|
|
|
3622
|
|
|
3623 (setq host (downcase host))
|
|
|
3624 (let ((name (concat "*ftp " user "@" host "*")))
|
|
|
3625 (if proc (condition-case nil (delete-process proc) (error nil)))
|
|
|
3626
|
|
|
3627 ;; grab a suitable process.
|
|
|
3628 (setq proc (efs-start-process host user name))
|
|
|
3629
|
|
|
3630 (efs-save-match-data
|
|
|
3631 (efs-save-buffer-excursion
|
|
|
3632 (set-buffer (process-buffer proc))
|
|
|
3633
|
|
|
3634 ;; Run any user-specified hooks.
|
|
|
3635 (run-hooks 'efs-ftp-startup-hook)
|
|
|
3636
|
|
|
3637 ;; login to FTP server.
|
|
|
3638 (efs-login host user proc)
|
|
|
3639
|
|
|
3640 ;; Beware, the process may have died if the login went bad.
|
|
|
3641 (if (memq (process-status proc) '(run open))
|
|
|
3642
|
|
|
3643 (progn
|
|
|
3644 ;; Tell client to send back hash-marks as progress. It isn't
|
|
|
3645 ;; usually fatal if this command fails.
|
|
|
3646 (efs-guess-hash-mark-size proc)
|
|
|
3647
|
|
|
3648 ;; Run any user startup functions
|
|
|
3649 (let ((alist efs-ftp-startup-function-alist)
|
|
|
3650 (case-fold-search t))
|
|
|
3651 (while alist
|
|
|
3652 (if (string-match (car (car alist)) host)
|
|
|
3653 (progn
|
|
|
3654 (funcall (cdr (car alist)) host user)
|
|
|
3655 (setq alist nil))
|
|
|
3656 (setq alist (cdr alist)))))
|
|
|
3657
|
|
|
3658 ;; Guess at the host type.
|
|
|
3659 (efs-guess-host-type host user)
|
|
|
3660
|
|
|
3661 ;; Check the idle time.
|
|
|
3662 (efs-check-idle host user)
|
|
|
3663
|
|
|
3664 proc)
|
|
|
3665
|
|
|
3666 ;; Hopefully a recursive retry worked.
|
|
|
3667 (or (efs-get-process-internal host user)
|
|
|
3668 (error "No FTP process for %s@%s" user host)))))))))
|
|
|
3669
|
|
|
3670 (defun efs-guess-hash-mark-size (proc)
|
|
|
3671 ;; Doesn't run efs-save-match-data. You must do that yourself.
|
|
|
3672 (if efs-send-hash
|
|
|
3673 (save-excursion
|
|
|
3674 (set-buffer (process-buffer proc))
|
|
|
3675 (let ((line (nth 1 (efs-raw-send-cmd proc "hash")))
|
|
|
3676 (gate-p (efs-use-gateway-p efs-process-host t)))
|
|
|
3677 ;; Don't guess if the hash-mark-size is already set.
|
|
|
3678 (or (if gate-p efs-gateway-hash-mark-size efs-hash-mark-size)
|
|
|
3679 (if (string-match efs-hash-mark-msgs line)
|
|
|
3680 (let ((size (substring line (match-beginning 1)
|
|
|
3681 (match-end 1))))
|
|
|
3682 (if (string-match "^[0-9]+$" size)
|
|
|
3683 (set (if gate-p
|
|
|
3684 'efs-gateway-hash-mark-size
|
|
|
3685 'efs-hash-mark-size)
|
|
|
3686 (string-to-int size))))))))))
|
|
|
3687
|
|
|
3688 ;;;; ------------------------------------------------------------
|
|
|
3689 ;;;; Simple FTP process shell support.
|
|
|
3690 ;;;; ------------------------------------------------------------
|
|
|
3691
|
|
|
3692 (defun efs-mode (host user prompt)
|
|
|
3693 "Major mode for interacting with an FTP process.
|
|
|
3694 The user interface for sending commands to the FTP process is `comint-mode'.
|
|
|
3695 For more information see the documentation for `comint-mode'. This command
|
|
|
3696 is not intended for interactive use.
|
|
|
3697 Takes arguments: HOST USER PROMPT
|
|
|
3698
|
|
|
3699 Runs efs-mode-hook if it is not nil.
|
|
|
3700
|
|
|
3701 Key map:
|
|
|
3702 \\{comint-mode-map}"
|
|
|
3703 (let ((proc (get-buffer-process (current-buffer))))
|
|
|
3704 ;; Running comint-mode will kill-all-local-variables.
|
|
|
3705 (comint-mode)
|
|
|
3706 ;; All these variables are buffer local.
|
|
|
3707 (setq major-mode 'efs-mode
|
|
|
3708 mode-name "efs"
|
|
|
3709 default-directory (file-name-directory efs-tmp-name-template)
|
|
|
3710 comint-prompt-regexp prompt
|
|
|
3711 efs-process-host host
|
|
|
3712 efs-process-user user
|
|
|
3713 efs-process-prompt-regexp prompt)
|
|
|
3714 (set (make-local-variable 'paragraph-start) comint-prompt-regexp)
|
|
|
3715 ;; Old versions of comint don't have this. It does no harm for
|
|
|
3716 ;; the newer ones.
|
|
|
3717 (set (make-local-variable 'comint-last-input-start) (make-marker))
|
|
|
3718 (goto-char (point-max))
|
|
|
3719 ;; in case there is a running process
|
|
|
3720 (if proc (set-marker (process-mark proc) (point)))
|
|
|
3721 (run-hooks 'efs-mode-hook)))
|
|
|
3722
|
|
|
3723
|
|
|
3724 ;;;; =============================================================
|
|
|
3725 ;;;; >6
|
|
|
3726 ;;;; Sending commands to the FTP server.
|
|
|
3727 ;;;; =============================================================
|
|
|
3728
|
|
|
3729 ;;;; -------------------------------------------------------------
|
|
|
3730 ;;;; General purpose functions for sending commands.
|
|
|
3731 ;;;; -------------------------------------------------------------
|
|
|
3732
|
|
|
3733 (defun efs-raw-send-cmd (proc cmd &optional msg pre-cont cont nowait)
|
|
|
3734 ;; Low-level routine to send the given ftp CMD to the ftp PROCESS.
|
|
|
3735 ;; MSG is an optional message to output before and after the command.
|
|
|
3736 ;; If PRE-CONT is non-nil, it is called immediately after execution
|
|
|
3737 ;; of the command starts, but without waiting for it to finish.
|
|
|
3738 ;; If CONT is non-NIL then it is either a function or a list of function and
|
|
|
3739 ;; some arguments. The function will be called when the ftp command has
|
|
|
3740 ;; completed.
|
|
|
3741 ;; If CONT is NIL then this routine will return \( RESULT . LINE \) where
|
|
|
3742 ;; RESULT is whether the command was successful, and LINE is the line from
|
|
|
3743 ;; the FTP process that caused the command to complete.
|
|
|
3744 ;; If NOWAIT is nil then we will wait for the command to complete before
|
|
|
3745 ;; returning. If NOWAIT is 0, then we will wait until the command starts,
|
|
|
3746 ;; executing before returning. NOWAIT of 1 is like 0, except that the modeline
|
|
|
3747 ;; will indicate an asynch FTP command.
|
|
|
3748 ;; If NOWAIT has any other value, then we will simply queue the
|
|
|
3749 ;; command. In all cases, CONT will still be called
|
|
|
3750
|
|
|
3751 (if (memq (process-status proc) '(run open))
|
|
|
3752 (efs-save-buffer-excursion
|
|
|
3753 (set-buffer (process-buffer proc))
|
|
|
3754
|
|
|
3755 (if efs-process-busy
|
|
|
3756 ;; This function will always wait on a busy process.
|
|
|
3757 ;; Queueing is done by efs-send-cmd.
|
|
|
3758 (let ((efs-process-cmd-waiting t))
|
|
|
3759 (efs-kbd-quit-protect proc
|
|
|
3760 (while efs-process-busy
|
|
|
3761 (accept-process-output)))))
|
|
|
3762
|
|
|
3763 (setq efs-process-string ""
|
|
|
3764 efs-process-result-line ""
|
|
|
3765 efs-process-result-cont-lines ""
|
|
|
3766 efs-process-busy t
|
|
|
3767 efs-process-msg (and efs-verbose msg)
|
|
|
3768 efs-process-continue cont
|
|
|
3769 efs-process-server-confused nil
|
|
|
3770 efs-process-nowait nowait
|
|
|
3771 efs-process-hash-mark-count 0
|
|
|
3772 efs-process-last-percent -1
|
|
|
3773 efs-process-xfer-size 0
|
|
|
3774 efs-process-cmd-counter (% (1+ efs-process-cmd-counter) 16))
|
|
|
3775 (process-kill-without-query proc t)
|
|
|
3776 (and efs-process-msg
|
|
|
3777 (efs-message-p)
|
|
|
3778 (efs-message "%s..." efs-process-msg))
|
|
|
3779 (goto-char (point-max))
|
|
|
3780 (move-marker comint-last-input-start (point))
|
|
|
3781 (move-marker comint-last-input-end (point))
|
|
|
3782 ;; don't insert the password into the buffer on the USER command.
|
|
|
3783 (efs-save-match-data
|
|
|
3784 (if (string-match efs-passwd-cmds cmd)
|
|
|
3785 (insert (setq efs-process-cmd
|
|
|
3786 (substring cmd 0 (match-end 0)))
|
|
|
3787 " Turtle Power!\n")
|
|
|
3788 (setq efs-process-cmd cmd)
|
|
|
3789 (insert cmd "\n")))
|
|
|
3790 (process-send-string proc (concat cmd "\n"))
|
|
|
3791 (set-marker (process-mark proc) (point))
|
|
|
3792 ;; Update the mode-line
|
|
|
3793 (if (and (or efs-mode-line-format efs-ftp-activity-function)
|
|
|
3794 (memq nowait '(t 1)))
|
|
|
3795 (efs-update-mode-line))
|
|
|
3796 (if pre-cont
|
|
|
3797 (let ((efs-nested-cmd t))
|
|
|
3798 (save-excursion
|
|
|
3799 (apply (car pre-cont) (cdr pre-cont)))))
|
|
|
3800 (prog1
|
|
|
3801 (if nowait
|
|
|
3802 nil
|
|
|
3803 ;; hang around for command to complete
|
|
|
3804 ;; Some clients die after the command is sent, if the server
|
|
|
3805 ;; times out. Don't wait on dead processes.
|
|
|
3806 (efs-kbd-quit-protect proc
|
|
|
3807 (while (and efs-process-busy
|
|
|
3808 ;; Need to recheck nowait, since it may get reset
|
|
|
3809 ;; in a cont.
|
|
|
3810 (null efs-process-nowait)
|
|
|
3811 (memq (process-status proc) '(run open)))
|
|
|
3812 (accept-process-output proc)))
|
|
|
3813
|
|
|
3814 ;; cont is called by the process filter
|
|
|
3815 (if cont
|
|
|
3816 ;; Return nil if a cont was called.
|
|
|
3817 ;; Can't return process-result
|
|
|
3818 ;; and process-line since executing
|
|
|
3819 ;; the cont may have changed
|
|
|
3820 ;; the state of the process buffer.
|
|
|
3821 nil
|
|
|
3822 (list efs-process-result
|
|
|
3823 efs-process-result-line
|
|
|
3824 efs-process-result-cont-lines)))
|
|
|
3825
|
|
|
3826 ;; If the process died, the filter would have never got the chance
|
|
|
3827 ;; to call the cont. Try to jump start things.
|
|
|
3828
|
|
|
3829 (if (and (not (memq (process-status proc) '(run open)))
|
|
|
3830 (string-equal efs-process-result-line "")
|
|
|
3831 cont
|
|
|
3832 (equal cont efs-process-continue))
|
|
|
3833 (progn
|
|
|
3834 (setq efs-process-continue nil
|
|
|
3835 efs-process-busy nil)
|
|
|
3836 ;; The process may be in some strange state. Get rid of it.
|
|
|
3837 (condition-case nil (delete-process proc) (error nil))
|
|
|
3838 (efs-call-cont cont 'fatal "" "")))))
|
|
|
3839
|
|
|
3840 (error "FTP process %s has died." (process-name proc))))
|
|
|
3841
|
|
|
3842 (efs-defun efs-quote-string nil (string &optional not-space)
|
|
|
3843 "Quote any characters in STRING that may confuse the ftp process.
|
|
|
3844 If NOT-SPACE is non-nil, then blank characters are not quoted, because
|
|
|
3845 it is assumed that the string will be surrounded by \"'s."
|
|
|
3846 (apply (function concat)
|
|
|
3847 (mapcar (function
|
|
|
3848 (lambda (char)
|
|
|
3849 (if (or (< char ?\ )
|
|
|
3850 (and (null not-space) (= char ?\ ))
|
|
|
3851 (> char ?\~)
|
|
|
3852 (= char ?\")
|
|
|
3853 (= char ?\\))
|
|
|
3854 (vector ?\\ char)
|
|
|
3855 (vector char))))
|
|
|
3856 string)))
|
|
|
3857
|
|
|
3858 (efs-defun efs-fix-path nil (path &optional reverse)
|
|
|
3859 "Convert PATH from a unix format to a non-unix format.
|
|
|
3860 If optional REVERSE, convert in the opposite direction."
|
|
|
3861 (identity path))
|
|
|
3862
|
|
|
3863 (efs-defun efs-fix-dir-path nil (dir-path)
|
|
|
3864 "Convert DIR-PATH from unix format to a non-unix format for a dir listing"
|
|
|
3865 ;; The default def runs for dos-distinct, ka9q, and all the unix's.
|
|
|
3866 ;; To be more careful about distinguishing dirs from plain files,
|
|
|
3867 ;; we append a ".".
|
|
|
3868 (let ((len (length dir-path)))
|
|
|
3869 (if (and (not (zerop len)) (= (aref dir-path (1- len)) ?/))
|
|
|
3870 (concat dir-path ".")
|
|
|
3871 dir-path)))
|
|
|
3872
|
|
|
3873 (defun efs-send-cmd (host user cmd
|
|
|
3874 &optional msg pre-cont cont nowait noretry)
|
|
|
3875 "Find an ftp process connected to HOST logged in as USER and send it CMD.
|
|
|
3876 MSG is an optional status message to be output before and after issuing the
|
|
|
3877 command.
|
|
|
3878
|
|
|
3879 See the documentation for efs-raw-send-cmd for a description of CONT, PRE-CONT
|
|
|
3880 and NOWAIT. Normally, if the command fails it is retried. If NORETRY is
|
|
|
3881 non-nil, this is not done."
|
|
|
3882 ;; Handles conversion to remote pathname syntax and remote ls option
|
|
|
3883 ;; capability. Also, sends umask if nec.
|
|
|
3884
|
|
|
3885 (let ((proc (efs-get-process host user)))
|
|
|
3886
|
|
|
3887 (if (and
|
|
|
3888 (eq nowait t)
|
|
|
3889 (save-excursion
|
|
|
3890 (set-buffer (process-buffer proc))
|
|
|
3891 (or efs-process-busy
|
|
|
3892 efs-process-cmd-waiting)))
|
|
|
3893
|
|
|
3894 (progn
|
|
|
3895 (efs-add-to-queue
|
|
|
3896 host user
|
|
|
3897 ;; Not nec. to store host and user, because the queue is for
|
|
|
3898 ;; a specific host user pair anyway. Because the queue is always
|
|
|
3899 ;; examined when efs-process-busy
|
|
|
3900 ;; is nil, it should be impossible to get into a loop
|
|
|
3901 ;; where we keep re-queueing over and over. To be on the safe
|
|
|
3902 ;; side, store nowait as 1.
|
|
|
3903 (list cmd msg pre-cont cont 1 noretry))
|
|
|
3904 nil)
|
|
|
3905
|
|
|
3906 ;; Send a command.
|
|
|
3907
|
|
|
3908 (let (cmd-string afsc-result afsc-line afsc-cont-lines)
|
|
|
3909
|
|
|
3910 (let ((efs-nested-cmd t)
|
|
|
3911 (cmd0 (car cmd))
|
|
|
3912 (cmd1 (nth 1 cmd))
|
|
|
3913 (cmd2 (nth 2 cmd))
|
|
|
3914 (cmd3 (nth 3 cmd)))
|
|
|
3915
|
|
|
3916 (cond
|
|
|
3917
|
|
|
3918 ((eq cmd0 'quote)
|
|
|
3919 ;; QUOTEd commands
|
|
|
3920 (cond
|
|
|
3921
|
|
|
3922 ((eq cmd1 'site)
|
|
|
3923 ;; SITE commands
|
|
|
3924 (cond
|
|
|
3925 ((memq cmd2 '(umask idle dos exec nfs group gpass))
|
|
|
3926 ;; For UMASK cmd3 = value of umask
|
|
|
3927 ;; For IDLE cmd3 = idle setting, or nil if we're querying.
|
|
|
3928 ;; For DOS and NFS cmd3 is nil.
|
|
|
3929 ;; For EXEC cmd3 is the command to be exec'ed -- a string.
|
|
|
3930 (if cmd3 (setq cmd3 (concat " " cmd3)))
|
|
|
3931 (setq cmd-string (concat "quote site " (symbol-name cmd2)
|
|
|
3932 cmd3)))
|
|
|
3933 ((eq cmd2 'chmod)
|
|
|
3934 (let* ((host-type (efs-host-type host user))
|
|
|
3935 (cmd4 (efs-quote-string
|
|
|
3936 host-type (efs-fix-path host-type (nth 4 cmd)))))
|
|
|
3937 (setq cmd-string (concat "quote site chmod " cmd3 " "
|
|
|
3938 cmd4))))
|
|
|
3939 (t (error "efs: Don't know how to send %s %s %s %s"
|
|
|
3940 cmd0 cmd1 cmd2 cmd3))))
|
|
|
3941
|
|
|
3942 ((memq cmd1 '(pwd xpwd syst pasv noop))
|
|
|
3943 (setq cmd-string (concat "quote " (symbol-name cmd1))))
|
|
|
3944
|
|
|
3945 ;; PORT command (cmd2 is IP + port address)
|
|
|
3946 ((eq cmd1 'port)
|
|
|
3947 (setq cmd-string (concat "quote port " cmd2)))
|
|
|
3948
|
|
|
3949 ((memq cmd1 '(appe retr))
|
|
|
3950 (let ((host-type (efs-host-type host user)))
|
|
|
3951 ;; Set an xfer type
|
|
|
3952 (if cmd3 (efs-set-xfer-type host user cmd3 t))
|
|
|
3953 (setq cmd2 (efs-quote-string host-type
|
|
|
3954 (efs-fix-path host-type cmd2))
|
|
|
3955 cmd-string (concat "quote " (symbol-name cmd1) " "
|
|
|
3956 cmd2))))
|
|
|
3957
|
|
|
3958 ((eq cmd1 'stor)
|
|
|
3959 (let ((host-type (efs-host-type host user)))
|
|
|
3960 (if (memq host-type efs-unix-host-types)
|
|
|
3961 (efs-set-umask host user))
|
|
|
3962 ;; Set an xfer type
|
|
|
3963 (if cmd3 (efs-set-xfer-type host user cmd3 t))
|
|
|
3964 (setq cmd2 (efs-quote-string host-type
|
|
|
3965 (efs-fix-path host-type cmd2))
|
|
|
3966 cmd-string (concat "quote stor " cmd2))))
|
|
|
3967
|
|
|
3968 ((memq cmd1 '(size mdtm rnfr))
|
|
|
3969 (let ((host-type (efs-host-type host user)))
|
|
|
3970 (setq cmd2 (efs-quote-string host-type
|
|
|
3971 (efs-fix-path host-type cmd2))
|
|
|
3972 cmd-string (concat "quote "
|
|
|
3973 (symbol-name cmd1) " " cmd2))))
|
|
|
3974
|
|
|
3975 ((memq cmd1 '(pass user))
|
|
|
3976 (setq cmd-string (concat "quote " (symbol-name cmd1) " " cmd2)))
|
|
|
3977
|
|
|
3978 (t
|
|
|
3979 (error "efs: Don't know how to send %s %s %s %s"
|
|
|
3980 cmd0 cmd1 cmd2 cmd3))))
|
|
|
3981
|
|
|
3982 ;; TYPE command
|
|
|
3983 ((eq cmd0 'type)
|
|
|
3984 (setq cmd-string (concat "type " (symbol-name cmd1))))
|
|
|
3985
|
|
|
3986 ;; DIR command
|
|
|
3987 ;; cmd == 'dir "remote-path" "local-path" "ls-switches"
|
|
|
3988 ((memq cmd0 '(dir nlist))
|
|
|
3989 (let ((host-type (efs-host-type host user))
|
|
|
3990 (listing-type (efs-listing-type host user)))
|
|
|
3991 (setq cmd1 (efs-fix-dir-path host-type cmd1))
|
|
|
3992 (cond
|
|
|
3993 ((memq listing-type efs-nlist-listing-types)
|
|
|
3994 (setq cmd-string (concat efs-nlist-cmd " "
|
|
|
3995 (efs-quote-string host-type cmd1)
|
|
|
3996 " " cmd2)))
|
|
|
3997 ((or (memq host-type efs-dumb-host-types)
|
|
|
3998 (null cmd3))
|
|
|
3999 (setq cmd-string (format "%s %s %s"
|
|
|
4000 (if (eq cmd0 'nlist)
|
|
|
4001 efs-nlist-cmd
|
|
|
4002 "dir")
|
|
|
4003 (efs-quote-string host-type cmd1)
|
|
|
4004 cmd2)))
|
|
|
4005 ((setq cmd-string
|
|
|
4006 (format "%s \"%s %s\" %s"
|
|
|
4007 (if (eq cmd0 'nlist)
|
|
|
4008 efs-nlist-cmd
|
|
|
4009 "ls")
|
|
|
4010 cmd3 (efs-quote-string host-type cmd1 t)
|
|
|
4011 ;; cmd2 is a temp file, not nec. to quote.
|
|
|
4012 cmd2))))))
|
|
|
4013
|
|
|
4014 ;; First argument is the remote pathname
|
|
|
4015 ((memq cmd0 '(delete mkdir rmdir cd))
|
|
|
4016 (let ((host-type (efs-host-type host user)))
|
|
|
4017 (setq cmd1 (efs-quote-string host-type
|
|
|
4018 (efs-fix-path host-type cmd1))
|
|
|
4019 cmd-string (concat (symbol-name cmd0) " " cmd1))))
|
|
|
4020
|
|
|
4021 ;; GET command
|
|
|
4022 ((eq cmd0 'get)
|
|
|
4023 (let ((host-type (efs-host-type host user)))
|
|
|
4024 (if cmd3 (efs-set-xfer-type host user cmd3))
|
|
|
4025 (efs-set-hash-mark-unit host user t)
|
|
|
4026 (setq cmd1 (efs-quote-string host-type
|
|
|
4027 (efs-fix-path host-type cmd1))
|
|
|
4028 cmd2 (efs-quote-string host-type cmd2)
|
|
|
4029 cmd-string (concat "get " cmd1 " " cmd2))))
|
|
|
4030
|
|
|
4031 ;; PUT command
|
|
|
4032 ((eq cmd0 'put)
|
|
|
4033 (let ((host-type (efs-host-type host user)))
|
|
|
4034 (if (memq host-type efs-unix-host-types)
|
|
|
4035 (efs-set-umask host user))
|
|
|
4036 (if cmd3 (efs-set-xfer-type host user cmd3))
|
|
|
4037 (efs-set-hash-mark-unit host user)
|
|
|
4038 (setq cmd2 (efs-quote-string host-type
|
|
|
4039 (efs-fix-path host-type cmd2))
|
|
|
4040 cmd1 (efs-quote-string host-type cmd1)
|
|
|
4041 cmd-string (concat "put " cmd1 " " cmd2))))
|
|
|
4042
|
|
|
4043 ;; APPEND command
|
|
|
4044 ((eq cmd0 'append)
|
|
|
4045 (let ((host-type (efs-host-type host user)))
|
|
|
4046 (if cmd3 (efs-set-xfer-type host user cmd3))
|
|
|
4047 (efs-set-hash-mark-unit host user)
|
|
|
4048 (setq cmd2 (efs-quote-string host-type
|
|
|
4049 (efs-fix-path host-type cmd2))
|
|
|
4050 cmd1 (efs-quote-string host-type cmd1)
|
|
|
4051 cmd-string (concat "append " cmd1 " " cmd2))))
|
|
|
4052
|
|
|
4053 ;; CHMOD command
|
|
|
4054 ((eq cmd0 'chmod)
|
|
|
4055 (let ((host-type (efs-host-type host user)))
|
|
|
4056 (setq cmd2 (efs-quote-string host-type
|
|
|
4057 (efs-fix-path host-type cmd2))
|
|
|
4058 cmd-string (concat "chmod " cmd1 " " cmd2))))
|
|
|
4059
|
|
|
4060 ;; Both arguments are remote pathnames
|
|
|
4061 ((eq cmd0 'rename)
|
|
|
4062 (let ((host-type (efs-host-type host user)))
|
|
|
4063 (setq cmd1 (efs-quote-string host-type
|
|
|
4064 (efs-fix-path host-type cmd1))
|
|
|
4065 cmd2 (efs-quote-string host-type
|
|
|
4066 (efs-fix-path host-type cmd2))
|
|
|
4067 cmd-string (concat "rename " cmd1 " " cmd2))))
|
|
|
4068
|
|
|
4069 (t
|
|
|
4070 (error "efs: Don't know how to send %s %s %s %s"
|
|
|
4071 cmd0 cmd1 cmd2 cmd3))))
|
|
|
4072
|
|
|
4073 ;; Actually send the resulting command.
|
|
|
4074 ;; Why do we use this complicated binding of afsc-{result,line},
|
|
|
4075 ;; rather then use the fact that efs-raw-send-cmd returns?
|
|
|
4076 ;; Because efs-raw-send-cmd returns the result of the first
|
|
|
4077 ;; attempt only. efs-send-cmd should return the result of
|
|
|
4078 ;; the retry, if one was necessary.
|
|
|
4079 ;; Maybe it would be better if efs-raw-send-cmd returned
|
|
|
4080 ;; the result of cont, if nowait was nil? Or maybe still return
|
|
|
4081 ;; \(result line \)? As long as nowait is nil, it should
|
|
|
4082 ;; return something useful.
|
|
|
4083
|
|
|
4084 ;; Beware, if some of the above FTP commands had to restart
|
|
|
4085 ;; the process, PROC won't be set to the right process object.
|
|
|
4086 (setq proc (efs-get-process host user))
|
|
|
4087
|
|
|
4088 (efs-raw-send-cmd
|
|
|
4089 proc
|
|
|
4090 cmd-string
|
|
|
4091 msg
|
|
|
4092 pre-cont
|
|
|
4093 (efs-cont (result line cont-lines) (host user proc cmd msg pre-cont
|
|
|
4094 cont nowait noretry)
|
|
|
4095 (cond ((and (null noretry) (eq result 'fatal))
|
|
|
4096 (let ((retry
|
|
|
4097 (efs-send-cmd
|
|
|
4098 host user cmd msg pre-cont cont
|
|
|
4099 (if (eq nowait t) 1 nowait) t)))
|
|
|
4100 (or cont nowait
|
|
|
4101 (setq afsc-result (car retry)
|
|
|
4102 afsc-line (nth 1 retry)
|
|
|
4103 afsc-cont-lines (nth 2 retry)))))
|
|
|
4104 ((and (eq result 'failed)
|
|
|
4105 (or (memq (car cmd) '(append rename put))
|
|
|
4106 (and (eq (car cmd) 'quote)
|
|
|
4107 (eq (nth 1 cmd) 'stor)))
|
|
|
4108 (efs-save-match-data
|
|
|
4109 (string-match efs-write-protect-msgs line)))
|
|
|
4110 (let ((retry (efs-write-recover
|
|
|
4111 (efs-host-type host)
|
|
|
4112 line cont-lines host user cmd msg pre-cont
|
|
|
4113 cont nowait noretry)))
|
|
|
4114 (or cont nowait
|
|
|
4115 (setq afsc-result (car retry)
|
|
|
4116 afsc-line (nth 1 retry)
|
|
|
4117 afsc-cont-lines (nth 2 retry)))))
|
|
|
4118
|
|
|
4119 (t (if cont
|
|
|
4120 (efs-call-cont cont result line cont-lines)
|
|
|
4121 (or nowait
|
|
|
4122 (setq afsc-result result
|
|
|
4123 afsc-line line
|
|
|
4124 afsc-cont-lines cont-lines))))))
|
|
|
4125 nowait)
|
|
|
4126
|
|
|
4127 (prog1
|
|
|
4128 (if (or nowait cont)
|
|
|
4129 nil
|
|
|
4130 (list afsc-result afsc-line afsc-cont-lines))
|
|
|
4131
|
|
|
4132 ;; Check the queue
|
|
|
4133 (or nowait
|
|
|
4134 efs-nested-cmd
|
|
|
4135 (let ((buff (efs-ftp-process-buffer host user)))
|
|
|
4136 (if (get-buffer buff)
|
|
|
4137 (save-excursion
|
|
|
4138 (set-buffer buff)
|
|
|
4139 (if efs-process-q
|
|
|
4140 (let ((next (car efs-process-q)))
|
|
|
4141 (setq efs-process-q (cdr efs-process-q))
|
|
|
4142 (apply 'efs-send-cmd host user next))))))))))))
|
|
|
4143
|
|
|
4144 (efs-defun efs-write-recover nil
|
|
|
4145 (line cont-lines host user cmd msg pre-cont cont nowait noretry)
|
|
|
4146 "Called when a write command fails with `efs-write-protect-msgs'.
|
|
|
4147 Should return \(result line cont-lines\), like `efs-raw-send-cmd'."
|
|
|
4148 ;; This default version doesn't do anything.
|
|
|
4149 (if cont
|
|
|
4150 (progn
|
|
|
4151 (efs-call-cont cont 'failed line cont-lines)
|
|
|
4152 nil)
|
|
|
4153 (if nowait nil (list 'failed line cont-lines))))
|
|
|
4154
|
|
|
4155 ;;;; ---------------------------------------------------------------------
|
|
|
4156 ;;;; The login sequence. (The follows RFC959 rather tightly. If a server
|
|
|
4157 ;;;; can't even get the login codes right, it is
|
|
|
4158 ;;;; pretty much scrap metal.)
|
|
|
4159 ;;;; ---------------------------------------------------------------------
|
|
|
4160
|
|
114
|
4161 ;;;###autoload
|
|
98
|
4162 (defun efs-nslookup-host (host)
|
|
|
4163 "Attempt to resolve the given HOSTNAME using nslookup if possible."
|
|
|
4164 (interactive "sHost: ")
|
|
|
4165 (if efs-nslookup-program
|
|
|
4166 (let* ((default-directory exec-directory)
|
|
|
4167 (default-major-mode 'fundamental-mode)
|
|
|
4168 (process-connection-type nil)
|
|
|
4169 (proc (start-process " *nslookup*" " *nslookup*"
|
|
|
4170 efs-nslookup-program host))
|
|
|
4171 (res host))
|
|
|
4172 (process-kill-without-query proc)
|
|
|
4173 (save-excursion
|
|
|
4174 (set-buffer (process-buffer proc))
|
|
|
4175 (let ((quit-flag nil)
|
|
|
4176 (inhibit-quit nil))
|
|
|
4177 (while (memq (process-status proc) '(run open))
|
|
|
4178 (accept-process-output proc)))
|
|
|
4179 (goto-char (point-min))
|
|
|
4180 (if (re-search-forward
|
|
|
4181 "Name:.*\nAddress\\(es\\)?: *\\([.0-9]+\\)$" nil t)
|
|
|
4182 (setq res (buffer-substring (match-beginning 2)
|
|
|
4183 (match-end 2))))
|
|
|
4184 (kill-buffer (current-buffer)))
|
|
|
4185 (if (interactive-p)
|
|
|
4186 (message "%s: %s" host res))
|
|
|
4187 res)
|
|
|
4188 (if (interactive-p)
|
|
|
4189 (message
|
|
|
4190 "No nslookup program. See the variable efs-nslookup-program."))
|
|
|
4191 host))
|
|
|
4192
|
|
|
4193 (defun efs-login (host user proc)
|
|
|
4194 "Connect to the FTP-server on HOST as USER.
|
|
|
4195 PROC is the process to the FTP-client. Doesn't call efs-save-match-data.
|
|
|
4196 You must do that yourself."
|
|
|
4197 (let ((gate (efs-use-gateway-p host)))
|
|
|
4198 (if (eq gate 'kerberos)
|
|
|
4199 (progn
|
|
|
4200 (setq proc (efs-kerberos-login host user proc))
|
|
|
4201 (efs-login-send-user host user proc gate))
|
|
|
4202 (let ((to (if (memq gate '(proxy local raptor))
|
|
|
4203 efs-gateway-host
|
|
|
4204 host))
|
|
|
4205 port cmd result)
|
|
|
4206 (if (string-match "#" to)
|
|
|
4207 (setq port (substring to (match-end 0))
|
|
|
4208 to (substring to 0 (match-beginning 0))))
|
|
|
4209 (and efs-nslookup-on-connect
|
|
|
4210 (string-match "[^0-9.]" to)
|
|
|
4211 (setq to (efs-nslookup-host to)))
|
|
|
4212 (setq cmd (concat "open " to))
|
|
|
4213 (if port (setq cmd (concat cmd " " port)))
|
|
|
4214
|
|
|
4215 ;; Send OPEN command.
|
|
|
4216 (setq result (efs-raw-send-cmd proc cmd nil))
|
|
|
4217
|
|
|
4218 (and (eq gate 'interlock) (string-match "^331 " (nth 1 result))
|
|
|
4219 (setq result (efs-login-send-pass
|
|
|
4220 efs-gateway-host
|
|
|
4221 (efs-get-user efs-gateway-host) proc)))
|
|
|
4222
|
|
|
4223 ;; Analyze result of OPEN.
|
|
|
4224 (if (car result)
|
|
|
4225 (progn
|
|
|
4226 (condition-case nil (delete-process proc) (error nil))
|
|
|
4227 (efs-error host user (concat "OPEN request failed: "
|
|
|
4228 (nth 1 result))))
|
|
|
4229 (efs-login-send-user host user proc gate))))))
|
|
|
4230
|
|
|
4231 (defun efs-login-send-user (host user proc &optional gate retry)
|
|
|
4232 "Send user command to HOST and USER. PROC is the ftp client process.
|
|
|
4233 Optional argument GATE specifies which type of gateway is being used.
|
|
|
4234 RETRY argument specifies to try twice if we get a 421 response."
|
|
|
4235 (let ((cmd (cond
|
|
|
4236 ((memq gate '(local proxy interlock))
|
|
|
4237 (format "quote USER \"%s\"@%s" user
|
|
|
4238 (if (and efs-nslookup-on-connect
|
|
|
4239 (string-match "[^0-9.]" host))
|
|
|
4240 (efs-nslookup-host host)
|
|
|
4241 host)))
|
|
|
4242 ((eq gate 'raptor)
|
|
|
4243 (format "quote USER \"%s\"@%s %s" user
|
|
|
4244 (if (and efs-nslookup-on-connect
|
|
|
4245 (string-match "[^0-9.]" host))
|
|
|
4246 (efs-nslookup-host host)
|
|
|
4247 host)
|
|
|
4248 (nth 3 efs-gateway-type)))
|
|
|
4249 ((eq gate 'kerberos)
|
|
|
4250 (let ((to host)
|
|
|
4251 port)
|
|
|
4252 (if (string-match "#" host)
|
|
|
4253 (progn
|
|
|
4254 (setq to (substring host 0 (match-beginning 0))
|
|
|
4255 port (substring host (match-end 0)))
|
|
|
4256 (and efs-nslookup-on-connect
|
|
|
4257 (string-match "[^0-9.]" to)
|
|
|
4258 (efs-nslookup-host to))
|
|
|
4259 (setq to (concat to "@" port))))
|
|
|
4260 (format "quote user \"%s\"@%s" user to)))
|
|
|
4261 (t
|
|
|
4262 (format "quote user \"%s\"" user))))
|
|
|
4263 (msg (format "Logging in as user %s%s..." user
|
|
|
4264 (if (memq gate '(proxy local raptor kerberos))
|
|
|
4265 (concat "@" host) "")))
|
|
|
4266 result code)
|
|
|
4267
|
|
|
4268 ;; Send the message by hand so that we can report on the size
|
|
|
4269 ;; of the MOTD.
|
|
|
4270 (message msg)
|
|
|
4271
|
|
|
4272 ;; Send USER command.
|
|
|
4273 (setq result (efs-raw-send-cmd proc cmd nil))
|
|
|
4274
|
|
|
4275 ;; Analyze result of USER (this follows RFC959 strictly)
|
|
|
4276 (if (< (length (nth 1 result)) 4)
|
|
|
4277 (progn
|
|
|
4278 (condition-case nil (delete-process proc) (error nil))
|
|
|
4279 (efs-error host user
|
|
|
4280 (concat "USER request failed: " (nth 1 result))))
|
|
|
4281
|
|
|
4282 (setq code (substring (nth 1 result) 0 4))
|
|
|
4283 (cond
|
|
|
4284
|
|
|
4285 ((string-equal "331 " code)
|
|
|
4286 ;; Need password
|
|
|
4287 (setq result (efs-login-send-pass host user proc gate)))
|
|
|
4288
|
|
|
4289 ((string-equal "332 " code)
|
|
|
4290 ;; Need an account, but no password
|
|
|
4291 (setq result (efs-login-send-acct host user proc gate)))
|
|
|
4292
|
|
|
4293 ((null (car result))
|
|
|
4294 ;; logged in proceed
|
|
|
4295 nil)
|
|
|
4296
|
|
|
4297 ((and (or (string-equal "530 " code) (string-equal "421 " code))
|
|
|
4298 (efs-anonymous-p user)
|
|
|
4299 (or (string-match efs-too-many-users-msgs (nth 1 result))
|
|
|
4300 (string-match efs-too-many-users-msgs (nth 2 result))))
|
|
|
4301 (if (save-window-excursion
|
|
|
4302 (condition-case nil
|
|
|
4303 (display-buffer (process-buffer proc))
|
|
|
4304 (error nil))
|
|
|
4305 (y-or-n-p (format
|
|
|
4306 "Too many users for %s@%s. Try again? "
|
|
|
4307 user host)))
|
|
|
4308 (progn
|
|
|
4309 ;; Set result to nil if we are doing a retry, so done
|
|
|
4310 ;; message only gets sent once.
|
|
|
4311 (setq result nil)
|
|
|
4312 (if (string-equal code "530 ")
|
|
|
4313 (efs-login-send-user host user proc gate t)
|
|
|
4314 (efs-get-process host user)))
|
|
|
4315 (signal 'quit nil)))
|
|
|
4316
|
|
|
4317 ((and retry (string-equal code "421 "))
|
|
|
4318 (setq result nil)
|
|
|
4319 (efs-get-process host user))
|
|
|
4320
|
|
|
4321 (t ; bombed
|
|
|
4322 (condition-case nil (delete-process proc) (error nil))
|
|
|
4323 ;; Wrong username?
|
|
|
4324 (efs-set-user host nil)
|
|
|
4325 (efs-error host user
|
|
|
4326 (concat "USER request failed: " (nth 1 result)))))
|
|
|
4327 (and (null (car result))
|
|
|
4328 (stringp (nth 2 result))
|
|
|
4329 (message "%sdone%s" msg
|
|
|
4330 (let ((n (efs-occur-in-string ?\n (nth 2 result))))
|
|
|
4331 (if (> n 1)
|
|
|
4332 (format "; MOTD of %d lines" n)
|
|
|
4333 "")))))))
|
|
|
4334
|
|
|
4335 (defun efs-login-send-pass (host user proc &optional gate)
|
|
|
4336 "Sends password to HOST and USER. PROC is the ftp client process.
|
|
|
4337 Doesn't call efs-save-match data. You must do that yourself."
|
|
|
4338 ;; Note that efs-get-password always returns something.
|
|
|
4339 ;; It prompts the user if necessary. Even if the returned password is
|
|
|
4340 ;; \"\", send it, because we wouldn't be running this function
|
|
|
4341 ;; if the server wasn't insisting on a password.
|
|
|
4342 (let* ((pass "")
|
|
|
4343 (qpass "")
|
|
|
4344 (cmd "")
|
|
|
4345 (result (unwind-protect
|
|
|
4346 (progn
|
|
|
4347 (condition-case nil
|
|
|
4348 (setq pass (efs-get-passwd host user))
|
|
|
4349 (quit (condition-case nil
|
|
|
4350 (kill-buffer (process-buffer proc))
|
|
|
4351 (error nil))
|
|
|
4352 (signal 'quit nil)))
|
|
|
4353 (setq cmd (concat
|
|
|
4354 "quote pass "
|
|
|
4355 (setq qpass (efs-quote-string nil pass t))))
|
|
|
4356 (efs-raw-send-cmd proc cmd))
|
|
|
4357 (fillarray pass 0)
|
|
|
4358 (fillarray qpass 0)
|
|
|
4359 (fillarray cmd 0)))
|
|
|
4360 (code (and (>= (length (nth 1 result)) 4)
|
|
|
4361 (substring (nth 1 result) 0 4))))
|
|
|
4362 (or code (setq code ""))
|
|
|
4363 ;; Analyze the result.
|
|
|
4364 (cond
|
|
|
4365 ((string-equal code "332 ")
|
|
|
4366 ;; require an account passwd
|
|
|
4367 (setq result (efs-login-send-acct host user proc gate)))
|
|
|
4368 ((null (car result))
|
|
|
4369 ;; logged in proceed
|
|
|
4370 nil)
|
|
|
4371 ((or (string-equal code "530 ") (string-equal code "421 "))
|
|
|
4372 ;; Give the user another chance
|
|
|
4373 (condition-case nil
|
|
|
4374 (if (efs-anonymous-p user)
|
|
|
4375 (if (or (string-match efs-too-many-users-msgs (nth 1 result))
|
|
|
4376 (string-match efs-too-many-users-msgs (nth 2 result)))
|
|
|
4377 (if (save-window-excursion
|
|
|
4378 (condition-case nil
|
|
|
4379 (display-buffer (process-buffer proc))
|
|
|
4380 (error nil))
|
|
|
4381 (y-or-n-p (format
|
|
|
4382 "Too many users for %s@%s. Try again? "
|
|
|
4383 user host)))
|
|
|
4384 (progn
|
|
|
4385 ;; Return nil if we are doing a retry, so done
|
|
|
4386 ;; message only gets sent once.
|
|
|
4387 (setq result nil)
|
|
|
4388 (if (string-equal code "530 ")
|
|
|
4389 (efs-login-send-user host user proc gate)
|
|
|
4390 (efs-get-process host user)))
|
|
|
4391 (signal 'quit nil))
|
|
|
4392 (unwind-protect
|
|
|
4393 (efs-set-passwd
|
|
|
4394 host user
|
|
|
4395 (save-window-excursion
|
|
|
4396 (condition-case nil
|
|
|
4397 (display-buffer (process-buffer proc))
|
|
|
4398 (error nil))
|
|
|
4399 (setq pass
|
|
|
4400 (read-passwd
|
|
|
4401 (format
|
|
|
4402 "Password for %s@%s failed. Try again: "
|
|
|
4403 user host)))))
|
|
|
4404 (fillarray pass 0))
|
|
|
4405 (setq result nil)
|
|
|
4406 (efs-login-send-user host user proc gate))
|
|
|
4407 (unwind-protect
|
|
|
4408 (efs-set-passwd
|
|
|
4409 host user
|
|
|
4410 (setq pass
|
|
|
4411 (read-passwd
|
|
|
4412 (format "Password for %s@%s failed. Try again: "
|
|
|
4413 user host))))
|
|
|
4414 (fillarray pass 0))
|
|
|
4415 (setq result nil)
|
|
|
4416 (efs-login-send-user host user proc gate))
|
|
|
4417 (quit (condition-case nil (delete-process proc) (error nil))
|
|
|
4418 (efs-set-user host nil)
|
|
|
4419 (efs-set-passwd host user nil)
|
|
|
4420 (signal 'quit nil))
|
|
|
4421 (error (condition-case nil (delete-process proc) (error nil))
|
|
|
4422 (efs-set-user host nil)
|
|
|
4423 (efs-set-passwd host user nil)
|
|
|
4424 (efs-error host user "PASS request failed."))))
|
|
|
4425 (t ; bombed for unexplained reasons
|
|
|
4426 (condition-case nil (delete-process proc) (error nil))
|
|
|
4427 (efs-error host user (concat "PASS request failed: " (nth 1 result)))))
|
|
|
4428 result))
|
|
|
4429
|
|
|
4430 (defun efs-login-send-acct (host user proc &optional gate)
|
|
|
4431 "Sends account password to HOST and USER. PROC is the ftp client process.
|
|
|
4432 Doesn't call efs-save-match data. You must do that yourself."
|
|
|
4433 (let* ((acct "")
|
|
|
4434 (qacct "")
|
|
|
4435 (cmd "")
|
|
|
4436 (result (unwind-protect
|
|
|
4437 (progn
|
|
|
4438 ;; The raptor gateway requires us to send a gateway
|
|
|
4439 ;; authentication password for account. What if the
|
|
|
4440 ;; remote server wants one too?
|
|
|
4441 (setq acct (if (eq gate 'raptor)
|
|
|
4442 (efs-get-account
|
|
|
4443 efs-gateway-host
|
|
|
4444 (nth 3 efs-gateway-type) nil t)
|
|
|
4445 (efs-get-account host user nil t))
|
|
|
4446 qacct (efs-quote-string nil acct t)
|
|
|
4447 cmd (concat "quote acct " qacct))
|
|
|
4448 (efs-raw-send-cmd proc cmd))
|
|
|
4449 (fillarray acct 0)
|
|
|
4450 (fillarray qacct 0)
|
|
|
4451 (fillarray cmd 0))))
|
|
|
4452 ;; Analyze the result
|
|
|
4453 (cond
|
|
|
4454 ((null (car result))
|
|
|
4455 ;; logged in proceed
|
|
|
4456 nil)
|
|
|
4457 ((eq (car result) 'failed)
|
|
|
4458 ;; Give the user another chance
|
|
|
4459 (condition-case nil
|
|
|
4460 (progn
|
|
|
4461 (unwind-protect
|
|
|
4462 (progn
|
|
|
4463 (setq acct (read-passwd
|
|
|
4464 (format
|
|
|
4465 "Account password for %s@%s failed. Try again: "
|
|
|
4466 user host)))
|
|
|
4467 (or (and efs-high-security-hosts
|
|
|
4468 (string-match efs-high-security-hosts
|
|
|
4469 (format "%s@%s" user host)))
|
|
|
4470 (efs-set-account host user nil acct)))
|
|
|
4471 (fillarray acct 0))
|
|
|
4472 (setq result (efs-login-send-user host user proc gate)))
|
|
|
4473 (quit (condition-case nil (delete-process proc) (error nil)))
|
|
|
4474 (error (condition-case nil (delete-process proc) (error nil))
|
|
|
4475 (efs-error host user "ACCT request failed."))))
|
|
|
4476 (t ; bombed for unexplained reasons
|
|
|
4477 (condition-case nil (delete-process proc) (error nil))
|
|
|
4478 (efs-error host user (concat "ACCT request failed: " (nth 1 result)))))
|
|
|
4479 result))
|
|
|
4480
|
|
|
4481 ;;;; ----------------------------------------------------------------------
|
|
|
4482 ;;;; Changing working directory.
|
|
|
4483 ;;;; ----------------------------------------------------------------------
|
|
|
4484
|
|
|
4485 (defun efs-raw-send-cd (host user dir &optional no-error)
|
|
|
4486 ;; If NO-ERROR, doesn't barf, but just returns success (t) or failure (nil).
|
|
|
4487 ;; This does not use efs-send-cmd.
|
|
|
4488 ;; Also DIR must be in the syntax of the remote host-type.
|
|
|
4489 (let* ((cmd (concat "cd " dir))
|
|
|
4490 cd-result cd-line)
|
|
|
4491 (efs-raw-send-cmd
|
|
|
4492 (efs-get-process host user)
|
|
|
4493 cmd nil nil
|
|
|
4494 (efs-cont (result line cont-lines) (cmd)
|
|
|
4495 (if (eq result 'fatal)
|
|
|
4496 (efs-raw-send-cmd
|
|
|
4497 (efs-get-process host user)
|
|
|
4498 cmd nil nil
|
|
|
4499 (function (lambda (result line cont-lines)
|
|
|
4500 (setq cd-result result
|
|
|
4501 cd-line line))))
|
|
|
4502 (setq cd-result result
|
|
|
4503 cd-line line))))
|
|
|
4504 (if no-error
|
|
|
4505 (null cd-result)
|
|
|
4506 (if cd-result
|
|
|
4507 (efs-error host user (concat "CD failed: " cd-line))))))
|
|
|
4508
|
|
|
4509 ;;;; --------------------------------------------------------------
|
|
|
4510 ;;;; Getting a PWD.
|
|
|
4511 ;;;; --------------------------------------------------------------
|
|
|
4512
|
|
|
4513 (defun efs-unquote-quotes (string)
|
|
|
4514 ;; Unquote \"\"'s in STRING to \".
|
|
|
4515 (let ((start 0)
|
|
|
4516 new)
|
|
|
4517 (while (string-match "\"\"" string start)
|
|
|
4518 (setq new (concat new (substring
|
|
|
4519 string start (1+ (match-beginning 0))))
|
|
|
4520 start (match-end 0)))
|
|
|
4521 (if new
|
|
|
4522 (concat new (substring string start))
|
|
|
4523 string)))
|
|
|
4524
|
|
|
4525 (efs-defun efs-send-pwd nil (host user &optional xpwd)
|
|
|
4526 "Attempts to get the current working directory for the given HOST/USER pair.
|
|
|
4527 Returns \( DIR . LINE \) where DIR is either the directory or NIL if not found,
|
|
|
4528 and LINE is the relevant success or fail line from the FTP-server. If the
|
|
|
4529 optional arg XPWD is given, uses this server command instead of PWD."
|
|
|
4530 (let* ((result (efs-send-cmd host user
|
|
|
4531 (list 'quote (if xpwd 'xpwd 'pwd))
|
|
|
4532 "Getting pwd"))
|
|
|
4533 (line (nth 1 result))
|
|
|
4534 dir)
|
|
|
4535 (or (car result)
|
|
|
4536 (efs-save-match-data
|
|
|
4537 (if (string-match "\"\\(.*\\)\"[^\"]*$" line)
|
|
|
4538 (setq dir (efs-unquote-quotes (substring line (match-beginning 1)
|
|
|
4539 (match-end 1))))
|
|
|
4540 (if (string-match " \\([^ ]+\\) " line) ; stone-age servers!
|
|
|
4541 (setq dir (substring line
|
|
|
4542 (match-beginning 1)
|
|
|
4543 (match-end 1)))))))
|
|
|
4544 (cons dir line)))
|
|
|
4545
|
|
|
4546 (efs-defun efs-send-pwd super-dumb-unix (host user &optional xpwd)
|
|
|
4547 ;; Guess at the pwd for a unix host that doesn't support pwd.
|
|
|
4548 (if (efs-anonymous-p user)
|
|
|
4549 ;; guess
|
|
|
4550 (cons "/" "")
|
|
|
4551 ;; Who knows?
|
|
|
4552 (message "Can't obtain pwd for %s" host)
|
|
|
4553 (ding)
|
|
|
4554 (sleep-for 2)
|
|
|
4555 (message "All file names must be specified as full paths.")
|
|
|
4556 (cons nil "")))
|
|
|
4557
|
|
|
4558 ;;;; --------------------------------------------------------
|
|
|
4559 ;;;; Getting the SIZE of a remote file.
|
|
|
4560 ;;;; --------------------------------------------------------
|
|
|
4561
|
|
|
4562 (defun efs-send-size (host user file)
|
|
|
4563 "For HOST and USER, get the size of FILE in bytes.
|
|
|
4564 This returns a list \( SIZE . LINE \), where SIZE is the file size in bytes,
|
|
|
4565 or nil if this couldn't be determined, and LINE is the output line of the
|
|
|
4566 FTP server."
|
|
|
4567 (efs-save-match-data
|
|
|
4568 (let ((result (efs-send-cmd host user (list 'quote 'size file))))
|
|
|
4569 (setcar result
|
|
|
4570 (and (null (car result))
|
|
|
4571 (string-match "^213 +\\([0-9]+\\)$" (nth 1 result))
|
|
|
4572 (string-to-int
|
|
|
4573 (substring
|
|
|
4574 (cdr result)
|
|
|
4575 (match-beginning 1) (match-end 1)))))
|
|
|
4576 result)))
|
|
|
4577
|
|
|
4578 ;;;; ------------------------------------------------------------
|
|
|
4579 ;;;; umask support
|
|
|
4580 ;;;; ------------------------------------------------------------
|
|
|
4581
|
|
|
4582 (defun efs-umask (user)
|
|
|
4583 "Returns the umask that efs will use for USER.
|
|
|
4584 If USER is root or anonymous, then the values of efs-root-umask
|
|
|
4585 and efs-anonymous-umask, respectively, take precedence, to be followed
|
|
|
4586 by the value of efs-umask, and if this is nil, it returns your current
|
|
|
4587 umask on the local machine. Returns nil if this can't be determined."
|
|
|
4588 (or
|
|
|
4589 (and (string-equal user "root") efs-root-umask)
|
|
|
4590 (and (efs-anonymous-p user)
|
|
|
4591 efs-anonymous-umask)
|
|
|
4592 efs-umask
|
|
|
4593 (let* ((shell (or (and (boundp 'explicit-shell-file-name)
|
|
|
4594 explicit-shell-file-name)
|
|
|
4595 (getenv "ESHELL")
|
|
|
4596 (getenv "SHELL")
|
|
|
4597 "/bin/sh"))
|
|
|
4598 (default-major-mode 'fundamental-mode)
|
|
|
4599 (default-directory exec-directory)
|
|
|
4600 (buff (get-buffer-create " *efs-umask-data*")))
|
|
|
4601 (unwind-protect
|
|
|
4602 (save-excursion
|
|
|
4603 (set-buffer buff)
|
|
|
4604 (call-process shell nil buff nil "-c" "umask")
|
|
|
4605 (goto-char (point-min))
|
|
|
4606 (if (re-search-forward "[0-7]?[0-7]?[0-7]" nil t)
|
|
|
4607 (string-to-int (buffer-substring (match-beginning 0)
|
|
|
4608 (match-end 0)))))
|
|
|
4609 (kill-buffer buff)))))
|
|
|
4610
|
|
|
4611 (defun efs-send-umask (host user mask)
|
|
|
4612 "Sets the umask on HOST for USER to MASK.
|
|
|
4613 Returns t for success, nil for failure."
|
|
|
4614 (interactive
|
|
|
4615 (let* ((path (or buffer-file-name
|
|
|
4616 (and (eq major-mode 'dired-mode)
|
|
|
4617 dired-directory)))
|
|
|
4618 (parsed (and path (efs-ftp-path path)))
|
|
|
4619 (default-host (car parsed))
|
|
|
4620 (default-user (nth 1 parsed))
|
|
|
4621 (default-mask (efs-umask default-user)))
|
|
|
4622 (list
|
|
|
4623 (read-string "Host: " default-host)
|
|
|
4624 (read-string "User: " default-user)
|
|
|
4625 (read-string "Umask: " (int-to-string default-mask)))))
|
|
|
4626 (let (int-mask)
|
|
|
4627 (if (integerp mask)
|
|
|
4628 (setq int-mask mask
|
|
|
4629 mask (int-to-string mask))
|
|
|
4630 (setq int-mask (string-to-int mask)))
|
|
|
4631 (or (string-match "^ *[0-7]?[0-7]?[0-7] *$" mask)
|
|
|
4632 (error "Invalid umask %s" mask))
|
|
|
4633 (efs-send-cmd host user
|
|
|
4634 (list 'quote 'site 'umask mask)
|
|
|
4635 (concat "Setting umask to " mask)
|
|
|
4636 (list
|
|
|
4637 (function
|
|
|
4638 (lambda (int-mask)
|
|
|
4639 (let ((buff (efs-ftp-process-buffer host user)))
|
|
|
4640 (if (get-buffer buff)
|
|
|
4641 (save-excursion
|
|
|
4642 (set-buffer buff)
|
|
|
4643 (setq efs-process-umask int-mask))))))
|
|
|
4644 int-mask)
|
|
|
4645 (efs-cont (result line cont-lines) (host user mask)
|
|
|
4646 (if result
|
|
|
4647 (let ((buff (efs-ftp-process-buffer host user)))
|
|
|
4648 (efs-set-host-property host 'umask-failed t)
|
|
|
4649 (if (get-buffer buff)
|
|
|
4650 (save-excursion
|
|
|
4651 (set-buffer buff)
|
|
|
4652 (setq efs-process-umask nil)))
|
|
|
4653 (message
|
|
|
4654 "Unable to set umask to %s on %s" mask host)
|
|
|
4655 (if efs-ding-on-umask-failure
|
|
|
4656 (progn
|
|
|
4657 (ding)
|
|
|
4658 (sit-for 1))))))
|
|
|
4659 0))) ; Do this NOWAIT = 0
|
|
|
4660
|
|
|
4661 (defun efs-set-umask (host user)
|
|
|
4662 "Sets the umask for HOST and USER, if it has not already been set."
|
|
|
4663 (save-excursion
|
|
|
4664 (set-buffer (process-buffer (efs-get-process host user)))
|
|
|
4665 (if (or efs-process-umask (efs-get-host-property host 'umask-failed))
|
|
|
4666 nil
|
|
|
4667 (let ((umask (efs-umask user)))
|
|
|
4668 (efs-send-umask host user umask)
|
|
|
4669 t)))) ; Tell the caller that we did something.
|
|
|
4670
|
|
|
4671 (defun efs-modes-from-umask (umask)
|
|
|
4672 ;; Given the 3 digit octal integer umask, returns the decimal integer
|
|
|
4673 ;; according to chmod that a file would be written with.
|
|
|
4674 ;; Assumes only ordinary files, so ignores x bits.
|
|
|
4675 (let* ((others (% umask 10))
|
|
|
4676 (umask (/ umask 10))
|
|
|
4677 (group (% umask 10))
|
|
|
4678 (umask (/ umask 10))
|
|
|
4679 (owner (% umask 10))
|
|
|
4680 (factor 1))
|
|
|
4681 (apply '+
|
|
|
4682 (mapcar
|
|
|
4683 (function
|
|
|
4684 (lambda (x)
|
|
|
4685 (prog1
|
|
|
4686 (* factor (- 6 (- x (% x 2))))
|
|
|
4687 (setq factor (* factor 8)))))
|
|
|
4688 (list others group owner)))))
|
|
|
4689
|
|
|
4690 ;;;; ------------------------------------------------------------
|
|
|
4691 ;;;; Idle time manipulation.
|
|
|
4692 ;;;; ------------------------------------------------------------
|
|
|
4693
|
|
|
4694 (defun efs-check-idle (host user)
|
|
|
4695 ;; We just toss it in the queue to run whenever there's time.
|
|
|
4696 ;; Just fail quietly if this doesn't work.
|
|
|
4697 (if (and (or efs-maximize-idle efs-expire-ftp-buffers)
|
|
|
4698 (memq (efs-host-type host) efs-idle-host-types)
|
|
|
4699 (null (efs-get-host-property host 'idle-failed)))
|
|
|
4700 (let ((buffname (efs-ftp-process-buffer host user)))
|
|
|
4701 (efs-add-to-queue
|
|
|
4702 host user
|
|
|
4703 (list '(quote site idle)
|
|
|
4704 nil nil
|
|
|
4705 (efs-cont (result line cont-lines) (host user buffname)
|
|
|
4706 (efs-save-match-data
|
|
|
4707 (if (and (null result)
|
|
|
4708 (string-match efs-idle-msgs line))
|
|
|
4709 (let ((max (substring line (match-beginning 2)
|
|
|
4710 (match-end 2))))
|
|
|
4711 (if (get-buffer buffname)
|
|
|
4712 (save-excursion
|
|
|
4713 (set-buffer buffname)
|
|
|
4714 (setq efs-process-idle-time
|
|
|
4715 (string-to-int
|
|
|
4716 (substring line (match-beginning 1)
|
|
|
4717 (match-end 1))))))
|
|
|
4718 (if (and efs-maximize-idle
|
|
|
4719 (not (efs-anonymous-p user)))
|
|
|
4720 (efs-add-to-queue
|
|
|
4721 host user
|
|
|
4722 (list
|
|
|
4723 (list 'quote 'site 'idle max)
|
|
|
4724 nil nil
|
|
|
4725 (efs-cont (result line cont-lines) (buffname
|
|
|
4726 max)
|
|
|
4727 (and (null result)
|
|
|
4728 (get-buffer buffname)
|
|
|
4729 (save-excursion
|
|
|
4730 (set-buffer buffname)
|
|
|
4731 (setq efs-process-idle-time
|
|
|
4732 (string-to-int max)))))
|
|
|
4733 0))))
|
|
|
4734 (efs-set-host-property host 'idle-failed t))))
|
|
|
4735 0 nil))))) ; Using NOWAIT = 0 inhibits mode line toggling.
|
|
|
4736
|
|
|
4737
|
|
|
4738 ;;;; ------------------------------------------------------------
|
|
|
4739 ;;;; Sending the SYST command for system type.
|
|
|
4740 ;;;; ------------------------------------------------------------
|
|
|
4741
|
|
|
4742 (defun efs-get-syst (host user)
|
|
|
4743 "Use SYST to get the remote system type.
|
|
|
4744 Returns the system type as a string if this succeeds, otherwise nil."
|
|
|
4745 (let* ((result (efs-send-cmd host user '(quote syst)))
|
|
|
4746 (line (nth 1 result)))
|
|
|
4747 (efs-save-match-data
|
|
|
4748 (and (null (car result))
|
|
|
4749 (string-match efs-syst-msgs line)
|
|
|
4750 (substring line (match-end 0))))))
|
|
|
4751
|
|
|
4752 ;;;; ------------------------------------------------------------
|
|
|
4753 ;;;; File transfer representation type support
|
|
|
4754 ;;;; ------------------------------------------------------------
|
|
|
4755
|
|
|
4756 ;;; Legal representation types are: image, ascii, ebcdic, tenex
|
|
|
4757
|
|
|
4758 (efs-defun efs-file-type nil (path)
|
|
|
4759 ;; Returns the file type for PATH, the full efs path, with filename FILE.
|
|
|
4760 ;; The return value is one of 'text, '8-binary, or '36-binary.
|
|
|
4761 (let ((parsed (efs-ftp-path path)))
|
|
|
4762 (efs-save-match-data
|
|
|
4763 (cond
|
|
|
4764 ;; There is no special significance to temp names, but we assume that
|
|
|
4765 ;; they exist on an 8-bit byte machine.
|
|
|
4766 ((or (null path)
|
|
|
4767 (let ((temp (intern-soft path efs-tmp-name-obarray)))
|
|
|
4768 (and temp (memq temp efs-tmp-name-files))))
|
|
|
4769 '8-binary)
|
|
|
4770 ((and (null parsed) (file-exists-p path))
|
|
|
4771 (efs-local-file-type path))
|
|
|
4772 ;; test special hosts
|
|
|
4773 ((and parsed
|
|
|
4774 efs-binary-file-host-regexp
|
|
|
4775 (let ((case-fold-search t))
|
|
|
4776 (string-match efs-binary-file-host-regexp (car parsed))))
|
|
|
4777 '8-binary)
|
|
|
4778 (t
|
|
|
4779 ;; Test file names
|
|
|
4780 (let ((file (efs-internal-file-name-nondirectory
|
|
|
4781 (or (nth 2 parsed) path))))
|
|
|
4782 (cond
|
|
|
4783 ;; test for PDP-10 binaries
|
|
|
4784 ((and efs-36-bit-binary-file-name-regexp
|
|
|
4785 (string-match efs-36-bit-binary-file-name-regexp file))
|
|
|
4786 '36-binary)
|
|
|
4787 ((and efs-binary-file-name-regexp
|
|
|
4788 (string-match efs-binary-file-name-regexp file))
|
|
|
4789 '8-binary)
|
|
|
4790 ((and efs-text-file-name-regexp
|
|
|
4791 (string-match efs-text-file-name-regexp file))
|
|
|
4792 'text)
|
|
|
4793 ;; by default
|
|
|
4794 (t
|
|
|
4795 '8-binary))))))))
|
|
|
4796
|
|
|
4797 (efs-define-fun efs-local-file-type (file)
|
|
|
4798 ;; Looks at the beginning (magic-cookie) of a local file to determine
|
|
|
4799 ;; if it is a text file or not. If it's not a text file, it doesn't care
|
|
|
4800 ;; about what type of binary file, so this doesn't really look for a magic
|
|
|
4801 ;; cookie.
|
|
|
4802 ;; Doesn't call efs-save-match-data. The caller should do so.
|
|
|
4803 (save-excursion
|
|
|
4804 (set-buffer (get-buffer-create efs-data-buffer-name))
|
|
|
4805 (erase-buffer)
|
|
|
4806 (insert-file-contents file nil 0 16)
|
|
|
4807 (if (looking-at "[ -~\n\r\C-L]*\\'")
|
|
|
4808 'text
|
|
|
4809 '8-binary)))
|
|
|
4810
|
|
|
4811 (defun efs-rationalize-file-type (f-type t-type)
|
|
|
4812 ;; When the original and new names for a file indicate
|
|
|
4813 ;; different file types, this function applies an ad hoc heuristic
|
|
|
4814 ;; to return a single file type.
|
|
|
4815 (cond
|
|
|
4816 ((eq f-type t-type)
|
|
|
4817 f-type)
|
|
|
4818 ((memq '36-binary (list f-type t-type))
|
|
|
4819 '36-binary)
|
|
|
4820 ((memq '8-binary (list f-type t-type))
|
|
|
4821 '8-binary)
|
|
|
4822 (t
|
|
|
4823 'text)))
|
|
|
4824
|
|
|
4825 (defun efs-prompt-for-transfer-type (arg)
|
|
|
4826 "Toggles value of efs-prompt-for-transfer-type.
|
|
|
4827 With prefix arg, turns prompting on if arg is positive, otherwise turns
|
|
|
4828 prompting off."
|
|
|
4829 (interactive "P")
|
|
|
4830 (if (if arg
|
|
|
4831 (> (prefix-numeric-value arg) 0)
|
|
|
4832 (null efs-prompt-for-transfer-type))
|
|
|
4833 ;; turn prompting on
|
|
|
4834 (prog1
|
|
|
4835 (setq efs-prompt-for-transfer-type t)
|
|
|
4836 (message "Prompting for FTP transfer TYPE is on."))
|
|
|
4837 (prog1
|
|
|
4838 (setq efs-prompt-for-transfer-type nil)
|
|
|
4839 (message "Prompting for FTP transfer TYPE is off."))))
|
|
|
4840
|
|
|
4841 (defun efs-read-xfer-type (path)
|
|
|
4842 ;; Prompt for the transfer type to use for PATH
|
|
|
4843 (let ((type
|
|
|
4844 (completing-read
|
|
|
4845 (format "FTP transfer TYPE for %s: " (efs-relativize-filename path))
|
|
|
4846 '(("binary") ("image") ("ascii") ("ebcdic") ("tenex"))
|
|
|
4847 nil t)))
|
|
|
4848 (if (string-equal type "binary")
|
|
|
4849 'image
|
|
|
4850 (intern type))))
|
|
|
4851
|
|
|
4852 (defun efs-xfer-type (f-host-type f-path t-host-type t-path
|
|
|
4853 &optional via-local)
|
|
|
4854 ;; Returns the transfer type for transferring a file.
|
|
|
4855 ;; F-HOST-TYPE = the host type of the machine on which the file is from.
|
|
|
4856 ;; F-PATH = path, in full efs-syntax, of the original file
|
|
|
4857 ;; T-HOST-TYPE = host-type of the machine to which the file is being
|
|
|
4858 ;; transferred.
|
|
|
4859 ;; VIA-LOCAL = non-nil of the file is being moved through the local, or
|
|
|
4860 ;; a gateway machine.
|
|
|
4861 ;; Set F-PATH or T-PATH to nil, to indicate that the file is being
|
|
|
4862 ;; transferred from/to a temporary file, whose name has no significance.
|
|
|
4863 (let (temp)
|
|
|
4864 (and f-path
|
|
|
4865 (setq temp (intern-soft f-path efs-tmp-name-obarray))
|
|
|
4866 (memq temp efs-tmp-name-files)
|
|
|
4867 (setq f-path nil))
|
|
|
4868 (and t-path
|
|
|
4869 (setq temp (intern-soft t-path efs-tmp-name-obarray))
|
|
|
4870 (memq temp efs-tmp-name-files)
|
|
|
4871 (setq t-path nil)))
|
|
|
4872 (if (or (null (or f-host-type t-host-type)) (null (or f-path t-path)))
|
|
|
4873 'image ; local copy?
|
|
|
4874 (if efs-prompt-for-transfer-type
|
|
|
4875 (efs-read-xfer-type (if f-path f-path t-path))
|
|
|
4876 (let ((f-fs (cdr (assq f-host-type efs-file-type-alist)))
|
|
|
4877 (t-fs (cdr (assq t-host-type efs-file-type-alist))))
|
|
|
4878 (if (and f-fs t-fs
|
|
|
4879 (if efs-treat-crlf-as-nl
|
|
|
4880 (and (eq (car f-fs) (car t-fs))
|
|
|
4881 (eq (nth 1 f-fs) (nth 1 t-fs))
|
|
|
4882 (let ((f2-fs (nth 2 f-fs))
|
|
|
4883 (t2-fs (nth 2 t-fs)))
|
|
|
4884 (or (eq f2-fs t2-fs)
|
|
|
4885 (and (memq f2-fs '(file-crlf file-nl))
|
|
|
4886 (memq t2-fs '(file-crlf file-nl))))))
|
|
|
4887 (equal f-fs t-fs)))
|
|
|
4888 'image
|
|
|
4889 (let ((type (cond
|
|
|
4890 ((and f-path t-path)
|
|
|
4891 (efs-rationalize-file-type
|
|
|
4892 (efs-file-type t-host-type t-path)
|
|
|
4893 (efs-file-type f-host-type f-path)))
|
|
|
4894 (f-path
|
|
|
4895 (efs-file-type f-host-type f-path))
|
|
|
4896 (t-path
|
|
|
4897 (efs-file-type t-host-type t-path)))))
|
|
|
4898 (cond
|
|
|
4899 ((eq type '36-binary)
|
|
|
4900 'image)
|
|
|
4901 ((eq type '8-binary)
|
|
|
4902 (if (or (eq (car f-fs) '36-bit-wa)
|
|
|
4903 (eq (car t-fs) '36-bit-wa))
|
|
|
4904 'tenex
|
|
|
4905 'image))
|
|
|
4906 (t ; handles 'text
|
|
|
4907 (if (and t-fs f-fs (eq (nth 1 f-fs) 'ebcdic)
|
|
|
4908 (eq (nth 1 t-fs) 'ebcdic) (null via-local))
|
|
|
4909 'ebcdic
|
|
|
4910 'ascii)))))))))
|
|
|
4911
|
|
|
4912 (defun efs-set-xfer-type (host user type &optional clientless)
|
|
|
4913 ;; Sets the xfer type for HOST and USER to TYPE.
|
|
|
4914 ;; If the connection is already using the required type, does nothing.
|
|
|
4915 ;; If clientless is non-nil, we are using a quoted xfer command, and
|
|
|
4916 ;; need to check if the client has changed things.
|
|
|
4917 (save-excursion
|
|
|
4918 (let ((buff (process-buffer (efs-get-process host user))))
|
|
|
4919 (set-buffer buff)
|
|
|
4920 (or (if (and clientless efs-process-client-altered-xfer-type)
|
|
|
4921 (or (eq type efs-process-client-altered-xfer-type)
|
|
|
4922 (setq efs-process-client-altered-xfer-type nil))
|
|
|
4923 ;; We are sending a non-clientless command, so the client
|
|
|
4924 ;; gets back in synch.
|
|
|
4925 (setq efs-process-client-altered-xfer-type nil)
|
|
|
4926 (and efs-process-xfer-type
|
|
|
4927 (eq type efs-process-xfer-type)))
|
|
|
4928 (let ((otype efs-process-xfer-type))
|
|
|
4929 ;; Set this now in anticipation that the TYPE command will work,
|
|
|
4930 ;; in case other commands, such as efs-set-hash-mark-unit want to
|
|
|
4931 ;; grok this before the TYPE command completes.
|
|
|
4932 (setq efs-process-xfer-type type)
|
|
|
4933 (efs-send-cmd
|
|
|
4934 host user (list 'type type)
|
|
|
4935 nil nil
|
|
|
4936 (efs-cont (result line cont-lines) (host user type otype buff)
|
|
|
4937 (if result
|
|
|
4938 (unwind-protect
|
|
|
4939 (efs-error host user (format "TYPE %s failed: %s"
|
|
|
4940 (upcase (symbol-name type))
|
|
|
4941 line))
|
|
|
4942 (if (get-buffer buff)
|
|
|
4943 (save-excursion
|
|
|
4944 (set-buffer buff)
|
|
|
4945 (setq efs-process-xfer-type otype))))))
|
|
|
4946 0)))))) ; always send type commands NOWAIT = 0
|
|
|
4947
|
|
|
4948
|
|
|
4949 ;;;; ------------------------------------------------------------
|
|
|
4950 ;;;; Obtaining DIR listings.
|
|
|
4951 ;;;; ------------------------------------------------------------
|
|
|
4952
|
|
|
4953 (defun efs-ls-guess-switches ()
|
|
|
4954 ;; Tries to determine what would be the most useful switches
|
|
|
4955 ;; to use for a DIR listing.
|
|
|
4956 (if (and (boundp 'dired-listing-switches)
|
|
|
4957 (stringp dired-listing-switches)
|
|
|
4958 (efs-parsable-switches-p dired-listing-switches t))
|
|
|
4959 dired-listing-switches
|
|
|
4960 "-al"))
|
|
|
4961
|
|
|
4962 (efs-defun efs-ls-dumb-check nil (line host file path lsargs msg noparse
|
|
|
4963 noerror nowait cont)
|
|
|
4964 nil)
|
|
|
4965
|
|
|
4966 (efs-defun efs-ls-dumb-check unknown (line host file path lsargs
|
|
|
4967 msg noparse noerror nowait cont)
|
|
|
4968 ;; Checks to see if the host type might be dumb unix. If so, returns the
|
|
|
4969 ;; listing otherwise nil.
|
|
|
4970 (and
|
|
|
4971 lsargs
|
|
|
4972 (string-match
|
|
|
4973 ;; Some CMU servers return a 530 here. 550 is correct.
|
|
|
4974 (concat "^5[35]0 \\(The file \\)?"
|
|
|
4975 (regexp-quote (concat lsargs " " path)))
|
|
|
4976 ;; 550 is for a non-accessible file -- RFC959
|
|
|
4977 line)
|
|
|
4978 (progn
|
|
|
4979 (if (eq (efs-host-type host) 'apollo-unix)
|
|
|
4980 (efs-add-host 'dumb-apollo-unix host)
|
|
|
4981 (efs-add-host 'dumb-unix host))
|
|
|
4982 ;; try again
|
|
|
4983 (if nowait
|
|
|
4984 t ; return t if asynch
|
|
|
4985 ; This is because dumb-check can't run asynch.
|
|
|
4986 ; This means that we can't recognize dumb hosts asynch.
|
|
|
4987 ; Shouldn't be a problem.
|
|
|
4988 (efs-ls file nil
|
|
|
4989 (if (eq msg t)
|
|
|
4990 (format "Relisting %s" (efs-relativize-filename file))
|
|
|
4991 msg)
|
|
|
4992 noparse noerror nowait cont)))))
|
|
|
4993
|
|
|
4994 ;; With no-error nil, this function returns:
|
|
|
4995 ;; an error if file is not an efs-path
|
|
|
4996 ;; (This should never happen.)
|
|
|
4997 ;; an error if either the listing is unreadable or there is an ftp error.
|
|
|
4998 ;; the listing (a string), if everything works.
|
|
|
4999 ;;
|
|
|
5000 ;; With no-error t, it returns:
|
|
|
5001 ;; an error if not an efs-path
|
|
|
5002 ;; error if listing is unreable (most likely caused by a slow connection)
|
|
|
5003 ;; nil if ftp error (this is because although asking to list a nonexistent
|
|
|
5004 ;; directory on a remote unix machine usually (except
|
|
|
5005 ;; maybe for dumb hosts) returns an ls error, but no
|
|
|
5006 ;; ftp error, if the same is done on a VMS machine,
|
|
|
5007 ;; an ftp error is returned. Need to trap the error
|
|
|
5008 ;; so we can go on and try to list the parent.)
|
|
|
5009 ;; the listing, if everything works.
|
|
|
5010
|
|
|
5011 (defun efs-ls (file lsargs msg &optional noparse noerror nowait cont nlist)
|
|
|
5012 "Return the output of a `DIR' or `ls' command done over ftp.
|
|
|
5013 FILE is the full name of the remote file, LSARGS is any args to pass to the
|
|
|
5014 `ls' command. MSG is a message to be displayed while listing, if MSG is given
|
|
|
5015 as t, a suitable message will be computed. If nil, no message will be
|
|
|
5016 displayed. If NOPARSE is non-nil, then the listing will not be parsed and
|
|
|
5017 stored in internal cache. Otherwise, the listing will be parsed, if LSARGS
|
|
|
5018 allow it. If NOERROR is non-nil, then we return nil if the listing fails,
|
|
|
5019 rather than signal an error. If NOWAIT is non-nil, we do the listing
|
|
|
5020 asynchronously, returning nil. If CONT is non-nil it is called with first
|
|
|
5021 argument the listing string."
|
|
|
5022 ;; If lsargs are nil, this forces a one-time only dumb listing using dir.
|
|
|
5023 (setq file (efs-expand-file-name file))
|
|
|
5024 (let ((parsed (efs-ftp-path file)))
|
|
|
5025 (if parsed
|
|
|
5026 (let* ((host (nth 0 parsed))
|
|
|
5027 (user (nth 1 parsed))
|
|
|
5028 (path (nth 2 parsed))
|
|
|
5029 (host-type (efs-host-type host user))
|
|
|
5030 (listing-type (efs-listing-type host user))
|
|
|
5031 (parse (cond
|
|
|
5032 ((null noparse)
|
|
|
5033 (efs-parsable-switches-p lsargs t))
|
|
|
5034 ((eq noparse 'parse)
|
|
|
5035 t)
|
|
|
5036 (t nil)))
|
|
|
5037 (switches lsargs)
|
|
|
5038 cache)
|
|
|
5039
|
|
|
5040 (if (memq host-type efs-dumb-host-types)
|
|
|
5041 (setq lsargs nil))
|
|
|
5042 (if (and (null efs-ls-uncache)
|
|
|
5043 (setq cache
|
|
|
5044 (or (efs-get-from-ls-cache file switches)
|
|
|
5045 (and switches
|
|
|
5046 (efs-convert-from-ls-cache
|
|
|
5047 file switches host-type listing-type)))))
|
|
|
5048 ;; The listing is in the mail, errr... cache.
|
|
|
5049 (let (listing)
|
|
|
5050 (if (stringp cache)
|
|
|
5051 (setq listing cache)
|
|
|
5052 (setq listing (car cache))
|
|
|
5053 (if (and parse (null (nth 1 cache)))
|
|
|
5054 (save-excursion
|
|
|
5055 (set-buffer
|
|
|
5056 (let ((default-major-mode 'fundamental-mode))
|
|
|
5057 (get-buffer-create
|
|
|
5058 efs-data-buffer-name)))
|
|
|
5059 (erase-buffer)
|
|
|
5060 (insert listing)
|
|
|
5061 (goto-char (point-min))
|
|
|
5062 (efs-set-files
|
|
|
5063 file
|
|
|
5064 (efs-parse-listing listing-type
|
|
|
5065 host user path
|
|
|
5066 file lsargs))
|
|
|
5067 ;; Note that we have parsed it now.
|
|
|
5068 (setcar (cdr cache) t))))
|
|
|
5069 (if cont (efs-call-cont cont listing))
|
|
|
5070 listing)
|
|
|
5071
|
|
|
5072 (if cache
|
|
|
5073 (efs-del-from-ls-cache file nil nil))
|
|
|
5074 ;; Need to get the listing via FTP.
|
|
|
5075 (let* ((temp (efs-make-tmp-name host nil))
|
|
|
5076 (temp-file (car temp))
|
|
|
5077 listing-result)
|
|
|
5078 (efs-send-cmd
|
|
|
5079 host user
|
|
|
5080 (list (if nlist 'nlist 'dir) path (cdr temp) lsargs)
|
|
|
5081 (if (eq msg t)
|
|
|
5082 (format "Listing %s" (efs-relativize-filename file))
|
|
|
5083 msg)
|
|
|
5084 nil
|
|
|
5085 (efs-cont (result line cont-lines)
|
|
|
5086 (host-type listing-type host user temp-file path
|
|
|
5087 switches file lsargs noparse parse noerror
|
|
|
5088 msg nowait cont)
|
|
|
5089 ;; The client flipped to ascii, remember this.
|
|
|
5090 (let ((buff (get-buffer
|
|
|
5091 (efs-ftp-process-buffer host user))))
|
|
|
5092 (if buff
|
|
|
5093 (efs-save-buffer-excursion
|
|
|
5094 (set-buffer buff)
|
|
|
5095 (setq efs-process-client-altered-xfer-type
|
|
|
5096 'ascii))))
|
|
|
5097 (unwind-protect
|
|
|
5098 (if result
|
|
|
5099 (or (setq listing-result
|
|
|
5100 (efs-ls-dumb-check
|
|
|
5101 (and (or (eq host-type 'unknown)
|
|
|
5102 (eq listing-type 'unix:unknown))
|
|
|
5103 'unknown)
|
|
|
5104 line host file path lsargs msg
|
|
|
5105 noparse noerror nowait cont))
|
|
|
5106 ;; If dumb-check returns non-nil
|
|
|
5107 ;; then it would have handled any error recovery
|
|
|
5108 ;; and conts. listing-result would only be set to
|
|
|
5109 ;; t if nowait was non-nil. Therefore, the final
|
|
|
5110 ;; return for efs-ls could never be t, even if I
|
|
|
5111 ;; set listing-result to t here.
|
|
|
5112 (if noerror
|
|
|
5113 (if cont
|
|
|
5114 (efs-call-cont cont nil))
|
|
|
5115 (efs-error host user
|
|
|
5116 (concat "DIR failed: "
|
|
|
5117 line))))
|
|
|
5118
|
|
|
5119 ;; listing worked
|
|
|
5120 (if (efs-ftp-path temp-file)
|
|
|
5121 (efs-add-file-entry (efs-host-type efs-gateway-host)
|
|
|
5122 temp-file nil nil nil))
|
|
|
5123 (save-excursion
|
|
|
5124 ;; A hack to get around a jka-compr problem.
|
|
|
5125 ;; Do we still need it?
|
|
|
5126 (let ((default-major-mode 'fundamental-mode)
|
|
|
5127 efs-verbose jka-compr-enabled)
|
|
|
5128 (set-buffer (get-buffer-create
|
|
|
5129 efs-data-buffer-name))
|
|
|
5130 (erase-buffer)
|
|
|
5131 (if (or (file-readable-p temp-file)
|
|
|
5132 (sleep-for efs-retry-time)
|
|
|
5133 (file-readable-p temp-file))
|
|
|
5134 (insert-file-contents temp-file)
|
|
|
5135 (efs-error host user
|
|
|
5136 (format
|
|
|
5137 "list data file %s not readable"
|
|
|
5138 temp-file))))
|
|
|
5139 (if parse
|
|
|
5140 (progn
|
|
|
5141 (efs-set-files
|
|
|
5142 file
|
|
|
5143 (efs-parse-listing listing-type host user path
|
|
|
5144 file lsargs))
|
|
|
5145 ;; Parsing may update the host type.
|
|
|
5146 (and lsargs (memq (efs-host-type host)
|
|
|
5147 efs-dumb-host-types)
|
|
|
5148 (setq lsargs nil))))
|
|
|
5149 (let ((listing (buffer-string)))
|
|
|
5150 (efs-add-to-ls-cache file lsargs listing parse)
|
|
|
5151 (if (and (null lsargs) switches)
|
|
|
5152 ;; Try to convert
|
|
|
5153 (let ((conv (efs-get-ls-converter switches)))
|
|
|
5154 (and conv
|
|
|
5155 (setq conv (assoc
|
|
|
5156 (char-to-string 0)
|
|
|
5157 conv))
|
|
|
5158 (funcall (cdr conv) listing-type nil)
|
|
|
5159 (setq listing (buffer-string)))))
|
|
|
5160 (or nowait (setq listing-result listing))
|
|
|
5161 ;; Call the ls cont, with first arg the
|
|
|
5162 ;; listing string.
|
|
|
5163 (if cont
|
|
|
5164 (efs-call-cont cont listing)))))
|
|
|
5165 (efs-del-tmp-name temp-file)))
|
|
|
5166 nowait)
|
|
|
5167 (and (null nowait) listing-result))))
|
|
|
5168 (error "Attempt to get a remote listing for the local file %s" file))))
|
|
|
5169
|
|
|
5170
|
|
|
5171 ;;;; ===============================================================
|
|
|
5172 ;;;; >7
|
|
|
5173 ;;;; Parsing and storing remote file system data.
|
|
|
5174 ;;;; ===============================================================
|
|
|
5175
|
|
|
5176 ;;; The directory listing parsers do some host type guessing.
|
|
|
5177 ;;; Most of the host type guessing is done when the PWD output
|
|
|
5178 ;;; is parsed. A bit is done when the error codes for DIR are
|
|
|
5179 ;;; analyzed.
|
|
|
5180
|
|
|
5181 ;;;; -----------------------------------------------------------
|
|
|
5182 ;;;; Caching directory listings.
|
|
|
5183 ;;;; -----------------------------------------------------------
|
|
|
5184
|
|
|
5185 ;;; Aside from storing files data in a hashtable, a limited number
|
|
|
5186 ;;; of listings are stored in complete form in `efs-ls-cache'.
|
|
|
5187
|
|
|
5188 (defun efs-del-from-ls-cache (file &optional parent-p dir-p)
|
|
|
5189 ;; Deletes from the ls cache the listing for FILE.
|
|
|
5190 ;; With optional PARENT-P, deletes any entry for the parent
|
|
|
5191 ;; directory of FILE too.
|
|
|
5192 ;; If DIR-P is non-nil, then the directory listing of FILE is to be deleted.
|
|
|
5193 (if dir-p
|
|
|
5194 (setq file (file-name-as-directory file))
|
|
|
5195 (setq file (directory-file-name file)))
|
|
|
5196 (setq file (efs-canonize-file-name file))
|
|
|
5197 (if parent-p
|
|
|
5198 (setq parent-p (file-name-directory
|
|
|
5199 (if dir-p
|
|
|
5200 (directory-file-name file)
|
|
|
5201 file))))
|
|
|
5202 (setq efs-ls-cache
|
|
|
5203 (delq nil
|
|
|
5204 (mapcar
|
|
|
5205 (if parent-p
|
|
|
5206 (function
|
|
|
5207 (lambda (x)
|
|
|
5208 (let ((f-ent (car x)))
|
|
|
5209 (and (not (string-equal file f-ent))
|
|
|
5210 (not (string-equal parent-p f-ent))
|
|
|
5211 x))))
|
|
|
5212 (function
|
|
|
5213 (lambda (x)
|
|
|
5214 (and (not (string-equal file (car x)))
|
|
|
5215 x))))
|
|
|
5216 efs-ls-cache))))
|
|
|
5217
|
|
|
5218 (defun efs-wipe-from-ls-cache (host user)
|
|
|
5219 ;; Remove from efs-ls-cache all listings for HOST and USER.
|
|
|
5220 (let ((host (downcase host))
|
|
|
5221 (case-insens (memq (efs-host-type host)
|
|
|
5222 efs-case-insensitive-host-types)))
|
|
|
5223 (if case-insens (setq user (downcase user)))
|
|
|
5224 (setq efs-ls-cache
|
|
|
5225 (delq nil
|
|
|
5226 (mapcar
|
|
|
5227 (function
|
|
|
5228 (lambda (x)
|
|
|
5229 (let ((parsed (efs-ftp-path (car x))))
|
|
|
5230 (and (not
|
|
|
5231 (and (string-equal (car parsed) host)
|
|
|
5232 (string-equal (if case-insens
|
|
|
5233 (downcase (nth 1 parsed))
|
|
|
5234 (nth 1 parsed))
|
|
|
5235 user)))
|
|
|
5236 x))))
|
|
|
5237 efs-ls-cache)))))
|
|
|
5238
|
|
|
5239 (defun efs-get-from-ls-cache (file switches)
|
|
|
5240 ;; Returns the value in `ls-cache' for FILE and SWITCHES.
|
|
|
5241 ;; Returns a list consisting of the listing string, and whether its
|
|
|
5242 ;; already been parsed. This list is eq to the nthcdr 2 of the actual
|
|
|
5243 ;; cache entry, so you can setcar it.
|
|
|
5244 ;; For dumb listings, SWITCHES will be nil.
|
|
|
5245 (let ((list efs-ls-cache)
|
|
|
5246 (switches (efs-canonize-switches switches))
|
|
|
5247 (file (efs-canonize-file-name file)))
|
|
|
5248 (catch 'done
|
|
|
5249 (while list
|
|
|
5250 (if (and (string-equal file (car (car list)))
|
|
|
5251 (string-equal switches (nth 1 (car list))))
|
|
|
5252 (throw 'done (nthcdr 2 (car list)))
|
|
|
5253 (setq list (cdr list)))))))
|
|
|
5254
|
|
|
5255 (defun efs-add-to-ls-cache (file switches listing parsed)
|
|
|
5256 ;; Only call after efs-get-from-cache returns nil, to avoid duplicate
|
|
|
5257 ;; entries. PARSED should be t, if the listing has already been parsed.
|
|
|
5258 (and (> efs-ls-cache-max 0)
|
|
|
5259 (let ((switches (efs-canonize-switches switches))
|
|
|
5260 (file (efs-canonize-file-name file)))
|
|
|
5261 (if (= efs-ls-cache-max 1)
|
|
|
5262 (setq efs-ls-cache
|
|
|
5263 (list (list file switches listing parsed)))
|
|
|
5264 (if (>= (length efs-ls-cache) efs-ls-cache-max)
|
|
|
5265 (setcdr (nthcdr (- efs-ls-cache-max 2) efs-ls-cache) nil))
|
|
|
5266 (setq efs-ls-cache (cons (list file switches listing parsed)
|
|
|
5267 efs-ls-cache))))))
|
|
|
5268
|
|
|
5269 ;;;; --------------------------------------------------------------
|
|
|
5270 ;;;; Converting listings from cache.
|
|
|
5271 ;;;; --------------------------------------------------------------
|
|
|
5272
|
|
|
5273 (defun efs-get-ls-converter (to-switches)
|
|
|
5274 ;; Returns converter alist for TO-SWITCHES
|
|
|
5275 (efs-get-hash-entry (efs-canonize-switches to-switches)
|
|
|
5276 efs-ls-converter-hashtable))
|
|
|
5277
|
|
|
5278 (defun efs-add-ls-converter (to-switches from-switches converter)
|
|
|
5279 ;; Adds an entry to `efs-ls-converter-hashtable'.
|
|
|
5280 ;; If from-switches is t, the converter converts from internal files
|
|
|
5281 ;; hashtable.
|
|
|
5282 (let* ((to-switches (efs-canonize-switches to-switches))
|
|
|
5283 (ent (efs-get-hash-entry to-switches efs-ls-converter-hashtable))
|
|
|
5284 (add (cons (or (eq from-switches t)
|
|
|
5285 (efs-canonize-switches from-switches))
|
|
|
5286 converter)))
|
|
|
5287 (if ent
|
|
|
5288 (or (member add ent)
|
|
|
5289 (nconc ent (list add)))
|
|
|
5290 (efs-put-hash-entry to-switches (list add) efs-ls-converter-hashtable))))
|
|
|
5291
|
|
|
5292 (defun efs-convert-from-ls-cache (file switches host-type listing-type)
|
|
|
5293 ;; Returns a listing by converting the switches from a cached listing.
|
|
|
5294 (let ((clist (efs-get-ls-converter switches))
|
|
|
5295 (dir-p (= ?/ (aref file (1- (length file)))))
|
|
|
5296 elt listing result regexp alist)
|
|
|
5297 (while file ; this loop will iterate at most twice.
|
|
|
5298 (setq alist clist)
|
|
|
5299 (while alist
|
|
|
5300 (setq elt (car alist))
|
|
|
5301 (if (eq (car elt) t)
|
|
|
5302 (if (and dir-p (setq result (funcall (cdr elt) host-type
|
|
|
5303 (let ((efs-ls-uncache t))
|
|
|
5304 (efs-get-files file))
|
|
|
5305 regexp)))
|
|
|
5306 (setq alist nil
|
|
|
5307 file nil)
|
|
|
5308 (setq alist (cdr alist)))
|
|
|
5309 (if (and (setq listing
|
|
|
5310 (efs-get-from-ls-cache file (car elt)))
|
|
|
5311 (save-excursion
|
|
|
5312 (set-buffer
|
|
|
5313 (let ((default-major-mode 'fundamental-mode))
|
|
|
5314 (get-buffer-create efs-data-buffer-name)))
|
|
|
5315 (erase-buffer)
|
|
|
5316 (insert (car listing))
|
|
|
5317 (and (funcall (cdr elt) listing-type regexp)
|
|
|
5318 (setq result (buffer-string)))))
|
|
|
5319 (setq alist nil
|
|
|
5320 file nil)
|
|
|
5321 (setq alist (cdr alist)))))
|
|
|
5322 ;; Look for wildcards.
|
|
|
5323 (if (and file (null dir-p) (null regexp))
|
|
|
5324 (setq regexp (efs-shell-regexp-to-regexp
|
|
|
5325 (file-name-nondirectory file))
|
|
|
5326 file (file-name-directory file)
|
|
|
5327 dir-p t)
|
|
|
5328 (setq file nil)))
|
|
|
5329 result))
|
|
|
5330
|
|
|
5331 ;;; Define some converters
|
|
|
5332
|
|
|
5333 (defun efs-unix-t-converter-sort-pred (elt1 elt2)
|
|
|
5334 (let* ((data1 (car elt1))
|
|
|
5335 (data2 (car elt2))
|
|
|
5336 (year1 (car data1))
|
|
|
5337 (year2 (car data2))
|
|
|
5338 (month1 (nth 1 data1))
|
|
|
5339 (month2 (nth 1 data2))
|
|
|
5340 (day1 (nth 2 data1))
|
|
|
5341 (day2 (nth 2 data2))
|
|
|
5342 (hour1 (nth 3 data1))
|
|
|
5343 (hour2 (nth 3 data2))
|
|
|
5344 (minutes1 (nth 4 data1))
|
|
|
5345 (minutes2 (nth 4 data2)))
|
|
|
5346 (if year1
|
|
|
5347 (and year2
|
|
|
5348 (or (> year1 year2)
|
|
|
5349 (and (= year1 year2)
|
|
|
5350 (or (> month1 month2)
|
|
|
5351 (and (= month1 month2)
|
|
|
5352 (> day1 day2))))))
|
|
|
5353 (if year2
|
|
|
5354 t
|
|
|
5355 (or (> month1 month2)
|
|
|
5356 (and (= month1 month2)
|
|
|
5357 (or (> day1 day2)
|
|
|
5358 (and (= day1 day2)
|
|
|
5359 (or (> hour1 hour2)
|
|
|
5360 (and (= hour1 hour2)
|
|
|
5361 (> minutes1 minutes2)))))))))))
|
|
|
5362
|
|
|
5363 (defun efs-unix-t-converter (&optional regexp reverse)
|
|
|
5364 (if regexp
|
|
|
5365 nil
|
|
|
5366 (goto-char (point-min))
|
|
|
5367 (efs-save-match-data
|
|
|
5368 (if (re-search-forward efs-month-and-time-regexp nil t)
|
|
|
5369 (let ((current-month (cdr (assoc (substring
|
|
|
5370 (current-time-string) 4 7)
|
|
|
5371 efs-month-alist)))
|
|
|
5372 list-start start end list year month day hour minutes)
|
|
|
5373 (beginning-of-line)
|
|
|
5374 (setq list-start (point))
|
|
|
5375 (while (progn
|
|
|
5376 (setq start (point))
|
|
|
5377 (forward-line 1)
|
|
|
5378 (setq end (point))
|
|
|
5379 (goto-char start)
|
|
|
5380 (re-search-forward efs-month-and-time-regexp end t))
|
|
|
5381 ;; Need to measure wrto the current month
|
|
|
5382 ;; There is a bug here if because of time-zone shifts, the
|
|
|
5383 ;; local machine and the remote one are on different months.
|
|
|
5384 (setq month (% (+ (- 11 current-month)
|
|
|
5385 (cdr (assoc
|
|
|
5386 (buffer-substring (match-beginning 2)
|
|
|
5387 (match-end 2))
|
|
|
5388 efs-month-alist))) 12)
|
|
|
5389 day (string-to-int
|
|
|
5390 (buffer-substring (match-beginning 3) (match-end 3)))
|
|
|
5391 year (buffer-substring (match-beginning 4) (match-end 4)))
|
|
|
5392 (if (string-match ":" year)
|
|
|
5393 (setq hour (string-to-int (substring year 0
|
|
|
5394 (match-beginning 0)))
|
|
|
5395 minutes (string-to-int (substring year (match-end 0)))
|
|
|
5396 year nil)
|
|
|
5397 (setq hour nil
|
|
|
5398 minutes nil
|
|
|
5399 year (string-to-int year)))
|
|
|
5400 (setq list (cons
|
|
|
5401 (cons
|
|
|
5402 (list year month day hour minutes)
|
|
|
5403 (buffer-substring start end))
|
|
|
5404 list))
|
|
|
5405 (goto-char end))
|
|
|
5406 (setq list
|
|
|
5407 (mapcar 'cdr
|
|
|
5408 (sort list 'efs-unix-t-converter-sort-pred)))
|
|
|
5409 (if reverse (setq list (nreverse list)))
|
|
|
5410 (delete-region list-start (point))
|
|
|
5411 (apply 'insert list)
|
|
|
5412 t)))))
|
|
|
5413
|
|
|
5414 (efs-defun efs-t-converter nil (&optional regexp reverse)
|
|
|
5415 ;; Converts listing without the t-switch, to ones with it.
|
|
|
5416 nil) ; by default assume that we cannot work.
|
|
|
5417
|
|
|
5418 (efs-fset 'efs-t-converter 'unix 'efs-unix-t-converter)
|
|
|
5419 (efs-fset 'efs-t-converter 'sysV-unix 'efs-unix-t-converter)
|
|
|
5420 (efs-fset 'efs-t-converter 'apollo-unix 'efs-unix-t-converter)
|
|
|
5421 (efs-fset 'efs-t-converter 'bsd-unix 'efs-unix-t-converter)
|
|
|
5422 (efs-fset 'efs-t-converter 'dumb-unix 'efs-unix-t-converter)
|
|
|
5423 (efs-fset 'efs-t-converter 'dumb-apollo-unix 'efs-unix-t-converter)
|
|
|
5424 (efs-fset 'efs-t-converter 'super-dumb-unix 'efs-unix-t-converter)
|
|
|
5425
|
|
|
5426 (defun efs-rt-converter (listing-type &optional regexp)
|
|
|
5427 ;; Reverse time sorting
|
|
|
5428 (efs-t-converter listing-type regexp t))
|
|
|
5429
|
|
|
5430 (defun efs-unix-alpha-converter (&optional regexp reverse)
|
|
|
5431 (if regexp
|
|
|
5432 nil
|
|
|
5433 (goto-char (point-min))
|
|
|
5434 (efs-save-match-data
|
|
|
5435 (if (re-search-forward efs-month-and-time-regexp nil t)
|
|
|
5436 (let (list list-start end start next)
|
|
|
5437 (beginning-of-line)
|
|
|
5438 (setq list-start (point))
|
|
|
5439 (while (progn
|
|
|
5440 (setq start (point))
|
|
|
5441 (end-of-line)
|
|
|
5442 (setq end (point)
|
|
|
5443 next (1+ end))
|
|
|
5444 (goto-char start)
|
|
|
5445 (re-search-forward efs-month-and-time-regexp end t))
|
|
|
5446 ;; Need to measure wrto the current month
|
|
|
5447 ;; There is a bug here if because of time-zone shifts, the
|
|
|
5448 ;; local machine and the remote one are on different months.
|
|
|
5449 (setq list
|
|
|
5450 (cons
|
|
|
5451 (cons (buffer-substring (point) end)
|
|
|
5452 (buffer-substring start next))
|
|
|
5453 list))
|
|
|
5454 (goto-char next))
|
|
|
5455 (delete-region list-start (point))
|
|
|
5456 (apply 'insert
|
|
|
5457 (mapcar 'cdr
|
|
|
5458 (sort list (if reverse
|
|
|
5459 (function
|
|
|
5460 (lambda (x y)
|
|
|
5461 (string< (car y) (car x))))
|
|
|
5462 (function
|
|
|
5463 (lambda (x y)
|
|
|
5464 (string< (car x) (car y))))))))
|
|
|
5465 t)))))
|
|
|
5466
|
|
|
5467 (efs-defun efs-alpha-converter nil (&optional regexp reverse)
|
|
|
5468 ;; Converts listing to lexigraphical order.
|
|
|
5469 nil) ; by default assume that we cannot work.
|
|
|
5470
|
|
|
5471 (efs-fset 'efs-alpha-converter 'unix 'efs-unix-alpha-converter)
|
|
|
5472 (efs-fset 'efs-alpha-converter 'sysV-unix 'efs-unix-alpha-converter)
|
|
|
5473 (efs-fset 'efs-alpha-converter 'apollo-unix 'efs-unix-alpha-converter)
|
|
|
5474 (efs-fset 'efs-alpha-converter 'bsd-unix 'efs-unix-alpha-converter)
|
|
|
5475 (efs-fset 'efs-alpha-converter 'dumb-unix 'efs-unix-alpha-converter)
|
|
|
5476 (efs-fset 'efs-alpha-converter 'dumb-apollo-unix 'efs-unix-alpha-converter)
|
|
|
5477 (efs-fset 'efs-alpha-converter 'super-dumb-unix 'efs-unix-alpha-converter)
|
|
|
5478
|
|
|
5479 (defun efs-ralpha-converter (listing-type &optional regexp)
|
|
|
5480 ;; Reverse alphabetic
|
|
|
5481 (efs-alpha-converter listing-type regexp t))
|
|
|
5482
|
|
|
5483 (defun efs-unix-S-converter (&optional regexp reverse)
|
|
|
5484 (if regexp
|
|
|
5485 nil
|
|
|
5486 (goto-char (point-min))
|
|
|
5487 (efs-save-match-data
|
|
|
5488 (if (re-search-forward efs-month-and-time-regexp nil t)
|
|
|
5489 (let (list list-start start next)
|
|
|
5490 (beginning-of-line)
|
|
|
5491 (setq list-start (point))
|
|
|
5492 (while (progn
|
|
|
5493 (setq start (point))
|
|
|
5494 (forward-line 1)
|
|
|
5495 (setq next (point))
|
|
|
5496 (goto-char start)
|
|
|
5497 (re-search-forward efs-month-and-time-regexp next t))
|
|
|
5498 ;; Need to measure wrto the current month
|
|
|
5499 ;; There is a bug here if because of time-zone shifts, the
|
|
|
5500 ;; local machine and the remote one are on different months.
|
|
|
5501 (setq list
|
|
|
5502 (cons
|
|
|
5503 (cons (string-to-int
|
|
|
5504 (buffer-substring (match-beginning 1)
|
|
|
5505 (match-end 1)))
|
|
|
5506 (buffer-substring start next))
|
|
|
5507 list))
|
|
|
5508 (goto-char next))
|
|
|
5509 (delete-region list-start (point))
|
|
|
5510 (apply 'insert
|
|
|
5511 (mapcar 'cdr
|
|
|
5512 (sort list (if reverse
|
|
|
5513 (function
|
|
|
5514 (lambda (x y)
|
|
|
5515 (< (car x) (car y))))
|
|
|
5516 (function
|
|
|
5517 (lambda (x y)
|
|
|
5518 (> (car x) (car y))))))))
|
|
|
5519 t)))))
|
|
|
5520
|
|
|
5521 (efs-defun efs-S-converter nil (&optional regexp reverse)
|
|
|
5522 ;; Converts listing without the S-switch, to ones with it.
|
|
|
5523 nil) ; by default assume that we cannot work.
|
|
|
5524
|
|
|
5525 (efs-fset 'efs-S-converter 'unix 'efs-unix-S-converter)
|
|
|
5526 (efs-fset 'efs-S-converter 'sysV-unix 'efs-unix-S-converter)
|
|
|
5527 (efs-fset 'efs-S-converter 'apollo-unix 'efs-unix-S-converter)
|
|
|
5528 (efs-fset 'efs-S-converter 'bsd-unix 'efs-unix-S-converter)
|
|
|
5529 (efs-fset 'efs-S-converter 'dumb-unix 'efs-unix-S-converter)
|
|
|
5530 (efs-fset 'efs-S-converter 'dumb-apollo-unix 'efs-unix-S-converter)
|
|
|
5531 (efs-fset 'efs-S-converter 'super-dumb-unix 'efs-unix-S-converter)
|
|
|
5532
|
|
|
5533 (defun efs-rS-converter (listing-type &optional regexp)
|
|
|
5534 ;; Reverse S switch.
|
|
|
5535 (efs-S-converter listing-type regexp t))
|
|
|
5536
|
|
|
5537 (defun efs-unix-X-converter (&optional regexp reverse)
|
|
|
5538 (if regexp
|
|
|
5539 nil
|
|
|
5540 (goto-char (point-min))
|
|
|
5541 (efs-save-match-data
|
|
|
5542 (if (re-search-forward efs-month-and-time-regexp nil t)
|
|
|
5543 (let (next list list-start fnstart eol start end link-p)
|
|
|
5544 (beginning-of-line)
|
|
|
5545 (setq list-start (point))
|
|
|
5546 (while (progn
|
|
|
5547 (setq start (point))
|
|
|
5548 (skip-chars-forward "0-9 ")
|
|
|
5549 (setq link-p (= (following-char) ?l))
|
|
|
5550 (end-of-line)
|
|
|
5551 (setq eol (point)
|
|
|
5552 next (1+ eol))
|
|
|
5553 (goto-char start)
|
|
|
5554 (re-search-forward efs-month-and-time-regexp eol t))
|
|
|
5555 ;; Need to measure wrto the current month
|
|
|
5556 ;; There is a bug here if because of time-zone shifts, the
|
|
|
5557 ;; local machine and the remote one are on different months.
|
|
|
5558 (setq fnstart (point))
|
|
|
5559 (or (and link-p (search-forward " -> " eol t)
|
|
|
5560 (goto-char (match-beginning 0)))
|
|
|
5561 (goto-char eol))
|
|
|
5562 (setq end (point))
|
|
|
5563 (skip-chars-backward "^." fnstart)
|
|
|
5564 (setq list
|
|
|
5565 (cons
|
|
|
5566 (cons
|
|
|
5567 (if (= (point) fnstart)
|
|
|
5568 ""
|
|
|
5569 (buffer-substring (point) end))
|
|
|
5570 (buffer-substring start next))
|
|
|
5571 list))
|
|
|
5572 (goto-char next))
|
|
|
5573 (delete-region list-start (point))
|
|
|
5574 (apply 'insert
|
|
|
5575 (mapcar 'cdr
|
|
|
5576 (sort list (if reverse
|
|
|
5577 (function
|
|
|
5578 (lambda (x y)
|
|
|
5579 (string< (car y) (car x))))
|
|
|
5580 (function
|
|
|
5581 (lambda (x y)
|
|
|
5582 (string< (car x) (car y))))))))
|
|
|
5583 t)))))
|
|
|
5584
|
|
|
5585 (efs-defun efs-X-converter nil (&optional regexp reverse)
|
|
|
5586 ;; Sort on file name extension. By default do nothing
|
|
|
5587 nil)
|
|
|
5588
|
|
|
5589 (defun efs-rX-converter (listing-type &optional regexp)
|
|
|
5590 (efs-X-converter listing-type regexp t))
|
|
|
5591
|
|
|
5592 (efs-fset 'efs-X-converter 'unix 'efs-unix-X-converter)
|
|
|
5593 (efs-fset 'efs-X-converter 'sysV-unix 'efs-unix-X-converter)
|
|
|
5594 (efs-fset 'efs-X-converter 'apollo-unix 'efs-unix-X-converter)
|
|
|
5595 (efs-fset 'efs-X-converter 'bsd-unix 'efs-unix-X-converter)
|
|
|
5596 (efs-fset 'efs-X-converter 'dumb-unix 'efs-unix-X-converter)
|
|
|
5597 (efs-fset 'efs-X-converter 'dumb-apollo-unix 'efs-unix-X-converter)
|
|
|
5598 (efs-fset 'efs-X-converter 'super-dumb-unix 'efs-unix-X-converter)
|
|
|
5599
|
|
|
5600 ;;; Brief listings
|
|
|
5601
|
|
|
5602 ;;; The following functions do a heap better at packing than
|
|
|
5603 ;;; the usual ls listing. A variable column width is used.
|
|
|
5604 (defun efs-column-widths (columns list &optional across)
|
|
|
5605 ;; Returns the column widths for breaking LIST into
|
|
|
5606 ;; COLUMNS number of columns.
|
|
|
5607 (cond
|
|
|
5608 ((null list)
|
|
|
5609 nil)
|
|
|
5610 ((= columns 1)
|
|
|
5611 (list (apply 'max (mapcar 'length list))))
|
|
|
5612 ((let* ((len (length list))
|
|
|
5613 (col-length (/ len columns))
|
|
|
5614 (remainder (% len columns))
|
|
|
5615 (i 0)
|
|
|
5616 (j 0)
|
|
|
5617 (max-width 0)
|
|
|
5618 widths padding)
|
|
|
5619 (if (zerop remainder)
|
|
|
5620 (setq padding 0)
|
|
|
5621 (setq col-length (1+ col-length)
|
|
|
5622 padding (- columns remainder)))
|
|
|
5623 (setq list (nconc (copy-sequence list) (make-list padding nil)))
|
|
|
5624 (setcdr (nthcdr (1- (+ len padding)) list) list)
|
|
|
5625 (while (< i columns)
|
|
|
5626 (while (< j col-length)
|
|
|
5627 (setq max-width (max max-width (length (car list)))
|
|
|
5628 list (if across (nthcdr columns list) (cdr list))
|
|
|
5629 j (1+ j)))
|
|
|
5630 (setq widths (cons (+ max-width 2) widths)
|
|
|
5631 max-width 0
|
|
|
5632 j 0
|
|
|
5633 i (1+ i))
|
|
|
5634 (if across (setq list (cdr list))))
|
|
|
5635 (setcar widths (- (car widths) 2))
|
|
|
5636 (nreverse widths)))))
|
|
|
5637
|
|
|
5638 (defun efs-calculate-columns (list &optional across)
|
|
|
5639 ;; Returns a list of integers which are the column widths that best pack
|
|
|
5640 ;; LIST, a list of strings, onto the screen.
|
|
|
5641 (and list
|
|
|
5642 (let* ((width (1- (window-width)))
|
|
|
5643 (columns (max 1 (/ width
|
|
|
5644 (+ 2 (apply 'max (mapcar 'length list))))))
|
|
|
5645 col-list last-col-list)
|
|
|
5646 (while (<= (apply '+ (setq col-list
|
|
|
5647 (efs-column-widths columns list across)))
|
|
|
5648 width)
|
|
|
5649 (setq columns (1+ columns)
|
|
|
5650 last-col-list col-list))
|
|
|
5651 (or last-col-list col-list))))
|
|
|
5652
|
|
|
5653 (defun efs-format-columns-of-files (files &optional across)
|
|
|
5654 ;; Returns the number of lines used.
|
|
|
5655 ;; If ACROSS is non-nil, sorts across rather than down the buffer, like
|
|
|
5656 ;; ls -x
|
|
|
5657 ;; A beefed up version of the function in dired. Thanks Sebastian.
|
|
|
5658 (and files
|
|
|
5659 (let* ((columns (efs-calculate-columns files across))
|
|
|
5660 (ncols (length columns))
|
|
|
5661 (ncols1 (1- ncols))
|
|
|
5662 (nfiles (length files))
|
|
|
5663 (nrows (+ (/ nfiles ncols)
|
|
|
5664 (if (zerop (% nfiles ncols)) 0 1)))
|
|
|
5665 (space-left (- (window-width) (apply '+ columns) 1))
|
|
|
5666 (stretch (/ space-left ncols1))
|
|
|
5667 (float-stretch (if (zerop ncols1) 0 (% space-left ncols1)))
|
|
|
5668 (i 0)
|
|
|
5669 (j 0)
|
|
|
5670 (result "")
|
|
|
5671 file padding)
|
|
|
5672 (setq files (nconc (copy-sequence files) ; fill up with empty fns
|
|
|
5673 (make-list (- (* ncols nrows) nfiles) "")))
|
|
|
5674 (setcdr (nthcdr (1- (length files)) files) files) ; make circular
|
|
|
5675 (while (< j nrows)
|
|
|
5676 (while (< i ncols)
|
|
|
5677 (setq result (concat result (setq file (car files))))
|
|
|
5678 (setq padding (- (nth i columns) (length file)))
|
|
|
5679 (or (= i ncols1)
|
|
|
5680 (progn
|
|
|
5681 (setq padding (+ padding stretch))
|
|
|
5682 (if (< i float-stretch) (setq padding (1+ padding)))))
|
|
|
5683 (setq result (concat result (make-string padding ?\ )))
|
|
|
5684 (setq files (if across (cdr files) (nthcdr nrows files))
|
|
|
5685 i (1+ i)))
|
|
|
5686 (setq result (concat result "\n"))
|
|
|
5687 (setq i 0
|
|
|
5688 j (1+ j))
|
|
|
5689 (or across (setq files (cdr files))))
|
|
|
5690 result)))
|
|
|
5691
|
|
|
5692 (defun efs-brief-converter (host-type file-table F a A p x C &optional regexp)
|
|
|
5693 ;; Builds a brief directory listing for file cache, with
|
|
|
5694 ;; possible switches F, a, A, p, x.
|
|
|
5695 (efs-save-match-data
|
|
|
5696 (let (list ent modes)
|
|
|
5697 (efs-map-hashtable
|
|
|
5698 (function
|
|
|
5699 (lambda (key val)
|
|
|
5700 (if (and
|
|
|
5701 (efs-really-file-p host-type key val)
|
|
|
5702 (or a
|
|
|
5703 (and A (not (or (string-equal "." key)
|
|
|
5704 (string-equal ".." key))))
|
|
|
5705 (/= (string-to-char key) ?.))
|
|
|
5706 (or (null regexp)
|
|
|
5707 (string-match regexp key)))
|
|
|
5708 (setq ent (car val)
|
|
|
5709 modes (nth 3 val)
|
|
|
5710 list (cons
|
|
|
5711 (cond ((null (or F p))
|
|
|
5712 key)
|
|
|
5713 ((eq t ent)
|
|
|
5714 (concat key "/"))
|
|
|
5715 ((cond
|
|
|
5716 ((null F)
|
|
|
5717 key)
|
|
|
5718 ((stringp ent)
|
|
|
5719 (concat key "@"))
|
|
|
5720 ((null modes)
|
|
|
5721 key)
|
|
|
5722 ((eq (string-to-char modes) ?s)
|
|
|
5723 ;; a socket
|
|
|
5724 (concat key "="))
|
|
|
5725 ((or
|
|
|
5726 (memq (elt modes 3) '(?x ?s ?t))
|
|
|
5727 (memq (elt modes 6) '(?x ?s ?t))
|
|
|
5728 (memq (elt modes 9) '(?x ?s ?t)))
|
|
|
5729 (concat key "*"))
|
|
|
5730 (t
|
|
|
5731 key))))
|
|
|
5732 list)))))
|
|
|
5733 file-table)
|
|
|
5734 (setq list (sort list 'string<))
|
|
|
5735 (if (or C x)
|
|
|
5736 (efs-format-columns-of-files list x)
|
|
|
5737 (concat (mapconcat 'identity list "\n") "\n")))))
|
|
|
5738
|
|
|
5739 ;;; Store converters.
|
|
|
5740
|
|
|
5741 ;; The cheaters.
|
|
|
5742 (efs-add-ls-converter "-al" nil (function
|
|
|
5743 (lambda (listing-type &optional regexp)
|
|
|
5744 (null regexp))))
|
|
|
5745 (efs-add-ls-converter "-Al" nil (function
|
|
|
5746 (lambda (listing-type &optional regexp)
|
|
|
5747 (null regexp))))
|
|
|
5748 (efs-add-ls-converter "-alF" nil (function
|
|
|
5749 (lambda (listing-type &optional regexp)
|
|
|
5750 (null regexp))))
|
|
|
5751 (efs-add-ls-converter "-AlF" nil (function
|
|
|
5752 (lambda (listing-type &optional regexp)
|
|
|
5753 (null regexp))))
|
|
|
5754
|
|
|
5755 (efs-add-ls-converter "-alt" "-al" 'efs-t-converter)
|
|
|
5756 (efs-add-ls-converter "-Alt" "-Al" 'efs-t-converter)
|
|
|
5757 (efs-add-ls-converter "-lt" "-l" 'efs-t-converter)
|
|
|
5758 (efs-add-ls-converter "-altF" "-alF" 'efs-t-converter)
|
|
|
5759 (efs-add-ls-converter "-AltF" "-AlF" 'efs-t-converter)
|
|
|
5760 (efs-add-ls-converter "-ltF" "-lF" 'efs-t-converter)
|
|
|
5761 (efs-add-ls-converter "-alt" nil 'efs-t-converter)
|
|
|
5762 (efs-add-ls-converter "-altF" nil 'efs-t-converter)
|
|
|
5763 (efs-add-ls-converter "-Alt" nil 'efs-t-converter) ; cheating a bit
|
|
|
5764 (efs-add-ls-converter "-AltF" nil 'efs-t-converter) ; cheating a bit
|
|
|
5765
|
|
|
5766 (efs-add-ls-converter "-altr" "-al" 'efs-rt-converter)
|
|
|
5767 (efs-add-ls-converter "-Altr" "-Al" 'efs-rt-converter)
|
|
|
5768 (efs-add-ls-converter "-ltr" "-l" 'efs-rt-converter)
|
|
|
5769 (efs-add-ls-converter "-altFr" "-alF" 'efs-rt-converter)
|
|
|
5770 (efs-add-ls-converter "-AltFr" "-AlF" 'efs-rt-converter)
|
|
|
5771 (efs-add-ls-converter "-ltFr" "-lF" 'efs-rt-converter)
|
|
|
5772 (efs-add-ls-converter "-altr" nil 'efs-rt-converter)
|
|
|
5773 (efs-add-ls-converter "-Altr" nil 'efs-rt-converter)
|
|
|
5774
|
|
|
5775 (efs-add-ls-converter "-alr" "-alt" 'efs-alpha-converter)
|
|
|
5776 (efs-add-ls-converter "-Alr" "-Alt" 'efs-alpha-converter)
|
|
|
5777 (efs-add-ls-converter "-lr" "-lt" 'efs-alpha-converter)
|
|
|
5778 (efs-add-ls-converter "-alFr" "-alFt" 'efs-alpha-converter)
|
|
|
5779 (efs-add-ls-converter "-AlFr" "-AlFt" 'efs-alpha-converter)
|
|
|
5780 (efs-add-ls-converter "-lFr" "-lFt" 'efs-alpha-converter)
|
|
|
5781
|
|
|
5782 (efs-add-ls-converter "-al" "-alt" 'efs-alpha-converter)
|
|
|
5783 (efs-add-ls-converter "-Al" "-Alt" 'efs-alpha-converter)
|
|
|
5784 (efs-add-ls-converter "-l" "-lt" 'efs-alpha-converter)
|
|
|
5785 (efs-add-ls-converter "-alF" "-alFt" 'efs-alpha-converter)
|
|
|
5786 (efs-add-ls-converter "-AlF" "-AlFt" 'efs-alpha-converter)
|
|
|
5787 (efs-add-ls-converter "-lF" "-lFt" 'efs-alpha-converter)
|
|
|
5788 (efs-add-ls-converter nil "-alt" 'efs-alpha-converter)
|
|
|
5789
|
|
|
5790 (efs-add-ls-converter "-alr" "-al" 'efs-ralpha-converter)
|
|
|
5791 (efs-add-ls-converter "-Alr" "-Al" 'efs-ralpha-converter)
|
|
|
5792 (efs-add-ls-converter "-lr" "-l" 'efs-ralpha-converter)
|
|
|
5793 (efs-add-ls-converter "-alFr" "-alF" 'efs-ralpha-converter)
|
|
|
5794 (efs-add-ls-converter "-lAFr" "-lAF" 'efs-ralpha-converter)
|
|
|
5795 (efs-add-ls-converter "-lFr" "-lF" 'efs-ralpha-converter)
|
|
|
5796 (efs-add-ls-converter "-alr" nil 'efs-ralpha-converter)
|
|
|
5797
|
|
|
5798 (efs-add-ls-converter "-alr" "-alt" 'efs-ralpha-converter)
|
|
|
5799 (efs-add-ls-converter "-Alr" "-Alt" 'efs-ralpha-converter)
|
|
|
5800 (efs-add-ls-converter "-lr" "-lt" 'efs-ralpha-converter)
|
|
|
5801 (efs-add-ls-converter "-alFr" "-alFt" 'efs-ralpha-converter)
|
|
|
5802 (efs-add-ls-converter "-lAFr" "-lAFt" 'efs-ralpha-converter)
|
|
|
5803 (efs-add-ls-converter "-lFr" "-lFt" 'efs-ralpha-converter)
|
|
|
5804
|
|
|
5805 (efs-add-ls-converter "-alS" "-al" 'efs-S-converter)
|
|
|
5806 (efs-add-ls-converter "-AlS" "-Al" 'efs-S-converter)
|
|
|
5807 (efs-add-ls-converter "-lS" "-l" 'efs-S-converter)
|
|
|
5808 (efs-add-ls-converter "-alSF" "-alF" 'efs-S-converter)
|
|
|
5809 (efs-add-ls-converter "-AlSF" "-AlF" 'efs-S-converter)
|
|
|
5810 (efs-add-ls-converter "-lSF" "-lF" 'efs-S-converter)
|
|
|
5811 (efs-add-ls-converter "-alS" nil 'efs-S-converter)
|
|
|
5812
|
|
|
5813 (efs-add-ls-converter "-alSr" "-al" 'efs-rS-converter)
|
|
|
5814 (efs-add-ls-converter "-AlSr" "-Al" 'efs-rS-converter)
|
|
|
5815 (efs-add-ls-converter "-lSr" "-l" 'efs-rS-converter)
|
|
|
5816 (efs-add-ls-converter "-alSFr" "-alF" 'efs-rS-converter)
|
|
|
5817 (efs-add-ls-converter "-AlSFr" "-AlF" 'efs-rS-converter)
|
|
|
5818 (efs-add-ls-converter "-lSFr" "-lF" 'efs-rS-converter)
|
|
|
5819 (efs-add-ls-converter "-alSr" nil 'efs-rS-converter)
|
|
|
5820
|
|
|
5821 (efs-add-ls-converter "-alS" "-alt" 'efs-S-converter)
|
|
|
5822 (efs-add-ls-converter "-AlS" "-Alt" 'efs-S-converter)
|
|
|
5823 (efs-add-ls-converter "-lS" "-lt" 'efs-S-converter)
|
|
|
5824 (efs-add-ls-converter "-alSF" "-alFt" 'efs-S-converter)
|
|
|
5825 (efs-add-ls-converter "-AlSF" "-AlFt" 'efs-S-converter)
|
|
|
5826 (efs-add-ls-converter "-lSF" "-lFt" 'efs-S-converter)
|
|
|
5827
|
|
|
5828 (efs-add-ls-converter "-alSr" "-alt" 'efs-rS-converter)
|
|
|
5829 (efs-add-ls-converter "-AlSr" "-Alt" 'efs-rS-converter)
|
|
|
5830 (efs-add-ls-converter "-lSr" "-lt" 'efs-rS-converter)
|
|
|
5831 (efs-add-ls-converter "-alSFr" "-alFt" 'efs-rS-converter)
|
|
|
5832 (efs-add-ls-converter "-AlSFr" "-AlFt" 'efs-rS-converter)
|
|
|
5833 (efs-add-ls-converter "-lSFr" "-lFt" 'efs-rS-converter)
|
|
|
5834
|
|
|
5835 (efs-add-ls-converter "-AlX" nil 'efs-X-converter)
|
|
|
5836 (efs-add-ls-converter "-alX" nil 'efs-X-converter)
|
|
|
5837 (efs-add-ls-converter "-AlXr" nil 'efs-rX-converter)
|
|
|
5838 (efs-add-ls-converter "-alXr" nil 'efs-rX-converter)
|
|
|
5839
|
|
|
5840 (efs-add-ls-converter "-alX" "-al" 'efs-X-converter)
|
|
|
5841 (efs-add-ls-converter "-AlX" "-Al" 'efs-X-converter)
|
|
|
5842 (efs-add-ls-converter "-lX" "-l" 'efs-X-converter)
|
|
|
5843 (efs-add-ls-converter "-alXF" "-alF" 'efs-X-converter)
|
|
|
5844 (efs-add-ls-converter "-AlXF" "-AlF" 'efs-X-converter)
|
|
|
5845 (efs-add-ls-converter "-lXF" "-lF" 'efs-X-converter)
|
|
|
5846
|
|
|
5847 (efs-add-ls-converter "-alXr" "-al" 'efs-rX-converter)
|
|
|
5848 (efs-add-ls-converter "-AlXr" "-Al" 'efs-rX-converter)
|
|
|
5849 (efs-add-ls-converter "-lXr" "-l" 'efs-rX-converter)
|
|
|
5850 (efs-add-ls-converter "-alXFr" "-alF" 'efs-rX-converter)
|
|
|
5851 (efs-add-ls-converter "-AlXFr" "-AlF" 'efs-rX-converter)
|
|
|
5852 (efs-add-ls-converter "-lXFr" "-lF" 'efs-rX-converter)
|
|
|
5853
|
|
|
5854 ;;; Converters for efs-files-hashtable
|
|
|
5855
|
|
|
5856 (efs-add-ls-converter
|
|
|
5857 "" t (function
|
|
|
5858 (lambda (host-type files &optional regexp)
|
|
|
5859 (efs-brief-converter host-type files
|
|
|
5860 nil nil nil nil nil nil regexp))))
|
|
|
5861 (efs-add-ls-converter
|
|
|
5862 "-C" t (function
|
|
|
5863 (lambda (host-type files &optional regexp)
|
|
|
5864 (efs-brief-converter host-type files
|
|
|
5865 nil nil nil nil nil t regexp))))
|
|
|
5866 (efs-add-ls-converter
|
|
|
5867 "-F" t (function
|
|
|
5868 (lambda (host-type files &optional regexp)
|
|
|
5869 (efs-brief-converter host-type files
|
|
|
5870 t nil nil nil nil nil regexp))))
|
|
|
5871 (efs-add-ls-converter
|
|
|
5872 "-p" t (function
|
|
|
5873 (lambda (host-type files &optional regexp)
|
|
|
5874 (efs-brief-converter host-type files
|
|
|
5875 nil nil nil t nil nil regexp))))
|
|
|
5876 (efs-add-ls-converter
|
|
|
5877 "-CF" t (function
|
|
|
5878 (lambda (host-type files &optional regexp)
|
|
|
5879 (efs-brief-converter host-type files
|
|
|
5880 t nil nil nil nil t regexp))))
|
|
|
5881 (efs-add-ls-converter
|
|
|
5882 "-Cp" t (function
|
|
|
5883 (lambda (host-type files &optional regexp)
|
|
|
5884 (efs-brief-converter host-type files nil nil nil t nil t regexp))))
|
|
|
5885 (efs-add-ls-converter
|
|
|
5886 "-x" t (function
|
|
|
5887 (lambda (host-type files &optional regexp)
|
|
|
5888 (efs-brief-converter host-type files
|
|
|
5889 nil nil nil nil t nil regexp))))
|
|
|
5890 (efs-add-ls-converter
|
|
|
5891 "-xF" t (function
|
|
|
5892 (lambda (host-type files &optional regexp)
|
|
|
5893 (efs-brief-converter host-type files t nil nil nil t nil regexp))))
|
|
|
5894 (efs-add-ls-converter
|
|
|
5895 "-xp" t (function
|
|
|
5896 (lambda (host-type files &optional regexp)
|
|
|
5897 (efs-brief-converter host-type files nil nil nil t t nil regexp))))
|
|
|
5898 (efs-add-ls-converter
|
|
|
5899 "-Ca" t (function
|
|
|
5900 (lambda (host-type files &optional regexp)
|
|
|
5901 (efs-brief-converter host-type files nil t nil nil nil t regexp))))
|
|
|
5902 (efs-add-ls-converter
|
|
|
5903 "-CFa" t (function
|
|
|
5904 (lambda (host-type files &optional regexp)
|
|
|
5905 (efs-brief-converter host-type files t t nil nil nil t regexp))))
|
|
|
5906 (efs-add-ls-converter
|
|
|
5907 "-Cpa" t (function
|
|
|
5908 (lambda (host-type files &optional regexp)
|
|
|
5909 (efs-brief-converter host-type files nil t nil t nil t regexp))))
|
|
|
5910 (efs-add-ls-converter
|
|
|
5911 "-xa" t (function
|
|
|
5912 (lambda (host-type files &optional regexp)
|
|
|
5913 (efs-brief-converter host-type files nil t nil nil t nil regexp))))
|
|
|
5914 (efs-add-ls-converter
|
|
|
5915 "-xFa" t (function
|
|
|
5916 (lambda (host-type files &optional regexp)
|
|
|
5917 (efs-brief-converter host-type files t t nil nil t nil regexp))))
|
|
|
5918 (efs-add-ls-converter
|
|
|
5919 "-xpa" t (function
|
|
|
5920 (lambda (host-type files &optional regexp)
|
|
|
5921 (efs-brief-converter host-type files nil t nil t t nil regexp))))
|
|
|
5922 (efs-add-ls-converter
|
|
|
5923 "-CA" t (function
|
|
|
5924 (lambda (host-type files &optional regexp)
|
|
|
5925 (efs-brief-converter host-type files nil nil t nil nil t regexp))))
|
|
|
5926 (efs-add-ls-converter
|
|
|
5927 "-CFA" t (function
|
|
|
5928 (lambda (host-type files &optional regexp)
|
|
|
5929 (efs-brief-converter host-type files t nil t nil nil t regexp))))
|
|
|
5930 (efs-add-ls-converter
|
|
|
5931 "-CpA" t (function
|
|
|
5932 (lambda (host-type files &optional regexp)
|
|
|
5933 (efs-brief-converter host-type files nil nil t t nil t regexp))))
|
|
|
5934 (efs-add-ls-converter
|
|
|
5935 "-xA" t (function
|
|
|
5936 (lambda (host-type files &optional regexp)
|
|
|
5937 (efs-brief-converter host-type files nil nil t nil t nil regexp))))
|
|
|
5938 (efs-add-ls-converter
|
|
|
5939 "-xFA" t (function
|
|
|
5940 (lambda (host-type files &optional regexp)
|
|
|
5941 (efs-brief-converter host-type files t nil t nil t nil regexp))))
|
|
|
5942 (efs-add-ls-converter
|
|
|
5943 "-xpA" t (function
|
|
|
5944 (lambda (host-type files &optional regexp)
|
|
|
5945 (efs-brief-converter host-type files nil nil t t t nil regexp))))
|
|
|
5946
|
|
|
5947 ;;;; ------------------------------------------------------------
|
|
|
5948 ;;;; Directory Listing Parsers
|
|
|
5949 ;;;; ------------------------------------------------------------
|
|
|
5950
|
|
|
5951 (defconst efs-unix:dl-listing-regexp
|
|
|
5952 "^[^ \n\t]+\n? +\\([0-9]+\\|-\\|=\\) ")
|
|
|
5953
|
|
|
5954 ;; Note to progammers:
|
|
|
5955 ;; Below are a series of macros and functions used for parsing unix
|
|
|
5956 ;; file listings. They are intended only to be used together, so be careful
|
|
|
5957 ;; about using them out of context.
|
|
|
5958
|
|
|
5959 (defmacro efs-ls-parse-file-line ()
|
|
|
5960 ;; Extract the filename, size, and permission string from the current
|
|
|
5961 ;; line of a dired-like listing. Assumes that the point is at
|
|
|
5962 ;; the beginning of the line, leaves it just before the size entry.
|
|
|
5963 ;; Returns a list (name size perm-string nlinks owner).
|
|
|
5964 ;; If there is no file on the line, returns nil.
|
|
|
5965 (` (let ((eol (save-excursion (end-of-line) (point)))
|
|
|
5966 name size modes nlinks owner)
|
|
|
5967 (skip-chars-forward " 0-9" eol)
|
|
|
5968 (and
|
|
|
5969 (looking-at efs-modes-links-owner-regexp)
|
|
|
5970 (setq modes (buffer-substring (match-beginning 1)
|
|
|
5971 (match-end 1))
|
|
|
5972 nlinks (string-to-int (buffer-substring (match-beginning 2)
|
|
|
5973 (match-end 2)))
|
|
|
5974 owner (buffer-substring (match-beginning 3) (match-end 3)))
|
|
|
5975 (re-search-forward efs-month-and-time-regexp eol t)
|
|
|
5976 (setq name (buffer-substring (point) eol)
|
|
|
5977 size (string-to-int (buffer-substring (match-beginning 1)
|
|
|
5978 (match-end 1))))
|
|
|
5979 (list name size modes nlinks owner)))))
|
|
|
5980
|
|
|
5981 (defun efs-relist-symlink (host user symlink path switches)
|
|
|
5982 ;; Does a re-list of a single symlink in efs-data-buffer-name-2,
|
|
|
5983 ;; HOST = remote host
|
|
|
5984 ;; USER = remote username
|
|
|
5985 ;; SYMLINK = symbolic link name as a remote fullpath
|
|
|
5986 ;; PATH = efs full path syntax for the dir. being listed
|
|
|
5987 ;; SWITCHES = ls switches to use for the re-list
|
|
|
5988 ;; Returns (symlink-name symlink-target), as given by the listing. Returns
|
|
|
5989 ;; nil if the listing fails.
|
|
|
5990 ;; Does NOT correct for any symlink marking.
|
|
|
5991 (let* ((temp (efs-make-tmp-name host nil))
|
|
|
5992 (temp-file (car temp))
|
|
|
5993 (default-major-mode 'fundamental-mode)
|
|
|
5994 spot)
|
|
|
5995 (unwind-protect
|
|
|
5996 (and
|
|
|
5997 (prog1
|
|
|
5998 (null
|
|
|
5999 (car
|
|
|
6000 (efs-send-cmd host user
|
|
|
6001 (list 'dir symlink (cdr temp) switches)
|
|
|
6002 (format "Listing %s"
|
|
|
6003 (efs-relativize-filename
|
|
|
6004 (efs-replace-path-component
|
|
|
6005 path symlink))))))
|
|
|
6006 ;; Put the old message back.
|
|
|
6007 (if (and efs-verbose
|
|
|
6008 (not (and (boundp 'dired-in-query) dired-in-query)))
|
|
|
6009 (message "Listing %s..."
|
|
|
6010 (efs-relativize-filename path))))
|
|
|
6011 (save-excursion
|
|
|
6012 (if (efs-ftp-path temp-file)
|
|
|
6013 (efs-add-file-entry (efs-host-type efs-gateway-host)
|
|
|
6014 temp-file nil nil nil))
|
|
|
6015 (set-buffer (get-buffer-create efs-data-buffer-name-2))
|
|
|
6016 (erase-buffer)
|
|
|
6017 (if (or (file-readable-p temp-file)
|
|
|
6018 (sleep-for efs-retry-time)
|
|
|
6019 (file-readable-p temp-file))
|
|
|
6020 (let (efs-verbose)
|
|
|
6021 (insert-file-contents temp-file))
|
|
|
6022 (efs-error host user
|
|
|
6023 (format
|
|
|
6024 "list data file %s not readable" temp-file)))
|
|
|
6025 (skip-chars-forward " 0-9")
|
|
|
6026 (and
|
|
|
6027 (eq (following-char) ?l)
|
|
|
6028 (re-search-forward efs-month-and-time-regexp nil t)
|
|
|
6029 (setq spot (point))
|
|
|
6030 (re-search-forward " -> " nil t)
|
|
|
6031 (progn
|
|
|
6032 (end-of-line)
|
|
|
6033 (list
|
|
|
6034 ;; We might get the full path in the listing.
|
|
|
6035 (file-name-nondirectory
|
|
|
6036 (buffer-substring spot (match-beginning 0)))
|
|
|
6037 (buffer-substring (match-end 0) (point)))))))
|
|
|
6038 (efs-del-tmp-name temp-file))))
|
|
|
6039
|
|
|
6040 (defun efs-ls-sysV-p (host user dir linkname path)
|
|
|
6041 ;; Returns t if the symlink is listed in sysV style. i.e. The
|
|
|
6042 ;; symlink name is marked with an @.
|
|
|
6043 ;; HOST = remote host name
|
|
|
6044 ;; USER = remote user name
|
|
|
6045 ;; DIR = directory being listed as a remote full path.
|
|
|
6046 ;; LINKNAME = relative name of symbolic link as derived from an ls -..F...
|
|
|
6047 ;; this is assumed to end with an @
|
|
|
6048 ;; PATH = efs full path synatx for the directory
|
|
|
6049 (let ((link (car (efs-relist-symlink
|
|
|
6050 host user
|
|
|
6051 (concat dir (substring linkname 0 -1))
|
|
|
6052 path "-lFd" ))))
|
|
|
6053 (and link (string-equal link linkname))))
|
|
|
6054
|
|
|
6055 (defun efs-ls-next-p (host user dir linkname target path)
|
|
|
6056 ;; Returns t is the symlink is marked in the NeXT style.
|
|
|
6057 ;; i.e. The symlink destination is marked with an @.
|
|
|
6058 ;; This assumes that the host-type has already been identified
|
|
|
6059 ;; as NOT sysV-unix, and that target ends in an "@".
|
|
|
6060 ;; HOST = remote host name
|
|
|
6061 ;; USER = remote user name
|
|
|
6062 ;; DIR = remote directory being listed, as a remore full path
|
|
|
6063 ;; LINKNAME = relative name of symbolic link
|
|
|
6064 ;; Since we've eliminated sysV, it won't be marked with an @
|
|
|
6065 ;; TARGET = target of symbolic link, as derived from an ls -..F..
|
|
|
6066 ;; PATH = directory being listed in full efs path syntax.
|
|
|
6067 (let ((no-F-target (nth 1 (efs-relist-symlink
|
|
|
6068 host user
|
|
|
6069 (concat dir linkname)
|
|
|
6070 path "-ld"))))
|
|
|
6071 (and no-F-target
|
|
|
6072 (string-equal (concat no-F-target "@") target))))
|
|
|
6073
|
|
|
6074 ;; This deals with the F switch. Should also do something about
|
|
|
6075 ;; unquoting names obtained with the SysV b switch and the GNU Q
|
|
|
6076 ;; switch. See Sebastian's dired-get-filename.
|
|
|
6077
|
|
|
6078 (defun efs-ls-parser (host-type host user dir path switches)
|
|
|
6079 ;; Meant to be called by efs-parse-listing.
|
|
|
6080 ;; Assumes that point is at the beginning of the first file line.
|
|
|
6081 ;; Assumes that SWITCHES has already been bound to nil for a dumb host.
|
|
|
6082 ;; HOST-TYPE is the remote host-type
|
|
|
6083 ;; HOST is the remote host name
|
|
|
6084 ;; USER is the remote user name
|
|
|
6085 ;; DIR is the remote directory as a full path
|
|
|
6086 ;; PATH is the directory in full efs syntax, and directory syntax.
|
|
|
6087 ;; SWITCHES is the ls listing switches
|
|
|
6088 (let ((tbl (efs-make-hashtable))
|
|
|
6089 (used-F (and switches (string-match "F" switches)))
|
|
|
6090 (old-tbl (efs-get-files-hashtable-entry path))
|
|
|
6091 file-type symlink directory file size modes nlinks owner)
|
|
|
6092 (while (setq file (efs-ls-parse-file-line))
|
|
|
6093 (setq size (nth 1 file)
|
|
|
6094 modes (nth 2 file)
|
|
|
6095 nlinks (nth 3 file)
|
|
|
6096 owner (nth 4 file)
|
|
|
6097 file (car file)
|
|
|
6098 file-type (string-to-char modes)
|
|
|
6099 directory (eq file-type ?d))
|
|
|
6100 (if (eq file-type ?l)
|
|
|
6101 (if (string-match " -> " file)
|
|
|
6102 (setq symlink (substring file (match-end 0))
|
|
|
6103 file (substring file 0 (match-beginning 0)))
|
|
|
6104 ;; Shouldn't happen
|
|
|
6105 (setq symlink ""))
|
|
|
6106 (setq symlink nil))
|
|
|
6107 (if used-F
|
|
|
6108 ;; The F-switch jungle
|
|
|
6109 (let ((socket (eq file-type ?s))
|
|
|
6110 (fifo (eq file-type ?p))
|
|
|
6111 (executable
|
|
|
6112 (and (not symlink) ; x bits don't mean a thing for symlinks
|
|
|
6113 (or (memq (elt modes 3) '(?x ?s ?t))
|
|
|
6114 (memq (elt modes 6) '(?x ?s ?t))
|
|
|
6115 (memq (elt modes 9) '(?x ?s ?t))))))
|
|
|
6116 ;; Deal with marking of directories, executables, and sockets.
|
|
|
6117 (if (or (and executable (string-match "*$" file))
|
|
|
6118 (and socket (string-match "=$" file))
|
|
|
6119 (and fifo (string-match "|$" file)))
|
|
|
6120 (setq file (substring file 0 -1))
|
|
|
6121 ;; Do the symlink dance.
|
|
|
6122 (if symlink
|
|
|
6123 (let ((fat-p (string-match "@$" file))
|
|
|
6124 (sat-p (string-match "@$" symlink)))
|
|
|
6125 (cond
|
|
|
6126 ;; Those that mark the file
|
|
|
6127 ((and (memq host-type '(sysV-unix apollo-unix)) fat-p)
|
|
|
6128 (setq file (substring file 0 -1)))
|
|
|
6129 ;; Those that mark nothing
|
|
|
6130 ((memq host-type '(bsd-unix dumb-unix)))
|
|
|
6131 ;; Those that mark the target
|
|
|
6132 ((and (eq host-type 'next-unix) sat-p)
|
|
|
6133 (setq symlink (substring symlink 0 -1)))
|
|
|
6134 ;; We don't know
|
|
|
6135 ((eq host-type 'unix)
|
|
|
6136 (if fat-p
|
|
|
6137 (cond
|
|
|
6138 ((efs-ls-sysV-p host user dir
|
|
|
6139 file path)
|
|
|
6140 (setq host-type 'sysV-unix
|
|
|
6141 file (substring file 0 -1))
|
|
|
6142 (efs-add-host 'sysV-unix host)
|
|
|
6143 (efs-add-listing-type 'sysV-unix host user))
|
|
|
6144 ((and sat-p
|
|
|
6145 (efs-ls-next-p host user dir file symlink
|
|
|
6146 path))
|
|
|
6147 (setq host-type 'next-unix
|
|
|
6148 symlink (substring symlink 0 -1))
|
|
|
6149 (efs-add-host 'next-unix host)
|
|
|
6150 (efs-add-listing-type 'next-unix host user))
|
|
|
6151 (t
|
|
|
6152 (setq host-type 'bsd-unix)
|
|
|
6153 (efs-add-host 'bsd-unix host)
|
|
|
6154 (efs-add-listing-type 'bsd-unix host user)))
|
|
|
6155 (if (and sat-p
|
|
|
6156 (efs-ls-next-p host user dir file
|
|
|
6157 symlink path))
|
|
|
6158 (progn
|
|
|
6159 (setq host-type 'next-unix
|
|
|
6160 symlink (substring symlink 0 -1))
|
|
|
6161 (efs-add-host 'next-unix host)
|
|
|
6162 (efs-add-listing-type 'next-unix host user))
|
|
|
6163 (setq host-type 'bsd-unix)
|
|
|
6164 (efs-add-host 'bsd-unix host)
|
|
|
6165 (efs-add-listing-type 'bsd-unix host user)))))
|
|
|
6166 ;; Look out for marking of symlink
|
|
|
6167 ;; If we really wanted to, at this point we
|
|
|
6168 ;; could distinguish aix from hp-ux, ultrix, irix and a/ux,
|
|
|
6169 ;; allowing us to skip the re-list in the future, for the
|
|
|
6170 ;; later 4 host types. Another version...
|
|
|
6171 (if (string-match "[=|*]$" symlink)
|
|
|
6172 (let ((relist (efs-relist-symlink
|
|
|
6173 host user (concat dir file)
|
|
|
6174 path "-dl")))
|
|
|
6175 (if relist (setq symlink (nth 1 relist))))))))))
|
|
|
6176 ;; Strip / off the end unconditionally. It's not a valid file character
|
|
|
6177 ;; anyway.
|
|
|
6178 (if (string-match "/$" file) (setq file (substring file 0 -1)))
|
|
|
6179 (let ((mdtm (and old-tbl (nth 5 (efs-get-hash-entry file old-tbl)))))
|
|
|
6180 (if mdtm
|
|
|
6181 (efs-put-hash-entry file (list (or symlink directory) size owner
|
|
|
6182 modes nlinks mdtm) tbl)
|
|
|
6183 (efs-put-hash-entry file (list (or symlink directory) size owner
|
|
|
6184 modes nlinks) tbl)))
|
|
|
6185 (forward-line 1))
|
|
|
6186 (efs-put-hash-entry "." '(t) tbl)
|
|
|
6187 (efs-put-hash-entry ".." '(t) tbl)
|
|
|
6188 tbl))
|
|
|
6189
|
|
|
6190 (efs-defun efs-parse-listing nil (host user dir path &optional switches)
|
|
|
6191 ;; Parse the a listing which is assumed to be from some type of unix host.
|
|
|
6192 ;; Note that efs-key will be bound to the actual host type.
|
|
|
6193 ;; HOST = remote host name
|
|
|
6194 ;; USER = remote user name
|
|
|
6195 ;; DIR = directory as a remote full path
|
|
|
6196 ;; PATH = directory in full efs path syntax
|
|
|
6197 ;; SWITCHES = ls switches used for the listing
|
|
|
6198 (efs-save-match-data
|
|
|
6199 (cond
|
|
|
6200 ;; look for total line
|
|
|
6201 ((looking-at "^total [0-9]+$")
|
|
|
6202 (forward-line 1)
|
|
|
6203 ;; Beware of machines that put a blank line after the totals line.
|
|
|
6204 (skip-chars-forward " \t\n")
|
|
|
6205 (efs-ls-parser efs-key host user dir path switches))
|
|
|
6206 ;; look for errors
|
|
|
6207 ((looking-at "[^\n]+\\( not found\\|: Not a directory\\)\n\\'")
|
|
|
6208 ;; It's an ls error message.
|
|
|
6209 nil)
|
|
|
6210 ((eobp) ; i.e. zerop buffer-size
|
|
|
6211 nil) ; assume an ls error message
|
|
|
6212 ;; look for listings without total lines
|
|
|
6213 ((re-search-forward efs-month-and-time-regexp nil t)
|
|
|
6214 (beginning-of-line)
|
|
|
6215 (efs-ls-parser efs-key host user dir path switches))
|
|
|
6216 (t nil))))
|
|
|
6217
|
|
|
6218 (efs-defun efs-parse-listing unix:unknown
|
|
|
6219 (host user dir path &optional switches)
|
|
|
6220 ;; Parse the a listing which is assumed to be from some type of unix host,
|
|
|
6221 ;; possibly one doing a dl listing.
|
|
|
6222 ;; HOST = remote host name
|
|
|
6223 ;; USER = remote user name
|
|
|
6224 ;; DIR = directory as a remote full path
|
|
|
6225 ;; PATH = directory in full efs path syntax
|
|
|
6226 ;; SWITCHES = ls switches used for the listing
|
|
|
6227 (efs-save-match-data
|
|
|
6228 (cond
|
|
|
6229 ;; look for total line
|
|
|
6230 ((looking-at "^total [0-9]+$")
|
|
|
6231 (forward-line 1)
|
|
|
6232 ;; Beware of machines that put a blank line after the totals line.
|
|
|
6233 (skip-chars-forward " \t\n")
|
|
|
6234 ;; This will make the listing-type track the host-type.
|
|
|
6235 (efs-add-listing-type nil host user)
|
|
|
6236 (efs-ls-parser 'unix host user dir path switches))
|
|
|
6237 ;; look for errors
|
|
|
6238 ((looking-at "[^\n]+\\( not found\\|: Not a directory\\)\n\\'")
|
|
|
6239 ;; It's an ls error message.
|
|
|
6240 nil)
|
|
|
6241 ((eobp) ; i.e. zerop buffer-size
|
|
|
6242 nil) ; assume an ls error message
|
|
|
6243 ;; look for listings without total lines
|
|
|
6244 ((and (re-search-forward efs-month-and-time-regexp nil t)
|
|
|
6245 (progn
|
|
|
6246 (beginning-of-line)
|
|
|
6247 (looking-at efs-modes-links-owner-regexp)))
|
|
|
6248 (efs-add-listing-type nil host user)
|
|
|
6249 (efs-ls-parser 'unix host user dir path switches))
|
|
|
6250 ;; look for dumb listings
|
|
|
6251 ((re-search-forward
|
|
|
6252 (concat (regexp-quote switches)
|
|
|
6253 " not found\\|\\(^ls: +illegal option -- \\)")
|
|
|
6254 (save-excursion (end-of-line) (point)) t)
|
|
|
6255 (if (eq (efs-host-type host) 'apollo-unix)
|
|
|
6256 (progn
|
|
|
6257 (efs-add-host 'dumb-apollo-unix host)
|
|
|
6258 (efs-add-listing-type 'dumb-apollo-unix host user))
|
|
|
6259 (efs-add-host 'dumb-unix host)
|
|
|
6260 (efs-add-listing-type 'dumb-unix host user))
|
|
|
6261 (if (match-beginning 1)
|
|
|
6262 ;; Need to try to list again.
|
|
|
6263 (let ((efs-ls-uncache t))
|
|
|
6264 (efs-ls
|
|
|
6265 path nil (format "Relisting %s" (efs-relativize-filename path)) t)
|
|
|
6266 (goto-char (point-min))
|
|
|
6267 (efs-parse-listing nil host user dir path switches))
|
|
|
6268 (if (re-search-forward "^total [0-9]+$" nil t)
|
|
|
6269 (progn
|
|
|
6270 (beginning-of-line)
|
|
|
6271 (delete-region (point-min) (point))
|
|
|
6272 (forward-line 1)
|
|
|
6273 (efs-ls-parser 'dumb-unix host user dir path switches)))))
|
|
|
6274 ;; Look for dl listings.
|
|
|
6275 ((re-search-forward efs-unix:dl-listing-regexp nil t)
|
|
|
6276 (efs-add-host 'unix host)
|
|
|
6277 (efs-add-listing-type 'unix:dl host user)
|
|
|
6278 (efs-parse-listing 'unix:dl host user dir path switches))
|
|
|
6279 ;; don't know, return nil
|
|
|
6280 (t nil))))
|
|
|
6281
|
|
|
6282 (defun efs-ls-parse-1-liner (filename buffer &optional symlink)
|
|
|
6283 ;; Parse a 1-line listing for FILENAME in BUFFER, and update
|
|
|
6284 ;; the cached info for FILENAME.
|
|
|
6285 ;; Optional SYMLINK arg gives the expected target of a symlink.
|
|
|
6286 ;; Since one-line listings are usually used to update info for
|
|
|
6287 ;; newly created files, we usually know what sort of a file to expect.
|
|
|
6288 ;; Actually trying to parse out the symlink target could be impossible
|
|
|
6289 ;; for some types of switches.
|
|
|
6290 (efs-save-buffer-excursion
|
|
|
6291 (set-buffer buffer)
|
|
|
6292 (goto-char (point-min))
|
|
|
6293 (skip-chars-forward " 0-9")
|
|
|
6294 (efs-save-match-data
|
|
|
6295 (let (modes nlinks owner size)
|
|
|
6296 (and
|
|
|
6297 (looking-at efs-modes-links-owner-regexp)
|
|
|
6298 (setq modes (buffer-substring (match-beginning 1) (match-end 1))
|
|
|
6299 nlinks (string-to-int (buffer-substring (match-beginning 2)
|
|
|
6300 (match-end 2)))
|
|
|
6301 owner (buffer-substring (match-beginning 3) (match-end 3)))
|
|
|
6302 (re-search-forward efs-month-and-time-regexp nil t)
|
|
|
6303 (setq size (string-to-int (buffer-substring (match-beginning 1)
|
|
|
6304 (match-end 1))))
|
|
|
6305 (let* ((filename (directory-file-name filename))
|
|
|
6306 (files (efs-get-files-hashtable-entry
|
|
|
6307 (file-name-directory filename))))
|
|
|
6308 (if files
|
|
|
6309 (let* ((key (efs-get-file-part filename))
|
|
|
6310 (ignore-case (memq (efs-host-type
|
|
|
6311 (car (efs-ftp-path filename)))
|
|
|
6312 efs-case-insensitive-host-types))
|
|
|
6313 (ent (efs-get-hash-entry key files ignore-case))
|
|
|
6314 (mdtm (nth 5 ent))
|
|
|
6315 type)
|
|
|
6316 (if (= (string-to-char modes) ?l)
|
|
|
6317 (setq type
|
|
|
6318 (cond
|
|
|
6319 ((stringp symlink)
|
|
|
6320 symlink)
|
|
|
6321 ((stringp (car ent))
|
|
|
6322 (car ent))
|
|
|
6323 (t ; something weird happened.
|
|
|
6324 "")))
|
|
|
6325 (if (= (string-to-char modes) ?d)
|
|
|
6326 (setq type t)))
|
|
|
6327 (efs-put-hash-entry
|
|
|
6328 key (list type size owner modes nlinks mdtm)
|
|
|
6329 files ignore-case)))))))))
|
|
|
6330
|
|
|
6331 (efs-defun efs-update-file-info nil (file buffer &optional symlink)
|
|
|
6332 "For FILE, update cache information from a single file listing in BUFFER."
|
|
|
6333 ;; By default, this does nothing.
|
|
|
6334 nil)
|
|
|
6335
|
|
|
6336 (efs-defun efs-update-file-info unix (file buffer &optional symlink)
|
|
|
6337 (efs-ls-parse-1-liner file buffer))
|
|
|
6338 (efs-defun efs-update-file-info sysV-unix (file buffer &optional symlink)
|
|
|
6339 (efs-ls-parse-1-liner file buffer))
|
|
|
6340 (efs-defun efs-update-file-info bsd-unix (file buffer &optional symlink)
|
|
|
6341 (efs-ls-parse-1-liner file buffer))
|
|
|
6342 (efs-defun efs-update-file-info next-unix (file buffer &optional symlink)
|
|
|
6343 (efs-ls-parse-1-liner file buffer))
|
|
|
6344 (efs-defun efs-update-file-info apollo-unix (file buffer &optional symlink)
|
|
|
6345 (efs-ls-parse-1-liner file buffer))
|
|
|
6346 (efs-defun efs-update-file-info dumb-unix (file buffer &optional symlink)
|
|
|
6347 (efs-ls-parse-1-liner file buffer))
|
|
|
6348 (efs-defun efs-update-file-info dumb-apollo-unix
|
|
|
6349 (file buffer &optional symlink)
|
|
|
6350 (efs-ls-parse-1-liner file buffer))
|
|
|
6351 (efs-defun efs-update-file-info super-dumb-unix (file buffer &optional symlink)
|
|
|
6352 (efs-ls-parse-1-liner file buffer))
|
|
|
6353
|
|
|
6354 ;;;; ----------------------------------------------------------------
|
|
|
6355 ;;;; The 'unknown listing parser. This does some host-type guessing.
|
|
|
6356 ;;;; ----------------------------------------------------------------
|
|
|
6357
|
|
|
6358 ;;; Regexps for host and listing type guessing from the listing syntax.
|
|
|
6359
|
|
|
6360 (defconst efs-ka9q-listing-regexp
|
|
|
6361 (concat
|
|
|
6362 "^\\([0-9,.]+\\|No\\) files\\. [0-9,.]+ bytes free\\. "
|
|
|
6363 "Disk size [0-9,]+ bytes\\.$"))
|
|
|
6364 ;; This version of the regexp is really for hosts which allow some switches,
|
|
|
6365 ;; but not ours. Rather than determine which switches we could be using
|
|
|
6366 ;; we just assume that it's dumb.
|
|
|
6367 (defconst efs-dumb-unix-listing-regexp
|
|
|
6368 (concat
|
|
|
6369 "^[Uu]sage: +ls +-[a-zA-Z0-9]+[ \n]\\|"
|
|
|
6370 ;; Unitree server
|
|
|
6371 "^Error getting stats for \"-[a-zA-Z0-9]+\""))
|
|
|
6372
|
|
|
6373 (defconst efs-dos-distinct-date-and-time-regexp
|
|
|
6374 (concat
|
|
|
6375 " \\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct"
|
|
|
6376 "\\|Nov\\|Dec\\) [ 0-3][0-9],[12][90][0-9][0-9] "
|
|
|
6377 "[ 12][0-9]:[0-5][0-9] "))
|
|
|
6378 ;; Regexp to match the output from the hellsoft ftp server to an
|
|
|
6379 ;; ls -al. Unfortunately, this looks a lot like some unix ls error
|
|
|
6380 ;; messages.
|
|
|
6381 (defconst efs-hell-listing-regexp
|
|
|
6382 (concat
|
|
|
6383 "ls: file or directory not found\n\\'\\|"
|
|
|
6384 "[-d]\\[[-A-Z][-A-Z][-A-Z][-A-Z][-A-Z][-A-Z][-A-Z]\\]"))
|
|
|
6385
|
|
|
6386 (efs-defun efs-parse-listing unknown
|
|
|
6387 (host user dir path &optional switches)
|
|
|
6388 "Parse the current buffer which is assumed to contain a dir listing.
|
|
|
6389 Return a hashtable as the result. If the listing is not really a
|
|
|
6390 directory listing, then return nil.
|
|
|
6391
|
|
|
6392 HOST is the remote host's name.
|
|
|
6393 USER is the remote user name.
|
|
|
6394 DIR is the directory as a full remote path.
|
|
|
6395 PATH is the directory in full efs path synatx.
|
|
|
6396 SWITCHES are the switches passed to ls. If SWITCHES is nil, then a
|
|
|
6397 dumb \(with dir\) listing has been done."
|
|
|
6398 (efs-save-match-data
|
|
|
6399 (cond
|
|
|
6400
|
|
|
6401 ;; look for total line
|
|
|
6402 ((looking-at "^total [0-9]+$")
|
|
|
6403 (efs-add-host 'unix host)
|
|
|
6404 (forward-line 1)
|
|
|
6405 ;; Beware of machines that put a blank line after the totals line.
|
|
|
6406 (skip-chars-forward " \t\n")
|
|
|
6407 (efs-ls-parser 'unix host user dir path switches))
|
|
|
6408
|
|
|
6409 ;; Look for hellsoft. Need to do this before looking
|
|
|
6410 ;; for ls errors, since the hellsoft output looks a lot like an ls error.
|
|
|
6411 ((looking-at efs-hell-listing-regexp)
|
|
|
6412 (if (null (car (efs-send-cmd host user '(quote site dos))))
|
|
|
6413 (let* ((key (concat host "/" user "/~"))
|
|
|
6414 (tilde (efs-get-hash-entry
|
|
|
6415 key efs-expand-dir-hashtable)))
|
|
|
6416 (efs-add-host 'hell host)
|
|
|
6417 ;; downcase the expansion of ~
|
|
|
6418 (if (and tilde (string-match "^[^a-z]+$" tilde))
|
|
|
6419 (efs-put-hash-entry key (downcase tilde)
|
|
|
6420 efs-expand-dir-hashtable))
|
|
|
6421 ;; Downcase dir, in case its got some upper case stuff in it.
|
|
|
6422 (setq dir (downcase dir)
|
|
|
6423 path (efs-replace-path-component path dir))
|
|
|
6424 (let ((efs-ls-uncache t))
|
|
|
6425 ;; This will force the data buffer to be re-filled
|
|
|
6426 (efs-ls path nil (format "Relisting %s"
|
|
|
6427 (efs-relativize-filename path))
|
|
|
6428 t))
|
|
|
6429 (efs-parse-listing 'hell host user dir path))
|
|
|
6430 ;; Don't know, give unix a try.
|
|
|
6431 (efs-add-host 'unix host)
|
|
|
6432 nil))
|
|
|
6433
|
|
|
6434 ;; look for ls errors
|
|
|
6435 ((looking-at "[^\n]+\\( not found\\|: Not a directory\\)\n\\'")
|
|
|
6436 ;; It's an ls error message.
|
|
|
6437 (efs-add-host 'unix host)
|
|
|
6438 nil)
|
|
|
6439
|
|
|
6440 ((eobp) ; i.e. (zerop (buffer-size))
|
|
|
6441 ;; This could be one of:
|
|
|
6442 ;; (1) An Ultrix ls error message
|
|
|
6443 ;; (2) A listing with the A switch of an empty directory
|
|
|
6444 ;; on a machine which doesn't give a total line.
|
|
|
6445 ;; (3) The result of an attempt at an nlist. (This would mean a
|
|
|
6446 ;; dumb host.)
|
|
|
6447 ;; (4) The twilight zone.
|
|
|
6448 (cond
|
|
|
6449 ((save-excursion
|
|
|
6450 (set-buffer (process-buffer
|
|
|
6451 (efs-get-process host user)))
|
|
|
6452 (save-excursion
|
|
|
6453 (goto-char (point-max))
|
|
|
6454 (and
|
|
|
6455 ;; The dir ftp output starts with a 200 cmd.
|
|
|
6456 (re-search-backward "^150 " nil t)
|
|
|
6457 ;; We never do an nlist (it's a short listing).
|
|
|
6458 ;; If the machine thinks that we did, it's dumb.
|
|
|
6459 (looking-at "[^\n]+ NLST "))))
|
|
|
6460 ;; It's dumb-unix or ka9q. Anything else?
|
|
|
6461 ;; This will re-fill the data buffer with a dumb listing.
|
|
|
6462 (let ((efs-ls-uncache t))
|
|
|
6463 (efs-ls path nil (format "Relisting %s"
|
|
|
6464 (efs-relativize-filename path))
|
|
|
6465 t))
|
|
|
6466 (cond
|
|
|
6467 ;; check for dumb-unix
|
|
|
6468 ((re-search-forward efs-month-and-time-regexp nil t)
|
|
|
6469 (efs-add-host 'dumb-unix host)
|
|
|
6470 (beginning-of-line)
|
|
|
6471 (efs-parse-listing 'dumb-unix host user dir path))
|
|
|
6472 ;; check for ka9q
|
|
|
6473 ((save-excursion
|
|
|
6474 (goto-char (point-max))
|
|
|
6475 (forward-line -1)
|
|
|
6476 (looking-at efs-ka9q-listing-regexp))
|
|
|
6477 (efs-add-host 'ka9q host)
|
|
|
6478 (efs-parse-listing 'ka9q host user dir path))
|
|
|
6479 (t ; Don't know, try unix.
|
|
|
6480 (efs-add-host 'unix host)
|
|
|
6481 nil)))
|
|
|
6482 ;; check for Novell Netware
|
|
|
6483 ((null (car (efs-send-cmd host user '(quote site nfs))))
|
|
|
6484 (efs-add-host 'netware host)
|
|
|
6485 (let ((efs-ls-uncache t))
|
|
|
6486 (efs-ls path nil (format "Relisting %s"
|
|
|
6487 (efs-relativize-filename path))
|
|
|
6488 t))
|
|
|
6489 (efs-parse-listing 'netware host user dir path))
|
|
|
6490 (t
|
|
|
6491 ;; Assume (1), an Ultrix error message.
|
|
|
6492 (efs-add-host 'unix host)
|
|
|
6493 nil)))
|
|
|
6494
|
|
|
6495 ;; unix without a total line
|
|
|
6496 ((re-search-forward efs-month-and-time-regexp nil t)
|
|
|
6497 (efs-add-host 'unix host)
|
|
|
6498 (beginning-of-line)
|
|
|
6499 (efs-ls-parser 'unix host user dir path switches))
|
|
|
6500
|
|
|
6501 ;; Now we look for host-types, or listing-types which are auto-rec
|
|
|
6502 ;; by the listing parser, because it's not possible to pick them out
|
|
|
6503 ;; from a pwd.
|
|
|
6504
|
|
|
6505 ;; check for dumb-unix
|
|
|
6506 ;; (Guessing of dumb-unix hosts which return an ftp error message is
|
|
|
6507 ;; done in efs-ls.)
|
|
|
6508 ((re-search-forward efs-dumb-unix-listing-regexp nil t)
|
|
|
6509 (efs-add-host 'dumb-unix host)
|
|
|
6510 ;; This will force the data buffer to be re-filled
|
|
|
6511 (let ((efs-ls-uncache t))
|
|
|
6512 (efs-ls path nil (format "Relisting %s"
|
|
|
6513 (efs-relativize-filename path))
|
|
|
6514 t))
|
|
|
6515 (efs-parse-listing 'dumb-unix host user dir path))
|
|
|
6516
|
|
|
6517 ;; check for Distinct's DOS ftp server
|
|
|
6518 ((re-search-forward efs-dos-distinct-date-and-time-regexp nil t)
|
|
|
6519 (efs-add-host 'dos-distinct host)
|
|
|
6520 (efs-parse-listing 'dos-distinct host user dir path))
|
|
|
6521
|
|
|
6522 ;; check for KA9Q pseudo-unix (LINUX?)
|
|
|
6523 ((save-excursion
|
|
|
6524 (goto-char (point-max))
|
|
|
6525 (forward-line -1)
|
|
|
6526 (looking-at efs-ka9q-listing-regexp))
|
|
|
6527 (efs-add-host 'ka9q host)
|
|
|
6528 ;; This will re-fill the data buffer.
|
|
|
6529 ;; Need to do this because ka9q is a dumb host.
|
|
|
6530 (let ((efs-ls-uncache t))
|
|
|
6531 (efs-ls path nil (format "Relisting %s"
|
|
|
6532 (efs-relativize-filename path))
|
|
|
6533 t))
|
|
|
6534 (efs-parse-listing 'ka9q host user dir path))
|
|
|
6535
|
|
|
6536 ;; Check for a unix descriptive (dl) listing
|
|
|
6537 ;; Do this last, because it's hard to guess.
|
|
|
6538 ((re-search-forward efs-unix:dl-listing-regexp nil t)
|
|
|
6539 (efs-add-host 'unix host)
|
|
|
6540 (efs-add-listing-type 'unix:dl host user)
|
|
|
6541 (efs-parse-listing 'unix:dl host user dir path switches))
|
|
|
6542
|
|
|
6543 ;; Don't know what's going on. Return nil, and assume unix.
|
|
|
6544 (t
|
|
|
6545 (efs-add-host 'unix host)
|
|
|
6546 nil))))
|
|
|
6547
|
|
|
6548 ;;;; ------------------------------------------------------------
|
|
|
6549 ;;;; Directory information hashtable.
|
|
|
6550 ;;;; ------------------------------------------------------------
|
|
|
6551
|
|
|
6552 (efs-defun efs-really-file-p nil (file ent)
|
|
|
6553 ;; efs-files-hashtable sometimes contains fictitious entries, when
|
|
|
6554 ;; some OS's allow a file to be accessed by another name. For example,
|
|
|
6555 ;; in VMS the highest version of a file may be accessed by omitting the
|
|
|
6556 ;; the file version number. This function should return t if the
|
|
|
6557 ;; filename FILE is really a file. ENT is the hash entry of the file.
|
|
|
6558 t)
|
|
|
6559
|
|
|
6560 (efs-defun efs-add-file-entry nil (path type size owner
|
|
|
6561 &optional modes nlinks mdtm)
|
|
|
6562 ;; Add a new file entry for PATH
|
|
|
6563 ;; TYPE is nil for a plain file, t for a directory, and a string
|
|
|
6564 ;; (the target of the link) for a symlink.
|
|
|
6565 ;; SIZE is the size of the file in bytes.
|
|
|
6566 ;; OWNER is the owner of the file, as a string.
|
|
|
6567 ;; MODES is the file modes, as a string. In Unix, this will be 10 cars.
|
|
|
6568 ;; NLINKS is the number of links for the file.
|
|
|
6569 ;; MDTM is the last modtime obtained for the file. This is for
|
|
|
6570 ;; short-term cache only, as emacs often has sequences of functions
|
|
|
6571 ;; doing modtime lookup. If you really want to be sure of the modtime,
|
|
|
6572 ;; use efs-get-file-mdtm, which asks the remote server.
|
|
|
6573
|
|
|
6574 (and (eq type t)
|
|
|
6575 (setq path (directory-file-name path)))
|
|
|
6576 (let ((files (efs-get-files-hashtable-entry (file-name-directory path))))
|
|
|
6577 (if files
|
|
|
6578 (efs-put-hash-entry
|
|
|
6579 (efs-get-file-part path)
|
|
|
6580 (cond (mdtm
|
|
|
6581 (list type size owner modes nlinks
|
|
|
6582 mdtm))
|
|
|
6583 (nlinks
|
|
|
6584 (list type size owner modes nlinks))
|
|
|
6585 (modes (list type size owner modes))
|
|
|
6586 (t (list type size owner)))
|
|
|
6587 files
|
|
|
6588 (memq efs-key efs-case-insensitive-host-types)))
|
|
|
6589 (efs-del-from-ls-cache path t nil)))
|
|
|
6590
|
|
|
6591 (efs-defun efs-delete-file-entry nil (path &optional dir-p)
|
|
|
6592 "Delete the file entry for PATH, if its directory info exists."
|
|
|
6593 (if dir-p
|
|
|
6594 (progn
|
|
|
6595 (setq path (file-name-as-directory path))
|
|
|
6596 (efs-del-hash-entry (efs-canonize-file-name path)
|
|
|
6597 efs-files-hashtable)
|
|
|
6598 ;; Note that file-name-as-directory followed by
|
|
|
6599 ;; (substring path 0 -1)
|
|
|
6600 ;; serves to canonicalize directory file names to their unix form.
|
|
|
6601 ;; i.e. in VMS, FOO.DIR -> FOO/ -> FOO
|
|
|
6602 ;; PATH is supposed to be s fully expanded efs-style path.
|
|
|
6603 (setq path (substring path 0 -1))))
|
|
|
6604 (let ((files (efs-get-files-hashtable-entry (file-name-directory path))))
|
|
|
6605 (if files
|
|
|
6606 (efs-del-hash-entry
|
|
|
6607 (efs-get-file-part path)
|
|
|
6608 files
|
|
|
6609 (memq (efs-host-type (car (efs-ftp-path path)))
|
|
|
6610 efs-case-insensitive-host-types))))
|
|
|
6611 (efs-del-from-ls-cache path t nil)
|
|
|
6612 (if dir-p (efs-del-from-ls-cache path nil t)))
|
|
|
6613
|
|
|
6614 (defun efs-set-files (directory files)
|
|
|
6615 "For DIRECTORY, set or change the associated FILES hashtable."
|
|
|
6616 (if files
|
|
|
6617 (efs-put-hash-entry
|
|
|
6618 (efs-canonize-file-name (file-name-as-directory directory))
|
|
|
6619 files efs-files-hashtable)))
|
|
|
6620
|
|
|
6621 (defun efs-parsable-switches-p (switches &optional full-dir)
|
|
|
6622 ;; Returns non-nil if SWITCHES would give an ls listing suitable for parsing
|
|
|
6623 ;; If FULL-DIR is non-nil, the switches must be suitable for parsing a full
|
|
|
6624 ;; ditectory.
|
|
|
6625 (or (null switches)
|
|
|
6626 (efs-save-match-data
|
|
|
6627 (and (string-match "[aA]" switches)
|
|
|
6628 ;; g is not good enough, need l or o for owner.
|
|
|
6629 (string-match "[lo]" switches)
|
|
|
6630 ;; L shows link target, rather than link. We need both.
|
|
|
6631 (not (string-match "[RfL]" switches))
|
|
|
6632 (not (and full-dir (string-match "d" switches)))))))
|
|
|
6633
|
|
|
6634 (defun efs-get-files (directory &optional no-error)
|
|
|
6635 "For DIRECTORY, return a hashtable of file entries.
|
|
|
6636 This will give an error or return nil, depending on the value of
|
|
|
6637 NO-ERROR, if a listing for DIRECTORY cannot be obtained."
|
|
|
6638 (let ((directory (file-name-as-directory directory)))
|
|
|
6639 (or (efs-get-files-hashtable-entry directory)
|
|
|
6640 (and (efs-ls directory (efs-ls-guess-switches) t 'parse no-error)
|
|
|
6641 (efs-get-files-hashtable-entry directory)))))
|
|
|
6642
|
|
|
6643 (efs-defun efs-allow-child-lookup nil (host user dir file)
|
|
|
6644 ;; Returns non-nil if in directory DIR, FILE could possibly be a subdir
|
|
|
6645 ;; according to its file-name syntax, and therefore a child listing should
|
|
|
6646 ;; be attempted. Note that DIR is in directory syntax.
|
|
|
6647 ;; i.e. /foo/bar/, not /foo/bar.
|
|
|
6648 ;; Deal with dired. Anything else?
|
|
|
6649 (not (and (boundp 'dired-local-variables-file)
|
|
|
6650 (stringp dired-local-variables-file)
|
|
|
6651 (string-equal dired-local-variables-file file))))
|
|
|
6652
|
|
|
6653 (defmacro efs-ancestral-check (host-type path ignore-case)
|
|
|
6654 ;; Checks to see if something in a path's ancient parentage
|
|
|
6655 ;; would make it impossible for the path to exist in the directory
|
|
|
6656 ;; tree. In this case it returns nil. Otherwise returns t (there
|
|
|
6657 ;; is essentially no information returned in this case, the file
|
|
|
6658 ;; may exist or not).
|
|
|
6659 ;; This macro should make working with RCS more efficient.
|
|
|
6660 ;; It also helps with FTP servers that go into fits if we ask to
|
|
|
6661 ;; list a non-existent dir.
|
|
|
6662 ;; Yes, I know that the function mapped over the hashtable can
|
|
|
6663 ;; be written more cleanly with a concat, but this is faster.
|
|
|
6664 ;; concat's cause a lot of consing. So do regexp-quote's, but we can't
|
|
|
6665 ;; avoid it.
|
|
|
6666 ;; Probably doesn't make much sense for this to be an efs-defun, since
|
|
|
6667 ;; the host-type dependence is very mild.
|
|
|
6668 (`
|
|
|
6669 (let ((path (, path)) ; expand once
|
|
|
6670 (ignore-case (, ignore-case))
|
|
|
6671 str)
|
|
|
6672 ;; eliminate flat file systems -- should have a constant for this
|
|
|
6673 (or (memq (, host-type) '(mts cms mvs cms-knet))
|
|
|
6674 (efs-save-match-data
|
|
|
6675 (catch 'foo
|
|
|
6676 (efs-map-hashtable
|
|
|
6677 (function
|
|
|
6678 (lambda (key val)
|
|
|
6679 (and (eq (string-match (regexp-quote key) path) 0)
|
|
|
6680 (setq str (substring path (match-end 0)))
|
|
|
6681 (string-match "^[^/]+" str)
|
|
|
6682 (not (efs-hash-entry-exists-p
|
|
|
6683 (substring str 0 (match-end 0))
|
|
|
6684 val ignore-case))
|
|
|
6685 (throw 'foo nil))))
|
|
|
6686 efs-files-hashtable)
|
|
|
6687 t))))))
|
|
|
6688
|
|
|
6689 (defun efs-file-entry-p (path)
|
|
|
6690 ;; Return whether there is a file entry for PATH.
|
|
|
6691 ;; Under no circumstances does this cause FTP activity.
|
|
|
6692 (let* ((path (directory-file-name (efs-canonize-file-name path)))
|
|
|
6693 (dir (file-name-directory path))
|
|
|
6694 (file (efs-get-file-part path))
|
|
|
6695 (tbl (efs-get-files-hashtable-entry dir)))
|
|
|
6696 (and tbl (efs-hash-entry-exists-p
|
|
|
6697 file tbl
|
|
|
6698 (memq (efs-host-type (car (efs-ftp-path dir)))
|
|
|
6699 efs-case-insensitive-host-types)) t)))
|
|
|
6700
|
|
|
6701 (defun efs-get-file-entry (path)
|
|
|
6702 "Return the given file entry for PATH.
|
|
|
6703 This is a list of the form \(type size owner modes nlinks modtm\),
|
|
|
6704 where type is nil for a normal file, t for a directory, and a string for a
|
|
|
6705 symlink, size is the size of the file in bytes, if known, and modes are
|
|
|
6706 the permission modes of the file as a string. modtm is short-term the
|
|
|
6707 cache of the file modtime. It is not used by `verify-visited-file-modtime'.
|
|
|
6708 If the file isn't in the hashtable, this returns nil."
|
|
|
6709 (let* ((path (directory-file-name (efs-canonize-file-name path)))
|
|
|
6710 (dir (file-name-directory path))
|
|
|
6711 (file (efs-get-file-part path))
|
|
|
6712 (parsed (efs-ftp-path dir))
|
|
|
6713 (host (car parsed))
|
|
|
6714 (host-type (efs-host-type host))
|
|
|
6715 (ent (efs-get-files-hashtable-entry dir))
|
|
|
6716 (ignore-case (memq host-type efs-case-insensitive-host-types)))
|
|
|
6717 (if ent
|
|
|
6718 (efs-get-hash-entry file ent ignore-case)
|
|
|
6719 (let ((user (nth 1 parsed))
|
|
|
6720 (r-dir (nth 2 parsed)))
|
|
|
6721 (and (efs-ancestral-check host-type path ignore-case)
|
|
|
6722 (or (and efs-allow-child-lookup
|
|
|
6723 (efs-allow-child-lookup host-type
|
|
|
6724 host user r-dir file)
|
|
|
6725 (setq ent (efs-get-files path t))
|
|
|
6726 (efs-get-hash-entry "." ent))
|
|
|
6727 ;; i.e. it's a directory by child lookup
|
|
|
6728 (efs-get-hash-entry
|
|
|
6729 file (efs-get-files dir) ignore-case)))))))
|
|
|
6730
|
|
|
6731 (defun efs-wipe-file-entries (host user)
|
|
|
6732 "Remove cache data for all files on HOST and USER.
|
|
|
6733 This replaces the file entry information hashtable with one that
|
|
|
6734 doesn't have any entries for the given HOST, USER pair."
|
|
|
6735 (let ((new-tbl (efs-make-hashtable (length efs-files-hashtable)))
|
|
|
6736 (host (downcase host))
|
|
|
6737 (case-fold (memq (efs-host-type host)
|
|
|
6738 efs-case-insensitive-host-types)))
|
|
|
6739 (if case-fold (setq user (downcase user)))
|
|
|
6740 (efs-map-hashtable
|
|
|
6741 (function
|
|
|
6742 (lambda (key val)
|
|
|
6743 (let ((parsed (efs-ftp-path key)))
|
|
|
6744 (if parsed
|
|
|
6745 (let ((h (nth 0 parsed))
|
|
|
6746 (u (nth 1 parsed)))
|
|
|
6747 (or (and (string-equal host (downcase h))
|
|
|
6748 (string-equal user (if case-fold (downcase u) u)))
|
|
|
6749 (efs-put-hash-entry key val new-tbl)))))))
|
|
|
6750 efs-files-hashtable)
|
|
|
6751 (setq efs-files-hashtable new-tbl)))
|
|
|
6752
|
|
|
6753
|
|
|
6754 ;;;; ============================================================
|
|
|
6755 ;;;; >8
|
|
|
6756 ;;;; Redefinitions of standard GNU Emacs functions.
|
|
|
6757 ;;;; ============================================================
|
|
|
6758
|
|
|
6759 ;;;; ------------------------------------------------------------
|
|
|
6760 ;;;; expand-file-name and friends...
|
|
|
6761 ;;;; ------------------------------------------------------------
|
|
|
6762
|
|
|
6763 ;; New filename expansion code for efs.
|
|
|
6764 ;; The overall structure is based around the following internal
|
|
|
6765 ;; functions and macros. Since these are internal, they do NOT
|
|
|
6766 ;; call efs-save-match-data. This is done by their calling
|
|
|
6767 ;; function.
|
|
|
6768 ;;
|
|
|
6769 ;; efs-expand-tilde
|
|
|
6770 ;; - expands all ~ constructs, both local and remote.
|
|
|
6771 ;; efs-short-circuit-file-name
|
|
|
6772 ;; - short-circuits //'s and /~'s, for both local and remote paths.
|
|
|
6773 ;; efs-de-dot-file-name
|
|
|
6774 ;; - canonizes /../ and /./'s in both local and remote paths.
|
|
|
6775 ;;
|
|
|
6776 ;; The following two functions overload existing emacs functions.
|
|
|
6777 ;; They are the entry points to this filename expansion code, and as such
|
|
|
6778 ;; call efs-save-match-data.
|
|
|
6779 ;;
|
|
|
6780 ;; efs-expand-file-name
|
|
|
6781 ;; efs-substitute-in-file-name
|
|
|
6782
|
|
|
6783 ;;; utility macros
|
|
|
6784
|
|
|
6785 (defmacro efs-short-circuit-file-name (filename)
|
|
|
6786 ;; Short-circuits //'s and /~'s in filenames.
|
|
|
6787 ;; Returns a list consisting of the local path,
|
|
|
6788 ;; host-type, host, user. For local hosts,
|
|
|
6789 ;; host-type, host, and user are all nil.
|
|
|
6790 (`
|
|
|
6791 (let ((start 0)
|
|
|
6792 (string (, filename))
|
|
|
6793 backskip regexp lbackskip
|
|
|
6794 lregexp parsed host-type host user)
|
|
|
6795
|
|
|
6796 (if efs-local-apollo-unix
|
|
|
6797 (setq lregexp ".//+"
|
|
|
6798 lbackskip 2)
|
|
|
6799 (setq lregexp "//+"
|
|
|
6800 lbackskip 1))
|
|
|
6801
|
|
|
6802 ;; Short circuit /user@mach: roots. It is important to do this
|
|
|
6803 ;; now to avoid unnecessary ftp connections.
|
|
|
6804
|
|
|
6805 (while (string-match efs-path-root-short-circuit-regexp string start)
|
|
|
6806 (setq start (1+ (match-beginning 0))))
|
|
|
6807 (or (zerop start) (setq string (substring string start)
|
|
|
6808 start 0))
|
|
|
6809
|
|
|
6810 ;; identify remote root
|
|
|
6811
|
|
|
6812 (if (setq parsed (efs-ftp-path-macro string))
|
|
|
6813 (if (memq (setq string (nth 2 parsed)
|
|
|
6814 host-type
|
|
|
6815 (efs-host-type (setq host (car parsed))
|
|
|
6816 (setq user (nth 1 parsed))))
|
|
|
6817 '(apollo-unix dumb-apollo-unix))
|
|
|
6818 (setq regexp ".//+"
|
|
|
6819 backskip 2)
|
|
|
6820 (setq regexp "//+"
|
|
|
6821 backskip 1))
|
|
|
6822 (setq regexp lregexp
|
|
|
6823 backskip lbackskip))
|
|
|
6824
|
|
|
6825 ;; Now short-circuit in an apollo and efs sensitive way.
|
|
|
6826
|
|
|
6827 (while (cond ((string-match regexp string start)
|
|
|
6828 (setq start (- (match-end 0) backskip)))
|
|
|
6829 ((string-match "/~" string start)
|
|
|
6830 (setq start (1- (match-end 0)))))
|
|
|
6831
|
|
|
6832 (and host-type
|
|
|
6833 (null efs-short-circuit-to-remote-root)
|
|
|
6834 (setq host-type nil
|
|
|
6835 regexp lregexp
|
|
|
6836 backskip lbackskip)))
|
|
|
6837 (or (zerop start) (setq string (substring string start)))
|
|
|
6838 (list string host-type (and host-type host) (and host-type user)))))
|
|
|
6839
|
|
|
6840 (defmacro efs-expand-tilde (tilde host-type host user)
|
|
|
6841 ;; Expands a TILDE (~ or ~sandy type construction)
|
|
|
6842 ;; Takes as an arg a filename (not directory name!)
|
|
|
6843 ;; and returns a filename. HOST-TYPE is the type of remote host.
|
|
|
6844 ;; nil is the type of the local host.
|
|
|
6845 (`
|
|
|
6846 (if (, host-type) ; nil host-type is the local machine
|
|
|
6847 (let* ((host (downcase (, host)))
|
|
|
6848 (host-type (, host-type))
|
|
|
6849 (ignore-case (memq host-type
|
|
|
6850 efs-case-insensitive-host-types))
|
|
|
6851 (tilde (, tilde))
|
|
|
6852 (user (, user))
|
|
|
6853 (key (concat host "/" user "/" tilde))
|
|
|
6854 (res (efs-get-hash-entry
|
|
|
6855 key efs-expand-dir-hashtable ignore-case)))
|
|
|
6856 (or res
|
|
|
6857 ;; for real accounts on unix systems, use the get trick
|
|
|
6858 (and (not (efs-anonymous-p user))
|
|
|
6859 (memq host-type efs-unix-host-types)
|
|
|
6860 (let ((line (nth 1 (efs-send-cmd
|
|
|
6861 host user
|
|
|
6862 (list 'get tilde "/dev/null")
|
|
|
6863 (format "expanding %s" tilde)))))
|
|
|
6864 (setq res
|
|
|
6865 (and (string-match efs-expand-dir-msgs line)
|
|
|
6866 (substring line
|
|
|
6867 (match-beginning 1)
|
|
|
6868 (match-end 1))))
|
|
|
6869 (if res
|
|
|
6870 (progn
|
|
|
6871 (setq res (efs-internal-directory-file-name res))
|
|
|
6872 (efs-put-hash-entry
|
|
|
6873 key res efs-expand-dir-hashtable ignore-case)
|
|
|
6874 res))))
|
|
|
6875 (progn
|
|
|
6876 (setq res
|
|
|
6877 (if (string-equal tilde "~")
|
|
|
6878 (car (efs-send-pwd
|
|
|
6879 host-type host user))
|
|
|
6880 (let* ((home-key (concat host "/" user "/~"))
|
|
|
6881 (home (efs-get-hash-entry
|
|
|
6882 home-key efs-expand-dir-hashtable
|
|
|
6883 ignore-case))
|
|
|
6884 pwd-result)
|
|
|
6885 (if home
|
|
|
6886 (setq home
|
|
|
6887 (efs-fix-path
|
|
|
6888 host-type
|
|
|
6889 (efs-internal-file-name-as-directory
|
|
|
6890 host-type home)))
|
|
|
6891 (if (setq home
|
|
|
6892 (car
|
|
|
6893 (setq pwd-result
|
|
|
6894 (efs-send-pwd
|
|
|
6895 host-type
|
|
|
6896 host user))))
|
|
|
6897 (efs-put-hash-entry
|
|
|
6898 home-key
|
|
|
6899 (efs-internal-directory-file-name
|
|
|
6900 (efs-fix-path host-type home 'reverse))
|
|
|
6901 efs-expand-dir-hashtable ignore-case)
|
|
|
6902 (efs-error host user
|
|
|
6903 (concat "PWD failed: "
|
|
|
6904 (cdr pwd-result)))))
|
|
|
6905 (unwind-protect
|
|
|
6906 (and (efs-raw-send-cd host user
|
|
|
6907 (efs-fix-path
|
|
|
6908 host-type tilde) t)
|
|
|
6909 (car
|
|
|
6910 (efs-send-pwd
|
|
|
6911 host-type host user)))
|
|
|
6912 (efs-raw-send-cd host user home)))))
|
|
|
6913 (if res
|
|
|
6914 (progn
|
|
|
6915 (setq res (efs-internal-directory-file-name
|
|
|
6916 (efs-fix-path host-type res 'reverse)))
|
|
|
6917 (efs-put-hash-entry
|
|
|
6918 key res efs-expand-dir-hashtable ignore-case)
|
|
|
6919 res)))
|
|
|
6920 (if (string-equal tilde "~")
|
|
|
6921 (error "Cannot get home directory on %s" host)
|
|
|
6922 (error "User %s is not known on %s" (substring tilde 1) host))))
|
|
|
6923 ;; local machine
|
|
|
6924 (efs-real-expand-file-name (, tilde)))))
|
|
|
6925
|
|
|
6926 (defmacro efs-de-dot-file-name (string)
|
|
|
6927 ;; Takes a string as arguments, and removes /../'s and /./'s.
|
|
|
6928 (`
|
|
|
6929 (let ((string (, string))
|
|
|
6930 (start 0)
|
|
|
6931 new make-dir)
|
|
|
6932 ;; to make the regexp's simpler, canonicalize to directory name.
|
|
|
6933 (if (setq make-dir (string-match "/\\.\\.?$" string))
|
|
|
6934 (setq string (concat string "/")))
|
|
|
6935 (while (string-match "/\\./" string start)
|
|
|
6936 (setq new (concat new
|
|
|
6937 (substring string
|
|
|
6938 start (match-beginning 0)))
|
|
|
6939 start (1- (match-end 0))))
|
|
|
6940
|
|
|
6941 (if new (setq string (concat new (substring string start))))
|
|
|
6942
|
|
|
6943 (while (string-match "/[^/]+/\\.\\./" string)
|
|
|
6944 ;; Is there a way to avoid all this concating and copying?
|
|
|
6945 (setq string (concat (substring string 0 (1+ (match-beginning 0)))
|
|
|
6946 (substring string (match-end 0)))))
|
|
|
6947
|
|
|
6948 ;; Do /../ and //../ special cases. They should expand to
|
|
|
6949 ;; / and //, respectively.
|
|
|
6950 (if (string-match "^\\(/+\\)\\.\\./" string)
|
|
|
6951 (setq string (concat (substring string 0 (match-end 1))
|
|
|
6952 (substring string (match-end 0)))))
|
|
|
6953
|
|
|
6954 (if (and make-dir
|
|
|
6955 (not (string-match "^/+$" string)))
|
|
|
6956 (substring string 0 -1)
|
|
|
6957 string))))
|
|
|
6958
|
|
|
6959 (defun efs-substitute-in-file-name (string)
|
|
|
6960 "Documented as original."
|
|
|
6961 ;; Because of the complicated interaction between short-circuiting
|
|
|
6962 ;; and environment variable substitution, this can't call the macro
|
|
|
6963 ;; efs-short-circuit-file-name.
|
|
|
6964 (efs-save-match-data
|
|
|
6965 (let ((start 0)
|
|
|
6966 var new root backskip regexp lbackskip
|
|
|
6967 lregexp parsed fudge-host-type rstart error)
|
|
|
6968
|
|
|
6969 (if efs-local-apollo-unix
|
|
|
6970 (setq lregexp ".//+"
|
|
|
6971 lbackskip 2)
|
|
|
6972 (setq lregexp "//+"
|
|
|
6973 lbackskip 1))
|
|
|
6974
|
|
|
6975 ;; Subst. existing env variables
|
|
|
6976 (while (string-match "\\$" string start)
|
|
|
6977 (setq new (concat new (substring string start (match-beginning 0)))
|
|
|
6978 start (match-end 0))
|
|
|
6979 (cond ((eq (string-match "\\$" string start) start)
|
|
|
6980 (setq start (1+ start)
|
|
|
6981 new (concat new "$$")))
|
|
|
6982 ((eq (string-match "{" string start) start)
|
|
|
6983 (if (and (string-match "}" string start)
|
|
|
6984 (setq var (getenv
|
|
|
6985 (substring string (1+ start)
|
|
|
6986 (1- (match-end 0))))))
|
|
|
6987 (setq start (match-end 0)
|
|
|
6988 new (concat new var))
|
|
|
6989 (setq new (concat new "$"))))
|
|
|
6990 ((eq (string-match "[a-zA-Z0-9]+" string start) start)
|
|
|
6991 (if (setq var (getenv
|
|
|
6992 (substring string start (match-end 0))))
|
|
|
6993 (setq start (match-end 0)
|
|
|
6994 new (concat new var))
|
|
|
6995 (setq new (concat new "$"))))
|
|
|
6996 ((setq new (concat new "$")))))
|
|
|
6997 (if new (setq string (concat new (substring string start))
|
|
|
6998 start 0))
|
|
|
6999
|
|
|
7000 ;; Short circuit /user@mach: roots. It is important to do this
|
|
|
7001 ;; now to avoid unnecessary ftp connections.
|
|
|
7002
|
|
|
7003 (while (string-match efs-path-root-short-circuit-regexp
|
|
|
7004 string start)
|
|
|
7005 (setq start (1+ (match-beginning 0))))
|
|
|
7006 (or (zerop start) (setq string (substring string start)
|
|
|
7007 start 0))
|
|
|
7008
|
|
|
7009 ;; Look for invalid environment variables in the root. If one is found,
|
|
|
7010 ;; we set the host-type to 'unix. Since we can't login in to determine
|
|
|
7011 ;; it. There is a good chance that we will bomb later with an error,
|
|
|
7012 ;; but the day may yet be saved if the root is short-circuited off.
|
|
|
7013
|
|
|
7014 (if (string-match efs-path-root-regexp string)
|
|
|
7015 (progn
|
|
|
7016 (setq root (substring string 0 (match-end 0))
|
|
|
7017 start (match-end 0))
|
|
|
7018 (if (string-match "[^$]\\(\\$\\$\\)*\\$[^$]" root)
|
|
|
7019 (progn
|
|
|
7020 (setq rstart (1- (match-end 0))
|
|
|
7021 fudge-host-type t)
|
|
|
7022 (cond
|
|
|
7023 ((eq (elt root rstart) ?{)
|
|
|
7024 (setq
|
|
|
7025 error
|
|
|
7026 (if (string-match "}" root rstart)
|
|
|
7027 (concat
|
|
|
7028 "Subsituting non-existent environment variable "
|
|
|
7029 (substring root (1+ rstart) (match-beginning 0)))
|
|
|
7030 "Missing \"}\" in environment-variable substitution")))
|
|
|
7031 ((eq (string-match "[A-Za-z0-9]+" root rstart) rstart)
|
|
|
7032 (setq
|
|
|
7033 error
|
|
|
7034 (concat
|
|
|
7035 "Subsituting non-existent environment variable "
|
|
|
7036 (substring root rstart (match-beginning 0)))))
|
|
|
7037 (t
|
|
|
7038 (setq
|
|
|
7039 error
|
|
|
7040 "Bad format environment-variable substitution")))))
|
|
|
7041 (setq root (efs-unquote-dollars root)
|
|
|
7042 parsed (efs-ftp-path root))
|
|
|
7043
|
|
|
7044 (if (and (not fudge-host-type)
|
|
|
7045 ;; This may trigger an FTP connection
|
|
|
7046 (memq (efs-host-type (car parsed) (nth 1 parsed))
|
|
|
7047 '(apollo-unix dumb-apollo-unix)))
|
|
|
7048 (setq regexp ".//+"
|
|
|
7049 backskip 2)
|
|
|
7050 (setq regexp "//+"
|
|
|
7051 backskip 1)))
|
|
|
7052 ;; no root, we're local
|
|
|
7053 (setq regexp lregexp
|
|
|
7054 backskip lbackskip))
|
|
|
7055
|
|
|
7056 ;; Now short-circuit in an apollo and efs sensitive way.
|
|
|
7057
|
|
|
7058 (while (cond ((string-match regexp string start)
|
|
|
7059 (setq start (- (match-end 0) backskip)))
|
|
|
7060 ((string-match "/~" string start)
|
|
|
7061 (setq start (1- (match-end 0)))))
|
|
|
7062
|
|
|
7063 (and root
|
|
|
7064 (null efs-short-circuit-to-remote-root)
|
|
|
7065 (setq root nil
|
|
|
7066 regexp lregexp
|
|
|
7067 backskip lbackskip)))
|
|
|
7068
|
|
|
7069 ;; If we still have a bad root, barf.
|
|
|
7070 (if (and root error) (error error))
|
|
|
7071
|
|
|
7072 ;; look for non-existent evironment variables in the path
|
|
|
7073
|
|
|
7074 (if (string-match
|
|
|
7075 "\\([^$]\\|^\\)\\(\\$\\$\\)*\\$\\([^$]\\|$\\)" string start)
|
|
|
7076 (progn
|
|
|
7077 (setq start (match-beginning 3))
|
|
|
7078 (cond
|
|
|
7079 ((eq (length string) start)
|
|
|
7080 (error "Empty string is an invalid environment variable"))
|
|
|
7081 ((eq (elt string start) ?{)
|
|
|
7082 (if (string-match "}" string start)
|
|
|
7083 (error
|
|
|
7084 "Subsituting non-existent environment variable %s"
|
|
|
7085 (substring string (1+ start) (match-end 0)))
|
|
|
7086 (error
|
|
|
7087 "Missing \"}\" in environment-variable substitution")))
|
|
|
7088 ((eq (string-match "[A-Za-z0-9]+" string start) start)
|
|
|
7089 (error
|
|
|
7090 "Subsituting non-existent environment variable %s"
|
|
|
7091 (substring string start (match-end 0))))
|
|
|
7092 (t
|
|
|
7093 (error
|
|
|
7094 "Bad format environment-variable substitution")))))
|
|
|
7095
|
|
|
7096 (if root
|
|
|
7097 (concat root
|
|
|
7098 (efs-unquote-dollars
|
|
|
7099 (if (zerop start)
|
|
|
7100 string
|
|
|
7101 (substring string start))))
|
|
|
7102 (efs-unquote-dollars
|
|
|
7103 (if (zerop start)
|
|
|
7104 string
|
|
|
7105 (substring string start)))))))
|
|
|
7106
|
|
|
7107 (defun efs-expand-file-name (name &optional default)
|
|
|
7108 "Documented as original."
|
|
|
7109 (let (s-c-res path host user host-type)
|
|
|
7110 (efs-save-match-data
|
|
|
7111 (or (file-name-absolute-p name)
|
|
|
7112 (setq name (concat
|
|
|
7113 (file-name-as-directory
|
|
|
7114 (or default default-directory))
|
|
|
7115 name)))
|
|
|
7116 (setq s-c-res (efs-short-circuit-file-name name)
|
|
|
7117 path (car s-c-res)
|
|
|
7118 host-type (nth 1 s-c-res)
|
|
|
7119 host (nth 2 s-c-res)
|
|
|
7120 user (nth 3 s-c-res))
|
|
|
7121 (cond ((string-match "^~[^/]*" path)
|
|
|
7122 (let ((start (match-end 0)))
|
|
|
7123 (setq path (concat
|
|
|
7124 (efs-expand-tilde
|
|
|
7125 (substring path 0 start)
|
|
|
7126 host-type host user)
|
|
|
7127 (substring path start)))))
|
|
|
7128 ((and host-type (not (file-name-absolute-p path)))
|
|
|
7129 ;; We expand the empty string to a directory.
|
|
|
7130 ;; This can be more efficient for filename
|
|
|
7131 ;; completion. It's also consistent with non-unix.
|
|
|
7132 (let ((tilde (efs-expand-tilde
|
|
|
7133 "~" host-type host user)))
|
|
|
7134 (if (string-equal tilde "/")
|
|
|
7135 (setq path (concat "/" path))
|
|
|
7136 (setq path (concat tilde "/" path))))))
|
|
|
7137
|
|
|
7138 (setq path (efs-de-dot-file-name path))
|
|
|
7139 (if host-type
|
|
|
7140 (format efs-path-format-string user host path)
|
|
|
7141 path))))
|
|
|
7142
|
|
|
7143 ;;;; ------------------------------------------------------------
|
|
|
7144 ;;;; Other functions for manipulating file names.
|
|
|
7145 ;;;; ------------------------------------------------------------
|
|
|
7146
|
|
|
7147 (defun efs-internal-file-name-extension (filename)
|
|
|
7148 ;; Returns the extension for file name FN.
|
|
|
7149 (save-match-data
|
|
|
7150 (let ((file (file-name-sans-versions (file-name-nondirectory filename))))
|
|
|
7151 (if (string-match "\\.[^.]*\\'" file)
|
|
|
7152 (substring file (match-beginning 0))
|
|
|
7153 ""))))
|
|
|
7154
|
|
|
7155 (defun efs-file-name-as-directory (name)
|
|
|
7156 ;; version of file-name-as-directory for remote files.
|
|
|
7157 ;; Usually just appends a / if there isn't one already.
|
|
|
7158 ;; For some systems, it may also remove .DIR like extensions.
|
|
|
7159 (let* ((parsed (efs-ftp-path name))
|
|
|
7160 (file (nth 2 parsed)))
|
|
|
7161 (if (string-equal file "")
|
|
|
7162 name
|
|
|
7163 (efs-internal-file-name-as-directory
|
|
|
7164 (efs-host-type (car parsed) (nth 1 parsed)) name))))
|
|
|
7165
|
|
|
7166 (efs-defun efs-internal-file-name-as-directory nil (name)
|
|
|
7167 ;; By default, simply adds a trailing /, if there isn't one.
|
|
|
7168 ;; Note that for expanded filenames, it pays to call this rather
|
|
|
7169 ;; than efs-file-name-as-directory.
|
|
|
7170 (let (file-name-handler-alist)
|
|
|
7171 (file-name-as-directory name)))
|
|
|
7172
|
|
|
7173 (defun efs-file-name-directory (name)
|
|
|
7174 ;; file-name-directory for remote files. Takes care not to
|
|
|
7175 ;; turn /user@host: into /.
|
|
|
7176 (let ((path (nth 2 (efs-ftp-path name)))
|
|
|
7177 file-name-handler-alist)
|
|
|
7178 (if (or (string-equal path "")
|
|
|
7179 (and (= (string-to-char path) ?~)
|
|
|
7180 (not
|
|
|
7181 (efs-save-match-data
|
|
|
7182 (string-match "/" path 1)))))
|
|
|
7183 name
|
|
|
7184 (if (efs-save-match-data
|
|
|
7185 (not (string-match "/" path)))
|
|
|
7186 (efs-replace-path-component name "")
|
|
|
7187 (file-name-directory name)))))
|
|
|
7188
|
|
|
7189 (defun efs-file-name-nondirectory (name)
|
|
|
7190 ;; Computes file-name-nondirectory for remote files.
|
|
|
7191 ;; For expanded filenames, can just call efs-internal-file-name-nondirectory.
|
|
|
7192 (let ((file (nth 2 (efs-ftp-path name))))
|
|
|
7193 (if (or (string-equal file "")
|
|
|
7194 (and (= (string-to-char file) ?~)
|
|
|
7195 (not
|
|
|
7196 (efs-save-match-data
|
|
|
7197 (string-match "/" file 1)))))
|
|
|
7198 ""
|
|
|
7199 (if (efs-save-match-data
|
|
|
7200 (not (string-match "/" file)))
|
|
|
7201 file
|
|
|
7202 (efs-internal-file-name-nondirectory name)))))
|
|
|
7203
|
|
|
7204 (defun efs-internal-file-name-nondirectory (name)
|
|
|
7205 ;; Version of file-name-nondirectory, without the efs-file-handler-function.
|
|
|
7206 ;; Useful to call this, if we have already decomposed the filename.
|
|
|
7207 (let (file-name-handler-alist)
|
|
|
7208 (file-name-nondirectory name)))
|
|
|
7209
|
|
|
7210 (defun efs-directory-file-name (dir)
|
|
|
7211 ;; Computes directory-file-name for remote files.
|
|
|
7212 ;; Needs to be careful not to turn /foo@bar:/ into /foo@bar:
|
|
|
7213 (let ((parsed (efs-ftp-path dir)))
|
|
|
7214 (if (string-equal "/" (nth 2 parsed))
|
|
|
7215 dir
|
|
|
7216 (efs-internal-directory-file-name dir))))
|
|
|
7217
|
|
|
7218 (defun efs-internal-directory-file-name (dir)
|
|
|
7219 ;; Call this if you want to apply directory-file-name to the remote
|
|
|
7220 ;; part of a efs-style path. Don't call for non-efs-style paths,
|
|
|
7221 ;; as this short-circuits the file-name-handler-alist completely.
|
|
|
7222 (let (file-name-handler-alist)
|
|
|
7223 (directory-file-name dir)))
|
|
|
7224
|
|
|
7225 (efs-defun efs-remote-directory-file-name nil (dir)
|
|
|
7226 "Returns the file name on the remote system of directory DIR.
|
|
|
7227 If the remote system is not unix, this may not be the same as the file name
|
|
|
7228 of the directory in efs's internal cache."
|
|
|
7229 (directory-file-name dir))
|
|
|
7230
|
|
|
7231 (defun efs-file-name-sans-versions (filename &optional keep-backup-versions)
|
|
|
7232 ;; Version of file-name-sans-versions for remote files.
|
|
|
7233 (or (file-name-absolute-p filename)
|
|
|
7234 (setq filename (expand-file-name filename)))
|
|
|
7235 (let ((parsed (efs-ftp-path filename)))
|
|
|
7236 (efs-internal-file-name-sans-versions
|
|
|
7237 (efs-host-type (car parsed) (nth 1 parsed))
|
|
|
7238 filename keep-backup-versions)))
|
|
|
7239
|
|
|
7240 (efs-defun efs-internal-file-name-sans-versions nil
|
|
|
7241 (filename &optional keep-backup-versions)
|
|
|
7242 (let (file-name-handler-alist)
|
|
|
7243 (file-name-sans-versions filename keep-backup-versions)))
|
|
|
7244
|
|
|
7245 (defun efs-diff-latest-backup-file (fn)
|
|
|
7246 ;; Version of diff latest backup file for remote files.
|
|
|
7247 ;; Accomodates non-unix.
|
|
|
7248 ;; Returns the latest backup for fn, according to the numbering
|
|
|
7249 ;; of the backups. Does not check file-newer-than-file-p.
|
|
|
7250 (let ((parsed (efs-ftp-path fn)))
|
|
|
7251 (efs-internal-diff-latest-backup-file
|
|
|
7252 (efs-host-type (car parsed) (nth 1 parsed)) fn)))
|
|
|
7253
|
|
|
7254 (efs-defun efs-internal-diff-latest-backup-file nil (fn)
|
|
|
7255 ;; Default behaviour is the behaviour in diff.el
|
|
|
7256 (let (file-name-handler-alist)
|
|
|
7257 (diff-latest-backup-file fn)))
|
|
|
7258
|
|
|
7259 (defun efs-unhandled-file-name-directory (filename)
|
|
|
7260 ;; Calculate a default unhandled directory for an efs buffer.
|
|
|
7261 ;; This is used to compute directories in which to execute
|
|
|
7262 ;; processes. This is relevant to V19 only. Doesn't do any harm for
|
|
|
7263 ;; older versions though. It would be nice if this wasn't such a
|
|
|
7264 ;; kludge.
|
|
|
7265 (file-name-directory efs-tmp-name-template))
|
|
|
7266
|
|
|
7267 (defun efs-file-truename (filename)
|
|
|
7268 ;; Calculates a remote file's truename, if this isn't inhibited.
|
|
|
7269 (let ((filename (expand-file-name filename)))
|
|
|
7270 (if (and efs-compute-remote-buffer-file-truename
|
|
|
7271 (memq (efs-host-type (car (efs-ftp-path filename)))
|
|
|
7272 efs-unix-host-types))
|
|
|
7273 (efs-internal-file-truename filename)
|
|
|
7274 filename)))
|
|
|
7275
|
|
|
7276 (defun efs-internal-file-truename (filename)
|
|
|
7277 ;; Internal function so that we don't keep checking
|
|
|
7278 ;; efs-compute-remote-buffer-file-truename, etc, as we recurse.
|
|
|
7279 (let ((dir (efs-file-name-directory filename))
|
|
|
7280 target dirfile)
|
|
|
7281 ;; Get the truename of the directory.
|
|
|
7282 (setq dirfile (efs-directory-file-name dir))
|
|
|
7283 ;; If these are equal, we have the (or a) root directory.
|
|
|
7284 (or (string= dir dirfile)
|
|
|
7285 (setq dir (efs-file-name-as-directory
|
|
|
7286 (efs-internal-file-truename dirfile))))
|
|
|
7287 (if (equal ".." (efs-file-name-nondirectory filename))
|
|
|
7288 (efs-directory-file-name (efs-file-name-directory
|
|
|
7289 (efs-directory-file-name dir)))
|
|
|
7290 (if (equal "." (efs-file-name-nondirectory filename))
|
|
|
7291 (efs-directory-file-name dir)
|
|
|
7292 ;; Put it back on the file name.
|
|
|
7293 (setq filename (concat dir (efs-file-name-nondirectory filename)))
|
|
|
7294 ;; Is the file name the name of a link?
|
|
|
7295 (setq target (efs-file-symlink-p filename))
|
|
|
7296 (if target
|
|
|
7297 ;; Yes => chase that link, then start all over
|
|
|
7298 ;; since the link may point to a directory name that uses links.
|
|
|
7299 ;; We can't safely use expand-file-name here
|
|
|
7300 ;; since target might look like foo/../bar where foo
|
|
|
7301 ;; is itself a link. Instead, we handle . and .. above.
|
|
|
7302 (if (file-name-absolute-p target)
|
|
|
7303 (efs-internal-file-truename target)
|
|
|
7304 (efs-internal-file-truename (concat dir target)))
|
|
|
7305 ;; No, we are done!
|
|
|
7306 filename)))))
|
|
|
7307
|
|
|
7308
|
|
|
7309 ;;;; ----------------------------------------------------------------
|
|
|
7310 ;;;; I/O functions
|
|
|
7311 ;;;; ----------------------------------------------------------------
|
|
|
7312
|
|
|
7313 (efs-define-fun efs-set-buffer-file-name (filename)
|
|
|
7314 ;; Sets the buffer local variables for filename appropriately.
|
|
|
7315 ;; A special function because Lucid and FSF do this differently.
|
|
|
7316 ;; This default behaviour is the lowest common denominator.
|
|
|
7317 (setq buffer-file-name filename))
|
|
|
7318
|
|
|
7319 (defun efs-write-region (start end filename &optional append visit &rest args)
|
|
|
7320 ;; write-region for remote files.
|
|
|
7321 ;; This version accepts the V19 interpretation for the arg VISIT.
|
|
|
7322 ;; However, making use of this within V18 may cause errors to crop up.
|
|
|
7323 ;; ARGS should catch the MULE coding-system argument.
|
|
|
7324 (if (stringp visit) (setq visit (expand-file-name visit)))
|
|
|
7325 (setq filename (expand-file-name filename))
|
|
|
7326 (let ((parsed (efs-ftp-path filename))
|
|
|
7327 ;; Make sure that the after-write-region-hook isn't called inside
|
|
|
7328 ;; the file-handler-alist
|
|
|
7329 (after-write-region-hook nil))
|
|
|
7330 (if parsed
|
|
|
7331 (let* ((host (car parsed))
|
|
|
7332 (user (nth 1 parsed))
|
|
|
7333 (host-type (efs-host-type host user))
|
|
|
7334 (temp (car (efs-make-tmp-name nil host)))
|
|
|
7335 (type (efs-xfer-type nil nil host-type filename))
|
|
|
7336 (abbr (and (or (stringp visit) (eq t visit) (null visit))
|
|
|
7337 (efs-relativize-filename
|
|
|
7338 (if (stringp visit) visit filename))))
|
|
|
7339 (buffer (current-buffer))
|
|
|
7340 (b-file-name buffer-file-name)
|
|
|
7341 (mod-p (buffer-modified-p)))
|
|
|
7342 (unwind-protect
|
|
|
7343 (progn
|
|
|
7344 (condition-case err
|
|
|
7345 (progn
|
|
|
7346 (unwind-protect
|
|
|
7347 (let ((executing-macro t))
|
|
|
7348 ;; let-bind executing-macro to inhibit messaging.
|
|
|
7349 ;; Setting VISIT to 'quiet is more elegant.
|
|
|
7350 ;; But in Emacs 18, doing it this way allows
|
|
|
7351 ;; us to modify the visited file modtime, so
|
|
|
7352 ;; that undo's show the buffer modified.
|
|
|
7353 (apply 'write-region start end
|
|
|
7354 temp nil visit args))
|
|
|
7355 ;; buffer-modified-p is now correctly set
|
|
|
7356 (setq buffer-file-name b-file-name)
|
|
|
7357 ;; File modtime is bogus, so clear.
|
|
|
7358 (clear-visited-file-modtime))
|
|
|
7359 (efs-copy-file-internal
|
|
|
7360 temp nil filename parsed (if append 'append t)
|
|
|
7361 nil (and abbr (format "Writing %s" abbr))
|
|
|
7362 ;; cont
|
|
|
7363 (efs-cont (result line cont-lines) (filename buffer
|
|
|
7364 visit)
|
|
|
7365 (if result
|
|
|
7366 (signal 'ftp-error
|
|
|
7367 (list "Opening output file"
|
|
|
7368 (format "FTP Error: \"%s\"" line)
|
|
|
7369 filename)))
|
|
|
7370 ;; The new file entry will be added by
|
|
|
7371 ;; efs-copy-file-internal.
|
|
|
7372 (cond
|
|
|
7373 ((eq visit t)
|
|
|
7374 ;; This will run asynch.
|
|
|
7375 (efs-save-buffer-excursion
|
|
|
7376 (set-buffer buffer)
|
|
|
7377 (efs-set-buffer-file-name filename)
|
|
|
7378 (efs-set-visited-file-modtime)))
|
|
|
7379 ((stringp visit)
|
|
|
7380 (efs-save-buffer-excursion
|
|
|
7381 (set-buffer buffer)
|
|
|
7382 (efs-set-buffer-file-name visit)
|
|
|
7383 (set-visited-file-modtime)))))
|
|
|
7384 nil type))
|
|
|
7385 (error
|
|
|
7386 ;; restore buffer-modified-p
|
|
|
7387 (let (file-name-handler-alist)
|
|
|
7388 (set-buffer-modified-p mod-p))
|
|
|
7389 (signal (car err) (cdr err))))
|
|
|
7390 (if (or (eq visit t)
|
|
|
7391 (and (stringp visit)
|
|
|
7392 (efs-ftp-path visit)))
|
|
|
7393 (efs-set-buffer-mode)))
|
|
|
7394 (efs-del-tmp-name temp))
|
|
|
7395 (and abbr (efs-message "Wrote %s" abbr)))
|
|
|
7396 (if (and (stringp visit) (efs-ftp-path visit))
|
|
|
7397 (progn
|
|
|
7398 (apply 'write-region start end filename append visit args)
|
|
|
7399 (efs-set-buffer-file-name visit)
|
|
|
7400 (efs-set-visited-file-modtime)
|
|
|
7401 (efs-set-buffer-mode))
|
|
|
7402 (error "efs-write-region called for a local file")))))
|
|
|
7403
|
|
|
7404 (defun efs-insert-file-contents (filename &optional visit &rest args)
|
|
|
7405 ;; Inserts file contents for remote files.
|
|
|
7406 ;; The additional ARGS covers V19 BEG and END. Should also handle the
|
|
|
7407 ;; CODING-SYSTEM arg for mule. Hope the two don't trip over each other.
|
|
|
7408 (barf-if-buffer-read-only)
|
|
|
7409 (unwind-protect
|
|
|
7410 (let* ((filename (expand-file-name filename))
|
|
|
7411 (parsed (efs-ftp-path filename))
|
|
|
7412 (host (car parsed))
|
|
|
7413 (host-type (efs-host-type host))
|
|
|
7414 (user (nth 1 parsed))
|
|
|
7415 (path (nth 2 parsed))
|
|
|
7416 (buffer (current-buffer)))
|
|
|
7417
|
|
|
7418 (if (or (file-exists-p filename)
|
|
|
7419 (let* ((res (and
|
|
|
7420 (not (efs-get-host-property host 'rnfr-failed))
|
|
|
7421 (efs-send-cmd
|
|
|
7422 host user (list 'quote 'rnfr path))))
|
|
|
7423 (line (nth 1 res)))
|
|
|
7424 ;; RNFR returns a 550 if the file doesn't exist.
|
|
|
7425 (if (and line (>= (length line) 4)
|
|
|
7426 (string-equal "550 " (substring line 0 4)))
|
|
|
7427 nil
|
|
|
7428 (if (car res) (efs-set-host-property host 'rnfr-failed t))
|
|
|
7429 (efs-del-from-ls-cache filename t nil)
|
|
|
7430 (efs-del-hash-entry
|
|
|
7431 (efs-canonize-file-name (file-name-directory filename))
|
|
|
7432 efs-files-hashtable)
|
|
|
7433 (file-exists-p filename))))
|
|
|
7434
|
|
|
7435 (let ((temp (concat
|
|
|
7436 (car (efs-make-tmp-name nil host))
|
|
|
7437 (efs-internal-file-name-extension filename)))
|
|
|
7438 (type (efs-xfer-type host-type filename nil nil))
|
|
|
7439 (abbr (efs-relativize-filename filename))
|
|
|
7440 (i-f-c-size 0))
|
|
|
7441
|
|
|
7442 (unwind-protect
|
|
|
7443 (efs-copy-file-internal
|
|
|
7444 filename parsed temp nil t nil
|
|
|
7445 (format "Retrieving %s" abbr)
|
|
|
7446 (efs-cont (result line cont-lines) (filename visit buffer
|
|
|
7447 host-type
|
|
|
7448 temp args)
|
|
|
7449 (if result
|
|
|
7450 (signal 'ftp-error
|
|
|
7451 (list "Opening input file"
|
|
|
7452 (format "FTP Error: \"%s\""
|
|
|
7453 line)
|
|
|
7454 filename))
|
|
|
7455 (if (eq host-type 'coke)
|
|
|
7456 (efs-coke-insert-beverage-contents buffer filename
|
|
|
7457 line)
|
|
|
7458 (efs-save-buffer-excursion
|
|
|
7459 (set-buffer buffer)
|
|
|
7460 (if (or (file-readable-p temp)
|
|
|
7461 (sleep-for efs-retry-time)
|
|
|
7462 ;; Wait for file to hopefully appear.
|
|
|
7463 (file-readable-p temp))
|
|
|
7464
|
|
|
7465 (setq i-f-c-size
|
|
|
7466 (nth 1 (apply 'insert-file-contents
|
|
|
7467 temp visit args)))
|
|
|
7468 (signal 'ftp-error
|
|
|
7469 (list
|
|
|
7470 "Opening input file:"
|
|
|
7471 (format
|
|
|
7472 "FTP Error: %s not arrived or readable"
|
|
|
7473 filename))))
|
|
|
7474 ;; This is done asynch
|
|
|
7475 (if visit
|
|
|
7476 (let ((buffer-file-name filename))
|
|
|
7477 (efs-set-visited-file-modtime)))))))
|
|
|
7478 nil type)
|
|
|
7479 (efs-del-tmp-name temp))
|
|
|
7480 ;; Return (FILENAME SIZE)
|
|
|
7481 (list filename i-f-c-size))
|
|
|
7482 (signal 'file-error (list "Opening input file" filename))))
|
|
|
7483 ;; Set buffer-file-name at the very last, so if anything bombs, we're
|
|
|
7484 ;; not visiting.
|
|
|
7485 (if visit
|
|
|
7486 (efs-set-buffer-file-name filename))))
|
|
|
7487
|
|
|
7488 (defun efs-revert-buffer (arg noconfirm)
|
|
|
7489 "Revert this buffer from a remote file using ftp."
|
|
|
7490 (let ((opoint (point)))
|
|
|
7491 (cond ((null buffer-file-name)
|
|
|
7492 (error "Buffer does not seem to be associated with any file"))
|
|
|
7493 ((or noconfirm
|
|
|
7494 (yes-or-no-p (format "Revert buffer from file %s? "
|
|
|
7495 buffer-file-name)))
|
|
|
7496 (let ((buffer-read-only nil))
|
|
|
7497 ;; Set buffer-file-name to nil
|
|
|
7498 ;; so that we don't try to lock the file.
|
|
|
7499 (let ((buffer-file-name nil))
|
|
|
7500 (unlock-buffer)
|
|
|
7501 (erase-buffer))
|
|
|
7502 (insert-file-contents buffer-file-name t))
|
|
|
7503 (goto-char (min opoint (point-max)))
|
|
|
7504 (after-find-file nil)
|
|
|
7505 t))))
|
|
|
7506
|
|
|
7507 (defun efs-recover-file (file)
|
|
|
7508 ;; Version of recover file for remote files, and remote autosave files too.
|
|
|
7509 (if (auto-save-file-name-p file) (error "%s is an auto-save file" file))
|
|
|
7510 (let* ((file-name (let ((buffer-file-name file)) (make-auto-save-file-name)))
|
|
|
7511 (file-name-parsed (efs-ftp-path file-name))
|
|
|
7512 (file-parsed (efs-ftp-path file))
|
|
|
7513 (efs-ls-uncache t))
|
|
|
7514 (cond ((not (file-newer-than-file-p file-name file))
|
|
|
7515 (error "Auto-save file %s not current" file-name))
|
|
|
7516 ((save-window-excursion
|
|
|
7517 (or (eq system-type 'vax-vms)
|
|
|
7518 (progn
|
|
|
7519 (with-output-to-temp-buffer "*Directory*"
|
|
|
7520 (buffer-disable-undo standard-output)
|
|
|
7521 (if file-parsed
|
|
|
7522 (progn
|
|
|
7523 (princ (format "On the host %s:\n"
|
|
|
7524 (car file-parsed)))
|
|
|
7525 (princ
|
|
|
7526 (let ((default-directory exec-directory))
|
|
|
7527 (efs-ls file (if (file-symlink-p file)
|
|
|
7528 "-lL" "-l")
|
|
|
7529 t t))))
|
|
|
7530 (princ "On the local host:\n")
|
|
|
7531 (let ((default-directory exec-directory))
|
|
|
7532 (call-process "ls" nil standard-output nil
|
|
|
7533 (if (file-symlink-p file) "-lL" "-l")
|
|
|
7534 file)))
|
|
|
7535 (princ "\nAUTO SAVE FILE on the ")
|
|
|
7536 (if file-name-parsed
|
|
|
7537 (progn
|
|
|
7538 (princ (format "host %s:\n"
|
|
|
7539 (car file-name-parsed)))
|
|
|
7540 (princ
|
|
|
7541 (efs-ls file-name
|
|
|
7542 (if (file-symlink-p file-name) "-lL" "-l")
|
|
|
7543 t t)))
|
|
|
7544 (princ "local host:\n")
|
|
|
7545 (let ((default-directory exec-directory))
|
|
|
7546 (call-process "ls" nil standard-output nil
|
|
|
7547 "-l" file-name)))
|
|
|
7548 (princ "\nFile modification times are given in ")
|
|
|
7549 (princ "the local time of each host.\n"))
|
|
|
7550 (save-excursion
|
|
|
7551 (set-buffer "*Directory*")
|
|
|
7552 (goto-char (point-min))
|
|
|
7553 (while (not (eobp))
|
|
|
7554 (end-of-line)
|
|
|
7555 (if (> (current-column) (window-width))
|
|
|
7556 (progn
|
|
|
7557 (skip-chars-backward " \t")
|
|
|
7558 (skip-chars-backward "^ \t\n")
|
|
|
7559 (if (> (current-column) 12)
|
|
|
7560 (progn
|
|
|
7561 (delete-horizontal-space)
|
|
|
7562 (insert "\n ")))))
|
|
|
7563 (forward-line 1))
|
|
|
7564 (set-buffer-modified-p nil)
|
|
|
7565 (goto-char (point-min)))))
|
|
|
7566 (yes-or-no-p (format "Recover using this auto save file? ")))
|
|
|
7567 (switch-to-buffer (find-file-noselect file t))
|
|
|
7568 (let ((buffer-read-only nil))
|
|
|
7569 (erase-buffer)
|
|
|
7570 (insert-file-contents file-name nil))
|
|
|
7571 (after-find-file nil))
|
|
|
7572 (t (error "Recover-file cancelled."))))
|
|
|
7573 ;; This is no longer done in V19. However, I like the caution for
|
|
|
7574 ;; remote files, where file-newer-than-file-p may lie.
|
|
|
7575 (setq buffer-auto-save-file-name nil)
|
|
|
7576 (message "Auto-save off in this buffer till you do M-x auto-save-mode."))
|
|
|
7577
|
|
|
7578 ;;;; ------------------------------------------------------------------
|
|
|
7579 ;;;; Attributes of files.
|
|
|
7580 ;;;; ------------------------------------------------------------------
|
|
|
7581
|
|
|
7582 (defun efs-file-symlink-p (file)
|
|
|
7583 ;; Version of file-symlink-p for remote files.
|
|
|
7584 ;; Call efs-expand-file-name rather than the normal
|
|
|
7585 ;; expand-file-name to stop loops when using a package that
|
|
|
7586 ;; redefines both file-symlink-p and expand-file-name.
|
|
|
7587 ;; Do not use efs-get-file-entry, because a child-lookup won't do.
|
|
|
7588 (let* ((file (efs-expand-file-name file))
|
|
|
7589 (ignore-case (memq (efs-host-type (car (efs-ftp-path file)))
|
|
|
7590 efs-case-insensitive-host-types))
|
|
|
7591 (file-type (car (efs-get-hash-entry
|
|
|
7592 (efs-get-file-part file)
|
|
|
7593 (efs-get-files (file-name-directory file))
|
|
|
7594 ignore-case))))
|
|
|
7595 (and (stringp file-type)
|
|
|
7596 (if (file-name-absolute-p file-type)
|
|
|
7597 (efs-replace-path-component file file-type)
|
|
|
7598 file-type))))
|
|
|
7599
|
|
|
7600 (defun efs-file-exists-p (path)
|
|
|
7601 ;; file-exists-p for remote file. Uses the cache if possible.
|
|
|
7602 (let* ((path (expand-file-name path))
|
|
|
7603 (parsed (efs-ftp-path path)))
|
|
|
7604 (efs-internal-file-exists-p (efs-host-type (car parsed) (nth 1 parsed))
|
|
|
7605 path)))
|
|
|
7606
|
|
|
7607 (efs-defun efs-internal-file-exists-p nil (path)
|
|
|
7608 (and (efs-get-file-entry path) t))
|
|
|
7609
|
|
|
7610 (defun efs-file-directory-p (file)
|
|
|
7611 (let* ((file (expand-file-name file))
|
|
|
7612 (parsed (efs-ftp-path file)))
|
|
|
7613 (efs-internal-file-directory-p (efs-host-type (car parsed) (nth 1 parsed))
|
|
|
7614 file)))
|
|
|
7615
|
|
|
7616 (efs-defun efs-internal-file-directory-p nil (path)
|
|
|
7617 ;; Version of file-directory-p for remote files.
|
|
|
7618 (let ((parsed (efs-ftp-path path)))
|
|
|
7619 (or (string-equal (nth 2 parsed) "/") ; root is always a directory
|
|
|
7620 (let ((file-ent (car (efs-get-file-entry
|
|
|
7621 (efs-internal-file-name-as-directory
|
|
|
7622 (efs-host-type (car parsed) (nth 1 parsed))
|
|
|
7623 path)))))
|
|
|
7624 ;; We do a file-name-as-directory on path here because some
|
|
|
7625 ;; machines (VMS) use a .DIR to indicate the filename associated
|
|
|
7626 ;; with a directory. This needs to be canonicalized.
|
|
|
7627 (if (stringp file-ent)
|
|
|
7628 (efs-internal-file-directory-p
|
|
|
7629 nil
|
|
|
7630 (efs-chase-symlinks
|
|
|
7631 ;; efs-internal-directory-file-name
|
|
|
7632 ;; only loses for paths where the remote file
|
|
|
7633 ;; is /. This has been eliminated.
|
|
|
7634 (efs-internal-directory-file-name path)))
|
|
|
7635 file-ent)))))
|
|
|
7636
|
|
|
7637 (defun efs-file-attributes (file)
|
|
|
7638 ;; Returns file-file-attributes for a remote file.
|
|
|
7639 ;; For the file modtime does not return efs's cached value, as that
|
|
|
7640 ;; corresponds to buffer-file-modtime (i.e. the modtime of the file
|
|
|
7641 ;; the last time the buffer was vsisted or saved). Caching modtimes
|
|
|
7642 ;; does not make much sense, as they are usually used to determine
|
|
|
7643 ;; if a cache is stale. The modtime if a remote file can be obtained with
|
|
|
7644 ;; efs-get-file-mdtm. This is _not_ returned for the 5th entry here,
|
|
|
7645 ;; because it requires an FTP transaction, and a priori we don't know
|
|
|
7646 ;; if the caller actually cares about this info. Having file-attributes
|
|
|
7647 ;; return such a long list of info is not well suited to remote files,
|
|
|
7648 ;; as some of this info may be costly to obtain.
|
|
|
7649 (let* ((file (expand-file-name file))
|
|
|
7650 (ent (efs-get-file-entry file)))
|
|
|
7651 (if ent
|
|
|
7652 (let* ((parsed (efs-ftp-path file))
|
|
|
7653 (host (nth 0 parsed))
|
|
|
7654 (user (nth 1 parsed))
|
|
|
7655 (path (nth 2 parsed))
|
|
|
7656 (type (car ent))
|
|
|
7657 (size (or (nth 1 ent) -1))
|
|
|
7658 (owner (nth 2 ent))
|
|
|
7659 (modes (nth 3 ent))
|
|
|
7660 ;; Hack to give remote files a "unique" "inode number".
|
|
|
7661 ;; It's actually the sum of the characters in its name.
|
|
|
7662 ;; It's not even really unique.
|
|
|
7663 (inode (apply '+
|
|
|
7664 (nconc (mapcar 'identity host)
|
|
|
7665 (mapcar 'identity user)
|
|
|
7666 (mapcar 'identity
|
|
|
7667 (efs-internal-directory-file-name
|
|
|
7668 path)))))
|
|
|
7669 (nlinks (or (nth 4 ent) -1))) ; return -1 if we don't know
|
|
|
7670 (list
|
|
|
7671 (if (and (stringp type) (file-name-absolute-p type))
|
|
|
7672 (efs-replace-path-component file type)
|
|
|
7673 type) ;0 file type
|
|
|
7674 nlinks ;1 link count
|
|
|
7675 (if owner ;2 uid
|
|
|
7676 ;; Not really a unique integer,
|
|
|
7677 ;; just a half-hearted attempt
|
|
|
7678 (apply '+ (mapcar 'identity owner))
|
|
|
7679 -1)
|
|
|
7680 -1 ;3 gid
|
|
|
7681 '(0 0) ;4 atime
|
|
|
7682 '(0 0) ;5 mtime
|
|
|
7683 '(0 0) ;6 ctime
|
|
|
7684 size ;7 size
|
|
|
7685 (or modes ;8 mode
|
|
|
7686 (concat
|
|
|
7687 (cond ((stringp type) "l")
|
|
|
7688 (type "d")
|
|
|
7689 (t "-"))
|
|
|
7690 "?????????"))
|
|
|
7691 nil ;9 gid weird (Who knows if the gid
|
|
|
7692 ; would be changed?)
|
|
|
7693 inode ;10 inode
|
|
|
7694 -1 ;11 device number [v19 only]
|
|
|
7695 )))))
|
|
|
7696
|
|
|
7697 (defun efs-file-writable-p (file)
|
|
|
7698 ;; file-writable-p for remote files.
|
|
|
7699 ;; Does not attempt to open the file, but just looks at the cached file
|
|
|
7700 ;; modes.
|
|
|
7701 (let* ((file (expand-file-name file))
|
|
|
7702 (ent (efs-get-file-entry file)))
|
|
|
7703 (if (and ent (or (not (stringp (car ent)))
|
|
|
7704 (setq file (efs-chase-symlinks file)
|
|
|
7705 ent (efs-get-file-entry file))))
|
|
|
7706 (let* ((owner (nth 2 ent))
|
|
|
7707 (modes (nth 3 ent))
|
|
|
7708 (parsed (efs-ftp-path file))
|
|
|
7709 (host-type (efs-host-type (car parsed)))
|
|
|
7710 (user (nth 1 parsed)))
|
|
|
7711 (if (memq host-type efs-unix-host-types)
|
|
|
7712 (setq host-type 'unix))
|
|
|
7713 (efs-internal-file-writable-p host-type user owner modes))
|
|
|
7714 (let ((dir (file-name-directory file)))
|
|
|
7715 (and
|
|
|
7716 (not (string-equal dir file))
|
|
|
7717 (file-directory-p dir)
|
|
|
7718 (file-writable-p dir))))))
|
|
|
7719
|
|
|
7720 (efs-defun efs-internal-file-writable-p nil (user owner modes)
|
|
|
7721 ;; By default, we'll just guess yes.
|
|
|
7722 t)
|
|
|
7723
|
|
|
7724 (efs-defun efs-internal-file-writable-p unix (user owner modes)
|
|
|
7725 (if (and modes
|
|
|
7726 (not (string-equal user "root")))
|
|
|
7727 (null
|
|
|
7728 (null
|
|
|
7729 (if (string-equal user owner)
|
|
|
7730 (memq ?w (list (aref modes 2) (aref modes 5)
|
|
|
7731 (aref modes 8)))
|
|
|
7732 (memq ?w (list (aref modes 5) (aref modes 8))))))
|
|
|
7733 t)) ; guess
|
|
|
7734
|
|
|
7735 (defun efs-file-readable-p (file)
|
|
|
7736 ;; Version of file-readable-p that works for remote files.
|
|
|
7737 ;; Works by checking efs's cache of the file modes.
|
|
|
7738 (let* ((file (expand-file-name file))
|
|
|
7739 (ent (efs-get-file-entry file)))
|
|
|
7740 (and ent
|
|
|
7741 (or (not (stringp (car ent)))
|
|
|
7742 (setq ent (efs-get-file-entry (efs-chase-symlinks file))))
|
|
|
7743 ;; file exists
|
|
|
7744 (let* ((parsed (efs-ftp-path file))
|
|
|
7745 (owner (nth 2 ent))
|
|
|
7746 (modes (nth 3 ent))
|
|
|
7747 (host-type (efs-host-type (car parsed)))
|
|
|
7748 (user (nth 1 parsed)))
|
|
|
7749 (if (memq host-type efs-unix-host-types)
|
|
|
7750 (setq host-type 'unix))
|
|
|
7751 (efs-internal-file-readable-p host-type user owner modes)))))
|
|
|
7752
|
|
|
7753 (efs-defun efs-internal-file-readable-p nil (user owner modes)
|
|
|
7754 ;; Guess t by default
|
|
|
7755 t)
|
|
|
7756
|
|
|
7757 (efs-defun efs-internal-file-readable-p unix (user owner modes)
|
|
|
7758 (if (and modes
|
|
|
7759 (not (string-equal user "root")))
|
|
|
7760 (null
|
|
|
7761 (null
|
|
|
7762 (if (string-equal user owner)
|
|
|
7763 (memq ?r (list (aref modes 1) (aref modes 4)
|
|
|
7764 (aref modes 7)))
|
|
|
7765 (memq ?r (list (aref modes 4) (aref modes 7))))))
|
|
|
7766 t)) ; guess
|
|
|
7767
|
|
|
7768 (defun efs-file-executable-p (file)
|
|
|
7769 ;; Version of file-executable-p for remote files.
|
|
|
7770 (let ((ent (efs-get-file-entry file)))
|
|
|
7771 (and ent
|
|
|
7772 (or (not (stringp (car ent)))
|
|
|
7773 (setq ent (efs-get-file-entry (efs-chase-symlinks file))))
|
|
|
7774 ;; file exists
|
|
|
7775 (let* ((parsed (efs-ftp-path file))
|
|
|
7776 (owner (nth 2 ent))
|
|
|
7777 (modes (nth 3 ent))
|
|
|
7778 (host-type (efs-host-type (car parsed)))
|
|
|
7779 (user (nth 1 parsed)))
|
|
|
7780 (if (memq host-type efs-unix-host-types)
|
|
|
7781 (setq host-type 'unix))
|
|
|
7782 (efs-internal-file-executable-p host-type user owner modes)))))
|
|
|
7783
|
|
|
7784 (efs-defun efs-internal-file-executable-p nil (user owner modes)
|
|
|
7785 ;; Guess t by default
|
|
|
7786 t)
|
|
|
7787
|
|
|
7788 (efs-defun efs-internal-file-executable-p unix (user owner modes)
|
|
|
7789 (if (and modes
|
|
|
7790 (not (string-equal user "root")))
|
|
|
7791 (null
|
|
|
7792 (null
|
|
|
7793 (if (string-equal user owner)
|
|
|
7794 (memq ?x (list (aref modes 3) (aref modes 6)
|
|
|
7795 (aref modes 9)))
|
|
|
7796 (memq ?x (list (aref modes 6) (aref modes 9))))))
|
|
|
7797 t)) ; guess
|
|
|
7798
|
|
|
7799 (defun efs-file-accessible-directory-p (dir)
|
|
|
7800 ;; Version of file-accessible-directory-p for remote directories.
|
|
|
7801 (let ((file (directory-file-name dir)))
|
|
|
7802 (and (efs-file-directory-p file) (efs-file-executable-p file))))
|
|
|
7803
|
|
|
7804 ;;;; --------------------------------------------------------------
|
|
|
7805 ;;;; Listing directories.
|
|
|
7806 ;;;; --------------------------------------------------------------
|
|
|
7807
|
|
|
7808 (defun efs-shell-regexp-to-regexp (regexp)
|
|
|
7809 ;; Converts a shell regexp to an emacs regexp.
|
|
|
7810 ;; Probably full of bugs. Tries to follow csh globbing.
|
|
|
7811 (let ((curly 0)
|
|
|
7812 backslash)
|
|
|
7813 (concat "^"
|
|
|
7814 (mapconcat
|
|
|
7815 (function
|
|
|
7816 (lambda (char)
|
|
|
7817 (cond
|
|
|
7818 (backslash
|
|
|
7819 (setq backslash nil)
|
|
|
7820 (regexp-quote (char-to-string char)))
|
|
|
7821 ((and (> curly 0) (eq char ?,))
|
|
|
7822 "\\|")
|
|
|
7823 ((memq char '(?[ ?]))
|
|
|
7824 (char-to-string char))
|
|
|
7825 ((eq char ??)
|
|
|
7826 ".")
|
|
|
7827 ((eq char ?\\)
|
|
|
7828 (setq backslash t)
|
|
|
7829 "")
|
|
|
7830 ((eq char ?*)
|
|
|
7831 ".*")
|
|
|
7832 ((eq char ?{)
|
|
|
7833 (setq curly (1+ curly))
|
|
|
7834 "\\(")
|
|
|
7835 ((and (eq char ?}) (> curly 0))
|
|
|
7836 (setq curly (1- curly))
|
|
|
7837 "\\)")
|
|
|
7838 (t (regexp-quote (char-to-string char))))))
|
|
|
7839 regexp nil)
|
|
|
7840 "$")))
|
|
|
7841
|
|
|
7842
|
|
|
7843 ;;; Getting directory listings.
|
|
|
7844
|
|
116
|
7845 (defun efs-directory-files (directory &optional full match nosort &rest ignored-for-now)
|
|
98
|
7846 ;; Returns directory-files for remote directories.
|
|
|
7847 ;; NOSORT is a V19 arg.
|
|
|
7848 (let* ((directory (expand-file-name directory))
|
|
|
7849 (parsed (efs-ftp-path directory))
|
|
|
7850 (directory (efs-internal-file-name-as-directory
|
|
|
7851 (efs-host-type (car parsed) (nth 1 parsed)) directory))
|
|
|
7852 files)
|
|
|
7853 (efs-barf-if-not-directory directory)
|
|
|
7854 (setq files (efs-hash-table-keys (efs-get-files directory) nosort))
|
|
|
7855 (cond
|
|
|
7856 ((null (or full match))
|
|
|
7857 files)
|
|
|
7858 (match ; this is slow case
|
|
|
7859 (let (res f)
|
|
|
7860 (efs-save-match-data
|
|
|
7861 (while files
|
|
|
7862 (setq f (if full (concat directory (car files)) (car files))
|
|
|
7863 files (cdr files))
|
|
|
7864 (if (string-match match f)
|
|
|
7865 (setq res (nconc res (list f))))))
|
|
|
7866 res))
|
|
|
7867 (full
|
|
|
7868 (mapcar (function
|
|
|
7869 (lambda (fn)
|
|
|
7870 (concat directory fn)))
|
|
|
7871 files)))))
|
|
|
7872
|
|
|
7873 (defun efs-list-directory (dirname &optional verbose)
|
|
|
7874 ;; Version of list-directory for remote directories.
|
|
|
7875 ;; If verbose is nil, it gets its information from efs's
|
|
|
7876 ;; internal cache.
|
|
|
7877 (let* ((dirname (expand-file-name (or dirname default-directory)))
|
|
|
7878 header)
|
|
|
7879 (if (file-directory-p dirname)
|
|
|
7880 (setq dirname (file-name-as-directory dirname)))
|
|
|
7881 (setq header dirname)
|
|
|
7882 (with-output-to-temp-buffer "*Directory*"
|
|
|
7883 (buffer-disable-undo standard-output)
|
|
|
7884 (princ "Directory ")
|
|
|
7885 (princ header)
|
|
|
7886 (terpri)
|
|
|
7887 (princ
|
|
|
7888 (efs-ls dirname (if verbose
|
|
|
7889 list-directory-verbose-switches
|
|
|
7890 list-directory-brief-switches)
|
|
|
7891 t)))))
|
|
|
7892
|
|
|
7893 ;;;; -------------------------------------------------------------------
|
|
|
7894 ;;;; Manipulating buffers.
|
|
|
7895 ;;;; -------------------------------------------------------------------
|
|
|
7896
|
|
|
7897 (defun efs-get-file-buffer (file)
|
|
|
7898 ;; Version of get-file-buffer for remote files. Needs to fuss over things
|
|
|
7899 ;; like OS's which are case-insens. for file names.
|
|
|
7900 (let ((file (efs-canonize-file-name (expand-file-name file)))
|
|
|
7901 (buff-list (buffer-list))
|
|
|
7902 buff-name)
|
|
|
7903 (catch 'match
|
|
|
7904 (while buff-list
|
|
|
7905 (and (setq buff-name (buffer-file-name (car buff-list)))
|
|
|
7906 (= (length buff-name) (length file)) ; efficiency hack
|
|
|
7907 (string-equal (efs-canonize-file-name buff-name) file)
|
|
|
7908 (throw 'match (car buff-list)))
|
|
|
7909 (setq buff-list (cdr buff-list))))))
|
|
|
7910
|
|
|
7911 (defun efs-create-file-buffer (filename)
|
|
|
7912 ;; Version of create-file-buffer for remote file names.
|
|
|
7913 (let* ((parsed (efs-ftp-path (expand-file-name filename)))
|
|
|
7914 (file (nth 2 parsed))
|
|
|
7915 (host (car parsed))
|
|
|
7916 (host-type (efs-host-type host))
|
|
|
7917 (buff (cond
|
|
|
7918 ((null efs-fancy-buffer-names)
|
|
|
7919 (if (string-equal file "/")
|
|
|
7920 "/"
|
|
|
7921 (efs-internal-file-name-nondirectory
|
|
|
7922 (efs-internal-directory-file-name file))))
|
|
|
7923 ((stringp efs-fancy-buffer-names)
|
|
|
7924 (format efs-fancy-buffer-names
|
|
|
7925 (if (string-equal file "/")
|
|
|
7926 "/"
|
|
|
7927 (efs-internal-file-name-nondirectory
|
|
|
7928 (efs-internal-directory-file-name file)))
|
|
|
7929 (substring host 0 (string-match "\\." host 1))))
|
|
|
7930 (t ; efs-fancy-buffer-names had better be a function
|
|
|
7931 (funcall efs-fancy-buffer-names host
|
|
|
7932 (nth 1 parsed) file)))))
|
|
|
7933 (if (memq host-type efs-case-insensitive-host-types)
|
|
|
7934 (cond ((eq efs-buffer-name-case 'down)
|
|
|
7935 (setq buff (downcase buff)))
|
|
|
7936 ((eq efs-buffer-name-case 'up)
|
|
|
7937 (setq buff (upcase buff)))))
|
|
|
7938 (get-buffer-create (generate-new-buffer-name buff))))
|
|
|
7939
|
|
|
7940 (defun efs-set-buffer-mode ()
|
|
|
7941 "Set correct modes for the current buffer if it is visiting a remote file."
|
|
|
7942 (if (and (stringp buffer-file-name)
|
|
|
7943 (efs-ftp-path buffer-file-name))
|
|
|
7944 (progn
|
|
|
7945 (auto-save-mode efs-auto-save)
|
|
|
7946 (set (make-local-variable 'revert-buffer-function)
|
|
|
7947 'efs-revert-buffer)
|
|
|
7948 (set (make-local-variable 'default-directory-function)
|
|
|
7949 'efs-default-dir-function))))
|
|
|
7950
|
|
|
7951 ;;;; ---------------------------------------------------------
|
|
|
7952 ;;;; Functions for doing backups.
|
|
|
7953 ;;;; ---------------------------------------------------------
|
|
|
7954
|
|
|
7955 (defun efs-backup-buffer ()
|
|
|
7956 ;; Version of backup-buffer for buffers visiting remote files.
|
|
|
7957 (if efs-make-backup-files
|
|
|
7958 (let* ((parsed (efs-ftp-path buffer-file-name))
|
|
|
7959 (host (car parsed))
|
|
|
7960 (host-type (efs-host-type (car parsed))))
|
|
|
7961 (if (or (not (listp efs-make-backup-files))
|
|
|
7962 (memq host-type efs-make-backup-files))
|
|
|
7963 (efs-internal-backup-buffer
|
|
|
7964 host host-type (nth 1 parsed) (nth 2 parsed))))))
|
|
|
7965
|
|
|
7966 (defun efs-internal-backup-buffer (host host-type user remote-path)
|
|
|
7967 ;; This is almost a copy of the function in files.el, modified
|
|
|
7968 ;; to check to see if the backup file exists, before deleting it.
|
|
|
7969 ;; It also supports efs-backup-by-copying, and tries to do the
|
|
|
7970 ;; right thing about backup-by-copying-when-mismatch. Only called
|
|
|
7971 ;; for remote files.
|
|
|
7972 ;; Set the umask now, so that `setmodes' knows about it.
|
|
|
7973 (efs-set-umask host user)
|
|
|
7974 (let ((ent (efs-get-file-entry (expand-file-name buffer-file-name)))
|
|
|
7975 ;; Never do version-control if the remote operating system is doing it.
|
|
|
7976 (version-control (if (memq host-type efs-version-host-types)
|
|
|
7977 'never
|
|
|
7978 version-control))
|
|
|
7979 modstring)
|
|
|
7980 (and make-backup-files
|
|
|
7981 (not buffer-backed-up)
|
|
|
7982 ent ; i.e. file-exists-p
|
|
|
7983 (not (eq t (car ent)))
|
|
|
7984 (or (null (setq modstring (nth 3 ent)))
|
|
|
7985 (not (memq host-type efs-unix-host-types))
|
|
|
7986 (memq (aref modstring 0) '(?- ?l)))
|
|
|
7987 (or (< (length remote-path) 5)
|
|
|
7988 (not (string-equal "/tmp/" (substring remote-path 0 5))))
|
|
|
7989 (condition-case ()
|
|
|
7990 (let* ((backup-info (find-backup-file-name buffer-file-name))
|
|
|
7991 (backupname (car backup-info))
|
|
|
7992 (targets (cdr backup-info))
|
|
|
7993 (links (nth 4 ent))
|
|
|
7994 setmodes)
|
|
|
7995 (condition-case ()
|
|
|
7996 (if (or file-precious-flag
|
|
|
7997 (stringp (car ent)) ; symlinkp
|
|
|
7998 efs-backup-by-copying
|
|
|
7999 (and backup-by-copying-when-linked
|
|
|
8000 links (> links 1))
|
|
|
8001 (and backup-by-copying-when-mismatch
|
|
|
8002 (not
|
|
|
8003 (if (memq
|
|
|
8004 host-type
|
|
|
8005 efs-case-insensitive-host-types)
|
|
|
8006 (string-equal
|
|
|
8007 (downcase user) (downcase (nth 2 ent)))
|
|
|
8008 (string-equal user (nth 2 ent))))))
|
|
|
8009 (copy-file buffer-file-name backupname t t)
|
|
|
8010 (condition-case ()
|
|
|
8011 (if (file-exists-p backupname)
|
|
|
8012 (delete-file backupname))
|
|
|
8013 (file-error nil))
|
|
|
8014 (rename-file buffer-file-name backupname t)
|
|
|
8015 (setq setmodes (file-modes backupname)))
|
|
|
8016 (file-error
|
|
|
8017 ;; If trouble writing the backup, write it in ~.
|
|
|
8018 (setq backupname (expand-file-name "~/%backup%~"))
|
|
|
8019 (message
|
|
|
8020 "Cannot write backup file; backing up in ~/%%backup%%~")
|
|
|
8021 (sleep-for 1)
|
|
|
8022 (copy-file buffer-file-name backupname t t)))
|
|
|
8023 (setq buffer-backed-up t)
|
|
|
8024 ;; Starting with 19.26, trim-versions-without-asking
|
|
|
8025 ;; has been renamed to delete-old-verions.
|
|
|
8026 (if (and targets
|
|
|
8027 (or (if (boundp 'trim-versions-without-asking)
|
|
|
8028 trim-versions-without-asking
|
|
|
8029 (and
|
|
|
8030 (boundp 'delete-old-versions)
|
|
|
8031 delete-old-versions))
|
|
|
8032 (y-or-n-p (format
|
|
|
8033 "Delete excess backup versions of %s? "
|
|
|
8034 buffer-file-name))))
|
|
|
8035 (while targets
|
|
|
8036 (condition-case ()
|
|
|
8037 (delete-file (car targets))
|
|
|
8038 (file-error nil))
|
|
|
8039 (setq targets (cdr targets))))
|
|
|
8040 ;; If the file was already written with the right modes,
|
|
|
8041 ;; don't return set-modes.
|
|
|
8042 (and setmodes
|
|
|
8043 (null
|
|
|
8044 (let ((buff (get-buffer
|
|
|
8045 (efs-ftp-process-buffer host user))))
|
|
|
8046 (and buff
|
|
|
8047 (save-excursion
|
|
|
8048 (set-buffer buff)
|
|
|
8049 (and (integerp efs-process-umask)
|
|
|
8050 (= (efs-modes-from-umask efs-process-umask)
|
|
|
8051 setmodes))))))
|
|
|
8052 setmodes))
|
|
|
8053 (file-error nil)))))
|
|
|
8054
|
|
|
8055 ;;;; ------------------------------------------------------------
|
|
|
8056 ;;;; Redefinition for Emacs file mode support
|
|
|
8057 ;;;; ------------------------------------------------------------
|
|
|
8058
|
|
|
8059 (defmacro efs-build-mode-string-element (int suid-p sticky-p)
|
|
|
8060 ;; INT is between 0 and 7.
|
|
|
8061 ;; If SUID-P is non-nil, we are building the 3-char string for either
|
|
|
8062 ;; the owner or group, and the s[ug]id bit is set.
|
|
|
8063 ;; If STICKY-P is non-nil, we are building the string for other perms,
|
|
|
8064 ;; and the sticky bit is set.
|
|
|
8065 ;; It doesn't make sense for both SUID-P and STICKY-P be non-nil!
|
|
|
8066 (` (let* ((int (, int))
|
|
|
8067 (suid-p (, suid-p))
|
|
|
8068 (sticky-p (, sticky-p))
|
|
|
8069 (read-bit (if (memq int '(4 5 6 7)) "r" "-"))
|
|
|
8070 (write-bit (if (memq int '(2 3 6 7)) "w" "-"))
|
|
|
8071 (x-bit (if (memq int '(1 3 5 7))
|
|
|
8072 (cond (suid-p "s") (sticky-p "t") ("x"))
|
|
|
8073 (cond (suid-p "S") (sticky-p "T") ("-")))))
|
|
|
8074 (concat read-bit write-bit x-bit))))
|
|
|
8075
|
|
|
8076 (defun efs-mode-string (int)
|
|
|
8077 ;; Takes an octal integer between 0 and 7777, and returns the 9 character
|
|
|
8078 ;; mode string.
|
|
|
8079 (let* ((other-int (% int 10))
|
|
|
8080 (int (/ int 10))
|
|
|
8081 (group-int (% int 10))
|
|
|
8082 (int (/ int 10))
|
|
|
8083 (owner-int (% int 10))
|
|
|
8084 (int (/ int 10))
|
|
|
8085 (suid (memq int '(4 5 6 7)))
|
|
|
8086 (sgid (memq int '(2 3 6 7)))
|
|
|
8087 (sticky (memq int '(1 3 5 7))))
|
|
|
8088 (concat (efs-build-mode-string-element owner-int suid nil)
|
|
|
8089 (efs-build-mode-string-element group-int sgid nil)
|
|
|
8090 (efs-build-mode-string-element other-int nil sticky))))
|
|
|
8091
|
|
|
8092 (defun efs-set-file-modes (file mode)
|
|
|
8093 ;; set-file-modes for remote files.
|
|
|
8094 ;; For remote files, if mode is nil, does nothing.
|
|
|
8095 ;; This is because efs-file-modes returns nil if the modes
|
|
|
8096 ;; of a remote file couldn't be determined, even if the file exists.
|
|
|
8097 (and mode
|
|
|
8098 (let* ((file (expand-file-name file))
|
|
|
8099 (parsed (efs-ftp-path file))
|
|
|
8100 (host (car parsed))
|
|
|
8101 (user (nth 1 parsed))
|
|
|
8102 (r-file (nth 2 parsed))
|
|
|
8103 ;; convert to octal, and keep only 12 lowest order bits.
|
|
|
8104 (omode (format "%o" (- mode (lsh (lsh mode -12) 12)))))
|
|
|
8105 (if (or (efs-get-host-property host 'chmod-failed)
|
|
|
8106 (null (memq (efs-host-type host user) efs-unix-host-types)))
|
|
|
8107 (message "Unable to set file modes for %s to %s." file omode)
|
|
|
8108 (efs-send-cmd
|
|
|
8109 host user
|
|
|
8110 (list 'quote 'site 'chmod omode r-file)
|
|
|
8111 nil nil
|
|
|
8112 (efs-cont (result line cont-lines) (host file r-file omode)
|
|
|
8113 (if result
|
|
|
8114 (progn
|
|
|
8115 (efs-set-host-property host 'chmod-failed t)
|
|
|
8116 (message "CHMOD %s failed for %s on %s." omode r-file host)
|
|
|
8117 (if efs-ding-on-chmod-failure
|
|
|
8118 (progn (ding) (sit-for 1))))
|
|
|
8119 (let ((ent (efs-get-file-entry file)))
|
|
|
8120 (if ent
|
|
|
8121 (let* ((type
|
|
|
8122 (cond
|
|
|
8123 ((null (car ent)) "-")
|
|
|
8124 ((eq (car ent) t) "d")
|
|
|
8125 ((stringp (car ent)) "s")
|
|
|
8126 (t
|
|
|
8127 (error
|
|
|
8128 "Weird error in efs-set-file-modes"))))
|
|
|
8129 (mode-string (concat
|
|
|
8130 type
|
|
|
8131 (efs-mode-string
|
|
|
8132 (string-to-int omode))))
|
|
|
8133 (tail (nthcdr 3 ent)))
|
|
|
8134 (if (consp tail)
|
|
|
8135 (setcar tail mode-string)
|
|
|
8136 (efs-add-file-entry nil file (car ent) (nth 1 ent)
|
|
|
8137 (nth 2 ent) mode-string)))))))
|
|
|
8138 0)))) ; It should be safe to do this NOWAIT = 0
|
|
|
8139 ;; set-file-modes returns nil
|
|
|
8140 nil)
|
|
|
8141
|
|
|
8142 (defmacro efs-parse-mode-element (modes)
|
|
|
8143 ;; Parses MODES, a string of three chars, and returns an integer
|
|
|
8144 ;; between 0 and 7 according to how unix file modes are represented
|
|
|
8145 ;; for chmod.
|
|
|
8146 (` (if (= (length (, modes)) 3)
|
|
|
8147 (let ((list (mapcar
|
|
|
8148 (function (lambda (char)
|
|
|
8149 (if (memq char '( ?- ?S ?T)) 0 1)))
|
|
|
8150 (, modes))))
|
|
|
8151 ;; Convert to octal
|
|
|
8152 (+ (* (car list) 4) (* (nth 1 list) 2) (nth 2 list)))
|
|
|
8153 (error "Can't parse modes %s" (, modes)))))
|
|
|
8154
|
|
|
8155 (defun efs-parse-mode-string (string)
|
|
|
8156 ;; Parse a 9-character mode string, and return what it represents
|
|
|
8157 ;; as a decimal integer.
|
|
|
8158 (let ((owner (efs-parse-mode-element (substring string 0 3)))
|
|
|
8159 (group (efs-parse-mode-element (substring string 3 6)))
|
|
|
8160 (other (efs-parse-mode-element (substring string 6 9)))
|
|
|
8161 (owner-x (elt string 2))
|
|
|
8162 (group-x (elt string 5))
|
|
|
8163 (other-x (elt string 8)))
|
|
|
8164 (+ (* (+ (if (memq owner-x '(?s ?S)) 4 0)
|
|
|
8165 (if (memq group-x '(?s ?S)) 2 0)
|
|
|
8166 (if (memq other-x '(?t ?T)) 1 0))
|
|
|
8167 512)
|
|
|
8168 (* owner 64)
|
|
|
8169 (* group 8)
|
|
|
8170 other)))
|
|
|
8171
|
|
|
8172 (defun efs-file-modes (file)
|
|
|
8173 ;; Version of file-modes for remote files.
|
|
|
8174 ;; Returns nil if the file modes can't be determined, either because
|
|
|
8175 ;; the file doesn't exist, or for any other reason.
|
|
|
8176 (let* ((file (expand-file-name file))
|
|
|
8177 (parsed (efs-ftp-path file)))
|
|
|
8178 (and (memq (efs-host-type (car parsed)) efs-unix-host-types)
|
|
|
8179 ;; Someday we should cache mode strings for non-unix, but they
|
|
|
8180 ;; won't be in unix format. Also, CHMOD doesn't work for non-unix
|
|
|
8181 ;; hosts, so returning this info to emacs is a waste.
|
|
|
8182 (let* ((ent (efs-get-file-entry file))
|
|
|
8183 (modes (nth 3 ent)))
|
|
|
8184 (and modes
|
|
|
8185 (efs-parse-mode-string (substring modes 1)))))))
|
|
|
8186
|
|
|
8187 ;;;; ------------------------------------------------------------
|
|
|
8188 ;;;; Redefinition of Emacs file modtime support.
|
|
|
8189 ;;;; ------------------------------------------------------------
|
|
|
8190
|
|
|
8191 (defun efs-day-number (year month day)
|
|
|
8192 ;; Returns the day number within year of date. Taken from calendar.el,
|
|
|
8193 ;; by Edward Reingold. Thanks.
|
|
|
8194 ;; An explanation of the calculation can be found in PascAlgorithms by
|
|
|
8195 ;; Edward and Ruth Reingold, Scott-Foresman/Little, Brown, 1988.
|
|
|
8196 (let ((day-of-year (+ day (* 31 (1- month)))))
|
|
|
8197 (if (> month 2)
|
|
|
8198 (progn
|
|
|
8199 (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10)))
|
|
|
8200 (if (zerop (% year 4))
|
|
|
8201 (setq day-of-year (1+ day-of-year)))))
|
|
|
8202 day-of-year))
|
|
|
8203
|
|
|
8204 (defun efs-days-elapsed (year month day)
|
|
|
8205 ;; Number of days elapsed since Jan 1, `efs-time-zero'
|
|
|
8206 (+ (efs-day-number year month day) ; days this year
|
|
|
8207 (* 365 (- year efs-time-zero)) ; days in prior years
|
|
|
8208 (- (/ (max (1- year) efs-time-zero) 4)
|
|
|
8209 (/ efs-time-zero 4)) ; leap years
|
|
|
8210 -1 )) ; don't count today
|
|
|
8211
|
|
|
8212 ;; 2^16 = 65536
|
|
|
8213 ;; Use this to avoid overflows
|
|
|
8214
|
|
|
8215 (defun efs-seconds-elapsed (year month day hours minutes seconds)
|
|
|
8216 ;; Computes the seconds elapsed from `efs-time-zero', in emacs'
|
|
|
8217 ;; format of a list of two integers, the first the higher 16-bits,
|
|
|
8218 ;; the second the lower 16-bits.
|
|
|
8219 (let* ((days (efs-days-elapsed year month day))
|
|
|
8220 ;; compute hours
|
|
|
8221 (hours (+ (* 24 days) hours))
|
|
|
8222 (high (lsh hours -16))
|
|
|
8223 (low (- hours (lsh high 16)))
|
|
|
8224 ;; compute minutes
|
|
|
8225 (low (+ (* low 60) minutes))
|
|
|
8226 (carry (lsh low -16))
|
|
|
8227 (high (+ (* high 60) carry))
|
|
|
8228 (low (- low (lsh carry 16)))
|
|
|
8229 ;; compute seconds
|
|
|
8230 (low (+ (* low 60) seconds))
|
|
|
8231 (carry (lsh low -16))
|
|
|
8232 (high (+ (* high 60) carry))
|
|
|
8233 (low (- low (lsh carry 16))))
|
|
|
8234 (list high low)))
|
|
|
8235
|
|
|
8236 (defun efs-parse-mdtime (string)
|
|
|
8237 ;; Parse a string, which is assumed to be the result of an ftp MDTM command.
|
|
|
8238 (efs-save-match-data
|
|
|
8239 (if (string-match efs-mdtm-msgs string)
|
|
|
8240 (efs-seconds-elapsed
|
|
|
8241 (string-to-int (substring string 4 8))
|
|
|
8242 (string-to-int (substring string 8 10))
|
|
|
8243 (string-to-int (substring string 10 12))
|
|
|
8244 (string-to-int (substring string 12 14))
|
|
|
8245 (string-to-int (substring string 14 16))
|
|
|
8246 (string-to-int (substring string 16 18))))))
|
|
|
8247
|
|
|
8248 (defun efs-parse-ctime (string)
|
|
|
8249 ;; Parse STRING which is assumed to be the result of a query over port 37.
|
|
|
8250 ;; Returns the number of seconds since the turn of the century, as a
|
|
|
8251 ;; list of two 16-bit integers.
|
|
|
8252 (and (= (length string) 4)
|
|
|
8253 (list (+ (lsh (aref string 0) 8) (aref string 1))
|
|
|
8254 (+ (lsh (aref string 2) 8) (aref string 3)))))
|
|
|
8255
|
|
|
8256 (defun efs-time-minus (time1 time2)
|
|
|
8257 ;; Subtract 32-bit integers, represented as two 16-bit integers.
|
|
|
8258 (let ((high (- (car time1) (car time2)))
|
|
|
8259 (low (- (nth 1 time1) (nth 1 time2))))
|
|
|
8260 (cond
|
|
|
8261 ((and (< high 0) (> low 0))
|
|
|
8262 (setq high (1+ high)
|
|
|
8263 low (- low 65536)))
|
|
|
8264 ((and (> high 0) (< low 0))
|
|
|
8265 (setq high (1- high)
|
|
|
8266 low (+ 65536 low))))
|
|
|
8267 (list high low)))
|
|
|
8268
|
|
|
8269 (defun efs-time-greater (time1 time2)
|
|
|
8270 ;; Compare two 32-bit integers, each represented as a list of two 16-bit
|
|
|
8271 ;; integers.
|
|
|
8272 (or (> (car time1) (car time2))
|
|
|
8273 (and (= (car time1) (car time2))
|
|
|
8274 (> (nth 1 time1) (nth 1 time2)))))
|
|
|
8275
|
|
|
8276 (defun efs-century-time (host &optional nowait cont)
|
|
|
8277 ;; Treat nil as the local host.
|
|
|
8278 ;; Returns the # of seconds since the turn of the century, according
|
|
|
8279 ;; to the system clock on host.
|
|
|
8280 ;; CONT is called with first arg HOST and second the # of seconds.
|
|
|
8281 (or host (setq host (system-name)))
|
|
|
8282 (efs-set-host-property host 'last-ctime nil)
|
|
|
8283 (efs-set-host-property host 'ctime-cont cont)
|
|
|
8284 (let ((name (format efs-ctime-process-name-format host))
|
|
|
8285 proc)
|
|
|
8286 (condition-case nil (delete-process name) (error nil))
|
|
|
8287 (if (and
|
|
|
8288 (or (efs-save-match-data (string-match efs-local-host-regexp host))
|
|
|
8289 (string-equal host (system-name)))
|
|
|
8290 (setq proc (condition-case nil
|
|
|
8291 (open-network-stream name nil host 37)
|
|
|
8292 (error nil))))
|
|
|
8293 (progn
|
|
|
8294 (set (intern name) "")
|
|
|
8295 (set-process-filter
|
|
|
8296 proc
|
|
|
8297 (function
|
|
|
8298 (lambda (proc string)
|
|
|
8299 (let ((name (process-name proc))
|
|
|
8300 result)
|
|
|
8301 (set (intern name) (concat (symbol-value (intern name))
|
|
|
8302 string))
|
|
|
8303 (setq result (efs-parse-ctime
|
|
|
8304 (symbol-value (intern name))))
|
|
|
8305 (if result
|
|
|
8306 (let* ((host (substring name 11 -1))
|
|
|
8307 (cont (efs-get-host-property host 'ctime-cont)))
|
|
|
8308 (efs-set-host-property host 'last-ctime result)
|
|
|
8309 (condition-case nil (delete-process proc) (error nil))
|
|
|
8310 (if cont
|
|
|
8311 (progn
|
|
|
8312 (efs-set-host-property host 'ctime-cont nil)
|
|
|
8313 (efs-call-cont cont host result)))))))))
|
|
|
8314 (set-process-sentinel
|
|
|
8315 proc
|
|
|
8316 (function
|
|
|
8317 (lambda (proc state)
|
|
|
8318 (let* ((name (process-name proc))
|
|
|
8319 (host (substring name 11 -1))
|
|
|
8320 (cont (efs-get-host-property host 'ctime-cont)))
|
|
|
8321 (makunbound (intern name))
|
|
|
8322 (or (efs-get-host-property host 'last-ctime)
|
|
|
8323 (if cont
|
|
|
8324 (progn
|
|
|
8325 (efs-set-host-property host 'ctime-cont nil)
|
|
|
8326 (efs-call-cont cont host 'failed))))))))
|
|
|
8327 (if nowait
|
|
|
8328 nil
|
|
|
8329 (let ((quit-flag nil)
|
|
|
8330 (inhibit-quit nil))
|
|
|
8331 (while (memq (process-status proc) '(run open))
|
|
|
8332 (accept-process-output)))
|
|
|
8333 (accept-process-output)
|
|
|
8334 (or (efs-get-host-property host 'last-ctime)
|
|
|
8335 'failed)))
|
|
|
8336 (if cont
|
|
|
8337 (progn
|
|
|
8338 (efs-set-host-property host 'ctime-cont nil)
|
|
|
8339 (efs-call-cont cont host 'failed)))
|
|
|
8340 (if nowait nil 'failed))))
|
|
|
8341
|
|
|
8342 (defun efs-clock-difference (host &optional nowait)
|
|
|
8343 ;; clock difference with the local host
|
|
|
8344 (let ((result (efs-get-host-property host 'clock-diff)))
|
|
|
8345 (or
|
|
|
8346 result
|
|
|
8347 (progn
|
|
|
8348 (efs-century-time
|
|
|
8349 host nowait
|
|
|
8350 (efs-cont (host result) (nowait)
|
|
|
8351 (if (eq result 'failed)
|
|
|
8352 (efs-set-host-property host 'clock-diff 'failed)
|
|
|
8353 (efs-century-time
|
|
|
8354 nil nowait
|
|
|
8355 (efs-cont (lhost lresult) (host result)
|
|
|
8356 (if (eq lresult 'failed)
|
|
|
8357 (efs-set-host-property host 'clock-diff 'failed)
|
|
|
8358 (efs-set-host-property host 'clock-diff
|
|
|
8359 (efs-time-minus result lresult))))))))
|
|
|
8360 (and (null nowait)
|
|
|
8361 (or (efs-get-host-property host 'clock-diff)
|
|
|
8362 'failed))))))
|
|
|
8363
|
|
|
8364 (defun efs-get-file-mdtm (host user file path)
|
|
|
8365 "For HOST and USER, return FILE's last modification time.
|
|
|
8366 PATH is the file name in full efs syntax.
|
|
|
8367 Returns a list of two six-digit integers which represent the 16 high order
|
|
|
8368 bits, and 16 low order bits of the number of elapsed seconds since
|
|
|
8369 `efs-time-zero'"
|
|
|
8370 (and (null (efs-get-host-property host 'mdtm-failed))
|
|
|
8371 (let ((result (efs-send-cmd host user (list 'quote 'mdtm file)
|
|
|
8372 (and (eq efs-verbose t)
|
|
|
8373 "Getting modtime")))
|
|
|
8374 parsed)
|
|
|
8375 (if (and (null (car result))
|
|
|
8376 (setq parsed (efs-parse-mdtime (nth 1 result))))
|
|
|
8377 (let ((ent (efs-get-file-entry path)))
|
|
|
8378 (if ent
|
|
|
8379 (setcdr ent (list (nth 1 ent) (nth 2 ent)
|
|
|
8380 (nth 3 ent) (nth 4 ent)
|
|
|
8381 parsed)))
|
|
|
8382 parsed)
|
|
|
8383 (efs-save-match-data
|
|
|
8384 ;; The 550 error is for a nonexistent file. Actually implies
|
|
|
8385 ;; that MDTM works.
|
|
|
8386 (if (string-match "^550 " (nth 1 result))
|
|
|
8387 '(0 0)
|
|
|
8388 (efs-set-host-property host 'mdtm-failed t)
|
|
|
8389 nil))))))
|
|
|
8390
|
|
|
8391 (efs-define-fun efs-set-emacs-bvf-mdtm (buffer mdtm)
|
|
|
8392 ;; Sets cached value for the buffer visited file modtime.
|
|
|
8393 (if (get-buffer buffer)
|
|
|
8394 (save-excursion
|
|
|
8395 (set-buffer buffer)
|
|
|
8396 (let (file-name-handler-alist)
|
|
|
8397 (set-visited-file-modtime mdtm)))))
|
|
|
8398
|
|
|
8399 ;; (defun efs-set-visited-file-modtime (&optional time)
|
|
|
8400 ;; ;; For remote files sets the modtime for a buffer to be that of the
|
|
|
8401 ;; ;; visited file. With arg TIME sets the modtime to TIME. TIME must be a list
|
|
|
8402 ;; ;; of two 16-bit integers.
|
|
|
8403 ;; ;; The function set-visited-file-modtime is for emacs-19. It doesn't
|
|
|
8404 ;; ;; exist in emacs 18. If you're running efs, it will work in emacs 18 for
|
|
|
8405 ;; ;; remote files only.
|
|
|
8406 ;; (if time
|
|
|
8407 ;; (efs-set-emacs-bvf-mdtm (current-buffer) time)
|
|
|
8408 ;; (let* ((path buffer-file-name)
|
|
|
8409 ;; (parsed (efs-ftp-path path))
|
|
|
8410 ;; (host (car parsed))
|
|
|
8411 ;; (user (nth 1 parsed))
|
|
|
8412 ;; (file (nth 2 parsed))
|
|
|
8413 ;; (buffer (current-buffer)))
|
|
|
8414 ;; (if (efs-save-match-data
|
|
|
8415 ;; (and efs-verify-modtime-host-regexp
|
|
|
8416 ;; (string-match efs-verify-modtime-host-regexp host)
|
|
|
8417 ;; (or efs-verify-anonymous-modtime
|
|
|
8418 ;; (not (efs-anonymous-p user)))
|
|
|
8419 ;; (not (efs-get-host-property host 'mdtm-failed))))
|
|
|
8420 ;; (efs-send-cmd
|
|
|
8421 ;; host user (list 'quote 'mdtm file)
|
|
|
8422 ;; nil nil
|
|
|
8423 ;; (efs-cont (result line cont-lines) (host user path buffer)
|
|
|
8424 ;; (let (modtime)
|
|
|
8425 ;; (if (and (null result)
|
|
|
8426 ;; (setq modtime (efs-parse-mdtime line)))
|
|
|
8427 ;; (let ((ent (efs-get-file-entry path)))
|
|
|
8428 ;; (if ent
|
|
|
8429 ;; (setcdr ent (list (nth 1 ent) (nth 2 ent)
|
|
|
8430 ;; (nth 3 ent) (nth 4 ent)
|
|
|
8431 ;; modtime)))
|
|
|
8432 ;; (setq buffer (and (setq buffer (get-buffer buffer))
|
|
|
8433 ;; (buffer-name buffer)))
|
|
|
8434 ;; ;; Beware that since this is happening asynch, the buffer
|
|
|
8435 ;; ;; may have disappeared.
|
|
|
8436 ;; (and buffer (efs-set-emacs-bvf-mdtm buffer modtime)))
|
|
|
8437 ;; (efs-save-match-data
|
|
|
8438 ;; (or (string-match "^550 " line)
|
|
|
8439 ;; (efs-set-host-property host 'mdtm-failed t)))
|
|
|
8440 ;; (efs-set-emacs-bvf-mdtm buffer 0)))) ; store dummy values
|
|
|
8441 ;; 0) ; Always do this NOWAIT = 0
|
|
|
8442 ;; (efs-set-emacs-bvf-mdtm buffer 0))
|
|
|
8443 ;; nil) ; return NIL
|
|
|
8444 ;; ))
|
|
|
8445
|
|
|
8446 (defvar efs-set-modtimes-synchronously nil
|
|
|
8447 "*Whether efs uses a synchronous FTP command to set the visited file modtime.
|
|
|
8448 Setting this variable to non-nil means that efs will set visited file modtimes
|
|
|
8449 synchronously.
|
|
|
8450
|
|
|
8451 Asynchronous setting of visited file modtimes leaves a very small
|
|
|
8452 window where Emacs may fail to detect a super session. However, it gives
|
|
|
8453 faster user access to newly visited files.")
|
|
|
8454
|
|
|
8455
|
|
|
8456 (defun efs-set-visited-file-modtime (&optional time)
|
|
|
8457 ;; For remote files sets the modtime for a buffer to be that of the
|
|
|
8458 ;; visited file. With arg TIME sets the modtime to TIME. TIME must be a list
|
|
|
8459 ;; of two 16-bit integers.
|
|
|
8460 ;; The function set-visited-file-modtime is for emacs-19. It doesn't
|
|
|
8461 ;; exist in emacs 18. If you're running efs, it will work in emacs 18 for
|
|
|
8462 ;; remote files only.
|
|
|
8463 (if time
|
|
|
8464 (efs-set-emacs-bvf-mdtm (current-buffer) time)
|
|
|
8465 (let* ((path buffer-file-name)
|
|
|
8466 (parsed (efs-ftp-path path))
|
|
|
8467 (host (car parsed))
|
|
|
8468 (user (nth 1 parsed))
|
|
|
8469 (file (nth 2 parsed))
|
|
|
8470 (buffer (current-buffer)))
|
|
|
8471 (if (efs-save-match-data
|
|
|
8472 (and efs-verify-modtime-host-regexp
|
|
|
8473 (string-match efs-verify-modtime-host-regexp host)
|
|
|
8474 (or efs-verify-anonymous-modtime
|
|
|
8475 (not (efs-anonymous-p user)))
|
|
|
8476 (not (efs-get-host-property host 'mdtm-failed))))
|
|
|
8477 (progn
|
|
|
8478 (or efs-set-modtimes-synchronously (clear-visited-file-modtime))
|
|
|
8479 (efs-send-cmd
|
|
|
8480 host user (list 'quote 'mdtm file)
|
|
|
8481 nil nil
|
|
|
8482 (efs-cont (result line cont-lines) (host user path buffer)
|
|
|
8483 (let (modtime)
|
|
|
8484 (if (and (null result)
|
|
|
8485 (setq modtime (efs-parse-mdtime line)))
|
|
|
8486 (let ((ent (efs-get-file-entry path)))
|
|
|
8487 (if ent
|
|
|
8488 (setcdr ent (list (nth 1 ent) (nth 2 ent)
|
|
|
8489 (nth 3 ent) (nth 4 ent)
|
|
|
8490 modtime)))
|
|
|
8491 (setq buffer (and (setq buffer (get-buffer buffer))
|
|
|
8492 (buffer-name buffer)))
|
|
|
8493 ;; Beware that since might be happening asynch,
|
|
|
8494 ;; the buffer may have disappeared.
|
|
|
8495 (and buffer (efs-set-emacs-bvf-mdtm buffer modtime)))
|
|
|
8496 (efs-save-match-data
|
|
|
8497 (or (string-match "^550 " line)
|
|
|
8498 (efs-set-host-property host 'mdtm-failed t)))
|
|
|
8499 (efs-set-emacs-bvf-mdtm buffer '(0 0))))) ; store dummy values
|
|
|
8500 (and (null efs-set-modtimes-synchronously) 0)))
|
|
|
8501 (efs-set-emacs-bvf-mdtm buffer '(0 0)))
|
|
|
8502 nil))) ; return NIL
|
|
|
8503
|
|
|
8504 (defun efs-file-newer-than-file-p (file1 file2)
|
|
|
8505 ;; Version of file-newer-than-file-p for remote files.
|
|
|
8506 (let* ((file1 (expand-file-name file1))
|
|
|
8507 (file2 (expand-file-name file2))
|
|
|
8508 (parsed1 (efs-ftp-path file1))
|
|
|
8509 (parsed2 (efs-ftp-path file2))
|
|
|
8510 (host1 (car parsed1))
|
|
|
8511 (host2 (car parsed2))
|
|
|
8512 (user1 (nth 1 parsed1))
|
|
|
8513 (user2 (nth 1 parsed2)))
|
|
|
8514 (cond
|
|
|
8515 ;; If the first file doedn't exist, or is remote but
|
|
|
8516 ;; we're not supposed to check modtimes on it, return nil.
|
|
|
8517 ((or (null (file-exists-p file1))
|
|
|
8518 (and parsed1
|
|
|
8519 (or
|
|
|
8520 (null efs-verify-modtime-host-regexp)
|
|
|
8521 (efs-get-host-property host1 'mdtm-failed)
|
|
|
8522 (not (string-match efs-verify-modtime-host-regexp host1))
|
|
|
8523 (and (null efs-verify-anonymous-modtime)
|
|
|
8524 (efs-anonymous-p user1)))))
|
|
|
8525 nil)
|
|
|
8526 ;; If the same is true for the second file, return t.
|
|
|
8527 ((or (null (file-exists-p file2))
|
|
|
8528 (and parsed2
|
|
|
8529 (or
|
|
|
8530 (null efs-verify-modtime-host-regexp)
|
|
|
8531 (efs-get-host-property host2 'mdtm-failed)
|
|
|
8532 (not (string-match efs-verify-modtime-host-regexp host2))
|
|
|
8533 (and (null efs-verify-anonymous-modtime)
|
|
|
8534 (efs-anonymous-p user2)))))
|
|
|
8535 t)
|
|
|
8536 ;; Calculate modtimes. If we get here, any remote files should
|
|
|
8537 ;; have a file entry.
|
|
|
8538 (t
|
|
|
8539 (let (mod1 mod2 shift1 shift2)
|
|
|
8540 (if parsed1
|
|
|
8541 (let ((ent (efs-get-file-entry file1)))
|
|
|
8542 (setq mod1 (nth 5 ent)
|
|
|
8543 shift1 (efs-clock-difference host1))
|
|
|
8544 (or mod1
|
|
|
8545 (setq mod1 (efs-get-file-mdtm
|
|
|
8546 host1 user1 (nth 2 parsed1) file1))))
|
|
|
8547 (setq mod1 (nth 5 (file-attributes file1))))
|
|
|
8548 (if parsed2
|
|
|
8549 (let ((ent (efs-get-file-entry file2)))
|
|
|
8550 (setq mod2 (nth 5 ent)
|
|
|
8551 shift2 (efs-clock-difference host2))
|
|
|
8552 (or mod2
|
|
|
8553 (setq mod2 (efs-get-file-mdtm
|
|
|
8554 host2 user2 (nth 2 parsed2) file2))))
|
|
|
8555 (setq mod2 (nth 5 (file-attributes file2))))
|
|
|
8556 ;; If we can't compute clock shifts, we act as if we don't
|
|
|
8557 ;; even know the modtime. Should we have more faith in ntp?
|
|
|
8558 (cond
|
|
|
8559 ((or (null mod1) (eq shift1 'failed))
|
|
|
8560 nil)
|
|
|
8561 ((or (null mod2) (eq shift2 'failed))
|
|
|
8562 t)
|
|
|
8563 ;; We get to compute something!
|
|
|
8564 (t
|
|
|
8565 (efs-time-greater
|
|
|
8566 (if shift1 (efs-time-minus mod1 shift1) mod1)
|
|
|
8567 (if shift2 (efs-time-minus mod2 shift2) mod2)))))))))
|
|
|
8568
|
|
|
8569 (defun efs-verify-visited-file-modtime (buff)
|
|
|
8570 ;; Verifies the modtime for buffers visiting remote files.
|
|
|
8571 ;; Won't get called for buffer not visiting any file.
|
|
|
8572 (let ((buff (get-buffer buff)))
|
|
|
8573 (null
|
|
|
8574 (and buff ; return t if no buffer? Need to beware of multi-threading.
|
|
|
8575 (buffer-file-name buff) ; t if no file
|
|
|
8576 (let ((mdtm (save-excursion
|
|
|
8577 (set-buffer buff)
|
|
|
8578 (visited-file-modtime))))
|
|
|
8579 (and
|
|
|
8580 (not (eq mdtm 0))
|
|
|
8581 (not (equal mdtm '(0 0)))
|
|
|
8582 efs-verify-modtime-host-regexp
|
|
|
8583 (let* ((path (buffer-file-name buff))
|
|
|
8584 (parsed (efs-ftp-path path))
|
|
|
8585 (host (car parsed))
|
|
|
8586 (user (nth 1 parsed))
|
|
|
8587 nmdtm)
|
|
|
8588 (and
|
|
|
8589 (null (efs-get-host-property host 'mdtm-failed))
|
|
|
8590 (efs-save-match-data
|
|
|
8591 (string-match
|
|
|
8592 efs-verify-modtime-host-regexp host))
|
|
|
8593 (or efs-verify-anonymous-modtime
|
|
|
8594 (not (efs-anonymous-p user)))
|
|
|
8595 (setq nmdtm (efs-get-file-mdtm host user (nth 2 parsed) path))
|
|
|
8596 (progn
|
|
|
8597 (or (equal nmdtm '(0 0))
|
|
|
8598 (file-exists-p path) ; Make sure that there is an entry.
|
|
|
8599 (null
|
|
|
8600 (efs-get-files
|
|
|
8601 (file-name-directory
|
|
|
8602 (efs-internal-directory-file-name path))))
|
|
|
8603 (efs-add-file-entry
|
|
|
8604 (efs-host-type host) path nil nil nil nil nil nmdtm))
|
|
|
8605 (null (and (eq (cdr mdtm) (nth 1 nmdtm))
|
|
|
8606 (eq (car mdtm) (car nmdtm)))))))))))))
|
|
|
8607
|
|
|
8608 ;;;; -----------------------------------------------------------
|
|
|
8609 ;;;; Redefinition of Emacs file name completion
|
|
|
8610 ;;;; -----------------------------------------------------------
|
|
|
8611
|
|
|
8612 (defmacro efs-set-completion-ignored-pattern ()
|
|
|
8613 ;; Set regexp efs-completion-ignored-pattern
|
|
|
8614 ;; to use for filename completion.
|
|
|
8615 (`
|
|
|
8616 (or (equal efs-completion-ignored-extensions
|
|
|
8617 completion-ignored-extensions)
|
|
|
8618 (setq efs-completion-ignored-extensions
|
|
|
8619 completion-ignored-extensions
|
|
|
8620 efs-completion-ignored-pattern
|
|
|
8621 (mapconcat (function
|
|
|
8622 (lambda (s) (if (stringp s)
|
|
|
8623 (concat (regexp-quote s) "$")
|
|
|
8624 "/"))) ; / never in filename
|
|
|
8625 efs-completion-ignored-extensions
|
|
|
8626 "\\|")))))
|
|
|
8627
|
|
|
8628 (defun efs-file-entry-active-p (sym)
|
|
|
8629 ;; If the file entry is a symlink, returns whether the file pointed to
|
|
|
8630 ;; exists.
|
|
|
8631 ;; Note that DIR is dynamically bound.
|
|
|
8632 (let ((file-type (car (get sym 'val))))
|
|
|
8633 (or (not (stringp file-type))
|
|
|
8634 (file-exists-p (efs-chase-symlinks
|
|
|
8635 (expand-file-name file-type efs-completion-dir))))))
|
|
|
8636
|
|
|
8637 (defun efs-file-entry-not-ignored-p (sym)
|
|
|
8638 ;; If the file entry is not a directory (nor a symlink pointing to a
|
|
|
8639 ;; directory) returns whether the file (or file pointed to by the symlink)
|
|
|
8640 ;; is ignored by completion-ignored-extensions.
|
|
|
8641 (let ((file-type (car (get sym 'val)))
|
|
|
8642 (symname (symbol-name sym)))
|
|
|
8643 (if (stringp file-type)
|
|
|
8644 ;; Maybe file-truename would be better here, but it is very costly
|
|
|
8645 ;; to chase symlinks at every level over FTP.
|
|
|
8646 (let ((file (efs-chase-symlinks (expand-file-name
|
|
|
8647 file-type efs-completion-dir))))
|
|
|
8648 (or (file-directory-p file)
|
|
|
8649 (and (file-exists-p file)
|
|
|
8650 (not (string-match efs-completion-ignored-pattern
|
|
|
8651 symname)))))
|
|
|
8652 (or file-type ; is a directory name
|
|
|
8653 (not (string-match efs-completion-ignored-pattern symname))))))
|
|
|
8654
|
|
|
8655 (defun efs-file-name-all-completions (file dir)
|
|
|
8656 ;; Does file-name-all-completions in remote directories.
|
|
|
8657 (efs-barf-if-not-directory dir)
|
|
|
8658 (let* ((efs-completion-dir (file-name-as-directory (expand-file-name dir)))
|
|
|
8659 (completion-ignore-case
|
|
|
8660 (memq (efs-host-type (car (efs-ftp-path efs-completion-dir)))
|
|
|
8661 efs-case-insensitive-host-types))
|
|
|
8662 (tbl (efs-get-files efs-completion-dir))
|
|
|
8663 (completions
|
|
|
8664 (all-completions file tbl
|
|
|
8665 (function efs-file-entry-active-p))))
|
|
|
8666 ;; see whether each matching file is a directory or not...
|
|
|
8667 (mapcar
|
|
|
8668 ;; Since the entries in completions will match the case
|
|
|
8669 ;; of the entries in tbl, don't need to case-fold
|
|
|
8670 ;; in efs-get-hash-entry below.
|
|
|
8671 (function
|
|
|
8672 (lambda (file)
|
|
|
8673 (let ((ent (car (efs-get-hash-entry file tbl))))
|
|
|
8674 (if (or (eq ent t)
|
|
|
8675 (and (stringp ent)
|
|
|
8676 (file-directory-p (efs-chase-symlinks
|
|
|
8677 (expand-file-name
|
|
|
8678 ent efs-completion-dir)))))
|
|
|
8679 (concat file "/")
|
|
|
8680 file))))
|
|
|
8681 completions)))
|
|
|
8682
|
|
|
8683 (defun efs-file-name-completion (file dir)
|
|
|
8684 ;; Does file name expansion in remote directories.
|
|
|
8685 (efs-barf-if-not-directory dir)
|
|
|
8686 (if (equal file "")
|
|
|
8687 ""
|
|
|
8688 (let* ((efs-completion-dir (file-name-as-directory (expand-file-name dir)))
|
|
|
8689 (completion-ignore-case
|
|
|
8690 (memq (efs-host-type (car (efs-ftp-path efs-completion-dir)))
|
|
|
8691 efs-case-insensitive-host-types))
|
|
|
8692 (tbl (efs-get-files efs-completion-dir)))
|
|
|
8693 (efs-set-completion-ignored-pattern)
|
|
|
8694 (efs-save-match-data
|
|
|
8695 (or (efs-file-name-completion-1
|
|
|
8696 file tbl efs-completion-dir
|
|
|
8697 (function efs-file-entry-not-ignored-p))
|
|
|
8698 (efs-file-name-completion-1
|
|
|
8699 file tbl efs-completion-dir
|
|
|
8700 (function efs-file-entry-active-p)))))))
|
|
|
8701
|
|
|
8702 (defun efs-file-name-completion-1 (file tbl dir predicate)
|
|
|
8703 ;; Internal subroutine for efs-file-name-completion. Do not call this.
|
|
|
8704 (let ((bestmatch (try-completion file tbl predicate)))
|
|
|
8705 (if bestmatch
|
|
|
8706 (if (eq bestmatch t)
|
|
|
8707 (if (file-directory-p (expand-file-name file dir))
|
|
|
8708 (concat file "/")
|
|
|
8709 t)
|
|
|
8710 (if (and (eq (try-completion bestmatch tbl predicate) t)
|
|
|
8711 (file-directory-p
|
|
|
8712 (expand-file-name bestmatch dir)))
|
|
|
8713 (concat bestmatch "/")
|
|
|
8714 bestmatch)))))
|
|
|
8715
|
|
|
8716 ;;;; ----------------------------------------------------------
|
|
|
8717 ;;;; Functions for loading lisp.
|
|
|
8718 ;;;; ----------------------------------------------------------
|
|
|
8719
|
|
|
8720 ;;; jka-load provided ideas here. Thanks, Jay.
|
|
|
8721
|
|
|
8722 (defun efs-load-openp (str suffixes)
|
|
|
8723 ;; Given STR, searches load-path and efs-load-lisp-extensions
|
|
|
8724 ;; for the name of a file to load. Returns the full path, or nil
|
|
|
8725 ;; if none found.
|
|
|
8726 (let ((path-list (if (file-name-absolute-p str) t load-path))
|
|
|
8727 root result)
|
|
|
8728 ;; If there is no load-path, at least try the default directory.
|
|
|
8729 (or path-list
|
|
|
8730 (setq path-list (list default-directory)))
|
|
|
8731 (while (and path-list (null result))
|
|
|
8732 (if (eq path-list t)
|
|
|
8733 (setq path-list nil
|
|
|
8734 root str)
|
|
|
8735 (setq root (expand-file-name str (car path-list))
|
|
|
8736 path-list (cdr path-list))
|
|
|
8737 (or (file-name-absolute-p root)
|
|
|
8738 (setq root (expand-file-name root default-directory))))
|
|
|
8739 (let ((suff-list suffixes))
|
|
|
8740 (while (and suff-list (null result))
|
|
|
8741 (let ((try (concat root (car suff-list))))
|
|
|
8742 (if (or (not (file-readable-p try))
|
|
|
8743 (file-directory-p try))
|
|
|
8744 (setq suff-list (cdr suff-list))
|
|
|
8745 (setq result try))))))
|
|
|
8746 result))
|
|
|
8747
|
|
|
8748 (defun efs-load (file &optional noerror nomessage nosuffix)
|
|
|
8749 "Documented as original."
|
|
|
8750 (let ((filename (efs-load-openp
|
|
|
8751 file
|
|
|
8752 (if nosuffix '("") efs-load-lisp-extensions))))
|
|
|
8753 (if (not filename)
|
|
|
8754 (and (null noerror) (error "Cannot open load file %s" file))
|
|
|
8755 (let ((parsed (efs-ftp-path filename))
|
|
|
8756 (after-load (and (boundp 'after-load-alist)
|
|
|
8757 (assoc file after-load-alist))))
|
|
|
8758 (if parsed
|
|
|
8759 (let ((temp (car (efs-make-tmp-name nil (car parsed)))))
|
|
|
8760 (unwind-protect
|
|
|
8761 (progn
|
|
|
8762 (efs-copy-file-internal
|
|
|
8763 filename parsed temp nil t nil
|
|
|
8764 (format "Getting %s" filename))
|
|
|
8765 (or (file-readable-p temp)
|
|
|
8766 (error
|
|
|
8767 "efs-load: temp file %s is unreadable" temp))
|
|
|
8768 (or nomessage
|
|
|
8769 (message "Loading %s..." file))
|
|
|
8770 ;; temp is an absolute filename, so load path
|
|
|
8771 ;; won't be searched.
|
|
|
8772 (let (after-load-alist)
|
|
|
8773 (efs-real-load temp t t t))
|
|
|
8774 (or nomessage
|
|
|
8775 (message "Loading %s...done" file))
|
|
|
8776 (if after-load (mapcar 'eval (cdr after-load)))
|
|
|
8777 t) ; return t if everything worked
|
|
|
8778 (efs-del-tmp-name temp)))
|
|
|
8779 (prog2
|
|
|
8780 (or nomessage
|
|
|
8781 (message "Loading %s..." file))
|
|
|
8782 (let (after-load-alist)
|
|
|
8783 (or (efs-real-load filename noerror t t)
|
|
|
8784 (setq after-load nil)))
|
|
|
8785 (or nomessage
|
|
|
8786 (message "Loading %s...done" file))
|
|
|
8787 (if after-load (mapcar 'eval (cdr after-load)))))))))
|
|
|
8788
|
|
|
8789 (defun efs-require (feature &optional filename)
|
|
|
8790 "Documented as original."
|
|
|
8791 (if (eq feature 'ange-ftp) (efs-require-scream-and-yell))
|
|
|
8792 (if (featurep feature)
|
|
|
8793 feature
|
|
|
8794 (or filename (setq filename (symbol-name feature)))
|
|
|
8795 (let ((fullpath (efs-load-openp filename
|
|
|
8796 efs-load-lisp-extensions)))
|
|
|
8797 (if (not fullpath)
|
|
|
8798 (error "Cannot open load file: %s" filename)
|
|
|
8799 (let ((parsed (efs-ftp-path fullpath)))
|
|
|
8800 (if parsed
|
|
|
8801 (let ((temp (car (efs-make-tmp-name nil (car parsed)))))
|
|
|
8802 (unwind-protect
|
|
|
8803 (progn
|
|
|
8804 (efs-copy-file-internal
|
|
|
8805 fullpath parsed temp nil t nil
|
|
|
8806 (format "Getting %s" fullpath))
|
|
|
8807 (or (file-readable-p temp)
|
|
|
8808 (error
|
|
|
8809 "efs-require: temp file %s is unreadable" temp))
|
|
|
8810 (efs-real-require feature temp))
|
|
|
8811 (efs-del-tmp-name temp)))
|
|
|
8812 (efs-real-require feature fullpath)))))))
|
|
|
8813
|
|
|
8814 (defun efs-require-scream-and-yell ()
|
|
|
8815 ;; Complain if something attempts to load ange-ftp.
|
|
|
8816 (with-output-to-temp-buffer "*Help*"
|
|
|
8817 (princ
|
|
|
8818 "Something tried to load ange-ftp.
|
|
|
8819 EFS AND ANGE-FTP DO NOT WORK TOGETHER.
|
|
|
8820
|
|
|
8821 If the culprit package does need to access ange-ftp internal functions,
|
|
|
8822 then it should be adequate to simply remove the \(require 'ange-ftp\)
|
|
|
8823 line and let efs handle remote file access. Otherwise, it will need to
|
|
|
8824 be ported to efs. This may already have been done, and you can find out
|
|
|
8825 by sending an enquiry to efs-help@cuckoo.hpl.hp.com.
|
|
|
8826
|
|
|
8827 Signalling an error with backtrace will allow you to determine which
|
|
|
8828 package was requiring ange-ftp.\n"))
|
|
|
8829 (select-window (get-buffer-window "*Help*"))
|
|
|
8830 (enlarge-window (- (count-lines (point-min) (point-max))
|
|
|
8831 (window-height) -1))
|
|
|
8832 (if (y-or-n-p "Signal error with backtrace? ")
|
|
|
8833 (let ((stack-trace-on-error t))
|
|
|
8834 (error "Attempt to require ange-ftp"))))
|
|
|
8835
|
|
|
8836 ;;;; -----------------------------------------------------------
|
|
|
8837 ;;;; Redefinition of Emacs functions for reading file names.
|
|
|
8838 ;;;; -----------------------------------------------------------
|
|
|
8839
|
|
|
8840 (defun efs-unexpand-parsed-filename (host user path)
|
|
|
8841 ;; Replaces the home directory in path with "~". Returns the unexpanded
|
|
|
8842 ;; full-path.
|
|
|
8843 (let* ((path-len (length path))
|
|
|
8844 (def-user (efs-get-user host))
|
|
|
8845 (host-type (efs-host-type host user))
|
|
|
8846 (ignore-case (memq host-type efs-case-insensitive-host-types)))
|
|
|
8847 (if (> path-len 1)
|
|
|
8848 (let* ((home (efs-expand-tilde "~" host-type host user))
|
|
|
8849 (home-len (length home)))
|
|
|
8850 (if (and (> path-len home-len)
|
|
|
8851 (if ignore-case (string-equal (downcase home)
|
|
|
8852 (downcase
|
|
|
8853 (substring path
|
|
|
8854 0 home-len)))
|
|
|
8855 (string-equal home (substring path 0 home-len)))
|
|
|
8856 (= (aref path home-len) ?/))
|
|
|
8857 (setq path (concat "~" (substring path home-len))))))
|
|
|
8858 (if (if ignore-case (string-equal (downcase user)
|
|
|
8859 (downcase def-user))
|
|
|
8860 (string-equal user def-user))
|
|
|
8861 (format efs-path-format-without-user host path)
|
|
|
8862 (format efs-path-format-string user host path))))
|
|
|
8863
|
|
|
8864 (efs-define-fun efs-abbreviate-file-name (filename)
|
|
|
8865 ;; Version of abbreviate-file-name for remote files.
|
|
|
8866 (efs-save-match-data
|
|
|
8867 (let ((tail directory-abbrev-alist))
|
|
|
8868 (while tail
|
|
|
8869 (if (string-match (car (car tail)) filename)
|
|
|
8870 (setq filename
|
|
|
8871 (concat (cdr (car tail))
|
|
|
8872 (substring filename (match-end 0)))))
|
|
|
8873 (setq tail (cdr tail)))
|
|
|
8874 (apply 'efs-unexpand-parsed-filename (efs-ftp-path filename)))))
|
|
|
8875
|
|
|
8876 (defun efs-default-dir-function ()
|
|
|
8877 (let ((parsed (efs-ftp-path default-directory))
|
|
|
8878 (dd default-directory))
|
|
|
8879 (if parsed
|
|
|
8880 (efs-save-match-data
|
|
|
8881 (let ((tail directory-abbrev-alist))
|
|
|
8882 (while tail
|
|
|
8883 (if (string-match (car (car tail)) dd)
|
|
|
8884 (setq dd (concat (cdr (car tail))
|
|
|
8885 (substring dd (match-end 0)))
|
|
|
8886 parsed nil))
|
|
|
8887 (setq tail (cdr tail)))
|
|
|
8888 (apply 'efs-unexpand-parsed-filename
|
|
|
8889 (or parsed (efs-ftp-path dd)))))
|
|
|
8890 default-directory)))
|
|
|
8891
|
|
|
8892 (defun efs-re-read-dir (&optional dir)
|
|
|
8893 "Forces a re-read of the directory DIR.
|
|
|
8894 If DIR is omitted then it defaults to the directory part of the contents
|
|
|
8895 of the current buffer. This is so this function can be caled from the
|
|
|
8896 minibuffer."
|
|
|
8897 (interactive)
|
|
|
8898 (if dir
|
|
|
8899 (setq dir (expand-file-name dir))
|
|
|
8900 (setq dir (file-name-directory (expand-file-name (buffer-string)))))
|
|
|
8901 (let ((parsed (efs-ftp-path dir)))
|
|
|
8902 (if parsed
|
|
|
8903 (let ((efs-ls-uncache t))
|
|
|
8904 (efs-del-hash-entry (efs-canonize-file-name dir)
|
|
|
8905 efs-files-hashtable)
|
|
|
8906 (efs-get-files dir t)))))
|
|
|
8907
|
|
|
8908 ;;;; ---------------------------------------------------------------
|
|
|
8909 ;;;; Creation and deletion of files and directories.
|
|
|
8910 ;;;; ---------------------------------------------------------------
|
|
|
8911
|
|
|
8912 (defun efs-delete-file (file)
|
|
|
8913 ;; Deletes remote files.
|
|
|
8914 (let* ((file (expand-file-name file))
|
|
|
8915 (parsed (efs-ftp-path file))
|
|
|
8916 (host (car parsed))
|
|
|
8917 (user (nth 1 parsed))
|
|
|
8918 (host-type (efs-host-type host user))
|
|
|
8919 (path (nth 2 parsed))
|
|
|
8920 (abbr (efs-relativize-filename file))
|
|
|
8921 (result (efs-send-cmd host user (list 'delete path)
|
|
|
8922 (format "Deleting %s" abbr))))
|
|
|
8923 (if (car result)
|
|
|
8924 (signal 'ftp-error
|
|
|
8925 (list "Removing old name"
|
|
|
8926 (format "FTP Error: \"%s\"" (nth 1 result))
|
|
|
8927 file)))
|
|
|
8928 (efs-delete-file-entry host-type file)))
|
|
|
8929
|
|
|
8930 (defun efs-make-directory-internal (dir)
|
|
|
8931 ;; version of make-directory-internal for remote directories.
|
|
|
8932 (if (file-exists-p dir)
|
|
|
8933 (error "Cannot make directory %s: file already exists" dir)
|
|
|
8934 (let* ((parsed (efs-ftp-path dir))
|
|
|
8935 (host (nth 0 parsed))
|
|
|
8936 (user (nth 1 parsed))
|
|
|
8937 (host-type (efs-host-type host user))
|
|
|
8938 ;; Some ftp's on unix machines (at least on Suns)
|
|
|
8939 ;; insist that mkdir take a filename, and not a
|
|
|
8940 ;; directory-name name as an arg. Argh!! This is a bug.
|
|
|
8941 ;; Non-unix machines will probably always insist
|
|
|
8942 ;; that mkdir takes a directory-name as an arg
|
|
|
8943 ;; (as the ftp man page says it should).
|
|
|
8944 (path (if (or (memq host-type efs-unix-host-types)
|
|
|
8945 (memq host-type '(os2 dos)))
|
|
|
8946 (efs-internal-directory-file-name (nth 2 parsed))
|
|
|
8947 (efs-internal-file-name-as-directory
|
|
|
8948 host-type (nth 2 parsed))))
|
|
|
8949 (abbr (efs-relativize-filename dir))
|
|
|
8950 (result (efs-send-cmd host user
|
|
|
8951 (list 'mkdir path)
|
|
|
8952 (format "Making directory %s"
|
|
|
8953 abbr))))
|
|
|
8954 (if (car result)
|
|
|
8955 (efs-error host user
|
|
|
8956 (format "Could not make directory %s: %s" dir
|
|
|
8957 (nth 1 result))))
|
|
|
8958 (efs-add-file-entry host-type dir t nil user))))
|
|
|
8959
|
|
|
8960 ;; V19 calls this function delete-directory. It used to be called
|
|
|
8961 ;; remove-directory.
|
|
|
8962
|
|
|
8963 (defun efs-delete-directory (dir)
|
|
|
8964 ;; Version of delete-directory for remote directories.
|
|
|
8965 (if (file-directory-p dir)
|
|
|
8966 (let* ((parsed (efs-ftp-path dir))
|
|
|
8967 (host (nth 0 parsed))
|
|
|
8968 (user (nth 1 parsed))
|
|
|
8969 (host-type (efs-host-type host user))
|
|
|
8970 ;; Some ftp's on unix machines (at least on Suns)
|
|
|
8971 ;; insist that rmdir take a filename, and not a
|
|
|
8972 ;; directory-name name as an arg. Argh!! This is a bug.
|
|
|
8973 ;; Non-unix machines will probably always insist
|
|
|
8974 ;; that rmdir takes a directory-name as an arg
|
|
|
8975 ;; (as the ftp man page says it should).
|
|
|
8976 (path
|
|
|
8977 (if (or (memq host-type efs-unix-host-types)
|
|
|
8978 (memq host-type '(os2 dos)))
|
|
|
8979 (efs-internal-directory-file-name (nth 2 parsed))
|
|
|
8980 (efs-internal-file-name-as-directory
|
|
|
8981 host-type (nth 2 parsed))))
|
|
|
8982 (abbr (efs-relativize-filename dir))
|
|
|
8983 (result (efs-send-cmd host user
|
|
|
8984 (list 'rmdir path)
|
|
|
8985 (format "Deleting directory %s" abbr))))
|
|
|
8986 (if (car result)
|
|
|
8987 (efs-error host user
|
|
|
8988 (format "Could not delete directory %s: %s"
|
|
|
8989 dir (nth 1 result))))
|
|
|
8990 (efs-delete-file-entry host-type dir t))
|
|
|
8991 (error "Not a directory: %s" dir)))
|
|
|
8992
|
|
|
8993 (defun efs-file-local-copy (file)
|
|
|
8994 ;; internal function for diff.el (dired 6.3 or later)
|
|
|
8995 ;; Makes a temp file containing the contents of file.
|
|
|
8996 ;; returns the name of the tmp file created, or nil if none is.
|
|
|
8997 ;; This function should have optional cont and nowait args.
|
|
|
8998 (let* ((file (expand-file-name file))
|
|
|
8999 (tmp (car (efs-make-tmp-name nil (car (efs-ftp-path file))))))
|
|
|
9000 (efs-copy-file-internal file (efs-ftp-path file)
|
|
|
9001 tmp nil t nil (format "Getting %s" file))
|
|
|
9002 tmp))
|
|
|
9003
|
|
|
9004 (defun efs-diff/grep-del-temp-file (temp)
|
|
|
9005 ;; internal function for diff.el and grep.el
|
|
|
9006 ;; if TEMP is non-nil, deletes the temp file TEMP.
|
|
|
9007 ;; if TEMP is nil, does nothing.
|
|
|
9008 (and temp
|
|
|
9009 (efs-del-tmp-name temp)))
|
|
|
9010
|
|
|
9011 ;;;; ------------------------------------------------------------
|
|
|
9012 ;;;; File copying support...
|
|
|
9013 ;;;; ------------------------------------------------------------
|
|
|
9014
|
|
|
9015 ;;; - totally re-written 6/24/92.
|
|
|
9016 ;;; - re-written again 9/3/93
|
|
|
9017 ;;; - and again 14/4/93
|
|
|
9018 ;;; - and again 17/8/93
|
|
|
9019
|
|
|
9020 (defun efs-barf-or-query-if-file-exists (absname querystring interactive)
|
|
|
9021 (if (file-exists-p absname)
|
|
|
9022 (if (not interactive)
|
|
|
9023 (signal 'file-already-exists (list absname))
|
|
|
9024 (if (not (yes-or-no-p (format "File %s already exists; %s anyway? "
|
|
|
9025 absname querystring)))
|
|
|
9026 (signal 'file-already-exists (list absname))))))
|
|
|
9027
|
|
|
9028 (defun efs-concatenate-files (file1 file2)
|
|
|
9029 ;; Concatenates file1 to file2. Both must be local files.
|
|
|
9030 ;; Needed because the efs version of copy-file understands
|
|
|
9031 ;; ok-if-already-exists = 'append
|
|
|
9032 (or (file-readable-p file1)
|
|
|
9033 (signal 'file-error
|
|
|
9034 (list (format "Input file %s not readable." file1))))
|
|
|
9035 (or (file-writable-p file2)
|
|
|
9036 (signal 'file-error
|
|
|
9037 (list (format "Output file %s not writable." file2))))
|
|
|
9038 (let ((default-directory exec-directory))
|
|
|
9039 (call-process "sh" nil nil nil "-c" (format "cat %s >> %s" file1 file2))))
|
|
|
9040
|
|
|
9041 (defun efs-copy-add-file-entry (newname host-type user size append)
|
|
|
9042 ;; Add an entry in `efs-files-hashtable' for a file newly created via a copy.
|
|
|
9043 (if (eq size -1) (setq size nil))
|
|
|
9044 (if append
|
|
|
9045 (let ((ent (efs-get-file-entry newname)))
|
|
|
9046 (if (and ent (null (car ent)))
|
|
|
9047 (if (and size (numberp (nth 1 ent)))
|
|
|
9048 (setcar (cdr ent) (+ size (nth 1 ent)))
|
|
|
9049 (setcar (cdr ent) nil))
|
|
|
9050 ;; If the ent is a symlink or directory, don't overwrite that entry.
|
|
|
9051 (if (null ent)
|
|
|
9052 (efs-add-file-entry host-type newname nil nil nil))))
|
|
|
9053 (efs-add-file-entry host-type newname nil size user)))
|
|
|
9054
|
|
|
9055 (defun efs-copy-remote-to-remote (f-host-type f-host f-user f-path filename
|
|
|
9056 t-host-type t-host t-user
|
|
|
9057 t-path newname append msg cont
|
|
|
9058 nowait xfer-type)
|
|
|
9059 ;; Use a 3rd data connection to copy from F-HOST for F-USER to T-HOST
|
|
|
9060 ;; for T-USER.
|
|
|
9061 (if (efs-get-host-property t-host 'pasv-failed)
|
|
|
9062 ;; PASV didn't work before, don't try again.
|
|
|
9063 (if cont (efs-call-cont cont 'failed "" ""))
|
|
|
9064 (or xfer-type
|
|
|
9065 (setq xfer-type (efs-xfer-type f-host-type filename
|
|
|
9066 t-host-type newname)))
|
|
|
9067 (efs-send-cmd
|
|
|
9068 t-host t-user '(quote pasv) nil nil
|
|
|
9069 (efs-cont (pasv-result pasv-line pasv-cont-lines)
|
|
|
9070 (cont nowait f-host-type f-host f-user f-path filename
|
|
|
9071 t-host-type t-host t-user t-path newname xfer-type msg append)
|
|
|
9072 (efs-save-match-data
|
|
|
9073 (if (or pasv-result
|
|
|
9074 (not (string-match efs-pasv-msgs pasv-line)))
|
|
|
9075 (progn
|
|
|
9076 (efs-set-host-property t-host 'pasv-failed t)
|
|
|
9077 (if cont
|
|
|
9078 (efs-call-cont
|
|
|
9079 cont (or pasv-result 'failed) pasv-line pasv-cont-lines)))
|
|
|
9080 (let ((address (substring pasv-line (match-beginning 1)
|
|
|
9081 (match-end 1))))
|
|
|
9082 (efs-send-cmd
|
|
|
9083 f-host f-user
|
|
|
9084 (list 'quote 'port address) nil nil
|
|
|
9085 (efs-cont (port-result port-line port-cont-lines)
|
|
|
9086 (cont f-host f-user f-host-type f-path filename
|
|
|
9087 xfer-type msg)
|
|
|
9088 (if port-result
|
|
|
9089 (if cont
|
|
|
9090 (efs-call-cont
|
|
|
9091 cont port-result port-line port-cont-lines)
|
|
|
9092 (efs-error f-host f-user
|
|
|
9093 (format "PORT failed for %s: %s"
|
|
|
9094 filename port-line)))
|
|
|
9095 (efs-send-cmd
|
|
|
9096 f-host f-user
|
|
|
9097 (list 'quote 'retr f-path xfer-type)
|
|
|
9098 msg nil
|
|
|
9099 (efs-cont (retr-result retr-line retr-cont-lines)
|
|
|
9100 (cont f-host f-user f-path)
|
|
|
9101 (and retr-result
|
|
|
9102 (null cont)
|
|
|
9103 (efs-error
|
|
|
9104 f-host f-user
|
|
|
9105 (format "RETR failed for %s: %s"
|
|
|
9106 f-path retr-line)))
|
|
|
9107 (if cont (efs-call-cont
|
|
|
9108 cont retr-result retr-line retr-cont-lines)))
|
|
|
9109 (if (eq nowait t) 1 nowait))))
|
|
|
9110 1) ; can't ever wait on this command.
|
|
|
9111 (efs-send-cmd
|
|
|
9112 t-host t-user
|
|
|
9113 (list 'quote (if append 'appe 'stor) t-path xfer-type)
|
|
|
9114 nil nil
|
|
|
9115 (efs-cont (stor-result stor-line stor-cont-lines)
|
|
|
9116 (t-host t-user t-path t-host-type newname filename
|
|
|
9117 append)
|
|
|
9118 (if stor-result
|
|
|
9119 (efs-error
|
|
|
9120 t-host t-user (format "%s failed for %s: %s"
|
|
|
9121 (if append "APPE" "STOR")
|
|
|
9122 t-path stor-line))
|
|
|
9123 (efs-copy-add-file-entry
|
|
|
9124 newname t-host-type t-user
|
|
|
9125 (nth 1 (efs-get-file-entry filename)) append)))
|
|
|
9126 (if (eq nowait t) 1 nowait))))))
|
|
|
9127 nowait)))
|
|
|
9128
|
|
|
9129 (defun efs-copy-on-remote (host user host-type filename newname filename-parsed
|
|
|
9130 newname-parsed keep-date append-p msg cont
|
|
|
9131 nowait xfer-type)
|
|
|
9132 ;; Uses site exec to copy the file on a remote host
|
|
|
9133 (let ((exec-cp (efs-get-host-property host 'exec-cp)))
|
|
|
9134 (if (or append-p
|
|
|
9135 (not (memq host-type efs-unix-host-types))
|
|
|
9136 (efs-get-host-property host 'exec-failed)
|
|
|
9137 (eq exec-cp 'failed))
|
|
|
9138 (efs-copy-via-temp filename filename-parsed newname newname-parsed
|
|
|
9139 append-p keep-date msg cont nowait xfer-type)
|
|
|
9140 (if (eq exec-cp 'works)
|
|
|
9141 (efs-send-cmd
|
|
|
9142 host user
|
|
|
9143 (list 'quote 'site 'exec
|
|
|
9144 (format "cp %s%s %s" (if keep-date "-p " "")
|
|
|
9145 (nth 2 filename-parsed) (nth 2 newname-parsed)))
|
|
|
9146 msg nil
|
|
|
9147 (efs-cont (result line cont-lines) (host user filename newname
|
|
|
9148 host-type filename-parsed
|
|
|
9149 newname-parsed
|
|
|
9150 keep-date append-p msg cont
|
|
|
9151 xfer-type nowait)
|
|
|
9152 (if result
|
|
|
9153 (progn
|
|
|
9154 (efs-set-host-property host 'exec-failed t)
|
|
|
9155 (efs-copy-via-temp filename filename-parsed newname
|
|
|
9156 newname-parsed append-p keep-date
|
|
|
9157 nil cont nowait xfer-type))
|
|
|
9158 (efs-save-match-data
|
|
|
9159 (if (string-match "\n200-\\([^\n]*\\)" cont-lines)
|
|
|
9160 (let ((err (substring cont-lines (match-beginning 1)
|
|
|
9161 (match-end 1))))
|
|
|
9162 (if cont
|
|
|
9163 (efs-call-cont cont 'failed err cont-lines)
|
|
|
9164 (efs-error host user err)))
|
|
|
9165 (efs-copy-add-file-entry
|
|
|
9166 newname host-type user
|
|
|
9167 (nth 7 (efs-file-attributes filename)) nil)
|
|
|
9168 (if cont (efs-call-cont cont nil line cont-lines))))))
|
|
|
9169 nowait)
|
|
|
9170 (message "Checking for cp executable on %s..." host)
|
|
|
9171 (efs-send-cmd
|
|
|
9172 host user (list 'quote 'site 'exec "cp / /") nil nil
|
|
|
9173 (efs-cont (result line cont-lines) (host user filename newname
|
|
|
9174 host-type filename-parsed
|
|
|
9175 newname-parsed
|
|
|
9176 keep-date append-p msg cont
|
|
|
9177 xfer-type nowait)
|
|
|
9178 (efs-save-match-data
|
|
|
9179 (if (string-match "\n200-" cont-lines)
|
|
|
9180 (efs-set-host-property host 'exec-cp 'works)
|
|
|
9181 (efs-set-host-property host 'exec-cp 'failed)))
|
|
|
9182 (efs-copy-on-remote host user host-type filename newname
|
|
|
9183 filename-parsed newname-parsed keep-date
|
|
|
9184 append-p msg cont nowait xfer-type))
|
|
|
9185 nowait)))))
|
|
|
9186
|
|
|
9187 (defun efs-copy-via-temp (filename filename-parsed newname newname-parsed
|
|
|
9188 append keep-date msg cont nowait xfer-type)
|
|
|
9189 ;; Copies from FILENAME to NEWNAME via a temp file.
|
|
|
9190 (let* ((temp (car (if (efs-use-gateway-p (car filename-parsed) t)
|
|
|
9191 (efs-make-tmp-name (car filename-parsed)
|
|
|
9192 (car newname-parsed))
|
|
|
9193 (efs-make-tmp-name (car newname-parsed)
|
|
|
9194 (car filename-parsed)))))
|
|
|
9195 (temp-parsed (efs-ftp-path temp)))
|
|
|
9196 (or xfer-type (setq xfer-type
|
|
|
9197 (efs-xfer-type
|
|
|
9198 (efs-host-type (car filename-parsed)) filename
|
|
|
9199 (efs-host-type (car newname-parsed)) newname
|
|
|
9200 t)))
|
|
|
9201 (efs-copy-file-internal
|
|
|
9202 filename filename-parsed temp temp-parsed t nil (if (eq 0 msg) 2 msg)
|
|
|
9203 (efs-cont (result line cont-lines) (newname newname-parsed temp
|
|
|
9204 temp-parsed append msg cont
|
|
|
9205 nowait xfer-type)
|
|
|
9206 (if result
|
|
|
9207 (progn
|
|
|
9208 (efs-del-tmp-name temp)
|
|
|
9209 (if cont
|
|
|
9210 (efs-call-cont cont result line cont-lines)
|
|
|
9211 (signal 'ftp-error
|
|
|
9212 (list "Opening input file"
|
|
|
9213 (format "FTP Error: \"%s\" " line) filename))))
|
|
|
9214 (efs-copy-file-internal
|
|
|
9215 temp temp-parsed newname newname-parsed (if append 'append t) nil
|
|
|
9216 (if (eq msg 0) 1 msg)
|
|
|
9217 (efs-cont (result line cont-lines) (temp newname cont)
|
|
|
9218 (efs-del-tmp-name temp)
|
|
|
9219 (if cont
|
|
|
9220 (efs-call-cont cont result line cont-lines)
|
|
|
9221 (if result
|
|
|
9222 (signal 'ftp-error
|
|
|
9223 (list "Opening output file"
|
|
|
9224 (format "FTP Error: \"%s\" " line) newname)))))
|
|
|
9225 nowait xfer-type)))
|
|
|
9226 nowait xfer-type)))
|
|
|
9227
|
|
|
9228 (defun efs-copy-file-internal (filename filename-parsed newname newname-parsed
|
|
|
9229 ok-if-already-exists keep-date
|
|
|
9230 &optional msg cont nowait xfer-type)
|
|
|
9231 ;; Internal function for copying a file from FILENAME to NEWNAME.
|
|
|
9232 ;; FILENAME-PARSED and NEWNAME-PARSED are the lists obtained by parsing
|
|
|
9233 ;; FILENAME and NEWNAME with efs-ftp-path.
|
|
|
9234 ;; If OK-IF-ALREADY-EXISTS is nil, then existing files will not be
|
|
|
9235 ;; overwritten.
|
|
|
9236 ;; If it is a number, then the user will be prompted about overwriting.
|
|
|
9237 ;; If it eq 'append, then an existing file will be appended to.
|
|
|
9238 ;; If it has anyother value, then existing files will be silently
|
|
|
9239 ;; overwritten.
|
|
|
9240 ;; If KEEP-DATE is t then we will attempt to reatin the date of the
|
|
|
9241 ;; original copy of the file. If this is a string, the modtime of the
|
|
|
9242 ;; NEWNAME will be set to this date. Must be in touch -t format.
|
|
|
9243 ;; If MSG is nil, then the copying will be done silently.
|
|
|
9244 ;; If it is a string, then that will be the massage displayed while copying.
|
|
|
9245 ;; If it is 0, then a suitable default message will be computed.
|
|
|
9246 ;; If it is 1, then a suitable default will be computed, assuming
|
|
|
9247 ;; that FILENAME is a temporary file, whose name is not suitable to use
|
|
|
9248 ;; in a status message.
|
|
|
9249 ;; If it is 2, then a suitable default will be used, assuming that
|
|
|
9250 ;; NEWNAME is a temporary file.
|
|
|
9251 ;; CONT is a continuation to call after completing the copy.
|
|
|
9252 ;; The first two args are RESULT and LINE, the result symbol and status
|
|
|
9253 ;; line of the FTP command. If more than one ftp command has been used,
|
|
|
9254 ;; then these values for the last FTP command are given.
|
|
|
9255 ;; NOWAIT can be either nil, 0, 1, t. See `efs-send-cmd' for an explanation.
|
|
|
9256 ;; XFER-TYPE is the transfer type to use for transferring the files.
|
|
|
9257 ;; If this is nil, than a suitable transfer type is computed.
|
|
|
9258 ;; Does not call expand-file-name. Do that yourself.
|
|
|
9259
|
|
|
9260 ;; check to see if we can overwrite
|
|
|
9261 (if (or (not ok-if-already-exists)
|
|
|
9262 (numberp ok-if-already-exists))
|
|
|
9263 (efs-barf-or-query-if-file-exists
|
|
|
9264 newname "copy to it" (numberp ok-if-already-exists)))
|
|
|
9265 (if (null (or filename-parsed newname-parsed))
|
|
|
9266 ;; local to local copy
|
|
|
9267 (progn
|
|
|
9268 (if (eq ok-if-already-exists 'append)
|
|
|
9269 (efs-concatenate-files filename newname)
|
|
|
9270 (copy-file filename newname ok-if-already-exists keep-date))
|
|
|
9271 (if cont
|
|
|
9272 (efs-call-cont cont nil "Copied locally" "")))
|
|
|
9273 (let* ((f-host (car filename-parsed))
|
|
|
9274 (f-user (nth 1 filename-parsed))
|
|
|
9275 (f-path (nth 2 filename-parsed))
|
|
|
9276 (f-host-type (efs-host-type f-host f-user))
|
|
|
9277 (f-gate-p (efs-use-gateway-p f-host t))
|
|
|
9278 (t-host (car newname-parsed))
|
|
|
9279 (t-user (nth 1 newname-parsed))
|
|
|
9280 (t-path (nth 2 newname-parsed))
|
|
|
9281 (t-host-type (efs-host-type t-host t-user))
|
|
|
9282 (t-gate-p (efs-use-gateway-p t-host t))
|
|
|
9283 (append-p (eq ok-if-already-exists 'append))
|
|
|
9284 gatename)
|
|
|
9285
|
|
|
9286 (if (and (eq keep-date t) (null newname-parsed))
|
|
|
9287 ;; f-host must be remote now.
|
|
|
9288 (setq keep-date filename))
|
|
|
9289
|
|
|
9290 (cond
|
|
|
9291
|
|
|
9292 ;; Check to see if we can do a PUT
|
|
|
9293 ((or
|
|
|
9294 (and (null f-host)
|
|
|
9295 (or (null t-gate-p)
|
|
|
9296 (setq gatename (efs-local-to-gateway-filename filename))))
|
|
|
9297 (and t-gate-p
|
|
|
9298 f-host
|
|
|
9299 (string-equal (downcase f-host) (downcase efs-gateway-host))
|
|
|
9300 (if (memq f-host-type efs-case-insensitive-host-types)
|
|
|
9301 (string-equal (downcase f-user)
|
|
|
9302 (downcase (efs-get-user efs-gateway-host)))
|
|
|
9303 (string-equal f-user (efs-get-user efs-gateway-host)))))
|
|
|
9304 (or f-host (let (file-name-handler-alist)
|
|
|
9305 (if (file-exists-p filename)
|
|
|
9306 (cond
|
|
|
9307 ((file-directory-p filename)
|
|
|
9308 (signal 'file-error
|
|
|
9309 (list "Non-regular file"
|
|
|
9310 "is a directory" filename)))
|
|
|
9311 ((not (file-readable-p filename))
|
|
|
9312 (signal 'file-error
|
|
|
9313 (list "Opening input file"
|
|
|
9314 "permission denied" filename))))
|
|
|
9315 (signal 'file-error
|
|
|
9316 (list "Opening input file"
|
|
|
9317 "no such file or directory" filename)))))
|
|
|
9318 (or xfer-type
|
|
|
9319 (setq xfer-type
|
|
|
9320 (efs-xfer-type f-host-type filename t-host-type newname)))
|
|
|
9321 (let ((size (and (or (null f-host-type)
|
|
|
9322 (efs-file-entry-p filename))
|
|
|
9323 (nth 7 (file-attributes filename)))))
|
|
|
9324 ;; -1 is a bogus size for remote files
|
|
|
9325 (if (eq size -1) (setq size nil))
|
|
|
9326 (efs-send-cmd
|
|
|
9327 t-host t-user
|
|
|
9328 (list (if append-p 'append 'put)
|
|
|
9329 (if f-host
|
|
|
9330 f-path
|
|
|
9331 (or gatename filename))
|
|
|
9332 t-path
|
|
|
9333 xfer-type)
|
|
|
9334 (cond ((eq msg 2)
|
|
|
9335 (concat (if append-p "Appending " "Putting ")
|
|
|
9336 (efs-relativize-filename filename)))
|
|
|
9337 ((eq msg 1)
|
|
|
9338 (concat (if append-p "Appending " "Putting ")
|
|
|
9339 (efs-relativize-filename newname)))
|
|
|
9340 ((eq msg 0)
|
|
|
9341 (concat (if append-p "Appending " "Copying ")
|
|
|
9342 (efs-relativize-filename filename)
|
|
|
9343 " to "
|
|
|
9344 (efs-relativize-filename
|
|
|
9345 newname (file-name-directory filename) filename)))
|
|
|
9346 (t msg))
|
|
|
9347 (and size (list 'efs-set-xfer-size t-host t-user size))
|
|
|
9348 (efs-cont (result line cont-lines) (newname t-host-type t-user size
|
|
|
9349 append-p cont)
|
|
|
9350 (if result
|
|
|
9351 (if cont
|
|
|
9352 (efs-call-cont cont result line cont-lines)
|
|
|
9353 (signal 'ftp-error
|
|
|
9354 (list "Opening output file"
|
|
|
9355 (format "FTP Error: \"%s\" " line) newname)))
|
|
|
9356 ;; add file entry
|
|
|
9357 (efs-copy-add-file-entry newname t-host-type t-user
|
|
|
9358 size append-p)
|
|
|
9359 (if cont
|
|
|
9360 (efs-call-cont cont result line cont-lines))))
|
|
|
9361 nowait)))
|
|
|
9362
|
|
|
9363 ;; Check to see if we can do a GET
|
|
|
9364 ((and
|
|
|
9365 ;; I think that giving the append arg, will cause this function
|
|
|
9366 ;; to make a temp file, recursively call itself, and append the temp
|
|
|
9367 ;; file to the local file. Hope it works out...
|
|
|
9368 (null append-p)
|
|
|
9369 (or
|
|
|
9370 (and (null t-host)
|
|
|
9371 (or (null f-gate-p)
|
|
|
9372 (setq gatename (efs-local-to-gateway-filename newname))))
|
|
|
9373 (and f-gate-p
|
|
|
9374 t-host
|
|
|
9375 (string-equal (downcase t-host) (downcase efs-gateway-host))
|
|
|
9376 (if (memq t-host-type efs-case-insensitive-host-types)
|
|
|
9377 (string-equal (downcase t-user)
|
|
|
9378 (downcase (efs-get-user efs-gateway-host)))
|
|
|
9379 (string-equal t-user (efs-get-user efs-gateway-host))))))
|
|
|
9380 (or t-host (let (file-name-handler-alist)
|
|
|
9381 (cond ((not (file-writable-p newname))
|
|
|
9382 (signal 'file-error
|
|
|
9383 (list "Opening output file"
|
|
|
9384 "permission denied" newname)))
|
|
|
9385 ((file-directory-p newname)
|
|
|
9386 (signal 'file-error
|
|
|
9387 (list "Opening output file"
|
|
|
9388 "is a directory" newname))))))
|
|
|
9389 (or xfer-type
|
|
|
9390 (setq xfer-type
|
|
|
9391 (efs-xfer-type f-host-type filename t-host-type newname)))
|
|
|
9392 (let ((size (and (or (null f-host-type)
|
|
|
9393 (efs-file-entry-p filename))
|
|
|
9394 (nth 7 (file-attributes filename)))))
|
|
|
9395 ;; -1 is a bogus size for remote files.
|
|
|
9396 (if (eq size -1) (setq size nil))
|
|
|
9397 (efs-send-cmd
|
|
|
9398 f-host f-user
|
|
|
9399 (list 'get
|
|
|
9400 f-path
|
|
|
9401 (if t-host
|
|
|
9402 t-path
|
|
|
9403 (or gatename newname))
|
|
|
9404 xfer-type)
|
|
|
9405 (cond ((eq msg 0)
|
|
|
9406 (concat "Copying "
|
|
|
9407 (efs-relativize-filename filename)
|
|
|
9408 " to "
|
|
|
9409 (efs-relativize-filename
|
|
|
9410 newname (file-name-directory filename) filename)))
|
|
|
9411 ((eq msg 2)
|
|
|
9412 (concat "Getting " (efs-relativize-filename filename)))
|
|
|
9413 ((eq msg 1)
|
|
|
9414 (concat "Getting " (efs-relativize-filename newname)))
|
|
|
9415 (t msg))
|
|
|
9416 ;; If the server emits a efs-xfer-size-msgs, it will over-ride this.
|
|
|
9417 ;; With no xfer msg, this is will do the job.
|
|
|
9418 (and size (list 'efs-set-xfer-size f-host f-user size))
|
|
|
9419 (efs-cont (result line cont-lines) (filename newname size
|
|
|
9420 t-host-type t-user
|
|
|
9421 cont keep-date)
|
|
|
9422 (if result
|
|
|
9423 (if cont
|
|
|
9424 (efs-call-cont cont result line cont-lines)
|
|
|
9425 (signal 'ftp-error
|
|
|
9426 (list "Opening input file"
|
|
|
9427 (format "FTP Error: \"%s\" " line) filename)))
|
|
|
9428 ;; Add a new file entry, if relevant.
|
|
|
9429 (if t-host-type
|
|
|
9430 ;; t-host will be equal to efs-gateway-host, if t-host-type
|
|
|
9431 ;; is non-nil.
|
|
|
9432 (efs-copy-add-file-entry newname t-host-type
|
|
|
9433 t-user size nil))
|
|
|
9434 (if (and (null t-host-type) (stringp keep-date))
|
|
|
9435 (efs-set-mdtm-of
|
|
|
9436 filename newname
|
|
|
9437 (and cont
|
|
|
9438 (efs-cont (result1 line1 cont-lines1) (result
|
|
|
9439 line cont-lines
|
|
|
9440 cont)
|
|
|
9441 (efs-call-cont cont result line cont-lines))))
|
|
|
9442 (if cont
|
|
|
9443 (efs-call-cont cont result line cont-lines)))))
|
|
|
9444 nowait)))
|
|
|
9445
|
|
|
9446 ;; Can we do a EXEC cp?
|
|
|
9447 ((and t-host f-host
|
|
|
9448 (string-equal (downcase t-host) (downcase f-host))
|
|
|
9449 (if (memq t-host-type efs-case-insensitive-host-types)
|
|
|
9450 (string-equal (downcase t-user) (downcase f-user))
|
|
|
9451 (string-equal t-user f-user)))
|
|
|
9452 (efs-copy-on-remote
|
|
|
9453 t-host t-user t-host-type filename newname filename-parsed
|
|
|
9454 newname-parsed keep-date append-p
|
|
|
9455 (cond ((eq msg 0)
|
|
|
9456 (concat "Copying "
|
|
|
9457 (efs-relativize-filename filename)
|
|
|
9458 " to "
|
|
|
9459 (efs-relativize-filename
|
|
|
9460 newname (file-name-directory filename) filename)))
|
|
|
9461 ((eq msg 1)
|
|
|
9462 (concat "Copying " (efs-relativize-filename newname)))
|
|
|
9463 ((eq msg 2)
|
|
|
9464 (concat "Copying " (efs-relativize-filename filename)))
|
|
|
9465 (t msg))
|
|
|
9466 cont nowait xfer-type))
|
|
|
9467
|
|
|
9468 ;; Try for a copy with PASV
|
|
|
9469 ((and t-host f-host
|
|
|
9470 (not (and (string-equal (downcase t-host) (downcase f-host))
|
|
|
9471 (if (memq t-host-type efs-case-insensitive-host-types)
|
|
|
9472 (string-equal (downcase t-user) (downcase f-user))
|
|
|
9473 (string-equal t-user f-user))))
|
|
|
9474 (or
|
|
|
9475 (and efs-gateway-host
|
|
|
9476 ;; The gateway should be able to talk to anything.
|
|
|
9477 (let ((gh (downcase efs-gateway-host)))
|
|
|
9478 (or (string-equal (downcase t-host) gh)
|
|
|
9479 (string-equal (downcase f-host) gh))))
|
|
|
9480 (efs-save-match-data
|
|
|
9481 (eq (null (string-match efs-local-host-regexp t-host))
|
|
|
9482 (null (string-match efs-local-host-regexp f-host))))))
|
|
|
9483 (efs-copy-remote-to-remote
|
|
|
9484 f-host-type f-host f-user f-path filename
|
|
|
9485 t-host-type t-host t-user t-path newname
|
|
|
9486 append-p
|
|
|
9487 (cond ((eq msg 0)
|
|
|
9488 (concat "Copying "
|
|
|
9489 (efs-relativize-filename filename)
|
|
|
9490 " to "
|
|
|
9491 (efs-relativize-filename
|
|
|
9492 newname (file-name-directory filename) filename)))
|
|
|
9493 ((eq msg 1)
|
|
|
9494 (concat "Copying " (efs-relativize-filename newname)))
|
|
|
9495 ((eq msg 2)
|
|
|
9496 (concat "Copying " (efs-relativize-filename filename)))
|
|
|
9497 (t msg))
|
|
|
9498 (efs-cont (result line cont-lines)
|
|
|
9499 (filename filename-parsed newname newname-parsed
|
|
|
9500 append-p keep-date msg cont nowait xfer-type)
|
|
|
9501 (if result
|
|
|
9502 ;; PASV didn't work. Do things the old-fashioned
|
|
|
9503 ;; way.
|
|
|
9504 (efs-copy-via-temp
|
|
|
9505 filename filename-parsed newname newname-parsed
|
|
|
9506 append-p keep-date msg cont nowait xfer-type)
|
|
|
9507 (if cont
|
|
|
9508 (efs-call-cont cont result line cont-lines))))
|
|
|
9509 nowait xfer-type))
|
|
|
9510
|
|
|
9511 ;; Can't do anything direct. Divide and conquer.
|
|
|
9512 (t
|
|
|
9513 (efs-copy-via-temp filename filename-parsed newname newname-parsed
|
|
|
9514 append-p keep-date msg cont nowait xfer-type))))))
|
|
|
9515
|
|
|
9516 (defun efs-copy-file (filename newname &optional ok-if-already-exists
|
|
|
9517 keep-date nowait)
|
|
|
9518 ;; Version of copy file for remote files. Actually, will also work
|
|
|
9519 ;; for local files too, since efs-copy-file-internal can copy anything.
|
|
|
9520 ;; If called interactively, copies asynchronously.
|
|
|
9521 (setq filename (expand-file-name filename)
|
|
|
9522 newname (expand-file-name newname))
|
|
|
9523 (if (eq ok-if-already-exists 'append)
|
|
|
9524 (setq ok-if-already-exists t))
|
|
|
9525 (efs-copy-file-internal filename (efs-ftp-path filename)
|
|
|
9526 newname (efs-ftp-path newname)
|
|
|
9527 ok-if-already-exists keep-date 0 nil nowait))
|
|
|
9528
|
|
|
9529 ;;;; ------------------------------------------------------------
|
|
|
9530 ;;;; File renaming support.
|
|
|
9531 ;;;; ------------------------------------------------------------
|
|
|
9532
|
|
|
9533 (defun efs-rename-get-file-list (dir ent)
|
|
|
9534 ;; From hashtable ENT for DIR returns a list of all files except "."
|
|
|
9535 ;; and "..".
|
|
|
9536 (let (list)
|
|
|
9537 (efs-map-hashtable
|
|
|
9538 (function
|
|
|
9539 (lambda (key val)
|
|
|
9540 (or (string-equal "." key) (string-equal ".." key)
|
|
|
9541 (setq list
|
|
|
9542 (cons (expand-file-name key dir) list)))))
|
|
|
9543 ent)
|
|
|
9544 list))
|
|
|
9545
|
|
|
9546 (defun efs-rename-get-files (dir cont nowait)
|
|
|
9547 ;; Obtains a list of files in directory DIR (except . and ..), and applies
|
|
|
9548 ;; CONT to the list. Doesn't return anything useful.
|
|
|
9549 (let* ((dir (file-name-as-directory dir))
|
|
|
9550 (ent (efs-get-files-hashtable-entry dir)))
|
|
|
9551 (if ent
|
|
|
9552 (efs-call-cont cont (efs-rename-get-file-list dir ent))
|
|
|
9553 (efs-ls
|
|
|
9554 dir (efs-ls-guess-switches) t nil t nowait
|
|
|
9555 (efs-cont (listing) (dir cont)
|
|
|
9556 (efs-call-cont
|
|
|
9557 cont (and listing
|
|
|
9558 (efs-rename-get-file-list
|
|
|
9559 dir (efs-get-files-hashtable-entry dir)))))))))
|
|
|
9560
|
|
|
9561 (defun efs-rename-get-local-file-tree (dir)
|
|
|
9562 ;; Returns a list of the full directory tree under DIR, for DIR on the
|
|
|
9563 ;; local host. The list is in tree order.
|
|
|
9564 (let ((res (list dir)))
|
|
|
9565 (mapcar
|
|
|
9566 (function
|
|
|
9567 (lambda (file)
|
|
|
9568 (if (file-directory-p file)
|
|
|
9569 (nconc res (delq nil (mapcar
|
|
|
9570 (function
|
|
|
9571 (lambda (f)
|
|
|
9572 (and (not (string-equal "." f))
|
|
|
9573 (not (string-equal ".." f))
|
|
|
9574 (expand-file-name f file))))
|
|
|
9575 (directory-files file)))))))
|
|
|
9576 res)
|
|
|
9577 res))
|
|
|
9578
|
|
|
9579 (defun efs-rename-get-remote-file-tree (next curr total cont nowait)
|
|
|
9580 ;; Builds a hierarchy of files.
|
|
|
9581 ;; NEXT is the next level so far.
|
|
|
9582 ;; CURR are unprocessed files in the current level.
|
|
|
9583 ;; TOTAL is the processed files so far.
|
|
|
9584 ;; CONT is a cont. function called on the total list after all files
|
|
|
9585 ;; are processed.
|
|
|
9586 ;; NOWAIT non-nil means run asynch.
|
|
|
9587 (or curr (setq curr next
|
|
|
9588 next nil))
|
|
|
9589 (if curr
|
|
|
9590 (let ((file (car curr)))
|
|
|
9591 (setq curr (cdr curr)
|
|
|
9592 total (cons file total))
|
|
|
9593 (if (file-directory-p file)
|
|
|
9594 (efs-rename-get-files
|
|
|
9595 file
|
|
|
9596 (efs-cont (list) (next curr total cont nowait)
|
|
|
9597 (efs-rename-get-remote-file-tree (nconc next list)
|
|
|
9598 curr total cont nowait))
|
|
|
9599 nowait)
|
|
|
9600 (efs-rename-get-remote-file-tree next curr total cont nowait)))
|
|
|
9601 (efs-call-cont cont (nreverse total))))
|
|
|
9602
|
|
|
9603 (defun efs-rename-make-targets (files from-dir-len to-dir host user host-type
|
|
|
9604 cont nowait)
|
|
|
9605 ;; Make targets (copy a file or make a subdir) on local or host
|
|
|
9606 ;; for the files in list. Afterwhich, call CONT.
|
|
|
9607 (if files
|
|
|
9608 (let* ((from (car files))
|
|
|
9609 (files (cdr files))
|
|
|
9610 (to (concat to-dir (substring from from-dir-len))))
|
|
|
9611 (if (file-directory-p from)
|
|
|
9612 (if host-type
|
|
|
9613 (let ((dir (nth 2 (efs-ftp-path to))))
|
|
|
9614 (or (memq host-type efs-unix-host-types)
|
|
|
9615 (memq host-type '(dos os2))
|
|
|
9616 (setq dir (efs-internal-file-name-as-directory nil dir)))
|
|
|
9617 (efs-send-cmd
|
|
|
9618 host user (list 'mkdir dir)
|
|
|
9619 (format "Making directory %s" (efs-relativize-filename to))
|
|
|
9620 nil
|
|
|
9621 (efs-cont (res line cont-lines) (to files from-dir-len
|
|
|
9622 to-dir host user
|
|
|
9623 host-type cont nowait)
|
|
|
9624 (if res
|
|
|
9625 (if cont
|
|
|
9626 (efs-call-cont cont res line cont-lines)
|
|
|
9627 (signal 'ftp-error
|
|
|
9628 (list "Making directory"
|
|
|
9629 (format "FTP Error: \"%s\"" line)
|
|
|
9630 to)))
|
|
|
9631 (efs-rename-make-targets
|
|
|
9632 files from-dir-len to-dir host user
|
|
|
9633 host-type cont nowait)))
|
|
|
9634 nowait))
|
|
|
9635 (condition-case nil
|
|
|
9636 (make-directory-internal to)
|
|
|
9637 (error (efs-call-cont
|
|
|
9638 cont 'failed (format "Failed to mkdir %s" to) "")))
|
|
|
9639 (efs-rename-make-targets
|
|
|
9640 files from-dir-len to-dir host user host-type cont nowait))
|
|
|
9641 (efs-copy-file-internal
|
|
|
9642 from (efs-ftp-path from) to (and host-type (efs-ftp-path to)) nil t
|
|
|
9643 (format "Renaming %s to %s" (efs-relativize-filename from)
|
|
|
9644 (efs-relativize-filename to))
|
|
|
9645 (efs-cont (res line cont-lines) (from to files from-dir-len to-dir
|
|
|
9646 host user host-type cont
|
|
|
9647 nowait)
|
|
|
9648 (if res
|
|
|
9649 (if cont
|
|
|
9650 (efs-call-cont cont res line cont-lines)
|
|
|
9651 (signal 'ftp-error
|
|
|
9652 (list "Renaming"
|
|
|
9653 (format "FTP Error: \"%s\"" line) from to)))
|
|
|
9654 (efs-rename-make-targets
|
|
|
9655 files from-dir-len to-dir host user host-type cont nowait)))
|
|
|
9656 nowait)))
|
|
|
9657 (if cont (efs-call-cont cont nil "" ""))))
|
|
|
9658
|
|
|
9659 (defun efs-rename-delete-on-local (files)
|
|
|
9660 ;; Delete the files FILES, and then run CONT.
|
|
|
9661 ;; FILES are assumed to be in inverse tree order.
|
|
|
9662 (message "Deleting files...")
|
|
|
9663 (mapcar
|
|
|
9664 (function
|
|
|
9665 (lambda (f)
|
|
|
9666 (condition-case nil
|
|
|
9667 (if (file-directory-p f)
|
|
|
9668 (delete-directory f)
|
|
|
9669 (delete-file f))
|
|
|
9670 (file-error nil)))) ; don't complain if the file is already gone.
|
|
|
9671 files)
|
|
|
9672 (message "Deleting files...done"))
|
|
|
9673
|
|
|
9674 (defun efs-rename-delete-on-remote (files host user host-type cont nowait)
|
|
|
9675 ;; Deletes the list FILES on a remote host. When done calls CONT.
|
|
|
9676 ;; FILES is assumed to be in reverse tree order.
|
|
|
9677 (if files
|
|
|
9678 (let* ((f (car files))
|
|
|
9679 (rf (nth 2 (efs-ftp-path f))))
|
|
|
9680 (progn
|
|
|
9681 (setq files (cdr files))
|
|
|
9682 (if (file-directory-p f)
|
|
|
9683 (let ((rf (if (memq host-type (append efs-unix-host-types
|
|
|
9684 '(dos os2)))
|
|
|
9685 (efs-internal-directory-file-name f)
|
|
|
9686 (efs-internal-file-name-as-directory nil f))))
|
|
|
9687
|
|
|
9688 (efs-send-cmd
|
|
|
9689 host user (list 'rmdir rf)
|
|
|
9690 (concat "Deleting directory " (efs-relativize-filename f))
|
|
|
9691 nil
|
|
|
9692 (efs-cont (res line cont-lines) (f files host user host-type
|
|
|
9693 cont nowait)
|
|
|
9694 (if (and res
|
|
|
9695 (efs-save-match-data
|
|
|
9696 (not (string-match "^550 " line))))
|
|
|
9697 (if cont
|
|
|
9698 (efs-call-cont cont res line cont-lines)
|
|
|
9699 (signal 'ftp-error
|
|
|
9700 (list "Deleting directory"
|
|
|
9701 (format "FTP Error: \"%s\"" line)
|
|
|
9702 f)))
|
|
|
9703 (efs-rename-delete-on-remote
|
|
|
9704 files host user host-type cont nowait)))
|
|
|
9705 nowait))
|
|
|
9706 (efs-send-cmd
|
|
|
9707 host user (list 'delete rf)
|
|
|
9708 (concat "Deleting " rf)
|
|
|
9709 nil
|
|
|
9710 (efs-cont (res line cont-lines) (f files host user host-type
|
|
|
9711 cont nowait)
|
|
|
9712 (if (and res
|
|
|
9713 (efs-save-match-data
|
|
|
9714 (not (string-match "^550 " line))))
|
|
|
9715 (if cont
|
|
|
9716 (efs-call-cont cont res line cont-lines)
|
|
|
9717 (signal 'ftp-error
|
|
|
9718 (list "Deleting"
|
|
|
9719 (format "FTP Error: \"%s\"" line)
|
|
|
9720 f)))
|
|
|
9721 (efs-rename-delete-on-remote
|
|
|
9722 files host user host-type cont nowait)))
|
|
|
9723 nowait))))
|
|
|
9724 (if cont (efs-call-cont cont nil "" ""))))
|
|
|
9725
|
|
|
9726 (defun efs-rename-on-remote (host user old-path new-path old-file new-file
|
|
|
9727 msg nowait cont)
|
|
|
9728 ;; Run a rename command on the remote server.
|
|
|
9729 ;; OLD-PATH and NEW-PATH are in full efs syntax.
|
|
|
9730 ;; OLD-FILE and NEW-FILE are the remote full pathnames, not in efs syntax.
|
|
|
9731 (efs-send-cmd
|
|
|
9732 host user (list 'rename old-file new-file) msg nil
|
|
|
9733 (efs-cont (result line cont-lines) (cont old-path new-path host)
|
|
|
9734 (if result
|
|
|
9735 (progn
|
|
|
9736 (or (and (>= (length line) 4)
|
|
|
9737 (string-equal "550 " (substring line 0 4)))
|
|
|
9738 (efs-set-host-property host 'rnfr-failed t))
|
|
|
9739 (if cont
|
|
|
9740 (efs-call-cont cont result line cont-lines)
|
|
|
9741 (signal 'ftp-error
|
|
|
9742 (list "Renaming"
|
|
|
9743 (format "FTP Error: \"%s\"" line)
|
|
|
9744 old-path new-path))))
|
|
|
9745 (let ((entry (efs-get-file-entry old-path))
|
|
|
9746 (host-type (efs-host-type host))
|
|
|
9747 ;; If no file entry, do extra work on the hashtable,
|
|
|
9748 ;; rather than force a listing.
|
|
|
9749 (dir-p (or (not (efs-file-entry-p old-path))
|
|
|
9750 (file-directory-p old-path))))
|
|
|
9751 (apply 'efs-add-file-entry host-type new-path
|
|
|
9752 (eq (car entry) t) (cdr entry))
|
|
|
9753 (efs-delete-file-entry host-type old-path)
|
|
|
9754 (if dir-p
|
|
|
9755 (let* ((old (efs-canonize-file-name
|
|
|
9756 (file-name-as-directory old-path)))
|
|
|
9757 (new (efs-canonize-file-name
|
|
|
9758 (file-name-as-directory new-path)))
|
|
|
9759 (old-len (length old))
|
|
|
9760 (new-tbl (efs-make-hashtable
|
|
|
9761 (length efs-files-hashtable))))
|
|
|
9762 (efs-map-hashtable
|
|
|
9763 (function
|
|
|
9764 (lambda (key val)
|
|
|
9765 (if (and (>= (length key) old-len)
|
|
|
9766 (string-equal (substring key 0 old-len)
|
|
|
9767 old))
|
|
|
9768 (efs-put-hash-entry
|
|
|
9769 (concat new (substring key old-len)) val new-tbl)
|
|
|
9770 (efs-put-hash-entry key val new-tbl))))
|
|
|
9771 efs-files-hashtable)
|
|
|
9772 (setq efs-files-hashtable new-tbl)))
|
|
|
9773 (if cont (efs-call-cont cont result line cont-lines)))))
|
|
|
9774 nowait))
|
|
|
9775
|
|
|
9776 (defun efs-rename-local-to-remote (filename newname newname-parsed
|
|
|
9777 msg cont nowait)
|
|
|
9778 ;; Renames a file from the local host to a remote host.
|
|
|
9779 (if (file-directory-p filename)
|
|
|
9780 (let* ((files (efs-rename-get-local-file-tree filename))
|
|
|
9781 (to-dir (directory-file-name newname))
|
|
|
9782 (filename (directory-file-name filename))
|
|
|
9783 (len (length filename))
|
|
|
9784 (t-parsed (efs-ftp-path to-dir))
|
|
|
9785 (host (car t-parsed))
|
|
|
9786 (user (nth 1 t-parsed))
|
|
|
9787 (host-type (efs-host-type host)))
|
|
|
9788 ;; MSG is never passed here, instead messages are constructed
|
|
|
9789 ;; internally. I don't know how to use a single message
|
|
|
9790 ;; in a function which sends so many FTP commands.
|
|
|
9791 (efs-rename-make-targets
|
|
|
9792 files len to-dir host user host-type
|
|
|
9793 (efs-cont (result line cont-lines) (files filename newname cont)
|
|
|
9794 (if result
|
|
|
9795 (if cont
|
|
|
9796 (efs-call-cont cont result line cont-lines)
|
|
|
9797 (signal 'ftp-error
|
|
|
9798 (list "Renaming" (format "FTP Error: \"%s\"" line)
|
|
|
9799 filename newname)))
|
|
|
9800 (efs-rename-delete-on-local (nreverse files))
|
|
|
9801 (if cont (efs-call-cont cont result line cont-lines))))
|
|
|
9802 nowait))
|
|
|
9803 (efs-copy-file-internal
|
|
|
9804 filename nil newname newname-parsed t t msg
|
|
|
9805 (efs-cont (result line cont-lines) (filename cont)
|
|
|
9806 (if result
|
|
|
9807 (if cont
|
|
|
9808 (efs-call-cont cont result line cont-lines)
|
|
|
9809 (signal 'ftp-error
|
|
|
9810 (list "Renaming"
|
|
|
9811 (format "FTP Error: \"%s\"" line)
|
|
|
9812 filename newname)))
|
|
|
9813 (condition-case nil
|
|
|
9814 (delete-file filename)
|
|
|
9815 (error nil))
|
|
|
9816 (if cont (efs-call-cont cont result line cont-lines))))
|
|
|
9817 nowait)))
|
|
|
9818
|
|
|
9819 (defun efs-rename-from-remote (filename filename-parsed newname newname-parsed
|
|
|
9820 msg cont nowait)
|
|
|
9821 (let ((f-host (car filename-parsed))
|
|
|
9822 (f-user (nth 1 filename-parsed))
|
|
|
9823 (fast-nowait (if (eq nowait t) 1 nowait)))
|
|
|
9824 (if (file-directory-p filename)
|
|
|
9825 (let* ((t-host (car newname-parsed))
|
|
|
9826 (t-user (nth 1 newname-parsed))
|
|
|
9827 (t-host-type (and t-host (efs-host-type t-host)))
|
|
|
9828 (f-host-type (efs-host-type f-host)))
|
|
|
9829 (efs-rename-get-remote-file-tree
|
|
|
9830 nil (list filename) nil
|
|
|
9831 (efs-cont (list) (filename filename-parsed newname t-host t-user
|
|
|
9832 t-host-type f-host f-user f-host-type
|
|
|
9833 cont fast-nowait)
|
|
|
9834 (efs-rename-make-targets
|
|
|
9835 list (length filename) newname t-host t-user t-host-type
|
|
|
9836 (efs-cont (res line cont-lines) (filename newname f-host f-user
|
|
|
9837 f-host-type list cont
|
|
|
9838 fast-nowait)
|
|
|
9839 (if res
|
|
|
9840 (if cont
|
|
|
9841 (efs-call-cont cont res line cont-lines)
|
|
|
9842 (signal 'ftp-error
|
|
|
9843 (list "Renaming"
|
|
|
9844 (format "FTP Error: \"%s\"" line)
|
|
|
9845 filename newname)))
|
|
|
9846 (efs-rename-delete-on-remote
|
|
|
9847 (nreverse list) f-host f-user f-host-type cont
|
|
|
9848 fast-nowait)))
|
|
|
9849 fast-nowait)) nowait))
|
|
|
9850 ;; Do things the simple way.
|
|
|
9851 (let ((f-path (nth 2 filename-parsed))
|
|
|
9852 (f-abbr (efs-relativize-filename filename)))
|
|
|
9853 (efs-copy-file-internal
|
|
|
9854 filename filename-parsed newname newname-parsed t t msg
|
|
|
9855 (efs-cont (result line cont-lines) (filename newname f-host f-user
|
|
|
9856 f-path f-abbr
|
|
|
9857 cont fast-nowait)
|
|
|
9858 (if result
|
|
|
9859 (if cont
|
|
|
9860 (efs-call-cont cont result line cont-lines)
|
|
|
9861 (signal 'ftp-error
|
|
|
9862 (list "Renaming"
|
|
|
9863 (format "FTP Error: \"%s\"" line)
|
|
|
9864 filename newname)))
|
|
|
9865 (efs-send-cmd
|
|
|
9866 f-host f-user (list 'delete f-path)
|
|
|
9867 (format "Removing %s" f-abbr) nil
|
|
|
9868 (efs-cont (result line cont-lines) (filename f-host cont)
|
|
|
9869 (if result
|
|
|
9870 (if cont
|
|
|
9871 (efs-call-cont cont result line cont-lines)
|
|
|
9872 (signal 'ftp-error
|
|
|
9873 (list "Renaming"
|
|
|
9874 (format "Failed to remove %s"
|
|
|
9875 filename)
|
|
|
9876 "FTP Error: \"%s\"" line)))
|
|
|
9877 (efs-delete-file-entry (efs-host-type f-host)
|
|
|
9878 filename)
|
|
|
9879 (if cont
|
|
|
9880 (efs-call-cont cont result line cont-lines))))
|
|
|
9881 fast-nowait))) nowait)))))
|
|
|
9882
|
|
|
9883 (defun efs-rename-file-internal (filename newname ok-if-already-exists
|
|
|
9884 &optional msg cont nowait)
|
|
|
9885 ;; Internal version of rename-file for remote files.
|
|
|
9886 ;; Takes CONT and NOWAIT args.
|
|
|
9887 (let ((filename (expand-file-name filename))
|
|
|
9888 (newname (expand-file-name newname)))
|
|
|
9889 (let ((f-parsed (efs-ftp-path filename))
|
|
|
9890 (t-parsed (efs-ftp-path newname)))
|
|
|
9891 (if (null (or f-parsed t-parsed))
|
|
|
9892 (progn
|
|
|
9893 ;; local rename
|
|
|
9894 (rename-file filename newname ok-if-already-exists)
|
|
|
9895 (if cont
|
|
|
9896 (efs-call-cont cont nil "Renamed locally" "")))
|
|
|
9897
|
|
|
9898 ;; check to see if we can overwrite
|
|
|
9899 (if (or (not ok-if-already-exists)
|
|
|
9900 (numberp ok-if-already-exists))
|
|
|
9901 (efs-barf-or-query-if-file-exists
|
|
|
9902 newname "rename to it" (numberp ok-if-already-exists)))
|
|
|
9903
|
|
|
9904 (let ((f-abbr (efs-relativize-filename filename))
|
|
|
9905 (t-abbr (efs-relativize-filename newname
|
|
|
9906 (file-name-directory filename)
|
|
|
9907 filename)))
|
|
|
9908 (or msg (setq msg (format "Renaming %s to %s" f-abbr t-abbr)))
|
|
|
9909 (if f-parsed
|
|
|
9910 (let* ((f-host (car f-parsed))
|
|
|
9911 (f-user (nth 1 f-parsed))
|
|
|
9912 (f-path (nth 2 f-parsed))
|
|
|
9913 (f-host-type (efs-host-type f-host)))
|
|
|
9914 (if (and t-parsed
|
|
|
9915 (string-equal (downcase f-host)
|
|
|
9916 (downcase (car t-parsed)))
|
|
|
9917 (not (efs-get-host-property f-host 'rnfr-failed))
|
|
|
9918 (if (memq f-host-type efs-case-insensitive-host-types)
|
|
|
9919 (string-equal (downcase f-user)
|
|
|
9920 (downcase (nth 1 t-parsed)))
|
|
|
9921 (string-equal f-user (nth 1 t-parsed))))
|
|
|
9922 ;; Can run a RENAME command on the server.
|
|
|
9923 (efs-rename-on-remote
|
|
|
9924 f-host f-user filename newname f-path (nth 2 t-parsed)
|
|
|
9925 msg nowait
|
|
|
9926 (efs-cont (result line cont-lines) (f-host
|
|
|
9927 filename
|
|
|
9928 newname
|
|
|
9929 ok-if-already-exists
|
|
|
9930 msg cont nowait)
|
|
|
9931 (if result
|
|
|
9932 (progn
|
|
|
9933 (efs-set-host-property f-host 'rnfr-failed t)
|
|
|
9934 (efs-rename-file-internal
|
|
|
9935 filename newname ok-if-already-exists msg cont
|
|
|
9936 (if (eq nowait t) 1 nowait)))
|
|
|
9937 (if cont
|
|
|
9938 (efs-call-cont cont result line cont-lines)))))
|
|
|
9939 ;; remote to remote
|
|
|
9940 (efs-rename-from-remote filename f-parsed newname t-parsed
|
|
|
9941 msg cont nowait)))
|
|
|
9942 ;; local to remote
|
|
|
9943 (efs-rename-local-to-remote
|
|
|
9944 filename newname t-parsed msg cont nowait)))))))
|
|
|
9945
|
|
|
9946 (defun efs-rename-file (filename newname &optional ok-if-already-exists nowait)
|
|
|
9947 ;; Does file renaming for remote files.
|
|
|
9948 (efs-rename-file-internal filename newname ok-if-already-exists
|
|
|
9949 nil nil nowait))
|
|
|
9950
|
|
|
9951 ;;;; ------------------------------------------------------------
|
|
|
9952 ;;;; Making symbolic and hard links.
|
|
|
9953 ;;;; ------------------------------------------------------------
|
|
|
9954
|
|
|
9955 ;;; These functions require that the remote FTP server understand
|
|
|
9956 ;;; SITE EXEC and that ln is in its the ftp-exec path.
|
|
|
9957
|
|
|
9958 (defun efs-try-ln (host user cont nowait)
|
|
|
9959 ;; Do some preemptive testing to see if exec ln works
|
|
|
9960 (if (efs-get-host-property host 'exec-failed)
|
|
|
9961 (signal 'ftp-error (list "Unable to exec ln on host" host)))
|
|
|
9962 (let ((exec-ln (efs-get-host-property host 'exec-ln)))
|
|
|
9963 (cond
|
|
|
9964 ((eq exec-ln 'failed)
|
|
|
9965 (signal 'ftp-error (list "ln is not in FTP exec path on host" host)))
|
|
|
9966 ((eq exec-ln 'works)
|
|
|
9967 (efs-call-cont cont))
|
|
|
9968 (t
|
|
|
9969 (message "Checking for ln executable on %s..." host)
|
|
|
9970 (efs-send-cmd
|
|
|
9971 host user '(quote site exec "ln / /")
|
|
|
9972 nil nil
|
|
|
9973 (efs-cont (result line cont-lines) (host user cont)
|
|
|
9974 (if result
|
|
|
9975 (progn
|
|
|
9976 (efs-set-host-property host 'exec-failed t)
|
|
|
9977 (efs-error host user (format "exec: %s" line)))
|
|
|
9978 ;; Look for an error message
|
|
|
9979 (if (efs-save-match-data
|
|
|
9980 (string-match "\n200-" cont-lines))
|
|
|
9981 (progn
|
|
|
9982 (efs-set-host-property host 'exec-ln 'works)
|
|
|
9983 (efs-call-cont cont))
|
|
|
9984 (efs-set-host-property host 'exec-ln 'failed)
|
|
|
9985 (efs-error host user
|
|
|
9986 (format "ln not in FTP exec path on host %s" host)))))
|
|
|
9987 nowait)))))
|
|
|
9988
|
|
|
9989 (defun efs-make-symbolic-link-internal
|
|
|
9990 (target linkname &optional ok-if-already-exists cont nowait)
|
|
|
9991 ;; Makes remote symbolic links. Assumes that linkname is already expanded.
|
|
|
9992 (let* ((parsed (efs-ftp-path linkname))
|
|
|
9993 (host (car parsed))
|
|
|
9994 (user (nth 1 parsed))
|
|
|
9995 (linkpath (nth 2 parsed))
|
|
|
9996 (abbr (efs-relativize-filename linkname
|
|
|
9997 (file-name-directory target) target))
|
|
|
9998 (tparsed (efs-ftp-path target))
|
|
|
9999 (com-target target)
|
|
|
10000 cmd-string)
|
|
|
10001 (if (null (file-directory-p
|
|
|
10002 (file-name-directory linkname)))
|
|
|
10003 (if cont
|
|
|
10004 (efs-call-cont cont 'failed
|
|
|
10005 (format "no such file or directory, %s" linkname)
|
|
|
10006 "")
|
|
|
10007 (signal 'file-error (list "no such file or directory" linkname)))
|
|
|
10008 (if (or (not ok-if-already-exists)
|
|
|
10009 (numberp ok-if-already-exists))
|
|
|
10010 (efs-barf-or-query-if-file-exists
|
|
|
10011 linkname "make symbolic link" (numberp ok-if-already-exists)))
|
|
|
10012 ;; Do this after above, so that hopefully the host type is sorted out
|
|
|
10013 ;; by now.
|
|
|
10014 (let ((host-type (efs-host-type host)))
|
|
|
10015 (if (or (not (memq host-type efs-unix-host-types))
|
|
|
10016 (memq host-type efs-dumb-host-types)
|
|
|
10017 (efs-get-host-property host 'exec-failed))
|
|
|
10018 (error "Unable to make symbolic links on %s." host)))
|
|
|
10019 ;; Be careful not to spoil relative links, or symlinks to other
|
|
|
10020 ;; machines, which maybe symlink-fix.el can sort out.
|
|
|
10021 (if (and tparsed
|
|
|
10022 (string-equal (downcase (car tparsed)) (downcase host))
|
|
|
10023 (string-equal (nth 1 tparsed) user))
|
|
|
10024 (setq com-target (nth 2 tparsed)))
|
|
|
10025 ;; symlinks only work for unix, so don't need to
|
|
|
10026 ;; convert pathnames. What about VOS?
|
|
|
10027 (setq cmd-string (concat "ln -sf " com-target " " linkpath))
|
|
|
10028 (efs-try-ln
|
|
|
10029 host user
|
|
|
10030 (efs-cont () (host user cmd-string target linkname com-target
|
|
|
10031 abbr cont nowait)
|
|
|
10032 (efs-send-cmd
|
|
|
10033 host user (list 'quote 'site 'exec cmd-string)
|
|
|
10034 (format "Symlinking %s to %s" target abbr)
|
|
|
10035 nil
|
|
|
10036 (efs-cont (result line cont-lines) (host user com-target linkname
|
|
|
10037 cont)
|
|
|
10038 (if result
|
|
|
10039 (progn
|
|
|
10040 (efs-set-host-property host 'exec-failed t)
|
|
|
10041 (efs-error host user (format "exec: %s" line)))
|
|
|
10042 (efs-save-match-data
|
|
|
10043 (if (string-match "\n200-\\([^\n]*\\)" cont-lines)
|
|
|
10044 (let ((err (substring cont-lines (match-beginning 1)
|
|
|
10045 (match-end 1))))
|
|
|
10046 (if cont
|
|
|
10047 (efs-call-cont cont 'failed err cont-lines)
|
|
|
10048 (efs-error host user err)))
|
|
|
10049 (efs-add-file-entry nil linkname com-target nil user)
|
|
|
10050 (if cont (efs-call-cont cont nil line cont-lines))))))
|
|
|
10051 nowait))
|
|
|
10052 nowait))))
|
|
|
10053
|
|
|
10054 (defun efs-make-symbolic-link (target linkname &optional ok-if-already-exists)
|
|
|
10055 ;; efs version of make-symbolic-link
|
|
|
10056 (let* ((linkname (expand-file-name linkname))
|
|
|
10057 (parsed (efs-ftp-path linkname)))
|
|
|
10058 (if parsed
|
|
|
10059 (efs-make-symbolic-link-internal target linkname ok-if-already-exists)
|
|
|
10060 ;; Handler will match on either target or linkname. We are only
|
|
|
10061 ;; interested in the linkname.
|
|
|
10062 (let ((file-name-handler-alist (efs-file-name-handler-alist-sans-fn
|
|
|
10063 'efs-file-handler-function)))
|
|
|
10064 (make-symbolic-link target linkname ok-if-already-exists)))))
|
|
|
10065
|
|
|
10066 (defun efs-add-name-to-file-internal
|
|
|
10067 (file newname &optional ok-if-already-exists cont nowait)
|
|
|
10068 ;; Makes remote symbolic links. Assumes that linkname is already expanded.
|
|
|
10069 (let* ((parsed (efs-ftp-path file))
|
|
|
10070 (host (car parsed))
|
|
|
10071 (user (nth 1 parsed))
|
|
|
10072 (path (nth 2 parsed))
|
|
|
10073 (nparsed (efs-ftp-path newname))
|
|
|
10074 (nhost (car nparsed))
|
|
|
10075 (nuser (nth 1 nparsed))
|
|
|
10076 (npath (nth 2 nparsed))
|
|
|
10077 (abbr (efs-relativize-filename newname
|
|
|
10078 (file-name-directory file)))
|
|
|
10079 (ent (efs-get-file-entry file))
|
|
|
10080 cmd-string)
|
|
|
10081 (or (and (string-equal (downcase host) (downcase nhost))
|
|
|
10082 (string-equal user nuser))
|
|
|
10083 (error "Cannot create hard links between different host user pairs."))
|
|
|
10084 (if (or (null ent) (stringp (car ent))
|
|
|
10085 (not (file-directory-p
|
|
|
10086 (file-name-directory newname))))
|
|
|
10087 (if cont
|
|
|
10088 (efs-call-cont cont 'failed
|
|
|
10089 (format "no such file or directory, %s %s"
|
|
|
10090 file newname) "")
|
|
|
10091 (signal 'file-error
|
|
|
10092 (list "no such file or directory"
|
|
|
10093 file newname)))
|
|
|
10094 (if (or (not ok-if-already-exists)
|
|
|
10095 (numberp ok-if-already-exists))
|
|
|
10096 (efs-barf-or-query-if-file-exists
|
|
|
10097 newname "make hard link" (numberp ok-if-already-exists)))
|
|
|
10098 ;; Do this last, so that hopefully the host type is known.
|
|
|
10099 (let ((host-type (efs-host-type host)))
|
|
|
10100 (if (or (not (memq host-type efs-unix-host-types))
|
|
|
10101 (memq host-type efs-dumb-host-types)
|
|
|
10102 (efs-get-host-property host 'exec-failed))
|
|
|
10103 (error "Unable to make hard links on %s." host)))
|
|
|
10104 (setq cmd-string (concat "ln -f " path " " npath))
|
|
|
10105 (efs-try-ln
|
|
|
10106 host user
|
|
|
10107 (efs-cont () (host user cmd-string file newname abbr cont nowait)
|
|
|
10108 (efs-send-cmd
|
|
|
10109 host user (list 'quote 'site 'exec cmd-string)
|
|
|
10110 (format "Adding to %s name %s" file abbr)
|
|
|
10111 nil
|
|
|
10112 (efs-cont (result line cont-lines) (host user file newname cont)
|
|
|
10113 (if result
|
|
|
10114 (progn
|
|
|
10115 (efs-set-host-property host 'exec-failed t)
|
|
|
10116 (efs-error host user (format "exec: %s" line)))
|
|
|
10117 (efs-save-match-data
|
|
|
10118 (if (string-match "\n200-\\([^\n]*\\)" cont-lines)
|
|
|
10119 (let ((err (substring cont-lines (match-beginning 1)
|
|
|
10120 (match-end 1))))
|
|
|
10121 (if cont
|
|
|
10122 (efs-call-cont cont 'failed err cont-lines)
|
|
|
10123 (efs-error host user err)))
|
|
|
10124 (let ((ent (efs-get-file-entry file)))
|
|
|
10125 (if ent
|
|
|
10126 (let ((nlinks (nthcdr 4 ent))
|
|
|
10127 new-nlinks)
|
|
|
10128 (and (integerp (car nlinks))
|
|
|
10129 (setq new-nlinks (1+ (car nlinks)))
|
|
|
10130 (setcar nlinks new-nlinks))
|
|
|
10131 (apply 'efs-add-file-entry nil newname ent)
|
|
|
10132 (if cont (efs-call-cont cont nil line cont-lines)))
|
|
|
10133 (let ((tbl (efs-get-files-hashtable-entry
|
|
|
10134 (file-name-directory
|
|
|
10135 (directory-file-name newname)))))
|
|
|
10136 (if tbl
|
|
|
10137 (efs-ls
|
|
|
10138 newname
|
|
|
10139 (concat (efs-ls-guess-switches) "d") t t nil
|
|
|
10140 nowait
|
|
|
10141 (efs-cont (listing) (newname cont line cont-lines)
|
|
|
10142 (efs-update-file-info
|
|
|
10143 newname efs-data-buffer-name)
|
|
|
10144 (if cont
|
|
|
10145 (efs-call-cont cont nil line cont-lines))))
|
|
|
10146 (if cont
|
|
|
10147 (efs-call-cont cont nil line cont-lines))))))))))
|
|
|
10148 nowait))
|
|
|
10149 nowait))))
|
|
|
10150
|
|
|
10151 (defun efs-add-name-to-file (file newname &optional ok-if-already-exists)
|
|
|
10152 ;; efs version of add-name-to-file
|
|
|
10153 (efs-add-name-to-file-internal file newname ok-if-already-exists))
|
|
|
10154
|
|
|
10155
|
|
|
10156 ;;;; ==============================================================
|
|
|
10157 ;;;; >9
|
|
|
10158 ;;;; Multiple Host Type Support.
|
|
|
10159 ;;;; The initial host type guessing is done in the PWD code below.
|
|
|
10160 ;;;; If necessary, further guessing is done in the listing parser.
|
|
|
10161 ;;;; ==============================================================
|
|
|
10162
|
|
|
10163
|
|
|
10164 ;;;; --------------------------------------------------------------
|
|
|
10165 ;;;; Functions for setting and retrieving host types.
|
|
|
10166 ;;;; --------------------------------------------------------------
|
|
|
10167
|
|
|
10168 (defun efs-add-host (type host)
|
|
|
10169 "Sets the TYPE of the remote host HOST.
|
|
|
10170 The host type is read with completion so this can be used to obtain a
|
|
|
10171 list of supported host types. HOST must be a string, giving the name of
|
|
|
10172 the host, exactly as given in file names. Setting the host type with
|
|
|
10173 this function is preferable to setting the efs-TYPE-host-regexp, as look up
|
|
|
10174 will be faster. Returns TYPE."
|
|
|
10175 ;; Since internet host names are always case-insensitive, we will cache
|
|
|
10176 ;; them in lower case.
|
|
|
10177 (interactive
|
|
|
10178 (list
|
|
|
10179 (intern
|
|
|
10180 (completing-read "Host type: "
|
|
|
10181 (mapcar
|
|
|
10182 (function (lambda (elt)
|
|
|
10183 (list (symbol-name (car elt)))))
|
|
|
10184 efs-host-type-alist)
|
|
|
10185 nil t))
|
|
|
10186 (read-string "Host: "
|
|
|
10187 (let ((name (or (buffer-file-name)
|
|
|
10188 (and (eq major-mode 'dired-mode)
|
|
|
10189 dired-directory))))
|
|
|
10190 (and name (car (efs-ftp-path name)))))))
|
|
|
10191 (setq host (downcase host))
|
|
|
10192 (efs-set-host-property host 'host-type type)
|
|
|
10193 (prog1
|
|
|
10194 (setq efs-host-cache host
|
|
|
10195 efs-host-type-cache type)
|
|
|
10196 (efs-set-process-host-type host)))
|
|
|
10197
|
|
|
10198 (defun efs-set-process-host-type (host &optional user)
|
|
|
10199 ;; Sets the value of efs-process-host-type so that it is shown
|
|
|
10200 ;; on the mode-line.
|
|
|
10201 (let ((buff-list (buffer-list)))
|
|
|
10202 (save-excursion
|
|
|
10203 (while buff-list
|
|
|
10204 (set-buffer (car buff-list))
|
|
|
10205 (if (equal efs-process-host host)
|
|
|
10206 (setq efs-process-host-type (concat " " (symbol-name
|
|
|
10207 (efs-host-type host))))
|
|
|
10208 (and efs-show-host-type-in-dired
|
|
|
10209 (eq major-mode 'dired-mode)
|
|
|
10210 efs-dired-host-type
|
|
|
10211 (string-equal (downcase
|
|
|
10212 (car (efs-ftp-path default-directory)))
|
|
|
10213 (downcase host))
|
|
|
10214 (if user
|
|
|
10215 (setq efs-dired-listing-type-string
|
|
|
10216 (concat
|
|
|
10217 " "
|
|
|
10218 (symbol-name (efs-listing-type host user))))
|
|
|
10219 (or efs-dired-listing-type-string
|
|
|
10220 (setq efs-dired-listing-type-string
|
|
|
10221 (concat " " (symbol-name (efs-host-type host))))))))
|
|
|
10222 (setq buff-list (cdr buff-list))))))
|
|
|
10223
|
|
|
10224 ;;;; ----------------------------------------------------------------
|
|
|
10225 ;;;; Functions for setting and retrieving listings types.
|
|
|
10226 ;;;; ----------------------------------------------------------------
|
|
|
10227
|
|
|
10228 ;;; listing types??
|
|
|
10229 ;;; These are distinguished from host types, in case some OS's have two
|
|
|
10230 ;;; breeds of listings. e.g. Unix descriptive listings.
|
|
|
10231 ;;; We also use this to support the myriad of DOS ftp servers.
|
|
|
10232
|
|
|
10233
|
|
|
10234 (defun efs-listing-type (host user)
|
|
|
10235 "Returns the type of listing used on HOST by USER.
|
|
|
10236 If there is no entry for a specialized listing, returns the host type."
|
|
|
10237 (or
|
|
|
10238 (efs-get-host-user-property host user 'listing-type)
|
|
|
10239 (efs-host-type host user)))
|
|
|
10240
|
|
|
10241 (defun efs-add-listing-type (type host user)
|
|
|
10242 "Interactively adds the specialized listing type TYPE for HOST and USER
|
|
|
10243 to the listing type cache."
|
|
|
10244 (interactive
|
|
|
10245 (let ((name (or (buffer-file-name)
|
|
|
10246 (and (eq major-mode 'dired-mode)
|
|
|
10247 dired-directory))))
|
|
|
10248 (list
|
|
|
10249 (intern
|
|
|
10250 (completing-read "Listing type: "
|
|
|
10251 (mapcar
|
|
|
10252 (function (lambda (elt)
|
|
|
10253 (list (symbol-name elt))))
|
|
|
10254 efs-listing-types)
|
|
|
10255 nil t))
|
|
|
10256 (read-string "Host: "
|
|
|
10257 (and name (car (efs-ftp-path name))))
|
|
|
10258 (read-string "User: "
|
|
|
10259 (and name (nth 1 (efs-ftp-path name)))))))
|
|
|
10260 (efs-set-host-user-property host user 'listing-type type)
|
|
|
10261 (efs-set-process-host-type host user))
|
|
|
10262
|
|
|
10263 ;;;; --------------------------------------------------------------
|
|
|
10264 ;;;; Auotomagic bug reporting for unrecognized host types.
|
|
|
10265 ;;;; --------------------------------------------------------------
|
|
|
10266
|
|
|
10267 (defun efs-scream-and-yell-1 (host user)
|
|
|
10268 ;; Internal for efs-scream-and-yell.
|
|
|
10269 (with-output-to-temp-buffer "*Help*"
|
|
|
10270 (princ
|
|
|
10271 (format
|
|
|
10272 "efs is unable to identify the remote host type of %s.
|
|
|
10273
|
|
|
10274 Please report this as a bug. It would be very helpful
|
|
|
10275 if your bug report contained at least the PWD command
|
|
|
10276 within the *ftp %s@%s* buffer.
|
|
|
10277 If you know them, also send the operating system
|
|
|
10278 and ftp server types of the remote host." host user host)))
|
|
|
10279 (if (y-or-n-p "Would you like to submit a bug report now? ")
|
|
|
10280 (efs-report-bug host user
|
|
|
10281 "Bug occurred during efs-guess-host-type." t)))
|
|
|
10282
|
|
|
10283 (defun efs-scream-and-yell (host user)
|
|
|
10284 ;; Advertises that something has gone wrong in identifying the host type.
|
|
|
10285 (if (eq (selected-window) (minibuffer-window))
|
|
|
10286 (efs-abort-recursive-edit-and-then 'efs-scream-and-yell-1 host user)
|
|
|
10287 (efs-scream-and-yell-1 host user)
|
|
|
10288 (error "Unable to identify remote host type")))
|
|
|
10289
|
|
|
10290 ;;;; --------------------------------------------------------
|
|
|
10291 ;;;; Guess at the host type using PWD syntax.
|
|
|
10292 ;;;; --------------------------------------------------------
|
|
|
10293
|
|
|
10294 ;; host-type path templates. These should match a pwd performed
|
|
|
10295 ;; as the first command after connecting. They should be as tight
|
|
|
10296 ;; as possible
|
|
|
10297
|
|
|
10298 (defconst efs-unix-path-template "^/")
|
|
|
10299 (defconst efs-apollo-unix-path-template "^//")
|
|
|
10300 (defconst efs-cms-path-template
|
|
|
10301 (concat
|
|
|
10302 "^[-A-Z0-9$*][-A-Z0-9$*]?[-A-Z0-9$*]?[-A-Z0-9$*]?[-A-Z0-9$*]?"
|
|
|
10303 "[-A-Z0-9$*]?[-A-Z0-9$*]?[-A-Z0-9$*]?\\.[0-9][0-9][0-9A-Z]$\\|"
|
|
|
10304 ;; For the SFS version of CMS
|
|
|
10305 "^[-A-Z0-9]+:[-A-Z0-9$*]+\\.$"))
|
|
|
10306
|
|
|
10307 (defconst efs-mvs-path-template "^'?[A-Z][0-9][0-9]?[0-9]?[0-9]?[0-9]?\\.'?")
|
|
|
10308
|
|
|
10309 (defconst efs-guardian-path-template
|
|
|
10310 (concat
|
|
|
10311 "^\\("
|
|
|
10312 "\\\\[A-Z0-9][A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?\\."
|
|
|
10313 "\\)?"
|
|
|
10314 "\\$[A-Z0-9][A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?\\."
|
|
|
10315 "[A-Z][A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?$"))
|
|
|
10316 ;; guardian and cms are very close to overlapping (they don't). Be careful.
|
|
|
10317 (defconst efs-vms-path-template
|
|
|
10318 "^[-A-Z0-9_$]+:\\[[-A-Z0-9_$]+\\(\\.[-A-Z0-9_$]+\\)*\\]$")
|
|
|
10319 (defconst efs-mts-path-template
|
|
|
10320 "^[A-Z0-9._][A-Z0-9._][A-Z0-9._][A-Z0-9._]:$")
|
|
|
10321 (defconst efs-ms-unix-path-template "^[A-Za-z0-9]:/")
|
|
|
10322
|
|
|
10323 ;; Following two are for TI lisp machines. Note that lisp machines
|
|
|
10324 ;; do not have a default directory, but only a default pathname against
|
|
|
10325 ;; which relative pathnames are merged (Jamie tells me).
|
|
|
10326 (defconst efs-ti-explorer-pwd-line-template
|
|
|
10327 (let* ((excluded-chars ":;<>.#\n\r\t\\/a-z ")
|
|
|
10328 (token (concat "[^" excluded-chars "]+")))
|
|
|
10329 (concat "^250 "
|
|
|
10330 token ": " ; host name
|
|
|
10331 token "\\(\\." token "\\)*; " ; directory
|
|
|
10332 "\\(\\*.\\*\\|\\*\\)#\\(\\*\\|>\\)" ; name, ext, version
|
|
|
10333 "$"))) ; "*.*#*" or "*.*#>" or "*#*" or "*#>" or "#*" ...
|
|
|
10334 (defconst efs-ti-twenex-path-template
|
|
|
10335 (let* ((excluded-chars ":;<>.#\n\r\t\\/a-z ")
|
|
|
10336 (token (concat "[^" excluded-chars "]+")))
|
|
|
10337 (concat "^"
|
|
|
10338 token ":" ; host name
|
|
|
10339 "<\\(" token "\\)?\\(\\." token "\\)*>" ; directory
|
|
|
10340 "\\(\\*.\\*\\|\\*\\)" ; name and extension
|
|
|
10341 "$")))
|
|
|
10342
|
|
|
10343 (defconst efs-tops-20-path-template
|
|
|
10344 "^[-A-Z0-9_$]+:<[-A-Z0-9_$]\\(.[-A-Z0-9_$]+\\)*>$")
|
|
|
10345 (defconst efs-pc-path-template
|
|
|
10346 "^[a-zA-Z0-9]:\\\\\\([-_+=a-zA-Z0-9.]+\\\\\\)*[-_+=a-zA-Z0-9.]*$")
|
|
|
10347 (defconst efs-mpe-path-template
|
|
|
10348 (let ((token (concat "[A-Z][A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?"
|
|
|
10349 "[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?")))
|
|
|
10350 (concat
|
|
|
10351 ;; optional session name
|
|
|
10352 "^\\(" token "\\)?,"
|
|
|
10353 ;; username
|
|
|
10354 token "."
|
|
|
10355 ;; account
|
|
|
10356 token ","
|
|
|
10357 ;; group
|
|
|
10358 token "$")))
|
|
|
10359 (defconst efs-vos-path-template
|
|
|
10360 (let ((token "[][@\\^`{}|~\"$+,---./:_a-zA-Z0-9]+"))
|
|
|
10361 (concat
|
|
|
10362 "%" token ; host
|
|
|
10363 "#" token ; disk
|
|
|
10364 "\\(>" token "\\)+" ; directories
|
|
|
10365 )))
|
|
|
10366 (defconst efs-netware-path-template "^[-A-Z0-9_][-A-Z0-9_/]*:/")
|
|
|
10367 ;; Sometimes netware doesn't return a device to a PWD. Then it will be
|
|
|
10368 ;; recognized by the listing parser.
|
|
|
10369
|
|
|
10370 (defconst efs-nos-ve-path-template "^:[A-Z0-9]")
|
|
|
10371 ;; Matches the path for NOS/VE
|
|
|
10372
|
|
|
10373 (defconst efs-mvs-pwd-line-template
|
|
|
10374 ;; Not sure how the PWD parser will do with empty strings, so treate
|
|
|
10375 ;; this as a line regexp.
|
|
|
10376 "^257 \\([Nn]o prefix defined\\|\"\" is working directory\\)")
|
|
|
10377 (defconst efs-cms-pwd-line-template
|
|
|
10378 "^450 No current working directory defined$")
|
|
|
10379 (defconst efs-tops-20-pwd-line-template
|
|
|
10380 "^500 I never heard of the \\(XPWD\\|PWD\\) command\\. Try HELP\\.$")
|
|
|
10381 (defconst efs-dos:ftp-pwd-line-template
|
|
|
10382 "^250 Current working directory is +")
|
|
|
10383 (defconst efs-coke-pwd-line-template "^257 Current balance \\$[0-9]")
|
|
|
10384
|
|
|
10385 (defconst efs-super-dumb-unix-tilde-regexp
|
|
|
10386 "^550 /.*: No such file or directory\\.?$")
|
|
|
10387 (defconst efs-cms-knet-tilde-regexp
|
|
|
10388 "^501 Invalid CMS fileid: ~$")
|
|
|
10389
|
|
|
10390
|
|
|
10391 ;; It might be nice to message users about the host type identified,
|
|
|
10392 ;; but there is so much other messaging going on, it would not be
|
|
|
10393 ;; seen. No point in slowing things down just so users can read
|
|
|
10394 ;; a host type message.
|
|
|
10395
|
|
|
10396 (defun efs-guess-host-type (host user)
|
|
|
10397 "Guess the host type of HOST.
|
|
|
10398 Does a PWD and examines the directory syntax. The PWD is then cached for use
|
|
|
10399 in file name expansion."
|
|
|
10400 (let ((host-type (efs-host-type host))
|
|
|
10401 (key (concat host "/" user "/~"))
|
|
|
10402 syst)
|
|
|
10403 (efs-save-match-data
|
|
|
10404 (if (eq host-type 'unknown)
|
|
|
10405 ;; Note that efs-host-type returns unknown as the default.
|
|
|
10406 ;; Since we don't yet know the host-type, we use the default
|
|
|
10407 ;; version of efs-send-pwd. We compensate if necessary
|
|
|
10408 ;; by looking at the entire line of output.
|
|
|
10409 (let* ((result (efs-send-pwd nil host user))
|
|
|
10410 (dir (car result))
|
|
|
10411 (line (cdr result)))
|
|
|
10412 (cond
|
|
|
10413
|
|
|
10414 ;; First sift through process lines to see if we recognize
|
|
|
10415 ;; any pwd errors, or full line messages.
|
|
|
10416
|
|
|
10417 ;; CMS
|
|
|
10418 ((string-match efs-cms-pwd-line-template line)
|
|
|
10419 (setq host-type (efs-add-host 'cms host)
|
|
|
10420 dir (concat "/" (if (> (length user) 8)
|
|
|
10421 (substring user 0 8)
|
|
|
10422 user)
|
|
|
10423 ".191"))
|
|
|
10424 (message
|
|
|
10425 "Unable to determine a \"home\" CMS minidisk. Assuming %s"
|
|
|
10426 dir)
|
|
|
10427 (sit-for 1))
|
|
|
10428
|
|
|
10429 ;; TOPS-20
|
|
|
10430 ((string-match efs-tops-20-pwd-line-template line)
|
|
|
10431 (setq host-type (efs-add-host 'tops-20 host)
|
|
|
10432 dir (car (efs-send-pwd 'tops-20 host user))))
|
|
|
10433
|
|
|
10434 ;; TI-EXPLORER lisp machine. pwd works here, but the output
|
|
|
10435 ;; needs to be specially parsed since spaces separate
|
|
|
10436 ;; hostnames from dirs from filenames.
|
|
|
10437 ((string-match efs-ti-explorer-pwd-line-template line)
|
|
|
10438 (setq host-type (efs-add-host 'ti-explorer host)
|
|
|
10439 dir (substring line 4)))
|
|
|
10440
|
|
|
10441 ;; FTP Software's DOS Server
|
|
|
10442 ((string-match efs-dos:ftp-pwd-line-template line)
|
|
|
10443 (setq host-type (efs-add-host 'dos host)
|
|
|
10444 dir (substring line (match-end 0)))
|
|
|
10445 (efs-add-listing-type 'dos:ftp host user))
|
|
|
10446
|
|
|
10447 ;; MVS
|
|
|
10448 ((string-match efs-mvs-pwd-line-template line)
|
|
|
10449 (setq host-type (efs-add-host 'mvs host)
|
|
|
10450 dir "")) ; "" will convert to /, which is always
|
|
|
10451 ; the mvs home dir.
|
|
|
10452
|
|
|
10453 ;; COKE
|
|
|
10454 ((string-match efs-coke-pwd-line-template line)
|
|
|
10455 (setq host-type (efs-add-host 'coke host)
|
|
|
10456 dir "/"))
|
|
|
10457
|
|
|
10458 ;; Try to get tilde.
|
|
|
10459 ((null dir)
|
|
|
10460 (let ((tilde (nth 1 (efs-send-cmd
|
|
|
10461 host user (list 'get "~" "/dev/null")))))
|
|
|
10462 (cond
|
|
|
10463 ;; super dumb unix
|
|
|
10464 ((string-match efs-super-dumb-unix-tilde-regexp tilde)
|
|
|
10465 (setq dir (car (efs-send-pwd 'super-dumb-unix host user))
|
|
|
10466 host-type (efs-add-host 'super-dumb-unix host)))
|
|
|
10467
|
|
|
10468 ;; Try for cms-knet
|
|
|
10469 ((string-match efs-cms-knet-tilde-regexp tilde)
|
|
|
10470 (setq dir (car (efs-send-pwd 'cms-knet host user))
|
|
|
10471 host-type (efs-add-host 'cms-knet host)))
|
|
|
10472
|
|
|
10473 ;; We don't know. Scream and yell.
|
|
|
10474 (efs-scream-and-yell host user))))
|
|
|
10475
|
|
|
10476 ;; Now look at dir to determine host type
|
|
|
10477
|
|
|
10478 ;; try for UN*X-y type stuff
|
|
|
10479 ((string-match efs-unix-path-template dir)
|
|
|
10480 (if
|
|
|
10481 ;; Check for apollo, so we know not to short-circuit //.
|
|
|
10482 (string-match efs-apollo-unix-path-template dir)
|
|
|
10483 (progn
|
|
|
10484 (setq host-type (efs-add-host 'apollo-unix host))
|
|
|
10485 (efs-add-listing-type 'unix:unknown host user))
|
|
|
10486 ;; could be ka9q, dos-distinct, plus any of the unix breeds,
|
|
|
10487 ;; except apollo.
|
|
|
10488 (if (setq syst (efs-get-syst host user))
|
|
|
10489 (let ((case-fold-search t))
|
|
|
10490 (cond
|
|
|
10491 ((string-match "\\bNetware\\b" syst)
|
|
|
10492 (setq host-type (efs-add-host 'netware host)))
|
|
|
10493 ((string-match "^Plan 9" syst)
|
|
|
10494 (setq host-type (efs-add-host 'plan9 host)))
|
|
|
10495 ((string-match "^UNIX" syst)
|
|
|
10496 (setq host-type (efs-add-host 'unix host))
|
|
|
10497 (efs-add-listing-type 'unix:unknown host user)))))))
|
|
|
10498
|
|
|
10499 ;; try for VMS
|
|
|
10500 ((string-match efs-vms-path-template dir)
|
|
|
10501 (setq host-type (efs-add-host 'vms host)))
|
|
|
10502
|
|
|
10503 ;; try for MTS
|
|
|
10504 ((string-match efs-mts-path-template dir)
|
|
|
10505 (setq host-type (efs-add-host 'mts host)))
|
|
|
10506
|
|
|
10507 ;; try for CMS
|
|
|
10508 ((string-match efs-cms-path-template dir)
|
|
|
10509 (setq host-type (efs-add-host 'cms host)))
|
|
|
10510
|
|
|
10511 ;; try for Tandem's guardian OS
|
|
|
10512 ((string-match efs-guardian-path-template dir)
|
|
|
10513 (setq host-type (efs-add-host 'guardian host)))
|
|
|
10514
|
|
|
10515 ;; Try for TOPS-20. pwd doesn't usually work for tops-20
|
|
|
10516 ;; But who knows???
|
|
|
10517 ((string-match efs-tops-20-path-template dir)
|
|
|
10518 (setq host-type (efs-add-host 'tops-20 host)))
|
|
|
10519
|
|
|
10520 ;; Try for DOS or OS/2.
|
|
|
10521 ((string-match efs-pc-path-template dir)
|
|
|
10522 (let ((syst (efs-get-syst host user))
|
|
|
10523 (case-fold-search t))
|
|
|
10524 (if (and syst (string-match "^OS/2 " syst))
|
|
|
10525 (setq host-type (efs-add-host 'os2 host))
|
|
|
10526 (setq host-type (efs-add-host 'dos host)))))
|
|
|
10527
|
|
|
10528 ;; try for TI-TWENEX lisp machine
|
|
|
10529 ((string-match efs-ti-twenex-path-template dir)
|
|
|
10530 (setq host-type (efs-add-host 'ti-twenex host)))
|
|
|
10531
|
|
|
10532 ;; try for MPE
|
|
|
10533 ((string-match efs-mpe-path-template dir)
|
|
|
10534 (setq host-type (efs-add-host 'mpe host)))
|
|
|
10535
|
|
|
10536 ;; try for VOS
|
|
|
10537 ((string-match efs-vos-path-template dir)
|
|
|
10538 (setq host-type (efs-add-host 'vos host)))
|
|
|
10539
|
|
|
10540 ;; try for the microsoft server in unix mode
|
|
|
10541 ((string-match efs-ms-unix-path-template dir)
|
|
|
10542 (setq host-type (efs-add-host 'ms-unix host)))
|
|
|
10543
|
|
|
10544 ;; Netware?
|
|
|
10545 ((string-match efs-netware-path-template dir)
|
|
|
10546 (setq host-type (efs-add-host 'netware host)))
|
|
|
10547
|
|
|
10548 ;; Try for MVS
|
|
|
10549 ((string-match efs-mvs-path-template dir)
|
|
|
10550 (if (string-match "^'.+'$" dir)
|
|
|
10551 ;; broken MVS PWD quoting
|
|
|
10552 (setq dir (substring dir 1 -1)))
|
|
|
10553 (setq host-type (efs-add-host 'mvs host)))
|
|
|
10554
|
|
|
10555 ;; Try for NOS/VE
|
|
|
10556 ((string-match efs-nos-ve-path-template dir)
|
|
|
10557 (setq host-type (efs-add-host 'nos-ve host)))
|
|
|
10558
|
|
|
10559 ;; We don't know. Scream and yell.
|
|
|
10560 (t
|
|
|
10561 (efs-scream-and-yell host user)))
|
|
|
10562
|
|
|
10563 ;; Now that we have done a pwd, might as well put it in
|
|
|
10564 ;; the expand-dir hashtable.
|
|
|
10565 (if dir
|
|
|
10566 (efs-put-hash-entry
|
|
|
10567 key
|
|
|
10568 (efs-internal-directory-file-name
|
|
|
10569 (efs-fix-path host-type dir 'reverse))
|
|
|
10570 efs-expand-dir-hashtable
|
|
|
10571 (memq host-type efs-case-insensitive-host-types))))
|
|
|
10572
|
|
|
10573 ;; host-type has been identified by regexp, set the mode-line.
|
|
|
10574 (efs-set-process-host-type host user)
|
|
|
10575
|
|
|
10576 ;; Some special cases, where we need to store the cwd on login.
|
|
|
10577 (if (not (efs-hash-entry-exists-p
|
|
|
10578 key efs-expand-dir-hashtable))
|
|
|
10579 (cond
|
|
|
10580 ;; CMS: We will be doing cd's, so we'd better make sure that
|
|
|
10581 ;; we know where home is.
|
|
|
10582 ((eq host-type 'cms)
|
|
|
10583 (let* ((res (efs-send-pwd 'cms host user))
|
|
|
10584 (dir (car res))
|
|
|
10585 (line (cdr res)))
|
|
|
10586 (if (and dir (not (string-match
|
|
|
10587 efs-cms-pwd-line-template line)))
|
|
|
10588 (setq dir (concat "/" dir))
|
|
|
10589 (setq dir (concat "/" (if (> (length user) 8)
|
|
|
10590 (substring user 0 8)
|
|
|
10591 user)
|
|
|
10592 ".191"))
|
|
|
10593 (message
|
|
|
10594 "Unable to determine a \"home\" CMS minidisk. Assuming %s"
|
|
|
10595 dir))
|
|
|
10596 (efs-put-hash-entry
|
|
|
10597 key dir efs-expand-dir-hashtable
|
|
|
10598 (memq 'cms efs-case-insensitive-host-types))))
|
|
|
10599 ;; MVS: pwd doesn't work in the root directory, so we stuff this
|
|
|
10600 ;; into the hashtable manually.
|
|
|
10601 ((eq host-type 'mvs)
|
|
|
10602 (efs-put-hash-entry key "/" efs-expand-dir-hashtable))
|
|
|
10603 ))))))
|
|
|
10604
|
|
|
10605
|
|
|
10606 ;;;; -----------------------------------------------------------
|
|
|
10607 ;;;; efs-autoloads
|
|
|
10608 ;;;; These provide the entry points for the non-unix packages.
|
|
|
10609 ;;;; -----------------------------------------------------------
|
|
|
10610
|
|
|
10611 (efs-autoload 'efs-fix-path vms "efs-vms")
|
|
|
10612 (efs-autoload 'efs-fix-path mts "efs-mts")
|
|
|
10613 (efs-autoload 'efs-fix-path cms "efs-cms")
|
|
|
10614 (efs-autoload 'efs-fix-path ti-explorer "efs-ti-explorer")
|
|
|
10615 (efs-autoload 'efs-fix-path ti-twenex "efs-ti-twenex")
|
|
|
10616 (efs-autoload 'efs-fix-path dos "efs-pc")
|
|
|
10617 (efs-autoload 'efs-fix-path mvs "efs-mvs")
|
|
|
10618 (efs-autoload 'efs-fix-path tops-20 "efs-tops-20")
|
|
|
10619 (efs-autoload 'efs-fix-path mpe "efs-mpe")
|
|
|
10620 (efs-autoload 'efs-fix-path os2 "efs-pc")
|
|
|
10621 (efs-autoload 'efs-fix-path vos "efs-vos")
|
|
|
10622 (efs-autoload 'efs-fix-path ms-unix "efs-ms-unix")
|
|
|
10623 (efs-autoload 'efs-fix-path netware "efs-netware")
|
|
|
10624 (efs-autoload 'efs-fix-path cms-knet "efs-cms-knet")
|
|
|
10625 (efs-autoload 'efs-fix-path guardian "efs-guardian")
|
|
|
10626 (efs-autoload 'efs-fix-path nos-ve "efs-nos-ve")
|
|
|
10627
|
|
|
10628 (efs-autoload 'efs-fix-dir-path vms "efs-vms")
|
|
|
10629 (efs-autoload 'efs-fix-dir-path mts "efs-mts")
|
|
|
10630 (efs-autoload 'efs-fix-dir-path cms "efs-cms")
|
|
|
10631 (efs-autoload 'efs-fix-dir-path ti-explorer "efs-ti-explorer")
|
|
|
10632 (efs-autoload 'efs-fix-dir-path ti-twenex "efs-ti-twenex")
|
|
|
10633 (efs-autoload 'efs-fix-dir-path dos "efs-pc")
|
|
|
10634 (efs-autoload 'efs-fix-dir-path mvs "efs-mvs")
|
|
|
10635 (efs-autoload 'efs-fix-dir-path tops-20 "efs-tops-20")
|
|
|
10636 (efs-autoload 'efs-fix-dir-path mpe "efs-mpe")
|
|
|
10637 (efs-autoload 'efs-fix-dir-path os2 "efs-pc")
|
|
|
10638 (efs-autoload 'efs-fix-dir-path vos "efs-vos")
|
|
|
10639 (efs-autoload 'efs-fix-dir-path hell "efs-hell")
|
|
|
10640 (efs-autoload 'efs-fix-dir-path ms-unix "efs-ms-unix")
|
|
|
10641 (efs-autoload 'efs-fix-dir-path netware "efs-netware")
|
|
|
10642 (efs-autoload 'efs-fix-dir-path plan9 "efs-plan9")
|
|
|
10643 (efs-autoload 'efs-fix-dir-path cms-knet "efs-cms-knet")
|
|
|
10644 (efs-autoload 'efs-fix-dir-path guardian "efs-guardian")
|
|
|
10645 (efs-autoload 'efs-fix-dir-path nos-ve "efs-nos-ve")
|
|
|
10646 (efs-autoload 'efs-fix-dir-path coke "efs-coke")
|
|
|
10647
|
|
|
10648 ;; A few need to autoload a pwd function
|
|
|
10649 (efs-autoload 'efs-send-pwd tops-20 "efs-tops-20")
|
|
|
10650 (efs-autoload 'efs-send-pwd cms-knet "efs-cms-knet")
|
|
|
10651 (efs-autoload 'efs-send-pwd ti-explorer "efs-ti-explorer")
|
|
|
10652 (efs-autoload 'efs-send-pwd hell "efs-hell")
|
|
|
10653 (efs-autoload 'efs-send-pwd mvs "efs-mvs")
|
|
|
10654 (efs-autoload 'efs-send-pwd coke "efs-coke")
|
|
|
10655
|
|
|
10656 ;; A few packages are loaded by the listing parser.
|
|
|
10657 (efs-autoload 'efs-parse-listing ka9q "efs-ka9q")
|
|
|
10658 (efs-autoload 'efs-parse-listing unix:dl "efs-dl")
|
|
|
10659 (efs-autoload 'efs-parse-listing dos-distinct "efs-dos-distinct")
|
|
|
10660 (efs-autoload 'efs-parse-listing hell "efs-hell")
|
|
|
10661 (efs-autoload 'efs-parse-listing netware "efs-netware")
|
|
|
10662
|
|
|
10663 ;; Packages that need to autoload for child-lookup
|
|
|
10664 (efs-autoload 'efs-allow-child-lookup plan9 "efs-plan9")
|
|
|
10665 (efs-autoload 'efs-allow-child-lookup coke "efs-coke")
|
|
|
10666
|
|
|
10667 ;; Packages that need to autoload for file-exists-p and file-directory-p
|
|
|
10668 (efs-autoload 'efs-internal-file-exists-p guardian "efs-guardian")
|
|
|
10669 (efs-autoload 'efs-internal-file-directory-p guardian "efs-guardian")
|
|
|
10670
|
|
|
10671
|
|
|
10672
|
|
|
10673 ;;;; ============================================================
|
|
|
10674 ;;;; >10
|
|
|
10675 ;;;; Attaching onto the appropriate Emacs version
|
|
|
10676 ;;;; ============================================================
|
|
|
10677
|
|
|
10678 ;;;; -------------------------------------------------------------------
|
|
|
10679 ;;;; Connect to various hooks.
|
|
|
10680 ;;;; -------------------------------------------------------------------
|
|
|
10681
|
|
|
10682 (or (memq 'efs-set-buffer-mode find-file-hooks)
|
|
|
10683 (setq find-file-hooks
|
|
|
10684 (cons 'efs-set-buffer-mode find-file-hooks)))
|
|
|
10685
|
|
|
10686 ;;; We are using our own dired.el, so this doesn't depend on Emacs flavour.
|
|
|
10687
|
|
|
10688 (if (featurep 'dired)
|
|
|
10689 (require 'efs-dired)
|
|
|
10690 (add-hook 'dired-load-hook (function
|
|
|
10691 (lambda ()
|
|
|
10692 (require 'efs-dired)))))
|
|
|
10693
|
|
|
10694 ;;;; ------------------------------------------------------------
|
|
|
10695 ;;;; Add to minor-mode-alist.
|
|
|
10696 ;;;; ------------------------------------------------------------
|
|
|
10697
|
|
|
10698 (or (assq 'efs-process-host-type minor-mode-alist)
|
|
|
10699 (if (assq 'dired-sort-mode minor-mode-alist)
|
|
|
10700 (let ((our-list
|
|
|
10701 (nconc
|
|
|
10702 (delq nil
|
|
|
10703 (list (assq 'dired-sort-mode minor-mode-alist)
|
|
|
10704 (assq 'dired-subdir-omit minor-mode-alist)
|
|
|
10705 (assq 'dired-marker-stack minor-mode-alist)))
|
|
|
10706 (list '(efs-process-host-type efs-process-host-type)
|
|
|
10707 '(efs-dired-listing-type
|
|
|
10708 efs-dired-listing-type-string))))
|
|
|
10709 (old-list (delq
|
|
|
10710 (assq 'efs-process-host-type minor-mode-alist)
|
|
|
10711 (delq
|
|
|
10712 (assq 'efs-dired-listing-type minor-mode-alist)
|
|
|
10713 minor-mode-alist))))
|
|
|
10714 (setq minor-mode-alist nil)
|
|
|
10715 (while old-list
|
|
|
10716 (or (assq (car (car old-list)) our-list)
|
|
|
10717 (setq minor-mode-alist (nconc minor-mode-alist
|
|
|
10718 (list (car old-list)))))
|
|
|
10719 (setq old-list (cdr old-list)))
|
|
|
10720 (setq minor-mode-alist (nconc our-list minor-mode-alist)))
|
|
|
10721 (setq minor-mode-alist
|
|
|
10722 (nconc
|
|
|
10723 (list '(efs-process-host-type efs-process-host-type)
|
|
|
10724 '(efs-dired-listing-type efs-dired-listing-type-string))
|
|
|
10725 minor-mode-alist))))
|
|
|
10726
|
|
|
10727 ;;;; ------------------------------------------------------------
|
|
|
10728 ;;;; File name handlers
|
|
|
10729 ;;;; ------------------------------------------------------------
|
|
|
10730
|
|
114
|
10731 ;;;###autoload
|
|
98
|
10732 (defun efs-file-handler-function (operation &rest args)
|
|
|
10733 "Function to call special file handlers for remote files."
|
|
116
|
10734 (let ((handler (and (if (boundp 'allow-remote-paths)
|
|
|
10735 allow-remote-paths
|
|
|
10736 t)
|
|
|
10737 (get operation 'efs))))
|
|
98
|
10738 (if handler
|
|
|
10739 (apply handler args)
|
|
|
10740 (let ((inhibit-file-name-handlers
|
|
|
10741 (cons 'efs-file-handler-function
|
|
|
10742 (and (eq inhibit-file-name-operation operation)
|
|
|
10743 inhibit-file-name-handlers)))
|
|
|
10744 (inhibit-file-name-operation operation))
|
|
|
10745 (apply operation args)))))
|
|
|
10746
|
|
|
10747 (defun efs-sifn-handler-function (operation &rest args)
|
|
|
10748 ;; Handler function for substitute-in-file-name
|
|
116
|
10749 (if (and (if (boundp 'allow-remote-paths)
|
|
|
10750 allow-remote-paths
|
|
|
10751 t)
|
|
|
10752 (eq operation 'substitute-in-file-name))
|
|
98
|
10753 (apply 'efs-substitute-in-file-name args)
|
|
|
10754 (let ((inhibit-file-name-handlers
|
|
|
10755 (cons 'efs-sifn-handler-function
|
|
|
10756 (and (eq operation inhibit-file-name-operation)
|
|
|
10757 inhibit-file-name-handlers)))
|
|
|
10758 (inhibit-file-name-operation operation))
|
|
|
10759 (apply operation args))))
|
|
|
10760
|
|
|
10761 ;; Yes, this is what it looks like. I'm defining the handler to run our
|
|
|
10762 ;; version whenever there is an environment variable.
|
|
|
10763
|
|
|
10764 (nconc file-name-handler-alist
|
|
|
10765 (list
|
|
|
10766 (cons "\\(^\\|[^$]\\)\\(\\$\\$\\)*\\$[{a-zA-Z0-9]"
|
|
|
10767 'efs-sifn-handler-function)))
|
|
|
10768
|
|
|
10769 ;;;; ------------------------------------------------------------
|
|
|
10770 ;;;; Necessary overloads.
|
|
|
10771 ;;;; ------------------------------------------------------------
|
|
|
10772
|
|
|
10773 ;;; The following functions are overloaded, instead of extended via
|
|
|
10774 ;;; the file-name-handler-alist. For various reasons, the
|
|
|
10775 ;;; file-name-handler-alist doesn't work for them. It would be nice if
|
|
|
10776 ;;; this list could be shortened in the future.
|
|
|
10777
|
|
|
10778 ;; File name exansion. It is not until _after_ a file name has been
|
|
|
10779 ;; expanded that it is reasonable to test it for a file name handler.
|
|
|
10780 (efs-overwrite-fn "efs" 'expand-file-name)
|
|
|
10781
|
|
|
10782 ;; Loading lisp files. The problem with using the file-name-handler-alist
|
|
|
10783 ;; here is that we don't know what is to be handled, until after searching
|
|
|
10784 ;; the load-path. The solution is to change the C code for Fload.
|
|
|
10785 ;; A patch to do this has been written by Jay Adams <jka@ece.cmu.edu>.
|
|
|
10786 (efs-overwrite-fn "efs" 'load)
|
|
|
10787 (efs-overwrite-fn "efs" 'require)
|
|
|
10788
|
|
|
10789 ;;;; ------------------------------------------------------------
|
|
|
10790 ;;;; Install the file handlers for efs-file-handler-function.
|
|
|
10791 ;;;; ------------------------------------------------------------
|
|
|
10792
|
|
|
10793 ;; I/O
|
|
|
10794 (put 'insert-file-contents 'efs 'efs-insert-file-contents)
|
|
|
10795 (put 'write-region 'efs 'efs-write-region)
|
|
|
10796 (put 'directory-files 'efs 'efs-directory-files)
|
|
|
10797 (put 'list-directory 'efs 'efs-list-directory)
|
|
|
10798 (put 'insert-directory 'efs 'efs-insert-directory)
|
|
|
10799 (put 'recover-file 'efs 'efs-recover-file)
|
|
|
10800 ;; file properties
|
|
|
10801 (put 'file-directory-p 'efs 'efs-file-directory-p)
|
|
|
10802 (put 'file-writable-p 'efs 'efs-file-writable-p)
|
|
|
10803 (put 'file-readable-p 'efs 'efs-file-readable-p)
|
|
|
10804 (put 'file-executable-p 'efs 'efs-file-executable-p)
|
|
|
10805 (put 'file-symlink-p 'efs 'efs-file-symlink-p)
|
|
|
10806 (put 'file-attributes 'efs 'efs-file-attributes)
|
|
|
10807 (put 'file-exists-p 'efs 'efs-file-exists-p)
|
|
|
10808 (put 'file-accessible-directory-p 'efs 'efs-file-accessible-directory-p)
|
|
|
10809 ;; manipulating file names
|
|
|
10810 (put 'file-name-directory 'efs 'efs-file-name-directory)
|
|
|
10811 (put 'file-name-nondirectory 'efs 'efs-file-name-nondirectory)
|
|
|
10812 (put 'file-name-as-directory 'efs 'efs-file-name-as-directory)
|
|
|
10813 (put 'directory-file-name 'efs 'efs-directory-file-name)
|
|
|
10814 (put 'abbreviate-file-name 'efs 'efs-abbreviate-file-name)
|
|
|
10815 (put 'file-name-sans-versions 'efs 'efs-file-name-sans-versions)
|
|
|
10816 (put 'unhandled-file-name-directory 'efs 'efs-unhandled-file-name-directory)
|
|
|
10817 (put 'diff-latest-backup-file 'efs 'efs-diff-latest-backup-file)
|
|
|
10818 (put 'file-truename 'efs 'efs-file-truename)
|
|
|
10819 ;; modtimes
|
|
|
10820 (put 'verify-visited-file-modtime 'efs 'efs-verify-visited-file-modtime)
|
|
|
10821 (put 'file-newer-than-file-p 'efs 'efs-file-newer-than-file-p)
|
|
|
10822 (put 'set-visited-file-modtime 'efs 'efs-set-visited-file-modtime)
|
|
|
10823 ;; file modes
|
|
|
10824 (put 'set-file-modes 'efs 'efs-set-file-modes)
|
|
|
10825 (put 'file-modes 'efs 'efs-file-modes)
|
|
|
10826 ;; buffers
|
|
|
10827 (put 'backup-buffer 'efs 'efs-backup-buffer)
|
|
|
10828 (put 'get-file-buffer 'efs 'efs-get-file-buffer)
|
|
|
10829 (put 'create-file-buffer 'efs 'efs-create-file-buffer)
|
|
|
10830 ;; creating and removing files
|
|
|
10831 (put 'delete-file 'efs 'efs-delete-file)
|
|
|
10832 (put 'copy-file 'efs 'efs-copy-file)
|
|
|
10833 (put 'rename-file 'efs 'efs-rename-file)
|
|
|
10834 (put 'file-local-copy 'efs 'efs-file-local-copy)
|
|
|
10835 (put 'make-directory-internal 'efs 'efs-make-directory-internal)
|
|
|
10836 (put 'delete-directory 'efs 'efs-delete-directory)
|
|
|
10837 (put 'add-name-to-file 'efs 'efs-add-name-to-file)
|
|
|
10838 (put 'make-symbolic-link 'efs 'efs-make-symbolic-link)
|
|
|
10839 ;; file name completion
|
|
|
10840 (put 'file-name-completion 'efs 'efs-file-name-completion)
|
|
|
10841 (put 'file-name-all-completions 'efs 'efs-file-name-all-completions)
|
|
|
10842
|
|
|
10843 ;;;; ------------------------------------------------------------
|
|
|
10844 ;;;; Finally run any load-hooks.
|
|
|
10845 ;;;; ------------------------------------------------------------
|
|
|
10846
|
|
|
10847 (run-hooks 'efs-load-hook)
|
|
|
10848
|
|
|
10849 ;;; end of efs.el
|
