|
98
|
1 ;; -*-Emacs-Lisp-*-
|
|
|
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
3 ;;
|
|
|
4 ;; File: efs.el
|
|
|
5 ;; Release: $efs release: 1.15 $
|
|
100
|
6 ;; Version: $Revision: 1.3 $
|
|
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 ;;;
|
|
|
76 ;;; Currently efs does not have a tex info file, and what you are
|
|
|
77 ;;; reading represents the only efs documentation. Please report any
|
|
|
78 ;;; errors or omissions in this documentation to the "bugs" address
|
|
|
79 ;;; below. Eventually, a tex info file should be written. If you have
|
|
|
80 ;;; any problems with efs, please read this section *before*
|
|
|
81 ;;; submitting a bug report.
|
|
|
82
|
|
|
83 ;;; Installation:
|
|
|
84 ;;;
|
|
|
85 ;;; For byte compiling the efs package, a Makefile is provided.
|
|
|
86 ;;; You should follow the instructions at the top of the Makefile.
|
|
|
87 ;;; If you have any problems, please let us know so that we can fix
|
|
|
88 ;;; them for other users. Don't even consider using efs without
|
|
|
89 ;;; byte compiling it. It will be far too slow.
|
|
|
90 ;;;
|
|
|
91 ;;; If you decide to byte compile efs by hand, it is important that
|
|
|
92 ;;; the file efs-defun.el be byte compiled first, followed by efs.el.
|
|
|
93 ;;; The other files may be byte compiled in any order.
|
|
|
94 ;;;
|
|
|
95 ;;; To use efs, simply put the byte compiled files in your load path
|
|
|
96 ;;; and add
|
|
|
97 ;;;
|
|
|
98 ;;; (require 'efs)
|
|
|
99 ;;;
|
|
100
|
100 ;;; in your .emacs file. Note this takes awhile, and some users have
|
|
|
101 ;;; found this to be unbearably slow. Therefore ...
|
|
98
|
102 ;;;
|
|
|
103 ;;; If you would like efs to be autoloaded when you attempt to access
|
|
|
104 ;;; a remote file, put
|
|
|
105 ;;;
|
|
|
106 ;;; (require 'efs-auto)
|
|
|
107 ;;;
|
|
|
108 ;;; in your .emacs file. Note that there are some limitations associated
|
|
|
109 ;;; with autoloading efs. A discussion of them is given at the top of
|
|
|
110 ;;; efs-auto.el.
|
|
|
111
|
|
|
112 ;;; Configuration variables:
|
|
|
113 ;;;
|
|
|
114 ;;; It is important that you read through the section on user customization
|
|
|
115 ;;; variables (search forward for the string ">>>"). If your local network
|
|
|
116 ;;; is not fully connected to the internet, but accesses the internet only
|
|
|
117 ;;; via a gateway, then it is vital to set the appropriate variables to
|
|
|
118 ;;; inform efs about the geometry of your local network. Also, see the
|
|
|
119 ;;; paragraph on gateways below.
|
|
|
120
|
|
|
121 ;;; Usage:
|
|
|
122 ;;;
|
|
|
123 ;;; Once installed, efs operates largely transparently. All files
|
|
|
124 ;;; normally accessible to you on the internet, become part of a large
|
|
|
125 ;;; virtual file system. These files are accessed using an extended
|
|
|
126 ;;; file name syntax. To access file <path> on remote host <host> by
|
|
|
127 ;;; logging in as user <user>, you simply specify the full path of the
|
|
|
128 ;;; file as /<user>@<host>:<path>. Nearly all GNU Emacs file handling
|
|
|
129 ;;; functions work for remote files. It is not possible to access
|
|
|
130 ;;; remote files using shell commands in an emacs *shell* buffer, as such
|
|
|
131 ;;; commands are passed directly to the shell, and not handled by emacs.
|
|
|
132 ;;; FTP is the underlying utility that efs uses to operate on remote files.
|
|
|
133 ;;;
|
|
|
134 ;;; For example, if find-file is given a filename of:
|
|
|
135 ;;;
|
|
|
136 ;;; /ange@anorman:/tmp/notes
|
|
|
137 ;;;
|
|
|
138 ;;; then efs will spawn an FTP process, connect to the host 'anorman' as
|
|
|
139 ;;; user 'ange', get the file '/tmp/notes' and pop up a buffer containing the
|
|
|
140 ;;; contents of that file as if it were on the local file system. If efs
|
|
|
141 ;;; needed a password to connect then it would prompt the user in the
|
|
|
142 ;;; minibuffer. For further discussion of the efs path syntax, see the
|
|
|
143 ;;; paragraph on extended file name syntax below.
|
|
|
144
|
|
|
145 ;;; Ports:
|
|
|
146 ;;;
|
|
|
147 ;;; efs supports the use of nonstandard ports on remote hosts.
|
|
|
148 ;;; To specify that port <port> should be used, give the host name as
|
|
|
149 ;;; host#<port>. Host names may be given in this form anywhere that efs
|
|
|
150 ;;; normally expects a host name. This includes in the .netrc file.
|
|
|
151 ;;; Logically, efs treats different ports to correspond to different
|
|
|
152 ;;; remote hosts.
|
|
|
153
|
|
|
154 ;;; Extended filename syntax:
|
|
|
155 ;;;
|
|
|
156 ;;; The default full efs path syntax is
|
|
|
157 ;;;
|
|
|
158 ;;; /<user>@<host>#<port>:<path>
|
|
|
159 ;;;
|
|
|
160 ;;; Both the `#<port>' and `<user>@' may be omitted.
|
|
|
161 ;;;
|
|
|
162 ;;; If the `#<port>' is omitted, then the default port is taken to be 21,
|
|
|
163 ;;; the usual FTP port. For most users, the port syntax will only
|
|
|
164 ;;; very rarely be necessary.
|
|
|
165 ;;;
|
|
|
166 ;;; If the `<user>@' is omitted, then efs will use a default user. If a
|
|
|
167 ;;; login token is specified in your .netrc file, then this will be used as
|
|
|
168 ;;; the default user for <host>. Otherwise, it is determined based on the
|
|
|
169 ;;; value of the variable efs-default-user.
|
|
|
170 ;;;
|
|
|
171 ;;; This efs path syntax can be customised to a certain extent by
|
|
|
172 ;;; changing a number of variables in the subsection Internal Variables.
|
|
|
173 ;;; To undertake such a customization requires some knowledge about the
|
|
|
174 ;;; internal workings of efs.
|
|
|
175
|
|
|
176 ;;; Passwords:
|
|
|
177 ;;;
|
|
|
178 ;;; A password is required for each host / user pair. This will be
|
|
|
179 ;;; prompted for when needed, unless already set by calling
|
|
|
180 ;;; efs-set-passwd, or specified in a *valid* ~/.netrc file.
|
|
|
181 ;;;
|
|
|
182 ;;; When efs prompts for a password, it provides defaults from its
|
|
|
183 ;;; cache of currently known passwords. The defaults are ordered such
|
|
|
184 ;;; that passwords for accounts which have the same user name as the
|
|
|
185 ;;; login which is currently underway have priority. You can cycle
|
|
|
186 ;;; through your list of defaults with C-n to cycle forwards and C-p
|
|
|
187 ;;; to cycle backwards. The list is circular.
|
|
|
188
|
|
|
189 ;;; Passwords for user "anonymous":
|
|
|
190 ;;;
|
|
|
191 ;;; Passwords for the user "anonymous" (or "ftp") are handled
|
|
|
192 ;;; specially. The variable efs-generate-anonymous-password controls
|
|
|
193 ;;; what happens. If the value of this variable is a string, then this
|
|
|
194 ;;; is used as the password; if non-nil, then a password is created
|
|
|
195 ;;; from the name of the user and the hostname of the machine on which
|
|
|
196 ;;; GNU Emacs is running; if nil (the default) then the user is
|
|
|
197 ;;; prompted for a password as normal.
|
|
|
198
|
|
|
199 ;;; "Dumb" UNIX hosts:
|
|
|
200 ;;;
|
|
|
201 ;;; The FTP servers on some UNIX machines have problems if the "ls"
|
|
|
202 ;;; command is used. efs will try to correct for this automatically,
|
|
|
203 ;;; and send the "dir" command instead. If it fails, you can call the
|
|
|
204 ;;; function efs-add-host, and give the host type as dumb-unix. Note
|
|
|
205 ;;; that this change will take effect for the current GNU Emacs
|
|
|
206 ;;; session only. To make this specification for future emacs
|
|
|
207 ;;; sessions, put
|
|
|
208 ;;;
|
|
|
209 ;;; (efs-add-host 'dumb-unix "hostname")
|
|
|
210 ;;;
|
|
|
211 ;;; in your .emacs file. Also, please report any failure to automatically
|
|
|
212 ;;; recognize dumb unix to the "bugs" address given below, so that we can
|
|
|
213 ;;; fix the auto recognition code.
|
|
|
214
|
|
|
215 ;;; File name completion:
|
|
|
216 ;;;
|
|
|
217 ;;; Full file-name completion is supported on every type of remote
|
|
|
218 ;;; host. To do filename completion, efs needs a listing from the
|
|
|
219 ;;; remote host. Therefore, for very slow connections, it might not
|
|
|
220 ;;; save any time. However, the listing is cached, so subsequent uses
|
|
|
221 ;;; of file-name completion will be just as fast as for local file
|
|
|
222 ;;; names.
|
|
|
223
|
|
|
224 ;;; FTP processes:
|
|
|
225 ;;;
|
|
|
226 ;;; When efs starts up an FTP process, it leaves it running for speed
|
|
|
227 ;;; purposes. Some FTP servers will close the connection after a period of
|
|
|
228 ;;; time, but efs should be able to quietly reconnect the next time that
|
|
|
229 ;;; the process is needed.
|
|
|
230 ;;;
|
|
|
231 ;;; The FTP process will be killed should the associated "*ftp user@host*"
|
|
|
232 ;;; buffer be deleted. This should not cause efs any grief.
|
|
|
233
|
|
|
234 ;;; Showing background FTP activity on the mode-line:
|
|
|
235 ;;;
|
|
|
236 ;;; After efs is loaded, the command efs-display-ftp-activity will cause
|
|
|
237 ;;; background FTP activity to be displayed on the mode line. The variable
|
|
|
238 ;;; efs-mode-line-format is used to determine how this data is displayed.
|
|
|
239 ;;; efs does not continuously track the number of active sessions, as this
|
|
|
240 ;;; would cause the display to change too rapidly. Rather, it uses a heuristic
|
|
|
241 ;;; algorithm to determine when there is a significant change in FTP activity.
|
|
|
242
|
|
|
243 ;;; File types:
|
|
|
244 ;;;
|
|
|
245 ;;; By default efs will assume that all files are ASCII. If a file
|
|
|
246 ;;; being transferred matches the value of efs-binary-file-name-regexp
|
|
|
247 ;;; then the file will be assumed to be a binary file, and efs will
|
|
|
248 ;;; transfer it using "type image". ASCII files will be transferred
|
|
|
249 ;;; using a transfer type which efs computes to be correct according
|
|
|
250 ;;; to its knowledge of the file system of the remote host. The
|
|
|
251 ;;; command `efs-prompt-for-transfer-type' toggles the variable
|
|
|
252 ;;; `efs-prompt-for-transfer-type'. When this variable is non-nil, efs
|
|
|
253 ;;; will prompt the user for the transfer type to use for every FTP
|
|
|
254 ;;; transfer. Having this set all the time is annoying, but it is
|
|
|
255 ;;; useful to give special treatment to a small set of files.
|
|
|
256 ;;; There is also variable efs-text-file-name-regexp. This is tested before
|
|
|
257 ;;; efs-binary-file-name-regexp, so if you set efs-text-file-name-regexp
|
|
|
258 ;;; to a non-trivial regular expression, and efs-binary-file-name-regexp
|
|
|
259 ;;; to ".*", the result will to make image the default tranfer type.
|
|
|
260 ;;;
|
|
|
261 ;;; Also, if you set efs-treat-crlf-as-nl, then efs will use type image
|
|
|
262 ;;; to transfer files between hosts whose file system differ only in that
|
|
|
263 ;;; one specifies end of line as CR-LF, and the other as NL. This is useful
|
|
|
264 ;;; if you are transferring files between UNIX and DOS machines, and have a
|
|
|
265 ;;; package such as dos-mode.el, that handles the extra ^M's.
|
|
|
266
|
|
|
267 ;;; Account passwords:
|
|
|
268 ;;;
|
|
|
269 ;;; Some FTP servers require an additional password which is sent by
|
|
|
270 ;;; the ACCOUNT command. efs will detect this and prompt the user for
|
|
|
271 ;;; an account password if the server expects one. Also, an account
|
|
|
272 ;;; password can be set by calling efs-set-account, or by specifying
|
|
|
273 ;;; an account token in the .netrc file.
|
|
|
274 ;;;
|
|
|
275 ;;; Some operating systems, such as CMS, require that ACCOUNT be used to
|
|
|
276 ;;; give a write access password for minidisks. efs-set-account can be used
|
|
|
277 ;;; to set a write password for a specific minidisk. Also, tokens of the form
|
|
|
278 ;;; minidisk <minidisk name> <password>
|
|
|
279 ;;; may be added to host lines in your .netrc file. Minidisk tokens must be
|
|
|
280 ;;; at the end of the host line, however there may be an arbitrary number of
|
|
|
281 ;;; them for any given host.
|
|
|
282
|
|
|
283 ;;; Preloading:
|
|
|
284 ;;;
|
|
|
285 ;;; efs can be preloaded, but must be put in the site-init.el file and
|
|
|
286 ;;; not the site-load.el file in order for the documentation strings for the
|
|
|
287 ;;; functions being overloaded to be available.
|
|
|
288
|
|
|
289 ;;; Status reports:
|
|
|
290 ;;;
|
|
|
291 ;;; Most efs commands that talk to the FTP process output a status
|
|
|
292 ;;; message on what they are doing. In addition, efs can take advantage
|
|
|
293 ;;; of the FTP client's HASH command to display the status of transferring
|
|
|
294 ;;; files and listing directories. See the documentation for the variables
|
|
|
295 ;;; efs-hash-mark-size, efs-send-hash and efs-verbose for more details.
|
|
|
296
|
|
|
297 ;;; Caching of directory information:
|
|
|
298 ;;;
|
|
|
299 ;;; efs keeps an internal cache of file listings from remote hosts.
|
|
|
300 ;;; If this cache gets out of synch, it can be renewed by reverting a
|
|
|
301 ;;; dired buffer for the appropriate directory (dired-revert is usually
|
|
|
302 ;;; bound to "g").
|
|
|
303 ;;;
|
|
|
304 ;;; Alternatively, you can add the following two lines to your .emacs file
|
|
|
305 ;;; if you want C-r to refresh efs's cache whilst doing filename
|
|
|
306 ;;; completion.
|
|
|
307 ;;; (define-key minibuffer-local-completion-map "\C-r" 'efs-re-read-dir)
|
|
|
308 ;;; (define-key minibuffer-local-must-match-map "\C-r" 'efs-re-read-dir)
|
|
|
309
|
|
|
310 ;;; Gateways:
|
|
|
311 ;;;
|
|
|
312 ;;; Sometimes it is neccessary for the FTP process to be run on a different
|
|
|
313 ;;; machine than the machine running GNU Emacs. This can happen when the
|
|
|
314 ;;; local machine has restrictions on what hosts it can access.
|
|
|
315 ;;;
|
|
|
316 ;;; efs has support for running the ftp process on a different (gateway)
|
|
|
317 ;;; machine. The way it works is as follows:
|
|
|
318 ;;;
|
|
|
319 ;;; 1) Set the variable 'efs-gateway-host' to the name of a machine
|
|
|
320 ;;; that doesn't have the access restrictions. If you need to use
|
|
|
321 ;;; a nonstandard port to access this host for gateway use, then
|
|
|
322 ;;; specify efs-gateway-host as "<hostname>#<port>".
|
|
|
323 ;;;
|
|
|
324 ;;; 2) Set the variable 'efs-ftp-local-host-regexp' to a regular expression
|
|
|
325 ;;; that matches hosts that can be contacted from running a local ftp
|
|
|
326 ;;; process, but fails to match hosts that can't be accessed locally. For
|
|
|
327 ;;; example:
|
|
|
328 ;;;
|
|
|
329 ;;; "\\.hp\\.com$\\|^[^.]*$"
|
|
|
330 ;;;
|
|
|
331 ;;; will match all hosts that are in the .hp.com domain, or don't have an
|
|
|
332 ;;; explicit domain in their name, but will fail to match hosts with
|
|
|
333 ;;; explicit domains or that are specified by their ip address.
|
|
|
334 ;;;
|
|
|
335 ;;; 3) Set the variable `efs-local-host-regexp' to machines that you have
|
|
|
336 ;;; direct TCP/IP access. In other words, you must be able to ping these
|
|
|
337 ;;; hosts. Usually, efs-ftp-local-host-regexp and efs-local-host-regexp
|
|
|
338 ;;; will be the same. However, they will differ for so-called transparent
|
|
|
339 ;;; gateways. See #7 below for more details.
|
|
|
340 ;;;
|
|
|
341 ;;; 4) Set the variable 'efs-gateway-tmp-name-template' to the name of
|
|
|
342 ;;; a directory plus an identifying filename prefix for making temporary
|
|
|
343 ;;; files on the gateway. For example: "/tmp/hplose/ange/efs"
|
|
|
344 ;;;
|
|
|
345 ;;; 5) If the gateway and the local host share cross-mounted directories,
|
|
|
346 ;;; set the value of `efs-gateway-mounted-dirs-alist' accordingly. It
|
|
|
347 ;;; is particularly useful, but not mandatory, that the directory
|
|
|
348 ;;; of `efs-gateway-tmp-name-template' be cross-mounted.
|
|
|
349 ;;;
|
|
|
350 ;;; 6) Set the variable `efs-gateway-type' to the type gateway that you have.
|
|
|
351 ;;; This variable is a list, the first element of which is a symbol
|
|
|
352 ;;; denoting the type of gateway. Following elements give further
|
|
|
353 ;;; data on the gateway.
|
|
|
354 ;;;
|
|
|
355 ;;; Supported gateway types:
|
|
|
356 ;;;
|
|
|
357 ;;; a) local:
|
|
|
358 ;;; This means that your local host is itself the gateway. However,
|
|
|
359 ;;; it is necessary to use a different FTP client to gain access to
|
|
|
360 ;;; the outside world. If the name of the FTP client were xftp, you might
|
|
|
361 ;;; set efs-gateway-type to
|
|
|
362 ;;;
|
|
|
363 ;;; (list 'local "xftp" efs-ftp-program-args)
|
|
|
364 ;;;
|
|
|
365 ;;; If xftp required special arguments, then give them in place of
|
|
|
366 ;;; efs-ftp-program-args. See the documentation for efs-ftp-program-args
|
|
|
367 ;;; for the syntax.
|
|
|
368 ;;;
|
|
|
369 ;;; b) proxy:
|
|
|
370 ;;; This indicates that your gateway works by first FTP'ing to it, and
|
|
|
371 ;;; then issuing a USER command of the form
|
|
|
372 ;;;
|
|
|
373 ;;; USER <username>@<host>
|
|
|
374 ;;;
|
|
|
375 ;;; In this case, you might set efs-gateway-type to
|
|
|
376 ;;;
|
|
|
377 ;;; (list 'proxy "ftp" efs-ftp-program-args)
|
|
|
378 ;;;
|
|
|
379 ;;; If you need to use a nonstandard client, such as iftp, give this
|
|
|
380 ;;; instead of "ftp". If this client needs to take special arguments,
|
|
|
381 ;;; give them instead of efs-ftp-program-args.
|
|
|
382 ;;;
|
|
|
383 ;;; c) remsh:
|
|
|
384 ;;; For this type of gateway, you need to start a remote shell on
|
|
|
385 ;;; your gateway, using either remsh or rsh. You should set
|
|
|
386 ;;; efs-gateway-type to something like
|
|
|
387 ;;;
|
|
|
388 ;;; (list 'remsh "remsh" nil "ftp" efs-ftp-program-args)
|
|
|
389 ;;;
|
|
|
390 ;;; If you use rsh instead of remsh, change the second element from
|
|
|
391 ;;; "remsh" to "rsh". Note that the symbol indicating the gateway
|
|
|
392 ;;; type should still be 'remsh. If you want to pass arguments
|
|
|
393 ;;; to the remsh program, give them as the third element. For example,
|
|
|
394 ;;; if you need to specify a user, make this (list "-l" "sandy").
|
|
|
395 ;;; If you need to use a nonstandard FTP client, specify that as the fourth
|
|
|
396 ;;; element. If your FTP client needs to be given special arguments,
|
|
|
397 ;;; give them instead of efs-ftp-program-args.
|
|
|
398 ;;;
|
|
|
399 ;;; d) interactive:
|
|
|
400 ;;; This indicates that you need to establish a login on the gateway,
|
|
|
401 ;;; using either telnet or rlogin.
|
|
|
402 ;;; You should set efs-gateway-type to something like
|
|
|
403 ;;;
|
|
|
404 ;;; (list 'interactive "rlogin" nil "exec ftp" efs-ftp-program-args)
|
|
|
405 ;;;
|
|
|
406 ;;; If you need to use telnet, then give "telnet" in place of the second
|
|
|
407 ;;; element "rlogin". If your login program needs to be given arguments,
|
|
|
408 ;;; then they should be given in the third slot. The fourth element
|
|
|
409 ;;; is for the name of the FTP client program. Giving this as "exec ftp",
|
|
|
410 ;;; instead of "ftp", ensures that you are logged out if the FTP client
|
|
|
411 ;;; dies. If the FTP client takes special arguments, give these instead
|
|
|
412 ;;; of efs-ftp-program-args. Furthermore, you should see the documentation
|
|
|
413 ;;; at the top of efs-gwp.el. You may need to set the variables
|
|
|
414 ;;; efs-gwp-setup-term-command, and efs-gwp-prompt-pattern.
|
|
|
415 ;;;
|
|
|
416 ;;; e) raptor:
|
|
|
417 ;;; This is a type of gateway where efs is expected to specify a gateway
|
|
|
418 ;;; user, and send a password for this user using the ACCOUNT command.
|
|
|
419 ;;; For example, to log in to foobar.edu as sandy, while using the account
|
|
|
420 ;;; ange on the gateway, the following commands would be sent:
|
|
|
421 ;;;
|
|
|
422 ;;; open raptorgate.com
|
|
|
423 ;;; quote USER sandy@foobar.edu ange
|
|
|
424 ;;; quote pass <sandy's password on foobar>
|
|
|
425 ;;; quote account <ange's password on raptorgate>
|
|
|
426 ;;;
|
|
|
427 ;;; For such a gateway, you would set efs-gateway-type to
|
|
|
428 ;;;
|
|
|
429 ;;; (list 'raptor efs-ftp-program efs-ftp-program-args <GATEWAY USER>)
|
|
|
430 ;;;
|
|
|
431 ;;; where <GATEWAY USER> is the name of your account on the gateway. In
|
|
|
432 ;;; the above example, this would be "ange". You can set your gateway
|
|
|
433 ;;; password by simply setting an account password for the gateway host.
|
|
|
434 ;;; This can be done with either efs-set-account, or within your .netrc
|
|
|
435 ;;; file. If no password is set, you will be prompted for one.
|
|
|
436 ;;;
|
|
|
437 ;;; f) interlock:
|
|
|
438 ;;; This is a type of gateway where you are expected to send a PASS
|
|
|
439 ;;; command after opening the connection to the gateway.
|
|
|
440 ;;; The precise login sequence is
|
|
|
441 ;;;
|
|
|
442 ;;; open interlockgate
|
|
|
443 ;;; quote PASS <sandy's password on interlockgate>
|
|
|
444 ;;; quote USER sandy@foobar.edu
|
|
|
445 ;;; quote PASS <sandy's password on foobar.edu>
|
|
|
446 ;;;
|
|
|
447 ;;; For such a gateway, you should set efs-gateway-type to
|
|
|
448 ;;;
|
|
|
449 ;;; (list 'interlock efs-ftp-program efs-ftp-program-args)
|
|
|
450 ;;;
|
|
|
451 ;;; If you need to use a nonstandard name for your FTP client,
|
|
|
452 ;;; then replace efs-ftp-program with this name. If your FTP client
|
|
|
453 ;;; needs to take nonstandard arguments, then replace efs-ftp-program-args
|
|
|
454 ;;; with these arguments. See efs-ftp-program-args <V> for the required
|
|
|
455 ;;; syntax.
|
|
|
456 ;;;
|
|
|
457 ;;; If your gateway returns both a 220 code and a 331 code to the
|
|
|
458 ;;; "open interlockgate" command, then you should add a regular
|
|
|
459 ;;; expression to efs-skip-msgs <V> that matches the 220 response.
|
|
|
460 ;;; Returning two response codes to a single FTP command is not permitted
|
|
|
461 ;;; in RFC 959. It is not possible for efs to ignore the 220 by default,
|
|
|
462 ;;; because than it would hang for interlock installations which do not
|
|
|
463 ;;; require a password.
|
|
|
464 ;;;
|
|
|
465 ;;; g) kerberos:
|
|
|
466 ;;; With this gateway, you need to authenticate yourself by getting a
|
|
|
467 ;;; kerberos "ticket" first. Usually, this is done with the kinit program.
|
|
|
468 ;;; Once authenticated, you connect to foobar.com as user sandy with the
|
|
|
469 ;;; sequence: (Note that the "-n" argument inhibits automatic login.
|
|
|
470 ;;; Although, in manual use you probably don't use it, efs always uses it.)
|
|
|
471 ;;;
|
|
|
472 ;;; iftp -n
|
|
|
473 ;;; open foobar.com
|
|
|
474 ;;; user sandy@foobar.com
|
|
|
475 ;;;
|
|
|
476 ;;; You should set efs-gateway-type to something like
|
|
|
477 ;;;
|
|
|
478 ;;; (list 'kerberos "iftp" efs-ftp-program-args "kinit" <KINIT-ARGS>)
|
|
|
479 ;;;
|
|
|
480 ;;; If you use an FTP client other than iftp, insert its name instead
|
|
|
481 ;;; of "iftp" above. If your FTP client needs special arguments, give
|
|
|
482 ;;; them as a list of strings in place of efs-ftp-program-args. If
|
|
|
483 ;;; the program that you use to collect a ticket in not called "kinit",
|
|
|
484 ;;; then give its name in place of "kinit" above. <KINIT-ARGS> should be
|
|
|
485 ;;; any arguments that you need to pass to your kinit program, given as a
|
|
|
486 ;;; list of strings. Most likely, you will give this as nil.
|
|
|
487 ;;;
|
|
|
488 ;;; See the file efs-kerberos.el for more configuration variables. If you
|
|
|
489 ;;; need to adjust any of these variables, please report this to us so that
|
|
|
490 ;;; we can fix them for other users.
|
|
|
491 ;;;
|
|
|
492 ;;; If efs detects that you are not authenticated to use the gateway, it
|
|
|
493 ;;; will run the kinit program automatically, prompting you for a password.
|
|
|
494 ;;; If you give a password in your .netrc file for login the value of
|
|
|
495 ;;; efs-gateway-host <V> and user kerberos, then efs will use this to
|
|
|
496 ;;; obtain gateway authentication.
|
|
|
497 ;;;
|
|
|
498 ;;; 7) Transparent gateways:
|
|
|
499 ;;;
|
|
|
500 ;;; If your gateway is completely transparent (for example it uses
|
|
|
501 ;;; socks), then you should set efs-gateway-type to nil. Also,
|
|
|
502 ;;; set efs-ftp-local-host-regexp to ".*". However, efs-local-host-regexp,
|
|
|
503 ;;; must still be set to a regular expression matching hosts in your local
|
|
|
504 ;;; domain. efs uses this to determine which machines that it can
|
|
|
505 ;;; open-network-stream to. Furthermore, you should still set
|
|
|
506 ;;; efs-gateway-host to the name of your gateway machine. That way efs
|
|
|
507 ;;; will know that this is a special machine having direct TCP/IP access
|
|
|
508 ;;; to both hosts in the outside world, and hosts in your local domain.
|
|
|
509 ;;;
|
|
|
510 ;;; 8) Common Problems with Gateways:
|
|
|
511 ;;;
|
|
|
512 ;;; a) Spurious 220 responses:
|
|
|
513 ;;; Some proxy-style gateways (eg gateway type 'proxy or 'raptor),
|
|
|
514 ;;; return two 3-digit FTP reply codes to the USER command.
|
|
|
515 ;;; For example:
|
|
|
516 ;;;
|
|
|
517 ;;; open gateway.weird
|
|
|
518 ;;; 220 Connected to gateway.weird
|
|
|
519 ;;; quote USER sandy@foobar
|
|
|
520 ;;; 220 Connected to foobar
|
|
|
521 ;;; 331 Password required for sandy
|
|
|
522 ;;;
|
|
|
523 ;;; This is wrong, according to the FT Protocol. Each command must return
|
|
|
524 ;;; exactly one 3-digit reply code. It may be preceded by continuation
|
|
|
525 ;;; lines. What should really be returned is:
|
|
|
526 ;;;
|
|
|
527 ;;; quote USER sandy@foobar
|
|
|
528 ;;; 331-Connected to foobar.
|
|
|
529 ;;; 331 Password required for sandy.
|
|
|
530 ;;;
|
|
|
531 ;;; or even
|
|
|
532 ;;;
|
|
|
533 ;;; quote USER sandy@foobar
|
|
|
534 ;;; 331-220 Connected to foobar.
|
|
|
535 ;;; 331 Password required for sandy.
|
|
|
536 ;;;
|
|
|
537 ;;; Even though the "331-220" looks strange, it is correct protocol, and
|
|
|
538 ;;; efs will parse it properly.
|
|
|
539 ;;;
|
|
|
540 ;;; If your gateway is returning a spurious 220 to USER, a work-around
|
|
|
541 ;;; is to add a regular expression to `efs-skip-msgs' that matches
|
|
|
542 ;;; this line. It must not match the 220 line returned to the open
|
|
|
543 ;;; command. This work-around may not work, as some system FTP clients
|
|
|
544 ;;; also get confused by the spurious 220. In this case, the only
|
|
|
545 ;;; solution is to patch the gateway server. In either case, please
|
|
|
546 ;;; send a bug report to the author of your gateway software.
|
|
|
547 ;;;
|
|
|
548 ;;; b) Case-sensitive parsing of FTP commands:
|
|
|
549 ;;; Some gateway servers seem to treat FTP commands case-sensitively.
|
|
|
550 ;;; This is incorrect, as RFC 959 clearly states that FTP commands
|
|
|
551 ;;; are always to be case-insensitive. If this is a problem with your
|
|
|
552 ;;; gateway server, you should send a bug report to its author.
|
|
|
553 ;;; If efs is using a case for FTP commands that does not suit your server,
|
|
|
554 ;;; a possible work-around is to edit the efs source so that the required
|
|
|
555 ;;; case is used. However, we will not be making any changes to the
|
|
|
556 ;;; standard efs distribution to support this type of server behaviour.
|
|
|
557 ;;; If you need help changing the efs source, you should enquire with the
|
|
|
558 ;;; efs-help mailing list.
|
|
|
559 ;;;
|
|
|
560
|
|
|
561 ;;; ---------------------------------------------------------------
|
|
|
562 ;;; Tips for using efs:
|
|
|
563 ;;; ---------------------------------------------------------------
|
|
|
564
|
|
|
565 ;;; 1) Beware of compressing files on non-UNIX hosts. efs will do it by
|
|
|
566 ;;; copying the file to the local machine, compressing it there, and then
|
|
|
567 ;;; sending it back. Binary file transfers between machines of different
|
|
|
568 ;;; architectures can be a risky business. Test things out first on some
|
|
|
569 ;;; test files. See "Bugs" below. Also, note that efs sometimes
|
|
|
570 ;;; copies files by moving them through the local machine. Again,
|
|
|
571 ;;; be careful when doing this with binary files on non-Unix
|
|
|
572 ;;; machines.
|
|
|
573 ;;;
|
|
|
574 ;;; 2) Beware that dired over ftp will use your setting of dired-no-confirm
|
|
|
575 ;;; (list of dired commands for which confirmation is not asked).
|
|
|
576 ;;; You might want to reconsider your setting of this variable,
|
|
|
577 ;;; because you might want confirmation for more commands on remote
|
|
|
578 ;;; direds than on local direds. For example, I strongly recommend
|
|
|
579 ;;; that you not include compress in this list. If there is enough
|
|
|
580 ;;; demand it might be a good idea to have an alist
|
|
|
581 ;;; efs-dired-no-confirm of pairs ( TYPE . LIST ), where TYPE is an
|
|
|
582 ;;; operating system type and LIST is a list of commands for which
|
|
|
583 ;;; confirmation would be suppressed. Then remote dired listings
|
|
|
584 ;;; would take their (buffer-local) value of dired-no-confirm from
|
|
|
585 ;;; this alist. Who votes for this?
|
|
|
586 ;;;
|
|
|
587 ;;; 3) Some combinations of FTP clients and servers break and get out of sync
|
|
|
588 ;;; when asked to list a non-existent directory. Some of the ai.mit.edu
|
|
|
589 ;;; machines cause this problem for some FTP clients. Using
|
|
|
590 ;;; efs-kill-ftp-process can be used to restart the ftp process, which
|
|
|
591 ;;; should get things back in synch.
|
|
|
592 ;;;
|
|
|
593 ;;; 4) Some ftp servers impose a length limit on the password that can
|
|
|
594 ;;; be sent. If this limit is exceeded they may bomb in an
|
|
|
595 ;;; incomprehensible way. This sort of behaviour is common with
|
|
|
596 ;;; MVS servers. Therefore, you should beware of this possibility
|
|
|
597 ;;; if you are generating a long password (like an email address)
|
|
|
598 ;;; with efs-generate-anonymous-password.
|
|
|
599 ;;;
|
|
|
600 ;;; 5) Some antiquated FTP servers hang when asked for an RNFR command.
|
|
|
601 ;;; efs sometimes uses this to test whether its local cache is stale.
|
|
|
602 ;;; If your server for HOST hangs when asked for this command, put
|
|
|
603 ;;; (efs-set-host-property HOST 'rnfr-failed t)
|
|
|
604 ;;; in your efs-ftp-startup-function-alist entry for HOST.
|
|
|
605 ;;;
|
|
|
606
|
|
|
607 ;;; -----------------------------------------------------------------------
|
|
|
608 ;;; Where to get the latest version of efs:
|
|
|
609 ;;; -----------------------------------------------------------------------
|
|
|
610 ;;;
|
|
|
611 ;;; The authors are grateful to anyone or any organization which
|
|
|
612 ;;; provides anonymous FTP distribution for efs.
|
|
|
613 ;;;
|
|
|
614 ;;;
|
|
|
615 ;;; Europe:
|
|
|
616 ;;;
|
|
|
617 ;;; Switzerland
|
|
|
618 ;;; /anonymous@itp.ethz.ch:/sandy/efs/
|
|
|
619 ;;;
|
|
|
620 ;;; North America:
|
|
|
621 ;;;
|
|
|
622 ;;; Massachusetts, USA
|
|
|
623 ;;; /anonymous@alpha.gnu.ai.mit.edu:/efs/
|
|
|
624 ;;;
|
|
|
625 ;;; California, USA
|
|
|
626 ;;; /anonymous@ftp.hmc.edu:/pub/emacs/packages/efs/
|
|
|
627 ;;;
|
|
|
628 ;;; Australia and New Zealand:
|
|
|
629 ;;;
|
|
|
630 ;;; ????????????
|
|
|
631 ;;;
|
|
|
632 ;;; Japan:
|
|
|
633 ;;;
|
|
|
634 ;;; ????????????
|
|
|
635
|
|
|
636 ;;; ---------------------------------------------------------------------
|
|
|
637 ;;; Non-UNIX support:
|
|
|
638 ;;; ---------------------------------------------------------------------
|
|
|
639
|
|
|
640 ;;; efs has full support, incuding file name completion and tree dired
|
|
|
641 ;;; for:
|
|
|
642 ;;;
|
|
|
643 ;;; VMS, CMS, MTS, MVS, ti-twenex, ti-explorer (the last two are lisp
|
|
|
644 ;;; machines), TOPS-20, DOS (running the Distinct, Novell, FTP
|
|
|
645 ;;; software, NCSA, Microsoft in both unix and DOS mode, Super TCP, and
|
|
|
646 ;;; Hellsoft FTP servers), unix descriptive listings (dl), KA9Q, OS/2,
|
|
|
647 ;;; VOS, NOS/VE, CMS running the KNET server, Tandem's Guardian OS, COKE
|
|
|
648 ;;;
|
|
|
649 ;;; efs should be able to automatically recognize any of the operating
|
|
|
650 ;;; systems and FTP servers that it supports. Please report any
|
|
|
651 ;;; failure to do so to the "bugs" address below. You can specify a
|
|
|
652 ;;; certain host as being of a given host type with the command
|
|
|
653 ;;;
|
|
|
654 ;;; (efs-add-host <host-type> <host>)
|
|
|
655 ;;;
|
|
|
656 ;;; <host-type> is a symbol, <host> is a string. If this command is
|
|
|
657 ;;; used interactively, then <host-type> is prompted for with
|
|
|
658 ;;; completion. Some host types have regexps that can be used to
|
|
|
659 ;;; specify a class of host names as being of a certain type. Note
|
|
|
660 ;;; that if you specify a host as being of a certain type, efs does
|
|
|
661 ;;; not verify that that is really the type of the host. This calls
|
|
|
662 ;;; for caution when using regexps to specify host types, as an
|
|
|
663 ;;; inadvertent match to a regexp might have unpleasant consequences.
|
|
|
664 ;;;
|
|
|
665 ;;; See the respective efs-TYPE.el files for more information.
|
|
|
666 ;;; When or if we get a tex info file, it should contain some more
|
|
|
667 ;;; details on the non-unix support.
|
|
|
668
|
|
|
669 ;;; ------------------------------------------------------------------
|
|
|
670 ;;; Bugs and other things that go clunk in the night:
|
|
|
671 ;;; ------------------------------------------------------------------
|
|
|
672
|
|
|
673 ;;; How to report a bug:
|
|
|
674 ;;; --------------------
|
|
|
675 ;;;
|
|
|
676 ;;; Type M-x efs-report-bug
|
|
|
677 ;;; or
|
|
|
678 ;;; send mail to efs-bugs@cuckoo.hpl.hp.com.
|
|
|
679 ;;;
|
|
|
680 ;;; efs is a "free" program. This means that you didn't (or shouldn't
|
|
|
681 ;;; have) paid anything for it. It also means that nobody is paid to
|
|
|
682 ;;; maintain it, and the authors weren't paid for writing it.
|
|
|
683 ;;; Therefore, please try to write your bug report in a clear and
|
|
|
684 ;;; complete fashion. It will greatly enhance the probability that
|
|
|
685 ;;; something will be done about your problem.
|
|
|
686 ;;;
|
|
|
687 ;;; Note that efs relies heavily in cached information, so the bug may
|
|
|
688 ;;; depend in a complicated fashion on commands that were performed on
|
|
|
689 ;;; remote files from the beginning of your emacs session. Trying to
|
|
|
690 ;;; reproduce your bug starting from a fresh emacs session is usually
|
|
|
691 ;;; a good idea.
|
|
|
692 ;;;
|
|
|
693
|
|
|
694 ;;; Fan/hate mail:
|
|
|
695 ;;; --------------
|
|
|
696 ;;;
|
|
|
697 ;;; efs has its own mailing list called efs-help. All users of efs
|
|
|
698 ;;; are welcome to subscribe (see below) and to discuss aspects of
|
|
|
699 ;;; efs. New versions of efs are posted periodically to the mailing
|
|
|
700 ;;; list.
|
|
|
701 ;;;
|
|
|
702 ;;; To [un]subscribe to efs-help, or to report mailer problems with the
|
|
|
703 ;;; list, please mail one of the following addresses:
|
|
|
704 ;;;
|
|
|
705 ;;; efs-help-request@cuckoo.hpl.hp.com
|
|
|
706 ;;; or
|
|
|
707 ;;; efs-help-request%cuckoo.hpl.hp.com@hplb.hpl.hp.com
|
|
|
708 ;;;
|
|
|
709 ;;; Please don't forget the -request part.
|
|
|
710 ;;;
|
|
|
711 ;;; For mail to be posted directly to efs-help, send to one of the
|
|
|
712 ;;; following addresses:
|
|
|
713 ;;;
|
|
|
714 ;;; efs-help@cuckoo.hpl.hp.com
|
|
|
715 ;;; or
|
|
|
716 ;;; efs-help%cuckoo.hpl.hp.com@hplb.hpl.hp.com
|
|
|
717 ;;;
|
|
|
718 ;;; Alternatively, there is a mailing list that only gets
|
|
|
719 ;;; announcements of new efs releases. This is called efs-announce,
|
|
|
720 ;;; and can be subscribed to by e-mailing to the -request address as
|
|
|
721 ;;; above. Please make it clear in the request which mailing list you
|
|
|
722 ;;; wish to join.
|
|
|
723 ;;;
|
|
|
724
|
|
|
725 ;;; Known bugs:
|
|
|
726 ;;; -----------
|
|
|
727 ;;;
|
|
|
728 ;;; If you hit a bug in this list, please report it anyway. Most of
|
|
|
729 ;;; the bugs here remain unfixed because they are considered too
|
|
|
730 ;;; esoteric to be a high priority. If one of them gets reported
|
|
|
731 ;;; enough, we will likely change our view on that.
|
|
|
732 ;;;
|
|
|
733 ;;; 1) efs does not check to make sure that when creating a new file,
|
|
|
734 ;;; you provide a valid filename for the remote operating system.
|
|
|
735 ;;; If you do not, then the remote FTP server will most likely
|
|
|
736 ;;; translate your filename in some way. This may cause efs to
|
|
|
737 ;;; get confused about what exactly is the name of the file.
|
|
|
738 ;;;
|
|
|
739 ;;; 2) For CMS support, we send too many cd's. Since cd's are cheap, I haven't
|
|
|
740 ;;; worried about this too much. Eventually, we should have some caching
|
|
|
741 ;;; of the current minidisk. This is complicated by the fact that some
|
|
|
742 ;;; CMS servers lie about the current minidisk, so sending redundant
|
|
|
743 ;;; cd's helps us recover in this case.
|
|
|
744 ;;;
|
|
|
745 ;;; 3) The code to do compression of files over ftp is not as careful as it
|
|
|
746 ;;; should be. It deletes the old remote version of the file, before
|
|
|
747 ;;; actually checking if the local to remote transfer of the compressed
|
|
|
748 ;;; file succeeds. Of course to delete the original version of the file
|
|
|
749 ;;; after transferring the compressed version back is also dangerous,
|
|
|
750 ;;; because some OS's have severe restrictions on the length of filenames,
|
|
|
751 ;;; and when the compressed version is copied back the "-Z" or ".Z" may be
|
|
|
752 ;;; truncated. Then, efs would delete the only remaining version of
|
|
|
753 ;;; the file. Maybe efs should make backups when it compresses files
|
|
|
754 ;;; (of course, the backup "~" could also be truncated off, sigh...).
|
|
|
755 ;;; Suggestions?
|
|
|
756 ;;;
|
|
|
757 ;;; 4) If a dir listing is attempted for an empty directory on (at least
|
|
|
758 ;;; some) VMS hosts, an ftp error is given. This is really an ftp bug, and
|
|
|
759 ;;; I don't know how to get efs work to around it.
|
|
|
760 ;;;
|
|
|
761 ;;; 5) efs gets confused by directories containing file names with
|
|
|
762 ;;; embedded newlines. A temporary solution is to add "q" to your
|
|
|
763 ;;; dired listing switches. As long as your dired listing switches
|
|
|
764 ;;; also contain "l" and either "a" or "A", efs will use these
|
|
|
765 ;;; switches to get listings for its internal cache. The "q" switch
|
|
|
766 ;;; should force listings to be exactly one file per line. You
|
|
|
767 ;;; still will not be able to access a file with embedded newlines,
|
|
|
768 ;;; but at least it won't mess up the parsing of the rest of the files.
|
|
|
769 ;;;
|
|
|
770 ;;; 6) efs cannot parse symlinks which have an embedded " -> "
|
|
|
771 ;;; in their name. It's alright to have an embedded " -> " in the name
|
|
|
772 ;;; of any other type of file. A fix is possible, but probably not worth
|
|
|
773 ;;; the trouble. If you disagree, send us a bug report.
|
|
|
774 ;;;
|
|
|
775 ;;; 7) efs doesn't handle context-dep. files in H-switch listings on
|
|
|
776 ;;; HP's. It wouldn't be such a big roaring deal to fix this. I'm
|
|
|
777 ;;; waiting until I get an actual bug report though.
|
|
|
778 ;;;
|
|
|
779 ;;; 8) If a hard link is added or deleted, efs will not update its
|
|
|
780 ;;; internal cache of the link count for other names of the file.
|
|
|
781 ;;; This may cause file-nlinks to return incorrectly. Reverting
|
|
|
782 ;;; any dired buffer containing other names for the file will
|
|
|
783 ;;; cause the file data to be updated, including the link counts.
|
|
|
784 ;;; A fix for this problem is known and will be eventually
|
|
|
785 ;;; implemented. How it is implemented will depend on how we decide
|
|
|
786 ;;; to handle inodes. See below.
|
|
|
787 ;;;
|
|
|
788 ;;; 9) efs is unable to parse R-switch listings from remote unix hosts.
|
|
|
789 ;;; This is inefficient, because efs will insist on doing individual
|
|
|
790 ;;; listings of the subdirectories to get its file information.
|
|
|
791 ;;; This may be fixed if there is enough demand.
|
|
|
792 ;;;
|
|
|
793 ;;; 10) In file-attributes, efs returns a fake inode number. Of course
|
|
|
794 ;;; this is necessary, but this inode number is not even necessarily
|
|
|
795 ;;; unique. It is simply the sum of the characters (treated as
|
|
|
796 ;;; integers) in the host name, user name, and file name. Possible
|
|
|
797 ;;; ways to get a unique inode number are:
|
|
|
798 ;;; a) Simply keep a count of all remote file in the cache, and
|
|
|
799 ;;; return the file's position in this count as a negative number.
|
|
|
800 ;;; b) For unix systems, we could actually get at the real inode
|
|
|
801 ;;; number on the remote host, by adding an "i" to the ls switches.
|
|
|
802 ;;; The inode numbers would then be removed from the listing
|
|
|
803 ;;; returned by efs-ls, if the caller hadn't requested the "i"
|
|
|
804 ;;; switch. We could then make a unique number out of the host name
|
|
|
805 ;;; and the real inode number.
|
|
|
806 ;;;
|
|
|
807 ;;; 11) efs tries to determine if a file is readable or writable by comparing
|
|
|
808 ;;; the file modes, file owner, and user name under which it is logged
|
|
|
809 ;;; into the remote host. This does not take into account groups.
|
|
|
810 ;;; We simply assume that the user belongs to all groups. As a result
|
|
|
811 ;;; we may assume that a file is writable, when in fact it is not.
|
|
|
812 ;;; Groups are tough to handle correctly over FTP. Suggestions?
|
|
|
813 ;;; (For new FTP servers, can do a "QUOTE SITE EXEC groups" to
|
|
|
814 ;;; handle this.)
|
|
|
815
|
|
|
816 ;;; -----------------------------------------------------------
|
|
|
817 ;;; Technical information on this package:
|
|
|
818 ;;; -----------------------------------------------------------
|
|
|
819
|
|
|
820 ;;; efs hooks onto the following functions using the
|
|
|
821 ;;; file-name-handler-alist. Depending on which version of emacs you
|
|
|
822 ;;; are using, not all of these functions may access this alist. In
|
|
|
823 ;;; this case, efs overloads the definitions of these functions with
|
|
|
824 ;;; versions that do access the file-name-handler-alist. These
|
|
|
825 ;;; overloads are done in efs's version-specific files.
|
|
|
826 ;;;
|
|
|
827 ;;; abbreviate-file-name
|
|
|
828 ;;; backup-buffer
|
|
|
829 ;;; copy-file
|
|
|
830 ;;; create-file-buffer
|
|
|
831 ;;; delete-directory
|
|
|
832 ;;; delete-file
|
|
|
833 ;;; directory-file-name
|
|
|
834 ;;; directory-files
|
|
|
835 ;;; file-attributes
|
|
|
836 ;;; file-directory-p
|
|
|
837 ;;; file-exists-p
|
|
|
838 ;;; file-local-copy
|
|
|
839 ;;; file-modes
|
|
|
840 ;;; file-name-all-completions
|
|
|
841 ;;; file-name-as-directory
|
|
|
842 ;;; file-name-completion
|
|
|
843 ;;; file-name-directory
|
|
|
844 ;;; file-name-nondirectory
|
|
|
845 ;;; file-name-sans-versions
|
|
|
846 ;;; file-newer-than-file-p
|
|
|
847 ;;; file-readable-p
|
|
|
848 ;;; file-executable-p
|
|
|
849 ;;; file-accessible-directory-p
|
|
|
850 ;;; file-symlink-p
|
|
|
851 ;;; file-writable-p
|
|
|
852 ;;; get-file-buffer
|
|
|
853 ;;; insert-directory
|
|
|
854 ;;; insert-file-contents
|
|
|
855 ;;; list-directory
|
|
|
856 ;;; make-directory-internal
|
|
|
857 ;;; rename-file
|
|
|
858 ;;; set-file-modes
|
|
|
859 ;;; set-visited-file-modtime
|
|
|
860 ;;; substitute-in-file-name
|
|
|
861 ;;; verify-visited-file-modtime
|
|
|
862 ;;; write-region
|
|
|
863 ;;;
|
|
|
864 ;;; The following functions are overloaded in efs.el, because they cannot
|
|
|
865 ;;; be handled via the file-name-handler-alist.
|
|
|
866 ;;;
|
|
|
867 ;;; expand-file-name
|
|
|
868 ;;; load
|
|
|
869 ;;; read-file-name-internal (Emacs 18, only)
|
|
|
870 ;;; require
|
|
|
871 ;;;
|
|
|
872 ;;; The following dired functions are handled by hooking them into the
|
|
|
873 ;;; the file-name-handler-alist. This is done in efs-dired.el.
|
|
|
874 ;;;
|
|
|
875 ;;; efs-dired-compress-file
|
|
|
876 ;;; eds-dired-print-file
|
|
|
877 ;;; efs-dired-make-compressed-filename
|
|
|
878 ;;; efs-compress-file
|
|
|
879 ;;; efs-dired-print-file
|
|
|
880 ;;; efs-dired-create-directory
|
|
|
881 ;;; efs-dired-recursive-delete-directory
|
|
|
882 ;;; efs-dired-uncache
|
|
|
883 ;;; efs-dired-call-process
|
|
|
884 ;;;
|
|
|
885 ;;; In efs-dired.el, the following dired finctions are overloaded.
|
|
|
886 ;;;
|
|
|
887 ;;; dired-collect-file-versions
|
|
|
888 ;;; dired-find-file
|
|
|
889 ;;; dired-flag-backup-files
|
|
|
890 ;;; dired-get-filename
|
|
|
891 ;;; dired-insert-headerline
|
|
|
892 ;;; dired-move-to-end-of-filename
|
|
|
893 ;;; dired-move-to-filename
|
|
|
894 ;;; dired-run-shell-command
|
|
|
895 ;;;
|
|
|
896 ;;; efs makes use of the following hooks
|
|
|
897 ;;;
|
|
|
898 ;;; diff-load-hook
|
|
|
899 ;;; dired-before-readin-hook
|
|
|
900 ;;; find-file-hooks
|
|
|
901 ;;; dired-grep-load-hook
|
|
|
902
|
|
|
903 ;;; LISPDIR ENTRY for the Elisp Archive:
|
|
|
904 ;;;
|
|
|
905 ;;; LCD Archive Entry:
|
|
|
906 ;;; efs|Andy Norman and Sandy Rutherford
|
|
|
907 ;;; |ange@hplb.hpl.hp.com and sandy@ibm550.sissa.it
|
|
|
908 ;;; |transparent FTP Support for GNU Emacs
|
|
100
|
909 ;;; |$Date: 1997/02/24 01:13:11 $|$efs release: 1.15 beta $|
|
|
98
|
910
|
|
|
911 ;;; Host and listing type notation:
|
|
|
912 ;;;
|
|
|
913 ;;; The functions efs-host-type and efs-listing-type, and the
|
|
|
914 ;;; variable efs-dired-host-type follow the following conventions
|
|
|
915 ;;; for remote host types.
|
|
|
916 ;;;
|
|
|
917 ;;; nil = local host type, whatever that is (probably unix).
|
|
|
918 ;;; Think nil as in "not a remote host". This value is used by
|
|
|
919 ;;; efs-dired-host-type for local buffers.
|
|
|
920 ;;; (efs-host-type nil) => nil
|
|
|
921 ;;;
|
|
|
922 ;;; 'type = a remote host of TYPE type.
|
|
|
923 ;;;
|
|
|
924 ;;; 'type:list = a remote host using listing type 'type:list.
|
|
|
925 ;;; This is currently used for Unix dl (descriptive
|
|
|
926 ;;; listings), when efs-dired-host-type is set to
|
|
|
927 ;;; 'unix:dl, and to support the myriad of DOS FTP
|
|
|
928 ;;; servers.
|
|
|
929
|
|
|
930 ;;; Supported host and listing types:
|
|
|
931 ;;;
|
|
|
932 ;;; unknown, unix, dumb-unix, bsd-unix, sysV-unix, next-unix,
|
|
|
933 ;;; super-dumb-unix, dumb-apollo-unix,
|
|
|
934 ;;; apollo-unix, unix:dl, dos-distinct, ka9q, dos, dos:ftp, dos:novell,
|
|
|
935 ;;; dos:ncsa, dos:winsock, vos, hell, dos:microsoft, super-dumb-unix
|
|
|
936 ;;; vms, cms, mts, mvs, mvs:tcp mvs:nih tops-20, mpe, ti-twenex,
|
|
|
937 ;;; ti-explorer, os2, vos,
|
|
|
938 ;;; vms:full, guardian, ms-unix (This is the Microsoft NT Windows server
|
|
|
939 ;;; in unix mode.), plan9, unix:unknown, nos-ve (actually NOS/VE).
|
|
|
940
|
|
|
941 ;;; Host and listing type hierarchy:
|
|
|
942 ;;;
|
|
|
943 ;;; unknown: unix, dumb-unix, sysV-unix, bsd-unix, next-unix, apollo-unix,
|
|
|
944 ;;; ka9q, dos-distinct, unix:dl, hell,
|
|
|
945 ;;; super-dumb-unix, dumb-apollo-unix
|
|
|
946 ;;; unix: sysV-unix, bsd-unix, next-unix, apollo-unix, unix:dl
|
|
|
947 ;;; dos: dos:ftp, dos:novell, dos:ncsa, dos:microsoft, dos:winsock
|
|
|
948 ;;; dumb-unix:
|
|
|
949 ;;; bsd-unix:
|
|
|
950 ;;; sysV-unix:
|
|
|
951 ;;; next-unix:
|
|
|
952 ;;; apollo-unix:
|
|
|
953 ;;; dumb-apollo-unix:
|
|
|
954 ;;; unix:dl:
|
|
|
955 ;;; unix:unknown: unix:dl, unix
|
|
|
956 ;;; super-dumb-unix:
|
|
|
957 ;;; dos-distinct:
|
|
|
958 ;;; dos:ftp:
|
|
|
959 ;;; dos:novell:
|
|
|
960 ;;; dos:microsoft
|
|
|
961 ;;; ka9q:
|
|
|
962 ;;; vms: vms:full
|
|
|
963 ;;; cms:
|
|
|
964 ;;; mts:
|
|
|
965 ;;; mvs: mvs:tcp, mvs:nih
|
|
|
966 ;;; mvs:tcp:
|
|
|
967 ;;; mvs:nih:
|
|
|
968 ;;; tops-20:
|
|
|
969 ;;; ti-twenex:
|
|
|
970 ;;; ti-explorer:
|
|
|
971 ;;; os2:
|
|
|
972 ;;; vos:
|
|
|
973 ;;; vms:full:
|
|
|
974 ;;; dos:ncsa:
|
|
|
975 ;;; dos:winsock:
|
|
|
976 ;;; vos:
|
|
|
977 ;;; hell:
|
|
|
978 ;;; guardian:
|
|
|
979 ;;; ms-unix:
|
|
|
980 ;;; plan9:
|
|
|
981 ;;; nos-ve:
|
|
|
982 ;;; coke:
|
|
|
983 ;;;
|
|
|
984
|
|
|
985
|
|
|
986 ;;;; ================================================================
|
|
|
987 ;;;; >0
|
|
|
988 ;;;; Table of Contents for efs.el
|
|
|
989 ;;;; ================================================================
|
|
|
990 ;;
|
|
|
991 ;; Each section of efs.el is labelled by >#, where # is the number of
|
|
|
992 ;; the section.
|
|
|
993 ;;
|
|
|
994 ;; 1. Provisions, requirements, and autoloads.
|
|
|
995 ;; 2. Variable definitions.
|
|
|
996 ;; 3. Utilities.
|
|
|
997 ;; 4. Hosts, users, accounts, and passwords.
|
|
|
998 ;; 5. FTP client process and server responses.
|
|
|
999 ;; 6. Sending commands to the FTP server.
|
|
|
1000 ;; 7. Parsing and storing remote file system data.
|
|
|
1001 ;; 8. Redefinitions of standard GNU Emacs functions.
|
|
|
1002 ;; 9. Multiple host type support.
|
|
|
1003 ;; 10. Attaching onto the appropriate emacs version.
|
|
|
1004
|
|
|
1005
|
|
|
1006 ;;;; ================================================================
|
|
|
1007 ;;;; >1
|
|
|
1008 ;;;; General provisions, requirements, and autoloads.
|
|
|
1009 ;;;; Host type, and local emacs type dependent loads, and autoloads
|
|
|
1010 ;;;; are in the last two sections of this file.
|
|
|
1011 ;;;; ================================================================
|
|
|
1012
|
|
|
1013 ;;;; ----------------------------------------------------------------
|
|
|
1014 ;;;; Provide the package (Do this now to avoid an infinite loop)
|
|
|
1015 ;;;; ----------------------------------------------------------------
|
|
|
1016
|
|
|
1017 (provide 'efs)
|
|
|
1018
|
|
|
1019 ;;;; ----------------------------------------------------------------
|
|
|
1020 ;;;; Our requirements.
|
|
|
1021 ;;;; ----------------------------------------------------------------
|
|
|
1022
|
|
|
1023 (require 'backquote)
|
|
|
1024 (require 'comint)
|
|
|
1025 (require 'efs-defun)
|
|
|
1026 (require 'efs-netrc)
|
|
|
1027 (require 'efs-cu)
|
|
|
1028 (require 'efs-ovwrt)
|
|
|
1029 ;; Do this last, as it installs efs into the file-name-handler-alist.
|
|
|
1030 (require 'efs-fnh)
|
|
|
1031
|
|
|
1032 (autoload 'efs-report-bug "efs-report" "Submit a bug report for efs." t)
|
|
|
1033 (autoload 'efs-gwp-start "efs-gwp" ; For interactive gateways.
|
|
|
1034 "Login to the gateway machine and fire up an FTP client.")
|
|
|
1035 (autoload 'efs-kerberos-login "efs-kerberos")
|
|
|
1036 (autoload 'efs-insert-directory "efs-dired" "Insert a directory listing.")
|
|
|
1037 (autoload 'efs-set-mdtm-of "efs-cp-p")
|
|
|
1038 (autoload 'diff-latest-backup-file "diff")
|
|
|
1039 (autoload 'read-passwd "passwd" "Read a password from the minibuffer." t)
|
|
|
1040
|
|
|
1041
|
|
|
1042 ;;;; ============================================================
|
|
|
1043 ;;;; >2
|
|
|
1044 ;;;; Variable Definitions
|
|
|
1045 ;;;; **** The user configuration variables are in ****
|
|
|
1046 ;;;; **** the second subsection of this section. ****
|
|
|
1047 ;;;; ============================================================
|
|
|
1048
|
|
|
1049 ;;;; ------------------------------------------------------------
|
|
|
1050 ;;;; Constant Definitions
|
|
|
1051 ;;;; ------------------------------------------------------------
|
|
|
1052
|
|
|
1053 (defconst efs-version
|
|
|
1054 (concat (substring "$efs release: 1.15 $" 14 -2)
|
|
|
1055 "/"
|
|
100
|
1056 (substring "$Revision: 1.3 $" 11 -2)))
|
|
98
|
1057
|
|
|
1058 (defconst efs-time-zero 1970) ; we count time from midnight, Jan 1, 1970 GMT.
|
|
|
1059
|
|
|
1060 (defconst efs-dumb-host-types
|
|
|
1061 '(dumb-unix super-dumb-unix vms cms mts ti-twenex ti-explorer dos mvs
|
|
|
1062 tops-20 mpe ka9q dos-distinct os2 vos hell guardian
|
|
|
1063 netware cms-knet nos-ve coke dumb-apollo-unix)
|
|
|
1064 "List of host types that can't take UNIX ls-style listing options.")
|
|
|
1065 ;; dos-distinct only ignores ls switches; it doesn't barf.
|
|
|
1066 ;; Still treat it as dumb.
|
|
|
1067
|
|
|
1068 (defconst efs-unix-host-types
|
|
|
1069 '(unix sysV-unix bsd-unix next-unix apollo-unix dumb-unix
|
|
|
1070 dumb-apollo-unix super-dumb-unix)
|
|
|
1071 "List of unix host types.")
|
|
|
1072
|
|
|
1073 (defconst efs-version-host-types '(vms tops-20 ti-twenex ti-explorer)
|
|
|
1074 "List of host-types which associated a version number to all files.
|
|
|
1075 This is not the same as associating version numbers to only backup files.")
|
|
|
1076 ;; Note that on these systems,
|
|
|
1077 ;; (file-name-sans-versions EXISTING-FILE) does not exist as a file.
|
|
|
1078
|
|
|
1079 (defconst efs-single-extension-host-types
|
|
|
1080 '(vms tops-20 ti-twenex ti-explorer cms mvs dos ka9q dos-distinct hell
|
|
|
1081 netware ms-unix plan9 cms-knet nos-ve)
|
|
|
1082 "List of host types which allow at most one extension on a file name.
|
|
|
1083 Extensions are deliminated by \".\". In addition, these host-types must
|
|
|
1084 allow \"-\" in file names, because it will be used to add additional extensions
|
|
|
1085 to indicate compressed files.")
|
|
|
1086
|
|
|
1087 (defconst efs-idle-host-types
|
|
|
1088 (append '(coke unknown) efs-unix-host-types))
|
|
|
1089 ;; List of host types for which it is possible that the SITE IDLE command
|
|
|
1090 ;; is supported.
|
|
|
1091
|
|
|
1092 (defconst efs-listing-types
|
|
|
1093 '(unix:dl unix:unknown
|
|
|
1094 dos:novell dos:ftp dos:ncsa dos:microsoft dos:stcp dos:winsock
|
|
|
1095 mvs:nih mvs:tcp mvs:tcp
|
|
|
1096 vms:full)
|
|
|
1097 "List of supported listing types")
|
|
|
1098
|
|
|
1099 (defconst efs-nlist-listing-types
|
|
|
1100 '(vms:full))
|
|
|
1101 ;; Listing types which give a long useless listing when asked for a
|
|
|
1102 ;; LIST. For these, use an NLST instead. This can only be done
|
|
|
1103 ;; when there is some way to distinguish directories from
|
|
|
1104 ;; plain files in an NLST.
|
|
|
1105
|
|
|
1106 (defconst efs-opaque-gateways '(remsh interactive))
|
|
|
1107 ;; List of gateway types for which we need to do explicit file handling on
|
|
|
1108 ;; the gateway machine.
|
|
|
1109
|
|
|
1110 ;;;; ------------------------------------------------------------------
|
|
|
1111 ;;;; User customization variables. Please read through these carefully.
|
|
|
1112 ;;;; ------------------------------------------------------------------
|
|
|
1113
|
|
|
1114 ;;;>>>> If you are not fully connected to the internet, <<<<
|
|
|
1115 ;;;>>>> and need to use a gateway (no matter how transparent) <<<<
|
|
|
1116 ;;;>>>> you will need to set some of the following variables. <<<<
|
|
|
1117 ;;;>>>> Read the documentation carefully. <<<<
|
|
|
1118
|
|
|
1119 (defvar efs-local-host-regexp ".*"
|
|
|
1120 "Regexp to match names of local hosts.
|
|
|
1121 These are hosts to which it is possible to obtain a direct internet
|
|
|
1122 connection. Even if the host is accessible by a very transparent FTP gateway,
|
|
|
1123 it does not qualify as a local host. The test to determine if machine A is
|
|
|
1124 local to your machine is if it is possible to ftp from A _back_ to your
|
|
|
1125 local machine. Also, open-network-stream must be able to reach the host
|
|
|
1126 in question.")
|
|
|
1127
|
|
|
1128 (defvar efs-ftp-local-host-regexp ".*"
|
|
|
1129 "Regexp to match the names of hosts reachable by a direct ftp connection.
|
|
|
1130 This regexp should match the names of hosts which can be reached using ftp,
|
|
|
1131 without requiring any explicit connection to a gateway. If you have a smart
|
|
|
1132 ftp client which is able to transparently go through a gateway, this will
|
|
|
1133 differ from `efs-local-host-regexp'.")
|
|
|
1134
|
|
|
1135 (defvar efs-gateway-host nil
|
|
|
1136 "If non-nil, this must be the name of your ftp gateway machine.
|
|
|
1137 If your net world is divided into two domains according to
|
|
|
1138 `efs-local-ftp-host-regexp', set this variable to the name of the
|
|
|
1139 gateway machine.")
|
|
|
1140
|
|
|
1141 (defvar efs-gateway-type nil
|
|
|
1142 "Specifies which type of gateway you wish efs to use.
|
|
|
1143 This should be a list, the first element of which is a symbol denoting the
|
|
|
1144 gateway type, and following elements give data on how to use the gateway.
|
|
|
1145
|
|
|
1146 The following possibilities are supported:
|
|
|
1147
|
|
|
1148 '(local FTP-PROGRAM FTP-PROGRAM-ARGS)
|
|
|
1149 This means that your local host is itself the gateway. However,
|
|
|
1150 you need to run a special FTP client to access outside hosts.
|
|
|
1151 FTP-PROGRAM should be the name of this FTP client, and FTP-PROGRAM-ARGS
|
|
|
1152 is a list of arguments to pass to it \(probably set this to the value of
|
|
|
1153 efs-ftp-program-args <V>\). Note that if your gateway is of this type,
|
|
|
1154 then you would set efs-gateway-host to nil.
|
|
|
1155
|
|
|
1156 '(proxy FTP-PROGRAM FTP-PROGRAM-ARGS)
|
|
|
1157 This indicates that your gateway works by first FTP'ing to it, and
|
|
|
1158 then giving a USER command of the form \"USER <username>@<host>\".
|
|
|
1159 FTP-PROGRAM is the FTP program to use to connect to the gateway; this
|
|
|
1160 is most likely \"ftp\". FTP-PROGRAM-ARGS is a list of arguments to
|
|
|
1161 pass to it. You likely want this to be set to the value of
|
|
|
1162 efs-ftp-program-args <V>. If the connection to the gateway FTP server
|
|
|
1163 is to be on a port different from 21, set efs-gateway-host to
|
|
|
1164 \"<host>#<port>\".
|
|
|
1165
|
|
|
1166 '(raptor FTP-PROGRAM FTP-PROGRAM-ARGS USER)
|
|
|
1167 This is for the gateway called raptor by Eagle. After connecting to the
|
|
|
1168 the gateway, the command \"user <user>@host USER\" is issued to login
|
|
|
1169 as <user> on <host>, where USER is an authentication username for the
|
|
|
1170 gateway. After issuing the password for the remote host, efs will
|
|
|
1171 send the password for USER on efs-gateway-host <V> as an account command.
|
|
|
1172
|
|
|
1173 '(interlock FTP-PROGRAM FTP-PROGRAM-ARGS)
|
|
|
1174 This is for the interlock gateway. The exact login sequence is to
|
|
|
1175 connect to the gateway specified by efs-gateway-host <V>, send the
|
|
|
1176 gateway password with a PASS command, send the command
|
|
|
1177 \"user <user>@<host>\" to connect to remote host <host> as user <user>,
|
|
|
1178 and finally to send the password for <user> on <host> with a second
|
|
|
1179 PASS command.
|
|
|
1180
|
|
|
1181 '(kerberos FTP-PROGRAM FTP-PROGRAM-ARGS KINIT-PROGRAM KINIT-PROGRAM-ARGS)
|
|
|
1182 This is for the kerberos gateway where you need to run a program (kinit) to
|
|
|
1183 obtain a ticket for gateway authroization first. FTP-PROGRAM should be
|
|
|
1184 the name of the FTP client that you use to connect to the gateway. This
|
|
|
1185 may likely be \"iftp\". FTP-PROGRAM-ARGS are the arguments that you need
|
|
|
1186 to pass to FTP-PROGRAM. This is probably the value of
|
|
|
1187 efs-ftp-program-args <V>. KINIT-PROGRAM is the name of the program to
|
|
|
1188 run in order to obtain a ticket. This is probably \"kinit\".
|
|
|
1189 KINIT-PROGRAM-ARGS is a list og strings indicating any arguments that you
|
|
|
1190 need to pass to KINIT-PROGRAM. Most likely this is nil.
|
|
|
1191
|
|
|
1192 '(remsh GATEWAY-PROGRAM GATEWAY-PROGRAM-ARGS FTP-PROGRAM FTP-PROGRAM-ARGS)
|
|
|
1193 This indicates that you wish to run FTP on your gateway using a remote shell.
|
|
|
1194 GATEWAY-PROGRAM is the name of the program to use to start a remote shell.
|
|
|
1195 It is assumed that it is not necessary to provide a password to start
|
|
|
1196 this remote shell. Likely values are \"remsh\" or \"rsh\".
|
|
|
1197 GATEWAY-PROGRAM-ARGS is a list of arguments to pass to GATEWAY-PROGRAM.
|
|
|
1198 FTP-PROGRAM is the name of the FTP program on the gateway. A likely setting
|
|
|
1199 of this is \"ftp\". FTP-PROGRAM-ARGS is a list of arguments to pass to
|
|
|
1200 FTP-PROGRAM. Most likely these should be set to the value of
|
|
|
1201 efs-ftp-program-args <V>.
|
|
|
1202
|
|
|
1203 '(interactive GATEWAY-PROGRAM GATEWAY-PROGRAM-ARGS FTP-PROGRAM
|
|
|
1204 FTP-PROGRAM-ARGS)
|
|
|
1205 This indicates that you need to start an interactive login on your gatway,
|
|
|
1206 using rlogin, telnet, or something similar. GATEWAY-PROGRAM is the name
|
|
|
1207 of the program to use to log in to the gateway, and GATEWAY-PROGRAM-ARGS
|
|
|
1208 is a list of arguments to pass to it. FTP-PROGRAM is the name of the FTP
|
|
|
1209 program on the gateway. A likely setting for this variable would be
|
|
|
1210 \"exec ftp\". FTP-PROGRAM-ARGS is a list of arguments to pass
|
|
|
1211 to FTP-PROGRAM. You probably want to set these to the same value as
|
|
|
1212 efs-ftp-program-args <V>. If you are using this option, read the
|
|
|
1213 documentation at the top of efs-gwp.el, and see
|
|
|
1214 efs-gwp-setup-term-command <V>.")
|
|
|
1215
|
|
|
1216 (defvar efs-gateway-hash-mark-size nil
|
|
|
1217 "*Value of `efs-hash-mark-size' for FTP clients on `efs-gateway-host'.
|
|
|
1218 See the documentation of these variables for more information.")
|
|
|
1219
|
|
|
1220 (defvar efs-gateway-incoming-binary-hm-size nil
|
|
|
1221 "*Value of `efs-incoming-binary-hm-size' for `efs-gateway-host'.
|
|
|
1222 See documentation of these variables for more information.")
|
|
|
1223
|
|
|
1224 (defvar efs-gateway-tmp-name-template "/tmp/efs"
|
|
|
1225 "Template used to create temporary files when ftp-ing through a gateway.
|
|
|
1226 This should be the name of the file on the gateway, and not necessarily
|
|
|
1227 the name on the local host.")
|
|
|
1228
|
|
|
1229 (defvar efs-gateway-mounted-dirs-alist nil
|
|
|
1230 "An alist of directories cross-mounted between the gateway and local host.
|
|
|
1231 Each entry is of the form \( DIR1 . DIR2 \), where DIR1 is the name of the
|
|
|
1232 directory on the local host, and DIR2 is its name on the remote host. Both
|
|
|
1233 DIR1 and DIR2 must be specified in directory syntax, i.e. end in a slash.
|
|
|
1234 Note that we will assume that subdirs of DIR1 and DIR2 are also accessible
|
|
|
1235 on both machines.")
|
|
|
1236
|
|
|
1237 (defvar efs-gateway-ftp-prompt-regexp "^\\(ftp\\|Ftp\\|FTP\\)> *"
|
|
|
1238 "*Regular expression to match the prompt of the gateway FTP client.")
|
|
|
1239
|
|
|
1240 ;;; End of gateway config variables.
|
|
|
1241
|
|
|
1242 (defvar efs-tmp-name-template "/tmp/efs"
|
|
|
1243 "Template used to create temporary files.
|
|
|
1244 If you are worried about security, make this a directory in some
|
|
|
1245 bomb-proof cave somewhere. efs does clean up its temp files, but
|
|
|
1246 they do live for short periods of time.")
|
|
|
1247
|
|
|
1248 (defvar efs-generate-anonymous-password t
|
|
|
1249 "*If t, use a password of `user@host' when logging in as the anonymous user.
|
|
|
1250 `host' is generated by the function `efs-system-fqdn'. If `system name' returns
|
|
|
1251 a fully qualified domain name, `efs-system-fqdn' will return this. Otherwise,
|
|
|
1252 it will attempt to use nslookup to obtain a fully qualified domain name. If
|
|
|
1253 this is unsuccessful, the returned value will be the same as `system-name',
|
|
|
1254 whether this is a fully qualified domain name or not.
|
|
|
1255
|
|
|
1256 If a string then use that as the password.
|
|
|
1257
|
|
|
1258 If nil then prompt the user for a password.
|
|
|
1259
|
|
|
1260 Beware that some operating systems, such as MVS, restrict substantially
|
|
|
1261 the password length. The login will fail with a weird error message
|
|
|
1262 if you exceed it.")
|
|
|
1263
|
|
|
1264 (defvar efs-high-security-hosts nil
|
|
|
1265 "*Indicates host user pairs for which passwords should not be cached.
|
|
|
1266 If non-nil, should be a regexp matching user@host constructions for which
|
|
|
1267 efs should not store passwords in its internal cache.")
|
|
|
1268
|
|
|
1269 ;; The following regexps are tested in the following order:
|
|
|
1270 ;; efs-binary-file-host-regexp, efs-36-bit-binary-file-name-regexp,
|
|
|
1271 ;; efs-binary-file-name-regexp, efs-text-file-name-regexp.
|
|
|
1272 ;; File names which match nothing are transferred in 'image mode.
|
|
|
1273
|
|
|
1274 ;; If we're not careful, we're going to blow the regexp stack here.
|
|
|
1275 ;; Probably should move to a list of regexps. Slower, but safer.
|
|
|
1276 ;; This is not a problem in Emacs 19.
|
|
|
1277 (defvar efs-binary-file-name-regexp
|
|
|
1278 (concat "\\." ; the dot
|
|
|
1279 ;; extensions
|
|
|
1280 "\\([zZ]\\|t?gz\\|lzh\\|arc\\|zip\\|zoo\\|ta[rz]\\|dvi\\|sit\\|"
|
|
|
1281 "ps\\|elc\\|gif\\|Z-part-..\\|tpz\\|exe\\|[jm]pg\\|TZ[a-z]?\\|lib\\)"
|
|
|
1282 "\\(~\\|~[0-9]+~\\)?$" ; backups
|
|
|
1283 "\\|"
|
|
|
1284 ;; UPPER CASE LAND
|
|
|
1285 "\\."
|
|
|
1286 "\\(ARC\\|ELC\\|TAGS\\|EXE\\|ZIP\\|DVI\|ZOO\\|GIF\\|T?GZ\\|"
|
|
|
1287 "[JM]PG\\)"
|
|
|
1288 "\\([.#;][0-9]+\\)?$" ; versions
|
|
|
1289 )
|
|
|
1290 "*Files whose names match this regexp will be considered to be binary.
|
|
|
1291 By binary here, we mean 8-bit binary files (the usual unix binary files).
|
|
|
1292 If nil, no files will be considered to be binary.")
|
|
|
1293
|
|
|
1294 (defvar efs-binary-file-host-regexp nil
|
|
|
1295 "*All files on hosts matching this regexp are treated as 8-bit binary.
|
|
|
1296 Setting this to nil, inhibits this feature.")
|
|
|
1297
|
|
|
1298 (defvar efs-36-bit-binary-file-name-regexp nil
|
|
|
1299 "*Files whose names match this regexp will be considered to PDP 10 binaries.
|
|
|
1300 These are 36-bit word-aligned binary files. This is really only relevant for
|
|
|
1301 files on PDP 10's, and similar machines. If nil, no files will be considered
|
|
|
1302 to be PDP 10 binaries.")
|
|
|
1303
|
|
|
1304 (defvar efs-text-file-name-regexp ".*"
|
|
|
1305 "*Files whose names match this regexp will be considered to be text files.")
|
|
|
1306
|
|
|
1307 (defvar efs-prompt-for-transfer-type nil
|
|
|
1308 "*If non-nil, efs will prompt for the transfer type for each file transfer.
|
|
|
1309 The command efs-prompt-for-transfer-type can be used to toggle its value.")
|
|
|
1310
|
|
|
1311 (defvar efs-treat-crlf-as-nl nil
|
|
|
1312 "*Controls how file systems using CRLF as end of line are treated.
|
|
|
1313 If non-nil, such file systems will be considered equivalent to those which use
|
|
|
1314 LF as end of line. This is particularly relevant to transfers between DOS
|
|
|
1315 systems and UNIX. Setting this to be non-nil will cause all file transfers
|
|
|
1316 between DOS and UNIX systems to use be image or binary transfers.")
|
|
|
1317
|
|
|
1318 (defvar efs-send-hash t
|
|
|
1319 "*If non-nil, send the HASH command to the FTP client.")
|
|
|
1320
|
|
|
1321 (defvar efs-hash-mark-size nil
|
|
|
1322 "*Default size, in bytes, between hash-marks when transferring a file.
|
|
|
1323 If this is nil then efs will attempt to assign a value based on the
|
|
|
1324 output of the HASH command. Also, if this variable is incorrectly set,
|
|
|
1325 then efs will try to correct it based on the size of the last file
|
|
|
1326 transferred, and the number hashes outputed by the client during the
|
|
|
1327 transfer.
|
|
|
1328
|
|
|
1329 The variable `efs-gateway-hash-mark-size' defines the corresponding value
|
|
|
1330 for the FTP client on the gateway, if you are using a gateway.
|
|
|
1331
|
|
|
1332 Some client-server combinations do not correctly compute the number of hash
|
|
|
1333 marks for incoming binary transfers. In this case, a separate variable
|
|
|
1334 `efs-incoming-binary-hm-size' can be used to set a default value of the
|
|
|
1335 hash mark size for incoming binary transfers.")
|
|
|
1336
|
|
|
1337 (defvar efs-incoming-binary-hm-size nil
|
|
|
1338 "*Default hash mark size for incoming binary transfers.
|
|
|
1339 If this is nil, incoming binary transfers will use `efs-hash-mark-size' as
|
|
|
1340 the default. See the documentation of this variable for more details.")
|
|
|
1341
|
|
|
1342 (defvar efs-verbose t
|
|
|
1343 "*If non-NIL then be chatty about interaction with the FTP process.
|
|
|
1344 If 0 do not give % transferred reports for asynchronous commands and status
|
|
|
1345 reports for commands verifying file modtimes, but report on everything else.")
|
|
|
1346
|
|
|
1347 (defvar efs-message-interval 0
|
|
|
1348 "*Defines the minimum time in seconds between status messages.
|
|
|
1349 A new status message is not displayed, if one has already been given
|
|
|
1350 within this period of time.")
|
|
|
1351
|
|
|
1352 (defvar efs-max-ftp-buffer-size 3000
|
|
|
1353 "*Maximum size in characters of FTP process buffer, before it is trimmed.
|
|
|
1354 The buffer is trimmed to approximately half this size. Setting this to nil
|
|
|
1355 inhibits trimming of FTP process buffers.")
|
|
|
1356
|
|
|
1357 (defvar efs-ls-cache-max 5
|
|
|
1358 "*Maximum number of directory listings to be cached in efs-ls-cache.")
|
|
|
1359
|
|
|
1360 (defvar efs-mode-line-format " ftp(%d)"
|
|
|
1361 "Format string used to determine how FTP activity is shown on the mode line.
|
|
|
1362 It is passed to format, with second argument the number of active FTP
|
|
|
1363 sessions as an integer.")
|
|
|
1364
|
|
|
1365 (defvar efs-show-host-type-in-dired t
|
|
|
1366 "If non-nil, show the system type on the mode line of remote dired buffers.")
|
|
|
1367
|
|
|
1368 (defvar efs-ftp-activity-function nil
|
|
|
1369 "Function called to indicate FTP activity.
|
|
|
1370 It must have exactly one argument, the number of active FTP sessions as an
|
|
|
1371 integer.")
|
|
|
1372
|
|
|
1373 (defvar efs-ftp-program-name "ftp"
|
|
|
1374 "Name of FTP program to run.")
|
|
|
1375
|
|
|
1376 (defvar efs-ftp-program-args '("-i" "-n" "-g" "-v")
|
|
|
1377 "*A list of arguments passed to the FTP program when started.")
|
|
|
1378
|
|
|
1379 (defvar efs-ftp-prompt-regexp "^\\(ftp\\|Ftp\\|FTP\\)> *"
|
|
|
1380 "*Regular expression to match the prompt of your FTP client.")
|
|
|
1381
|
|
|
1382 (defvar efs-nslookup-program "nslookup"
|
|
|
1383 "*If non-NIL then a string naming nslookup program." )
|
|
|
1384
|
|
|
1385 (defvar efs-nslookup-on-connect nil
|
|
|
1386 "*If non-NIL then use nslookup to resolve the host name before connecting.")
|
|
|
1387
|
|
|
1388 (defvar efs-nslookup-threshold 1000
|
|
|
1389 "How many iterations efs waits on the nslookup program.
|
|
|
1390 Applies when nslookup is used to compute a fully qualified domain name
|
|
|
1391 for the local host, in the case when `system-name' does not return one.
|
|
|
1392 If you set this to nil, efs will wait an arbitrary amount of time to get
|
|
|
1393 output.")
|
|
|
1394
|
|
|
1395 (defvar efs-make-backup-files efs-unix-host-types
|
|
|
1396 "*A list of operating systems for which efs will make Emacs backup files.
|
|
|
1397 The backup files are made on the remote host.
|
|
|
1398
|
|
|
1399 For example:
|
|
|
1400 '\(unix sysV-unix bsd-unix apollo-unix dumb-unix\) makes sense, but
|
|
|
1401 '\(unix vms\) would be silly, since vms makes its own backups.")
|
|
|
1402
|
|
|
1403 ;; Is this variable really useful? We should try to figure a way to
|
|
|
1404 ;; do local copies on a remote machine that doesn't take forever.
|
|
|
1405 (defvar efs-backup-by-copying nil
|
|
|
1406 "*Version of `backup by copying' for remote files.
|
|
|
1407 If non-nil, remote files will be backed up by copying, instead of by renaming.
|
|
|
1408 Note the copying will be done by moving the file through the local host -- a
|
|
|
1409 very time consuming operation.")
|
|
|
1410
|
|
|
1411 ;;; Auto-save variables. Relevant for auto-save.el
|
|
|
1412
|
|
|
1413 (defvar efs-auto-save 0
|
|
|
1414 "*If 1, allows efs files to be auto-saved.
|
|
|
1415 If 0, suppresses auto-saving of efs files.
|
|
|
1416 Don't use any other value.")
|
|
|
1417
|
|
|
1418 (defvar efs-auto-save-remotely nil
|
|
|
1419 "*Determines where remote files are auto-saved.
|
|
|
1420
|
|
|
1421 If nil, auto-saves for remote files will be written in `auto-save-directory'
|
|
|
1422 or `auto-save-directory-fallback' if this isn't defined.
|
|
|
1423
|
|
|
1424 If non-nil, causes the auto-save file for an efs file to be written in
|
|
|
1425 the remote directory containing the file, rather than in a local directory.
|
|
|
1426 For remote files, this overrides a non-nil `auto-save-directory'. Local files
|
|
|
1427 are unaffected. If you want to use this feature, you probably only want to
|
|
|
1428 set this true in a few buffers, rather than globally. You might want to give
|
|
|
1429 each buffer its own value using `make-variable-buffer-local'. It is usually
|
|
|
1430 a good idea to auto-save remote files locally, because it is not only faster,
|
|
|
1431 but provides protection against a connection going down.
|
|
|
1432
|
|
|
1433 See also variable `efs-auto-save'.")
|
|
|
1434
|
|
|
1435 (defvar efs-short-circuit-to-remote-root nil
|
|
|
1436 "*Defines whether \"//\" short-circuits to the remote or local root.")
|
|
|
1437
|
|
|
1438 ;; Can we somehow grok this from system type? No.
|
|
|
1439 (defvar efs-local-apollo-unix
|
|
|
1440 (eq 0 (string-match "//" (or (getenv "HOME") (getenv "SHELL") "")))
|
|
|
1441 "*Defines whether the local machine is an apollo running Domain.
|
|
|
1442 This variable has nothing to do with efs, and should be basic to all
|
|
|
1443 of emacs.")
|
|
|
1444
|
|
|
1445 (defvar efs-root-umask nil
|
|
|
1446 "*umask to use for root logins.")
|
|
|
1447
|
|
|
1448 (defvar efs-anonymous-umask nil
|
|
|
1449 "*umask to use for anonymous logins.")
|
|
|
1450
|
|
|
1451 (defvar efs-umask nil
|
|
|
1452 "*umask to use for efs sessions.
|
|
|
1453 If this is nil, then the setting of umask on the local host is used.")
|
|
|
1454
|
|
|
1455 ;; Eliminate these variables when Sun gets around to getting its FTP server
|
|
|
1456 ;; out of the stone age.
|
|
|
1457 (defvar efs-ding-on-umask-failure t
|
|
|
1458 "*Ring the bell if the umask command fails on a unix host. Many servers don't
|
|
|
1459 support this command, so if you get a lot of annoying failures, set this
|
|
|
1460 to nil.")
|
|
|
1461
|
|
|
1462 (defvar efs-ding-on-chmod-failure t
|
|
|
1463 "*Ring the bell if the chmod command fails on a unix host. Some servers don't
|
|
|
1464 support this command, so if you get a lot of annoying failures, set this
|
|
|
1465 to nil.")
|
|
|
1466
|
|
|
1467 ;; Please let us know if you can contribute more entries to this guessing game.
|
|
|
1468 (defvar efs-nlist-cmd
|
|
|
1469 (cond
|
|
|
1470 ;; Covers Ultrix, SunOS, and NeXT.
|
|
|
1471 ((eq system-type 'berkeley-unix)
|
|
|
1472 "ls")
|
|
|
1473 ((memq system-type '(hpux aix-v3 silicon-graphics-unix))
|
|
|
1474 "nlist")
|
|
|
1475 ;; Blind guess
|
|
|
1476 ("ls"))
|
|
|
1477 "*FTP client command for getting a brief listing (NLST) from the FTP server.
|
|
|
1478 We try to guess this based on the local system-type, but obviously if you
|
|
|
1479 are using a gateway, you'll have to set it yourself.")
|
|
|
1480
|
|
|
1481 (defvar efs-compute-remote-buffer-file-truename nil
|
|
|
1482 "*If non-nil, `buffer-file-truename' will be computed for remote buffers.
|
|
|
1483 In emacs 19, each buffer has a local variable, `buffer-file-truename',
|
|
|
1484 which is used to ensure that symbolic links will not confuse emacs into
|
|
|
1485 visiting the same file with two buffers. This variable is computed by
|
|
|
1486 chasing all symbolic links in `buffer-file-name', both at the level of the
|
|
|
1487 file and at the level of all parent directories. Since this operation can be
|
|
|
1488 very time-consuming over FTP, this variable can be used to inhibit it.")
|
|
|
1489
|
|
|
1490 (defvar efs-buffer-name-case nil
|
|
|
1491 "*Selects the case used for buffer names of case-insensitive file names.
|
|
|
1492 Case-insensitive file names are files on hosts whose host type is in
|
|
|
1493 `efs-case-insensitive-host-types'.
|
|
|
1494
|
|
|
1495 If this is 'up upper case is used, if it is 'down lower case is used.
|
|
|
1496 If this has any other value, the case is inherited from the name used
|
|
|
1497 to access the file.")
|
|
|
1498
|
|
|
1499 (defvar efs-fancy-buffer-names "%s@%s"
|
|
|
1500 "Format used to compute names of buffers attached to remote files.
|
|
|
1501
|
|
|
1502 If this is nil, buffer names are computed in the usual way.
|
|
|
1503
|
|
|
1504 If it is a string, then the it is passed to format with second and third
|
|
|
1505 arguments the host name and file name.
|
|
|
1506
|
|
|
1507 Otherwise, it is assumed to be function taking three arguments, the host name,
|
|
|
1508 the user name, and the truncated file name. It should returns the name to
|
|
|
1509 be used for the buffer.")
|
|
|
1510
|
|
|
1511 (defvar efs-verify-anonymous-modtime nil
|
|
|
1512 "*Determines if efs checks modtimes for remote files on anonymous logins.
|
|
|
1513 If non-nil, efs runs `verify-visited-file-modtime' for remote files on
|
|
|
1514 anonymous ftp logins. Since verify-visited-file-modtime slows things down,
|
|
|
1515 and most people aren't editing files on anonymous ftp logins, this is nil
|
|
|
1516 by default.")
|
|
|
1517
|
|
|
1518 (defvar efs-verify-modtime-host-regexp ".*"
|
|
|
1519 "*Regexp to match host names for which efs checks file modtimes.
|
|
|
1520 If non-nil, efs will run `verify-visited-file-modtime' for remote
|
|
|
1521 files on hosts matching this regexp. If nil, verify-visited-file-modtime
|
|
|
1522 is supressed for all remote hosts. This is tested before
|
|
|
1523 `efs-verify-anonymous-modtime'.")
|
|
|
1524
|
|
|
1525 (defvar efs-maximize-idle nil
|
|
|
1526 "*If non-nil, efs will attempt to maximize the idle time out period.
|
|
|
1527 At some idle moment in the connection after login, efs will attempt to
|
|
|
1528 set the idle time out period to the maximum amount allowed by the server.
|
|
|
1529 It applies only to non-anonymous logins on unix hosts.")
|
|
|
1530
|
|
|
1531 (defvar efs-expire-ftp-buffers t
|
|
|
1532 "*If non-nil ftp buffers will be expired.
|
|
|
1533 The buffers will be killed either after `efs-ftp-buffer-expire-time' has
|
|
|
1534 elapsed with no activity, or the remote FTP server has timed out.")
|
|
|
1535
|
|
|
1536 (defvar efs-ftp-buffer-expire-time nil
|
|
|
1537 "*If non-nil, the time after which ftp buffers will be expired.
|
|
|
1538 If nil, ftp buffers will be expired only when the remote server has timed out.
|
|
|
1539 If an integer, ftp buffers will be expired either when the remote server
|
|
|
1540 has timed out, or when this many seconds on inactivity has elapsed.")
|
|
|
1541
|
|
|
1542 ;; If you need to increase this variable much, it is likely that
|
|
|
1543 ;; the true problem is timing errors between the efs process filter
|
|
|
1544 ;; and the FTP server. This could either be caused by the server
|
|
|
1545 ;; not following RFC959 response codes, or a bug in efs. In either
|
|
|
1546 ;; case please report the problem to us. If it's a bug, we'll fix it.
|
|
|
1547 ;; If the server is at fault we may try to do something. Our rule
|
|
|
1548 ;; of thumb is that we will support non-RFC959 behaviour, as long as
|
|
|
1549 ;; it doesn't risk breaking efs for servers which behave properly.
|
|
|
1550
|
|
|
1551 (defvar efs-retry-time 5
|
|
|
1552 "*Number of seconds to wait before retrying if data doesn't arrive.
|
|
|
1553 The FTP command isn't retried, rather efs just takes a second look
|
|
|
1554 for the data file. This might need to be increased for very slow FTP
|
|
|
1555 clients.")
|
|
|
1556
|
|
|
1557 (defvar efs-pty-check-threshold 1000
|
|
|
1558 "*How long efs waits before deciding that it doesn't have a pty.
|
|
|
1559 Specifically it is the number of iterations through `accept-process-output'
|
|
|
1560 that `efs-pty-p' waits before deciding that the pty is really a pipe.
|
|
|
1561 Set this to nil to inhibit checking for pty's. If efs seems to be
|
|
|
1562 mistaking some pty's for pipes, try increasing this number.")
|
|
|
1563
|
|
|
1564 (defvar efs-pty-check-retry-time 5
|
|
|
1565 "*Number of seconds that efs waits before retrying a pty check.
|
|
|
1566 This can be lengthened, if your FTP client is slow to start.")
|
|
|
1567
|
|
|
1568 (defvar efs-suppress-abort-recursive-edit-and-then nil
|
|
|
1569 "*If non-nil, `efs-abort-recursive-edit-and-then' will not run its function.
|
|
|
1570 This means that when a recursive edit is in progress, automatic popping of the
|
|
|
1571 FTP process buffer, and automatic popping of the bug report buffer will not
|
|
|
1572 work. `efs-abort-recursive-edit-and-then' works by forking a \"sleep 0\"
|
|
|
1573 process. On some unix implementations the forked process might be of the same
|
|
|
1574 size as the original GNU Emacs process. Forking such a large process just to
|
|
|
1575 do a \"sleep 0\" is probably not good.")
|
|
|
1576
|
|
|
1577 (defvar efs-ftp-buffer-format "*ftp %s@%s*"
|
|
|
1578 "Format to construct the name of FTP process buffers.
|
|
|
1579 This string is fed to `format' with second and third arguments the user
|
|
|
1580 name and host name.")
|
|
|
1581 ;; This does not affect the process name of the FTP client process.
|
|
|
1582 ;; That is always *ftp USER@HOST*
|
|
|
1583
|
|
|
1584 (defvar efs-debug-ftp-connection nil
|
|
|
1585 "*If non-nil, the user will be permitted to debug the FTP connection.
|
|
|
1586 This means that typing a C-g to the FTP process filter will give the user
|
|
|
1587 the option to type commands at the FTP connection. Normally, the connection
|
|
|
1588 is killed first. Note that doing this may result in the FTP process filter
|
|
|
1589 getting out of synch with the FTP client, so using this feature routinely
|
|
|
1590 isn't recommended.")
|
|
|
1591
|
|
|
1592 ;;; Hooks and crooks.
|
|
|
1593
|
|
|
1594 (defvar efs-ftp-startup-hook nil
|
|
|
1595 "Hook to run immediately after starting the FTP client.
|
|
|
1596 This hook is run before the FTP OPEN command is sent.")
|
|
|
1597
|
|
|
1598 (defvar efs-ftp-startup-function-alist nil
|
|
|
1599 "Association list of functions to running after FTP login.
|
|
|
1600 This should be an alist of the form '\(\(REGEXP . FUNCTION\) ...\), where
|
|
|
1601 REGEXP is a regular expression matched against the name of the remote host,
|
|
|
1602 and FUNCTION is a function of two arguments, HOST and USER. REGEXP is
|
|
|
1603 compared to the host name with `case-fold-search' bound to t. Only the first
|
|
|
1604 match in the alist is run.")
|
|
|
1605
|
|
|
1606 (defvar efs-load-hook nil
|
|
|
1607 "Hook to run immediately after loading efs.el.
|
|
|
1608 You can use it to alter definitions in efs.el, but why would you want
|
|
|
1609 to do such a thing?")
|
|
|
1610
|
|
|
1611 ;;;; -----------------------------------------------------------
|
|
|
1612 ;;;; Regexps for parsing FTP server responses.
|
|
|
1613 ;;;; -----------------------------------------------------------
|
|
|
1614 ;;;
|
|
|
1615 ;;; If you have to tune these variables, please let us know, so that
|
|
|
1616 ;;; we can get them right in the next release.
|
|
|
1617
|
|
|
1618 (defvar efs-multi-msgs
|
|
|
1619 ;; RFC959 compliant codes
|
|
|
1620 "^[1-5][0-5][0-7]-")
|
|
|
1621 ;; Regexp to match the start of an FTP server multiline reply.
|
|
|
1622
|
|
|
1623 (defvar efs-skip-msgs
|
|
|
1624 ;; RFC959 compliant codes
|
|
|
1625 (concat
|
|
|
1626 "^110 \\|" ; Restart marker reply.
|
|
|
1627 "^125 \\|" ; Data connection already open; transfer starting.
|
|
|
1628 "^150 ")) ; File status OK; about to open connection.
|
|
|
1629 ;; Regexp to match an FTP server response which we wish to ignore.
|
|
|
1630
|
|
|
1631 (defvar efs-cmd-ok-msgs
|
|
|
1632 ;; RFC959 compliant
|
|
|
1633 "^200 \\|^227 ")
|
|
|
1634 ;; Regexp to match the server command OK response.
|
|
|
1635 ;; Because PORT commands return this we usually ignore it. However, it is
|
|
|
1636 ;; a valid response for TYPE, SITE, and a few other commands (cf. RFC 959).
|
|
|
1637 ;; If we are explicitly sending a PORT, or one of these other commands,
|
|
|
1638 ;; then we don't want to ignore this response code. Also use this to match
|
|
|
1639 ;; the return code for PASV, as some clients burp these things out at odd
|
|
|
1640 ;; times.
|
|
|
1641
|
|
|
1642 (defvar efs-pending-msgs
|
|
|
1643 ;; RFC959 compliant
|
|
|
1644 "^350 ") ; Requested file action, pending further information.
|
|
|
1645 ;; Regexp to match the \"requested file action, pending further information\"
|
|
|
1646 ;; message. These are usually ignored, except if we are using RNFR to test for
|
|
|
1647 ;; file existence.
|
|
|
1648
|
|
|
1649 (defvar efs-cmd-ok-cmds
|
|
|
1650 (concat
|
|
|
1651 "^quote port \\|^type \\|^quote site \\|^chmod \\|^quote noop\\|"
|
|
|
1652 "^quote pasv"))
|
|
|
1653 ;; Regexp to match commands for which efs-cmd-ok-msgs is a valid server
|
|
|
1654 ;; response for success.
|
|
|
1655
|
|
|
1656 (defvar efs-passwd-cmds
|
|
|
1657 "^quote pass \\|^quote acct \\|^quote site gpass ")
|
|
|
1658 ;; Regexp to match commands for sending passwords.
|
|
|
1659 ;; All text following (match-end 0) will be replaced by "Turtle Power!"
|
|
|
1660
|
|
|
1661 (defvar efs-bytes-received-msgs
|
|
|
1662 ;; Strictly a client response
|
|
|
1663 "^[0-9]+ bytes ")
|
|
|
1664 ;; Regexp to match the reply from the FTP client that it has finished
|
|
|
1665 ;; receiving data.
|
|
|
1666
|
|
|
1667 (defvar efs-server-confused-msgs
|
|
|
1668 ;; ka9q uses this to indicate an incorrectly set transfer mode, and
|
|
|
1669 ;; then does send a second completion code for the command. This does
|
|
|
1670 ;; *not* conform to RFC959.
|
|
|
1671 "^100 Warning: type is ")
|
|
|
1672 ;; Regexp to match non-standard response from the FTP server. This can
|
|
|
1673 ;; sometimes be the result of an incorrectly set transfer mode. In this case
|
|
|
1674 ;; we do not rely on the server to tell us when the data transfer is complete,
|
|
|
1675 ;; but check with the client.
|
|
|
1676
|
|
|
1677 (defvar efs-good-msgs
|
|
|
1678 (concat
|
|
|
1679 ;; RFC959 compliant codes
|
|
|
1680 "^2[01345][0-7] \\|" ; 2yz = positive completion reply
|
|
|
1681 "^22[02-7] \\|" ; 221 = successful logout
|
|
|
1682 ; (Sometimes get this with a timeout,
|
|
|
1683 ; so treat as fatal.)
|
|
|
1684 "^3[0-5][0-7] \\|" ; 3yz = positive intermediate reply
|
|
|
1685 ;; client codes
|
|
|
1686 "^[Hh]ash mark "))
|
|
|
1687 ;; Response to indicate that the requested action was successfully completed.
|
|
|
1688
|
|
|
1689 (defvar efs-failed-msgs
|
|
|
1690 (concat
|
|
|
1691 ;; RFC959 compliant codes
|
|
|
1692 "^120 \\|" ; Service ready in nnn minutes.
|
|
|
1693 "^450 \\|" ; File action not taken; file is unavailable, or busy.
|
|
|
1694 "^452 \\|" ; Insufficient storage space on system.
|
|
|
1695 "^5[0-5][0-7] \\|" ; Permanent negative reply codes.
|
|
|
1696 ;; When clients tell us that a file doesn't exist, or can't access.
|
|
|
1697 "^\\(local: +\\)?/[^ ]* +"
|
|
|
1698 "\\([Nn]o such file or directory\\|[Nn]ot a plain file\\|"
|
|
|
1699 "The file access permissions do not allow \\|Is a directory\\b\\)"))
|
|
|
1700 ;; Regexp to match responses for failed commands. However, the ftp connection
|
|
|
1701 ;; is assumed to be good.
|
|
|
1702
|
|
|
1703 (defvar efs-fatal-msgs
|
|
|
1704 (concat
|
|
|
1705 ;; RFC959 codes
|
|
|
1706 "^221 \\|" ; Service closing control connection.
|
|
|
1707 "^421 \\|" ; Service not available.
|
|
|
1708 "^425 \\|" ; Can't open data connection.
|
|
|
1709 "^426 \\|" ; Connection closed, transfer aborted.
|
|
|
1710 "^451 \\|" ; Requested action aborted, local error in processing.
|
|
|
1711 ;; RFC959 non-compliant codes
|
|
|
1712 "^552 Maximum Idle Time Exceded\\.$\\|" ; Hellsoft server uses this to
|
|
|
1713 ; indicate a timeout. 552 is
|
|
|
1714 ; supposed to be used for exceeded
|
|
|
1715 ; storage allocation. Note that
|
|
|
1716 ; they also misspelled the error
|
|
|
1717 ; message.
|
|
|
1718 ;; client problems
|
|
|
1719 "^ftp: \\|^Not connected\\|^rcmd: \\|^No control connection\\|"
|
|
|
1720 "^unknown host\\|: unknown host$\\|^lost connection\\|"
|
|
|
1721 "^[Ss]egmentation fault\\|"
|
|
|
1722 ;; Make sure that the "local: " isn't just a message about a file.
|
|
|
1723 "^local: [^/]\\|"
|
|
|
1724 ;; Gateways
|
|
|
1725 "^iftp: cannot authenticate to server\\b"
|
|
|
1726 ))
|
|
|
1727 ;; Regexp to match responses that something has gone drastically wrong with
|
|
|
1728 ;; either the client, server, or connection. We kill the ftp process, and start
|
|
|
1729 ;; anew.
|
|
|
1730
|
|
|
1731 (defvar efs-unknown-response-msgs
|
|
|
1732 "^[0-9][0-9][0-9] ")
|
|
|
1733 ;; Regexp to match server response codes that we don't understand. This
|
|
|
1734 ;; is tested after all the other regexp, so it can match everything.
|
|
|
1735
|
|
|
1736 (defvar efs-pasv-msgs
|
|
|
1737 ;; According to RFC959.
|
|
|
1738 "^227 .*(\\([0-9]+,[0-9]+,[0-9]+,[0-9]+,[0-9]+,[0-9]+\\))$")
|
|
|
1739 ;; Matches the output of a PASV. (match-beginning 1) and (match-end 1)
|
|
|
1740 ;; must bracket the IP address and port.
|
|
|
1741
|
|
|
1742 (defvar efs-syst-msgs "^215 \\|^210 ")
|
|
|
1743 ;; 215 is RFC959. Plan 9 FTP server returns a 210. 210 is not assigned in
|
|
|
1744 ;; RFC 959.
|
|
|
1745 ;; The plan 9 people tell me that they fixed this. -- sr 18/4/94
|
|
|
1746 ;; Matches the output of a SYST.
|
|
|
1747
|
|
|
1748 (defvar efs-mdtm-msgs
|
|
|
1749 (concat
|
|
|
1750 "^213 [0-9][0-9][0-9][0-9][0-9][0-9][0-9]"
|
|
|
1751 "[0-9][0-9][0-9][0-9][0-9][0-9][0-9]$"))
|
|
|
1752 ;; Regexp to match the output of a quote mdtm command.
|
|
|
1753
|
|
|
1754 (defvar efs-idle-msgs
|
|
|
1755 "^200 [^0-9]+ \\([0-9]+\\)[^0-9]* max \\([0-9]+\\)")
|
|
|
1756 ;; Regexp to match the output of a SITE IDLE command.
|
|
|
1757 ;; Match 1 should refer to the current idle time, and match 2 the maximum
|
|
|
1758 ;; idle time.
|
|
|
1759
|
|
|
1760 (defvar efs-write-protect-msgs "^532 ") ; RFC959
|
|
|
1761 ;; Regexp to match a server ressponse to indicate that a STOR failed
|
|
|
1762 ;; because of insufficient write privileges.
|
|
|
1763
|
|
|
1764 (defvar efs-hash-mark-msgs
|
|
|
1765 "[hH]ash mark [^0-9]*\\([0-9]+\\)")
|
|
|
1766 ;; Regexp matching the FTP client's output upon doing a HASH command.
|
|
|
1767
|
|
|
1768 (defvar efs-xfer-size-msgs
|
|
|
1769 (concat
|
|
|
1770 ;; UN*X
|
|
|
1771 "^150 .* connection for .* (\\([0-9]+\\) bytes)\\|"
|
|
|
1772 ;; Wollongong VMS server.
|
|
|
1773 "^125 .* transfer started for .* (\\([0-9]+\\) bytes)\\|"
|
|
|
1774 ;; TOPS-20 server
|
|
|
1775 "^150 .* retrieve of .* ([0-9]+ pages?, \\([0-9]+\\) 7-bit bytes)"))
|
|
|
1776 ;; Regular expression used to determine the number of bytes
|
|
|
1777 ;; in a FTP transfer. The first (match-beginning #) which is non-nil is assumed
|
|
|
1778 ;; to give the size.
|
|
|
1779
|
|
|
1780 (defvar efs-expand-dir-msgs "^550 \\([^: ]+\\):")
|
|
|
1781 ;; Regexp to match the error response from a "get ~sandy".
|
|
|
1782 ;; By parsing the error, we can get a quick expansion of ~sandy
|
|
|
1783 ;; According to RFC 959, should be a 550.
|
|
|
1784
|
|
|
1785 (defvar efs-gateway-fatal-msgs
|
|
|
1786 "No route to host\\|Connection closed\\|No such host\\|Login incorrect")
|
|
|
1787 ;; Regular expression matching messages from the rlogin / telnet process that
|
|
|
1788 ;; indicates that logging in to the gateway machine has gone wrong.
|
|
|
1789
|
|
|
1790 (defvar efs-too-many-users-msgs
|
|
|
1791 ;; The test for "two many" is because some people can't spell.
|
|
|
1792 ;; I allow for up to two adjectives before "users".
|
|
|
1793 (concat
|
|
|
1794 "\\b[Tt][wo]o many\\( +[^ \n]+\\)?\\( +[^ \n]+\\)? +users\\b\\|"
|
|
|
1795 "\\btry back later\\b"))
|
|
|
1796 ;; Regular expresion to match what servers output when there are too many
|
|
|
1797 ;; anonymous logins. It is assumed that this is part of a 530 or 530- response
|
|
|
1798 ;; to USER or PASS.
|
|
|
1799
|
|
|
1800 ;;;; -------------------------------------------------------------
|
|
|
1801 ;;;; Buffer local FTP process variables
|
|
|
1802 ;;;; -------------------------------------------------------------
|
|
|
1803
|
|
|
1804 ;;; Variables buffer local to the process buffers are
|
|
|
1805 ;;; named with the prefix efs-process-
|
|
|
1806
|
|
|
1807 (defvar efs-process-q nil)
|
|
|
1808 ;; List of functions to be performed asynch.
|
|
|
1809 (make-variable-buffer-local 'efs-process-q)
|
|
|
1810
|
|
|
1811 (defvar efs-process-cmd-waiting nil)
|
|
|
1812 ;; Set to t if a process has a synchronous cmd waiting to execute.
|
|
|
1813 ;; In this case, it will allow the synch. cmd to run before returning to
|
|
|
1814 ;; the cmd queue.
|
|
|
1815 (make-variable-buffer-local 'efs-process-cmd-waiting)
|
|
|
1816
|
|
|
1817 (defvar efs-process-server-confused nil)
|
|
|
1818 (make-variable-buffer-local 'efs-process-server-confused)
|
|
|
1819
|
|
|
1820 (defvar efs-process-cmd nil)
|
|
|
1821 ;; The command currently being executed, as a string.
|
|
|
1822 (make-variable-buffer-local 'efs-process-cmd)
|
|
|
1823
|
|
|
1824 (defvar efs-process-xfer-size 0)
|
|
|
1825 (make-variable-buffer-local 'efs-process-xfer-size)
|
|
|
1826
|
|
|
1827 (defvar efs-process-umask nil)
|
|
|
1828 ;; nil if the umask hash not been set
|
|
|
1829 ;; an integer (the umask) if the umask has been set
|
|
|
1830 (make-variable-buffer-local 'efs-process-umask)
|
|
|
1831
|
|
|
1832 (defvar efs-process-idle-time nil)
|
|
|
1833 ;; If non-nil, the idle time of the server in seconds.
|
|
|
1834 (make-variable-buffer-local 'efs-process-idle-time)
|
|
|
1835
|
|
|
1836 (defvar efs-process-busy nil)
|
|
|
1837 (make-variable-buffer-local 'efs-process-busy)
|
|
|
1838
|
|
|
1839 (defvar efs-process-result-line "")
|
|
|
1840 (make-variable-buffer-local 'efs-process-result-line)
|
|
|
1841
|
|
|
1842 (defvar efs-process-result nil)
|
|
|
1843 (make-variable-buffer-local 'efs-process-result)
|
|
|
1844
|
|
|
1845 (defvar efs-process-result-cont-lines "")
|
|
|
1846 (make-variable-buffer-local 'efs-process-result-cont-lines)
|
|
|
1847
|
|
|
1848 (defvar efs-process-msg "")
|
|
|
1849 (make-variable-buffer-local 'efs-process-msg)
|
|
|
1850
|
|
|
1851 (defvar efs-process-nowait nil)
|
|
|
1852 (make-variable-buffer-local 'efs-process-nowait)
|
|
|
1853
|
|
|
1854 (defvar efs-process-string "")
|
|
|
1855 (make-variable-buffer-local 'efs-process-string)
|
|
|
1856
|
|
|
1857 (defvar efs-process-continue nil)
|
|
|
1858 (make-variable-buffer-local 'efs-process-continue)
|
|
|
1859
|
|
|
1860 (defvar efs-process-hash-mark-count 0)
|
|
|
1861 (make-variable-buffer-local 'efs-process-hash-mark-count)
|
|
|
1862
|
|
|
1863 (defvar efs-process-hash-mark-unit nil)
|
|
|
1864 (make-variable-buffer-local 'efs-process-hash-mark-unit)
|
|
|
1865
|
|
|
1866 (defvar efs-process-last-percent -1)
|
|
|
1867 (make-variable-buffer-local 'efs-process-last-percent)
|
|
|
1868
|
|
|
1869 (defvar efs-process-host nil)
|
|
|
1870 (make-variable-buffer-local 'efs-process-host)
|
|
|
1871
|
|
|
1872 (defvar efs-process-user nil)
|
|
|
1873 (make-variable-buffer-local 'efs-process-user)
|
|
|
1874
|
|
|
1875 (defvar efs-process-host-type nil)
|
|
|
1876 ;; Holds the host-type as a string, for showing it on the mode line.
|
|
|
1877 (make-variable-buffer-local 'efs-process-host-type)
|
|
|
1878
|
|
|
1879 (defvar efs-process-xfer-type nil)
|
|
|
1880 ;; Set to one of 'ascii, 'ebcdic, 'image, 'tenex, or nil to indicate
|
|
|
1881 ;; the current setting of the transfer type for the connection. nil means
|
|
|
1882 ;; that we don't know.
|
|
|
1883 (make-variable-buffer-local 'efs-process-xfer-type)
|
|
|
1884
|
|
|
1885 (defvar efs-process-client-altered-xfer-type nil)
|
|
|
1886 ;; Sometimes clients alter the xfer type, such as doing
|
|
|
1887 ;; an ls it is changed to ascii. If we are using quoted commands
|
|
|
1888 ;; to do xfers the client doesn't get a chance to set it back.
|
|
|
1889 (make-variable-buffer-local 'efs-process-client-altered-xfer-type)
|
|
|
1890
|
|
|
1891 (defvar efs-process-prompt-regexp nil)
|
|
|
1892 ;; local value of prompt of FTP client.
|
|
|
1893 (make-variable-buffer-local 'efs-process-prompt-regexp)
|
|
|
1894
|
|
|
1895 (defvar efs-process-cmd-counter 0)
|
|
|
1896 ;; Counts FTP commands, mod 16.
|
|
|
1897 (make-variable-buffer-local 'efs-process-cmd-counter)
|
|
|
1898
|
|
|
1899 ;;;; ------------------------------------------------------------
|
|
|
1900 ;;;; General Internal Variables.
|
|
|
1901 ;;;; ------------------------------------------------------------
|
|
|
1902
|
|
|
1903 ;;; For the byte compiler
|
|
|
1904 ;;
|
|
|
1905 ;; These variables are usually unbound. We are just notifying the
|
|
|
1906 ;; byte compiler that we know what we are doing.
|
|
|
1907
|
|
|
1908 (defvar bv-length) ; getting file versions.
|
|
|
1909 (defvar default-file-name-handler-alist) ; for file-name-handler-alist
|
|
|
1910 (defvar efs-completion-dir) ; for file name completion predicates
|
|
|
1911 (defvar dired-directory) ; for default actions in interactive specs
|
|
|
1912 (defvar dired-local-variables-file) ; for inhibiting child look ups
|
|
|
1913 (defvar dired-in-query) ; don't clobber dired queries with stat messages
|
|
|
1914 (defvar after-load-alist) ; in case we're in emacs 18.
|
|
|
1915 (defvar comint-last-input-start)
|
|
|
1916 (defvar comint-last-input-end)
|
|
|
1917 (defvar explicit-shell-file-name)
|
|
|
1918
|
|
|
1919 ;;; fluid vars
|
|
|
1920
|
|
|
1921 (defvar efs-allow-child-lookup t)
|
|
|
1922 ;; let-bind to nil, if want to inhibit child lookups.
|
|
|
1923
|
|
|
1924 (defvar efs-nested-cmd nil)
|
|
|
1925 ;; let-bound to t, when a cmd is executed by a cont or pre-cont.
|
|
|
1926 ;; Such cmds will never end by looking at the next item in the queue,
|
|
|
1927 ;; if they are run synchronously, but rely on their calling function
|
|
|
1928 ;; to do this.
|
|
|
1929
|
|
|
1930 ;;; polling ftp buffers
|
|
|
1931
|
|
|
1932 (defvar efs-ftp-buffer-poll-time 300
|
|
|
1933 "Period, in seconds, which efs will poll ftp buffers for activity.
|
|
|
1934 Used for expiring \(killing\) inactive ftp buffers.")
|
|
|
1935
|
|
|
1936 (defconst efs-ftp-buffer-alist nil)
|
|
|
1937 ;; alist of ftp buffers, and the total number of seconds that they
|
|
|
1938 ;; have been idle.
|
|
|
1939
|
|
|
1940 ;;; load extensions
|
|
|
1941
|
|
|
1942 (defvar efs-load-lisp-extensions '(".elc" ".el" "")
|
|
|
1943 "List of extensions to try when loading lisp files.")
|
|
|
1944
|
|
|
1945 ;;; mode-line
|
|
|
1946
|
|
|
1947 (defvar efs-mode-line-string "")
|
|
|
1948 ;; Stores the string that efs displays on the mode line.
|
|
|
1949
|
|
|
1950 ;;; data & temporary buffers
|
|
|
1951
|
|
|
1952 (defvar efs-data-buffer-name " *ftp data*")
|
|
|
1953 ;; Buffer name to hold directory listing data received from ftp process.
|
|
|
1954
|
|
|
1955 (defvar efs-data-buffer-name-2 " *ftp data-2*")
|
|
|
1956 ;; A second buffer name in which to hold directory listings.
|
|
|
1957 ;; Used for listings which are made during another directory listing.
|
|
|
1958
|
|
|
1959 ;;; process names
|
|
|
1960
|
|
|
1961 (defvar efs-ctime-process-name-format "*efs ctime %s*")
|
|
|
1962 ;; Passed to format with second arg the host name.
|
|
|
1963
|
|
|
1964 ;;; For temporary files.
|
|
|
1965
|
|
|
1966 ;; This is a list of symbols.
|
|
|
1967 (defconst efs-tmp-name-files ())
|
|
|
1968 ;; Here is where these symbols live:
|
|
|
1969 (defconst efs-tmp-name-obarray (make-vector 7 0))
|
|
|
1970 ;; We put our version of the emacs PID here:
|
|
|
1971 (defvar efs-pid nil)
|
|
|
1972
|
|
|
1973 ;;; For abort-recursive-edit
|
|
|
1974
|
|
|
1975 (defvar efs-abort-recursive-edit-data nil)
|
|
|
1976 (defvar efs-abort-recursive-edit-delay 5)
|
|
|
1977 ;; Number of seconds after which efs-abort-recursive-edit-and-then
|
|
|
1978 ;; will decide not to runs its sentinel. The assumption is that something
|
|
|
1979 ;; went wrong.
|
|
|
1980
|
|
|
1981 ;;; hashtables (Use defconst's to clobber any user silliness.)
|
|
|
1982
|
|
|
1983 (defconst efs-files-hashtable (efs-make-hashtable 97))
|
|
|
1984 ;; Hash table for storing directories and their respective files.
|
|
|
1985
|
|
|
1986 (defconst efs-expand-dir-hashtable (efs-make-hashtable))
|
|
|
1987 ;; Hash table of tilde expansions for remote directories.
|
|
|
1988
|
|
|
1989 (defconst efs-ls-converter-hashtable (efs-make-hashtable 37))
|
|
|
1990 ;; Hashtable for storing functions to convert listings from one
|
|
|
1991 ;; format to another. Keys are the required switches, and the values
|
|
|
1992 ;; are alist of the form ((SWITCHES . CONVERTER)...) where is SWITCHES
|
|
|
1993 ;; are the listing switches for the original listing, and CONVERTER is a
|
|
|
1994 ;; function of one-variable, the listing-type, to do the conversion
|
|
|
1995 ;; on data in the current buffer. SWITCHES is either a string, or nil.
|
|
|
1996 ;; nil means that the listing can be converted from cache in
|
|
|
1997 ;; efs-files-hashtable, a string from cache in efs-ls-cache. For the latter,
|
|
|
1998 ;; listings with no switches (dumb listings), represent SWITCHES as a string
|
|
|
1999 ;; consisting only of the ASCII null character.
|
|
|
2000
|
|
|
2001 ;;; cache variables (Use defconst's to clobber any user sillines.)
|
|
|
2002
|
|
|
2003 (defconst efs-ls-cache nil
|
|
|
2004 "List of results from efs-ls.
|
|
|
2005 Each entry is a list of four elements, the file listed, the switches used
|
|
|
2006 \(nil if none\), the listing string, and whether this string has already been
|
|
|
2007 parsed.")
|
|
|
2008
|
|
|
2009 (defvar efs-ls-uncache nil)
|
|
|
2010 ;; let-bind this to t, if you want to be sure that efs-ls will replace any
|
|
|
2011 ;; cache entries.
|
|
|
2012
|
|
|
2013 ;; This is a cache to see if the user has changed
|
|
|
2014 ;; completion-ignored-extensions.
|
|
|
2015 (defconst efs-completion-ignored-extensions completion-ignored-extensions
|
|
|
2016 "This variable is internal to efs. Do not set.
|
|
|
2017 See completion-ignored-extensions, instead.")
|
|
|
2018
|
|
|
2019 ;; We cache the regexp we use for completion-ignored-extensions. This
|
|
|
2020 ;; saves building a string every time we do completion. String construction
|
|
|
2021 ;; is costly in emacs.
|
|
|
2022 (defconst efs-completion-ignored-pattern
|
|
|
2023 (mapconcat (function
|
|
|
2024 (lambda (s) (if (stringp s)
|
|
|
2025 (concat (regexp-quote s) "$")
|
|
|
2026 "/"))) ; / never in filename
|
|
|
2027 efs-completion-ignored-extensions
|
|
|
2028 "\\|")
|
|
|
2029 "This variable is internal to efs. Do not set.
|
|
|
2030 See completion-ignored-extensions, instead.")
|
|
|
2031
|
|
|
2032 (defvar efs-system-fqdn nil
|
|
|
2033 "Cached value of the local systems' fully qualified domain name.")
|
|
|
2034
|
|
|
2035 ;;; The file-type-alist
|
|
|
2036
|
|
|
2037 ;; efs-file-type-alist is an alist indexed by host-type
|
|
|
2038 ;; which stores data on how files are structured on the given
|
|
|
2039 ;; host-type. Each entry is a list of three elements. The first is the
|
|
|
2040 ;; definition of a `byte', the second the native character representation,
|
|
|
2041 ;; and the third, the file structure.
|
|
|
2042 ;;
|
|
|
2043 ;; Meanings of the symbols:
|
|
|
2044 ;; ------------------------
|
|
|
2045 ;; The byte symbols:
|
|
|
2046 ;; 8-bit = bytes of 8-bits
|
|
|
2047 ;; 36-bit-wa = 36-bit word aligned. Precisely, the addressing unit is that
|
|
|
2048 ;; of a PDP-10 using the "<440700,,0> byte pointer".
|
|
|
2049 ;;
|
|
|
2050 ;; The native character set symbols:
|
|
|
2051 ;; 8-ascii = 8-bit NVT-ASCII
|
|
|
2052 ;; 7-ascii = 7-bit ascii as on a PDP-10
|
|
|
2053 ;; ebcdic = EBCDIC as on an IBM mainframe
|
|
|
2054 ;; lispm = the native character set on a lispm (Symbolics and LMI)
|
|
|
2055 ;; mts = native character representation in the Michigan Terminal System
|
|
|
2056 ;; (which runs on IBM and Amdal mainframes), similar to ebcdic
|
|
|
2057 ;;
|
|
|
2058 ;; The file structure symbols:
|
|
|
2059 ;;
|
|
|
2060 ;; file-nl = data is stored as a contiguous sequence of data bytes
|
|
|
2061 ;; with EOL denoted by <NL>.
|
|
|
2062 ;; file-crlf = data is stored as a contiguous sequence of data bytes
|
|
|
2063 ;; with EOL denoted by <CR-LF>
|
|
|
2064 ;; record = data is stored as a sequence of records
|
|
|
2065 ;; file-lispm = data as stored on a lispm. i.e. a sequence of bits
|
|
|
2066 ;; with EOL denoted by character code 138 (?)
|
|
|
2067 ;;
|
|
|
2068 ;; If we've messed anything up here, please let us know.
|
|
|
2069
|
|
|
2070 (defvar efs-file-type-alist
|
|
|
2071 '((unix . (8-bit 8-ascii file-nl))
|
|
|
2072 (sysV-unix . (8-bit 8-ascii file-nl))
|
|
|
2073 (bsd-unix . (8-bit 8-ascii file-nl))
|
|
|
2074 (apollo-unix . (8-bit 8-ascii file-nl))
|
|
|
2075 (dumb-apollo-unix . (8-bit 8-ascii file-nl))
|
|
|
2076 (dumb-unix . (8-bit 8-ascii file-nl))
|
|
|
2077 (super-dumb-unix . (8-bit 8-ascii file-nl))
|
|
|
2078 (guardian . (8-bit ascii file-nl))
|
|
|
2079 (plan9 . (8-bit 8-ascii file-nl))
|
|
|
2080 (dos . (8-bit 8-ascii file-crlf))
|
|
|
2081 (ms-unix . (8-bit 8-ascii file-crlf))
|
|
|
2082 (netware . (8-bit 8-ascii file-crlf))
|
|
|
2083 (os2 . (8-bit 8-ascii file-crlf))
|
|
|
2084 (tops-20 . (36-bit-wa 7-ascii file-crlf))
|
|
|
2085 (mpe . (8-bit 8-ascii record))
|
|
|
2086 (mvs . (8-bit ebcdic record))
|
|
|
2087 (cms . (8-bit ebcdic record))
|
|
|
2088 (cms-knet . (8-bit ebcdic record))
|
|
|
2089 (mts . (8-bit mts record)) ; mts seems to have its own char rep.
|
|
|
2090 ; Seems to be close to ebcdic, but not the same.
|
|
|
2091 (dos-distinct . (8-bit 8-ascii file-crlf))
|
|
|
2092 (ka9q . (8-bit 8-ascii file-crlf))
|
|
|
2093 (vms . (8-bit 8-ascii record)) ; The mysteries of VMS's RMS.
|
|
|
2094 (hell . (8-bit 8-ascii file-crlf))
|
|
|
2095 (vos . (8-bit 8-ascii record))
|
|
|
2096 (ti-explorer . (8-bit lispm file-lispm)) ; lispms use a file structure, but
|
|
|
2097 ; use an out of range char to
|
|
|
2098 ; indicate EOL.
|
|
|
2099 (ti-twenex . (8-bit lispm file-lispm))
|
|
|
2100 (nos-ve . (8-bit 8-ascii record))
|
|
|
2101 (coke . (8-bit 8-ascii file-nl)) ; only support 8-bit beverages
|
|
|
2102 (nil . (8-bit 8-ascii file-nl)))) ; the local host
|
|
|
2103
|
|
|
2104 ;;; Status messages
|
|
|
2105
|
|
|
2106 (defvar efs-last-message-time -86400) ; yesterday
|
|
|
2107 ;; The time of the last efs status message. c.f. efs-message-interval
|
|
|
2108
|
|
|
2109 ;;; For handling dir listings
|
|
|
2110
|
|
|
2111 ;; This MUST match all the way to to the start of the filename.
|
|
|
2112 ;; This version corresponds to what dired now uses (sandy, 14.1.93)
|
|
|
2113 (defvar efs-month-and-time-regexp
|
|
|
2114 (concat
|
|
|
2115 " \\([0-9]+\\) +" ; file size
|
|
|
2116 "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|June?\\|July?\\|Aug\\|Sep\\|Oct"
|
|
|
2117 ; June and July are for HP-UX 9.0
|
|
|
2118 "\\|Nov\\|Dec\\) \\([ 0-3][0-9]\\)\\("
|
|
|
2119 " [012][0-9]:[0-6][0-9] \\|" ; time
|
|
|
2120 " [12][90][0-9][0-9] \\|" ; year on IRIX, NeXT, SunOS, ULTRIX, Apollo
|
|
|
2121 ; HP-UX, A/UX
|
|
|
2122 " [12][90][0-9][0-9] \\)" ; year on AIX
|
|
|
2123 ))
|
|
|
2124
|
|
|
2125 (defvar efs-month-alist
|
|
|
2126 '(("Jan" . 1) ("Feb". 2) ("Mar" . 3) ("Apr" . 4) ("May" . 5) ("Jun" . 6)
|
|
|
2127 ("June" . 6) ("Jul" . 7) ("July" . 7) ("Aug" . 8) ("Sep" . 9) ("Oct" . 10)
|
|
|
2128 ("Nov" . 11) ("Dec" . 12)))
|
|
|
2129
|
|
|
2130 ;; Matches the file modes, link number, and owner string.
|
|
|
2131 ;; The +/- is for extended file access permissions.
|
|
|
2132 (defvar efs-modes-links-owner-regexp
|
|
|
2133 (concat
|
|
|
2134 "\\([^ ][-r][-w][^ ][-r][-w][^ ][-r][-w][^ ]\\)[-+]? *\\([0-9]+\\)"
|
|
|
2135 " +\\([^ ]+\\) "))
|
|
|
2136
|
|
|
2137 ;;;; ---------------------------------------------------------------
|
|
|
2138 ;;;; efs-dired variables
|
|
|
2139 ;;;; ---------------------------------------------------------------
|
|
|
2140
|
|
|
2141 ;; These variables must be here, instead of in efs-dired.el, because
|
|
|
2142 ;; the efs-HOST-TYPE.el files need to add to it.
|
|
|
2143 (defvar efs-dired-re-exe-alist nil
|
|
|
2144 "Association list of regexps which match file lines of executable files.")
|
|
|
2145
|
|
|
2146 (defvar efs-dired-re-dir-alist nil
|
|
|
2147 "Association list of regexps which match file lines of subdirectories.")
|
|
|
2148
|
|
|
2149 (defvar efs-dired-host-type nil
|
|
|
2150 "Host type of a dired buffer. \(buffer local\)")
|
|
|
2151 (make-variable-buffer-local 'efs-dired-host-type)
|
|
|
2152
|
|
|
2153 (defvar efs-dired-listing-type nil
|
|
|
2154 "Listing type of a dired buffer. \(buffer local\)")
|
|
|
2155 (make-variable-buffer-local 'efs-dired-listing-type)
|
|
|
2156
|
|
|
2157 (defvar efs-dired-listing-type-string nil)
|
|
|
2158 (make-variable-buffer-local 'efs-dired-listing-type-string)
|
|
|
2159
|
|
|
2160 ;;;; -------------------------------------------------------------
|
|
|
2161 ;;;; New error symbols.
|
|
|
2162 ;;;; -------------------------------------------------------------
|
|
|
2163
|
|
|
2164 (put 'ftp-error 'error-conditions '(ftp-error file-error error))
|
|
|
2165 ;; (put 'ftp-error 'error-message "FTP error")
|
|
|
2166
|
|
|
2167
|
|
|
2168 ;;;; =============================================================
|
|
|
2169 ;;;; >3
|
|
|
2170 ;;;; Utilities
|
|
|
2171 ;;;; =============================================================
|
|
|
2172
|
|
|
2173 ;;; -------------------------------------------------------------------
|
|
|
2174 ;;; General Macros (Make sure that macros are defined before they're
|
|
|
2175 ;;; used, for the byte compiler.
|
|
|
2176 ;;; -------------------------------------------------------------------
|
|
|
2177
|
|
|
2178 (defmacro efs-kbd-quit-protect (proc &rest body)
|
|
|
2179 ;; When an efs function controlling an FTP connection gets a kbd-quit
|
|
|
2180 ;; this tries to make sure that everything unwinds consistently.
|
|
|
2181 (let ((temp (make-symbol "continue")))
|
|
|
2182 (list 'let
|
|
|
2183 (list '(quit-flag nil)
|
|
|
2184 '(inhibit-quit nil)
|
|
|
2185 (list temp t))
|
|
|
2186 (list
|
|
|
2187 'while temp
|
|
|
2188 (list 'setq temp nil)
|
|
|
2189 (list
|
|
|
2190 'condition-case nil
|
|
|
2191 (cons 'progn
|
|
|
2192 body)
|
|
|
2193 (list 'quit
|
|
|
2194 (list 'setq temp
|
|
|
2195 (list 'efs-kbd-quit-protect-cover-quit proc))))))))
|
|
|
2196
|
|
|
2197 (defun efs-kbd-quit-protect-cover-quit (proc)
|
|
|
2198 ;; This function exists to keep the macro expansion of the
|
|
|
2199 ;; efs-kbd-quit-protect down to a reasonable size.
|
|
|
2200 (let ((pop-up-windows t)
|
|
|
2201 (buff (get-buffer (process-buffer proc)))
|
|
|
2202 res)
|
|
|
2203 (if (save-window-excursion
|
|
|
2204 (if buff
|
|
|
2205 (progn
|
|
|
2206 (pop-to-buffer buff)
|
|
|
2207 (goto-char (point-max))
|
|
|
2208 (recenter (- (window-height)
|
|
|
2209 2))))
|
|
|
2210 (setq res (efs-kill-ftp-buffer-with-prompt proc buff)))
|
|
|
2211 (progn
|
|
|
2212 (if (eq res 0)
|
|
|
2213 (if (eq (selected-window)
|
|
|
2214 (minibuffer-window))
|
|
|
2215 (efs-abort-recursive-edit-and-then
|
|
|
2216 (function
|
|
|
2217 (lambda (buff)
|
|
|
2218 (if (get-buffer buff)
|
|
|
2219 (display-buffer buff))))
|
|
|
2220 buff)
|
|
|
2221 (if (get-buffer buff)
|
|
|
2222 (display-buffer buff))
|
|
|
2223 (signal 'quit nil))
|
|
|
2224 (if (eq (selected-window) (minibuffer-window))
|
|
|
2225 (abort-recursive-edit)
|
|
|
2226 (signal (quote quit) nil)))
|
|
|
2227 nil)
|
|
|
2228 (sit-for 0)
|
|
|
2229 (message "Waiting on %s..." (or (car (efs-parse-proc-name proc))
|
|
|
2230 "a whim"))
|
|
|
2231 t)))
|
|
|
2232
|
|
|
2233 (put 'efs-kbd-quit-protect 'lisp-indent-hook 1)
|
|
|
2234
|
|
|
2235 (defmacro efs-save-buffer-excursion (&rest forms)
|
|
|
2236 "Execute FORMS, restoring the current buffer afterwards.
|
|
|
2237 Unlike, save-excursion, this does not restore the point."
|
|
|
2238 (let ((temp (make-symbol "saved-buff")))
|
|
|
2239 (list 'let
|
|
|
2240 (list (list temp '(current-buffer)))
|
|
|
2241 (list 'unwind-protect
|
|
|
2242 (cons 'progn forms)
|
|
|
2243 (list 'condition-case nil
|
|
|
2244 (list 'set-buffer temp)
|
|
|
2245 '(error nil))))))
|
|
|
2246
|
|
|
2247 (put 'efs-save-buffer-excursion 'lisp-indent-hook 0)
|
|
|
2248
|
|
|
2249 (defmacro efs-unquote-dollars (string)
|
|
|
2250 ;; Unquote $$'s to $'s in STRING.
|
|
|
2251 (` (let ((string (, string))
|
|
|
2252 (start 0)
|
|
|
2253 new)
|
|
|
2254 (while (string-match "\\$\\$" string start)
|
|
|
2255 (setq new (concat new (substring
|
|
|
2256 string start (1+ (match-beginning 0))))
|
|
|
2257 start (match-end 0)))
|
|
|
2258 (if new
|
|
|
2259 (concat new (substring string start))
|
|
|
2260 string))))
|
|
|
2261
|
|
|
2262 (defmacro efs-get-file-part (path)
|
|
|
2263 ;; Given PATH, return the file part used for looking up the file's entry
|
|
|
2264 ;; in a hashtable.
|
|
|
2265 ;; This need not be the same thing as file-name-nondirectory.
|
|
|
2266 (` (let ((file (file-name-nondirectory (, path))))
|
|
|
2267 (if (string-equal file "")
|
|
|
2268 "."
|
|
|
2269 file))))
|
|
|
2270
|
|
|
2271 (defmacro efs-ftp-path-macro (path)
|
|
|
2272 ;; Just a macro version of efs-ftp-path, for speed critical
|
|
|
2273 ;; situations. Could use (inline ...) instead, but not everybody
|
|
|
2274 ;; uses the V19 byte-compiler. Also, doesn't call efs-save-match-data,
|
|
|
2275 ;; but assumes that the calling function does it.
|
|
|
2276 (`
|
|
|
2277 (let ((path (, path)))
|
|
|
2278 (or (string-equal path efs-ftp-path-arg)
|
|
|
2279 (setq efs-ftp-path-res
|
|
|
2280 (and (string-match efs-path-regexp path)
|
|
|
2281 (let ((host (substring path (match-beginning 2)
|
|
|
2282 (match-end 2)))
|
|
|
2283 (user (and (match-beginning 1)
|
|
|
2284 (substring path (match-beginning 1)
|
|
|
2285 (1- (match-end 1)))))
|
|
|
2286 (rpath (substring path (1+ (match-end 2)))))
|
|
|
2287 (list (if (string-equal host "")
|
|
|
2288 (setq host (system-name))
|
|
|
2289 host)
|
|
|
2290 (or user (efs-get-user host))
|
|
|
2291 rpath)))
|
|
|
2292 ;; Set this last, in case efs-get-user calls this function,
|
|
|
2293 ;; which would modify an earlier setting.
|
|
|
2294 efs-ftp-path-arg path))
|
|
|
2295 efs-ftp-path-res)))
|
|
|
2296
|
|
|
2297 (defmacro efs-canonize-switches (switches)
|
|
|
2298 ;; Converts a switches string, into a lexographically ordered string,
|
|
|
2299 ;; omitting - and spaces. Should we remove duplicate characters too?
|
|
|
2300 (` (if (, switches)
|
|
|
2301 (mapconcat
|
|
|
2302 'char-to-string
|
|
|
2303 (sort (delq ?- (delq ?\ (mapcar 'identity (, switches)))) '<) "")
|
|
|
2304 ;; For the purpose of interning in a hashtable, represent the nil
|
|
|
2305 ;; switches, as a string consisting of the ascii null character.
|
|
|
2306 (char-to-string 0))))
|
|
|
2307
|
|
|
2308 (defmacro efs-canonize-file-name (fn)
|
|
|
2309 ;; Canonizes the case of file names.
|
|
|
2310 (` (let ((parsed (efs-ftp-path (, fn))))
|
|
|
2311 (if parsed
|
|
|
2312 (let ((host (car parsed)))
|
|
|
2313 (if (memq (efs-host-type host) efs-case-insensitive-host-types)
|
|
|
2314 (downcase (, fn))
|
|
|
2315 (format efs-path-format-string (nth 1 parsed) (downcase host)
|
|
|
2316 (nth 2 parsed))))
|
|
|
2317 (, fn)))))
|
|
|
2318
|
|
|
2319 (defmacro efs-get-files-hashtable-entry (fn)
|
|
|
2320 (` (efs-get-hash-entry (efs-canonize-file-name (, fn)) efs-files-hashtable)))
|
|
|
2321
|
|
|
2322 ;;;; ------------------------------------------------------------
|
|
|
2323 ;;;; Utility Functions
|
|
|
2324 ;;;; ------------------------------------------------------------
|
|
|
2325
|
|
|
2326 (defun efs-kill-ftp-buffer-with-prompt (proc buffer)
|
|
|
2327 ;; Does a 3-way prompt to kill a ftp PROC and BUFFER.
|
|
|
2328 ;; Returns t if buffer was killed, 0 if only process, nil otherwise.
|
|
|
2329 (let ((inhibit-quit t)
|
|
|
2330 (cursor-in-echo-area t)
|
|
|
2331 char)
|
|
|
2332 (message
|
|
|
2333 (if efs-debug-ftp-connection
|
|
|
2334 "Kill ftp process and buffer (y[es], n[o], c[lose], d[ebug] ) "
|
|
|
2335 "Kill ftp process and buffer? (y or n, c to only close process) "))
|
|
|
2336 (setq char (read-char))
|
|
|
2337 (prog1
|
|
|
2338 (cond
|
|
|
2339 ((memq char '(?y ?Y ?\ ))
|
|
|
2340 (set-process-sentinel proc nil)
|
|
|
2341 (condition-case nil
|
|
|
2342 (kill-buffer buffer)
|
|
|
2343 (error nil))
|
|
|
2344 t)
|
|
|
2345 ((memq char '(?c ?C))
|
|
|
2346 (set-process-sentinel proc nil)
|
|
|
2347 (condition-case nil
|
|
|
2348 (save-excursion
|
|
|
2349 (set-buffer buffer)
|
|
|
2350 (setq efs-process-busy nil
|
|
|
2351 efs-process-q nil)
|
|
|
2352 (delete-process proc))
|
|
|
2353 (error nil))
|
|
|
2354 0)
|
|
|
2355 ((memq char '(?n ?N))
|
|
|
2356 (message "")
|
|
|
2357 nil)
|
|
|
2358 ((and efs-debug-ftp-connection
|
|
|
2359 (memq char '(?d ?D)))
|
|
|
2360 (condition-case nil
|
|
|
2361 (save-excursion
|
|
|
2362 (set-buffer buffer)
|
|
|
2363 (setq efs-process-busy nil
|
|
|
2364 efs-process-q nil))
|
|
|
2365 (error nil))
|
|
|
2366 0)
|
|
|
2367 (t
|
|
|
2368 (message
|
|
|
2369 (if efs-debug-ftp-connection
|
|
|
2370 "Type one of y, n, c or d."
|
|
|
2371 "Type one of y, n or c."))
|
|
|
2372 (ding)
|
|
|
2373 (sit-for 1)
|
|
|
2374 (setq quit-flag nil)
|
|
|
2375 (efs-kill-ftp-buffer-with-prompt proc buffer))))))
|
|
|
2376
|
|
|
2377 (defun efs-barf-if-not-directory (directory)
|
|
|
2378 ;; Signal an error if DIRECTORY is not one.
|
|
|
2379 (or (file-directory-p directory)
|
|
|
2380 (signal 'file-error
|
|
|
2381 (list "Opening directory"
|
|
|
2382 (if (file-exists-p directory)
|
|
|
2383 "not a directory"
|
|
|
2384 "no such file or directory")
|
|
|
2385 directory))))
|
|
|
2386
|
|
|
2387 (defun efs-call-cont (cont &rest args)
|
|
|
2388 "Call the function specified by CONT.
|
|
|
2389 CONT can be either a function or a list of a function and some args.
|
|
|
2390 The first parameters passed to the function will be ARGS. The remaining
|
|
|
2391 args will be taken from CONT if a list was passed."
|
|
|
2392 (if cont
|
|
|
2393 (let ((efs-nested-cmd t)) ; let-bound so that conts don't pop any queues
|
|
|
2394 (efs-save-buffer-excursion
|
|
|
2395 (if (and (listp cont)
|
|
|
2396 (not (eq (car cont) 'lambda)))
|
|
|
2397 (apply (car cont) (append args (cdr cont)))
|
|
|
2398 (apply cont args))))))
|
|
|
2399
|
|
|
2400 (defun efs-replace-path-component (fullpath path)
|
|
|
2401 "For FULLPATH matching efs-path-regexp replace the path component with PATH."
|
|
|
2402 (efs-save-match-data
|
|
|
2403 (if (string-match efs-path-root-regexp fullpath)
|
|
|
2404 (concat (substring fullpath 0 (match-end 0)) path)
|
|
|
2405 path)))
|
|
|
2406
|
|
|
2407 (defun efs-abort-recursive-edit-and-then (fun &rest args)
|
|
|
2408 ;; Does an abort-recursive-edit, and runs fun _after_ emacs returns to
|
|
|
2409 ;; top level.
|
|
|
2410 (if (get-process "efs-abort-recursive-edit")
|
|
|
2411 ;; Don't queue these things. Clean them out.
|
|
|
2412 (delete-process "efs-abort-recursive-edit"))
|
|
|
2413 (or efs-suppress-abort-recursive-edit-and-then
|
|
|
2414 (progn
|
|
|
2415 (setq efs-abort-recursive-edit-data (cons (nth 1 (current-time))
|
|
|
2416 (cons fun args)))
|
|
|
2417 (condition-case nil
|
|
|
2418 (set-process-sentinel
|
|
|
2419 (let ((default-directory exec-directory)
|
|
|
2420 (process-connection-type nil))
|
|
|
2421 (start-process "efs-abort-recursive-edit" nil "sleep" "0"))
|
|
|
2422 (function
|
|
|
2423 (lambda (proc string)
|
|
|
2424 (let ((data efs-abort-recursive-edit-data))
|
|
|
2425 (setq efs-abort-recursive-edit-data)
|
|
|
2426 (if (and data
|
|
|
2427 (integerp (car data))
|
|
|
2428 (<= (- (nth 1 (current-time)) (car data))
|
|
|
2429 efs-abort-recursive-edit-delay))
|
|
|
2430 (apply (nth 1 data) (nthcdr 2 data)))))))
|
|
|
2431 (error nil))))
|
|
|
2432 (abort-recursive-edit))
|
|
|
2433
|
|
|
2434 (defun efs-occur-in-string (char string)
|
|
|
2435 ;; Return the number of occurrences of CHAR in STRING.
|
|
|
2436 (efs-save-match-data
|
|
|
2437 (let ((regexp (regexp-quote (char-to-string char)))
|
|
|
2438 (count 0)
|
|
|
2439 (start 0))
|
|
|
2440 (while (string-match regexp string start)
|
|
|
2441 (setq start (match-end 0)
|
|
|
2442 count (1+ count)))
|
|
|
2443 count)))
|
|
|
2444
|
|
|
2445 (defun efs-parse-proc-name (proc)
|
|
|
2446 ;; Parses the name of process to return a list \(host user\).
|
|
|
2447 (efs-save-match-data
|
|
|
2448 (let ((name (process-name proc)))
|
|
|
2449 (and name
|
|
|
2450 (string-match "^\\*ftp \\([^@]*\\)@\\([^*]+\\)\\*$" name)
|
|
|
2451 (list (substring name (match-beginning 2) (match-end 2))
|
|
|
2452 (substring name (match-beginning 1) (match-end 1)))))))
|
|
|
2453
|
|
|
2454 ;;;; ------------------------------------------------------------
|
|
|
2455 ;;;; Of Geography, connectivity, and the internet... Gateways.
|
|
|
2456 ;;;; ------------------------------------------------------------
|
|
|
2457
|
|
|
2458 (defun efs-use-gateway-p (host &optional opaque-p)
|
|
|
2459 ;; Returns whether to access this host via a gateway.
|
|
|
2460 ;; Returns the gateway type as a symbol. See efs-gateway-type <V>.
|
|
|
2461 ;; If optional OPAQUE-P is non-nil, only returns non-nil if the gateway
|
|
|
2462 ;; type is in the list efs-opaque-gateways <V>.
|
|
|
2463 (and efs-gateway-type
|
|
|
2464 host ;local host is nil
|
|
|
2465 (efs-save-match-data
|
|
|
2466 (and (not (string-match efs-ftp-local-host-regexp host))
|
|
|
2467 (let ((type (car efs-gateway-type)))
|
|
|
2468 (if opaque-p
|
|
|
2469 (and (memq type efs-opaque-gateways) type)
|
|
|
2470 type))))))
|
|
|
2471
|
|
|
2472 (defun efs-local-to-gateway-filename (filename &optional reverse)
|
|
|
2473 ;; Converts a FILENAME on the local host to its name on the gateway,
|
|
|
2474 ;; using efs-gateway-mounted-dirs-alist. If REVERSE is non-nil, does just
|
|
|
2475 ;; that. If the there is no corresponding name because non of its parent
|
|
|
2476 ;; directories are mounted, returns nil.
|
|
|
2477 (if efs-gateway-mounted-dirs-alist
|
|
|
2478 (let ((len (length filename))
|
|
|
2479 (alist efs-gateway-mounted-dirs-alist)
|
|
|
2480 result elt elt-len)
|
|
|
2481 (if reverse
|
|
|
2482 (while (setq elt (car alist))
|
|
|
2483 (if (and (>= len (setq elt-len (length (cdr elt))))
|
|
|
2484 (string-equal (cdr elt) (substring filename 0 elt-len)))
|
|
|
2485 (setq result (concat (car elt)
|
|
|
2486 (substring filename elt-len))
|
|
|
2487 alist nil)
|
|
|
2488 (setq alist (cdr alist))))
|
|
|
2489 (while (setq elt (car alist))
|
|
|
2490 (if (and (>= len (setq elt-len (length (car elt))))
|
|
|
2491 (string-equal (car elt) (substring filename 0 elt-len)))
|
|
|
2492 (setq result (concat (cdr elt)
|
|
|
2493 (substring filename elt-len))
|
|
|
2494 alist nil)
|
|
|
2495 (setq alist (cdr alist)))))
|
|
|
2496 result)))
|
|
|
2497
|
|
|
2498 ;;; ------------------------------------------------------------
|
|
|
2499 ;;; Enhanced message support.
|
|
|
2500 ;;; ------------------------------------------------------------
|
|
|
2501
|
|
|
2502 (defun efs-message (fmt &rest args)
|
|
|
2503 "Output the given message, truncating to the size of the minibuffer window."
|
|
|
2504 (let ((msg (apply (function format) fmt args))
|
|
|
2505 (max (window-width (minibuffer-window))))
|
|
|
2506 (if (>= (length msg) max)
|
|
|
2507 (setq msg (concat "> " (substring msg (- 3 max)))))
|
|
|
2508 (message "%s" msg)))
|
|
|
2509
|
|
|
2510 (defun efs-message-p ()
|
|
|
2511 ;; Returns t, if efs is allowed to display a status message.
|
|
|
2512 (not
|
|
|
2513 (or (and (boundp 'dired-in-query) dired-in-query)
|
|
|
2514 (boundp 'search-message)
|
|
|
2515 cursor-in-echo-area
|
|
|
2516 (and (/= efs-message-interval 0)
|
|
|
2517 (let ((diff (- efs-last-message-time
|
|
|
2518 (setq efs-last-message-time
|
|
|
2519 (nth 1 (current-time))))))
|
|
|
2520 (and
|
|
|
2521 (> diff (- efs-message-interval))
|
|
|
2522 (< diff 0))))))) ; in case the clock wraps.
|
|
|
2523
|
|
|
2524 (efs-define-fun efs-relativize-filename (file &optional dir new)
|
|
|
2525 "Abbreviate the given filename relative to DIR .
|
|
|
2526 If DIR is nil, use the value of `default-directory' for the currently selected
|
|
|
2527 window. If the optional parameter NEW is given and the
|
|
|
2528 non-directory parts match, only return the directory part of the file."
|
|
|
2529 (let* ((dir (or dir (save-excursion
|
|
|
2530 (set-buffer (window-buffer (selected-window)))
|
|
|
2531 default-directory)))
|
|
|
2532 (dlen (length dir))
|
|
|
2533 (result file))
|
|
|
2534 (and (> (length file) dlen)
|
|
|
2535 (string-equal (substring file 0 dlen) dir)
|
|
|
2536 (setq result (substring file dlen)))
|
|
|
2537 (and new
|
|
|
2538 (string-equal (file-name-nondirectory result)
|
|
|
2539 (file-name-nondirectory new))
|
|
|
2540 (or (setq result (file-name-directory result))
|
|
|
2541 (setq result "./")))
|
|
|
2542 (abbreviate-file-name result)))
|
|
|
2543
|
|
|
2544 ;;; ------------------------------------------------------------
|
|
|
2545 ;;; Temporary file location and deletion...
|
|
|
2546 ;;; ------------------------------------------------------------
|
|
|
2547
|
|
|
2548 (defun efs-get-pid ()
|
|
|
2549 ;; Half-hearted attempt to get the current process's id.
|
|
|
2550 (setq efs-pid (substring (make-temp-name "") 1)))
|
|
|
2551
|
|
|
2552 (defun efs-make-tmp-name (host1 host2)
|
|
|
2553 ;; Returns the name of a new temp file, for moving data between HOST1
|
|
|
2554 ;; and HOST2. This temp file must be directly accessible to the
|
|
|
2555 ;; FTP client connected to HOST1. Using nil for either HOST1 or
|
|
|
2556 ;; HOST2 means the local host. The return value is actually a list
|
|
|
2557 ;; whose car is the name of the temp file wrto to the local host
|
|
|
2558 ;; and whose cdr is the name of the temp file wrto to the host
|
|
|
2559 ;; on which the client connected to HOST1 is running. If the gateway
|
|
|
2560 ;; is only accessible by FTP, then the car of this may be in efs extended
|
|
|
2561 ;; file name syntax.
|
|
|
2562 (let ((pid (or efs-pid (efs-get-pid)))
|
|
|
2563 (start ?a)
|
|
|
2564 file entry template rem-template template-len)
|
|
|
2565 ;; Compute the templates.
|
|
|
2566 (if (null (and host1 (efs-use-gateway-p host1 t)))
|
|
|
2567 ;; file must be local
|
|
|
2568 (if (null (and host2 (efs-use-gateway-p host2 t)))
|
|
|
2569 (setq template efs-tmp-name-template)
|
|
|
2570 (setq template (or (efs-local-to-gateway-filename
|
|
|
2571 efs-gateway-tmp-name-template t)
|
|
|
2572 efs-tmp-name-template)))
|
|
|
2573 ;; file must be on the gateway -- make sure that the gateway
|
|
|
2574 ;; configuration is sensible.
|
|
|
2575 (efs-save-match-data
|
|
|
2576 (or (string-match efs-ftp-local-host-regexp efs-gateway-host)
|
|
|
2577 (error "Gateway %s must be directly ftp accessible."
|
|
|
2578 efs-gateway-host)))
|
|
|
2579 (setq rem-template efs-gateway-tmp-name-template
|
|
|
2580 template (or (efs-local-to-gateway-filename
|
|
|
2581 efs-gateway-tmp-name-template t)
|
|
|
2582 (format efs-path-format-string
|
|
|
2583 (efs-get-user efs-gateway-host)
|
|
|
2584 efs-gateway-host
|
|
|
2585 efs-gateway-tmp-name-template))
|
|
|
2586 template-len (length template)))
|
|
|
2587 ;; Compute a new file name.
|
|
|
2588 (while (let (efs-verbose)
|
|
|
2589 (setq file (format "%s%c%s" template start pid)
|
|
|
2590 entry (intern file efs-tmp-name-obarray))
|
|
|
2591 (or (memq entry efs-tmp-name-files)
|
|
|
2592 (file-exists-p file)))
|
|
|
2593 (if (> (setq start (1+ start)) ?z)
|
|
|
2594 (progn
|
|
|
2595 (setq template (concat template "X"))
|
|
|
2596 (setq start ?a))))
|
|
|
2597 (setq efs-tmp-name-files
|
|
|
2598 (cons entry efs-tmp-name-files))
|
|
|
2599 (if rem-template
|
|
|
2600 (cons file (concat rem-template (substring file template-len)))
|
|
|
2601 (cons file file))))
|
|
|
2602
|
|
|
2603 (defun efs-del-tmp-name (temp)
|
|
|
2604 ;; Deletes file TEMP, a string.
|
|
|
2605 (setq efs-tmp-name-files
|
|
|
2606 (delq (intern temp efs-tmp-name-obarray)
|
|
|
2607 efs-tmp-name-files))
|
|
|
2608 (condition-case ()
|
|
|
2609 (let (efs-verbose)
|
|
|
2610 (delete-file temp))
|
|
|
2611 (error nil)))
|
|
|
2612
|
|
|
2613
|
|
|
2614 ;;;; ==============================================================
|
|
|
2615 ;;;; >4
|
|
|
2616 ;;;; Hosts, Users, Accounts, and Passwords
|
|
|
2617 ;;;; ==============================================================
|
|
|
2618 ;;;
|
|
|
2619 ;;; A lot of the support for this type of thing is in efs-netrc.el.
|
|
|
2620
|
|
|
2621 ;;;; ------------------------------------------------------------
|
|
|
2622 ;;;; Password support.
|
|
|
2623 ;;;; ------------------------------------------------------------
|
|
|
2624
|
|
|
2625 (defun efs-lookup-passwd (host user)
|
|
|
2626 ;; Look up the password for HOST and USER.
|
|
|
2627 (let ((ent (efs-get-host-user-property host user 'passwd)))
|
|
|
2628 (and ent (efs-code-string ent))))
|
|
|
2629
|
|
|
2630 (defun efs-system-fqdn ()
|
|
|
2631 "Returns a fully qualified domain name for the current host, if possible."
|
|
|
2632 (or efs-system-fqdn
|
|
|
2633 (setq efs-system-fqdn
|
|
|
2634 (let ((sys (system-name)))
|
|
|
2635 (if (string-match "\\." sys)
|
|
|
2636 sys
|
|
|
2637 (if efs-nslookup-program
|
|
|
2638 (let ((proc (let ((default-directory exec-directory)
|
|
|
2639 (process-connection-type nil))
|
|
|
2640 (start-process " *nslookup*" " *nslookup*"
|
|
|
2641 efs-nslookup-program sys)))
|
|
|
2642 (res sys)
|
|
|
2643 (n 0))
|
|
|
2644 (process-kill-without-query proc)
|
|
|
2645 (save-excursion
|
|
|
2646 (set-buffer (process-buffer proc))
|
|
|
2647 (let ((quit-flag nil)
|
|
|
2648 (inhibit-quit nil))
|
|
|
2649 (if efs-nslookup-threshold
|
|
|
2650 (progn
|
|
|
2651 (while (and (memq (process-status proc)
|
|
|
2652 '(run open))
|
|
|
2653 (< n efs-nslookup-threshold))
|
|
|
2654 (accept-process-output)
|
|
|
2655 (setq n (1+ n)))
|
|
|
2656 (if (>= n efs-nslookup-threshold)
|
|
|
2657 (progn
|
|
|
2658 (with-output-to-temp-buffer "*Help*"
|
|
|
2659 (princ (format "\
|
|
|
2660 efs is unable to determine a fully qualified domain name
|
|
|
2661 for the local host to send as an anonymous ftp password.
|
|
|
2662
|
|
|
2663 The function `system-name' is not returning a fully qualified
|
|
|
2664 domain name. An attempt to obtain a fully qualified domain name
|
|
|
2665 with `efs-nslookup-program' (currently set to \"%s\") has
|
|
|
2666 elicited no response from that program. Consider setting
|
|
|
2667 `efs-generate-anonymous-password' to an email address for anonymous
|
|
|
2668 ftp passwords.
|
|
|
2669
|
|
|
2670 For more information see the documentation (use C-h v) for the
|
|
|
2671 variables `efs-nslookup-program' and `efs-nslookup-threshold'."
|
|
|
2672 efs-nslookup-program)))
|
|
|
2673 (error "No response from %s"
|
|
|
2674 efs-nslookup-program))))
|
|
|
2675 (while (memq (process-status proc) '(run open))
|
|
|
2676 (accept-process-output proc)))
|
|
|
2677 (goto-char (point-min))
|
|
|
2678 (if (re-search-forward
|
|
|
2679 (format "^Name: *\\(%s\\.[^ \n\t]+\\)"
|
|
|
2680 sys) nil t)
|
|
|
2681 (setq res (buffer-substring
|
|
|
2682 (match-beginning 1)
|
|
|
2683 (match-end 1)))
|
|
|
2684 (kill-buffer (current-buffer)))))
|
|
|
2685 res)
|
|
|
2686 sys))))))
|
|
|
2687
|
|
|
2688 (defun efs-passwd-unique-list (alist)
|
|
|
2689 ;; Preserving the relative order of ALIST, remove all entries with duplicate
|
|
|
2690 ;; cars.
|
|
|
2691 (let (result)
|
|
|
2692 (while alist
|
|
|
2693 (or (assoc (car alist) result)
|
|
|
2694 (setq result (cons (car alist) result)))
|
|
|
2695 (setq alist (cdr alist)))
|
|
|
2696 (nreverse result)))
|
|
|
2697
|
|
|
2698 (defun efs-get-passwd-list (user host)
|
|
|
2699 ;; Returns an alist of the form '((pass host user) ...).
|
|
|
2700 ;; The order is essentially arbitrary, except that entries with user
|
|
|
2701 ;; equal to USER will appear first. Followed by entries with host equal to
|
|
|
2702 ;; HOST. Also, there will be no entries with duplicate values of pass.
|
|
|
2703 (efs-parse-netrc)
|
|
|
2704 (let* ((user-template (concat "/" user))
|
|
|
2705 (ulen (length user-template))
|
|
|
2706 (hlen (length host))
|
|
|
2707 primaries secondaries tertiaries)
|
|
|
2708 (efs-save-match-data
|
|
|
2709 (efs-map-hashtable
|
|
|
2710 (function
|
|
|
2711 (lambda (key passwd)
|
|
|
2712 (cond ((null passwd) nil)
|
|
|
2713 ((and (> (length key) ulen)
|
|
|
2714 (string-equal user-template
|
|
|
2715 (substring key (- ulen))))
|
|
|
2716 (setq primaries (cons (list (efs-code-string passwd)
|
|
|
2717 (substring key 0 (- ulen))
|
|
|
2718 (substring user-template 1))
|
|
|
2719 primaries)))
|
|
|
2720 ((and (> (length key) hlen)
|
|
|
2721 (string-equal host (substring key 0 hlen))
|
|
|
2722 (memq (aref key hlen) '(?/ ?.)))
|
|
|
2723 (if (string-match "/" key hlen)
|
|
|
2724 (setq secondaries
|
|
|
2725 (cons (list (efs-code-string passwd)
|
|
|
2726 (substring key 0 (match-beginning 0))
|
|
|
2727 (substring key (match-end 0)))
|
|
|
2728 secondaries))))
|
|
|
2729 ((string-match "/" key)
|
|
|
2730 (setq tertiaries
|
|
|
2731 (cons (list (efs-code-string passwd)
|
|
|
2732 (substring key 0 (match-beginning 0))
|
|
|
2733 (substring key (match-end 0)))
|
|
|
2734 tertiaries))))))
|
|
|
2735 efs-host-user-hashtable 'passwd))
|
|
|
2736 (efs-passwd-unique-list (nconc primaries secondaries tertiaries))))
|
|
|
2737
|
|
|
2738 (defun efs-get-passwd (host user)
|
|
|
2739 "Given a HOST and USER, return the FTP password, prompting if it was not
|
|
|
2740 previously set."
|
|
|
2741 (efs-parse-netrc)
|
|
|
2742
|
|
|
2743 ;; look up password in the hash table first; user might have overriden the
|
|
|
2744 ;; defaults.
|
|
|
2745 (cond ((efs-lookup-passwd host user))
|
|
|
2746
|
|
|
2747 ;; see if default user and password set from the .netrc file.
|
|
|
2748 ((and (stringp efs-default-user)
|
|
|
2749 efs-default-password
|
|
|
2750 (string-equal user efs-default-user))
|
|
|
2751 (copy-sequence efs-default-password))
|
|
|
2752
|
|
|
2753 ;; anonymous ftp password is handled specially since there is an
|
|
|
2754 ;; unwritten rule about how that is used on the Internet.
|
|
|
2755 ((and (efs-anonymous-p user)
|
|
|
2756 efs-generate-anonymous-password)
|
|
|
2757 (if (stringp efs-generate-anonymous-password)
|
|
|
2758 (copy-sequence efs-generate-anonymous-password)
|
|
|
2759 (concat (user-login-name) "@" (efs-system-fqdn))))
|
|
|
2760
|
|
|
2761 ;; see if same user has logged in to other hosts; if so then prompt
|
|
|
2762 ;; with the password that was used there.
|
|
|
2763 (t
|
|
|
2764 (let (others defaults passwd)
|
|
|
2765 (unwind-protect
|
|
|
2766 (progn
|
|
|
2767 (setq others (efs-get-passwd-list user host)
|
|
|
2768 defaults (mapcar
|
|
|
2769 (function
|
|
|
2770 (lambda (x)
|
|
|
2771 (cons
|
|
|
2772 (format
|
|
|
2773 "Passwd for %s@%s (same as %s@%s): "
|
|
|
2774 user host (nth 2 x) (nth 1 x))
|
|
|
2775 (car x))))
|
|
|
2776 others))
|
|
|
2777 (setq passwd
|
|
|
2778 (read-passwd
|
|
|
2779 (or defaults
|
|
|
2780 (format "Password for %s@%s: " user host)))))
|
|
|
2781 (while others
|
|
|
2782 (fillarray (car (car others)) 0)
|
|
|
2783 (setq others (cdr others))))
|
|
|
2784 (or (null passwd)
|
|
|
2785 (and efs-high-security-hosts
|
|
|
2786 (efs-save-match-data
|
|
|
2787 (string-match efs-high-security-hosts
|
|
|
2788 (format "%s@%s" user host))))
|
|
|
2789 (efs-set-passwd host user passwd))
|
|
|
2790 passwd))))
|
|
|
2791
|
|
|
2792 ;;;; ------------------------------------------------------------
|
|
|
2793 ;;;; Account support
|
|
|
2794 ;;;; ------------------------------------------------------------
|
|
|
2795
|
|
|
2796 (defun efs-get-account (host user &optional minidisk really)
|
|
|
2797 "Given a HOST, USER, and optional MINIDISK return the FTP account password.
|
|
|
2798 If the optional REALLY argument is given, prompts the user if it can't find
|
|
|
2799 one."
|
|
|
2800 (efs-parse-netrc)
|
|
|
2801 (let ((account (if minidisk
|
|
|
2802 (efs-get-hash-entry
|
|
|
2803 (concat (downcase host) "/" user "/" minidisk)
|
|
|
2804 efs-minidisk-hashtable
|
|
|
2805 (memq (efs-host-type host)
|
|
|
2806 efs-case-insensitive-host-types))
|
|
|
2807 (efs-get-host-user-property host user 'account))))
|
|
|
2808 (if account
|
|
|
2809 (efs-code-string account)
|
|
|
2810 ;; Do we really want to send the default-account passwd for all
|
|
|
2811 ;; minidisks?
|
|
|
2812 (if (and (stringp efs-default-user)
|
|
|
2813 (string-equal user efs-default-user)
|
|
|
2814 efs-default-account)
|
|
|
2815 efs-default-account
|
|
|
2816 (and really
|
|
|
2817 (let ((acct
|
|
|
2818 (read-passwd
|
|
|
2819 (if minidisk
|
|
|
2820 (format
|
|
|
2821 "Write access password for minidisk %s on %s@%s: "
|
|
|
2822 minidisk user host)
|
|
|
2823 (format
|
|
|
2824 "Account password for %s@%s: " user host)))))
|
|
|
2825 (or (and efs-high-security-hosts
|
|
|
2826 (efs-save-match-data
|
|
|
2827 efs-high-security-hosts
|
|
|
2828 (format "%s@%s" user host)))
|
|
|
2829 (efs-set-account host user minidisk acct))
|
|
|
2830 acct))))))
|
|
|
2831
|
|
|
2832 ;;;; -------------------------------------------------------------
|
|
|
2833 ;;;; Special classes of users.
|
|
|
2834 ;;;; -------------------------------------------------------------
|
|
|
2835
|
|
|
2836 (defun efs-anonymous-p (user)
|
|
|
2837 ;; Returns t if USER should be treated as an anonymous FTP login.
|
|
|
2838 (let ((user (downcase user)))
|
|
|
2839 (or (string-equal user "anonymous") (string-equal user "ftp"))))
|
|
|
2840
|
|
|
2841
|
|
|
2842 ;;;; =============================================================
|
|
|
2843 ;;;; >5
|
|
|
2844 ;;;; FTP client process, and server responses
|
|
|
2845 ;;;; =============================================================
|
|
|
2846
|
|
|
2847 ;;;; ---------------------------------------------------------
|
|
|
2848 ;;;; Support for asynch process queues.
|
|
|
2849 ;;;; ---------------------------------------------------------
|
|
|
2850
|
|
|
2851 (defun efs-add-to-queue (host user item)
|
|
|
2852 "To the end of the command queue for HOST and USER, adds ITEM.
|
|
|
2853 Does nothing if there is no process buffer for HOST and USER."
|
|
|
2854 (let ((buff (efs-ftp-process-buffer host user)))
|
|
|
2855 (if (get-buffer buff)
|
|
|
2856 (save-excursion
|
|
|
2857 (set-buffer buff)
|
|
|
2858 (setq efs-process-q
|
|
|
2859 (nconc efs-process-q (list item)))))))
|
|
|
2860
|
|
|
2861 ;;;; -------------------------------------------------------
|
|
|
2862 ;;;; Error recovery for the process filter.
|
|
|
2863 ;;;; -------------------------------------------------------
|
|
|
2864
|
|
|
2865 ;;; Could make this better, but it's such an unlikely error to hit.
|
|
|
2866 (defun efs-process-scream-and-yell (line)
|
|
|
2867 (let* ((buff (buffer-name (current-buffer)))
|
|
|
2868 (host (and (string-match "@\\(.*\\)\\*$" buff)
|
|
|
2869 (substring buff (match-beginning 1) (match-end 1)))))
|
|
|
2870 (with-output-to-temp-buffer "*Help*"
|
|
|
2871 (princ
|
|
|
2872 (concat
|
|
|
2873 "efs is unable to identify the following reply code
|
|
|
2874 from the ftp server " host ":\n\n" line "
|
|
|
2875
|
|
|
2876 Please send a bug report to ange@hplb.hpl.hp.com.
|
|
|
2877 In your report include a transcript of your\n"
|
|
|
2878 buff " buffer."))))
|
|
|
2879 (error "Unable to identify server code."))
|
|
|
2880
|
|
|
2881 (defun efs-error (host user msg)
|
|
|
2882 "Signal \'ftp-error for the FTP connection for HOST and USER.
|
|
|
2883 The error gives the string MSG as text. The process buffer for the FTP
|
|
|
2884 is popped up in another window."
|
|
|
2885 (let ((cur (selected-window))
|
|
|
2886 (pop-up-windows t)
|
|
|
2887 (buff (get-buffer (efs-ftp-process-buffer host user))))
|
|
|
2888 (if buff
|
|
|
2889 (progn
|
|
|
2890 (pop-to-buffer buff)
|
|
|
2891 (goto-char (point-max))
|
|
|
2892 (select-window cur))))
|
|
|
2893 (signal 'ftp-error (list (format "FTP Error: %s" msg))))
|
|
|
2894
|
|
|
2895 ;;;; --------------------------------------------------------------------
|
|
|
2896 ;;;; Process filter and supporting functions for handling FTP codes.
|
|
|
2897 ;;;; --------------------------------------------------------------------
|
|
|
2898
|
|
|
2899 (defun efs-process-handle-line (line proc)
|
|
|
2900 ;; Look at the given LINE from the ftp process PROC and try to catagorize it.
|
|
|
2901 (cond ((string-match efs-xfer-size-msgs line)
|
|
|
2902 (let ((n 1))
|
|
|
2903 ;; this loop will bomb with an args out of range error at 10
|
|
|
2904 (while (not (match-beginning n))
|
|
|
2905 (setq n (1+ n)))
|
|
|
2906 (setq efs-process-xfer-size
|
|
|
2907 (ash (string-to-int (substring line
|
|
|
2908 (match-beginning n)
|
|
|
2909 (match-end n)))
|
|
|
2910 -10))))
|
|
|
2911
|
|
|
2912 ((string-match efs-multi-msgs line)
|
|
|
2913 (setq efs-process-result-cont-lines
|
|
|
2914 (concat efs-process-result-cont-lines line "\n")))
|
|
|
2915
|
|
|
2916 ((string-match efs-skip-msgs line))
|
|
|
2917
|
|
|
2918 ((string-match efs-cmd-ok-msgs line)
|
|
|
2919 (if (string-match efs-cmd-ok-cmds efs-process-cmd)
|
|
|
2920 (setq efs-process-busy nil
|
|
|
2921 efs-process-result nil
|
|
|
2922 efs-process-result-line line)))
|
|
|
2923
|
|
|
2924 ((string-match efs-pending-msgs line)
|
|
|
2925 (if (string-match "^quote rnfr " efs-process-cmd)
|
|
|
2926 (setq efs-process-busy nil
|
|
|
2927 efs-process-result nil
|
|
|
2928 efs-process-result-line line)))
|
|
|
2929
|
|
|
2930 ((string-match efs-bytes-received-msgs line)
|
|
|
2931 (if efs-process-server-confused
|
|
|
2932 (setq efs-process-busy nil
|
|
|
2933 efs-process-result nil
|
|
|
2934 efs-process-result-line line)))
|
|
|
2935
|
|
|
2936 ((string-match efs-server-confused-msgs line)
|
|
|
2937 (setq efs-process-server-confused t))
|
|
|
2938
|
|
|
2939 ((string-match efs-good-msgs line)
|
|
|
2940 (setq efs-process-busy nil
|
|
|
2941 efs-process-result nil
|
|
|
2942 efs-process-result-line line))
|
|
|
2943
|
|
|
2944 ((string-match efs-fatal-msgs line)
|
|
|
2945 (set-process-sentinel proc nil)
|
|
|
2946 (delete-process proc)
|
|
|
2947 (setq efs-process-busy nil
|
|
|
2948 efs-process-result 'fatal
|
|
|
2949 efs-process-result-line line))
|
|
|
2950
|
|
|
2951 ((string-match efs-failed-msgs line)
|
|
|
2952 (setq efs-process-busy nil
|
|
|
2953 efs-process-result 'failed
|
|
|
2954 efs-process-result-line line))
|
|
|
2955
|
|
|
2956 ((string-match efs-unknown-response-msgs line)
|
|
|
2957 (setq efs-process-busy nil
|
|
|
2958 efs-process-result 'weird
|
|
|
2959 efs-process-result-line line)
|
|
|
2960 (efs-process-scream-and-yell line))))
|
|
|
2961
|
|
|
2962 (efs-define-fun efs-process-log-string (proc str)
|
|
|
2963 ;; For a given PROCESS, log the given STRING at the end of its
|
|
|
2964 ;; associated buffer.
|
|
|
2965 (let ((buff (get-buffer (process-buffer proc))))
|
|
|
2966 (if buff
|
|
|
2967 (efs-save-buffer-excursion
|
|
|
2968 (set-buffer buff)
|
|
|
2969 (comint-output-filter proc str)))))
|
|
|
2970
|
|
|
2971 (defun efs-process-filter (proc str)
|
|
|
2972 ;; Build up a complete line of output from the ftp PROCESS and pass it
|
|
|
2973 ;; on to efs-process-handle-line to deal with.
|
|
|
2974 (let ((inhibit-quit t)
|
|
|
2975 (buffer (get-buffer (process-buffer proc)))
|
|
|
2976 (efs-default-directory default-directory))
|
|
|
2977
|
|
|
2978 ;; see if the buffer is still around... it could have been deleted.
|
|
|
2979 (if buffer
|
|
|
2980 (efs-save-buffer-excursion
|
|
|
2981 (set-buffer (process-buffer proc))
|
|
|
2982 (efs-save-match-data
|
|
|
2983
|
|
|
2984 ;; handle hash mark printing
|
|
|
2985 (if efs-process-busy
|
|
|
2986 (setq str (efs-process-handle-hash str)
|
|
|
2987 efs-process-string (concat efs-process-string str)))
|
|
|
2988 (efs-process-log-string proc str)
|
|
|
2989 (while (and efs-process-busy
|
|
|
2990 (string-match "\n" efs-process-string))
|
|
|
2991 (let ((line (substring efs-process-string
|
|
|
2992 0
|
|
|
2993 (match-beginning 0))))
|
|
|
2994 (setq efs-process-string (substring
|
|
|
2995 efs-process-string
|
|
|
2996 (match-end 0)))
|
|
|
2997 ;; If we are in synch with the client, we should
|
|
|
2998 ;; never get prompts in the wrong place. Just to be safe,
|
|
|
2999 ;; chew them off.
|
|
|
3000 (while (string-match efs-process-prompt-regexp line)
|
|
|
3001 (setq line (substring line (match-end 0))))
|
|
|
3002 (efs-process-handle-line line proc)))
|
|
|
3003
|
|
|
3004 ;; has the ftp client finished? if so then do some clean-up
|
|
|
3005 ;; actions.
|
|
|
3006 (if (not efs-process-busy)
|
|
|
3007 (progn
|
|
|
3008 (efs-correct-hash-mark-size)
|
|
|
3009 ;; reset process-kill-without-query
|
|
|
3010 (process-kill-without-query proc)
|
|
|
3011 ;; issue the "done" message since we've finished.
|
|
|
3012 (if (and efs-process-msg
|
|
|
3013 (efs-message-p)
|
|
|
3014 (null efs-process-result))
|
|
|
3015 (progn
|
|
|
3016
|
|
|
3017 (efs-message "%s...done" efs-process-msg)
|
|
|
3018 (setq efs-process-msg nil)))
|
|
|
3019
|
|
|
3020 (if (and efs-process-nowait
|
|
|
3021 (null efs-process-cmd-waiting))
|
|
|
3022
|
|
|
3023 (progn
|
|
|
3024 ;; Is there a continuation we should be calling?
|
|
|
3025 ;; If so, we'd better call it, making sure we
|
|
|
3026 ;; only call it once.
|
|
|
3027 (if efs-process-continue
|
|
|
3028 (let ((cont efs-process-continue))
|
|
|
3029 (setq efs-process-continue nil)
|
|
|
3030 (efs-call-cont
|
|
|
3031 cont
|
|
|
3032 efs-process-result
|
|
|
3033 efs-process-result-line
|
|
|
3034 efs-process-result-cont-lines)))
|
|
|
3035 ;; If the cmd was run asynch, run the next
|
|
|
3036 ;; cmd from the queue. For synch cmds, this
|
|
|
3037 ;; is done by efs-send-cmd. For asynch
|
|
|
3038 ;; cmds we don't care about
|
|
|
3039 ;; efs-nested-cmd, since nothing is
|
|
|
3040 ;; waiting for the cmd to complete. If
|
|
|
3041 ;; efs-process-cmd-waiting is t, exit
|
|
|
3042 ;; to let this command run.
|
|
|
3043 (if (and efs-process-q
|
|
|
3044 ;; Be careful to check efs-process-busy
|
|
|
3045 ;; again, because the cont may have started
|
|
|
3046 ;; some new ftp action.
|
|
|
3047 ;; wheels within wheels...
|
|
|
3048 (null efs-process-busy))
|
|
|
3049 (let ((next (car efs-process-q)))
|
|
|
3050 (setq efs-process-q
|
|
|
3051 (cdr efs-process-q))
|
|
|
3052 (apply 'efs-send-cmd
|
|
|
3053 efs-process-host
|
|
|
3054 efs-process-user
|
|
|
3055 next))))
|
|
|
3056
|
|
|
3057 (if efs-process-continue
|
|
|
3058 (let ((cont efs-process-continue))
|
|
|
3059 (setq efs-process-continue nil)
|
|
|
3060 (efs-call-cont
|
|
|
3061 cont
|
|
|
3062 efs-process-result
|
|
|
3063 efs-process-result-line
|
|
|
3064 efs-process-result-cont-lines))))
|
|
|
3065
|
|
|
3066 ;; Update the mode line
|
|
|
3067 ;; We can't test nowait to see if we changed the
|
|
|
3068 ;; modeline in the first place, because conts
|
|
|
3069 ;; may be running now, which will confuse the issue.
|
|
|
3070 ;; The logic is simpler if we update the modeline
|
|
|
3071 ;; before the cont, but then the user sees the
|
|
|
3072 ;; modeline track the cont execution. It's dizzying.
|
|
|
3073 (if (and (or efs-mode-line-format
|
|
|
3074 efs-ftp-activity-function)
|
|
|
3075 (null efs-process-busy))
|
|
|
3076 (efs-update-mode-line)))))
|
|
|
3077
|
|
|
3078 ;; Trim buffer, if required.
|
|
|
3079 (and efs-max-ftp-buffer-size
|
|
|
3080 (zerop efs-process-cmd-counter)
|
|
|
3081 (> (point-max) efs-max-ftp-buffer-size)
|
|
|
3082 (= (point-min) 1) ; who knows, the user may have narrowed.
|
|
|
3083 (null (get-buffer-window (current-buffer)))
|
|
|
3084 (save-excursion
|
|
|
3085 (goto-char (/ efs-max-ftp-buffer-size 2))
|
|
|
3086 (forward-line 1)
|
|
|
3087 (delete-region (point-min) (point))))))))
|
|
|
3088
|
|
|
3089 ;;;; ------------------------------------------------------------------
|
|
|
3090 ;;;; Functions for counting hashes and reporting on bytes transferred.
|
|
|
3091 ;;;; ------------------------------------------------------------------
|
|
|
3092
|
|
|
3093 (defun efs-set-xfer-size (host user bytes)
|
|
|
3094 ;; Set the size of the next FTP transfer in bytes.
|
|
|
3095 (let ((proc (efs-get-process host user)))
|
|
|
3096 (if proc
|
|
|
3097 (let ((buf (process-buffer proc)))
|
|
|
3098 (if buf
|
|
|
3099 (save-excursion
|
|
|
3100 (set-buffer buf)
|
|
|
3101 (setq efs-process-xfer-size (ash bytes -10))))))))
|
|
|
3102
|
|
|
3103 (defun efs-guess-incoming-bin-hm-size ()
|
|
|
3104 ;; Guess at the hash mark size for incoming binary transfers by taking
|
|
|
3105 ;; the average value for such transfers to other hosts.
|
|
|
3106 (let ((total 0)
|
|
|
3107 (n 0))
|
|
|
3108 (efs-map-hashtable
|
|
|
3109 (function
|
|
|
3110 (lambda (host hm-size)
|
|
|
3111 (if hm-size (setq total (+ total hm-size)
|
|
|
3112 n (1+ n)))))
|
|
|
3113 efs-host-hashtable
|
|
|
3114 'incoming-bin-hm-size)
|
|
|
3115 (and (> n 0) (/ total n))))
|
|
|
3116
|
|
|
3117 (defun efs-set-hash-mark-unit (host user &optional incoming)
|
|
|
3118 ;; Sets the value of efs-process-hash-mark-unit according to the xfer-type.
|
|
|
3119 ;; efs-hash-mark-unit is the number of bytes represented by a hash mark,
|
|
|
3120 ;; in units of 16. If INCOMING is non-nil, the xfer will be a GET.
|
|
|
3121 (if efs-send-hash
|
|
|
3122 (let ((buff (efs-ftp-process-buffer host user))
|
|
|
3123 (gate-p (efs-use-gateway-p host t)))
|
|
|
3124 (if buff
|
|
|
3125 (save-excursion
|
|
|
3126 (set-buffer buff)
|
|
|
3127 (setq efs-process-hash-mark-unit
|
|
|
3128 (ash (or
|
|
|
3129 (and incoming (eq efs-process-xfer-type 'image)
|
|
|
3130 (or (efs-get-host-property
|
|
|
3131 host 'incoming-bin-hm-size)
|
|
|
3132 (if gate-p
|
|
|
3133 efs-gateway-incoming-binary-hm-size
|
|
|
3134 efs-incoming-binary-hm-size)
|
|
|
3135 (let ((guess
|
|
|
3136 (efs-guess-incoming-bin-hm-size)))
|
|
|
3137 (and guess
|
|
|
3138 (efs-set-host-property
|
|
|
3139 host 'incoming-bin-hm-size
|
|
|
3140 guess)))))
|
|
|
3141 (if gate-p
|
|
|
3142 efs-gateway-hash-mark-size
|
|
|
3143 efs-hash-mark-size)
|
|
|
3144 1024) ; make sure that we have some integer
|
|
|
3145 -4)))))))
|
|
|
3146
|
|
|
3147 (defun efs-correct-hash-mark-size ()
|
|
|
3148 ;; Corrects the value of efs-{ascii,binary}-hash-mark-size.
|
|
|
3149 ;; Must be run in the process buffer.
|
|
|
3150 (and efs-send-hash
|
|
|
3151 efs-process-hash-mark-unit
|
|
|
3152 (> efs-process-xfer-size 0)
|
|
|
3153 (< efs-process-xfer-size 524288) ; 2^19, prevent overflows
|
|
|
3154 (> efs-process-hash-mark-count 0)
|
|
|
3155 (or (> efs-process-last-percent 100)
|
|
|
3156 (< (ash (* efs-process-hash-mark-unit
|
|
|
3157 (1+ efs-process-hash-mark-count )) -6)
|
|
|
3158 efs-process-xfer-size))
|
|
|
3159 (let ((val (ash (/ (ash efs-process-xfer-size 6)
|
|
|
3160 efs-process-hash-mark-count) 4)))
|
|
|
3161 (if (and (eq efs-process-xfer-type 'image)
|
|
|
3162 (>= (length efs-process-cmd) 4)
|
|
|
3163 (string-equal (downcase (substring efs-process-cmd 0 4))
|
|
|
3164 "get "))
|
|
|
3165 (efs-set-host-property efs-process-host 'incoming-bin-hm-size val)
|
|
|
3166 (set (if (efs-use-gateway-p efs-process-host t)
|
|
|
3167 'efs-gateway-hash-mark-size
|
|
|
3168 'efs-hash-mark-size)
|
|
|
3169 val)))))
|
|
|
3170
|
|
|
3171 (defun efs-process-handle-hash (str)
|
|
|
3172 ;; Remove hash marks from STRING and display count so far.
|
|
|
3173 (if (string-match "^#+$" str)
|
|
|
3174 (progn
|
|
|
3175 (setq efs-process-hash-mark-count
|
|
|
3176 (+ efs-process-hash-mark-count
|
|
|
3177 (- (match-end 0) (match-beginning 0))))
|
|
|
3178 (and
|
|
|
3179 efs-process-msg
|
|
|
3180 efs-process-hash-mark-unit
|
|
|
3181 (not (and efs-process-nowait
|
|
|
3182 (or (eq efs-verbose 0)
|
|
|
3183 (eq (selected-window) (minibuffer-window)))))
|
|
|
3184 (efs-message-p)
|
|
|
3185 (let* ((big (> efs-process-hash-mark-count 65536)) ; 2^16
|
|
|
3186 (kbytes (if big
|
|
|
3187 (* efs-process-hash-mark-unit
|
|
|
3188 (ash efs-process-hash-mark-count -6))
|
|
|
3189 (ash (* efs-process-hash-mark-unit
|
|
|
3190 efs-process-hash-mark-count)
|
|
|
3191 -6))))
|
|
|
3192 (if (zerop efs-process-xfer-size)
|
|
|
3193 (or (zerop kbytes)
|
|
|
3194 (efs-message "%s...%dk" efs-process-msg kbytes))
|
|
|
3195 (let ((percent (if big
|
|
|
3196 (/ (* 100 (ash kbytes -7))
|
|
|
3197 (ash efs-process-xfer-size -7))
|
|
|
3198 (/ (* 100 kbytes) efs-process-xfer-size))))
|
|
|
3199 ;; Don't display %'s betwwen 100 and 110
|
|
|
3200 (and (> percent 100) (< percent 110) (setq percent 100))
|
|
|
3201 ;; cut out the redisplay of identical %-age messages.
|
|
|
3202 (or (eq percent efs-process-last-percent)
|
|
|
3203 (progn
|
|
|
3204 (setq efs-process-last-percent percent)
|
|
|
3205 (efs-message "%s...%d%%" efs-process-msg percent)))))))
|
|
|
3206 (concat (substring str 0 (match-beginning 0))
|
|
|
3207 (and (/= (length str) (match-end 0))
|
|
|
3208 (substring str (1+ (match-end 0))))))
|
|
|
3209 str))
|
|
|
3210
|
|
|
3211 ;;;; ------------------------------------------------------------------
|
|
|
3212 ;;;; Keeping track of the number of active background connections.
|
|
|
3213 ;;;; ------------------------------------------------------------------
|
|
|
3214
|
|
|
3215 (defun efs-ftp-processes-active ()
|
|
|
3216 ;; Return the number of FTP processes busy.
|
|
|
3217 (save-excursion
|
|
|
3218 (length
|
|
|
3219 (delq nil
|
|
|
3220 (mapcar
|
|
|
3221 (function
|
|
|
3222 (lambda (buff)
|
|
|
3223 (set-buffer buff)
|
|
|
3224 (and (boundp 'efs-process-busy)
|
|
|
3225 efs-process-busy)))
|
|
|
3226 (buffer-list))))))
|
|
|
3227
|
|
|
3228 (defun efs-update-mode-line ()
|
|
|
3229 ;; Updates the mode with FTP activity, and runs `efs-ftp-activity-function'.
|
|
|
3230 (let ((num (efs-ftp-processes-active)))
|
|
|
3231 (if efs-mode-line-format
|
|
|
3232 (progn
|
|
|
3233 (if (zerop num)
|
|
|
3234 (setq efs-mode-line-string "")
|
|
|
3235 (setq efs-mode-line-string (format efs-mode-line-format num)))
|
|
|
3236 ;; fake emacs into re-calculating all the mode lines.
|
|
|
3237 (save-excursion (set-buffer (other-buffer)))
|
|
|
3238 (set-buffer-modified-p (buffer-modified-p))))
|
|
|
3239 (if efs-ftp-activity-function
|
|
|
3240 (funcall efs-ftp-activity-function num))))
|
|
|
3241
|
|
|
3242 (defun efs-display-ftp-activity ()
|
|
|
3243 "Displays the number of active background ftp sessions.
|
|
|
3244 Uses the variable `efs-mode-line-format' to determine how this will be
|
|
|
3245 displayed."
|
|
|
3246 (interactive)
|
|
|
3247 (or (memq 'efs-mode-line-string global-mode-string)
|
|
|
3248 (if global-mode-string
|
|
|
3249 (nconc global-mode-string '(efs-mode-line-string))
|
|
|
3250 (setq global-mode-string '("" efs-mode-line-string)))))
|
|
|
3251
|
|
|
3252 ;;;; -------------------------------------------------------------------
|
|
|
3253 ;;;; Expiring inactive ftp buffers.
|
|
|
3254 ;;;; -------------------------------------------------------------------
|
|
|
3255
|
|
|
3256 (defun efs-start-polling ()
|
|
|
3257 ;; Start polling FTP buffers, to look for idle ones.
|
|
|
3258 (or (null efs-expire-ftp-buffers)
|
|
|
3259 (let ((proc (get-process "efs poll")))
|
|
|
3260 (or (and proc (eq (process-status proc) 'run))))
|
|
|
3261 (let ((default-directory exec-directory)
|
|
|
3262 (process-connection-type nil)
|
|
|
3263 new-proc)
|
|
|
3264 (condition-case nil
|
|
|
3265 (delete-process "efs poll")
|
|
|
3266 (error nil))
|
|
|
3267 (setq new-proc (start-process
|
|
|
3268 "efs poll" nil
|
|
|
3269 (concat exec-directory "wakeup")
|
|
|
3270 (int-to-string efs-ftp-buffer-poll-time)))
|
|
|
3271 (set-process-filter new-proc (function efs-expire-ftp-buffers-filter))
|
|
|
3272 (process-kill-without-query new-proc))))
|
|
|
3273
|
|
|
3274 (defun efs-connection-visited-p (host user)
|
|
|
3275 ;; Returns t if there are any buffers visiting files on HOST and USER.
|
|
|
3276 (save-excursion
|
|
|
3277 (let ((list (buffer-list))
|
|
|
3278 (case-fold (memq (efs-host-type host)
|
|
|
3279 efs-case-insensitive-host-types))
|
|
|
3280 (visited nil)
|
|
|
3281 parsed)
|
|
|
3282 (setq host (downcase host))
|
|
|
3283 (if case-fold (setq user (downcase user)))
|
|
|
3284 (while list
|
|
|
3285 (set-buffer (car list))
|
|
|
3286 (if (or (and buffer-file-name
|
|
|
3287 (setq parsed (efs-ftp-path buffer-file-name))
|
|
|
3288 (string-equal host (downcase (car parsed)))
|
|
|
3289 (string-equal user (if case-fold
|
|
|
3290 (downcase (nth 1 parsed))
|
|
|
3291 (nth 1 parsed))))
|
|
|
3292 (and (boundp 'dired-directory)
|
|
|
3293 (stringp dired-directory)
|
|
|
3294 efs-dired-host-type
|
|
|
3295 (setq parsed (efs-ftp-path dired-directory))
|
|
|
3296 (string-equal host (downcase (car parsed)))
|
|
|
3297 (string-equal user (if case-fold
|
|
|
3298 (downcase (nth 1 parsed))
|
|
|
3299 (nth 1 parsed)))))
|
|
|
3300 (setq visited t
|
|
|
3301 list nil)
|
|
|
3302 (setq list (cdr list))))
|
|
|
3303 visited)))
|
|
|
3304
|
|
|
3305 (defun efs-expire-ftp-buffers-filter (proc string)
|
|
|
3306 ;; Check all ftp buffers, and kill them if they have been inactive
|
|
|
3307 ;; for the minimum of efs-ftp-buffer-expire-time and their local
|
|
|
3308 ;; time out time.
|
|
|
3309 (if efs-expire-ftp-buffers
|
|
|
3310 (let ((list (buffer-list))
|
|
|
3311 new-alist)
|
|
|
3312 (save-excursion
|
|
|
3313 (while list
|
|
|
3314 (set-buffer (car list))
|
|
|
3315 (if (eq major-mode 'efs-mode)
|
|
|
3316 (let* ((proc (get-buffer-process (current-buffer)))
|
|
|
3317 (proc-p (and proc (memq (process-status proc)
|
|
|
3318 '(run open)))))
|
|
|
3319 (if (or efs-ftp-buffer-expire-time
|
|
|
3320 efs-process-idle-time
|
|
|
3321 (null proc-p))
|
|
|
3322 (let ((elt (assq (car list) efs-ftp-buffer-alist))
|
|
|
3323 (wind-p (get-buffer-window (car list))))
|
|
|
3324 (if (or (null elt) (buffer-modified-p)
|
|
|
3325 efs-process-busy wind-p)
|
|
|
3326 (progn
|
|
|
3327 (setq new-alist (cons (cons (car list) 0)
|
|
|
3328 new-alist))
|
|
|
3329 (or wind-p (set-buffer-modified-p nil)))
|
|
|
3330 (let ((idle (+ (cdr elt)
|
|
|
3331 efs-ftp-buffer-poll-time)))
|
|
|
3332 (if (and proc-p
|
|
|
3333 (< idle
|
|
|
3334 (if efs-ftp-buffer-expire-time
|
|
|
3335 (if efs-process-idle-time
|
|
|
3336 (min efs-ftp-buffer-expire-time
|
|
|
3337 efs-process-idle-time)
|
|
|
3338 efs-ftp-buffer-expire-time)
|
|
|
3339 efs-process-idle-time)))
|
|
|
3340 (progn
|
|
|
3341 (setq new-alist (cons (cons (car list) idle)
|
|
|
3342 new-alist))
|
|
|
3343 (set-buffer-modified-p nil))
|
|
|
3344 ;; If there are still buffers for host & user,
|
|
|
3345 ;; don't wipe the cache.
|
|
|
3346 (and proc
|
|
|
3347 (efs-connection-visited-p
|
|
|
3348 efs-process-host efs-process-user)
|
|
|
3349 (set-process-sentinel proc nil))
|
|
|
3350 (kill-buffer (car list)))))))))
|
|
|
3351 (setq list (cdr list))))
|
|
|
3352 (setq efs-ftp-buffer-alist new-alist))
|
|
|
3353 (condition-case nil
|
|
|
3354 (delete-process "efs poll")
|
|
|
3355 (error nil))))
|
|
|
3356
|
|
|
3357 ;;;; -------------------------------------------------------------------
|
|
|
3358 ;;;; When the FTP client process dies...
|
|
|
3359 ;;;; -------------------------------------------------------------------
|
|
|
3360
|
|
|
3361 (defun efs-process-sentinel (proc str)
|
|
|
3362 ;; When ftp process changes state, nuke all file-entries in cache.
|
|
|
3363 (let ((buff (process-buffer proc)))
|
|
|
3364 ;; If the client dies, make sure that efs doesn't think that
|
|
|
3365 ;; there is a running process.
|
|
|
3366 (save-excursion
|
|
|
3367 (condition-case nil
|
|
|
3368 (progn
|
|
|
3369 (set-buffer buff)
|
|
|
3370 (setq efs-process-busy nil))
|
|
|
3371 (error nil)))
|
|
|
3372 (let ((parsed (efs-parse-proc-name proc)))
|
|
|
3373 (if parsed
|
|
|
3374 (progn
|
|
|
3375 (apply 'efs-wipe-file-entries parsed)
|
|
|
3376 (apply 'efs-wipe-from-ls-cache parsed))))
|
|
|
3377 (if (or efs-mode-line-format efs-ftp-activity-function)
|
|
|
3378 (efs-update-mode-line))))
|
|
|
3379
|
|
|
3380 (defun efs-kill-ftp-process (buffer)
|
|
|
3381 "Kill an FTP connection and its associated process buffer.
|
|
|
3382 If the BUFFER's visited file name or default-directory is an efs remote
|
|
|
3383 file name, it is the connection for that file name that is killed."
|
|
|
3384 (interactive "bKill FTP process associated with buffer: ")
|
|
|
3385 (or buffer (setq buffer (current-buffer)))
|
|
|
3386 (save-excursion
|
|
|
3387 (set-buffer buffer)
|
|
|
3388 (if (eq major-mode 'efs-mode)
|
|
|
3389 (kill-buffer buffer)
|
|
|
3390 (let ((file (or (buffer-file-name) default-directory)))
|
|
|
3391 (if file
|
|
|
3392 (let ((parsed (efs-ftp-path (expand-file-name file))))
|
|
|
3393 (if parsed
|
|
|
3394 (let ((host (nth 0 parsed))
|
|
|
3395 (user (nth 1 parsed)))
|
|
|
3396 (kill-buffer
|
|
|
3397 (efs-ftp-process-buffer host user))))))))))
|
|
|
3398
|
|
|
3399 (defun efs-close-ftp-process (buffer)
|
|
|
3400 "Close an FTP connection.
|
|
|
3401 This kills the FTP client process, but unlike `efs-kill-ftp-process' this
|
|
|
3402 neither kills the process buffer, nor deletes cached data for the connection."
|
|
|
3403 (interactive "bClose FTP process associated with buffer: ")
|
|
|
3404 (or buffer (setq buffer (current-buffer)))
|
|
|
3405 (save-excursion
|
|
|
3406 (set-buffer buffer)
|
|
|
3407 (if (eq major-mode 'efs-mode)
|
|
|
3408 (let ((process (get-buffer-process buffer)))
|
|
|
3409 (if process
|
|
|
3410 (progn
|
|
|
3411 (set-process-sentinel process nil)
|
|
|
3412 (setq efs-process-busy nil
|
|
|
3413 efs-process-q nil)
|
|
|
3414 (if (or efs-mode-line-format efs-ftp-activity-function)
|
|
|
3415 (efs-update-mode-line))
|
|
|
3416 (delete-process process))))
|
|
|
3417 (let ((file (or (buffer-file-name) default-directory)))
|
|
|
3418 (if file
|
|
|
3419 (let ((parsed (efs-ftp-path (expand-file-name file))))
|
|
|
3420 (if parsed
|
|
|
3421 (let ((process (get-process
|
|
|
3422 (format "*ftp %s@%s*"
|
|
|
3423 (nth 1 parsed) (car parsed)))))
|
|
|
3424 (if process
|
|
|
3425 (progn
|
|
|
3426 (set-buffer (process-buffer process))
|
|
|
3427 (set-process-sentinel process nil)
|
|
|
3428 (setq efs-process-busy nil
|
|
|
3429 efs-process-q nil)
|
|
|
3430 (if (or efs-mode-line-format
|
|
|
3431 efs-ftp-activity-function)
|
|
|
3432 (efs-update-mode-line))
|
|
|
3433 (delete-process process)))))))))))
|
|
|
3434
|
|
|
3435 (defun efs-ping-ftp-connection (buffer)
|
|
|
3436 "Ping a connection by sending a NOOP command.
|
|
|
3437 Useful for waking up a possible expired connection."
|
|
|
3438 (interactive "bPing FTP connection associated with buffer: ")
|
|
|
3439 (or buffer (setq buffer (current-buffer)))
|
|
|
3440 (efs-save-buffer-excursion
|
|
|
3441 (set-buffer buffer)
|
|
|
3442 (let (file host user parsed)
|
|
|
3443 (if (or (and (eq major-mode 'efs-mode)
|
|
|
3444 (setq host efs-process-host
|
|
|
3445 user efs-process-user))
|
|
|
3446 (and (setq file (or (buffer-file-name) default-directory))
|
|
|
3447 (setq parsed (efs-ftp-path file))
|
|
|
3448 (setq host (car parsed)
|
|
|
3449 user (nth 1 parsed))))
|
|
|
3450 (or (car
|
|
|
3451 (efs-send-cmd
|
|
|
3452 host user '(quote noop)
|
|
|
3453 (format "Pinging connection %s@%s" user host)))
|
|
|
3454 (message "Connection %s@%s is alive." user host))))))
|
|
|
3455
|
|
|
3456 (defun efs-display-ftp-process-buffer (buffer)
|
|
|
3457 "Displays the FTP process buffer associated with the current buffer."
|
|
|
3458 (interactive "bDisplay FTP buffer associated with buffer: ")
|
|
|
3459 (if (null buffer) (setq buffer (current-buffer)))
|
|
|
3460 (let ((file (or (buffer-file-name) default-directory))
|
|
|
3461 parsed proc-buffer)
|
|
|
3462 (if (and file (setq parsed (efs-ftp-path file))
|
|
|
3463 (setq proc-buffer (get-buffer (efs-ftp-process-buffer
|
|
|
3464 (car parsed)
|
|
|
3465 (nth 1 parsed)))))
|
|
|
3466 (display-buffer proc-buffer)
|
|
|
3467 (error "Buffer %s not associated with an FTP process" buffer))))
|
|
|
3468
|
|
|
3469 ;;;; -------------------------------------------------------------------
|
|
|
3470 ;;;; Starting the FTP client process
|
|
|
3471 ;;;; -------------------------------------------------------------------
|
|
|
3472
|
|
|
3473 (defun efs-ftp-process-buffer (host user)
|
|
|
3474 "Return name of the process buffer for ftp process for HOST and USER."
|
|
|
3475 ;; Host names on the internet are case-insensitive.
|
|
|
3476 (format efs-ftp-buffer-format user (downcase host)))
|
|
|
3477
|
|
|
3478 (defun efs-pty-check (proc threshold)
|
|
|
3479 ;; Checks to see if PROC is a pty. Beware, it clobbers the process
|
|
|
3480 ;; filter, so run this before you set the filter.
|
|
|
3481 ;; THRESHOLD is an integer to tell it how long to wait for output.
|
|
|
3482 (sit-for 0) ; Update the display before doing any waiting.
|
|
|
3483 (let ((efs-pipe-p t)
|
|
|
3484 (n 0))
|
|
|
3485 (set-process-filter proc (function (lambda (proc string)
|
|
|
3486 (setq efs-pipe-p nil))))
|
|
|
3487 (while (and (< n threshold) efs-pipe-p)
|
|
|
3488 (accept-process-output)
|
|
|
3489 (setq n (1+ n)))
|
|
|
3490 (if efs-pipe-p
|
|
|
3491 (progn
|
|
|
3492 (sit-for 0) ; update display
|
|
|
3493 ;; Use a sleep-for as I don't want pty-checking to depend
|
|
|
3494 ;; on pending input.
|
|
|
3495 (sleep-for efs-pty-check-retry-time)))
|
|
|
3496 (accept-process-output)
|
|
|
3497 (if efs-pipe-p
|
|
|
3498 (if (or noninteractive
|
|
|
3499 (progn
|
|
|
3500 ;; in case the user typed something during the wait.
|
|
|
3501 (discard-input)
|
|
|
3502 (y-or-n-p
|
|
|
3503 (format "%s seems not a pty. Kill? " proc))))
|
|
|
3504 (progn
|
|
|
3505 (kill-buffer (process-buffer proc))
|
|
|
3506 (if (eq (selected-window) (minibuffer-window))
|
|
|
3507 (abort-recursive-edit)
|
|
|
3508 (signal 'quit nil))))
|
|
|
3509 ;; Need to send a \n to make sure, because sometimes we get the startup
|
|
|
3510 ;; prompt from a pipe.
|
|
|
3511 (sit-for 0)
|
|
|
3512 (process-send-string proc "\n")
|
|
|
3513 (setq efs-pipe-p t
|
|
|
3514 n 0)
|
|
|
3515 (while (and (< n threshold) efs-pipe-p)
|
|
|
3516 (accept-process-output)
|
|
|
3517 (setq n (1+ n)))
|
|
|
3518 (if efs-pipe-p
|
|
|
3519 (progn
|
|
|
3520 (sit-for 0)
|
|
|
3521 (sleep-for efs-pty-check-retry-time)))
|
|
|
3522 (accept-process-output)
|
|
|
3523 (if (and efs-pipe-p
|
|
|
3524 (or noninteractive
|
|
|
3525 (progn
|
|
|
3526 ;; in case the user typed something during the wait.
|
|
|
3527 (discard-input)
|
|
|
3528 (y-or-n-p
|
|
|
3529 (format "%s seems not a pty. Kill? " proc)))))
|
|
|
3530 (progn
|
|
|
3531 (kill-buffer (process-buffer proc))
|
|
|
3532 (if (eq (selected-window) (minibuffer-window))
|
|
|
3533 (abort-recursive-edit)
|
|
|
3534 (signal 'quit nil)))))))
|
|
|
3535
|
|
|
3536 (defun efs-start-process (host user name)
|
|
|
3537 "Spawn a new ftp process ready to connect to machine HOST as USER.
|
|
|
3538 If HOST is only ftp-able through a gateway machine then spawn a shell
|
|
|
3539 on the gateway machine to do the ftp instead. NAME is the name of the
|
|
|
3540 process."
|
|
|
3541 (let* ((use-gateway (efs-use-gateway-p host))
|
|
|
3542 (buffer (get-buffer-create (efs-ftp-process-buffer host user)))
|
|
|
3543 (process-connection-type t)
|
|
|
3544 (opaque-p (memq use-gateway efs-opaque-gateways))
|
|
|
3545 proc)
|
|
|
3546 (save-excursion
|
|
|
3547 (set-buffer buffer)
|
|
|
3548 (efs-mode host user (if opaque-p
|
|
|
3549 efs-gateway-ftp-prompt-regexp
|
|
|
3550 efs-ftp-prompt-regexp)))
|
|
|
3551 (cond
|
|
|
3552 ((null use-gateway)
|
|
|
3553 (message "Opening FTP connection to %s..." host)
|
|
|
3554 (setq proc (apply 'start-process name buffer efs-ftp-program-name
|
|
|
3555 efs-ftp-program-args)))
|
|
|
3556 ((eq use-gateway 'interactive)
|
|
|
3557 (setq proc (efs-gwp-start host user name)))
|
|
|
3558 ((eq use-gateway 'remsh)
|
|
|
3559 (message "Opening FTP connection to %s via %s..." host efs-gateway-host)
|
|
|
3560 (setq proc (apply 'start-process name buffer (nth 1 efs-gateway-type)
|
|
|
3561 (append (list efs-gateway-host)
|
|
|
3562 (nth 2 efs-gateway-type)
|
|
|
3563 (list (nth 3 efs-gateway-type))
|
|
|
3564 (nth 4 efs-gateway-type)))))
|
|
|
3565 ((memq use-gateway '(proxy raptor interlock kerberos))
|
|
|
3566 (message "Opening FTP connection to %s via %s..." host efs-gateway-host)
|
|
|
3567 (setq proc (apply 'start-process name buffer (nth 1 efs-gateway-type)
|
|
|
3568 (nth 2 efs-gateway-type))))
|
|
|
3569 ((eq use-gateway 'local)
|
|
|
3570 (message "Opening FTP connection to %s..." host)
|
|
|
3571 (setq proc (apply 'start-process name buffer (nth 1 efs-gateway-type)
|
|
|
3572 (nth 2 efs-gateway-type))))
|
|
|
3573 ((error "Never heard of gateway type %s" use-gateway)))
|
|
|
3574 (process-kill-without-query proc)
|
|
|
3575 (if opaque-p
|
|
|
3576 (accept-process-output proc)
|
|
|
3577 (if efs-pty-check-threshold
|
|
|
3578 (efs-pty-check proc efs-pty-check-threshold)
|
|
|
3579 (accept-process-output proc)))
|
|
|
3580 (set-process-sentinel proc (function efs-process-sentinel))
|
|
|
3581 (set-process-filter proc (function efs-process-filter))
|
|
|
3582 (efs-start-polling)
|
|
|
3583 (save-excursion
|
|
|
3584 (set-buffer buffer)
|
|
|
3585 (goto-char (point-max))
|
|
|
3586 (set-marker (process-mark proc) (point)))
|
|
|
3587 proc))
|
|
|
3588
|
|
|
3589 (defun efs-get-process-internal (host user)
|
|
|
3590 ;; Get's the first process for HOST and USER. If HOST runs a
|
|
|
3591 ;; a case insignificant OS, then case is not considered in USER.
|
|
|
3592 (let ((list (process-list))
|
|
|
3593 (case-fold (memq (efs-host-type host)
|
|
|
3594 efs-case-insensitive-host-types))
|
|
|
3595 (len (+ (length host) (length user) 7))
|
|
|
3596 fmt name found)
|
|
|
3597 (setq host (downcase host))
|
|
|
3598 (if case-fold (setq user (downcase user)))
|
|
|
3599 (while (and (not found) list)
|
|
|
3600 (setq name (process-name (car list)))
|
|
|
3601 (if (and (= (length name) len)
|
|
|
3602 (string-equal (substring name 0 5) "*ftp ")
|
|
|
3603 (string-equal
|
|
|
3604 (if case-fold (downcase (substring name 5)) (substring name 5))
|
|
|
3605 (or fmt (setq fmt (format "%s@%s*" user host))))
|
|
|
3606 (memq (process-status (car list)) '(run open)))
|
|
|
3607 (setq found (car list))
|
|
|
3608 (setq list (cdr list))))
|
|
|
3609 found))
|
|
|
3610
|
|
|
3611 ;; efs-guess-host-type calls this
|
|
|
3612 ;; function recursively. The (if (and proc... avoids an infinite
|
|
|
3613 ;; loop. We should make sure that this won't hang things if the
|
|
|
3614 ;; connection goes wrong.
|
|
|
3615
|
|
|
3616 (defun efs-get-process (host user)
|
|
|
3617 "Return the process object for the FTP process for HOST and USER.
|
|
|
3618 Create a new process if needed."
|
|
|
3619
|
|
|
3620 (let ((proc (efs-get-process-internal host user)))
|
|
|
3621 (if (and proc (memq (process-status proc) '(run open)))
|
|
|
3622 proc
|
|
|
3623
|
|
|
3624 ;; Make sure that the process isn't around in some strange state.
|
|
|
3625
|
|
|
3626 (setq host (downcase host))
|
|
|
3627 (let ((name (concat "*ftp " user "@" host "*")))
|
|
|
3628 (if proc (condition-case nil (delete-process proc) (error nil)))
|
|
|
3629
|
|
|
3630 ;; grab a suitable process.
|
|
|
3631 (setq proc (efs-start-process host user name))
|
|
|
3632
|
|
|
3633 (efs-save-match-data
|
|
|
3634 (efs-save-buffer-excursion
|
|
|
3635 (set-buffer (process-buffer proc))
|
|
|
3636
|
|
|
3637 ;; Run any user-specified hooks.
|
|
|
3638 (run-hooks 'efs-ftp-startup-hook)
|
|
|
3639
|
|
|
3640 ;; login to FTP server.
|
|
|
3641 (efs-login host user proc)
|
|
|
3642
|
|
|
3643 ;; Beware, the process may have died if the login went bad.
|
|
|
3644 (if (memq (process-status proc) '(run open))
|
|
|
3645
|
|
|
3646 (progn
|
|
|
3647 ;; Tell client to send back hash-marks as progress. It isn't
|
|
|
3648 ;; usually fatal if this command fails.
|
|
|
3649 (efs-guess-hash-mark-size proc)
|
|
|
3650
|
|
|
3651 ;; Run any user startup functions
|
|
|
3652 (let ((alist efs-ftp-startup-function-alist)
|
|
|
3653 (case-fold-search t))
|
|
|
3654 (while alist
|
|
|
3655 (if (string-match (car (car alist)) host)
|
|
|
3656 (progn
|
|
|
3657 (funcall (cdr (car alist)) host user)
|
|
|
3658 (setq alist nil))
|
|
|
3659 (setq alist (cdr alist)))))
|
|
|
3660
|
|
|
3661 ;; Guess at the host type.
|
|
|
3662 (efs-guess-host-type host user)
|
|
|
3663
|
|
|
3664 ;; Check the idle time.
|
|
|
3665 (efs-check-idle host user)
|
|
|
3666
|
|
|
3667 proc)
|
|
|
3668
|
|
|
3669 ;; Hopefully a recursive retry worked.
|
|
|
3670 (or (efs-get-process-internal host user)
|
|
|
3671 (error "No FTP process for %s@%s" user host)))))))))
|
|
|
3672
|
|
|
3673 (defun efs-guess-hash-mark-size (proc)
|
|
|
3674 ;; Doesn't run efs-save-match-data. You must do that yourself.
|
|
|
3675 (if efs-send-hash
|
|
|
3676 (save-excursion
|
|
|
3677 (set-buffer (process-buffer proc))
|
|
|
3678 (let ((line (nth 1 (efs-raw-send-cmd proc "hash")))
|
|
|
3679 (gate-p (efs-use-gateway-p efs-process-host t)))
|
|
|
3680 ;; Don't guess if the hash-mark-size is already set.
|
|
|
3681 (or (if gate-p efs-gateway-hash-mark-size efs-hash-mark-size)
|
|
|
3682 (if (string-match efs-hash-mark-msgs line)
|
|
|
3683 (let ((size (substring line (match-beginning 1)
|
|
|
3684 (match-end 1))))
|
|
|
3685 (if (string-match "^[0-9]+$" size)
|
|
|
3686 (set (if gate-p
|
|
|
3687 'efs-gateway-hash-mark-size
|
|
|
3688 'efs-hash-mark-size)
|
|
|
3689 (string-to-int size))))))))))
|
|
|
3690
|
|
|
3691 ;;;; ------------------------------------------------------------
|
|
|
3692 ;;;; Simple FTP process shell support.
|
|
|
3693 ;;;; ------------------------------------------------------------
|
|
|
3694
|
|
|
3695 (defun efs-mode (host user prompt)
|
|
|
3696 "Major mode for interacting with an FTP process.
|
|
|
3697 The user interface for sending commands to the FTP process is `comint-mode'.
|
|
|
3698 For more information see the documentation for `comint-mode'. This command
|
|
|
3699 is not intended for interactive use.
|
|
|
3700 Takes arguments: HOST USER PROMPT
|
|
|
3701
|
|
|
3702 Runs efs-mode-hook if it is not nil.
|
|
|
3703
|
|
|
3704 Key map:
|
|
|
3705 \\{comint-mode-map}"
|
|
|
3706 (let ((proc (get-buffer-process (current-buffer))))
|
|
|
3707 ;; Running comint-mode will kill-all-local-variables.
|
|
|
3708 (comint-mode)
|
|
|
3709 ;; All these variables are buffer local.
|
|
|
3710 (setq major-mode 'efs-mode
|
|
|
3711 mode-name "efs"
|
|
|
3712 default-directory (file-name-directory efs-tmp-name-template)
|
|
|
3713 comint-prompt-regexp prompt
|
|
|
3714 efs-process-host host
|
|
|
3715 efs-process-user user
|
|
|
3716 efs-process-prompt-regexp prompt)
|
|
|
3717 (set (make-local-variable 'paragraph-start) comint-prompt-regexp)
|
|
|
3718 ;; Old versions of comint don't have this. It does no harm for
|
|
|
3719 ;; the newer ones.
|
|
|
3720 (set (make-local-variable 'comint-last-input-start) (make-marker))
|
|
|
3721 (goto-char (point-max))
|
|
|
3722 ;; in case there is a running process
|
|
|
3723 (if proc (set-marker (process-mark proc) (point)))
|
|
|
3724 (run-hooks 'efs-mode-hook)))
|
|
|
3725
|
|
|
3726
|
|
|
3727 ;;;; =============================================================
|
|
|
3728 ;;;; >6
|
|
|
3729 ;;;; Sending commands to the FTP server.
|
|
|
3730 ;;;; =============================================================
|
|
|
3731
|
|
|
3732 ;;;; -------------------------------------------------------------
|
|
|
3733 ;;;; General purpose functions for sending commands.
|
|
|
3734 ;;;; -------------------------------------------------------------
|
|
|
3735
|
|
|
3736 (defun efs-raw-send-cmd (proc cmd &optional msg pre-cont cont nowait)
|
|
|
3737 ;; Low-level routine to send the given ftp CMD to the ftp PROCESS.
|
|
|
3738 ;; MSG is an optional message to output before and after the command.
|
|
|
3739 ;; If PRE-CONT is non-nil, it is called immediately after execution
|
|
|
3740 ;; of the command starts, but without waiting for it to finish.
|
|
|
3741 ;; If CONT is non-NIL then it is either a function or a list of function and
|
|
|
3742 ;; some arguments. The function will be called when the ftp command has
|
|
|
3743 ;; completed.
|
|
|
3744 ;; If CONT is NIL then this routine will return \( RESULT . LINE \) where
|
|
|
3745 ;; RESULT is whether the command was successful, and LINE is the line from
|
|
|
3746 ;; the FTP process that caused the command to complete.
|
|
|
3747 ;; If NOWAIT is nil then we will wait for the command to complete before
|
|
|
3748 ;; returning. If NOWAIT is 0, then we will wait until the command starts,
|
|
|
3749 ;; executing before returning. NOWAIT of 1 is like 0, except that the modeline
|
|
|
3750 ;; will indicate an asynch FTP command.
|
|
|
3751 ;; If NOWAIT has any other value, then we will simply queue the
|
|
|
3752 ;; command. In all cases, CONT will still be called
|
|
|
3753
|
|
|
3754 (if (memq (process-status proc) '(run open))
|
|
|
3755 (efs-save-buffer-excursion
|
|
|
3756 (set-buffer (process-buffer proc))
|
|
|
3757
|
|
|
3758 (if efs-process-busy
|
|
|
3759 ;; This function will always wait on a busy process.
|
|
|
3760 ;; Queueing is done by efs-send-cmd.
|
|
|
3761 (let ((efs-process-cmd-waiting t))
|
|
|
3762 (efs-kbd-quit-protect proc
|
|
|
3763 (while efs-process-busy
|
|
|
3764 (accept-process-output)))))
|
|
|
3765
|
|
|
3766 (setq efs-process-string ""
|
|
|
3767 efs-process-result-line ""
|
|
|
3768 efs-process-result-cont-lines ""
|
|
|
3769 efs-process-busy t
|
|
|
3770 efs-process-msg (and efs-verbose msg)
|
|
|
3771 efs-process-continue cont
|
|
|
3772 efs-process-server-confused nil
|
|
|
3773 efs-process-nowait nowait
|
|
|
3774 efs-process-hash-mark-count 0
|
|
|
3775 efs-process-last-percent -1
|
|
|
3776 efs-process-xfer-size 0
|
|
|
3777 efs-process-cmd-counter (% (1+ efs-process-cmd-counter) 16))
|
|
|
3778 (process-kill-without-query proc t)
|
|
|
3779 (and efs-process-msg
|
|
|
3780 (efs-message-p)
|
|
|
3781 (efs-message "%s..." efs-process-msg))
|
|
|
3782 (goto-char (point-max))
|
|
|
3783 (move-marker comint-last-input-start (point))
|
|
|
3784 (move-marker comint-last-input-end (point))
|
|
|
3785 ;; don't insert the password into the buffer on the USER command.
|
|
|
3786 (efs-save-match-data
|
|
|
3787 (if (string-match efs-passwd-cmds cmd)
|
|
|
3788 (insert (setq efs-process-cmd
|
|
|
3789 (substring cmd 0 (match-end 0)))
|
|
|
3790 " Turtle Power!\n")
|
|
|
3791 (setq efs-process-cmd cmd)
|
|
|
3792 (insert cmd "\n")))
|
|
|
3793 (process-send-string proc (concat cmd "\n"))
|
|
|
3794 (set-marker (process-mark proc) (point))
|
|
|
3795 ;; Update the mode-line
|
|
|
3796 (if (and (or efs-mode-line-format efs-ftp-activity-function)
|
|
|
3797 (memq nowait '(t 1)))
|
|
|
3798 (efs-update-mode-line))
|
|
|
3799 (if pre-cont
|
|
|
3800 (let ((efs-nested-cmd t))
|
|
|
3801 (save-excursion
|
|
|
3802 (apply (car pre-cont) (cdr pre-cont)))))
|
|
|
3803 (prog1
|
|
|
3804 (if nowait
|
|
|
3805 nil
|
|
|
3806 ;; hang around for command to complete
|
|
|
3807 ;; Some clients die after the command is sent, if the server
|
|
|
3808 ;; times out. Don't wait on dead processes.
|
|
|
3809 (efs-kbd-quit-protect proc
|
|
|
3810 (while (and efs-process-busy
|
|
|
3811 ;; Need to recheck nowait, since it may get reset
|
|
|
3812 ;; in a cont.
|
|
|
3813 (null efs-process-nowait)
|
|
|
3814 (memq (process-status proc) '(run open)))
|
|
|
3815 (accept-process-output proc)))
|
|
|
3816
|
|
|
3817 ;; cont is called by the process filter
|
|
|
3818 (if cont
|
|
|
3819 ;; Return nil if a cont was called.
|
|
|
3820 ;; Can't return process-result
|
|
|
3821 ;; and process-line since executing
|
|
|
3822 ;; the cont may have changed
|
|
|
3823 ;; the state of the process buffer.
|
|
|
3824 nil
|
|
|
3825 (list efs-process-result
|
|
|
3826 efs-process-result-line
|
|
|
3827 efs-process-result-cont-lines)))
|
|
|
3828
|
|
|
3829 ;; If the process died, the filter would have never got the chance
|
|
|
3830 ;; to call the cont. Try to jump start things.
|
|
|
3831
|
|
|
3832 (if (and (not (memq (process-status proc) '(run open)))
|
|
|
3833 (string-equal efs-process-result-line "")
|
|
|
3834 cont
|
|
|
3835 (equal cont efs-process-continue))
|
|
|
3836 (progn
|
|
|
3837 (setq efs-process-continue nil
|
|
|
3838 efs-process-busy nil)
|
|
|
3839 ;; The process may be in some strange state. Get rid of it.
|
|
|
3840 (condition-case nil (delete-process proc) (error nil))
|
|
|
3841 (efs-call-cont cont 'fatal "" "")))))
|
|
|
3842
|
|
|
3843 (error "FTP process %s has died." (process-name proc))))
|
|
|
3844
|
|
|
3845 (efs-defun efs-quote-string nil (string &optional not-space)
|
|
|
3846 "Quote any characters in STRING that may confuse the ftp process.
|
|
|
3847 If NOT-SPACE is non-nil, then blank characters are not quoted, because
|
|
|
3848 it is assumed that the string will be surrounded by \"'s."
|
|
|
3849 (apply (function concat)
|
|
|
3850 (mapcar (function
|
|
|
3851 (lambda (char)
|
|
|
3852 (if (or (< char ?\ )
|
|
|
3853 (and (null not-space) (= char ?\ ))
|
|
|
3854 (> char ?\~)
|
|
|
3855 (= char ?\")
|
|
|
3856 (= char ?\\))
|
|
|
3857 (vector ?\\ char)
|
|
|
3858 (vector char))))
|
|
|
3859 string)))
|
|
|
3860
|
|
|
3861 (efs-defun efs-fix-path nil (path &optional reverse)
|
|
|
3862 "Convert PATH from a unix format to a non-unix format.
|
|
|
3863 If optional REVERSE, convert in the opposite direction."
|
|
|
3864 (identity path))
|
|
|
3865
|
|
|
3866 (efs-defun efs-fix-dir-path nil (dir-path)
|
|
|
3867 "Convert DIR-PATH from unix format to a non-unix format for a dir listing"
|
|
|
3868 ;; The default def runs for dos-distinct, ka9q, and all the unix's.
|
|
|
3869 ;; To be more careful about distinguishing dirs from plain files,
|
|
|
3870 ;; we append a ".".
|
|
|
3871 (let ((len (length dir-path)))
|
|
|
3872 (if (and (not (zerop len)) (= (aref dir-path (1- len)) ?/))
|
|
|
3873 (concat dir-path ".")
|
|
|
3874 dir-path)))
|
|
|
3875
|
|
|
3876 (defun efs-send-cmd (host user cmd
|
|
|
3877 &optional msg pre-cont cont nowait noretry)
|
|
|
3878 "Find an ftp process connected to HOST logged in as USER and send it CMD.
|
|
|
3879 MSG is an optional status message to be output before and after issuing the
|
|
|
3880 command.
|
|
|
3881
|
|
|
3882 See the documentation for efs-raw-send-cmd for a description of CONT, PRE-CONT
|
|
|
3883 and NOWAIT. Normally, if the command fails it is retried. If NORETRY is
|
|
|
3884 non-nil, this is not done."
|
|
|
3885 ;; Handles conversion to remote pathname syntax and remote ls option
|
|
|
3886 ;; capability. Also, sends umask if nec.
|
|
|
3887
|
|
|
3888 (let ((proc (efs-get-process host user)))
|
|
|
3889
|
|
|
3890 (if (and
|
|
|
3891 (eq nowait t)
|
|
|
3892 (save-excursion
|
|
|
3893 (set-buffer (process-buffer proc))
|
|
|
3894 (or efs-process-busy
|
|
|
3895 efs-process-cmd-waiting)))
|
|
|
3896
|
|
|
3897 (progn
|
|
|
3898 (efs-add-to-queue
|
|
|
3899 host user
|
|
|
3900 ;; Not nec. to store host and user, because the queue is for
|
|
|
3901 ;; a specific host user pair anyway. Because the queue is always
|
|
|
3902 ;; examined when efs-process-busy
|
|
|
3903 ;; is nil, it should be impossible to get into a loop
|
|
|
3904 ;; where we keep re-queueing over and over. To be on the safe
|
|
|
3905 ;; side, store nowait as 1.
|
|
|
3906 (list cmd msg pre-cont cont 1 noretry))
|
|
|
3907 nil)
|
|
|
3908
|
|
|
3909 ;; Send a command.
|
|
|
3910
|
|
|
3911 (let (cmd-string afsc-result afsc-line afsc-cont-lines)
|
|
|
3912
|
|
|
3913 (let ((efs-nested-cmd t)
|
|
|
3914 (cmd0 (car cmd))
|
|
|
3915 (cmd1 (nth 1 cmd))
|
|
|
3916 (cmd2 (nth 2 cmd))
|
|
|
3917 (cmd3 (nth 3 cmd)))
|
|
|
3918
|
|
|
3919 (cond
|
|
|
3920
|
|
|
3921 ((eq cmd0 'quote)
|
|
|
3922 ;; QUOTEd commands
|
|
|
3923 (cond
|
|
|
3924
|
|
|
3925 ((eq cmd1 'site)
|
|
|
3926 ;; SITE commands
|
|
|
3927 (cond
|
|
|
3928 ((memq cmd2 '(umask idle dos exec nfs group gpass))
|
|
|
3929 ;; For UMASK cmd3 = value of umask
|
|
|
3930 ;; For IDLE cmd3 = idle setting, or nil if we're querying.
|
|
|
3931 ;; For DOS and NFS cmd3 is nil.
|
|
|
3932 ;; For EXEC cmd3 is the command to be exec'ed -- a string.
|
|
|
3933 (if cmd3 (setq cmd3 (concat " " cmd3)))
|
|
|
3934 (setq cmd-string (concat "quote site " (symbol-name cmd2)
|
|
|
3935 cmd3)))
|
|
|
3936 ((eq cmd2 'chmod)
|
|
|
3937 (let* ((host-type (efs-host-type host user))
|
|
|
3938 (cmd4 (efs-quote-string
|
|
|
3939 host-type (efs-fix-path host-type (nth 4 cmd)))))
|
|
|
3940 (setq cmd-string (concat "quote site chmod " cmd3 " "
|
|
|
3941 cmd4))))
|
|
|
3942 (t (error "efs: Don't know how to send %s %s %s %s"
|
|
|
3943 cmd0 cmd1 cmd2 cmd3))))
|
|
|
3944
|
|
|
3945 ((memq cmd1 '(pwd xpwd syst pasv noop))
|
|
|
3946 (setq cmd-string (concat "quote " (symbol-name cmd1))))
|
|
|
3947
|
|
|
3948 ;; PORT command (cmd2 is IP + port address)
|
|
|
3949 ((eq cmd1 'port)
|
|
|
3950 (setq cmd-string (concat "quote port " cmd2)))
|
|
|
3951
|
|
|
3952 ((memq cmd1 '(appe retr))
|
|
|
3953 (let ((host-type (efs-host-type host user)))
|
|
|
3954 ;; Set an xfer type
|
|
|
3955 (if cmd3 (efs-set-xfer-type host user cmd3 t))
|
|
|
3956 (setq cmd2 (efs-quote-string host-type
|
|
|
3957 (efs-fix-path host-type cmd2))
|
|
|
3958 cmd-string (concat "quote " (symbol-name cmd1) " "
|
|
|
3959 cmd2))))
|
|
|
3960
|
|
|
3961 ((eq cmd1 'stor)
|
|
|
3962 (let ((host-type (efs-host-type host user)))
|
|
|
3963 (if (memq host-type efs-unix-host-types)
|
|
|
3964 (efs-set-umask host user))
|
|
|
3965 ;; Set an xfer type
|
|
|
3966 (if cmd3 (efs-set-xfer-type host user cmd3 t))
|
|
|
3967 (setq cmd2 (efs-quote-string host-type
|
|
|
3968 (efs-fix-path host-type cmd2))
|
|
|
3969 cmd-string (concat "quote stor " cmd2))))
|
|
|
3970
|
|
|
3971 ((memq cmd1 '(size mdtm rnfr))
|
|
|
3972 (let ((host-type (efs-host-type host user)))
|
|
|
3973 (setq cmd2 (efs-quote-string host-type
|
|
|
3974 (efs-fix-path host-type cmd2))
|
|
|
3975 cmd-string (concat "quote "
|
|
|
3976 (symbol-name cmd1) " " cmd2))))
|
|
|
3977
|
|
|
3978 ((memq cmd1 '(pass user))
|
|
|
3979 (setq cmd-string (concat "quote " (symbol-name cmd1) " " cmd2)))
|
|
|
3980
|
|
|
3981 (t
|
|
|
3982 (error "efs: Don't know how to send %s %s %s %s"
|
|
|
3983 cmd0 cmd1 cmd2 cmd3))))
|
|
|
3984
|
|
|
3985 ;; TYPE command
|
|
|
3986 ((eq cmd0 'type)
|
|
|
3987 (setq cmd-string (concat "type " (symbol-name cmd1))))
|
|
|
3988
|
|
|
3989 ;; DIR command
|
|
|
3990 ;; cmd == 'dir "remote-path" "local-path" "ls-switches"
|
|
|
3991 ((memq cmd0 '(dir nlist))
|
|
|
3992 (let ((host-type (efs-host-type host user))
|
|
|
3993 (listing-type (efs-listing-type host user)))
|
|
|
3994 (setq cmd1 (efs-fix-dir-path host-type cmd1))
|
|
|
3995 (cond
|
|
|
3996 ((memq listing-type efs-nlist-listing-types)
|
|
|
3997 (setq cmd-string (concat efs-nlist-cmd " "
|
|
|
3998 (efs-quote-string host-type cmd1)
|
|
|
3999 " " cmd2)))
|
|
|
4000 ((or (memq host-type efs-dumb-host-types)
|
|
|
4001 (null cmd3))
|
|
|
4002 (setq cmd-string (format "%s %s %s"
|
|
|
4003 (if (eq cmd0 'nlist)
|
|
|
4004 efs-nlist-cmd
|
|
|
4005 "dir")
|
|
|
4006 (efs-quote-string host-type cmd1)
|
|
|
4007 cmd2)))
|
|
|
4008 ((setq cmd-string
|
|
|
4009 (format "%s \"%s %s\" %s"
|
|
|
4010 (if (eq cmd0 'nlist)
|
|
|
4011 efs-nlist-cmd
|
|
|
4012 "ls")
|
|
|
4013 cmd3 (efs-quote-string host-type cmd1 t)
|
|
|
4014 ;; cmd2 is a temp file, not nec. to quote.
|
|
|
4015 cmd2))))))
|
|
|
4016
|
|
|
4017 ;; First argument is the remote pathname
|
|
|
4018 ((memq cmd0 '(delete mkdir rmdir cd))
|
|
|
4019 (let ((host-type (efs-host-type host user)))
|
|
|
4020 (setq cmd1 (efs-quote-string host-type
|
|
|
4021 (efs-fix-path host-type cmd1))
|
|
|
4022 cmd-string (concat (symbol-name cmd0) " " cmd1))))
|
|
|
4023
|
|
|
4024 ;; GET command
|
|
|
4025 ((eq cmd0 'get)
|
|
|
4026 (let ((host-type (efs-host-type host user)))
|
|
|
4027 (if cmd3 (efs-set-xfer-type host user cmd3))
|
|
|
4028 (efs-set-hash-mark-unit host user t)
|
|
|
4029 (setq cmd1 (efs-quote-string host-type
|
|
|
4030 (efs-fix-path host-type cmd1))
|
|
|
4031 cmd2 (efs-quote-string host-type cmd2)
|
|
|
4032 cmd-string (concat "get " cmd1 " " cmd2))))
|
|
|
4033
|
|
|
4034 ;; PUT command
|
|
|
4035 ((eq cmd0 'put)
|
|
|
4036 (let ((host-type (efs-host-type host user)))
|
|
|
4037 (if (memq host-type efs-unix-host-types)
|
|
|
4038 (efs-set-umask host user))
|
|
|
4039 (if cmd3 (efs-set-xfer-type host user cmd3))
|
|
|
4040 (efs-set-hash-mark-unit host user)
|
|
|
4041 (setq cmd2 (efs-quote-string host-type
|
|
|
4042 (efs-fix-path host-type cmd2))
|
|
|
4043 cmd1 (efs-quote-string host-type cmd1)
|
|
|
4044 cmd-string (concat "put " cmd1 " " cmd2))))
|
|
|
4045
|
|
|
4046 ;; APPEND command
|
|
|
4047 ((eq cmd0 'append)
|
|
|
4048 (let ((host-type (efs-host-type host user)))
|
|
|
4049 (if cmd3 (efs-set-xfer-type host user cmd3))
|
|
|
4050 (efs-set-hash-mark-unit host user)
|
|
|
4051 (setq cmd2 (efs-quote-string host-type
|
|
|
4052 (efs-fix-path host-type cmd2))
|
|
|
4053 cmd1 (efs-quote-string host-type cmd1)
|
|
|
4054 cmd-string (concat "append " cmd1 " " cmd2))))
|
|
|
4055
|
|
|
4056 ;; CHMOD command
|
|
|
4057 ((eq cmd0 'chmod)
|
|
|
4058 (let ((host-type (efs-host-type host user)))
|
|
|
4059 (setq cmd2 (efs-quote-string host-type
|
|
|
4060 (efs-fix-path host-type cmd2))
|
|
|
4061 cmd-string (concat "chmod " cmd1 " " cmd2))))
|
|
|
4062
|
|
|
4063 ;; Both arguments are remote pathnames
|
|
|
4064 ((eq cmd0 'rename)
|
|
|
4065 (let ((host-type (efs-host-type host user)))
|
|
|
4066 (setq cmd1 (efs-quote-string host-type
|
|
|
4067 (efs-fix-path host-type cmd1))
|
|
|
4068 cmd2 (efs-quote-string host-type
|
|
|
4069 (efs-fix-path host-type cmd2))
|
|
|
4070 cmd-string (concat "rename " cmd1 " " cmd2))))
|
|
|
4071
|
|
|
4072 (t
|
|
|
4073 (error "efs: Don't know how to send %s %s %s %s"
|
|
|
4074 cmd0 cmd1 cmd2 cmd3))))
|
|
|
4075
|
|
|
4076 ;; Actually send the resulting command.
|
|
|
4077 ;; Why do we use this complicated binding of afsc-{result,line},
|
|
|
4078 ;; rather then use the fact that efs-raw-send-cmd returns?
|
|
|
4079 ;; Because efs-raw-send-cmd returns the result of the first
|
|
|
4080 ;; attempt only. efs-send-cmd should return the result of
|
|
|
4081 ;; the retry, if one was necessary.
|
|
|
4082 ;; Maybe it would be better if efs-raw-send-cmd returned
|
|
|
4083 ;; the result of cont, if nowait was nil? Or maybe still return
|
|
|
4084 ;; \(result line \)? As long as nowait is nil, it should
|
|
|
4085 ;; return something useful.
|
|
|
4086
|
|
|
4087 ;; Beware, if some of the above FTP commands had to restart
|
|
|
4088 ;; the process, PROC won't be set to the right process object.
|
|
|
4089 (setq proc (efs-get-process host user))
|
|
|
4090
|
|
|
4091 (efs-raw-send-cmd
|
|
|
4092 proc
|
|
|
4093 cmd-string
|
|
|
4094 msg
|
|
|
4095 pre-cont
|
|
|
4096 (efs-cont (result line cont-lines) (host user proc cmd msg pre-cont
|
|
|
4097 cont nowait noretry)
|
|
|
4098 (cond ((and (null noretry) (eq result 'fatal))
|
|
|
4099 (let ((retry
|
|
|
4100 (efs-send-cmd
|
|
|
4101 host user cmd msg pre-cont cont
|
|
|
4102 (if (eq nowait t) 1 nowait) t)))
|
|
|
4103 (or cont nowait
|
|
|
4104 (setq afsc-result (car retry)
|
|
|
4105 afsc-line (nth 1 retry)
|
|
|
4106 afsc-cont-lines (nth 2 retry)))))
|
|
|
4107 ((and (eq result 'failed)
|
|
|
4108 (or (memq (car cmd) '(append rename put))
|
|
|
4109 (and (eq (car cmd) 'quote)
|
|
|
4110 (eq (nth 1 cmd) 'stor)))
|
|
|
4111 (efs-save-match-data
|
|
|
4112 (string-match efs-write-protect-msgs line)))
|
|
|
4113 (let ((retry (efs-write-recover
|
|
|
4114 (efs-host-type host)
|
|
|
4115 line cont-lines host user cmd msg pre-cont
|
|
|
4116 cont nowait noretry)))
|
|
|
4117 (or cont nowait
|
|
|
4118 (setq afsc-result (car retry)
|
|
|
4119 afsc-line (nth 1 retry)
|
|
|
4120 afsc-cont-lines (nth 2 retry)))))
|
|
|
4121
|
|
|
4122 (t (if cont
|
|
|
4123 (efs-call-cont cont result line cont-lines)
|
|
|
4124 (or nowait
|
|
|
4125 (setq afsc-result result
|
|
|
4126 afsc-line line
|
|
|
4127 afsc-cont-lines cont-lines))))))
|
|
|
4128 nowait)
|
|
|
4129
|
|
|
4130 (prog1
|
|
|
4131 (if (or nowait cont)
|
|
|
4132 nil
|
|
|
4133 (list afsc-result afsc-line afsc-cont-lines))
|
|
|
4134
|
|
|
4135 ;; Check the queue
|
|
|
4136 (or nowait
|
|
|
4137 efs-nested-cmd
|
|
|
4138 (let ((buff (efs-ftp-process-buffer host user)))
|
|
|
4139 (if (get-buffer buff)
|
|
|
4140 (save-excursion
|
|
|
4141 (set-buffer buff)
|
|
|
4142 (if efs-process-q
|
|
|
4143 (let ((next (car efs-process-q)))
|
|
|
4144 (setq efs-process-q (cdr efs-process-q))
|
|
|
4145 (apply 'efs-send-cmd host user next))))))))))))
|
|
|
4146
|
|
|
4147 (efs-defun efs-write-recover nil
|
|
|
4148 (line cont-lines host user cmd msg pre-cont cont nowait noretry)
|
|
|
4149 "Called when a write command fails with `efs-write-protect-msgs'.
|
|
|
4150 Should return \(result line cont-lines\), like `efs-raw-send-cmd'."
|
|
|
4151 ;; This default version doesn't do anything.
|
|
|
4152 (if cont
|
|
|
4153 (progn
|
|
|
4154 (efs-call-cont cont 'failed line cont-lines)
|
|
|
4155 nil)
|
|
|
4156 (if nowait nil (list 'failed line cont-lines))))
|
|
|
4157
|
|
|
4158 ;;;; ---------------------------------------------------------------------
|
|
|
4159 ;;;; The login sequence. (The follows RFC959 rather tightly. If a server
|
|
|
4160 ;;;; can't even get the login codes right, it is
|
|
|
4161 ;;;; pretty much scrap metal.)
|
|
|
4162 ;;;; ---------------------------------------------------------------------
|
|
|
4163
|
|
|
4164 (defun efs-nslookup-host (host)
|
|
|
4165 "Attempt to resolve the given HOSTNAME using nslookup if possible."
|
|
|
4166 (interactive "sHost: ")
|
|
|
4167 (if efs-nslookup-program
|
|
|
4168 (let* ((default-directory exec-directory)
|
|
|
4169 (default-major-mode 'fundamental-mode)
|
|
|
4170 (process-connection-type nil)
|
|
|
4171 (proc (start-process " *nslookup*" " *nslookup*"
|
|
|
4172 efs-nslookup-program host))
|
|
|
4173 (res host))
|
|
|
4174 (process-kill-without-query proc)
|
|
|
4175 (save-excursion
|
|
|
4176 (set-buffer (process-buffer proc))
|
|
|
4177 (let ((quit-flag nil)
|
|
|
4178 (inhibit-quit nil))
|
|
|
4179 (while (memq (process-status proc) '(run open))
|
|
|
4180 (accept-process-output proc)))
|
|
|
4181 (goto-char (point-min))
|
|
|
4182 (if (re-search-forward
|
|
|
4183 "Name:.*\nAddress\\(es\\)?: *\\([.0-9]+\\)$" nil t)
|
|
|
4184 (setq res (buffer-substring (match-beginning 2)
|
|
|
4185 (match-end 2))))
|
|
|
4186 (kill-buffer (current-buffer)))
|
|
|
4187 (if (interactive-p)
|
|
|
4188 (message "%s: %s" host res))
|
|
|
4189 res)
|
|
|
4190 (if (interactive-p)
|
|
|
4191 (message
|
|
|
4192 "No nslookup program. See the variable efs-nslookup-program."))
|
|
|
4193 host))
|
|
|
4194
|
|
|
4195 (defun efs-login (host user proc)
|
|
|
4196 "Connect to the FTP-server on HOST as USER.
|
|
|
4197 PROC is the process to the FTP-client. Doesn't call efs-save-match-data.
|
|
|
4198 You must do that yourself."
|
|
|
4199 (let ((gate (efs-use-gateway-p host)))
|
|
|
4200 (if (eq gate 'kerberos)
|
|
|
4201 (progn
|
|
|
4202 (setq proc (efs-kerberos-login host user proc))
|
|
|
4203 (efs-login-send-user host user proc gate))
|
|
|
4204 (let ((to (if (memq gate '(proxy local raptor))
|
|
|
4205 efs-gateway-host
|
|
|
4206 host))
|
|
|
4207 port cmd result)
|
|
|
4208 (if (string-match "#" to)
|
|
|
4209 (setq port (substring to (match-end 0))
|
|
|
4210 to (substring to 0 (match-beginning 0))))
|
|
|
4211 (and efs-nslookup-on-connect
|
|
|
4212 (string-match "[^0-9.]" to)
|
|
|
4213 (setq to (efs-nslookup-host to)))
|
|
|
4214 (setq cmd (concat "open " to))
|
|
|
4215 (if port (setq cmd (concat cmd " " port)))
|
|
|
4216
|
|
|
4217 ;; Send OPEN command.
|
|
|
4218 (setq result (efs-raw-send-cmd proc cmd nil))
|
|
|
4219
|
|
|
4220 (and (eq gate 'interlock) (string-match "^331 " (nth 1 result))
|
|
|
4221 (setq result (efs-login-send-pass
|
|
|
4222 efs-gateway-host
|
|
|
4223 (efs-get-user efs-gateway-host) proc)))
|
|
|
4224
|
|
|
4225 ;; Analyze result of OPEN.
|
|
|
4226 (if (car result)
|
|
|
4227 (progn
|
|
|
4228 (condition-case nil (delete-process proc) (error nil))
|
|
|
4229 (efs-error host user (concat "OPEN request failed: "
|
|
|
4230 (nth 1 result))))
|
|
|
4231 (efs-login-send-user host user proc gate))))))
|
|
|
4232
|
|
|
4233 (defun efs-login-send-user (host user proc &optional gate retry)
|
|
|
4234 "Send user command to HOST and USER. PROC is the ftp client process.
|
|
|
4235 Optional argument GATE specifies which type of gateway is being used.
|
|
|
4236 RETRY argument specifies to try twice if we get a 421 response."
|
|
|
4237 (let ((cmd (cond
|
|
|
4238 ((memq gate '(local proxy interlock))
|
|
|
4239 (format "quote USER \"%s\"@%s" user
|
|
|
4240 (if (and efs-nslookup-on-connect
|
|
|
4241 (string-match "[^0-9.]" host))
|
|
|
4242 (efs-nslookup-host host)
|
|
|
4243 host)))
|
|
|
4244 ((eq gate 'raptor)
|
|
|
4245 (format "quote USER \"%s\"@%s %s" user
|
|
|
4246 (if (and efs-nslookup-on-connect
|
|
|
4247 (string-match "[^0-9.]" host))
|
|
|
4248 (efs-nslookup-host host)
|
|
|
4249 host)
|
|
|
4250 (nth 3 efs-gateway-type)))
|
|
|
4251 ((eq gate 'kerberos)
|
|
|
4252 (let ((to host)
|
|
|
4253 port)
|
|
|
4254 (if (string-match "#" host)
|
|
|
4255 (progn
|
|
|
4256 (setq to (substring host 0 (match-beginning 0))
|
|
|
4257 port (substring host (match-end 0)))
|
|
|
4258 (and efs-nslookup-on-connect
|
|
|
4259 (string-match "[^0-9.]" to)
|
|
|
4260 (efs-nslookup-host to))
|
|
|
4261 (setq to (concat to "@" port))))
|
|
|
4262 (format "quote user \"%s\"@%s" user to)))
|
|
|
4263 (t
|
|
|
4264 (format "quote user \"%s\"" user))))
|
|
|
4265 (msg (format "Logging in as user %s%s..." user
|
|
|
4266 (if (memq gate '(proxy local raptor kerberos))
|
|
|
4267 (concat "@" host) "")))
|
|
|
4268 result code)
|
|
|
4269
|
|
|
4270 ;; Send the message by hand so that we can report on the size
|
|
|
4271 ;; of the MOTD.
|
|
|
4272 (message msg)
|
|
|
4273
|
|
|
4274 ;; Send USER command.
|
|
|
4275 (setq result (efs-raw-send-cmd proc cmd nil))
|
|
|
4276
|
|
|
4277 ;; Analyze result of USER (this follows RFC959 strictly)
|
|
|
4278 (if (< (length (nth 1 result)) 4)
|
|
|
4279 (progn
|
|
|
4280 (condition-case nil (delete-process proc) (error nil))
|
|
|
4281 (efs-error host user
|
|
|
4282 (concat "USER request failed: " (nth 1 result))))
|
|
|
4283
|
|
|
4284 (setq code (substring (nth 1 result) 0 4))
|
|
|
4285 (cond
|
|
|
4286
|
|
|
4287 ((string-equal "331 " code)
|
|
|
4288 ;; Need password
|
|
|
4289 (setq result (efs-login-send-pass host user proc gate)))
|
|
|
4290
|
|
|
4291 ((string-equal "332 " code)
|
|
|
4292 ;; Need an account, but no password
|
|
|
4293 (setq result (efs-login-send-acct host user proc gate)))
|
|
|
4294
|
|
|
4295 ((null (car result))
|
|
|
4296 ;; logged in proceed
|
|
|
4297 nil)
|
|
|
4298
|
|
|
4299 ((and (or (string-equal "530 " code) (string-equal "421 " code))
|
|
|
4300 (efs-anonymous-p user)
|
|
|
4301 (or (string-match efs-too-many-users-msgs (nth 1 result))
|
|
|
4302 (string-match efs-too-many-users-msgs (nth 2 result))))
|
|
|
4303 (if (save-window-excursion
|
|
|
4304 (condition-case nil
|
|
|
4305 (display-buffer (process-buffer proc))
|
|
|
4306 (error nil))
|
|
|
4307 (y-or-n-p (format
|
|
|
4308 "Too many users for %s@%s. Try again? "
|
|
|
4309 user host)))
|
|
|
4310 (progn
|
|
|
4311 ;; Set result to nil if we are doing a retry, so done
|
|
|
4312 ;; message only gets sent once.
|
|
|
4313 (setq result nil)
|
|
|
4314 (if (string-equal code "530 ")
|
|
|
4315 (efs-login-send-user host user proc gate t)
|
|
|
4316 (efs-get-process host user)))
|
|
|
4317 (signal 'quit nil)))
|
|
|
4318
|
|
|
4319 ((and retry (string-equal code "421 "))
|
|
|
4320 (setq result nil)
|
|
|
4321 (efs-get-process host user))
|
|
|
4322
|
|
|
4323 (t ; bombed
|
|
|
4324 (condition-case nil (delete-process proc) (error nil))
|
|
|
4325 ;; Wrong username?
|
|
|
4326 (efs-set-user host nil)
|
|
|
4327 (efs-error host user
|
|
|
4328 (concat "USER request failed: " (nth 1 result)))))
|
|
|
4329 (and (null (car result))
|
|
|
4330 (stringp (nth 2 result))
|
|
|
4331 (message "%sdone%s" msg
|
|
|
4332 (let ((n (efs-occur-in-string ?\n (nth 2 result))))
|
|
|
4333 (if (> n 1)
|
|
|
4334 (format "; MOTD of %d lines" n)
|
|
|
4335 "")))))))
|
|
|
4336
|
|
|
4337 (defun efs-login-send-pass (host user proc &optional gate)
|
|
|
4338 "Sends password to HOST and USER. PROC is the ftp client process.
|
|
|
4339 Doesn't call efs-save-match data. You must do that yourself."
|
|
|
4340 ;; Note that efs-get-password always returns something.
|
|
|
4341 ;; It prompts the user if necessary. Even if the returned password is
|
|
|
4342 ;; \"\", send it, because we wouldn't be running this function
|
|
|
4343 ;; if the server wasn't insisting on a password.
|
|
|
4344 (let* ((pass "")
|
|
|
4345 (qpass "")
|
|
|
4346 (cmd "")
|
|
|
4347 (result (unwind-protect
|
|
|
4348 (progn
|
|
|
4349 (condition-case nil
|
|
|
4350 (setq pass (efs-get-passwd host user))
|
|
|
4351 (quit (condition-case nil
|
|
|
4352 (kill-buffer (process-buffer proc))
|
|
|
4353 (error nil))
|
|
|
4354 (signal 'quit nil)))
|
|
|
4355 (setq cmd (concat
|
|
|
4356 "quote pass "
|
|
|
4357 (setq qpass (efs-quote-string nil pass t))))
|
|
|
4358 (efs-raw-send-cmd proc cmd))
|
|
|
4359 (fillarray pass 0)
|
|
|
4360 (fillarray qpass 0)
|
|
|
4361 (fillarray cmd 0)))
|
|
|
4362 (code (and (>= (length (nth 1 result)) 4)
|
|
|
4363 (substring (nth 1 result) 0 4))))
|
|
|
4364 (or code (setq code ""))
|
|
|
4365 ;; Analyze the result.
|
|
|
4366 (cond
|
|
|
4367 ((string-equal code "332 ")
|
|
|
4368 ;; require an account passwd
|
|
|
4369 (setq result (efs-login-send-acct host user proc gate)))
|
|
|
4370 ((null (car result))
|
|
|
4371 ;; logged in proceed
|
|
|
4372 nil)
|
|
|
4373 ((or (string-equal code "530 ") (string-equal code "421 "))
|
|
|
4374 ;; Give the user another chance
|
|
|
4375 (condition-case nil
|
|
|
4376 (if (efs-anonymous-p user)
|
|
|
4377 (if (or (string-match efs-too-many-users-msgs (nth 1 result))
|
|
|
4378 (string-match efs-too-many-users-msgs (nth 2 result)))
|
|
|
4379 (if (save-window-excursion
|
|
|
4380 (condition-case nil
|
|
|
4381 (display-buffer (process-buffer proc))
|
|
|
4382 (error nil))
|
|
|
4383 (y-or-n-p (format
|
|
|
4384 "Too many users for %s@%s. Try again? "
|
|
|
4385 user host)))
|
|
|
4386 (progn
|
|
|
4387 ;; Return nil if we are doing a retry, so done
|
|
|
4388 ;; message only gets sent once.
|
|
|
4389 (setq result nil)
|
|
|
4390 (if (string-equal code "530 ")
|
|
|
4391 (efs-login-send-user host user proc gate)
|
|
|
4392 (efs-get-process host user)))
|
|
|
4393 (signal 'quit nil))
|
|
|
4394 (unwind-protect
|
|
|
4395 (efs-set-passwd
|
|
|
4396 host user
|
|
|
4397 (save-window-excursion
|
|
|
4398 (condition-case nil
|
|
|
4399 (display-buffer (process-buffer proc))
|
|
|
4400 (error nil))
|
|
|
4401 (setq pass
|
|
|
4402 (read-passwd
|
|
|
4403 (format
|
|
|
4404 "Password for %s@%s failed. Try again: "
|
|
|
4405 user host)))))
|
|
|
4406 (fillarray pass 0))
|
|
|
4407 (setq result nil)
|
|
|
4408 (efs-login-send-user host user proc gate))
|
|
|
4409 (unwind-protect
|
|
|
4410 (efs-set-passwd
|
|
|
4411 host user
|
|
|
4412 (setq pass
|
|
|
4413 (read-passwd
|
|
|
4414 (format "Password for %s@%s failed. Try again: "
|
|
|
4415 user host))))
|
|
|
4416 (fillarray pass 0))
|
|
|
4417 (setq result nil)
|
|
|
4418 (efs-login-send-user host user proc gate))
|
|
|
4419 (quit (condition-case nil (delete-process proc) (error nil))
|
|
|
4420 (efs-set-user host nil)
|
|
|
4421 (efs-set-passwd host user nil)
|
|
|
4422 (signal 'quit nil))
|
|
|
4423 (error (condition-case nil (delete-process proc) (error nil))
|
|
|
4424 (efs-set-user host nil)
|
|
|
4425 (efs-set-passwd host user nil)
|
|
|
4426 (efs-error host user "PASS request failed."))))
|
|
|
4427 (t ; bombed for unexplained reasons
|
|
|
4428 (condition-case nil (delete-process proc) (error nil))
|
|
|
4429 (efs-error host user (concat "PASS request failed: " (nth 1 result)))))
|
|
|
4430 result))
|
|
|
4431
|
|
|
4432 (defun efs-login-send-acct (host user proc &optional gate)
|
|
|
4433 "Sends account password to HOST and USER. PROC is the ftp client process.
|
|
|
4434 Doesn't call efs-save-match data. You must do that yourself."
|
|
|
4435 (let* ((acct "")
|
|
|
4436 (qacct "")
|
|
|
4437 (cmd "")
|
|
|
4438 (result (unwind-protect
|
|
|
4439 (progn
|
|
|
4440 ;; The raptor gateway requires us to send a gateway
|
|
|
4441 ;; authentication password for account. What if the
|
|
|
4442 ;; remote server wants one too?
|
|
|
4443 (setq acct (if (eq gate 'raptor)
|
|
|
4444 (efs-get-account
|
|
|
4445 efs-gateway-host
|
|
|
4446 (nth 3 efs-gateway-type) nil t)
|
|
|
4447 (efs-get-account host user nil t))
|
|
|
4448 qacct (efs-quote-string nil acct t)
|
|
|
4449 cmd (concat "quote acct " qacct))
|
|
|
4450 (efs-raw-send-cmd proc cmd))
|
|
|
4451 (fillarray acct 0)
|
|
|
4452 (fillarray qacct 0)
|
|
|
4453 (fillarray cmd 0))))
|
|
|
4454 ;; Analyze the result
|
|
|
4455 (cond
|
|
|
4456 ((null (car result))
|
|
|
4457 ;; logged in proceed
|
|
|
4458 nil)
|
|
|
4459 ((eq (car result) 'failed)
|
|
|
4460 ;; Give the user another chance
|
|
|
4461 (condition-case nil
|
|
|
4462 (progn
|
|
|
4463 (unwind-protect
|
|
|
4464 (progn
|
|
|
4465 (setq acct (read-passwd
|
|
|
4466 (format
|
|
|
4467 "Account password for %s@%s failed. Try again: "
|
|
|
4468 user host)))
|
|
|
4469 (or (and efs-high-security-hosts
|
|
|
4470 (string-match efs-high-security-hosts
|
|
|
4471 (format "%s@%s" user host)))
|
|
|
4472 (efs-set-account host user nil acct)))
|
|
|
4473 (fillarray acct 0))
|
|
|
4474 (setq result (efs-login-send-user host user proc gate)))
|
|
|
4475 (quit (condition-case nil (delete-process proc) (error nil)))
|
|
|
4476 (error (condition-case nil (delete-process proc) (error nil))
|
|
|
4477 (efs-error host user "ACCT request failed."))))
|
|
|
4478 (t ; bombed for unexplained reasons
|
|
|
4479 (condition-case nil (delete-process proc) (error nil))
|
|
|
4480 (efs-error host user (concat "ACCT request failed: " (nth 1 result)))))
|
|
|
4481 result))
|
|
|
4482
|
|
|
4483 ;;;; ----------------------------------------------------------------------
|
|
|
4484 ;;;; Changing working directory.
|
|
|
4485 ;;;; ----------------------------------------------------------------------
|
|
|
4486
|
|
|
4487 (defun efs-raw-send-cd (host user dir &optional no-error)
|
|
|
4488 ;; If NO-ERROR, doesn't barf, but just returns success (t) or failure (nil).
|
|
|
4489 ;; This does not use efs-send-cmd.
|
|
|
4490 ;; Also DIR must be in the syntax of the remote host-type.
|
|
|
4491 (let* ((cmd (concat "cd " dir))
|
|
|
4492 cd-result cd-line)
|
|
|
4493 (efs-raw-send-cmd
|
|
|
4494 (efs-get-process host user)
|
|
|
4495 cmd nil nil
|
|
|
4496 (efs-cont (result line cont-lines) (cmd)
|
|
|
4497 (if (eq result 'fatal)
|
|
|
4498 (efs-raw-send-cmd
|
|
|
4499 (efs-get-process host user)
|
|
|
4500 cmd nil nil
|
|
|
4501 (function (lambda (result line cont-lines)
|
|
|
4502 (setq cd-result result
|
|
|
4503 cd-line line))))
|
|
|
4504 (setq cd-result result
|
|
|
4505 cd-line line))))
|
|
|
4506 (if no-error
|
|
|
4507 (null cd-result)
|
|
|
4508 (if cd-result
|
|
|
4509 (efs-error host user (concat "CD failed: " cd-line))))))
|
|
|
4510
|
|
|
4511 ;;;; --------------------------------------------------------------
|
|
|
4512 ;;;; Getting a PWD.
|
|
|
4513 ;;;; --------------------------------------------------------------
|
|
|
4514
|
|
|
4515 (defun efs-unquote-quotes (string)
|
|
|
4516 ;; Unquote \"\"'s in STRING to \".
|
|
|
4517 (let ((start 0)
|
|
|
4518 new)
|
|
|
4519 (while (string-match "\"\"" string start)
|
|
|
4520 (setq new (concat new (substring
|
|
|
4521 string start (1+ (match-beginning 0))))
|
|
|
4522 start (match-end 0)))
|
|
|
4523 (if new
|
|
|
4524 (concat new (substring string start))
|
|
|
4525 string)))
|
|
|
4526
|
|
|
4527 (efs-defun efs-send-pwd nil (host user &optional xpwd)
|
|
|
4528 "Attempts to get the current working directory for the given HOST/USER pair.
|
|
|
4529 Returns \( DIR . LINE \) where DIR is either the directory or NIL if not found,
|
|
|
4530 and LINE is the relevant success or fail line from the FTP-server. If the
|
|
|
4531 optional arg XPWD is given, uses this server command instead of PWD."
|
|
|
4532 (let* ((result (efs-send-cmd host user
|
|
|
4533 (list 'quote (if xpwd 'xpwd 'pwd))
|
|
|
4534 "Getting pwd"))
|
|
|
4535 (line (nth 1 result))
|
|
|
4536 dir)
|
|
|
4537 (or (car result)
|
|
|
4538 (efs-save-match-data
|
|
|
4539 (if (string-match "\"\\(.*\\)\"[^\"]*$" line)
|
|
|
4540 (setq dir (efs-unquote-quotes (substring line (match-beginning 1)
|
|
|
4541 (match-end 1))))
|
|
|
4542 (if (string-match " \\([^ ]+\\) " line) ; stone-age servers!
|
|
|
4543 (setq dir (substring line
|
|
|
4544 (match-beginning 1)
|
|
|
4545 (match-end 1)))))))
|
|
|
4546 (cons dir line)))
|
|
|
4547
|
|
|
4548 (efs-defun efs-send-pwd super-dumb-unix (host user &optional xpwd)
|
|
|
4549 ;; Guess at the pwd for a unix host that doesn't support pwd.
|
|
|
4550 (if (efs-anonymous-p user)
|
|
|
4551 ;; guess
|
|
|
4552 (cons "/" "")
|
|
|
4553 ;; Who knows?
|
|
|
4554 (message "Can't obtain pwd for %s" host)
|
|
|
4555 (ding)
|
|
|
4556 (sleep-for 2)
|
|
|
4557 (message "All file names must be specified as full paths.")
|
|
|
4558 (cons nil "")))
|
|
|
4559
|
|
|
4560 ;;;; --------------------------------------------------------
|
|
|
4561 ;;;; Getting the SIZE of a remote file.
|
|
|
4562 ;;;; --------------------------------------------------------
|
|
|
4563
|
|
|
4564 (defun efs-send-size (host user file)
|
|
|
4565 "For HOST and USER, get the size of FILE in bytes.
|
|
|
4566 This returns a list \( SIZE . LINE \), where SIZE is the file size in bytes,
|
|
|
4567 or nil if this couldn't be determined, and LINE is the output line of the
|
|
|
4568 FTP server."
|
|
|
4569 (efs-save-match-data
|
|
|
4570 (let ((result (efs-send-cmd host user (list 'quote 'size file))))
|
|
|
4571 (setcar result
|
|
|
4572 (and (null (car result))
|
|
|
4573 (string-match "^213 +\\([0-9]+\\)$" (nth 1 result))
|
|
|
4574 (string-to-int
|
|
|
4575 (substring
|
|
|
4576 (cdr result)
|
|
|
4577 (match-beginning 1) (match-end 1)))))
|
|
|
4578 result)))
|
|
|
4579
|
|
|
4580 ;;;; ------------------------------------------------------------
|
|
|
4581 ;;;; umask support
|
|
|
4582 ;;;; ------------------------------------------------------------
|
|
|
4583
|
|
|
4584 (defun efs-umask (user)
|
|
|
4585 "Returns the umask that efs will use for USER.
|
|
|
4586 If USER is root or anonymous, then the values of efs-root-umask
|
|
|
4587 and efs-anonymous-umask, respectively, take precedence, to be followed
|
|
|
4588 by the value of efs-umask, and if this is nil, it returns your current
|
|
|
4589 umask on the local machine. Returns nil if this can't be determined."
|
|
|
4590 (or
|
|
|
4591 (and (string-equal user "root") efs-root-umask)
|
|
|
4592 (and (efs-anonymous-p user)
|
|
|
4593 efs-anonymous-umask)
|
|
|
4594 efs-umask
|
|
|
4595 (let* ((shell (or (and (boundp 'explicit-shell-file-name)
|
|
|
4596 explicit-shell-file-name)
|
|
|
4597 (getenv "ESHELL")
|
|
|
4598 (getenv "SHELL")
|
|
|
4599 "/bin/sh"))
|
|
|
4600 (default-major-mode 'fundamental-mode)
|
|
|
4601 (default-directory exec-directory)
|
|
|
4602 (buff (get-buffer-create " *efs-umask-data*")))
|
|
|
4603 (unwind-protect
|
|
|
4604 (save-excursion
|
|
|
4605 (set-buffer buff)
|
|
|
4606 (call-process shell nil buff nil "-c" "umask")
|
|
|
4607 (goto-char (point-min))
|
|
|
4608 (if (re-search-forward "[0-7]?[0-7]?[0-7]" nil t)
|
|
|
4609 (string-to-int (buffer-substring (match-beginning 0)
|
|
|
4610 (match-end 0)))))
|
|
|
4611 (kill-buffer buff)))))
|
|
|
4612
|
|
|
4613 (defun efs-send-umask (host user mask)
|
|
|
4614 "Sets the umask on HOST for USER to MASK.
|
|
|
4615 Returns t for success, nil for failure."
|
|
|
4616 (interactive
|
|
|
4617 (let* ((path (or buffer-file-name
|
|
|
4618 (and (eq major-mode 'dired-mode)
|
|
|
4619 dired-directory)))
|
|
|
4620 (parsed (and path (efs-ftp-path path)))
|
|
|
4621 (default-host (car parsed))
|
|
|
4622 (default-user (nth 1 parsed))
|
|
|
4623 (default-mask (efs-umask default-user)))
|
|
|
4624 (list
|
|
|
4625 (read-string "Host: " default-host)
|
|
|
4626 (read-string "User: " default-user)
|
|
|
4627 (read-string "Umask: " (int-to-string default-mask)))))
|
|
|
4628 (let (int-mask)
|
|
|
4629 (if (integerp mask)
|
|
|
4630 (setq int-mask mask
|
|
|
4631 mask (int-to-string mask))
|
|
|
4632 (setq int-mask (string-to-int mask)))
|
|
|
4633 (or (string-match "^ *[0-7]?[0-7]?[0-7] *$" mask)
|
|
|
4634 (error "Invalid umask %s" mask))
|
|
|
4635 (efs-send-cmd host user
|
|
|
4636 (list 'quote 'site 'umask mask)
|
|
|
4637 (concat "Setting umask to " mask)
|
|
|
4638 (list
|
|
|
4639 (function
|
|
|
4640 (lambda (int-mask)
|
|
|
4641 (let ((buff (efs-ftp-process-buffer host user)))
|
|
|
4642 (if (get-buffer buff)
|
|
|
4643 (save-excursion
|
|
|
4644 (set-buffer buff)
|
|
|
4645 (setq efs-process-umask int-mask))))))
|
|
|
4646 int-mask)
|
|
|
4647 (efs-cont (result line cont-lines) (host user mask)
|
|
|
4648 (if result
|
|
|
4649 (let ((buff (efs-ftp-process-buffer host user)))
|
|
|
4650 (efs-set-host-property host 'umask-failed t)
|
|
|
4651 (if (get-buffer buff)
|
|
|
4652 (save-excursion
|
|
|
4653 (set-buffer buff)
|
|
|
4654 (setq efs-process-umask nil)))
|
|
|
4655 (message
|
|
|
4656 "Unable to set umask to %s on %s" mask host)
|
|
|
4657 (if efs-ding-on-umask-failure
|
|
|
4658 (progn
|
|
|
4659 (ding)
|
|
|
4660 (sit-for 1))))))
|
|
|
4661 0))) ; Do this NOWAIT = 0
|
|
|
4662
|
|
|
4663 (defun efs-set-umask (host user)
|
|
|
4664 "Sets the umask for HOST and USER, if it has not already been set."
|
|
|
4665 (save-excursion
|
|
|
4666 (set-buffer (process-buffer (efs-get-process host user)))
|
|
|
4667 (if (or efs-process-umask (efs-get-host-property host 'umask-failed))
|
|
|
4668 nil
|
|
|
4669 (let ((umask (efs-umask user)))
|
|
|
4670 (efs-send-umask host user umask)
|
|
|
4671 t)))) ; Tell the caller that we did something.
|
|
|
4672
|
|
|
4673 (defun efs-modes-from-umask (umask)
|
|
|
4674 ;; Given the 3 digit octal integer umask, returns the decimal integer
|
|
|
4675 ;; according to chmod that a file would be written with.
|
|
|
4676 ;; Assumes only ordinary files, so ignores x bits.
|
|
|
4677 (let* ((others (% umask 10))
|
|
|
4678 (umask (/ umask 10))
|
|
|
4679 (group (% umask 10))
|
|
|
4680 (umask (/ umask 10))
|
|
|
4681 (owner (% umask 10))
|
|
|
4682 (factor 1))
|
|
|
4683 (apply '+
|
|
|
4684 (mapcar
|
|
|
4685 (function
|
|
|
4686 (lambda (x)
|
|
|
4687 (prog1
|
|
|
4688 (* factor (- 6 (- x (% x 2))))
|
|
|
4689 (setq factor (* factor 8)))))
|
|
|
4690 (list others group owner)))))
|
|
|
4691
|
|
|
4692 ;;;; ------------------------------------------------------------
|
|
|
4693 ;;;; Idle time manipulation.
|
|
|
4694 ;;;; ------------------------------------------------------------
|
|
|
4695
|
|
|
4696 (defun efs-check-idle (host user)
|
|
|
4697 ;; We just toss it in the queue to run whenever there's time.
|
|
|
4698 ;; Just fail quietly if this doesn't work.
|
|
|
4699 (if (and (or efs-maximize-idle efs-expire-ftp-buffers)
|
|
|
4700 (memq (efs-host-type host) efs-idle-host-types)
|
|
|
4701 (null (efs-get-host-property host 'idle-failed)))
|
|
|
4702 (let ((buffname (efs-ftp-process-buffer host user)))
|
|
|
4703 (efs-add-to-queue
|
|
|
4704 host user
|
|
|
4705 (list '(quote site idle)
|
|
|
4706 nil nil
|
|
|
4707 (efs-cont (result line cont-lines) (host user buffname)
|
|
|
4708 (efs-save-match-data
|
|
|
4709 (if (and (null result)
|
|
|
4710 (string-match efs-idle-msgs line))
|
|
|
4711 (let ((max (substring line (match-beginning 2)
|
|
|
4712 (match-end 2))))
|
|
|
4713 (if (get-buffer buffname)
|
|
|
4714 (save-excursion
|
|
|
4715 (set-buffer buffname)
|
|
|
4716 (setq efs-process-idle-time
|
|
|
4717 (string-to-int
|
|
|
4718 (substring line (match-beginning 1)
|
|
|
4719 (match-end 1))))))
|
|
|
4720 (if (and efs-maximize-idle
|
|
|
4721 (not (efs-anonymous-p user)))
|
|
|
4722 (efs-add-to-queue
|
|
|
4723 host user
|
|
|
4724 (list
|
|
|
4725 (list 'quote 'site 'idle max)
|
|
|
4726 nil nil
|
|
|
4727 (efs-cont (result line cont-lines) (buffname
|
|
|
4728 max)
|
|
|
4729 (and (null result)
|
|
|
4730 (get-buffer buffname)
|
|
|
4731 (save-excursion
|
|
|
4732 (set-buffer buffname)
|
|
|
4733 (setq efs-process-idle-time
|
|
|
4734 (string-to-int max)))))
|
|
|
4735 0))))
|
|
|
4736 (efs-set-host-property host 'idle-failed t))))
|
|
|
4737 0 nil))))) ; Using NOWAIT = 0 inhibits mode line toggling.
|
|
|
4738
|
|
|
4739
|
|
|
4740 ;;;; ------------------------------------------------------------
|
|
|
4741 ;;;; Sending the SYST command for system type.
|
|
|
4742 ;;;; ------------------------------------------------------------
|
|
|
4743
|
|
|
4744 (defun efs-get-syst (host user)
|
|
|
4745 "Use SYST to get the remote system type.
|
|
|
4746 Returns the system type as a string if this succeeds, otherwise nil."
|
|
|
4747 (let* ((result (efs-send-cmd host user '(quote syst)))
|
|
|
4748 (line (nth 1 result)))
|
|
|
4749 (efs-save-match-data
|
|
|
4750 (and (null (car result))
|
|
|
4751 (string-match efs-syst-msgs line)
|
|
|
4752 (substring line (match-end 0))))))
|
|
|
4753
|
|
|
4754 ;;;; ------------------------------------------------------------
|
|
|
4755 ;;;; File transfer representation type support
|
|
|
4756 ;;;; ------------------------------------------------------------
|
|
|
4757
|
|
|
4758 ;;; Legal representation types are: image, ascii, ebcdic, tenex
|
|
|
4759
|
|
|
4760 (efs-defun efs-file-type nil (path)
|
|
|
4761 ;; Returns the file type for PATH, the full efs path, with filename FILE.
|
|
|
4762 ;; The return value is one of 'text, '8-binary, or '36-binary.
|
|
|
4763 (let ((parsed (efs-ftp-path path)))
|
|
|
4764 (efs-save-match-data
|
|
|
4765 (cond
|
|
|
4766 ;; There is no special significance to temp names, but we assume that
|
|
|
4767 ;; they exist on an 8-bit byte machine.
|
|
|
4768 ((or (null path)
|
|
|
4769 (let ((temp (intern-soft path efs-tmp-name-obarray)))
|
|
|
4770 (and temp (memq temp efs-tmp-name-files))))
|
|
|
4771 '8-binary)
|
|
|
4772 ((and (null parsed) (file-exists-p path))
|
|
|
4773 (efs-local-file-type path))
|
|
|
4774 ;; test special hosts
|
|
|
4775 ((and parsed
|
|
|
4776 efs-binary-file-host-regexp
|
|
|
4777 (let ((case-fold-search t))
|
|
|
4778 (string-match efs-binary-file-host-regexp (car parsed))))
|
|
|
4779 '8-binary)
|
|
|
4780 (t
|
|
|
4781 ;; Test file names
|
|
|
4782 (let ((file (efs-internal-file-name-nondirectory
|
|
|
4783 (or (nth 2 parsed) path))))
|
|
|
4784 (cond
|
|
|
4785 ;; test for PDP-10 binaries
|
|
|
4786 ((and efs-36-bit-binary-file-name-regexp
|
|
|
4787 (string-match efs-36-bit-binary-file-name-regexp file))
|
|
|
4788 '36-binary)
|
|
|
4789 ((and efs-binary-file-name-regexp
|
|
|
4790 (string-match efs-binary-file-name-regexp file))
|
|
|
4791 '8-binary)
|
|
|
4792 ((and efs-text-file-name-regexp
|
|
|
4793 (string-match efs-text-file-name-regexp file))
|
|
|
4794 'text)
|
|
|
4795 ;; by default
|
|
|
4796 (t
|
|
|
4797 '8-binary))))))))
|
|
|
4798
|
|
|
4799 (efs-define-fun efs-local-file-type (file)
|
|
|
4800 ;; Looks at the beginning (magic-cookie) of a local file to determine
|
|
|
4801 ;; if it is a text file or not. If it's not a text file, it doesn't care
|
|
|
4802 ;; about what type of binary file, so this doesn't really look for a magic
|
|
|
4803 ;; cookie.
|
|
|
4804 ;; Doesn't call efs-save-match-data. The caller should do so.
|
|
|
4805 (save-excursion
|
|
|
4806 (set-buffer (get-buffer-create efs-data-buffer-name))
|
|
|
4807 (erase-buffer)
|
|
|
4808 (insert-file-contents file nil 0 16)
|
|
|
4809 (if (looking-at "[ -~\n\r\C-L]*\\'")
|
|
|
4810 'text
|
|
|
4811 '8-binary)))
|
|
|
4812
|
|
|
4813 (defun efs-rationalize-file-type (f-type t-type)
|
|
|
4814 ;; When the original and new names for a file indicate
|
|
|
4815 ;; different file types, this function applies an ad hoc heuristic
|
|
|
4816 ;; to return a single file type.
|
|
|
4817 (cond
|
|
|
4818 ((eq f-type t-type)
|
|
|
4819 f-type)
|
|
|
4820 ((memq '36-binary (list f-type t-type))
|
|
|
4821 '36-binary)
|
|
|
4822 ((memq '8-binary (list f-type t-type))
|
|
|
4823 '8-binary)
|
|
|
4824 (t
|
|
|
4825 'text)))
|
|
|
4826
|
|
|
4827 (defun efs-prompt-for-transfer-type (arg)
|
|
|
4828 "Toggles value of efs-prompt-for-transfer-type.
|
|
|
4829 With prefix arg, turns prompting on if arg is positive, otherwise turns
|
|
|
4830 prompting off."
|
|
|
4831 (interactive "P")
|
|
|
4832 (if (if arg
|
|
|
4833 (> (prefix-numeric-value arg) 0)
|
|
|
4834 (null efs-prompt-for-transfer-type))
|
|
|
4835 ;; turn prompting on
|
|
|
4836 (prog1
|
|
|
4837 (setq efs-prompt-for-transfer-type t)
|
|
|
4838 (message "Prompting for FTP transfer TYPE is on."))
|
|
|
4839 (prog1
|
|
|
4840 (setq efs-prompt-for-transfer-type nil)
|
|
|
4841 (message "Prompting for FTP transfer TYPE is off."))))
|
|
|
4842
|
|
|
4843 (defun efs-read-xfer-type (path)
|
|
|
4844 ;; Prompt for the transfer type to use for PATH
|
|
|
4845 (let ((type
|
|
|
4846 (completing-read
|
|
|
4847 (format "FTP transfer TYPE for %s: " (efs-relativize-filename path))
|
|
|
4848 '(("binary") ("image") ("ascii") ("ebcdic") ("tenex"))
|
|
|
4849 nil t)))
|
|
|
4850 (if (string-equal type "binary")
|
|
|
4851 'image
|
|
|
4852 (intern type))))
|
|
|
4853
|
|
|
4854 (defun efs-xfer-type (f-host-type f-path t-host-type t-path
|
|
|
4855 &optional via-local)
|
|
|
4856 ;; Returns the transfer type for transferring a file.
|
|
|
4857 ;; F-HOST-TYPE = the host type of the machine on which the file is from.
|
|
|
4858 ;; F-PATH = path, in full efs-syntax, of the original file
|
|
|
4859 ;; T-HOST-TYPE = host-type of the machine to which the file is being
|
|
|
4860 ;; transferred.
|
|
|
4861 ;; VIA-LOCAL = non-nil of the file is being moved through the local, or
|
|
|
4862 ;; a gateway machine.
|
|
|
4863 ;; Set F-PATH or T-PATH to nil, to indicate that the file is being
|
|
|
4864 ;; transferred from/to a temporary file, whose name has no significance.
|
|
|
4865 (let (temp)
|
|
|
4866 (and f-path
|
|
|
4867 (setq temp (intern-soft f-path efs-tmp-name-obarray))
|
|
|
4868 (memq temp efs-tmp-name-files)
|
|
|
4869 (setq f-path nil))
|
|
|
4870 (and t-path
|
|
|
4871 (setq temp (intern-soft t-path efs-tmp-name-obarray))
|
|
|
4872 (memq temp efs-tmp-name-files)
|
|
|
4873 (setq t-path nil)))
|
|
|
4874 (if (or (null (or f-host-type t-host-type)) (null (or f-path t-path)))
|
|
|
4875 'image ; local copy?
|
|
|
4876 (if efs-prompt-for-transfer-type
|
|
|
4877 (efs-read-xfer-type (if f-path f-path t-path))
|
|
|
4878 (let ((f-fs (cdr (assq f-host-type efs-file-type-alist)))
|
|
|
4879 (t-fs (cdr (assq t-host-type efs-file-type-alist))))
|
|
|
4880 (if (and f-fs t-fs
|
|
|
4881 (if efs-treat-crlf-as-nl
|
|
|
4882 (and (eq (car f-fs) (car t-fs))
|
|
|
4883 (eq (nth 1 f-fs) (nth 1 t-fs))
|
|
|
4884 (let ((f2-fs (nth 2 f-fs))
|
|
|
4885 (t2-fs (nth 2 t-fs)))
|
|
|
4886 (or (eq f2-fs t2-fs)
|
|
|
4887 (and (memq f2-fs '(file-crlf file-nl))
|
|
|
4888 (memq t2-fs '(file-crlf file-nl))))))
|
|
|
4889 (equal f-fs t-fs)))
|
|
|
4890 'image
|
|
|
4891 (let ((type (cond
|
|
|
4892 ((and f-path t-path)
|
|
|
4893 (efs-rationalize-file-type
|
|
|
4894 (efs-file-type t-host-type t-path)
|
|
|
4895 (efs-file-type f-host-type f-path)))
|
|
|
4896 (f-path
|
|
|
4897 (efs-file-type f-host-type f-path))
|
|
|
4898 (t-path
|
|
|
4899 (efs-file-type t-host-type t-path)))))
|
|
|
4900 (cond
|
|
|
4901 ((eq type '36-binary)
|
|
|
4902 'image)
|
|
|
4903 ((eq type '8-binary)
|
|
|
4904 (if (or (eq (car f-fs) '36-bit-wa)
|
|
|
4905 (eq (car t-fs) '36-bit-wa))
|
|
|
4906 'tenex
|
|
|
4907 'image))
|
|
|
4908 (t ; handles 'text
|
|
|
4909 (if (and t-fs f-fs (eq (nth 1 f-fs) 'ebcdic)
|
|
|
4910 (eq (nth 1 t-fs) 'ebcdic) (null via-local))
|
|
|
4911 'ebcdic
|
|
|
4912 'ascii)))))))))
|
|
|
4913
|
|
|
4914 (defun efs-set-xfer-type (host user type &optional clientless)
|
|
|
4915 ;; Sets the xfer type for HOST and USER to TYPE.
|
|
|
4916 ;; If the connection is already using the required type, does nothing.
|
|
|
4917 ;; If clientless is non-nil, we are using a quoted xfer command, and
|
|
|
4918 ;; need to check if the client has changed things.
|
|
|
4919 (save-excursion
|
|
|
4920 (let ((buff (process-buffer (efs-get-process host user))))
|
|
|
4921 (set-buffer buff)
|
|
|
4922 (or (if (and clientless efs-process-client-altered-xfer-type)
|
|
|
4923 (or (eq type efs-process-client-altered-xfer-type)
|
|
|
4924 (setq efs-process-client-altered-xfer-type nil))
|
|
|
4925 ;; We are sending a non-clientless command, so the client
|
|
|
4926 ;; gets back in synch.
|
|
|
4927 (setq efs-process-client-altered-xfer-type nil)
|
|
|
4928 (and efs-process-xfer-type
|
|
|
4929 (eq type efs-process-xfer-type)))
|
|
|
4930 (let ((otype efs-process-xfer-type))
|
|
|
4931 ;; Set this now in anticipation that the TYPE command will work,
|
|
|
4932 ;; in case other commands, such as efs-set-hash-mark-unit want to
|
|
|
4933 ;; grok this before the TYPE command completes.
|
|
|
4934 (setq efs-process-xfer-type type)
|
|
|
4935 (efs-send-cmd
|
|
|
4936 host user (list 'type type)
|
|
|
4937 nil nil
|
|
|
4938 (efs-cont (result line cont-lines) (host user type otype buff)
|
|
|
4939 (if result
|
|
|
4940 (unwind-protect
|
|
|
4941 (efs-error host user (format "TYPE %s failed: %s"
|
|
|
4942 (upcase (symbol-name type))
|
|
|
4943 line))
|
|
|
4944 (if (get-buffer buff)
|
|
|
4945 (save-excursion
|
|
|
4946 (set-buffer buff)
|
|
|
4947 (setq efs-process-xfer-type otype))))))
|
|
|
4948 0)))))) ; always send type commands NOWAIT = 0
|
|
|
4949
|
|
|
4950
|
|
|
4951 ;;;; ------------------------------------------------------------
|
|
|
4952 ;;;; Obtaining DIR listings.
|
|
|
4953 ;;;; ------------------------------------------------------------
|
|
|
4954
|
|
|
4955 (defun efs-ls-guess-switches ()
|
|
|
4956 ;; Tries to determine what would be the most useful switches
|
|
|
4957 ;; to use for a DIR listing.
|
|
|
4958 (if (and (boundp 'dired-listing-switches)
|
|
|
4959 (stringp dired-listing-switches)
|
|
|
4960 (efs-parsable-switches-p dired-listing-switches t))
|
|
|
4961 dired-listing-switches
|
|
|
4962 "-al"))
|
|
|
4963
|
|
|
4964 (efs-defun efs-ls-dumb-check nil (line host file path lsargs msg noparse
|
|
|
4965 noerror nowait cont)
|
|
|
4966 nil)
|
|
|
4967
|
|
|
4968 (efs-defun efs-ls-dumb-check unknown (line host file path lsargs
|
|
|
4969 msg noparse noerror nowait cont)
|
|
|
4970 ;; Checks to see if the host type might be dumb unix. If so, returns the
|
|
|
4971 ;; listing otherwise nil.
|
|
|
4972 (and
|
|
|
4973 lsargs
|
|
|
4974 (string-match
|
|
|
4975 ;; Some CMU servers return a 530 here. 550 is correct.
|
|
|
4976 (concat "^5[35]0 \\(The file \\)?"
|
|
|
4977 (regexp-quote (concat lsargs " " path)))
|
|
|
4978 ;; 550 is for a non-accessible file -- RFC959
|
|
|
4979 line)
|
|
|
4980 (progn
|
|
|
4981 (if (eq (efs-host-type host) 'apollo-unix)
|
|
|
4982 (efs-add-host 'dumb-apollo-unix host)
|
|
|
4983 (efs-add-host 'dumb-unix host))
|
|
|
4984 ;; try again
|
|
|
4985 (if nowait
|
|
|
4986 t ; return t if asynch
|
|
|
4987 ; This is because dumb-check can't run asynch.
|
|
|
4988 ; This means that we can't recognize dumb hosts asynch.
|
|
|
4989 ; Shouldn't be a problem.
|
|
|
4990 (efs-ls file nil
|
|
|
4991 (if (eq msg t)
|
|
|
4992 (format "Relisting %s" (efs-relativize-filename file))
|
|
|
4993 msg)
|
|
|
4994 noparse noerror nowait cont)))))
|
|
|
4995
|
|
|
4996 ;; With no-error nil, this function returns:
|
|
|
4997 ;; an error if file is not an efs-path
|
|
|
4998 ;; (This should never happen.)
|
|
|
4999 ;; an error if either the listing is unreadable or there is an ftp error.
|
|
|
5000 ;; the listing (a string), if everything works.
|
|
|
5001 ;;
|
|
|
5002 ;; With no-error t, it returns:
|
|
|
5003 ;; an error if not an efs-path
|
|
|
5004 ;; error if listing is unreable (most likely caused by a slow connection)
|
|
|
5005 ;; nil if ftp error (this is because although asking to list a nonexistent
|
|
|
5006 ;; directory on a remote unix machine usually (except
|
|
|
5007 ;; maybe for dumb hosts) returns an ls error, but no
|
|
|
5008 ;; ftp error, if the same is done on a VMS machine,
|
|
|
5009 ;; an ftp error is returned. Need to trap the error
|
|
|
5010 ;; so we can go on and try to list the parent.)
|
|
|
5011 ;; the listing, if everything works.
|
|
|
5012
|
|
|
5013 (defun efs-ls (file lsargs msg &optional noparse noerror nowait cont nlist)
|
|
|
5014 "Return the output of a `DIR' or `ls' command done over ftp.
|
|
|
5015 FILE is the full name of the remote file, LSARGS is any args to pass to the
|
|
|
5016 `ls' command. MSG is a message to be displayed while listing, if MSG is given
|
|
|
5017 as t, a suitable message will be computed. If nil, no message will be
|
|
|
5018 displayed. If NOPARSE is non-nil, then the listing will not be parsed and
|
|
|
5019 stored in internal cache. Otherwise, the listing will be parsed, if LSARGS
|
|
|
5020 allow it. If NOERROR is non-nil, then we return nil if the listing fails,
|
|
|
5021 rather than signal an error. If NOWAIT is non-nil, we do the listing
|
|
|
5022 asynchronously, returning nil. If CONT is non-nil it is called with first
|
|
|
5023 argument the listing string."
|
|
|
5024 ;; If lsargs are nil, this forces a one-time only dumb listing using dir.
|
|
|
5025 (setq file (efs-expand-file-name file))
|
|
|
5026 (let ((parsed (efs-ftp-path file)))
|
|
|
5027 (if parsed
|
|
|
5028 (let* ((host (nth 0 parsed))
|
|
|
5029 (user (nth 1 parsed))
|
|
|
5030 (path (nth 2 parsed))
|
|
|
5031 (host-type (efs-host-type host user))
|
|
|
5032 (listing-type (efs-listing-type host user))
|
|
|
5033 (parse (cond
|
|
|
5034 ((null noparse)
|
|
|
5035 (efs-parsable-switches-p lsargs t))
|
|
|
5036 ((eq noparse 'parse)
|
|
|
5037 t)
|
|
|
5038 (t nil)))
|
|
|
5039 (switches lsargs)
|
|
|
5040 cache)
|
|
|
5041
|
|
|
5042 (if (memq host-type efs-dumb-host-types)
|
|
|
5043 (setq lsargs nil))
|
|
|
5044 (if (and (null efs-ls-uncache)
|
|
|
5045 (setq cache
|
|
|
5046 (or (efs-get-from-ls-cache file switches)
|
|
|
5047 (and switches
|
|
|
5048 (efs-convert-from-ls-cache
|
|
|
5049 file switches host-type listing-type)))))
|
|
|
5050 ;; The listing is in the mail, errr... cache.
|
|
|
5051 (let (listing)
|
|
|
5052 (if (stringp cache)
|
|
|
5053 (setq listing cache)
|
|
|
5054 (setq listing (car cache))
|
|
|
5055 (if (and parse (null (nth 1 cache)))
|
|
|
5056 (save-excursion
|
|
|
5057 (set-buffer
|
|
|
5058 (let ((default-major-mode 'fundamental-mode))
|
|
|
5059 (get-buffer-create
|
|
|
5060 efs-data-buffer-name)))
|
|
|
5061 (erase-buffer)
|
|
|
5062 (insert listing)
|
|
|
5063 (goto-char (point-min))
|
|
|
5064 (efs-set-files
|
|
|
5065 file
|
|
|
5066 (efs-parse-listing listing-type
|
|
|
5067 host user path
|
|
|
5068 file lsargs))
|
|
|
5069 ;; Note that we have parsed it now.
|
|
|
5070 (setcar (cdr cache) t))))
|
|
|
5071 (if cont (efs-call-cont cont listing))
|
|
|
5072 listing)
|
|
|
5073
|
|
|
5074 (if cache
|
|
|
5075 (efs-del-from-ls-cache file nil nil))
|
|
|
5076 ;; Need to get the listing via FTP.
|
|
|
5077 (let* ((temp (efs-make-tmp-name host nil))
|
|
|
5078 (temp-file (car temp))
|
|
|
5079 listing-result)
|
|
|
5080 (efs-send-cmd
|
|
|
5081 host user
|
|
|
5082 (list (if nlist 'nlist 'dir) path (cdr temp) lsargs)
|
|
|
5083 (if (eq msg t)
|
|
|
5084 (format "Listing %s" (efs-relativize-filename file))
|
|
|
5085 msg)
|
|
|
5086 nil
|
|
|
5087 (efs-cont (result line cont-lines)
|
|
|
5088 (host-type listing-type host user temp-file path
|
|
|
5089 switches file lsargs noparse parse noerror
|
|
|
5090 msg nowait cont)
|
|
|
5091 ;; The client flipped to ascii, remember this.
|
|
|
5092 (let ((buff (get-buffer
|
|
|
5093 (efs-ftp-process-buffer host user))))
|
|
|
5094 (if buff
|
|
|
5095 (efs-save-buffer-excursion
|
|
|
5096 (set-buffer buff)
|
|
|
5097 (setq efs-process-client-altered-xfer-type
|
|
|
5098 'ascii))))
|
|
|
5099 (unwind-protect
|
|
|
5100 (if result
|
|
|
5101 (or (setq listing-result
|
|
|
5102 (efs-ls-dumb-check
|
|
|
5103 (and (or (eq host-type 'unknown)
|
|
|
5104 (eq listing-type 'unix:unknown))
|
|
|
5105 'unknown)
|
|
|
5106 line host file path lsargs msg
|
|
|
5107 noparse noerror nowait cont))
|
|
|
5108 ;; If dumb-check returns non-nil
|
|
|
5109 ;; then it would have handled any error recovery
|
|
|
5110 ;; and conts. listing-result would only be set to
|
|
|
5111 ;; t if nowait was non-nil. Therefore, the final
|
|
|
5112 ;; return for efs-ls could never be t, even if I
|
|
|
5113 ;; set listing-result to t here.
|
|
|
5114 (if noerror
|
|
|
5115 (if cont
|
|
|
5116 (efs-call-cont cont nil))
|
|
|
5117 (efs-error host user
|
|
|
5118 (concat "DIR failed: "
|
|
|
5119 line))))
|
|
|
5120
|
|
|
5121 ;; listing worked
|
|
|
5122 (if (efs-ftp-path temp-file)
|
|
|
5123 (efs-add-file-entry (efs-host-type efs-gateway-host)
|
|
|
5124 temp-file nil nil nil))
|
|
|
5125 (save-excursion
|
|
|
5126 ;; A hack to get around a jka-compr problem.
|
|
|
5127 ;; Do we still need it?
|
|
|
5128 (let ((default-major-mode 'fundamental-mode)
|
|
|
5129 efs-verbose jka-compr-enabled)
|
|
|
5130 (set-buffer (get-buffer-create
|
|
|
5131 efs-data-buffer-name))
|
|
|
5132 (erase-buffer)
|
|
|
5133 (if (or (file-readable-p temp-file)
|
|
|
5134 (sleep-for efs-retry-time)
|
|
|
5135 (file-readable-p temp-file))
|
|
|
5136 (insert-file-contents temp-file)
|
|
|
5137 (efs-error host user
|
|
|
5138 (format
|
|
|
5139 "list data file %s not readable"
|
|
|
5140 temp-file))))
|
|
|
5141 (if parse
|
|
|
5142 (progn
|
|
|
5143 (efs-set-files
|
|
|
5144 file
|
|
|
5145 (efs-parse-listing listing-type host user path
|
|
|
5146 file lsargs))
|
|
|
5147 ;; Parsing may update the host type.
|
|
|
5148 (and lsargs (memq (efs-host-type host)
|
|
|
5149 efs-dumb-host-types)
|
|
|
5150 (setq lsargs nil))))
|
|
|
5151 (let ((listing (buffer-string)))
|
|
|
5152 (efs-add-to-ls-cache file lsargs listing parse)
|
|
|
5153 (if (and (null lsargs) switches)
|
|
|
5154 ;; Try to convert
|
|
|
5155 (let ((conv (efs-get-ls-converter switches)))
|
|
|
5156 (and conv
|
|
|
5157 (setq conv (assoc
|
|
|
5158 (char-to-string 0)
|
|
|
5159 conv))
|
|
|
5160 (funcall (cdr conv) listing-type nil)
|
|
|
5161 (setq listing (buffer-string)))))
|
|
|
5162 (or nowait (setq listing-result listing))
|
|
|
5163 ;; Call the ls cont, with first arg the
|
|
|
5164 ;; listing string.
|
|
|
5165 (if cont
|
|
|
5166 (efs-call-cont cont listing)))))
|
|
|
5167 (efs-del-tmp-name temp-file)))
|
|
|
5168 nowait)
|
|
|
5169 (and (null nowait) listing-result))))
|
|
|
5170 (error "Attempt to get a remote listing for the local file %s" file))))
|
|
|
5171
|
|
|
5172
|
|
|
5173 ;;;; ===============================================================
|
|
|
5174 ;;;; >7
|
|
|
5175 ;;;; Parsing and storing remote file system data.
|
|
|
5176 ;;;; ===============================================================
|
|
|
5177
|
|
|
5178 ;;; The directory listing parsers do some host type guessing.
|
|
|
5179 ;;; Most of the host type guessing is done when the PWD output
|
|
|
5180 ;;; is parsed. A bit is done when the error codes for DIR are
|
|
|
5181 ;;; analyzed.
|
|
|
5182
|
|
|
5183 ;;;; -----------------------------------------------------------
|
|
|
5184 ;;;; Caching directory listings.
|
|
|
5185 ;;;; -----------------------------------------------------------
|
|
|
5186
|
|
|
5187 ;;; Aside from storing files data in a hashtable, a limited number
|
|
|
5188 ;;; of listings are stored in complete form in `efs-ls-cache'.
|
|
|
5189
|
|
|
5190 (defun efs-del-from-ls-cache (file &optional parent-p dir-p)
|
|
|
5191 ;; Deletes from the ls cache the listing for FILE.
|
|
|
5192 ;; With optional PARENT-P, deletes any entry for the parent
|
|
|
5193 ;; directory of FILE too.
|
|
|
5194 ;; If DIR-P is non-nil, then the directory listing of FILE is to be deleted.
|
|
|
5195 (if dir-p
|
|
|
5196 (setq file (file-name-as-directory file))
|
|
|
5197 (setq file (directory-file-name file)))
|
|
|
5198 (setq file (efs-canonize-file-name file))
|
|
|
5199 (if parent-p
|
|
|
5200 (setq parent-p (file-name-directory
|
|
|
5201 (if dir-p
|
|
|
5202 (directory-file-name file)
|
|
|
5203 file))))
|
|
|
5204 (setq efs-ls-cache
|
|
|
5205 (delq nil
|
|
|
5206 (mapcar
|
|
|
5207 (if parent-p
|
|
|
5208 (function
|
|
|
5209 (lambda (x)
|
|
|
5210 (let ((f-ent (car x)))
|
|
|
5211 (and (not (string-equal file f-ent))
|
|
|
5212 (not (string-equal parent-p f-ent))
|
|
|
5213 x))))
|
|
|
5214 (function
|
|
|
5215 (lambda (x)
|
|
|
5216 (and (not (string-equal file (car x)))
|
|
|
5217 x))))
|
|
|
5218 efs-ls-cache))))
|
|
|
5219
|
|
|
5220 (defun efs-wipe-from-ls-cache (host user)
|
|
|
5221 ;; Remove from efs-ls-cache all listings for HOST and USER.
|
|
|
5222 (let ((host (downcase host))
|
|
|
5223 (case-insens (memq (efs-host-type host)
|
|
|
5224 efs-case-insensitive-host-types)))
|
|
|
5225 (if case-insens (setq user (downcase user)))
|
|
|
5226 (setq efs-ls-cache
|
|
|
5227 (delq nil
|
|
|
5228 (mapcar
|
|
|
5229 (function
|
|
|
5230 (lambda (x)
|
|
|
5231 (let ((parsed (efs-ftp-path (car x))))
|
|
|
5232 (and (not
|
|
|
5233 (and (string-equal (car parsed) host)
|
|
|
5234 (string-equal (if case-insens
|
|
|
5235 (downcase (nth 1 parsed))
|
|
|
5236 (nth 1 parsed))
|
|
|
5237 user)))
|
|
|
5238 x))))
|
|
|
5239 efs-ls-cache)))))
|
|
|
5240
|
|
|
5241 (defun efs-get-from-ls-cache (file switches)
|
|
|
5242 ;; Returns the value in `ls-cache' for FILE and SWITCHES.
|
|
|
5243 ;; Returns a list consisting of the listing string, and whether its
|
|
|
5244 ;; already been parsed. This list is eq to the nthcdr 2 of the actual
|
|
|
5245 ;; cache entry, so you can setcar it.
|
|
|
5246 ;; For dumb listings, SWITCHES will be nil.
|
|
|
5247 (let ((list efs-ls-cache)
|
|
|
5248 (switches (efs-canonize-switches switches))
|
|
|
5249 (file (efs-canonize-file-name file)))
|
|
|
5250 (catch 'done
|
|
|
5251 (while list
|
|
|
5252 (if (and (string-equal file (car (car list)))
|
|
|
5253 (string-equal switches (nth 1 (car list))))
|
|
|
5254 (throw 'done (nthcdr 2 (car list)))
|
|
|
5255 (setq list (cdr list)))))))
|
|
|
5256
|
|
|
5257 (defun efs-add-to-ls-cache (file switches listing parsed)
|
|
|
5258 ;; Only call after efs-get-from-cache returns nil, to avoid duplicate
|
|
|
5259 ;; entries. PARSED should be t, if the listing has already been parsed.
|
|
|
5260 (and (> efs-ls-cache-max 0)
|
|
|
5261 (let ((switches (efs-canonize-switches switches))
|
|
|
5262 (file (efs-canonize-file-name file)))
|
|
|
5263 (if (= efs-ls-cache-max 1)
|
|
|
5264 (setq efs-ls-cache
|
|
|
5265 (list (list file switches listing parsed)))
|
|
|
5266 (if (>= (length efs-ls-cache) efs-ls-cache-max)
|
|
|
5267 (setcdr (nthcdr (- efs-ls-cache-max 2) efs-ls-cache) nil))
|
|
|
5268 (setq efs-ls-cache (cons (list file switches listing parsed)
|
|
|
5269 efs-ls-cache))))))
|
|
|
5270
|
|
|
5271 ;;;; --------------------------------------------------------------
|
|
|
5272 ;;;; Converting listings from cache.
|
|
|
5273 ;;;; --------------------------------------------------------------
|
|
|
5274
|
|
|
5275 (defun efs-get-ls-converter (to-switches)
|
|
|
5276 ;; Returns converter alist for TO-SWITCHES
|
|
|
5277 (efs-get-hash-entry (efs-canonize-switches to-switches)
|
|
|
5278 efs-ls-converter-hashtable))
|
|
|
5279
|
|
|
5280 (defun efs-add-ls-converter (to-switches from-switches converter)
|
|
|
5281 ;; Adds an entry to `efs-ls-converter-hashtable'.
|
|
|
5282 ;; If from-switches is t, the converter converts from internal files
|
|
|
5283 ;; hashtable.
|
|
|
5284 (let* ((to-switches (efs-canonize-switches to-switches))
|
|
|
5285 (ent (efs-get-hash-entry to-switches efs-ls-converter-hashtable))
|
|
|
5286 (add (cons (or (eq from-switches t)
|
|
|
5287 (efs-canonize-switches from-switches))
|
|
|
5288 converter)))
|
|
|
5289 (if ent
|
|
|
5290 (or (member add ent)
|
|
|
5291 (nconc ent (list add)))
|
|
|
5292 (efs-put-hash-entry to-switches (list add) efs-ls-converter-hashtable))))
|
|
|
5293
|
|
|
5294 (defun efs-convert-from-ls-cache (file switches host-type listing-type)
|
|
|
5295 ;; Returns a listing by converting the switches from a cached listing.
|
|
|
5296 (let ((clist (efs-get-ls-converter switches))
|
|
|
5297 (dir-p (= ?/ (aref file (1- (length file)))))
|
|
|
5298 elt listing result regexp alist)
|
|
|
5299 (while file ; this loop will iterate at most twice.
|
|
|
5300 (setq alist clist)
|
|
|
5301 (while alist
|
|
|
5302 (setq elt (car alist))
|
|
|
5303 (if (eq (car elt) t)
|
|
|
5304 (if (and dir-p (setq result (funcall (cdr elt) host-type
|
|
|
5305 (let ((efs-ls-uncache t))
|
|
|
5306 (efs-get-files file))
|
|
|
5307 regexp)))
|
|
|
5308 (setq alist nil
|
|
|
5309 file nil)
|
|
|
5310 (setq alist (cdr alist)))
|
|
|
5311 (if (and (setq listing
|
|
|
5312 (efs-get-from-ls-cache file (car elt)))
|
|
|
5313 (save-excursion
|
|
|
5314 (set-buffer
|
|
|
5315 (let ((default-major-mode 'fundamental-mode))
|
|
|
5316 (get-buffer-create efs-data-buffer-name)))
|
|
|
5317 (erase-buffer)
|
|
|
5318 (insert (car listing))
|
|
|
5319 (and (funcall (cdr elt) listing-type regexp)
|
|
|
5320 (setq result (buffer-string)))))
|
|
|
5321 (setq alist nil
|
|
|
5322 file nil)
|
|
|
5323 (setq alist (cdr alist)))))
|
|
|
5324 ;; Look for wildcards.
|
|
|
5325 (if (and file (null dir-p) (null regexp))
|
|
|
5326 (setq regexp (efs-shell-regexp-to-regexp
|
|
|
5327 (file-name-nondirectory file))
|
|
|
5328 file (file-name-directory file)
|
|
|
5329 dir-p t)
|
|
|
5330 (setq file nil)))
|
|
|
5331 result))
|
|
|
5332
|
|
|
5333 ;;; Define some converters
|
|
|
5334
|
|
|
5335 (defun efs-unix-t-converter-sort-pred (elt1 elt2)
|
|
|
5336 (let* ((data1 (car elt1))
|
|
|
5337 (data2 (car elt2))
|
|
|
5338 (year1 (car data1))
|
|
|
5339 (year2 (car data2))
|
|
|
5340 (month1 (nth 1 data1))
|
|
|
5341 (month2 (nth 1 data2))
|
|
|
5342 (day1 (nth 2 data1))
|
|
|
5343 (day2 (nth 2 data2))
|
|
|
5344 (hour1 (nth 3 data1))
|
|
|
5345 (hour2 (nth 3 data2))
|
|
|
5346 (minutes1 (nth 4 data1))
|
|
|
5347 (minutes2 (nth 4 data2)))
|
|
|
5348 (if year1
|
|
|
5349 (and year2
|
|
|
5350 (or (> year1 year2)
|
|
|
5351 (and (= year1 year2)
|
|
|
5352 (or (> month1 month2)
|
|
|
5353 (and (= month1 month2)
|
|
|
5354 (> day1 day2))))))
|
|
|
5355 (if year2
|
|
|
5356 t
|
|
|
5357 (or (> month1 month2)
|
|
|
5358 (and (= month1 month2)
|
|
|
5359 (or (> day1 day2)
|
|
|
5360 (and (= day1 day2)
|
|
|
5361 (or (> hour1 hour2)
|
|
|
5362 (and (= hour1 hour2)
|
|
|
5363 (> minutes1 minutes2)))))))))))
|
|
|
5364
|
|
|
5365 (defun efs-unix-t-converter (&optional regexp reverse)
|
|
|
5366 (if regexp
|
|
|
5367 nil
|
|
|
5368 (goto-char (point-min))
|
|
|
5369 (efs-save-match-data
|
|
|
5370 (if (re-search-forward efs-month-and-time-regexp nil t)
|
|
|
5371 (let ((current-month (cdr (assoc (substring
|
|
|
5372 (current-time-string) 4 7)
|
|
|
5373 efs-month-alist)))
|
|
|
5374 list-start start end list year month day hour minutes)
|
|
|
5375 (beginning-of-line)
|
|
|
5376 (setq list-start (point))
|
|
|
5377 (while (progn
|
|
|
5378 (setq start (point))
|
|
|
5379 (forward-line 1)
|
|
|
5380 (setq end (point))
|
|
|
5381 (goto-char start)
|
|
|
5382 (re-search-forward efs-month-and-time-regexp end t))
|
|
|
5383 ;; Need to measure wrto the current month
|
|
|
5384 ;; There is a bug here if because of time-zone shifts, the
|
|
|
5385 ;; local machine and the remote one are on different months.
|
|
|
5386 (setq month (% (+ (- 11 current-month)
|
|
|
5387 (cdr (assoc
|
|
|
5388 (buffer-substring (match-beginning 2)
|
|
|
5389 (match-end 2))
|
|
|
5390 efs-month-alist))) 12)
|
|
|
5391 day (string-to-int
|
|
|
5392 (buffer-substring (match-beginning 3) (match-end 3)))
|
|
|
5393 year (buffer-substring (match-beginning 4) (match-end 4)))
|
|
|
5394 (if (string-match ":" year)
|
|
|
5395 (setq hour (string-to-int (substring year 0
|
|
|
5396 (match-beginning 0)))
|
|
|
5397 minutes (string-to-int (substring year (match-end 0)))
|
|
|
5398 year nil)
|
|
|
5399 (setq hour nil
|
|
|
5400 minutes nil
|
|
|
5401 year (string-to-int year)))
|
|
|
5402 (setq list (cons
|
|
|
5403 (cons
|
|
|
5404 (list year month day hour minutes)
|
|
|
5405 (buffer-substring start end))
|
|
|
5406 list))
|
|
|
5407 (goto-char end))
|
|
|
5408 (setq list
|
|
|
5409 (mapcar 'cdr
|
|
|
5410 (sort list 'efs-unix-t-converter-sort-pred)))
|
|
|
5411 (if reverse (setq list (nreverse list)))
|
|
|
5412 (delete-region list-start (point))
|
|
|
5413 (apply 'insert list)
|
|
|
5414 t)))))
|
|
|
5415
|
|
|
5416 (efs-defun efs-t-converter nil (&optional regexp reverse)
|
|
|
5417 ;; Converts listing without the t-switch, to ones with it.
|
|
|
5418 nil) ; by default assume that we cannot work.
|
|
|
5419
|
|
|
5420 (efs-fset 'efs-t-converter 'unix 'efs-unix-t-converter)
|
|
|
5421 (efs-fset 'efs-t-converter 'sysV-unix 'efs-unix-t-converter)
|
|
|
5422 (efs-fset 'efs-t-converter 'apollo-unix 'efs-unix-t-converter)
|
|
|
5423 (efs-fset 'efs-t-converter 'bsd-unix 'efs-unix-t-converter)
|
|
|
5424 (efs-fset 'efs-t-converter 'dumb-unix 'efs-unix-t-converter)
|
|
|
5425 (efs-fset 'efs-t-converter 'dumb-apollo-unix 'efs-unix-t-converter)
|
|
|
5426 (efs-fset 'efs-t-converter 'super-dumb-unix 'efs-unix-t-converter)
|
|
|
5427
|
|
|
5428 (defun efs-rt-converter (listing-type &optional regexp)
|
|
|
5429 ;; Reverse time sorting
|
|
|
5430 (efs-t-converter listing-type regexp t))
|
|
|
5431
|
|
|
5432 (defun efs-unix-alpha-converter (&optional regexp reverse)
|
|
|
5433 (if regexp
|
|
|
5434 nil
|
|
|
5435 (goto-char (point-min))
|
|
|
5436 (efs-save-match-data
|
|
|
5437 (if (re-search-forward efs-month-and-time-regexp nil t)
|
|
|
5438 (let (list list-start end start next)
|
|
|
5439 (beginning-of-line)
|
|
|
5440 (setq list-start (point))
|
|
|
5441 (while (progn
|
|
|
5442 (setq start (point))
|
|
|
5443 (end-of-line)
|
|
|
5444 (setq end (point)
|
|
|
5445 next (1+ end))
|
|
|
5446 (goto-char start)
|
|
|
5447 (re-search-forward efs-month-and-time-regexp end t))
|
|
|
5448 ;; Need to measure wrto the current month
|
|
|
5449 ;; There is a bug here if because of time-zone shifts, the
|
|
|
5450 ;; local machine and the remote one are on different months.
|
|
|
5451 (setq list
|
|
|
5452 (cons
|
|
|
5453 (cons (buffer-substring (point) end)
|
|
|
5454 (buffer-substring start next))
|
|
|
5455 list))
|
|
|
5456 (goto-char next))
|
|
|
5457 (delete-region list-start (point))
|
|
|
5458 (apply 'insert
|
|
|
5459 (mapcar 'cdr
|
|
|
5460 (sort list (if reverse
|
|
|
5461 (function
|
|
|
5462 (lambda (x y)
|
|
|
5463 (string< (car y) (car x))))
|
|
|
5464 (function
|
|
|
5465 (lambda (x y)
|
|
|
5466 (string< (car x) (car y))))))))
|
|
|
5467 t)))))
|
|
|
5468
|
|
|
5469 (efs-defun efs-alpha-converter nil (&optional regexp reverse)
|
|
|
5470 ;; Converts listing to lexigraphical order.
|
|
|
5471 nil) ; by default assume that we cannot work.
|
|
|
5472
|
|
|
5473 (efs-fset 'efs-alpha-converter 'unix 'efs-unix-alpha-converter)
|
|
|
5474 (efs-fset 'efs-alpha-converter 'sysV-unix 'efs-unix-alpha-converter)
|
|
|
5475 (efs-fset 'efs-alpha-converter 'apollo-unix 'efs-unix-alpha-converter)
|
|
|
5476 (efs-fset 'efs-alpha-converter 'bsd-unix 'efs-unix-alpha-converter)
|
|
|
5477 (efs-fset 'efs-alpha-converter 'dumb-unix 'efs-unix-alpha-converter)
|
|
|
5478 (efs-fset 'efs-alpha-converter 'dumb-apollo-unix 'efs-unix-alpha-converter)
|
|
|
5479 (efs-fset 'efs-alpha-converter 'super-dumb-unix 'efs-unix-alpha-converter)
|
|
|
5480
|
|
|
5481 (defun efs-ralpha-converter (listing-type &optional regexp)
|
|
|
5482 ;; Reverse alphabetic
|
|
|
5483 (efs-alpha-converter listing-type regexp t))
|
|
|
5484
|
|
|
5485 (defun efs-unix-S-converter (&optional regexp reverse)
|
|
|
5486 (if regexp
|
|
|
5487 nil
|
|
|
5488 (goto-char (point-min))
|
|
|
5489 (efs-save-match-data
|
|
|
5490 (if (re-search-forward efs-month-and-time-regexp nil t)
|
|
|
5491 (let (list list-start start next)
|
|
|
5492 (beginning-of-line)
|
|
|
5493 (setq list-start (point))
|
|
|
5494 (while (progn
|
|
|
5495 (setq start (point))
|
|
|
5496 (forward-line 1)
|
|
|
5497 (setq next (point))
|
|
|
5498 (goto-char start)
|
|
|
5499 (re-search-forward efs-month-and-time-regexp next t))
|
|
|
5500 ;; Need to measure wrto the current month
|
|
|
5501 ;; There is a bug here if because of time-zone shifts, the
|
|
|
5502 ;; local machine and the remote one are on different months.
|
|
|
5503 (setq list
|
|
|
5504 (cons
|
|
|
5505 (cons (string-to-int
|
|
|
5506 (buffer-substring (match-beginning 1)
|
|
|
5507 (match-end 1)))
|
|
|
5508 (buffer-substring start next))
|
|
|
5509 list))
|
|
|
5510 (goto-char next))
|
|
|
5511 (delete-region list-start (point))
|
|
|
5512 (apply 'insert
|
|
|
5513 (mapcar 'cdr
|
|
|
5514 (sort list (if reverse
|
|
|
5515 (function
|
|
|
5516 (lambda (x y)
|
|
|
5517 (< (car x) (car y))))
|
|
|
5518 (function
|
|
|
5519 (lambda (x y)
|
|
|
5520 (> (car x) (car y))))))))
|
|
|
5521 t)))))
|
|
|
5522
|
|
|
5523 (efs-defun efs-S-converter nil (&optional regexp reverse)
|
|
|
5524 ;; Converts listing without the S-switch, to ones with it.
|
|
|
5525 nil) ; by default assume that we cannot work.
|
|
|
5526
|
|
|
5527 (efs-fset 'efs-S-converter 'unix 'efs-unix-S-converter)
|
|
|
5528 (efs-fset 'efs-S-converter 'sysV-unix 'efs-unix-S-converter)
|
|
|
5529 (efs-fset 'efs-S-converter 'apollo-unix 'efs-unix-S-converter)
|
|
|
5530 (efs-fset 'efs-S-converter 'bsd-unix 'efs-unix-S-converter)
|
|
|
5531 (efs-fset 'efs-S-converter 'dumb-unix 'efs-unix-S-converter)
|
|
|
5532 (efs-fset 'efs-S-converter 'dumb-apollo-unix 'efs-unix-S-converter)
|
|
|
5533 (efs-fset 'efs-S-converter 'super-dumb-unix 'efs-unix-S-converter)
|
|
|
5534
|
|
|
5535 (defun efs-rS-converter (listing-type &optional regexp)
|
|
|
5536 ;; Reverse S switch.
|
|
|
5537 (efs-S-converter listing-type regexp t))
|
|
|
5538
|
|
|
5539 (defun efs-unix-X-converter (&optional regexp reverse)
|
|
|
5540 (if regexp
|
|
|
5541 nil
|
|
|
5542 (goto-char (point-min))
|
|
|
5543 (efs-save-match-data
|
|
|
5544 (if (re-search-forward efs-month-and-time-regexp nil t)
|
|
|
5545 (let (next list list-start fnstart eol start end link-p)
|
|
|
5546 (beginning-of-line)
|
|
|
5547 (setq list-start (point))
|
|
|
5548 (while (progn
|
|
|
5549 (setq start (point))
|
|
|
5550 (skip-chars-forward "0-9 ")
|
|
|
5551 (setq link-p (= (following-char) ?l))
|
|
|
5552 (end-of-line)
|
|
|
5553 (setq eol (point)
|
|
|
5554 next (1+ eol))
|
|
|
5555 (goto-char start)
|
|
|
5556 (re-search-forward efs-month-and-time-regexp eol t))
|
|
|
5557 ;; Need to measure wrto the current month
|
|
|
5558 ;; There is a bug here if because of time-zone shifts, the
|
|
|
5559 ;; local machine and the remote one are on different months.
|
|
|
5560 (setq fnstart (point))
|
|
|
5561 (or (and link-p (search-forward " -> " eol t)
|
|
|
5562 (goto-char (match-beginning 0)))
|
|
|
5563 (goto-char eol))
|
|
|
5564 (setq end (point))
|
|
|
5565 (skip-chars-backward "^." fnstart)
|
|
|
5566 (setq list
|
|
|
5567 (cons
|
|
|
5568 (cons
|
|
|
5569 (if (= (point) fnstart)
|
|
|
5570 ""
|
|
|
5571 (buffer-substring (point) end))
|
|
|
5572 (buffer-substring start next))
|
|
|
5573 list))
|
|
|
5574 (goto-char next))
|
|
|
5575 (delete-region list-start (point))
|
|
|
5576 (apply 'insert
|
|
|
5577 (mapcar 'cdr
|
|
|
5578 (sort list (if reverse
|
|
|
5579 (function
|
|
|
5580 (lambda (x y)
|
|
|
5581 (string< (car y) (car x))))
|
|
|
5582 (function
|
|
|
5583 (lambda (x y)
|
|
|
5584 (string< (car x) (car y))))))))
|
|
|
5585 t)))))
|
|
|
5586
|
|
|
5587 (efs-defun efs-X-converter nil (&optional regexp reverse)
|
|
|
5588 ;; Sort on file name extension. By default do nothing
|
|
|
5589 nil)
|
|
|
5590
|
|
|
5591 (defun efs-rX-converter (listing-type &optional regexp)
|
|
|
5592 (efs-X-converter listing-type regexp t))
|
|
|
5593
|
|
|
5594 (efs-fset 'efs-X-converter 'unix 'efs-unix-X-converter)
|
|
|
5595 (efs-fset 'efs-X-converter 'sysV-unix 'efs-unix-X-converter)
|
|
|
5596 (efs-fset 'efs-X-converter 'apollo-unix 'efs-unix-X-converter)
|
|
|
5597 (efs-fset 'efs-X-converter 'bsd-unix 'efs-unix-X-converter)
|
|
|
5598 (efs-fset 'efs-X-converter 'dumb-unix 'efs-unix-X-converter)
|
|
|
5599 (efs-fset 'efs-X-converter 'dumb-apollo-unix 'efs-unix-X-converter)
|
|
|
5600 (efs-fset 'efs-X-converter 'super-dumb-unix 'efs-unix-X-converter)
|
|
|
5601
|
|
|
5602 ;;; Brief listings
|
|
|
5603
|
|
|
5604 ;;; The following functions do a heap better at packing than
|
|
|
5605 ;;; the usual ls listing. A variable column width is used.
|
|
|
5606 (defun efs-column-widths (columns list &optional across)
|
|
|
5607 ;; Returns the column widths for breaking LIST into
|
|
|
5608 ;; COLUMNS number of columns.
|
|
|
5609 (cond
|
|
|
5610 ((null list)
|
|
|
5611 nil)
|
|
|
5612 ((= columns 1)
|
|
|
5613 (list (apply 'max (mapcar 'length list))))
|
|
|
5614 ((let* ((len (length list))
|
|
|
5615 (col-length (/ len columns))
|
|
|
5616 (remainder (% len columns))
|
|
|
5617 (i 0)
|
|
|
5618 (j 0)
|
|
|
5619 (max-width 0)
|
|
|
5620 widths padding)
|
|
|
5621 (if (zerop remainder)
|
|
|
5622 (setq padding 0)
|
|
|
5623 (setq col-length (1+ col-length)
|
|
|
5624 padding (- columns remainder)))
|
|
|
5625 (setq list (nconc (copy-sequence list) (make-list padding nil)))
|
|
|
5626 (setcdr (nthcdr (1- (+ len padding)) list) list)
|
|
|
5627 (while (< i columns)
|
|
|
5628 (while (< j col-length)
|
|
|
5629 (setq max-width (max max-width (length (car list)))
|
|
|
5630 list (if across (nthcdr columns list) (cdr list))
|
|
|
5631 j (1+ j)))
|
|
|
5632 (setq widths (cons (+ max-width 2) widths)
|
|
|
5633 max-width 0
|
|
|
5634 j 0
|
|
|
5635 i (1+ i))
|
|
|
5636 (if across (setq list (cdr list))))
|
|
|
5637 (setcar widths (- (car widths) 2))
|
|
|
5638 (nreverse widths)))))
|
|
|
5639
|
|
|
5640 (defun efs-calculate-columns (list &optional across)
|
|
|
5641 ;; Returns a list of integers which are the column widths that best pack
|
|
|
5642 ;; LIST, a list of strings, onto the screen.
|
|
|
5643 (and list
|
|
|
5644 (let* ((width (1- (window-width)))
|
|
|
5645 (columns (max 1 (/ width
|
|
|
5646 (+ 2 (apply 'max (mapcar 'length list))))))
|
|
|
5647 col-list last-col-list)
|
|
|
5648 (while (<= (apply '+ (setq col-list
|
|
|
5649 (efs-column-widths columns list across)))
|
|
|
5650 width)
|
|
|
5651 (setq columns (1+ columns)
|
|
|
5652 last-col-list col-list))
|
|
|
5653 (or last-col-list col-list))))
|
|
|
5654
|
|
|
5655 (defun efs-format-columns-of-files (files &optional across)
|
|
|
5656 ;; Returns the number of lines used.
|
|
|
5657 ;; If ACROSS is non-nil, sorts across rather than down the buffer, like
|
|
|
5658 ;; ls -x
|
|
|
5659 ;; A beefed up version of the function in dired. Thanks Sebastian.
|
|
|
5660 (and files
|
|
|
5661 (let* ((columns (efs-calculate-columns files across))
|
|
|
5662 (ncols (length columns))
|
|
|
5663 (ncols1 (1- ncols))
|
|
|
5664 (nfiles (length files))
|
|
|
5665 (nrows (+ (/ nfiles ncols)
|
|
|
5666 (if (zerop (% nfiles ncols)) 0 1)))
|
|
|
5667 (space-left (- (window-width) (apply '+ columns) 1))
|
|
|
5668 (stretch (/ space-left ncols1))
|
|
|
5669 (float-stretch (if (zerop ncols1) 0 (% space-left ncols1)))
|
|
|
5670 (i 0)
|
|
|
5671 (j 0)
|
|
|
5672 (result "")
|
|
|
5673 file padding)
|
|
|
5674 (setq files (nconc (copy-sequence files) ; fill up with empty fns
|
|
|
5675 (make-list (- (* ncols nrows) nfiles) "")))
|
|
|
5676 (setcdr (nthcdr (1- (length files)) files) files) ; make circular
|
|
|
5677 (while (< j nrows)
|
|
|
5678 (while (< i ncols)
|
|
|
5679 (setq result (concat result (setq file (car files))))
|
|
|
5680 (setq padding (- (nth i columns) (length file)))
|
|
|
5681 (or (= i ncols1)
|
|
|
5682 (progn
|
|
|
5683 (setq padding (+ padding stretch))
|
|
|
5684 (if (< i float-stretch) (setq padding (1+ padding)))))
|
|
|
5685 (setq result (concat result (make-string padding ?\ )))
|
|
|
5686 (setq files (if across (cdr files) (nthcdr nrows files))
|
|
|
5687 i (1+ i)))
|
|
|
5688 (setq result (concat result "\n"))
|
|
|
5689 (setq i 0
|
|
|
5690 j (1+ j))
|
|
|
5691 (or across (setq files (cdr files))))
|
|
|
5692 result)))
|
|
|
5693
|
|
|
5694 (defun efs-brief-converter (host-type file-table F a A p x C &optional regexp)
|
|
|
5695 ;; Builds a brief directory listing for file cache, with
|
|
|
5696 ;; possible switches F, a, A, p, x.
|
|
|
5697 (efs-save-match-data
|
|
|
5698 (let (list ent modes)
|
|
|
5699 (efs-map-hashtable
|
|
|
5700 (function
|
|
|
5701 (lambda (key val)
|
|
|
5702 (if (and
|
|
|
5703 (efs-really-file-p host-type key val)
|
|
|
5704 (or a
|
|
|
5705 (and A (not (or (string-equal "." key)
|
|
|
5706 (string-equal ".." key))))
|
|
|
5707 (/= (string-to-char key) ?.))
|
|
|
5708 (or (null regexp)
|
|
|
5709 (string-match regexp key)))
|
|
|
5710 (setq ent (car val)
|
|
|
5711 modes (nth 3 val)
|
|
|
5712 list (cons
|
|
|
5713 (cond ((null (or F p))
|
|
|
5714 key)
|
|
|
5715 ((eq t ent)
|
|
|
5716 (concat key "/"))
|
|
|
5717 ((cond
|
|
|
5718 ((null F)
|
|
|
5719 key)
|
|
|
5720 ((stringp ent)
|
|
|
5721 (concat key "@"))
|
|
|
5722 ((null modes)
|
|
|
5723 key)
|
|
|
5724 ((eq (string-to-char modes) ?s)
|
|
|
5725 ;; a socket
|
|
|
5726 (concat key "="))
|
|
|
5727 ((or
|
|
|
5728 (memq (elt modes 3) '(?x ?s ?t))
|
|
|
5729 (memq (elt modes 6) '(?x ?s ?t))
|
|
|
5730 (memq (elt modes 9) '(?x ?s ?t)))
|
|
|
5731 (concat key "*"))
|
|
|
5732 (t
|
|
|
5733 key))))
|
|
|
5734 list)))))
|
|
|
5735 file-table)
|
|
|
5736 (setq list (sort list 'string<))
|
|
|
5737 (if (or C x)
|
|
|
5738 (efs-format-columns-of-files list x)
|
|
|
5739 (concat (mapconcat 'identity list "\n") "\n")))))
|
|
|
5740
|
|
|
5741 ;;; Store converters.
|
|
|
5742
|
|
|
5743 ;; The cheaters.
|
|
|
5744 (efs-add-ls-converter "-al" nil (function
|
|
|
5745 (lambda (listing-type &optional regexp)
|
|
|
5746 (null regexp))))
|
|
|
5747 (efs-add-ls-converter "-Al" nil (function
|
|
|
5748 (lambda (listing-type &optional regexp)
|
|
|
5749 (null regexp))))
|
|
|
5750 (efs-add-ls-converter "-alF" nil (function
|
|
|
5751 (lambda (listing-type &optional regexp)
|
|
|
5752 (null regexp))))
|
|
|
5753 (efs-add-ls-converter "-AlF" nil (function
|
|
|
5754 (lambda (listing-type &optional regexp)
|
|
|
5755 (null regexp))))
|
|
|
5756
|
|
|
5757 (efs-add-ls-converter "-alt" "-al" 'efs-t-converter)
|
|
|
5758 (efs-add-ls-converter "-Alt" "-Al" 'efs-t-converter)
|
|
|
5759 (efs-add-ls-converter "-lt" "-l" 'efs-t-converter)
|
|
|
5760 (efs-add-ls-converter "-altF" "-alF" 'efs-t-converter)
|
|
|
5761 (efs-add-ls-converter "-AltF" "-AlF" 'efs-t-converter)
|
|
|
5762 (efs-add-ls-converter "-ltF" "-lF" 'efs-t-converter)
|
|
|
5763 (efs-add-ls-converter "-alt" nil 'efs-t-converter)
|
|
|
5764 (efs-add-ls-converter "-altF" nil 'efs-t-converter)
|
|
|
5765 (efs-add-ls-converter "-Alt" nil 'efs-t-converter) ; cheating a bit
|
|
|
5766 (efs-add-ls-converter "-AltF" nil 'efs-t-converter) ; cheating a bit
|
|
|
5767
|
|
|
5768 (efs-add-ls-converter "-altr" "-al" 'efs-rt-converter)
|
|
|
5769 (efs-add-ls-converter "-Altr" "-Al" 'efs-rt-converter)
|
|
|
5770 (efs-add-ls-converter "-ltr" "-l" 'efs-rt-converter)
|
|
|
5771 (efs-add-ls-converter "-altFr" "-alF" 'efs-rt-converter)
|
|
|
5772 (efs-add-ls-converter "-AltFr" "-AlF" 'efs-rt-converter)
|
|
|
5773 (efs-add-ls-converter "-ltFr" "-lF" 'efs-rt-converter)
|
|
|
5774 (efs-add-ls-converter "-altr" nil 'efs-rt-converter)
|
|
|
5775 (efs-add-ls-converter "-Altr" nil 'efs-rt-converter)
|
|
|
5776
|
|
|
5777 (efs-add-ls-converter "-alr" "-alt" 'efs-alpha-converter)
|
|
|
5778 (efs-add-ls-converter "-Alr" "-Alt" 'efs-alpha-converter)
|
|
|
5779 (efs-add-ls-converter "-lr" "-lt" 'efs-alpha-converter)
|
|
|
5780 (efs-add-ls-converter "-alFr" "-alFt" 'efs-alpha-converter)
|
|
|
5781 (efs-add-ls-converter "-AlFr" "-AlFt" 'efs-alpha-converter)
|
|
|
5782 (efs-add-ls-converter "-lFr" "-lFt" 'efs-alpha-converter)
|
|
|
5783
|
|
|
5784 (efs-add-ls-converter "-al" "-alt" 'efs-alpha-converter)
|
|
|
5785 (efs-add-ls-converter "-Al" "-Alt" 'efs-alpha-converter)
|
|
|
5786 (efs-add-ls-converter "-l" "-lt" 'efs-alpha-converter)
|
|
|
5787 (efs-add-ls-converter "-alF" "-alFt" 'efs-alpha-converter)
|
|
|
5788 (efs-add-ls-converter "-AlF" "-AlFt" 'efs-alpha-converter)
|
|
|
5789 (efs-add-ls-converter "-lF" "-lFt" 'efs-alpha-converter)
|
|
|
5790 (efs-add-ls-converter nil "-alt" 'efs-alpha-converter)
|
|
|
5791
|
|
|
5792 (efs-add-ls-converter "-alr" "-al" 'efs-ralpha-converter)
|
|
|
5793 (efs-add-ls-converter "-Alr" "-Al" 'efs-ralpha-converter)
|
|
|
5794 (efs-add-ls-converter "-lr" "-l" 'efs-ralpha-converter)
|
|
|
5795 (efs-add-ls-converter "-alFr" "-alF" 'efs-ralpha-converter)
|
|
|
5796 (efs-add-ls-converter "-lAFr" "-lAF" 'efs-ralpha-converter)
|
|
|
5797 (efs-add-ls-converter "-lFr" "-lF" 'efs-ralpha-converter)
|
|
|
5798 (efs-add-ls-converter "-alr" nil 'efs-ralpha-converter)
|
|
|
5799
|
|
|
5800 (efs-add-ls-converter "-alr" "-alt" 'efs-ralpha-converter)
|
|
|
5801 (efs-add-ls-converter "-Alr" "-Alt" 'efs-ralpha-converter)
|
|
|
5802 (efs-add-ls-converter "-lr" "-lt" 'efs-ralpha-converter)
|
|
|
5803 (efs-add-ls-converter "-alFr" "-alFt" 'efs-ralpha-converter)
|
|
|
5804 (efs-add-ls-converter "-lAFr" "-lAFt" 'efs-ralpha-converter)
|
|
|
5805 (efs-add-ls-converter "-lFr" "-lFt" 'efs-ralpha-converter)
|
|
|
5806
|
|
|
5807 (efs-add-ls-converter "-alS" "-al" 'efs-S-converter)
|
|
|
5808 (efs-add-ls-converter "-AlS" "-Al" 'efs-S-converter)
|
|
|
5809 (efs-add-ls-converter "-lS" "-l" 'efs-S-converter)
|
|
|
5810 (efs-add-ls-converter "-alSF" "-alF" 'efs-S-converter)
|
|
|
5811 (efs-add-ls-converter "-AlSF" "-AlF" 'efs-S-converter)
|
|
|
5812 (efs-add-ls-converter "-lSF" "-lF" 'efs-S-converter)
|
|
|
5813 (efs-add-ls-converter "-alS" nil 'efs-S-converter)
|
|
|
5814
|
|
|
5815 (efs-add-ls-converter "-alSr" "-al" 'efs-rS-converter)
|
|
|
5816 (efs-add-ls-converter "-AlSr" "-Al" 'efs-rS-converter)
|
|
|
5817 (efs-add-ls-converter "-lSr" "-l" 'efs-rS-converter)
|
|
|
5818 (efs-add-ls-converter "-alSFr" "-alF" 'efs-rS-converter)
|
|
|
5819 (efs-add-ls-converter "-AlSFr" "-AlF" 'efs-rS-converter)
|
|
|
5820 (efs-add-ls-converter "-lSFr" "-lF" 'efs-rS-converter)
|
|
|
5821 (efs-add-ls-converter "-alSr" nil 'efs-rS-converter)
|
|
|
5822
|
|
|
5823 (efs-add-ls-converter "-alS" "-alt" 'efs-S-converter)
|
|
|
5824 (efs-add-ls-converter "-AlS" "-Alt" 'efs-S-converter)
|
|
|
5825 (efs-add-ls-converter "-lS" "-lt" 'efs-S-converter)
|
|
|
5826 (efs-add-ls-converter "-alSF" "-alFt" 'efs-S-converter)
|
|
|
5827 (efs-add-ls-converter "-AlSF" "-AlFt" 'efs-S-converter)
|
|
|
5828 (efs-add-ls-converter "-lSF" "-lFt" 'efs-S-converter)
|
|
|
5829
|
|
|
5830 (efs-add-ls-converter "-alSr" "-alt" 'efs-rS-converter)
|
|
|
5831 (efs-add-ls-converter "-AlSr" "-Alt" 'efs-rS-converter)
|
|
|
5832 (efs-add-ls-converter "-lSr" "-lt" 'efs-rS-converter)
|
|
|
5833 (efs-add-ls-converter "-alSFr" "-alFt" 'efs-rS-converter)
|
|
|
5834 (efs-add-ls-converter "-AlSFr" "-AlFt" 'efs-rS-converter)
|
|
|
5835 (efs-add-ls-converter "-lSFr" "-lFt" 'efs-rS-converter)
|
|
|
5836
|
|
|
5837 (efs-add-ls-converter "-AlX" nil 'efs-X-converter)
|
|
|
5838 (efs-add-ls-converter "-alX" nil 'efs-X-converter)
|
|
|
5839 (efs-add-ls-converter "-AlXr" nil 'efs-rX-converter)
|
|
|
5840 (efs-add-ls-converter "-alXr" nil 'efs-rX-converter)
|
|
|
5841
|
|
|
5842 (efs-add-ls-converter "-alX" "-al" 'efs-X-converter)
|
|
|
5843 (efs-add-ls-converter "-AlX" "-Al" 'efs-X-converter)
|
|
|
5844 (efs-add-ls-converter "-lX" "-l" 'efs-X-converter)
|
|
|
5845 (efs-add-ls-converter "-alXF" "-alF" 'efs-X-converter)
|
|
|
5846 (efs-add-ls-converter "-AlXF" "-AlF" 'efs-X-converter)
|
|
|
5847 (efs-add-ls-converter "-lXF" "-lF" 'efs-X-converter)
|
|
|
5848
|
|
|
5849 (efs-add-ls-converter "-alXr" "-al" 'efs-rX-converter)
|
|
|
5850 (efs-add-ls-converter "-AlXr" "-Al" 'efs-rX-converter)
|
|
|
5851 (efs-add-ls-converter "-lXr" "-l" 'efs-rX-converter)
|
|
|
5852 (efs-add-ls-converter "-alXFr" "-alF" 'efs-rX-converter)
|
|
|
5853 (efs-add-ls-converter "-AlXFr" "-AlF" 'efs-rX-converter)
|
|
|
5854 (efs-add-ls-converter "-lXFr" "-lF" 'efs-rX-converter)
|
|
|
5855
|
|
|
5856 ;;; Converters for efs-files-hashtable
|
|
|
5857
|
|
|
5858 (efs-add-ls-converter
|
|
|
5859 "" t (function
|
|
|
5860 (lambda (host-type files &optional regexp)
|
|
|
5861 (efs-brief-converter host-type files
|
|
|
5862 nil nil nil nil nil nil regexp))))
|
|
|
5863 (efs-add-ls-converter
|
|
|
5864 "-C" t (function
|
|
|
5865 (lambda (host-type files &optional regexp)
|
|
|
5866 (efs-brief-converter host-type files
|
|
|
5867 nil nil nil nil nil t regexp))))
|
|
|
5868 (efs-add-ls-converter
|
|
|
5869 "-F" t (function
|
|
|
5870 (lambda (host-type files &optional regexp)
|
|
|
5871 (efs-brief-converter host-type files
|
|
|
5872 t nil nil nil nil nil regexp))))
|
|
|
5873 (efs-add-ls-converter
|
|
|
5874 "-p" t (function
|
|
|
5875 (lambda (host-type files &optional regexp)
|
|
|
5876 (efs-brief-converter host-type files
|
|
|
5877 nil nil nil t nil nil regexp))))
|
|
|
5878 (efs-add-ls-converter
|
|
|
5879 "-CF" t (function
|
|
|
5880 (lambda (host-type files &optional regexp)
|
|
|
5881 (efs-brief-converter host-type files
|
|
|
5882 t nil nil nil nil t regexp))))
|
|
|
5883 (efs-add-ls-converter
|
|
|
5884 "-Cp" t (function
|
|
|
5885 (lambda (host-type files &optional regexp)
|
|
|
5886 (efs-brief-converter host-type files nil nil nil t nil t regexp))))
|
|
|
5887 (efs-add-ls-converter
|
|
|
5888 "-x" t (function
|
|
|
5889 (lambda (host-type files &optional regexp)
|
|
|
5890 (efs-brief-converter host-type files
|
|
|
5891 nil nil nil nil t nil regexp))))
|
|
|
5892 (efs-add-ls-converter
|
|
|
5893 "-xF" t (function
|
|
|
5894 (lambda (host-type files &optional regexp)
|
|
|
5895 (efs-brief-converter host-type files t nil nil nil t nil regexp))))
|
|
|
5896 (efs-add-ls-converter
|
|
|
5897 "-xp" t (function
|
|
|
5898 (lambda (host-type files &optional regexp)
|
|
|
5899 (efs-brief-converter host-type files nil nil nil t t nil regexp))))
|
|
|
5900 (efs-add-ls-converter
|
|
|
5901 "-Ca" t (function
|
|
|
5902 (lambda (host-type files &optional regexp)
|
|
|
5903 (efs-brief-converter host-type files nil t nil nil nil t regexp))))
|
|
|
5904 (efs-add-ls-converter
|
|
|
5905 "-CFa" t (function
|
|
|
5906 (lambda (host-type files &optional regexp)
|
|
|
5907 (efs-brief-converter host-type files t t nil nil nil t regexp))))
|
|
|
5908 (efs-add-ls-converter
|
|
|
5909 "-Cpa" t (function
|
|
|
5910 (lambda (host-type files &optional regexp)
|
|
|
5911 (efs-brief-converter host-type files nil t nil t nil t regexp))))
|
|
|
5912 (efs-add-ls-converter
|
|
|
5913 "-xa" t (function
|
|
|
5914 (lambda (host-type files &optional regexp)
|
|
|
5915 (efs-brief-converter host-type files nil t nil nil t nil regexp))))
|
|
|
5916 (efs-add-ls-converter
|
|
|
5917 "-xFa" t (function
|
|
|
5918 (lambda (host-type files &optional regexp)
|
|
|
5919 (efs-brief-converter host-type files t t nil nil t nil regexp))))
|
|
|
5920 (efs-add-ls-converter
|
|
|
5921 "-xpa" t (function
|
|
|
5922 (lambda (host-type files &optional regexp)
|
|
|
5923 (efs-brief-converter host-type files nil t nil t t nil regexp))))
|
|
|
5924 (efs-add-ls-converter
|
|
|
5925 "-CA" t (function
|
|
|
5926 (lambda (host-type files &optional regexp)
|
|
|
5927 (efs-brief-converter host-type files nil nil t nil nil t regexp))))
|
|
|
5928 (efs-add-ls-converter
|
|
|
5929 "-CFA" t (function
|
|
|
5930 (lambda (host-type files &optional regexp)
|
|
|
5931 (efs-brief-converter host-type files t nil t nil nil t regexp))))
|
|
|
5932 (efs-add-ls-converter
|
|
|
5933 "-CpA" t (function
|
|
|
5934 (lambda (host-type files &optional regexp)
|
|
|
5935 (efs-brief-converter host-type files nil nil t t nil t regexp))))
|
|
|
5936 (efs-add-ls-converter
|
|
|
5937 "-xA" t (function
|
|
|
5938 (lambda (host-type files &optional regexp)
|
|
|
5939 (efs-brief-converter host-type files nil nil t nil t nil regexp))))
|
|
|
5940 (efs-add-ls-converter
|
|
|
5941 "-xFA" t (function
|
|
|
5942 (lambda (host-type files &optional regexp)
|
|
|
5943 (efs-brief-converter host-type files t nil t nil t nil regexp))))
|
|
|
5944 (efs-add-ls-converter
|
|
|
5945 "-xpA" t (function
|
|
|
5946 (lambda (host-type files &optional regexp)
|
|
|
5947 (efs-brief-converter host-type files nil nil t t t nil regexp))))
|
|
|
5948
|
|
|
5949 ;;;; ------------------------------------------------------------
|
|
|
5950 ;;;; Directory Listing Parsers
|
|
|
5951 ;;;; ------------------------------------------------------------
|
|
|
5952
|
|
|
5953 (defconst efs-unix:dl-listing-regexp
|
|
|
5954 "^[^ \n\t]+\n? +\\([0-9]+\\|-\\|=\\) ")
|
|
|
5955
|
|
|
5956 ;; Note to progammers:
|
|
|
5957 ;; Below are a series of macros and functions used for parsing unix
|
|
|
5958 ;; file listings. They are intended only to be used together, so be careful
|
|
|
5959 ;; about using them out of context.
|
|
|
5960
|
|
|
5961 (defmacro efs-ls-parse-file-line ()
|
|
|
5962 ;; Extract the filename, size, and permission string from the current
|
|
|
5963 ;; line of a dired-like listing. Assumes that the point is at
|
|
|
5964 ;; the beginning of the line, leaves it just before the size entry.
|
|
|
5965 ;; Returns a list (name size perm-string nlinks owner).
|
|
|
5966 ;; If there is no file on the line, returns nil.
|
|
|
5967 (` (let ((eol (save-excursion (end-of-line) (point)))
|
|
|
5968 name size modes nlinks owner)
|
|
|
5969 (skip-chars-forward " 0-9" eol)
|
|
|
5970 (and
|
|
|
5971 (looking-at efs-modes-links-owner-regexp)
|
|
|
5972 (setq modes (buffer-substring (match-beginning 1)
|
|
|
5973 (match-end 1))
|
|
|
5974 nlinks (string-to-int (buffer-substring (match-beginning 2)
|
|
|
5975 (match-end 2)))
|
|
|
5976 owner (buffer-substring (match-beginning 3) (match-end 3)))
|
|
|
5977 (re-search-forward efs-month-and-time-regexp eol t)
|
|
|
5978 (setq name (buffer-substring (point) eol)
|
|
|
5979 size (string-to-int (buffer-substring (match-beginning 1)
|
|
|
5980 (match-end 1))))
|
|
|
5981 (list name size modes nlinks owner)))))
|
|
|
5982
|
|
|
5983 (defun efs-relist-symlink (host user symlink path switches)
|
|
|
5984 ;; Does a re-list of a single symlink in efs-data-buffer-name-2,
|
|
|
5985 ;; HOST = remote host
|
|
|
5986 ;; USER = remote username
|
|
|
5987 ;; SYMLINK = symbolic link name as a remote fullpath
|
|
|
5988 ;; PATH = efs full path syntax for the dir. being listed
|
|
|
5989 ;; SWITCHES = ls switches to use for the re-list
|
|
|
5990 ;; Returns (symlink-name symlink-target), as given by the listing. Returns
|
|
|
5991 ;; nil if the listing fails.
|
|
|
5992 ;; Does NOT correct for any symlink marking.
|
|
|
5993 (let* ((temp (efs-make-tmp-name host nil))
|
|
|
5994 (temp-file (car temp))
|
|
|
5995 (default-major-mode 'fundamental-mode)
|
|
|
5996 spot)
|
|
|
5997 (unwind-protect
|
|
|
5998 (and
|
|
|
5999 (prog1
|
|
|
6000 (null
|
|
|
6001 (car
|
|
|
6002 (efs-send-cmd host user
|
|
|
6003 (list 'dir symlink (cdr temp) switches)
|
|
|
6004 (format "Listing %s"
|
|
|
6005 (efs-relativize-filename
|
|
|
6006 (efs-replace-path-component
|
|
|
6007 path symlink))))))
|
|
|
6008 ;; Put the old message back.
|
|
|
6009 (if (and efs-verbose
|
|
|
6010 (not (and (boundp 'dired-in-query) dired-in-query)))
|
|
|
6011 (message "Listing %s..."
|
|
|
6012 (efs-relativize-filename path))))
|
|
|
6013 (save-excursion
|
|
|
6014 (if (efs-ftp-path temp-file)
|
|
|
6015 (efs-add-file-entry (efs-host-type efs-gateway-host)
|
|
|
6016 temp-file nil nil nil))
|
|
|
6017 (set-buffer (get-buffer-create efs-data-buffer-name-2))
|
|
|
6018 (erase-buffer)
|
|
|
6019 (if (or (file-readable-p temp-file)
|
|
|
6020 (sleep-for efs-retry-time)
|
|
|
6021 (file-readable-p temp-file))
|
|
|
6022 (let (efs-verbose)
|
|
|
6023 (insert-file-contents temp-file))
|
|
|
6024 (efs-error host user
|
|
|
6025 (format
|
|
|
6026 "list data file %s not readable" temp-file)))
|
|
|
6027 (skip-chars-forward " 0-9")
|
|
|
6028 (and
|
|
|
6029 (eq (following-char) ?l)
|
|
|
6030 (re-search-forward efs-month-and-time-regexp nil t)
|
|
|
6031 (setq spot (point))
|
|
|
6032 (re-search-forward " -> " nil t)
|
|
|
6033 (progn
|
|
|
6034 (end-of-line)
|
|
|
6035 (list
|
|
|
6036 ;; We might get the full path in the listing.
|
|
|
6037 (file-name-nondirectory
|
|
|
6038 (buffer-substring spot (match-beginning 0)))
|
|
|
6039 (buffer-substring (match-end 0) (point)))))))
|
|
|
6040 (efs-del-tmp-name temp-file))))
|
|
|
6041
|
|
|
6042 (defun efs-ls-sysV-p (host user dir linkname path)
|
|
|
6043 ;; Returns t if the symlink is listed in sysV style. i.e. The
|
|
|
6044 ;; symlink name is marked with an @.
|
|
|
6045 ;; HOST = remote host name
|
|
|
6046 ;; USER = remote user name
|
|
|
6047 ;; DIR = directory being listed as a remote full path.
|
|
|
6048 ;; LINKNAME = relative name of symbolic link as derived from an ls -..F...
|
|
|
6049 ;; this is assumed to end with an @
|
|
|
6050 ;; PATH = efs full path synatx for the directory
|
|
|
6051 (let ((link (car (efs-relist-symlink
|
|
|
6052 host user
|
|
|
6053 (concat dir (substring linkname 0 -1))
|
|
|
6054 path "-lFd" ))))
|
|
|
6055 (and link (string-equal link linkname))))
|
|
|
6056
|
|
|
6057 (defun efs-ls-next-p (host user dir linkname target path)
|
|
|
6058 ;; Returns t is the symlink is marked in the NeXT style.
|
|
|
6059 ;; i.e. The symlink destination is marked with an @.
|
|
|
6060 ;; This assumes that the host-type has already been identified
|
|
|
6061 ;; as NOT sysV-unix, and that target ends in an "@".
|
|
|
6062 ;; HOST = remote host name
|
|
|
6063 ;; USER = remote user name
|
|
|
6064 ;; DIR = remote directory being listed, as a remore full path
|
|
|
6065 ;; LINKNAME = relative name of symbolic link
|
|
|
6066 ;; Since we've eliminated sysV, it won't be marked with an @
|
|
|
6067 ;; TARGET = target of symbolic link, as derived from an ls -..F..
|
|
|
6068 ;; PATH = directory being listed in full efs path syntax.
|
|
|
6069 (let ((no-F-target (nth 1 (efs-relist-symlink
|
|
|
6070 host user
|
|
|
6071 (concat dir linkname)
|
|
|
6072 path "-ld"))))
|
|
|
6073 (and no-F-target
|
|
|
6074 (string-equal (concat no-F-target "@") target))))
|
|
|
6075
|
|
|
6076 ;; This deals with the F switch. Should also do something about
|
|
|
6077 ;; unquoting names obtained with the SysV b switch and the GNU Q
|
|
|
6078 ;; switch. See Sebastian's dired-get-filename.
|
|
|
6079
|
|
|
6080 (defun efs-ls-parser (host-type host user dir path switches)
|
|
|
6081 ;; Meant to be called by efs-parse-listing.
|
|
|
6082 ;; Assumes that point is at the beginning of the first file line.
|
|
|
6083 ;; Assumes that SWITCHES has already been bound to nil for a dumb host.
|
|
|
6084 ;; HOST-TYPE is the remote host-type
|
|
|
6085 ;; HOST is the remote host name
|
|
|
6086 ;; USER is the remote user name
|
|
|
6087 ;; DIR is the remote directory as a full path
|
|
|
6088 ;; PATH is the directory in full efs syntax, and directory syntax.
|
|
|
6089 ;; SWITCHES is the ls listing switches
|
|
|
6090 (let ((tbl (efs-make-hashtable))
|
|
|
6091 (used-F (and switches (string-match "F" switches)))
|
|
|
6092 (old-tbl (efs-get-files-hashtable-entry path))
|
|
|
6093 file-type symlink directory file size modes nlinks owner)
|
|
|
6094 (while (setq file (efs-ls-parse-file-line))
|
|
|
6095 (setq size (nth 1 file)
|
|
|
6096 modes (nth 2 file)
|
|
|
6097 nlinks (nth 3 file)
|
|
|
6098 owner (nth 4 file)
|
|
|
6099 file (car file)
|
|
|
6100 file-type (string-to-char modes)
|
|
|
6101 directory (eq file-type ?d))
|
|
|
6102 (if (eq file-type ?l)
|
|
|
6103 (if (string-match " -> " file)
|
|
|
6104 (setq symlink (substring file (match-end 0))
|
|
|
6105 file (substring file 0 (match-beginning 0)))
|
|
|
6106 ;; Shouldn't happen
|
|
|
6107 (setq symlink ""))
|
|
|
6108 (setq symlink nil))
|
|
|
6109 (if used-F
|
|
|
6110 ;; The F-switch jungle
|
|
|
6111 (let ((socket (eq file-type ?s))
|
|
|
6112 (fifo (eq file-type ?p))
|
|
|
6113 (executable
|
|
|
6114 (and (not symlink) ; x bits don't mean a thing for symlinks
|
|
|
6115 (or (memq (elt modes 3) '(?x ?s ?t))
|
|
|
6116 (memq (elt modes 6) '(?x ?s ?t))
|
|
|
6117 (memq (elt modes 9) '(?x ?s ?t))))))
|
|
|
6118 ;; Deal with marking of directories, executables, and sockets.
|
|
|
6119 (if (or (and executable (string-match "*$" file))
|
|
|
6120 (and socket (string-match "=$" file))
|
|
|
6121 (and fifo (string-match "|$" file)))
|
|
|
6122 (setq file (substring file 0 -1))
|
|
|
6123 ;; Do the symlink dance.
|
|
|
6124 (if symlink
|
|
|
6125 (let ((fat-p (string-match "@$" file))
|
|
|
6126 (sat-p (string-match "@$" symlink)))
|
|
|
6127 (cond
|
|
|
6128 ;; Those that mark the file
|
|
|
6129 ((and (memq host-type '(sysV-unix apollo-unix)) fat-p)
|
|
|
6130 (setq file (substring file 0 -1)))
|
|
|
6131 ;; Those that mark nothing
|
|
|
6132 ((memq host-type '(bsd-unix dumb-unix)))
|
|
|
6133 ;; Those that mark the target
|
|
|
6134 ((and (eq host-type 'next-unix) sat-p)
|
|
|
6135 (setq symlink (substring symlink 0 -1)))
|
|
|
6136 ;; We don't know
|
|
|
6137 ((eq host-type 'unix)
|
|
|
6138 (if fat-p
|
|
|
6139 (cond
|
|
|
6140 ((efs-ls-sysV-p host user dir
|
|
|
6141 file path)
|
|
|
6142 (setq host-type 'sysV-unix
|
|
|
6143 file (substring file 0 -1))
|
|
|
6144 (efs-add-host 'sysV-unix host)
|
|
|
6145 (efs-add-listing-type 'sysV-unix host user))
|
|
|
6146 ((and sat-p
|
|
|
6147 (efs-ls-next-p host user dir file symlink
|
|
|
6148 path))
|
|
|
6149 (setq host-type 'next-unix
|
|
|
6150 symlink (substring symlink 0 -1))
|
|
|
6151 (efs-add-host 'next-unix host)
|
|
|
6152 (efs-add-listing-type 'next-unix host user))
|
|
|
6153 (t
|
|
|
6154 (setq host-type 'bsd-unix)
|
|
|
6155 (efs-add-host 'bsd-unix host)
|
|
|
6156 (efs-add-listing-type 'bsd-unix host user)))
|
|
|
6157 (if (and sat-p
|
|
|
6158 (efs-ls-next-p host user dir file
|
|
|
6159 symlink path))
|
|
|
6160 (progn
|
|
|
6161 (setq host-type 'next-unix
|
|
|
6162 symlink (substring symlink 0 -1))
|
|
|
6163 (efs-add-host 'next-unix host)
|
|
|
6164 (efs-add-listing-type 'next-unix host user))
|
|
|
6165 (setq host-type 'bsd-unix)
|
|
|
6166 (efs-add-host 'bsd-unix host)
|
|
|
6167 (efs-add-listing-type 'bsd-unix host user)))))
|
|
|
6168 ;; Look out for marking of symlink
|
|
|
6169 ;; If we really wanted to, at this point we
|
|
|
6170 ;; could distinguish aix from hp-ux, ultrix, irix and a/ux,
|
|
|
6171 ;; allowing us to skip the re-list in the future, for the
|
|
|
6172 ;; later 4 host types. Another version...
|
|
|
6173 (if (string-match "[=|*]$" symlink)
|
|
|
6174 (let ((relist (efs-relist-symlink
|
|
|
6175 host user (concat dir file)
|
|
|
6176 path "-dl")))
|
|
|
6177 (if relist (setq symlink (nth 1 relist))))))))))
|
|
|
6178 ;; Strip / off the end unconditionally. It's not a valid file character
|
|
|
6179 ;; anyway.
|
|
|
6180 (if (string-match "/$" file) (setq file (substring file 0 -1)))
|
|
|
6181 (let ((mdtm (and old-tbl (nth 5 (efs-get-hash-entry file old-tbl)))))
|
|
|
6182 (if mdtm
|
|
|
6183 (efs-put-hash-entry file (list (or symlink directory) size owner
|
|
|
6184 modes nlinks mdtm) tbl)
|
|
|
6185 (efs-put-hash-entry file (list (or symlink directory) size owner
|
|
|
6186 modes nlinks) tbl)))
|
|
|
6187 (forward-line 1))
|
|
|
6188 (efs-put-hash-entry "." '(t) tbl)
|
|
|
6189 (efs-put-hash-entry ".." '(t) tbl)
|
|
|
6190 tbl))
|
|
|
6191
|
|
|
6192 (efs-defun efs-parse-listing nil (host user dir path &optional switches)
|
|
|
6193 ;; Parse the a listing which is assumed to be from some type of unix host.
|
|
|
6194 ;; Note that efs-key will be bound to the actual host type.
|
|
|
6195 ;; HOST = remote host name
|
|
|
6196 ;; USER = remote user name
|
|
|
6197 ;; DIR = directory as a remote full path
|
|
|
6198 ;; PATH = directory in full efs path syntax
|
|
|
6199 ;; SWITCHES = ls switches used for the listing
|
|
|
6200 (efs-save-match-data
|
|
|
6201 (cond
|
|
|
6202 ;; look for total line
|
|
|
6203 ((looking-at "^total [0-9]+$")
|
|
|
6204 (forward-line 1)
|
|
|
6205 ;; Beware of machines that put a blank line after the totals line.
|
|
|
6206 (skip-chars-forward " \t\n")
|
|
|
6207 (efs-ls-parser efs-key host user dir path switches))
|
|
|
6208 ;; look for errors
|
|
|
6209 ((looking-at "[^\n]+\\( not found\\|: Not a directory\\)\n\\'")
|
|
|
6210 ;; It's an ls error message.
|
|
|
6211 nil)
|
|
|
6212 ((eobp) ; i.e. zerop buffer-size
|
|
|
6213 nil) ; assume an ls error message
|
|
|
6214 ;; look for listings without total lines
|
|
|
6215 ((re-search-forward efs-month-and-time-regexp nil t)
|
|
|
6216 (beginning-of-line)
|
|
|
6217 (efs-ls-parser efs-key host user dir path switches))
|
|
|
6218 (t nil))))
|
|
|
6219
|
|
|
6220 (efs-defun efs-parse-listing unix:unknown
|
|
|
6221 (host user dir path &optional switches)
|
|
|
6222 ;; Parse the a listing which is assumed to be from some type of unix host,
|
|
|
6223 ;; possibly one doing a dl listing.
|
|
|
6224 ;; HOST = remote host name
|
|
|
6225 ;; USER = remote user name
|
|
|
6226 ;; DIR = directory as a remote full path
|
|
|
6227 ;; PATH = directory in full efs path syntax
|
|
|
6228 ;; SWITCHES = ls switches used for the listing
|
|
|
6229 (efs-save-match-data
|
|
|
6230 (cond
|
|
|
6231 ;; look for total line
|
|
|
6232 ((looking-at "^total [0-9]+$")
|
|
|
6233 (forward-line 1)
|
|
|
6234 ;; Beware of machines that put a blank line after the totals line.
|
|
|
6235 (skip-chars-forward " \t\n")
|
|
|
6236 ;; This will make the listing-type track the host-type.
|
|
|
6237 (efs-add-listing-type nil host user)
|
|
|
6238 (efs-ls-parser 'unix host user dir path switches))
|
|
|
6239 ;; look for errors
|
|
|
6240 ((looking-at "[^\n]+\\( not found\\|: Not a directory\\)\n\\'")
|
|
|
6241 ;; It's an ls error message.
|
|
|
6242 nil)
|
|
|
6243 ((eobp) ; i.e. zerop buffer-size
|
|
|
6244 nil) ; assume an ls error message
|
|
|
6245 ;; look for listings without total lines
|
|
|
6246 ((and (re-search-forward efs-month-and-time-regexp nil t)
|
|
|
6247 (progn
|
|
|
6248 (beginning-of-line)
|
|
|
6249 (looking-at efs-modes-links-owner-regexp)))
|
|
|
6250 (efs-add-listing-type nil host user)
|
|
|
6251 (efs-ls-parser 'unix host user dir path switches))
|
|
|
6252 ;; look for dumb listings
|
|
|
6253 ((re-search-forward
|
|
|
6254 (concat (regexp-quote switches)
|
|
|
6255 " not found\\|\\(^ls: +illegal option -- \\)")
|
|
|
6256 (save-excursion (end-of-line) (point)) t)
|
|
|
6257 (if (eq (efs-host-type host) 'apollo-unix)
|
|
|
6258 (progn
|
|
|
6259 (efs-add-host 'dumb-apollo-unix host)
|
|
|
6260 (efs-add-listing-type 'dumb-apollo-unix host user))
|
|
|
6261 (efs-add-host 'dumb-unix host)
|
|
|
6262 (efs-add-listing-type 'dumb-unix host user))
|
|
|
6263 (if (match-beginning 1)
|
|
|
6264 ;; Need to try to list again.
|
|
|
6265 (let ((efs-ls-uncache t))
|
|
|
6266 (efs-ls
|
|
|
6267 path nil (format "Relisting %s" (efs-relativize-filename path)) t)
|
|
|
6268 (goto-char (point-min))
|
|
|
6269 (efs-parse-listing nil host user dir path switches))
|
|
|
6270 (if (re-search-forward "^total [0-9]+$" nil t)
|
|
|
6271 (progn
|
|
|
6272 (beginning-of-line)
|
|
|
6273 (delete-region (point-min) (point))
|
|
|
6274 (forward-line 1)
|
|
|
6275 (efs-ls-parser 'dumb-unix host user dir path switches)))))
|
|
|
6276 ;; Look for dl listings.
|
|
|
6277 ((re-search-forward efs-unix:dl-listing-regexp nil t)
|
|
|
6278 (efs-add-host 'unix host)
|
|
|
6279 (efs-add-listing-type 'unix:dl host user)
|
|
|
6280 (efs-parse-listing 'unix:dl host user dir path switches))
|
|
|
6281 ;; don't know, return nil
|
|
|
6282 (t nil))))
|
|
|
6283
|
|
|
6284 (defun efs-ls-parse-1-liner (filename buffer &optional symlink)
|
|
|
6285 ;; Parse a 1-line listing for FILENAME in BUFFER, and update
|
|
|
6286 ;; the cached info for FILENAME.
|
|
|
6287 ;; Optional SYMLINK arg gives the expected target of a symlink.
|
|
|
6288 ;; Since one-line listings are usually used to update info for
|
|
|
6289 ;; newly created files, we usually know what sort of a file to expect.
|
|
|
6290 ;; Actually trying to parse out the symlink target could be impossible
|
|
|
6291 ;; for some types of switches.
|
|
|
6292 (efs-save-buffer-excursion
|
|
|
6293 (set-buffer buffer)
|
|
|
6294 (goto-char (point-min))
|
|
|
6295 (skip-chars-forward " 0-9")
|
|
|
6296 (efs-save-match-data
|
|
|
6297 (let (modes nlinks owner size)
|
|
|
6298 (and
|
|
|
6299 (looking-at efs-modes-links-owner-regexp)
|
|
|
6300 (setq modes (buffer-substring (match-beginning 1) (match-end 1))
|
|
|
6301 nlinks (string-to-int (buffer-substring (match-beginning 2)
|
|
|
6302 (match-end 2)))
|
|
|
6303 owner (buffer-substring (match-beginning 3) (match-end 3)))
|
|
|
6304 (re-search-forward efs-month-and-time-regexp nil t)
|
|
|
6305 (setq size (string-to-int (buffer-substring (match-beginning 1)
|
|
|
6306 (match-end 1))))
|
|
|
6307 (let* ((filename (directory-file-name filename))
|
|
|
6308 (files (efs-get-files-hashtable-entry
|
|
|
6309 (file-name-directory filename))))
|
|
|
6310 (if files
|
|
|
6311 (let* ((key (efs-get-file-part filename))
|
|
|
6312 (ignore-case (memq (efs-host-type
|
|
|
6313 (car (efs-ftp-path filename)))
|
|
|
6314 efs-case-insensitive-host-types))
|
|
|
6315 (ent (efs-get-hash-entry key files ignore-case))
|
|
|
6316 (mdtm (nth 5 ent))
|
|
|
6317 type)
|
|
|
6318 (if (= (string-to-char modes) ?l)
|
|
|
6319 (setq type
|
|
|
6320 (cond
|
|
|
6321 ((stringp symlink)
|
|
|
6322 symlink)
|
|
|
6323 ((stringp (car ent))
|
|
|
6324 (car ent))
|
|
|
6325 (t ; something weird happened.
|
|
|
6326 "")))
|
|
|
6327 (if (= (string-to-char modes) ?d)
|
|
|
6328 (setq type t)))
|
|
|
6329 (efs-put-hash-entry
|
|
|
6330 key (list type size owner modes nlinks mdtm)
|
|
|
6331 files ignore-case)))))))))
|
|
|
6332
|
|
|
6333 (efs-defun efs-update-file-info nil (file buffer &optional symlink)
|
|
|
6334 "For FILE, update cache information from a single file listing in BUFFER."
|
|
|
6335 ;; By default, this does nothing.
|
|
|
6336 nil)
|
|
|
6337
|
|
|
6338 (efs-defun efs-update-file-info unix (file buffer &optional symlink)
|
|
|
6339 (efs-ls-parse-1-liner file buffer))
|
|
|
6340 (efs-defun efs-update-file-info sysV-unix (file buffer &optional symlink)
|
|
|
6341 (efs-ls-parse-1-liner file buffer))
|
|
|
6342 (efs-defun efs-update-file-info bsd-unix (file buffer &optional symlink)
|
|
|
6343 (efs-ls-parse-1-liner file buffer))
|
|
|
6344 (efs-defun efs-update-file-info next-unix (file buffer &optional symlink)
|
|
|
6345 (efs-ls-parse-1-liner file buffer))
|
|
|
6346 (efs-defun efs-update-file-info apollo-unix (file buffer &optional symlink)
|
|
|
6347 (efs-ls-parse-1-liner file buffer))
|
|
|
6348 (efs-defun efs-update-file-info dumb-unix (file buffer &optional symlink)
|
|
|
6349 (efs-ls-parse-1-liner file buffer))
|
|
|
6350 (efs-defun efs-update-file-info dumb-apollo-unix
|
|
|
6351 (file buffer &optional symlink)
|
|
|
6352 (efs-ls-parse-1-liner file buffer))
|
|
|
6353 (efs-defun efs-update-file-info super-dumb-unix (file buffer &optional symlink)
|
|
|
6354 (efs-ls-parse-1-liner file buffer))
|
|
|
6355
|
|
|
6356 ;;;; ----------------------------------------------------------------
|
|
|
6357 ;;;; The 'unknown listing parser. This does some host-type guessing.
|
|
|
6358 ;;;; ----------------------------------------------------------------
|
|
|
6359
|
|
|
6360 ;;; Regexps for host and listing type guessing from the listing syntax.
|
|
|
6361
|
|
|
6362 (defconst efs-ka9q-listing-regexp
|
|
|
6363 (concat
|
|
|
6364 "^\\([0-9,.]+\\|No\\) files\\. [0-9,.]+ bytes free\\. "
|
|
|
6365 "Disk size [0-9,]+ bytes\\.$"))
|
|
|
6366 ;; This version of the regexp is really for hosts which allow some switches,
|
|
|
6367 ;; but not ours. Rather than determine which switches we could be using
|
|
|
6368 ;; we just assume that it's dumb.
|
|
|
6369 (defconst efs-dumb-unix-listing-regexp
|
|
|
6370 (concat
|
|
|
6371 "^[Uu]sage: +ls +-[a-zA-Z0-9]+[ \n]\\|"
|
|
|
6372 ;; Unitree server
|
|
|
6373 "^Error getting stats for \"-[a-zA-Z0-9]+\""))
|
|
|
6374
|
|
|
6375 (defconst efs-dos-distinct-date-and-time-regexp
|
|
|
6376 (concat
|
|
|
6377 " \\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct"
|
|
|
6378 "\\|Nov\\|Dec\\) [ 0-3][0-9],[12][90][0-9][0-9] "
|
|
|
6379 "[ 12][0-9]:[0-5][0-9] "))
|
|
|
6380 ;; Regexp to match the output from the hellsoft ftp server to an
|
|
|
6381 ;; ls -al. Unfortunately, this looks a lot like some unix ls error
|
|
|
6382 ;; messages.
|
|
|
6383 (defconst efs-hell-listing-regexp
|
|
|
6384 (concat
|
|
|
6385 "ls: file or directory not found\n\\'\\|"
|
|
|
6386 "[-d]\\[[-A-Z][-A-Z][-A-Z][-A-Z][-A-Z][-A-Z][-A-Z]\\]"))
|
|
|
6387
|
|
|
6388 (efs-defun efs-parse-listing unknown
|
|
|
6389 (host user dir path &optional switches)
|
|
|
6390 "Parse the current buffer which is assumed to contain a dir listing.
|
|
|
6391 Return a hashtable as the result. If the listing is not really a
|
|
|
6392 directory listing, then return nil.
|
|
|
6393
|
|
|
6394 HOST is the remote host's name.
|
|
|
6395 USER is the remote user name.
|
|
|
6396 DIR is the directory as a full remote path.
|
|
|
6397 PATH is the directory in full efs path synatx.
|
|
|
6398 SWITCHES are the switches passed to ls. If SWITCHES is nil, then a
|
|
|
6399 dumb \(with dir\) listing has been done."
|
|
|
6400 (efs-save-match-data
|
|
|
6401 (cond
|
|
|
6402
|
|
|
6403 ;; look for total line
|
|
|
6404 ((looking-at "^total [0-9]+$")
|
|
|
6405 (efs-add-host 'unix host)
|
|
|
6406 (forward-line 1)
|
|
|
6407 ;; Beware of machines that put a blank line after the totals line.
|
|
|
6408 (skip-chars-forward " \t\n")
|
|
|
6409 (efs-ls-parser 'unix host user dir path switches))
|
|
|
6410
|
|
|
6411 ;; Look for hellsoft. Need to do this before looking
|
|
|
6412 ;; for ls errors, since the hellsoft output looks a lot like an ls error.
|
|
|
6413 ((looking-at efs-hell-listing-regexp)
|
|
|
6414 (if (null (car (efs-send-cmd host user '(quote site dos))))
|
|
|
6415 (let* ((key (concat host "/" user "/~"))
|
|
|
6416 (tilde (efs-get-hash-entry
|
|
|
6417 key efs-expand-dir-hashtable)))
|
|
|
6418 (efs-add-host 'hell host)
|
|
|
6419 ;; downcase the expansion of ~
|
|
|
6420 (if (and tilde (string-match "^[^a-z]+$" tilde))
|
|
|
6421 (efs-put-hash-entry key (downcase tilde)
|
|
|
6422 efs-expand-dir-hashtable))
|
|
|
6423 ;; Downcase dir, in case its got some upper case stuff in it.
|
|
|
6424 (setq dir (downcase dir)
|
|
|
6425 path (efs-replace-path-component path dir))
|
|
|
6426 (let ((efs-ls-uncache t))
|
|
|
6427 ;; This will force the data buffer to be re-filled
|
|
|
6428 (efs-ls path nil (format "Relisting %s"
|
|
|
6429 (efs-relativize-filename path))
|
|
|
6430 t))
|
|
|
6431 (efs-parse-listing 'hell host user dir path))
|
|
|
6432 ;; Don't know, give unix a try.
|
|
|
6433 (efs-add-host 'unix host)
|
|
|
6434 nil))
|
|
|
6435
|
|
|
6436 ;; look for ls errors
|
|
|
6437 ((looking-at "[^\n]+\\( not found\\|: Not a directory\\)\n\\'")
|
|
|
6438 ;; It's an ls error message.
|
|
|
6439 (efs-add-host 'unix host)
|
|
|
6440 nil)
|
|
|
6441
|
|
|
6442 ((eobp) ; i.e. (zerop (buffer-size))
|
|
|
6443 ;; This could be one of:
|
|
|
6444 ;; (1) An Ultrix ls error message
|
|
|
6445 ;; (2) A listing with the A switch of an empty directory
|
|
|
6446 ;; on a machine which doesn't give a total line.
|
|
|
6447 ;; (3) The result of an attempt at an nlist. (This would mean a
|
|
|
6448 ;; dumb host.)
|
|
|
6449 ;; (4) The twilight zone.
|
|
|
6450 (cond
|
|
|
6451 ((save-excursion
|
|
|
6452 (set-buffer (process-buffer
|
|
|
6453 (efs-get-process host user)))
|
|
|
6454 (save-excursion
|
|
|
6455 (goto-char (point-max))
|
|
|
6456 (and
|
|
|
6457 ;; The dir ftp output starts with a 200 cmd.
|
|
|
6458 (re-search-backward "^150 " nil t)
|
|
|
6459 ;; We never do an nlist (it's a short listing).
|
|
|
6460 ;; If the machine thinks that we did, it's dumb.
|
|
|
6461 (looking-at "[^\n]+ NLST "))))
|
|
|
6462 ;; It's dumb-unix or ka9q. Anything else?
|
|
|
6463 ;; This will re-fill the data buffer with a dumb listing.
|
|
|
6464 (let ((efs-ls-uncache t))
|
|
|
6465 (efs-ls path nil (format "Relisting %s"
|
|
|
6466 (efs-relativize-filename path))
|
|
|
6467 t))
|
|
|
6468 (cond
|
|
|
6469 ;; check for dumb-unix
|
|
|
6470 ((re-search-forward efs-month-and-time-regexp nil t)
|
|
|
6471 (efs-add-host 'dumb-unix host)
|
|
|
6472 (beginning-of-line)
|
|
|
6473 (efs-parse-listing 'dumb-unix host user dir path))
|
|
|
6474 ;; check for ka9q
|
|
|
6475 ((save-excursion
|
|
|
6476 (goto-char (point-max))
|
|
|
6477 (forward-line -1)
|
|
|
6478 (looking-at efs-ka9q-listing-regexp))
|
|
|
6479 (efs-add-host 'ka9q host)
|
|
|
6480 (efs-parse-listing 'ka9q host user dir path))
|
|
|
6481 (t ; Don't know, try unix.
|
|
|
6482 (efs-add-host 'unix host)
|
|
|
6483 nil)))
|
|
|
6484 ;; check for Novell Netware
|
|
|
6485 ((null (car (efs-send-cmd host user '(quote site nfs))))
|
|
|
6486 (efs-add-host 'netware host)
|
|
|
6487 (let ((efs-ls-uncache t))
|
|
|
6488 (efs-ls path nil (format "Relisting %s"
|
|
|
6489 (efs-relativize-filename path))
|
|
|
6490 t))
|
|
|
6491 (efs-parse-listing 'netware host user dir path))
|
|
|
6492 (t
|
|
|
6493 ;; Assume (1), an Ultrix error message.
|
|
|
6494 (efs-add-host 'unix host)
|
|
|
6495 nil)))
|
|
|
6496
|
|
|
6497 ;; unix without a total line
|
|
|
6498 ((re-search-forward efs-month-and-time-regexp nil t)
|
|
|
6499 (efs-add-host 'unix host)
|
|
|
6500 (beginning-of-line)
|
|
|
6501 (efs-ls-parser 'unix host user dir path switches))
|
|
|
6502
|
|
|
6503 ;; Now we look for host-types, or listing-types which are auto-rec
|
|
|
6504 ;; by the listing parser, because it's not possible to pick them out
|
|
|
6505 ;; from a pwd.
|
|
|
6506
|
|
|
6507 ;; check for dumb-unix
|
|
|
6508 ;; (Guessing of dumb-unix hosts which return an ftp error message is
|
|
|
6509 ;; done in efs-ls.)
|
|
|
6510 ((re-search-forward efs-dumb-unix-listing-regexp nil t)
|
|
|
6511 (efs-add-host 'dumb-unix host)
|
|
|
6512 ;; This will force the data buffer to be re-filled
|
|
|
6513 (let ((efs-ls-uncache t))
|
|
|
6514 (efs-ls path nil (format "Relisting %s"
|
|
|
6515 (efs-relativize-filename path))
|
|
|
6516 t))
|
|
|
6517 (efs-parse-listing 'dumb-unix host user dir path))
|
|
|
6518
|
|
|
6519 ;; check for Distinct's DOS ftp server
|
|
|
6520 ((re-search-forward efs-dos-distinct-date-and-time-regexp nil t)
|
|
|
6521 (efs-add-host 'dos-distinct host)
|
|
|
6522 (efs-parse-listing 'dos-distinct host user dir path))
|
|
|
6523
|
|
|
6524 ;; check for KA9Q pseudo-unix (LINUX?)
|
|
|
6525 ((save-excursion
|
|
|
6526 (goto-char (point-max))
|
|
|
6527 (forward-line -1)
|
|
|
6528 (looking-at efs-ka9q-listing-regexp))
|
|
|
6529 (efs-add-host 'ka9q host)
|
|
|
6530 ;; This will re-fill the data buffer.
|
|
|
6531 ;; Need to do this because ka9q is a dumb host.
|
|
|
6532 (let ((efs-ls-uncache t))
|
|
|
6533 (efs-ls path nil (format "Relisting %s"
|
|
|
6534 (efs-relativize-filename path))
|
|
|
6535 t))
|
|
|
6536 (efs-parse-listing 'ka9q host user dir path))
|
|
|
6537
|
|
|
6538 ;; Check for a unix descriptive (dl) listing
|
|
|
6539 ;; Do this last, because it's hard to guess.
|
|
|
6540 ((re-search-forward efs-unix:dl-listing-regexp nil t)
|
|
|
6541 (efs-add-host 'unix host)
|
|
|
6542 (efs-add-listing-type 'unix:dl host user)
|
|
|
6543 (efs-parse-listing 'unix:dl host user dir path switches))
|
|
|
6544
|
|
|
6545 ;; Don't know what's going on. Return nil, and assume unix.
|
|
|
6546 (t
|
|
|
6547 (efs-add-host 'unix host)
|
|
|
6548 nil))))
|
|
|
6549
|
|
|
6550 ;;;; ------------------------------------------------------------
|
|
|
6551 ;;;; Directory information hashtable.
|
|
|
6552 ;;;; ------------------------------------------------------------
|
|
|
6553
|
|
|
6554 (efs-defun efs-really-file-p nil (file ent)
|
|
|
6555 ;; efs-files-hashtable sometimes contains fictitious entries, when
|
|
|
6556 ;; some OS's allow a file to be accessed by another name. For example,
|
|
|
6557 ;; in VMS the highest version of a file may be accessed by omitting the
|
|
|
6558 ;; the file version number. This function should return t if the
|
|
|
6559 ;; filename FILE is really a file. ENT is the hash entry of the file.
|
|
|
6560 t)
|
|
|
6561
|
|
|
6562 (efs-defun efs-add-file-entry nil (path type size owner
|
|
|
6563 &optional modes nlinks mdtm)
|
|
|
6564 ;; Add a new file entry for PATH
|
|
|
6565 ;; TYPE is nil for a plain file, t for a directory, and a string
|
|
|
6566 ;; (the target of the link) for a symlink.
|
|
|
6567 ;; SIZE is the size of the file in bytes.
|
|
|
6568 ;; OWNER is the owner of the file, as a string.
|
|
|
6569 ;; MODES is the file modes, as a string. In Unix, this will be 10 cars.
|
|
|
6570 ;; NLINKS is the number of links for the file.
|
|
|
6571 ;; MDTM is the last modtime obtained for the file. This is for
|
|
|
6572 ;; short-term cache only, as emacs often has sequences of functions
|
|
|
6573 ;; doing modtime lookup. If you really want to be sure of the modtime,
|
|
|
6574 ;; use efs-get-file-mdtm, which asks the remote server.
|
|
|
6575
|
|
|
6576 (and (eq type t)
|
|
|
6577 (setq path (directory-file-name path)))
|
|
|
6578 (let ((files (efs-get-files-hashtable-entry (file-name-directory path))))
|
|
|
6579 (if files
|
|
|
6580 (efs-put-hash-entry
|
|
|
6581 (efs-get-file-part path)
|
|
|
6582 (cond (mdtm
|
|
|
6583 (list type size owner modes nlinks
|
|
|
6584 mdtm))
|
|
|
6585 (nlinks
|
|
|
6586 (list type size owner modes nlinks))
|
|
|
6587 (modes (list type size owner modes))
|
|
|
6588 (t (list type size owner)))
|
|
|
6589 files
|
|
|
6590 (memq efs-key efs-case-insensitive-host-types)))
|
|
|
6591 (efs-del-from-ls-cache path t nil)))
|
|
|
6592
|
|
|
6593 (efs-defun efs-delete-file-entry nil (path &optional dir-p)
|
|
|
6594 "Delete the file entry for PATH, if its directory info exists."
|
|
|
6595 (if dir-p
|
|
|
6596 (progn
|
|
|
6597 (setq path (file-name-as-directory path))
|
|
|
6598 (efs-del-hash-entry (efs-canonize-file-name path)
|
|
|
6599 efs-files-hashtable)
|
|
|
6600 ;; Note that file-name-as-directory followed by
|
|
|
6601 ;; (substring path 0 -1)
|
|
|
6602 ;; serves to canonicalize directory file names to their unix form.
|
|
|
6603 ;; i.e. in VMS, FOO.DIR -> FOO/ -> FOO
|
|
|
6604 ;; PATH is supposed to be s fully expanded efs-style path.
|
|
|
6605 (setq path (substring path 0 -1))))
|
|
|
6606 (let ((files (efs-get-files-hashtable-entry (file-name-directory path))))
|
|
|
6607 (if files
|
|
|
6608 (efs-del-hash-entry
|
|
|
6609 (efs-get-file-part path)
|
|
|
6610 files
|
|
|
6611 (memq (efs-host-type (car (efs-ftp-path path)))
|
|
|
6612 efs-case-insensitive-host-types))))
|
|
|
6613 (efs-del-from-ls-cache path t nil)
|
|
|
6614 (if dir-p (efs-del-from-ls-cache path nil t)))
|
|
|
6615
|
|
|
6616 (defun efs-set-files (directory files)
|
|
|
6617 "For DIRECTORY, set or change the associated FILES hashtable."
|
|
|
6618 (if files
|
|
|
6619 (efs-put-hash-entry
|
|
|
6620 (efs-canonize-file-name (file-name-as-directory directory))
|
|
|
6621 files efs-files-hashtable)))
|
|
|
6622
|
|
|
6623 (defun efs-parsable-switches-p (switches &optional full-dir)
|
|
|
6624 ;; Returns non-nil if SWITCHES would give an ls listing suitable for parsing
|
|
|
6625 ;; If FULL-DIR is non-nil, the switches must be suitable for parsing a full
|
|
|
6626 ;; ditectory.
|
|
|
6627 (or (null switches)
|
|
|
6628 (efs-save-match-data
|
|
|
6629 (and (string-match "[aA]" switches)
|
|
|
6630 ;; g is not good enough, need l or o for owner.
|
|
|
6631 (string-match "[lo]" switches)
|
|
|
6632 ;; L shows link target, rather than link. We need both.
|
|
|
6633 (not (string-match "[RfL]" switches))
|
|
|
6634 (not (and full-dir (string-match "d" switches)))))))
|
|
|
6635
|
|
|
6636 (defun efs-get-files (directory &optional no-error)
|
|
|
6637 "For DIRECTORY, return a hashtable of file entries.
|
|
|
6638 This will give an error or return nil, depending on the value of
|
|
|
6639 NO-ERROR, if a listing for DIRECTORY cannot be obtained."
|
|
|
6640 (let ((directory (file-name-as-directory directory)))
|
|
|
6641 (or (efs-get-files-hashtable-entry directory)
|
|
|
6642 (and (efs-ls directory (efs-ls-guess-switches) t 'parse no-error)
|
|
|
6643 (efs-get-files-hashtable-entry directory)))))
|
|
|
6644
|
|
|
6645 (efs-defun efs-allow-child-lookup nil (host user dir file)
|
|
|
6646 ;; Returns non-nil if in directory DIR, FILE could possibly be a subdir
|
|
|
6647 ;; according to its file-name syntax, and therefore a child listing should
|
|
|
6648 ;; be attempted. Note that DIR is in directory syntax.
|
|
|
6649 ;; i.e. /foo/bar/, not /foo/bar.
|
|
|
6650 ;; Deal with dired. Anything else?
|
|
|
6651 (not (and (boundp 'dired-local-variables-file)
|
|
|
6652 (stringp dired-local-variables-file)
|
|
|
6653 (string-equal dired-local-variables-file file))))
|
|
|
6654
|
|
|
6655 (defmacro efs-ancestral-check (host-type path ignore-case)
|
|
|
6656 ;; Checks to see if something in a path's ancient parentage
|
|
|
6657 ;; would make it impossible for the path to exist in the directory
|
|
|
6658 ;; tree. In this case it returns nil. Otherwise returns t (there
|
|
|
6659 ;; is essentially no information returned in this case, the file
|
|
|
6660 ;; may exist or not).
|
|
|
6661 ;; This macro should make working with RCS more efficient.
|
|
|
6662 ;; It also helps with FTP servers that go into fits if we ask to
|
|
|
6663 ;; list a non-existent dir.
|
|
|
6664 ;; Yes, I know that the function mapped over the hashtable can
|
|
|
6665 ;; be written more cleanly with a concat, but this is faster.
|
|
|
6666 ;; concat's cause a lot of consing. So do regexp-quote's, but we can't
|
|
|
6667 ;; avoid it.
|
|
|
6668 ;; Probably doesn't make much sense for this to be an efs-defun, since
|
|
|
6669 ;; the host-type dependence is very mild.
|
|
|
6670 (`
|
|
|
6671 (let ((path (, path)) ; expand once
|
|
|
6672 (ignore-case (, ignore-case))
|
|
|
6673 str)
|
|
|
6674 ;; eliminate flat file systems -- should have a constant for this
|
|
|
6675 (or (memq (, host-type) '(mts cms mvs cms-knet))
|
|
|
6676 (efs-save-match-data
|
|
|
6677 (catch 'foo
|
|
|
6678 (efs-map-hashtable
|
|
|
6679 (function
|
|
|
6680 (lambda (key val)
|
|
|
6681 (and (eq (string-match (regexp-quote key) path) 0)
|
|
|
6682 (setq str (substring path (match-end 0)))
|
|
|
6683 (string-match "^[^/]+" str)
|
|
|
6684 (not (efs-hash-entry-exists-p
|
|
|
6685 (substring str 0 (match-end 0))
|
|
|
6686 val ignore-case))
|
|
|
6687 (throw 'foo nil))))
|
|
|
6688 efs-files-hashtable)
|
|
|
6689 t))))))
|
|
|
6690
|
|
|
6691 (defun efs-file-entry-p (path)
|
|
|
6692 ;; Return whether there is a file entry for PATH.
|
|
|
6693 ;; Under no circumstances does this cause FTP activity.
|
|
|
6694 (let* ((path (directory-file-name (efs-canonize-file-name path)))
|
|
|
6695 (dir (file-name-directory path))
|
|
|
6696 (file (efs-get-file-part path))
|
|
|
6697 (tbl (efs-get-files-hashtable-entry dir)))
|
|
|
6698 (and tbl (efs-hash-entry-exists-p
|
|
|
6699 file tbl
|
|
|
6700 (memq (efs-host-type (car (efs-ftp-path dir)))
|
|
|
6701 efs-case-insensitive-host-types)) t)))
|
|
|
6702
|
|
|
6703 (defun efs-get-file-entry (path)
|
|
|
6704 "Return the given file entry for PATH.
|
|
|
6705 This is a list of the form \(type size owner modes nlinks modtm\),
|
|
|
6706 where type is nil for a normal file, t for a directory, and a string for a
|
|
|
6707 symlink, size is the size of the file in bytes, if known, and modes are
|
|
|
6708 the permission modes of the file as a string. modtm is short-term the
|
|
|
6709 cache of the file modtime. It is not used by `verify-visited-file-modtime'.
|
|
|
6710 If the file isn't in the hashtable, this returns nil."
|
|
|
6711 (let* ((path (directory-file-name (efs-canonize-file-name path)))
|
|
|
6712 (dir (file-name-directory path))
|
|
|
6713 (file (efs-get-file-part path))
|
|
|
6714 (parsed (efs-ftp-path dir))
|
|
|
6715 (host (car parsed))
|
|
|
6716 (host-type (efs-host-type host))
|
|
|
6717 (ent (efs-get-files-hashtable-entry dir))
|
|
|
6718 (ignore-case (memq host-type efs-case-insensitive-host-types)))
|
|
|
6719 (if ent
|
|
|
6720 (efs-get-hash-entry file ent ignore-case)
|
|
|
6721 (let ((user (nth 1 parsed))
|
|
|
6722 (r-dir (nth 2 parsed)))
|
|
|
6723 (and (efs-ancestral-check host-type path ignore-case)
|
|
|
6724 (or (and efs-allow-child-lookup
|
|
|
6725 (efs-allow-child-lookup host-type
|
|
|
6726 host user r-dir file)
|
|
|
6727 (setq ent (efs-get-files path t))
|
|
|
6728 (efs-get-hash-entry "." ent))
|
|
|
6729 ;; i.e. it's a directory by child lookup
|
|
|
6730 (efs-get-hash-entry
|
|
|
6731 file (efs-get-files dir) ignore-case)))))))
|
|
|
6732
|
|
|
6733 (defun efs-wipe-file-entries (host user)
|
|
|
6734 "Remove cache data for all files on HOST and USER.
|
|
|
6735 This replaces the file entry information hashtable with one that
|
|
|
6736 doesn't have any entries for the given HOST, USER pair."
|
|
|
6737 (let ((new-tbl (efs-make-hashtable (length efs-files-hashtable)))
|
|
|
6738 (host (downcase host))
|
|
|
6739 (case-fold (memq (efs-host-type host)
|
|
|
6740 efs-case-insensitive-host-types)))
|
|
|
6741 (if case-fold (setq user (downcase user)))
|
|
|
6742 (efs-map-hashtable
|
|
|
6743 (function
|
|
|
6744 (lambda (key val)
|
|
|
6745 (let ((parsed (efs-ftp-path key)))
|
|
|
6746 (if parsed
|
|
|
6747 (let ((h (nth 0 parsed))
|
|
|
6748 (u (nth 1 parsed)))
|
|
|
6749 (or (and (string-equal host (downcase h))
|
|
|
6750 (string-equal user (if case-fold (downcase u) u)))
|
|
|
6751 (efs-put-hash-entry key val new-tbl)))))))
|
|
|
6752 efs-files-hashtable)
|
|
|
6753 (setq efs-files-hashtable new-tbl)))
|
|
|
6754
|
|
|
6755
|
|
|
6756 ;;;; ============================================================
|
|
|
6757 ;;;; >8
|
|
|
6758 ;;;; Redefinitions of standard GNU Emacs functions.
|
|
|
6759 ;;;; ============================================================
|
|
|
6760
|
|
|
6761 ;;;; ------------------------------------------------------------
|
|
|
6762 ;;;; expand-file-name and friends...
|
|
|
6763 ;;;; ------------------------------------------------------------
|
|
|
6764
|
|
|
6765 ;; New filename expansion code for efs.
|
|
|
6766 ;; The overall structure is based around the following internal
|
|
|
6767 ;; functions and macros. Since these are internal, they do NOT
|
|
|
6768 ;; call efs-save-match-data. This is done by their calling
|
|
|
6769 ;; function.
|
|
|
6770 ;;
|
|
|
6771 ;; efs-expand-tilde
|
|
|
6772 ;; - expands all ~ constructs, both local and remote.
|
|
|
6773 ;; efs-short-circuit-file-name
|
|
|
6774 ;; - short-circuits //'s and /~'s, for both local and remote paths.
|
|
|
6775 ;; efs-de-dot-file-name
|
|
|
6776 ;; - canonizes /../ and /./'s in both local and remote paths.
|
|
|
6777 ;;
|
|
|
6778 ;; The following two functions overload existing emacs functions.
|
|
|
6779 ;; They are the entry points to this filename expansion code, and as such
|
|
|
6780 ;; call efs-save-match-data.
|
|
|
6781 ;;
|
|
|
6782 ;; efs-expand-file-name
|
|
|
6783 ;; efs-substitute-in-file-name
|
|
|
6784
|
|
|
6785 ;;; utility macros
|
|
|
6786
|
|
|
6787 (defmacro efs-short-circuit-file-name (filename)
|
|
|
6788 ;; Short-circuits //'s and /~'s in filenames.
|
|
|
6789 ;; Returns a list consisting of the local path,
|
|
|
6790 ;; host-type, host, user. For local hosts,
|
|
|
6791 ;; host-type, host, and user are all nil.
|
|
|
6792 (`
|
|
|
6793 (let ((start 0)
|
|
|
6794 (string (, filename))
|
|
|
6795 backskip regexp lbackskip
|
|
|
6796 lregexp parsed host-type host user)
|
|
|
6797
|
|
|
6798 (if efs-local-apollo-unix
|
|
|
6799 (setq lregexp ".//+"
|
|
|
6800 lbackskip 2)
|
|
|
6801 (setq lregexp "//+"
|
|
|
6802 lbackskip 1))
|
|
|
6803
|
|
|
6804 ;; Short circuit /user@mach: roots. It is important to do this
|
|
|
6805 ;; now to avoid unnecessary ftp connections.
|
|
|
6806
|
|
|
6807 (while (string-match efs-path-root-short-circuit-regexp string start)
|
|
|
6808 (setq start (1+ (match-beginning 0))))
|
|
|
6809 (or (zerop start) (setq string (substring string start)
|
|
|
6810 start 0))
|
|
|
6811
|
|
|
6812 ;; identify remote root
|
|
|
6813
|
|
|
6814 (if (setq parsed (efs-ftp-path-macro string))
|
|
|
6815 (if (memq (setq string (nth 2 parsed)
|
|
|
6816 host-type
|
|
|
6817 (efs-host-type (setq host (car parsed))
|
|
|
6818 (setq user (nth 1 parsed))))
|
|
|
6819 '(apollo-unix dumb-apollo-unix))
|
|
|
6820 (setq regexp ".//+"
|
|
|
6821 backskip 2)
|
|
|
6822 (setq regexp "//+"
|
|
|
6823 backskip 1))
|
|
|
6824 (setq regexp lregexp
|
|
|
6825 backskip lbackskip))
|
|
|
6826
|
|
|
6827 ;; Now short-circuit in an apollo and efs sensitive way.
|
|
|
6828
|
|
|
6829 (while (cond ((string-match regexp string start)
|
|
|
6830 (setq start (- (match-end 0) backskip)))
|
|
|
6831 ((string-match "/~" string start)
|
|
|
6832 (setq start (1- (match-end 0)))))
|
|
|
6833
|
|
|
6834 (and host-type
|
|
|
6835 (null efs-short-circuit-to-remote-root)
|
|
|
6836 (setq host-type nil
|
|
|
6837 regexp lregexp
|
|
|
6838 backskip lbackskip)))
|
|
|
6839 (or (zerop start) (setq string (substring string start)))
|
|
|
6840 (list string host-type (and host-type host) (and host-type user)))))
|
|
|
6841
|
|
|
6842 (defmacro efs-expand-tilde (tilde host-type host user)
|
|
|
6843 ;; Expands a TILDE (~ or ~sandy type construction)
|
|
|
6844 ;; Takes as an arg a filename (not directory name!)
|
|
|
6845 ;; and returns a filename. HOST-TYPE is the type of remote host.
|
|
|
6846 ;; nil is the type of the local host.
|
|
|
6847 (`
|
|
|
6848 (if (, host-type) ; nil host-type is the local machine
|
|
|
6849 (let* ((host (downcase (, host)))
|
|
|
6850 (host-type (, host-type))
|
|
|
6851 (ignore-case (memq host-type
|
|
|
6852 efs-case-insensitive-host-types))
|
|
|
6853 (tilde (, tilde))
|
|
|
6854 (user (, user))
|
|
|
6855 (key (concat host "/" user "/" tilde))
|
|
|
6856 (res (efs-get-hash-entry
|
|
|
6857 key efs-expand-dir-hashtable ignore-case)))
|
|
|
6858 (or res
|
|
|
6859 ;; for real accounts on unix systems, use the get trick
|
|
|
6860 (and (not (efs-anonymous-p user))
|
|
|
6861 (memq host-type efs-unix-host-types)
|
|
|
6862 (let ((line (nth 1 (efs-send-cmd
|
|
|
6863 host user
|
|
|
6864 (list 'get tilde "/dev/null")
|
|
|
6865 (format "expanding %s" tilde)))))
|
|
|
6866 (setq res
|
|
|
6867 (and (string-match efs-expand-dir-msgs line)
|
|
|
6868 (substring line
|
|
|
6869 (match-beginning 1)
|
|
|
6870 (match-end 1))))
|
|
|
6871 (if res
|
|
|
6872 (progn
|
|
|
6873 (setq res (efs-internal-directory-file-name res))
|
|
|
6874 (efs-put-hash-entry
|
|
|
6875 key res efs-expand-dir-hashtable ignore-case)
|
|
|
6876 res))))
|
|
|
6877 (progn
|
|
|
6878 (setq res
|
|
|
6879 (if (string-equal tilde "~")
|
|
|
6880 (car (efs-send-pwd
|
|
|
6881 host-type host user))
|
|
|
6882 (let* ((home-key (concat host "/" user "/~"))
|
|
|
6883 (home (efs-get-hash-entry
|
|
|
6884 home-key efs-expand-dir-hashtable
|
|
|
6885 ignore-case))
|
|
|
6886 pwd-result)
|
|
|
6887 (if home
|
|
|
6888 (setq home
|
|
|
6889 (efs-fix-path
|
|
|
6890 host-type
|
|
|
6891 (efs-internal-file-name-as-directory
|
|
|
6892 host-type home)))
|
|
|
6893 (if (setq home
|
|
|
6894 (car
|
|
|
6895 (setq pwd-result
|
|
|
6896 (efs-send-pwd
|
|
|
6897 host-type
|
|
|
6898 host user))))
|
|
|
6899 (efs-put-hash-entry
|
|
|
6900 home-key
|
|
|
6901 (efs-internal-directory-file-name
|
|
|
6902 (efs-fix-path host-type home 'reverse))
|
|
|
6903 efs-expand-dir-hashtable ignore-case)
|
|
|
6904 (efs-error host user
|
|
|
6905 (concat "PWD failed: "
|
|
|
6906 (cdr pwd-result)))))
|
|
|
6907 (unwind-protect
|
|
|
6908 (and (efs-raw-send-cd host user
|
|
|
6909 (efs-fix-path
|
|
|
6910 host-type tilde) t)
|
|
|
6911 (car
|
|
|
6912 (efs-send-pwd
|
|
|
6913 host-type host user)))
|
|
|
6914 (efs-raw-send-cd host user home)))))
|
|
|
6915 (if res
|
|
|
6916 (progn
|
|
|
6917 (setq res (efs-internal-directory-file-name
|
|
|
6918 (efs-fix-path host-type res 'reverse)))
|
|
|
6919 (efs-put-hash-entry
|
|
|
6920 key res efs-expand-dir-hashtable ignore-case)
|
|
|
6921 res)))
|
|
|
6922 (if (string-equal tilde "~")
|
|
|
6923 (error "Cannot get home directory on %s" host)
|
|
|
6924 (error "User %s is not known on %s" (substring tilde 1) host))))
|
|
|
6925 ;; local machine
|
|
|
6926 (efs-real-expand-file-name (, tilde)))))
|
|
|
6927
|
|
|
6928 (defmacro efs-de-dot-file-name (string)
|
|
|
6929 ;; Takes a string as arguments, and removes /../'s and /./'s.
|
|
|
6930 (`
|
|
|
6931 (let ((string (, string))
|
|
|
6932 (start 0)
|
|
|
6933 new make-dir)
|
|
|
6934 ;; to make the regexp's simpler, canonicalize to directory name.
|
|
|
6935 (if (setq make-dir (string-match "/\\.\\.?$" string))
|
|
|
6936 (setq string (concat string "/")))
|
|
|
6937 (while (string-match "/\\./" string start)
|
|
|
6938 (setq new (concat new
|
|
|
6939 (substring string
|
|
|
6940 start (match-beginning 0)))
|
|
|
6941 start (1- (match-end 0))))
|
|
|
6942
|
|
|
6943 (if new (setq string (concat new (substring string start))))
|
|
|
6944
|
|
|
6945 (while (string-match "/[^/]+/\\.\\./" string)
|
|
|
6946 ;; Is there a way to avoid all this concating and copying?
|
|
|
6947 (setq string (concat (substring string 0 (1+ (match-beginning 0)))
|
|
|
6948 (substring string (match-end 0)))))
|
|
|
6949
|
|
|
6950 ;; Do /../ and //../ special cases. They should expand to
|
|
|
6951 ;; / and //, respectively.
|
|
|
6952 (if (string-match "^\\(/+\\)\\.\\./" string)
|
|
|
6953 (setq string (concat (substring string 0 (match-end 1))
|
|
|
6954 (substring string (match-end 0)))))
|
|
|
6955
|
|
|
6956 (if (and make-dir
|
|
|
6957 (not (string-match "^/+$" string)))
|
|
|
6958 (substring string 0 -1)
|
|
|
6959 string))))
|
|
|
6960
|
|
|
6961 (defun efs-substitute-in-file-name (string)
|
|
|
6962 "Documented as original."
|
|
|
6963 ;; Because of the complicated interaction between short-circuiting
|
|
|
6964 ;; and environment variable substitution, this can't call the macro
|
|
|
6965 ;; efs-short-circuit-file-name.
|
|
|
6966 (efs-save-match-data
|
|
|
6967 (let ((start 0)
|
|
|
6968 var new root backskip regexp lbackskip
|
|
|
6969 lregexp parsed fudge-host-type rstart error)
|
|
|
6970
|
|
|
6971 (if efs-local-apollo-unix
|
|
|
6972 (setq lregexp ".//+"
|
|
|
6973 lbackskip 2)
|
|
|
6974 (setq lregexp "//+"
|
|
|
6975 lbackskip 1))
|
|
|
6976
|
|
|
6977 ;; Subst. existing env variables
|
|
|
6978 (while (string-match "\\$" string start)
|
|
|
6979 (setq new (concat new (substring string start (match-beginning 0)))
|
|
|
6980 start (match-end 0))
|
|
|
6981 (cond ((eq (string-match "\\$" string start) start)
|
|
|
6982 (setq start (1+ start)
|
|
|
6983 new (concat new "$$")))
|
|
|
6984 ((eq (string-match "{" string start) start)
|
|
|
6985 (if (and (string-match "}" string start)
|
|
|
6986 (setq var (getenv
|
|
|
6987 (substring string (1+ start)
|
|
|
6988 (1- (match-end 0))))))
|
|
|
6989 (setq start (match-end 0)
|
|
|
6990 new (concat new var))
|
|
|
6991 (setq new (concat new "$"))))
|
|
|
6992 ((eq (string-match "[a-zA-Z0-9]+" string start) start)
|
|
|
6993 (if (setq var (getenv
|
|
|
6994 (substring string start (match-end 0))))
|
|
|
6995 (setq start (match-end 0)
|
|
|
6996 new (concat new var))
|
|
|
6997 (setq new (concat new "$"))))
|
|
|
6998 ((setq new (concat new "$")))))
|
|
|
6999 (if new (setq string (concat new (substring string start))
|
|
|
7000 start 0))
|
|
|
7001
|
|
|
7002 ;; Short circuit /user@mach: roots. It is important to do this
|
|
|
7003 ;; now to avoid unnecessary ftp connections.
|
|
|
7004
|
|
|
7005 (while (string-match efs-path-root-short-circuit-regexp
|
|
|
7006 string start)
|
|
|
7007 (setq start (1+ (match-beginning 0))))
|
|
|
7008 (or (zerop start) (setq string (substring string start)
|
|
|
7009 start 0))
|
|
|
7010
|
|
|
7011 ;; Look for invalid environment variables in the root. If one is found,
|
|
|
7012 ;; we set the host-type to 'unix. Since we can't login in to determine
|
|
|
7013 ;; it. There is a good chance that we will bomb later with an error,
|
|
|
7014 ;; but the day may yet be saved if the root is short-circuited off.
|
|
|
7015
|
|
|
7016 (if (string-match efs-path-root-regexp string)
|
|
|
7017 (progn
|
|
|
7018 (setq root (substring string 0 (match-end 0))
|
|
|
7019 start (match-end 0))
|
|
|
7020 (if (string-match "[^$]\\(\\$\\$\\)*\\$[^$]" root)
|
|
|
7021 (progn
|
|
|
7022 (setq rstart (1- (match-end 0))
|
|
|
7023 fudge-host-type t)
|
|
|
7024 (cond
|
|
|
7025 ((eq (elt root rstart) ?{)
|
|
|
7026 (setq
|
|
|
7027 error
|
|
|
7028 (if (string-match "}" root rstart)
|
|
|
7029 (concat
|
|
|
7030 "Subsituting non-existent environment variable "
|
|
|
7031 (substring root (1+ rstart) (match-beginning 0)))
|
|
|
7032 "Missing \"}\" in environment-variable substitution")))
|
|
|
7033 ((eq (string-match "[A-Za-z0-9]+" root rstart) rstart)
|
|
|
7034 (setq
|
|
|
7035 error
|
|
|
7036 (concat
|
|
|
7037 "Subsituting non-existent environment variable "
|
|
|
7038 (substring root rstart (match-beginning 0)))))
|
|
|
7039 (t
|
|
|
7040 (setq
|
|
|
7041 error
|
|
|
7042 "Bad format environment-variable substitution")))))
|
|
|
7043 (setq root (efs-unquote-dollars root)
|
|
|
7044 parsed (efs-ftp-path root))
|
|
|
7045
|
|
|
7046 (if (and (not fudge-host-type)
|
|
|
7047 ;; This may trigger an FTP connection
|
|
|
7048 (memq (efs-host-type (car parsed) (nth 1 parsed))
|
|
|
7049 '(apollo-unix dumb-apollo-unix)))
|
|
|
7050 (setq regexp ".//+"
|
|
|
7051 backskip 2)
|
|
|
7052 (setq regexp "//+"
|
|
|
7053 backskip 1)))
|
|
|
7054 ;; no root, we're local
|
|
|
7055 (setq regexp lregexp
|
|
|
7056 backskip lbackskip))
|
|
|
7057
|
|
|
7058 ;; Now short-circuit in an apollo and efs sensitive way.
|
|
|
7059
|
|
|
7060 (while (cond ((string-match regexp string start)
|
|
|
7061 (setq start (- (match-end 0) backskip)))
|
|
|
7062 ((string-match "/~" string start)
|
|
|
7063 (setq start (1- (match-end 0)))))
|
|
|
7064
|
|
|
7065 (and root
|
|
|
7066 (null efs-short-circuit-to-remote-root)
|
|
|
7067 (setq root nil
|
|
|
7068 regexp lregexp
|
|
|
7069 backskip lbackskip)))
|
|
|
7070
|
|
|
7071 ;; If we still have a bad root, barf.
|
|
|
7072 (if (and root error) (error error))
|
|
|
7073
|
|
|
7074 ;; look for non-existent evironment variables in the path
|
|
|
7075
|
|
|
7076 (if (string-match
|
|
|
7077 "\\([^$]\\|^\\)\\(\\$\\$\\)*\\$\\([^$]\\|$\\)" string start)
|
|
|
7078 (progn
|
|
|
7079 (setq start (match-beginning 3))
|
|
|
7080 (cond
|
|
|
7081 ((eq (length string) start)
|
|
|
7082 (error "Empty string is an invalid environment variable"))
|
|
|
7083 ((eq (elt string start) ?{)
|
|
|
7084 (if (string-match "}" string start)
|
|
|
7085 (error
|
|
|
7086 "Subsituting non-existent environment variable %s"
|
|
|
7087 (substring string (1+ start) (match-end 0)))
|
|
|
7088 (error
|
|
|
7089 "Missing \"}\" in environment-variable substitution")))
|
|
|
7090 ((eq (string-match "[A-Za-z0-9]+" string start) start)
|
|
|
7091 (error
|
|
|
7092 "Subsituting non-existent environment variable %s"
|
|
|
7093 (substring string start (match-end 0))))
|
|
|
7094 (t
|
|
|
7095 (error
|
|
|
7096 "Bad format environment-variable substitution")))))
|
|
|
7097
|
|
|
7098 (if root
|
|
|
7099 (concat root
|
|
|
7100 (efs-unquote-dollars
|
|
|
7101 (if (zerop start)
|
|
|
7102 string
|
|
|
7103 (substring string start))))
|
|
|
7104 (efs-unquote-dollars
|
|
|
7105 (if (zerop start)
|
|
|
7106 string
|
|
|
7107 (substring string start)))))))
|
|
|
7108
|
|
|
7109 (defun efs-expand-file-name (name &optional default)
|
|
|
7110 "Documented as original."
|
|
|
7111 (let (s-c-res path host user host-type)
|
|
|
7112 (efs-save-match-data
|
|
|
7113 (or (file-name-absolute-p name)
|
|
|
7114 (setq name (concat
|
|
|
7115 (file-name-as-directory
|
|
|
7116 (or default default-directory))
|
|
|
7117 name)))
|
|
|
7118 (setq s-c-res (efs-short-circuit-file-name name)
|
|
|
7119 path (car s-c-res)
|
|
|
7120 host-type (nth 1 s-c-res)
|
|
|
7121 host (nth 2 s-c-res)
|
|
|
7122 user (nth 3 s-c-res))
|
|
|
7123 (cond ((string-match "^~[^/]*" path)
|
|
|
7124 (let ((start (match-end 0)))
|
|
|
7125 (setq path (concat
|
|
|
7126 (efs-expand-tilde
|
|
|
7127 (substring path 0 start)
|
|
|
7128 host-type host user)
|
|
|
7129 (substring path start)))))
|
|
|
7130 ((and host-type (not (file-name-absolute-p path)))
|
|
|
7131 ;; We expand the empty string to a directory.
|
|
|
7132 ;; This can be more efficient for filename
|
|
|
7133 ;; completion. It's also consistent with non-unix.
|
|
|
7134 (let ((tilde (efs-expand-tilde
|
|
|
7135 "~" host-type host user)))
|
|
|
7136 (if (string-equal tilde "/")
|
|
|
7137 (setq path (concat "/" path))
|
|
|
7138 (setq path (concat tilde "/" path))))))
|
|
|
7139
|
|
|
7140 (setq path (efs-de-dot-file-name path))
|
|
|
7141 (if host-type
|
|
|
7142 (format efs-path-format-string user host path)
|
|
|
7143 path))))
|
|
|
7144
|
|
|
7145 ;;;; ------------------------------------------------------------
|
|
|
7146 ;;;; Other functions for manipulating file names.
|
|
|
7147 ;;;; ------------------------------------------------------------
|
|
|
7148
|
|
|
7149 (defun efs-internal-file-name-extension (filename)
|
|
|
7150 ;; Returns the extension for file name FN.
|
|
|
7151 (save-match-data
|
|
|
7152 (let ((file (file-name-sans-versions (file-name-nondirectory filename))))
|
|
|
7153 (if (string-match "\\.[^.]*\\'" file)
|
|
|
7154 (substring file (match-beginning 0))
|
|
|
7155 ""))))
|
|
|
7156
|
|
|
7157 (defun efs-file-name-as-directory (name)
|
|
|
7158 ;; version of file-name-as-directory for remote files.
|
|
|
7159 ;; Usually just appends a / if there isn't one already.
|
|
|
7160 ;; For some systems, it may also remove .DIR like extensions.
|
|
|
7161 (let* ((parsed (efs-ftp-path name))
|
|
|
7162 (file (nth 2 parsed)))
|
|
|
7163 (if (string-equal file "")
|
|
|
7164 name
|
|
|
7165 (efs-internal-file-name-as-directory
|
|
|
7166 (efs-host-type (car parsed) (nth 1 parsed)) name))))
|
|
|
7167
|
|
|
7168 (efs-defun efs-internal-file-name-as-directory nil (name)
|
|
|
7169 ;; By default, simply adds a trailing /, if there isn't one.
|
|
|
7170 ;; Note that for expanded filenames, it pays to call this rather
|
|
|
7171 ;; than efs-file-name-as-directory.
|
|
|
7172 (let (file-name-handler-alist)
|
|
|
7173 (file-name-as-directory name)))
|
|
|
7174
|
|
|
7175 (defun efs-file-name-directory (name)
|
|
|
7176 ;; file-name-directory for remote files. Takes care not to
|
|
|
7177 ;; turn /user@host: into /.
|
|
|
7178 (let ((path (nth 2 (efs-ftp-path name)))
|
|
|
7179 file-name-handler-alist)
|
|
|
7180 (if (or (string-equal path "")
|
|
|
7181 (and (= (string-to-char path) ?~)
|
|
|
7182 (not
|
|
|
7183 (efs-save-match-data
|
|
|
7184 (string-match "/" path 1)))))
|
|
|
7185 name
|
|
|
7186 (if (efs-save-match-data
|
|
|
7187 (not (string-match "/" path)))
|
|
|
7188 (efs-replace-path-component name "")
|
|
|
7189 (file-name-directory name)))))
|
|
|
7190
|
|
|
7191 (defun efs-file-name-nondirectory (name)
|
|
|
7192 ;; Computes file-name-nondirectory for remote files.
|
|
|
7193 ;; For expanded filenames, can just call efs-internal-file-name-nondirectory.
|
|
|
7194 (let ((file (nth 2 (efs-ftp-path name))))
|
|
|
7195 (if (or (string-equal file "")
|
|
|
7196 (and (= (string-to-char file) ?~)
|
|
|
7197 (not
|
|
|
7198 (efs-save-match-data
|
|
|
7199 (string-match "/" file 1)))))
|
|
|
7200 ""
|
|
|
7201 (if (efs-save-match-data
|
|
|
7202 (not (string-match "/" file)))
|
|
|
7203 file
|
|
|
7204 (efs-internal-file-name-nondirectory name)))))
|
|
|
7205
|
|
|
7206 (defun efs-internal-file-name-nondirectory (name)
|
|
|
7207 ;; Version of file-name-nondirectory, without the efs-file-handler-function.
|
|
|
7208 ;; Useful to call this, if we have already decomposed the filename.
|
|
|
7209 (let (file-name-handler-alist)
|
|
|
7210 (file-name-nondirectory name)))
|
|
|
7211
|
|
|
7212 (defun efs-directory-file-name (dir)
|
|
|
7213 ;; Computes directory-file-name for remote files.
|
|
|
7214 ;; Needs to be careful not to turn /foo@bar:/ into /foo@bar:
|
|
|
7215 (let ((parsed (efs-ftp-path dir)))
|
|
|
7216 (if (string-equal "/" (nth 2 parsed))
|
|
|
7217 dir
|
|
|
7218 (efs-internal-directory-file-name dir))))
|
|
|
7219
|
|
|
7220 (defun efs-internal-directory-file-name (dir)
|
|
|
7221 ;; Call this if you want to apply directory-file-name to the remote
|
|
|
7222 ;; part of a efs-style path. Don't call for non-efs-style paths,
|
|
|
7223 ;; as this short-circuits the file-name-handler-alist completely.
|
|
|
7224 (let (file-name-handler-alist)
|
|
|
7225 (directory-file-name dir)))
|
|
|
7226
|
|
|
7227 (efs-defun efs-remote-directory-file-name nil (dir)
|
|
|
7228 "Returns the file name on the remote system of directory DIR.
|
|
|
7229 If the remote system is not unix, this may not be the same as the file name
|
|
|
7230 of the directory in efs's internal cache."
|
|
|
7231 (directory-file-name dir))
|
|
|
7232
|
|
|
7233 (defun efs-file-name-sans-versions (filename &optional keep-backup-versions)
|
|
|
7234 ;; Version of file-name-sans-versions for remote files.
|
|
|
7235 (or (file-name-absolute-p filename)
|
|
|
7236 (setq filename (expand-file-name filename)))
|
|
|
7237 (let ((parsed (efs-ftp-path filename)))
|
|
|
7238 (efs-internal-file-name-sans-versions
|
|
|
7239 (efs-host-type (car parsed) (nth 1 parsed))
|
|
|
7240 filename keep-backup-versions)))
|
|
|
7241
|
|
|
7242 (efs-defun efs-internal-file-name-sans-versions nil
|
|
|
7243 (filename &optional keep-backup-versions)
|
|
|
7244 (let (file-name-handler-alist)
|
|
|
7245 (file-name-sans-versions filename keep-backup-versions)))
|
|
|
7246
|
|
|
7247 (defun efs-diff-latest-backup-file (fn)
|
|
|
7248 ;; Version of diff latest backup file for remote files.
|
|
|
7249 ;; Accomodates non-unix.
|
|
|
7250 ;; Returns the latest backup for fn, according to the numbering
|
|
|
7251 ;; of the backups. Does not check file-newer-than-file-p.
|
|
|
7252 (let ((parsed (efs-ftp-path fn)))
|
|
|
7253 (efs-internal-diff-latest-backup-file
|
|
|
7254 (efs-host-type (car parsed) (nth 1 parsed)) fn)))
|
|
|
7255
|
|
|
7256 (efs-defun efs-internal-diff-latest-backup-file nil (fn)
|
|
|
7257 ;; Default behaviour is the behaviour in diff.el
|
|
|
7258 (let (file-name-handler-alist)
|
|
|
7259 (diff-latest-backup-file fn)))
|
|
|
7260
|
|
|
7261 (defun efs-unhandled-file-name-directory (filename)
|
|
|
7262 ;; Calculate a default unhandled directory for an efs buffer.
|
|
|
7263 ;; This is used to compute directories in which to execute
|
|
|
7264 ;; processes. This is relevant to V19 only. Doesn't do any harm for
|
|
|
7265 ;; older versions though. It would be nice if this wasn't such a
|
|
|
7266 ;; kludge.
|
|
|
7267 (file-name-directory efs-tmp-name-template))
|
|
|
7268
|
|
|
7269 (defun efs-file-truename (filename)
|
|
|
7270 ;; Calculates a remote file's truename, if this isn't inhibited.
|
|
|
7271 (let ((filename (expand-file-name filename)))
|
|
|
7272 (if (and efs-compute-remote-buffer-file-truename
|
|
|
7273 (memq (efs-host-type (car (efs-ftp-path filename)))
|
|
|
7274 efs-unix-host-types))
|
|
|
7275 (efs-internal-file-truename filename)
|
|
|
7276 filename)))
|
|
|
7277
|
|
|
7278 (defun efs-internal-file-truename (filename)
|
|
|
7279 ;; Internal function so that we don't keep checking
|
|
|
7280 ;; efs-compute-remote-buffer-file-truename, etc, as we recurse.
|
|
|
7281 (let ((dir (efs-file-name-directory filename))
|
|
|
7282 target dirfile)
|
|
|
7283 ;; Get the truename of the directory.
|
|
|
7284 (setq dirfile (efs-directory-file-name dir))
|
|
|
7285 ;; If these are equal, we have the (or a) root directory.
|
|
|
7286 (or (string= dir dirfile)
|
|
|
7287 (setq dir (efs-file-name-as-directory
|
|
|
7288 (efs-internal-file-truename dirfile))))
|
|
|
7289 (if (equal ".." (efs-file-name-nondirectory filename))
|
|
|
7290 (efs-directory-file-name (efs-file-name-directory
|
|
|
7291 (efs-directory-file-name dir)))
|
|
|
7292 (if (equal "." (efs-file-name-nondirectory filename))
|
|
|
7293 (efs-directory-file-name dir)
|
|
|
7294 ;; Put it back on the file name.
|
|
|
7295 (setq filename (concat dir (efs-file-name-nondirectory filename)))
|
|
|
7296 ;; Is the file name the name of a link?
|
|
|
7297 (setq target (efs-file-symlink-p filename))
|
|
|
7298 (if target
|
|
|
7299 ;; Yes => chase that link, then start all over
|
|
|
7300 ;; since the link may point to a directory name that uses links.
|
|
|
7301 ;; We can't safely use expand-file-name here
|
|
|
7302 ;; since target might look like foo/../bar where foo
|
|
|
7303 ;; is itself a link. Instead, we handle . and .. above.
|
|
|
7304 (if (file-name-absolute-p target)
|
|
|
7305 (efs-internal-file-truename target)
|
|
|
7306 (efs-internal-file-truename (concat dir target)))
|
|
|
7307 ;; No, we are done!
|
|
|
7308 filename)))))
|
|
|
7309
|
|
|
7310
|
|
|
7311 ;;;; ----------------------------------------------------------------
|
|
|
7312 ;;;; I/O functions
|
|
|
7313 ;;;; ----------------------------------------------------------------
|
|
|
7314
|
|
|
7315 (efs-define-fun efs-set-buffer-file-name (filename)
|
|
|
7316 ;; Sets the buffer local variables for filename appropriately.
|
|
|
7317 ;; A special function because Lucid and FSF do this differently.
|
|
|
7318 ;; This default behaviour is the lowest common denominator.
|
|
|
7319 (setq buffer-file-name filename))
|
|
|
7320
|
|
|
7321 (defun efs-write-region (start end filename &optional append visit &rest args)
|
|
|
7322 ;; write-region for remote files.
|
|
|
7323 ;; This version accepts the V19 interpretation for the arg VISIT.
|
|
|
7324 ;; However, making use of this within V18 may cause errors to crop up.
|
|
|
7325 ;; ARGS should catch the MULE coding-system argument.
|
|
|
7326 (if (stringp visit) (setq visit (expand-file-name visit)))
|
|
|
7327 (setq filename (expand-file-name filename))
|
|
|
7328 (let ((parsed (efs-ftp-path filename))
|
|
|
7329 ;; Make sure that the after-write-region-hook isn't called inside
|
|
|
7330 ;; the file-handler-alist
|
|
|
7331 (after-write-region-hook nil))
|
|
|
7332 (if parsed
|
|
|
7333 (let* ((host (car parsed))
|
|
|
7334 (user (nth 1 parsed))
|
|
|
7335 (host-type (efs-host-type host user))
|
|
|
7336 (temp (car (efs-make-tmp-name nil host)))
|
|
|
7337 (type (efs-xfer-type nil nil host-type filename))
|
|
|
7338 (abbr (and (or (stringp visit) (eq t visit) (null visit))
|
|
|
7339 (efs-relativize-filename
|
|
|
7340 (if (stringp visit) visit filename))))
|
|
|
7341 (buffer (current-buffer))
|
|
|
7342 (b-file-name buffer-file-name)
|
|
|
7343 (mod-p (buffer-modified-p)))
|
|
|
7344 (unwind-protect
|
|
|
7345 (progn
|
|
|
7346 (condition-case err
|
|
|
7347 (progn
|
|
|
7348 (unwind-protect
|
|
|
7349 (let ((executing-macro t))
|
|
|
7350 ;; let-bind executing-macro to inhibit messaging.
|
|
|
7351 ;; Setting VISIT to 'quiet is more elegant.
|
|
|
7352 ;; But in Emacs 18, doing it this way allows
|
|
|
7353 ;; us to modify the visited file modtime, so
|
|
|
7354 ;; that undo's show the buffer modified.
|
|
|
7355 (apply 'write-region start end
|
|
|
7356 temp nil visit args))
|
|
|
7357 ;; buffer-modified-p is now correctly set
|
|
|
7358 (setq buffer-file-name b-file-name)
|
|
|
7359 ;; File modtime is bogus, so clear.
|
|
|
7360 (clear-visited-file-modtime))
|
|
|
7361 (efs-copy-file-internal
|
|
|
7362 temp nil filename parsed (if append 'append t)
|
|
|
7363 nil (and abbr (format "Writing %s" abbr))
|
|
|
7364 ;; cont
|
|
|
7365 (efs-cont (result line cont-lines) (filename buffer
|
|
|
7366 visit)
|
|
|
7367 (if result
|
|
|
7368 (signal 'ftp-error
|
|
|
7369 (list "Opening output file"
|
|
|
7370 (format "FTP Error: \"%s\"" line)
|
|
|
7371 filename)))
|
|
|
7372 ;; The new file entry will be added by
|
|
|
7373 ;; efs-copy-file-internal.
|
|
|
7374 (cond
|
|
|
7375 ((eq visit t)
|
|
|
7376 ;; This will run asynch.
|
|
|
7377 (efs-save-buffer-excursion
|
|
|
7378 (set-buffer buffer)
|
|
|
7379 (efs-set-buffer-file-name filename)
|
|
|
7380 (efs-set-visited-file-modtime)))
|
|
|
7381 ((stringp visit)
|
|
|
7382 (efs-save-buffer-excursion
|
|
|
7383 (set-buffer buffer)
|
|
|
7384 (efs-set-buffer-file-name visit)
|
|
|
7385 (set-visited-file-modtime)))))
|
|
|
7386 nil type))
|
|
|
7387 (error
|
|
|
7388 ;; restore buffer-modified-p
|
|
|
7389 (let (file-name-handler-alist)
|
|
|
7390 (set-buffer-modified-p mod-p))
|
|
|
7391 (signal (car err) (cdr err))))
|
|
|
7392 (if (or (eq visit t)
|
|
|
7393 (and (stringp visit)
|
|
|
7394 (efs-ftp-path visit)))
|
|
|
7395 (efs-set-buffer-mode)))
|
|
|
7396 (efs-del-tmp-name temp))
|
|
|
7397 (and abbr (efs-message "Wrote %s" abbr)))
|
|
|
7398 (if (and (stringp visit) (efs-ftp-path visit))
|
|
|
7399 (progn
|
|
|
7400 (apply 'write-region start end filename append visit args)
|
|
|
7401 (efs-set-buffer-file-name visit)
|
|
|
7402 (efs-set-visited-file-modtime)
|
|
|
7403 (efs-set-buffer-mode))
|
|
|
7404 (error "efs-write-region called for a local file")))))
|
|
|
7405
|
|
|
7406 (defun efs-insert-file-contents (filename &optional visit &rest args)
|
|
|
7407 ;; Inserts file contents for remote files.
|
|
|
7408 ;; The additional ARGS covers V19 BEG and END. Should also handle the
|
|
|
7409 ;; CODING-SYSTEM arg for mule. Hope the two don't trip over each other.
|
|
|
7410 (barf-if-buffer-read-only)
|
|
|
7411 (unwind-protect
|
|
|
7412 (let* ((filename (expand-file-name filename))
|
|
|
7413 (parsed (efs-ftp-path filename))
|
|
|
7414 (host (car parsed))
|
|
|
7415 (host-type (efs-host-type host))
|
|
|
7416 (user (nth 1 parsed))
|
|
|
7417 (path (nth 2 parsed))
|
|
|
7418 (buffer (current-buffer)))
|
|
|
7419
|
|
|
7420 (if (or (file-exists-p filename)
|
|
|
7421 (let* ((res (and
|
|
|
7422 (not (efs-get-host-property host 'rnfr-failed))
|
|
|
7423 (efs-send-cmd
|
|
|
7424 host user (list 'quote 'rnfr path))))
|
|
|
7425 (line (nth 1 res)))
|
|
|
7426 ;; RNFR returns a 550 if the file doesn't exist.
|
|
|
7427 (if (and line (>= (length line) 4)
|
|
|
7428 (string-equal "550 " (substring line 0 4)))
|
|
|
7429 nil
|
|
|
7430 (if (car res) (efs-set-host-property host 'rnfr-failed t))
|
|
|
7431 (efs-del-from-ls-cache filename t nil)
|
|
|
7432 (efs-del-hash-entry
|
|
|
7433 (efs-canonize-file-name (file-name-directory filename))
|
|
|
7434 efs-files-hashtable)
|
|
|
7435 (file-exists-p filename))))
|
|
|
7436
|
|
|
7437 (let ((temp (concat
|
|
|
7438 (car (efs-make-tmp-name nil host))
|
|
|
7439 (efs-internal-file-name-extension filename)))
|
|
|
7440 (type (efs-xfer-type host-type filename nil nil))
|
|
|
7441 (abbr (efs-relativize-filename filename))
|
|
|
7442 (i-f-c-size 0))
|
|
|
7443
|
|
|
7444 (unwind-protect
|
|
|
7445 (efs-copy-file-internal
|
|
|
7446 filename parsed temp nil t nil
|
|
|
7447 (format "Retrieving %s" abbr)
|
|
|
7448 (efs-cont (result line cont-lines) (filename visit buffer
|
|
|
7449 host-type
|
|
|
7450 temp args)
|
|
|
7451 (if result
|
|
|
7452 (signal 'ftp-error
|
|
|
7453 (list "Opening input file"
|
|
|
7454 (format "FTP Error: \"%s\""
|
|
|
7455 line)
|
|
|
7456 filename))
|
|
|
7457 (if (eq host-type 'coke)
|
|
|
7458 (efs-coke-insert-beverage-contents buffer filename
|
|
|
7459 line)
|
|
|
7460 (efs-save-buffer-excursion
|
|
|
7461 (set-buffer buffer)
|
|
|
7462 (if (or (file-readable-p temp)
|
|
|
7463 (sleep-for efs-retry-time)
|
|
|
7464 ;; Wait for file to hopefully appear.
|
|
|
7465 (file-readable-p temp))
|
|
|
7466
|
|
|
7467 (setq i-f-c-size
|
|
|
7468 (nth 1 (apply 'insert-file-contents
|
|
|
7469 temp visit args)))
|
|
|
7470 (signal 'ftp-error
|
|
|
7471 (list
|
|
|
7472 "Opening input file:"
|
|
|
7473 (format
|
|
|
7474 "FTP Error: %s not arrived or readable"
|
|
|
7475 filename))))
|
|
|
7476 ;; This is done asynch
|
|
|
7477 (if visit
|
|
|
7478 (let ((buffer-file-name filename))
|
|
|
7479 (efs-set-visited-file-modtime)))))))
|
|
|
7480 nil type)
|
|
|
7481 (efs-del-tmp-name temp))
|
|
|
7482 ;; Return (FILENAME SIZE)
|
|
|
7483 (list filename i-f-c-size))
|
|
|
7484 (signal 'file-error (list "Opening input file" filename))))
|
|
|
7485 ;; Set buffer-file-name at the very last, so if anything bombs, we're
|
|
|
7486 ;; not visiting.
|
|
|
7487 (if visit
|
|
|
7488 (efs-set-buffer-file-name filename))))
|
|
|
7489
|
|
|
7490 (defun efs-revert-buffer (arg noconfirm)
|
|
|
7491 "Revert this buffer from a remote file using ftp."
|
|
|
7492 (let ((opoint (point)))
|
|
|
7493 (cond ((null buffer-file-name)
|
|
|
7494 (error "Buffer does not seem to be associated with any file"))
|
|
|
7495 ((or noconfirm
|
|
|
7496 (yes-or-no-p (format "Revert buffer from file %s? "
|
|
|
7497 buffer-file-name)))
|
|
|
7498 (let ((buffer-read-only nil))
|
|
|
7499 ;; Set buffer-file-name to nil
|
|
|
7500 ;; so that we don't try to lock the file.
|
|
|
7501 (let ((buffer-file-name nil))
|
|
|
7502 (unlock-buffer)
|
|
|
7503 (erase-buffer))
|
|
|
7504 (insert-file-contents buffer-file-name t))
|
|
|
7505 (goto-char (min opoint (point-max)))
|
|
|
7506 (after-find-file nil)
|
|
|
7507 t))))
|
|
|
7508
|
|
|
7509 (defun efs-recover-file (file)
|
|
|
7510 ;; Version of recover file for remote files, and remote autosave files too.
|
|
|
7511 (if (auto-save-file-name-p file) (error "%s is an auto-save file" file))
|
|
|
7512 (let* ((file-name (let ((buffer-file-name file)) (make-auto-save-file-name)))
|
|
|
7513 (file-name-parsed (efs-ftp-path file-name))
|
|
|
7514 (file-parsed (efs-ftp-path file))
|
|
|
7515 (efs-ls-uncache t))
|
|
|
7516 (cond ((not (file-newer-than-file-p file-name file))
|
|
|
7517 (error "Auto-save file %s not current" file-name))
|
|
|
7518 ((save-window-excursion
|
|
|
7519 (or (eq system-type 'vax-vms)
|
|
|
7520 (progn
|
|
|
7521 (with-output-to-temp-buffer "*Directory*"
|
|
|
7522 (buffer-disable-undo standard-output)
|
|
|
7523 (if file-parsed
|
|
|
7524 (progn
|
|
|
7525 (princ (format "On the host %s:\n"
|
|
|
7526 (car file-parsed)))
|
|
|
7527 (princ
|
|
|
7528 (let ((default-directory exec-directory))
|
|
|
7529 (efs-ls file (if (file-symlink-p file)
|
|
|
7530 "-lL" "-l")
|
|
|
7531 t t))))
|
|
|
7532 (princ "On the local host:\n")
|
|
|
7533 (let ((default-directory exec-directory))
|
|
|
7534 (call-process "ls" nil standard-output nil
|
|
|
7535 (if (file-symlink-p file) "-lL" "-l")
|
|
|
7536 file)))
|
|
|
7537 (princ "\nAUTO SAVE FILE on the ")
|
|
|
7538 (if file-name-parsed
|
|
|
7539 (progn
|
|
|
7540 (princ (format "host %s:\n"
|
|
|
7541 (car file-name-parsed)))
|
|
|
7542 (princ
|
|
|
7543 (efs-ls file-name
|
|
|
7544 (if (file-symlink-p file-name) "-lL" "-l")
|
|
|
7545 t t)))
|
|
|
7546 (princ "local host:\n")
|
|
|
7547 (let ((default-directory exec-directory))
|
|
|
7548 (call-process "ls" nil standard-output nil
|
|
|
7549 "-l" file-name)))
|
|
|
7550 (princ "\nFile modification times are given in ")
|
|
|
7551 (princ "the local time of each host.\n"))
|
|
|
7552 (save-excursion
|
|
|
7553 (set-buffer "*Directory*")
|
|
|
7554 (goto-char (point-min))
|
|
|
7555 (while (not (eobp))
|
|
|
7556 (end-of-line)
|
|
|
7557 (if (> (current-column) (window-width))
|
|
|
7558 (progn
|
|
|
7559 (skip-chars-backward " \t")
|
|
|
7560 (skip-chars-backward "^ \t\n")
|
|
|
7561 (if (> (current-column) 12)
|
|
|
7562 (progn
|
|
|
7563 (delete-horizontal-space)
|
|
|
7564 (insert "\n ")))))
|
|
|
7565 (forward-line 1))
|
|
|
7566 (set-buffer-modified-p nil)
|
|
|
7567 (goto-char (point-min)))))
|
|
|
7568 (yes-or-no-p (format "Recover using this auto save file? ")))
|
|
|
7569 (switch-to-buffer (find-file-noselect file t))
|
|
|
7570 (let ((buffer-read-only nil))
|
|
|
7571 (erase-buffer)
|
|
|
7572 (insert-file-contents file-name nil))
|
|
|
7573 (after-find-file nil))
|
|
|
7574 (t (error "Recover-file cancelled."))))
|
|
|
7575 ;; This is no longer done in V19. However, I like the caution for
|
|
|
7576 ;; remote files, where file-newer-than-file-p may lie.
|
|
|
7577 (setq buffer-auto-save-file-name nil)
|
|
|
7578 (message "Auto-save off in this buffer till you do M-x auto-save-mode."))
|
|
|
7579
|
|
|
7580 ;;;; ------------------------------------------------------------------
|
|
|
7581 ;;;; Attributes of files.
|
|
|
7582 ;;;; ------------------------------------------------------------------
|
|
|
7583
|
|
|
7584 (defun efs-file-symlink-p (file)
|
|
|
7585 ;; Version of file-symlink-p for remote files.
|
|
|
7586 ;; Call efs-expand-file-name rather than the normal
|
|
|
7587 ;; expand-file-name to stop loops when using a package that
|
|
|
7588 ;; redefines both file-symlink-p and expand-file-name.
|
|
|
7589 ;; Do not use efs-get-file-entry, because a child-lookup won't do.
|
|
|
7590 (let* ((file (efs-expand-file-name file))
|
|
|
7591 (ignore-case (memq (efs-host-type (car (efs-ftp-path file)))
|
|
|
7592 efs-case-insensitive-host-types))
|
|
|
7593 (file-type (car (efs-get-hash-entry
|
|
|
7594 (efs-get-file-part file)
|
|
|
7595 (efs-get-files (file-name-directory file))
|
|
|
7596 ignore-case))))
|
|
|
7597 (and (stringp file-type)
|
|
|
7598 (if (file-name-absolute-p file-type)
|
|
|
7599 (efs-replace-path-component file file-type)
|
|
|
7600 file-type))))
|
|
|
7601
|
|
|
7602 (defun efs-file-exists-p (path)
|
|
|
7603 ;; file-exists-p for remote file. Uses the cache if possible.
|
|
|
7604 (let* ((path (expand-file-name path))
|
|
|
7605 (parsed (efs-ftp-path path)))
|
|
|
7606 (efs-internal-file-exists-p (efs-host-type (car parsed) (nth 1 parsed))
|
|
|
7607 path)))
|
|
|
7608
|
|
|
7609 (efs-defun efs-internal-file-exists-p nil (path)
|
|
|
7610 (and (efs-get-file-entry path) t))
|
|
|
7611
|
|
|
7612 (defun efs-file-directory-p (file)
|
|
|
7613 (let* ((file (expand-file-name file))
|
|
|
7614 (parsed (efs-ftp-path file)))
|
|
|
7615 (efs-internal-file-directory-p (efs-host-type (car parsed) (nth 1 parsed))
|
|
|
7616 file)))
|
|
|
7617
|
|
|
7618 (efs-defun efs-internal-file-directory-p nil (path)
|
|
|
7619 ;; Version of file-directory-p for remote files.
|
|
|
7620 (let ((parsed (efs-ftp-path path)))
|
|
|
7621 (or (string-equal (nth 2 parsed) "/") ; root is always a directory
|
|
|
7622 (let ((file-ent (car (efs-get-file-entry
|
|
|
7623 (efs-internal-file-name-as-directory
|
|
|
7624 (efs-host-type (car parsed) (nth 1 parsed))
|
|
|
7625 path)))))
|
|
|
7626 ;; We do a file-name-as-directory on path here because some
|
|
|
7627 ;; machines (VMS) use a .DIR to indicate the filename associated
|
|
|
7628 ;; with a directory. This needs to be canonicalized.
|
|
|
7629 (if (stringp file-ent)
|
|
|
7630 (efs-internal-file-directory-p
|
|
|
7631 nil
|
|
|
7632 (efs-chase-symlinks
|
|
|
7633 ;; efs-internal-directory-file-name
|
|
|
7634 ;; only loses for paths where the remote file
|
|
|
7635 ;; is /. This has been eliminated.
|
|
|
7636 (efs-internal-directory-file-name path)))
|
|
|
7637 file-ent)))))
|
|
|
7638
|
|
|
7639 (defun efs-file-attributes (file)
|
|
|
7640 ;; Returns file-file-attributes for a remote file.
|
|
|
7641 ;; For the file modtime does not return efs's cached value, as that
|
|
|
7642 ;; corresponds to buffer-file-modtime (i.e. the modtime of the file
|
|
|
7643 ;; the last time the buffer was vsisted or saved). Caching modtimes
|
|
|
7644 ;; does not make much sense, as they are usually used to determine
|
|
|
7645 ;; if a cache is stale. The modtime if a remote file can be obtained with
|
|
|
7646 ;; efs-get-file-mdtm. This is _not_ returned for the 5th entry here,
|
|
|
7647 ;; because it requires an FTP transaction, and a priori we don't know
|
|
|
7648 ;; if the caller actually cares about this info. Having file-attributes
|
|
|
7649 ;; return such a long list of info is not well suited to remote files,
|
|
|
7650 ;; as some of this info may be costly to obtain.
|
|
|
7651 (let* ((file (expand-file-name file))
|
|
|
7652 (ent (efs-get-file-entry file)))
|
|
|
7653 (if ent
|
|
|
7654 (let* ((parsed (efs-ftp-path file))
|
|
|
7655 (host (nth 0 parsed))
|
|
|
7656 (user (nth 1 parsed))
|
|
|
7657 (path (nth 2 parsed))
|
|
|
7658 (type (car ent))
|
|
|
7659 (size (or (nth 1 ent) -1))
|
|
|
7660 (owner (nth 2 ent))
|
|
|
7661 (modes (nth 3 ent))
|
|
|
7662 ;; Hack to give remote files a "unique" "inode number".
|
|
|
7663 ;; It's actually the sum of the characters in its name.
|
|
|
7664 ;; It's not even really unique.
|
|
|
7665 (inode (apply '+
|
|
|
7666 (nconc (mapcar 'identity host)
|
|
|
7667 (mapcar 'identity user)
|
|
|
7668 (mapcar 'identity
|
|
|
7669 (efs-internal-directory-file-name
|
|
|
7670 path)))))
|
|
|
7671 (nlinks (or (nth 4 ent) -1))) ; return -1 if we don't know
|
|
|
7672 (list
|
|
|
7673 (if (and (stringp type) (file-name-absolute-p type))
|
|
|
7674 (efs-replace-path-component file type)
|
|
|
7675 type) ;0 file type
|
|
|
7676 nlinks ;1 link count
|
|
|
7677 (if owner ;2 uid
|
|
|
7678 ;; Not really a unique integer,
|
|
|
7679 ;; just a half-hearted attempt
|
|
|
7680 (apply '+ (mapcar 'identity owner))
|
|
|
7681 -1)
|
|
|
7682 -1 ;3 gid
|
|
|
7683 '(0 0) ;4 atime
|
|
|
7684 '(0 0) ;5 mtime
|
|
|
7685 '(0 0) ;6 ctime
|
|
|
7686 size ;7 size
|
|
|
7687 (or modes ;8 mode
|
|
|
7688 (concat
|
|
|
7689 (cond ((stringp type) "l")
|
|
|
7690 (type "d")
|
|
|
7691 (t "-"))
|
|
|
7692 "?????????"))
|
|
|
7693 nil ;9 gid weird (Who knows if the gid
|
|
|
7694 ; would be changed?)
|
|
|
7695 inode ;10 inode
|
|
|
7696 -1 ;11 device number [v19 only]
|
|
|
7697 )))))
|
|
|
7698
|
|
|
7699 (defun efs-file-writable-p (file)
|
|
|
7700 ;; file-writable-p for remote files.
|
|
|
7701 ;; Does not attempt to open the file, but just looks at the cached file
|
|
|
7702 ;; modes.
|
|
|
7703 (let* ((file (expand-file-name file))
|
|
|
7704 (ent (efs-get-file-entry file)))
|
|
|
7705 (if (and ent (or (not (stringp (car ent)))
|
|
|
7706 (setq file (efs-chase-symlinks file)
|
|
|
7707 ent (efs-get-file-entry file))))
|
|
|
7708 (let* ((owner (nth 2 ent))
|
|
|
7709 (modes (nth 3 ent))
|
|
|
7710 (parsed (efs-ftp-path file))
|
|
|
7711 (host-type (efs-host-type (car parsed)))
|
|
|
7712 (user (nth 1 parsed)))
|
|
|
7713 (if (memq host-type efs-unix-host-types)
|
|
|
7714 (setq host-type 'unix))
|
|
|
7715 (efs-internal-file-writable-p host-type user owner modes))
|
|
|
7716 (let ((dir (file-name-directory file)))
|
|
|
7717 (and
|
|
|
7718 (not (string-equal dir file))
|
|
|
7719 (file-directory-p dir)
|
|
|
7720 (file-writable-p dir))))))
|
|
|
7721
|
|
|
7722 (efs-defun efs-internal-file-writable-p nil (user owner modes)
|
|
|
7723 ;; By default, we'll just guess yes.
|
|
|
7724 t)
|
|
|
7725
|
|
|
7726 (efs-defun efs-internal-file-writable-p unix (user owner modes)
|
|
|
7727 (if (and modes
|
|
|
7728 (not (string-equal user "root")))
|
|
|
7729 (null
|
|
|
7730 (null
|
|
|
7731 (if (string-equal user owner)
|
|
|
7732 (memq ?w (list (aref modes 2) (aref modes 5)
|
|
|
7733 (aref modes 8)))
|
|
|
7734 (memq ?w (list (aref modes 5) (aref modes 8))))))
|
|
|
7735 t)) ; guess
|
|
|
7736
|
|
|
7737 (defun efs-file-readable-p (file)
|
|
|
7738 ;; Version of file-readable-p that works for remote files.
|
|
|
7739 ;; Works by checking efs's cache of the file modes.
|
|
|
7740 (let* ((file (expand-file-name file))
|
|
|
7741 (ent (efs-get-file-entry file)))
|
|
|
7742 (and ent
|
|
|
7743 (or (not (stringp (car ent)))
|
|
|
7744 (setq ent (efs-get-file-entry (efs-chase-symlinks file))))
|
|
|
7745 ;; file exists
|
|
|
7746 (let* ((parsed (efs-ftp-path file))
|
|
|
7747 (owner (nth 2 ent))
|
|
|
7748 (modes (nth 3 ent))
|
|
|
7749 (host-type (efs-host-type (car parsed)))
|
|
|
7750 (user (nth 1 parsed)))
|
|
|
7751 (if (memq host-type efs-unix-host-types)
|
|
|
7752 (setq host-type 'unix))
|
|
|
7753 (efs-internal-file-readable-p host-type user owner modes)))))
|
|
|
7754
|
|
|
7755 (efs-defun efs-internal-file-readable-p nil (user owner modes)
|
|
|
7756 ;; Guess t by default
|
|
|
7757 t)
|
|
|
7758
|
|
|
7759 (efs-defun efs-internal-file-readable-p unix (user owner modes)
|
|
|
7760 (if (and modes
|
|
|
7761 (not (string-equal user "root")))
|
|
|
7762 (null
|
|
|
7763 (null
|
|
|
7764 (if (string-equal user owner)
|
|
|
7765 (memq ?r (list (aref modes 1) (aref modes 4)
|
|
|
7766 (aref modes 7)))
|
|
|
7767 (memq ?r (list (aref modes 4) (aref modes 7))))))
|
|
|
7768 t)) ; guess
|
|
|
7769
|
|
|
7770 (defun efs-file-executable-p (file)
|
|
|
7771 ;; Version of file-executable-p for remote files.
|
|
|
7772 (let ((ent (efs-get-file-entry file)))
|
|
|
7773 (and ent
|
|
|
7774 (or (not (stringp (car ent)))
|
|
|
7775 (setq ent (efs-get-file-entry (efs-chase-symlinks file))))
|
|
|
7776 ;; file exists
|
|
|
7777 (let* ((parsed (efs-ftp-path file))
|
|
|
7778 (owner (nth 2 ent))
|
|
|
7779 (modes (nth 3 ent))
|
|
|
7780 (host-type (efs-host-type (car parsed)))
|
|
|
7781 (user (nth 1 parsed)))
|
|
|
7782 (if (memq host-type efs-unix-host-types)
|
|
|
7783 (setq host-type 'unix))
|
|
|
7784 (efs-internal-file-executable-p host-type user owner modes)))))
|
|
|
7785
|
|
|
7786 (efs-defun efs-internal-file-executable-p nil (user owner modes)
|
|
|
7787 ;; Guess t by default
|
|
|
7788 t)
|
|
|
7789
|
|
|
7790 (efs-defun efs-internal-file-executable-p unix (user owner modes)
|
|
|
7791 (if (and modes
|
|
|
7792 (not (string-equal user "root")))
|
|
|
7793 (null
|
|
|
7794 (null
|
|
|
7795 (if (string-equal user owner)
|
|
|
7796 (memq ?x (list (aref modes 3) (aref modes 6)
|
|
|
7797 (aref modes 9)))
|
|
|
7798 (memq ?x (list (aref modes 6) (aref modes 9))))))
|
|
|
7799 t)) ; guess
|
|
|
7800
|
|
|
7801 (defun efs-file-accessible-directory-p (dir)
|
|
|
7802 ;; Version of file-accessible-directory-p for remote directories.
|
|
|
7803 (let ((file (directory-file-name dir)))
|
|
|
7804 (and (efs-file-directory-p file) (efs-file-executable-p file))))
|
|
|
7805
|
|
|
7806 ;;;; --------------------------------------------------------------
|
|
|
7807 ;;;; Listing directories.
|
|
|
7808 ;;;; --------------------------------------------------------------
|
|
|
7809
|
|
|
7810 (defun efs-shell-regexp-to-regexp (regexp)
|
|
|
7811 ;; Converts a shell regexp to an emacs regexp.
|
|
|
7812 ;; Probably full of bugs. Tries to follow csh globbing.
|
|
|
7813 (let ((curly 0)
|
|
|
7814 backslash)
|
|
|
7815 (concat "^"
|
|
|
7816 (mapconcat
|
|
|
7817 (function
|
|
|
7818 (lambda (char)
|
|
|
7819 (cond
|
|
|
7820 (backslash
|
|
|
7821 (setq backslash nil)
|
|
|
7822 (regexp-quote (char-to-string char)))
|
|
|
7823 ((and (> curly 0) (eq char ?,))
|
|
|
7824 "\\|")
|
|
|
7825 ((memq char '(?[ ?]))
|
|
|
7826 (char-to-string char))
|
|
|
7827 ((eq char ??)
|
|
|
7828 ".")
|
|
|
7829 ((eq char ?\\)
|
|
|
7830 (setq backslash t)
|
|
|
7831 "")
|
|
|
7832 ((eq char ?*)
|
|
|
7833 ".*")
|
|
|
7834 ((eq char ?{)
|
|
|
7835 (setq curly (1+ curly))
|
|
|
7836 "\\(")
|
|
|
7837 ((and (eq char ?}) (> curly 0))
|
|
|
7838 (setq curly (1- curly))
|
|
|
7839 "\\)")
|
|
|
7840 (t (regexp-quote (char-to-string char))))))
|
|
|
7841 regexp nil)
|
|
|
7842 "$")))
|
|
|
7843
|
|
|
7844
|
|
|
7845 ;;; Getting directory listings.
|
|
|
7846
|
|
|
7847 (defun efs-directory-files (directory &optional full match nosort)
|
|
|
7848 ;; Returns directory-files for remote directories.
|
|
|
7849 ;; NOSORT is a V19 arg.
|
|
|
7850 (let* ((directory (expand-file-name directory))
|
|
|
7851 (parsed (efs-ftp-path directory))
|
|
|
7852 (directory (efs-internal-file-name-as-directory
|
|
|
7853 (efs-host-type (car parsed) (nth 1 parsed)) directory))
|
|
|
7854 files)
|
|
|
7855 (efs-barf-if-not-directory directory)
|
|
|
7856 (setq files (efs-hash-table-keys (efs-get-files directory) nosort))
|
|
|
7857 (cond
|
|
|
7858 ((null (or full match))
|
|
|
7859 files)
|
|
|
7860 (match ; this is slow case
|
|
|
7861 (let (res f)
|
|
|
7862 (efs-save-match-data
|
|
|
7863 (while files
|
|
|
7864 (setq f (if full (concat directory (car files)) (car files))
|
|
|
7865 files (cdr files))
|
|
|
7866 (if (string-match match f)
|
|
|
7867 (setq res (nconc res (list f))))))
|
|
|
7868 res))
|
|
|
7869 (full
|
|
|
7870 (mapcar (function
|
|
|
7871 (lambda (fn)
|
|
|
7872 (concat directory fn)))
|
|
|
7873 files)))))
|
|
|
7874
|
|
|
7875 (defun efs-list-directory (dirname &optional verbose)
|
|
|
7876 ;; Version of list-directory for remote directories.
|
|
|
7877 ;; If verbose is nil, it gets its information from efs's
|
|
|
7878 ;; internal cache.
|
|
|
7879 (let* ((dirname (expand-file-name (or dirname default-directory)))
|
|
|
7880 header)
|
|
|
7881 (if (file-directory-p dirname)
|
|
|
7882 (setq dirname (file-name-as-directory dirname)))
|
|
|
7883 (setq header dirname)
|
|
|
7884 (with-output-to-temp-buffer "*Directory*"
|
|
|
7885 (buffer-disable-undo standard-output)
|
|
|
7886 (princ "Directory ")
|
|
|
7887 (princ header)
|
|
|
7888 (terpri)
|
|
|
7889 (princ
|
|
|
7890 (efs-ls dirname (if verbose
|
|
|
7891 list-directory-verbose-switches
|
|
|
7892 list-directory-brief-switches)
|
|
|
7893 t)))))
|
|
|
7894
|
|
|
7895 ;;;; -------------------------------------------------------------------
|
|
|
7896 ;;;; Manipulating buffers.
|
|
|
7897 ;;;; -------------------------------------------------------------------
|
|
|
7898
|
|
|
7899 (defun efs-get-file-buffer (file)
|
|
|
7900 ;; Version of get-file-buffer for remote files. Needs to fuss over things
|
|
|
7901 ;; like OS's which are case-insens. for file names.
|
|
|
7902 (let ((file (efs-canonize-file-name (expand-file-name file)))
|
|
|
7903 (buff-list (buffer-list))
|
|
|
7904 buff-name)
|
|
|
7905 (catch 'match
|
|
|
7906 (while buff-list
|
|
|
7907 (and (setq buff-name (buffer-file-name (car buff-list)))
|
|
|
7908 (= (length buff-name) (length file)) ; efficiency hack
|
|
|
7909 (string-equal (efs-canonize-file-name buff-name) file)
|
|
|
7910 (throw 'match (car buff-list)))
|
|
|
7911 (setq buff-list (cdr buff-list))))))
|
|
|
7912
|
|
|
7913 (defun efs-create-file-buffer (filename)
|
|
|
7914 ;; Version of create-file-buffer for remote file names.
|
|
|
7915 (let* ((parsed (efs-ftp-path (expand-file-name filename)))
|
|
|
7916 (file (nth 2 parsed))
|
|
|
7917 (host (car parsed))
|
|
|
7918 (host-type (efs-host-type host))
|
|
|
7919 (buff (cond
|
|
|
7920 ((null efs-fancy-buffer-names)
|
|
|
7921 (if (string-equal file "/")
|
|
|
7922 "/"
|
|
|
7923 (efs-internal-file-name-nondirectory
|
|
|
7924 (efs-internal-directory-file-name file))))
|
|
|
7925 ((stringp efs-fancy-buffer-names)
|
|
|
7926 (format efs-fancy-buffer-names
|
|
|
7927 (if (string-equal file "/")
|
|
|
7928 "/"
|
|
|
7929 (efs-internal-file-name-nondirectory
|
|
|
7930 (efs-internal-directory-file-name file)))
|
|
|
7931 (substring host 0 (string-match "\\." host 1))))
|
|
|
7932 (t ; efs-fancy-buffer-names had better be a function
|
|
|
7933 (funcall efs-fancy-buffer-names host
|
|
|
7934 (nth 1 parsed) file)))))
|
|
|
7935 (if (memq host-type efs-case-insensitive-host-types)
|
|
|
7936 (cond ((eq efs-buffer-name-case 'down)
|
|
|
7937 (setq buff (downcase buff)))
|
|
|
7938 ((eq efs-buffer-name-case 'up)
|
|
|
7939 (setq buff (upcase buff)))))
|
|
|
7940 (get-buffer-create (generate-new-buffer-name buff))))
|
|
|
7941
|
|
|
7942 (defun efs-set-buffer-mode ()
|
|
|
7943 "Set correct modes for the current buffer if it is visiting a remote file."
|
|
|
7944 (if (and (stringp buffer-file-name)
|
|
|
7945 (efs-ftp-path buffer-file-name))
|
|
|
7946 (progn
|
|
|
7947 (auto-save-mode efs-auto-save)
|
|
|
7948 (set (make-local-variable 'revert-buffer-function)
|
|
|
7949 'efs-revert-buffer)
|
|
|
7950 (set (make-local-variable 'default-directory-function)
|
|
|
7951 'efs-default-dir-function))))
|
|
|
7952
|
|
|
7953 ;;;; ---------------------------------------------------------
|
|
|
7954 ;;;; Functions for doing backups.
|
|
|
7955 ;;;; ---------------------------------------------------------
|
|
|
7956
|
|
|
7957 (defun efs-backup-buffer ()
|
|
|
7958 ;; Version of backup-buffer for buffers visiting remote files.
|
|
|
7959 (if efs-make-backup-files
|
|
|
7960 (let* ((parsed (efs-ftp-path buffer-file-name))
|
|
|
7961 (host (car parsed))
|
|
|
7962 (host-type (efs-host-type (car parsed))))
|
|
|
7963 (if (or (not (listp efs-make-backup-files))
|
|
|
7964 (memq host-type efs-make-backup-files))
|
|
|
7965 (efs-internal-backup-buffer
|
|
|
7966 host host-type (nth 1 parsed) (nth 2 parsed))))))
|
|
|
7967
|
|
|
7968 (defun efs-internal-backup-buffer (host host-type user remote-path)
|
|
|
7969 ;; This is almost a copy of the function in files.el, modified
|
|
|
7970 ;; to check to see if the backup file exists, before deleting it.
|
|
|
7971 ;; It also supports efs-backup-by-copying, and tries to do the
|
|
|
7972 ;; right thing about backup-by-copying-when-mismatch. Only called
|
|
|
7973 ;; for remote files.
|
|
|
7974 ;; Set the umask now, so that `setmodes' knows about it.
|
|
|
7975 (efs-set-umask host user)
|
|
|
7976 (let ((ent (efs-get-file-entry (expand-file-name buffer-file-name)))
|
|
|
7977 ;; Never do version-control if the remote operating system is doing it.
|
|
|
7978 (version-control (if (memq host-type efs-version-host-types)
|
|
|
7979 'never
|
|
|
7980 version-control))
|
|
|
7981 modstring)
|
|
|
7982 (and make-backup-files
|
|
|
7983 (not buffer-backed-up)
|
|
|
7984 ent ; i.e. file-exists-p
|
|
|
7985 (not (eq t (car ent)))
|
|
|
7986 (or (null (setq modstring (nth 3 ent)))
|
|
|
7987 (not (memq host-type efs-unix-host-types))
|
|
|
7988 (memq (aref modstring 0) '(?- ?l)))
|
|
|
7989 (or (< (length remote-path) 5)
|
|
|
7990 (not (string-equal "/tmp/" (substring remote-path 0 5))))
|
|
|
7991 (condition-case ()
|
|
|
7992 (let* ((backup-info (find-backup-file-name buffer-file-name))
|
|
|
7993 (backupname (car backup-info))
|
|
|
7994 (targets (cdr backup-info))
|
|
|
7995 (links (nth 4 ent))
|
|
|
7996 setmodes)
|
|
|
7997 (condition-case ()
|
|
|
7998 (if (or file-precious-flag
|
|
|
7999 (stringp (car ent)) ; symlinkp
|
|
|
8000 efs-backup-by-copying
|
|
|
8001 (and backup-by-copying-when-linked
|
|
|
8002 links (> links 1))
|
|
|
8003 (and backup-by-copying-when-mismatch
|
|
|
8004 (not
|
|
|
8005 (if (memq
|
|
|
8006 host-type
|
|
|
8007 efs-case-insensitive-host-types)
|
|
|
8008 (string-equal
|
|
|
8009 (downcase user) (downcase (nth 2 ent)))
|
|
|
8010 (string-equal user (nth 2 ent))))))
|
|
|
8011 (copy-file buffer-file-name backupname t t)
|
|
|
8012 (condition-case ()
|
|
|
8013 (if (file-exists-p backupname)
|
|
|
8014 (delete-file backupname))
|
|
|
8015 (file-error nil))
|
|
|
8016 (rename-file buffer-file-name backupname t)
|
|
|
8017 (setq setmodes (file-modes backupname)))
|
|
|
8018 (file-error
|
|
|
8019 ;; If trouble writing the backup, write it in ~.
|
|
|
8020 (setq backupname (expand-file-name "~/%backup%~"))
|
|
|
8021 (message
|
|
|
8022 "Cannot write backup file; backing up in ~/%%backup%%~")
|
|
|
8023 (sleep-for 1)
|
|
|
8024 (copy-file buffer-file-name backupname t t)))
|
|
|
8025 (setq buffer-backed-up t)
|
|
|
8026 ;; Starting with 19.26, trim-versions-without-asking
|
|
|
8027 ;; has been renamed to delete-old-verions.
|
|
|
8028 (if (and targets
|
|
|
8029 (or (if (boundp 'trim-versions-without-asking)
|
|
|
8030 trim-versions-without-asking
|
|
|
8031 (and
|
|
|
8032 (boundp 'delete-old-versions)
|
|
|
8033 delete-old-versions))
|
|
|
8034 (y-or-n-p (format
|
|
|
8035 "Delete excess backup versions of %s? "
|
|
|
8036 buffer-file-name))))
|
|
|
8037 (while targets
|
|
|
8038 (condition-case ()
|
|
|
8039 (delete-file (car targets))
|
|
|
8040 (file-error nil))
|
|
|
8041 (setq targets (cdr targets))))
|
|
|
8042 ;; If the file was already written with the right modes,
|
|
|
8043 ;; don't return set-modes.
|
|
|
8044 (and setmodes
|
|
|
8045 (null
|
|
|
8046 (let ((buff (get-buffer
|
|
|
8047 (efs-ftp-process-buffer host user))))
|
|
|
8048 (and buff
|
|
|
8049 (save-excursion
|
|
|
8050 (set-buffer buff)
|
|
|
8051 (and (integerp efs-process-umask)
|
|
|
8052 (= (efs-modes-from-umask efs-process-umask)
|
|
|
8053 setmodes))))))
|
|
|
8054 setmodes))
|
|
|
8055 (file-error nil)))))
|
|
|
8056
|
|
|
8057 ;;;; ------------------------------------------------------------
|
|
|
8058 ;;;; Redefinition for Emacs file mode support
|
|
|
8059 ;;;; ------------------------------------------------------------
|
|
|
8060
|
|
|
8061 (defmacro efs-build-mode-string-element (int suid-p sticky-p)
|
|
|
8062 ;; INT is between 0 and 7.
|
|
|
8063 ;; If SUID-P is non-nil, we are building the 3-char string for either
|
|
|
8064 ;; the owner or group, and the s[ug]id bit is set.
|
|
|
8065 ;; If STICKY-P is non-nil, we are building the string for other perms,
|
|
|
8066 ;; and the sticky bit is set.
|
|
|
8067 ;; It doesn't make sense for both SUID-P and STICKY-P be non-nil!
|
|
|
8068 (` (let* ((int (, int))
|
|
|
8069 (suid-p (, suid-p))
|
|
|
8070 (sticky-p (, sticky-p))
|
|
|
8071 (read-bit (if (memq int '(4 5 6 7)) "r" "-"))
|
|
|
8072 (write-bit (if (memq int '(2 3 6 7)) "w" "-"))
|
|
|
8073 (x-bit (if (memq int '(1 3 5 7))
|
|
|
8074 (cond (suid-p "s") (sticky-p "t") ("x"))
|
|
|
8075 (cond (suid-p "S") (sticky-p "T") ("-")))))
|
|
|
8076 (concat read-bit write-bit x-bit))))
|
|
|
8077
|
|
|
8078 (defun efs-mode-string (int)
|
|
|
8079 ;; Takes an octal integer between 0 and 7777, and returns the 9 character
|
|
|
8080 ;; mode string.
|
|
|
8081 (let* ((other-int (% int 10))
|
|
|
8082 (int (/ int 10))
|
|
|
8083 (group-int (% int 10))
|
|
|
8084 (int (/ int 10))
|
|
|
8085 (owner-int (% int 10))
|
|
|
8086 (int (/ int 10))
|
|
|
8087 (suid (memq int '(4 5 6 7)))
|
|
|
8088 (sgid (memq int '(2 3 6 7)))
|
|
|
8089 (sticky (memq int '(1 3 5 7))))
|
|
|
8090 (concat (efs-build-mode-string-element owner-int suid nil)
|
|
|
8091 (efs-build-mode-string-element group-int sgid nil)
|
|
|
8092 (efs-build-mode-string-element other-int nil sticky))))
|
|
|
8093
|
|
|
8094 (defun efs-set-file-modes (file mode)
|
|
|
8095 ;; set-file-modes for remote files.
|
|
|
8096 ;; For remote files, if mode is nil, does nothing.
|
|
|
8097 ;; This is because efs-file-modes returns nil if the modes
|
|
|
8098 ;; of a remote file couldn't be determined, even if the file exists.
|
|
|
8099 (and mode
|
|
|
8100 (let* ((file (expand-file-name file))
|
|
|
8101 (parsed (efs-ftp-path file))
|
|
|
8102 (host (car parsed))
|
|
|
8103 (user (nth 1 parsed))
|
|
|
8104 (r-file (nth 2 parsed))
|
|
|
8105 ;; convert to octal, and keep only 12 lowest order bits.
|
|
|
8106 (omode (format "%o" (- mode (lsh (lsh mode -12) 12)))))
|
|
|
8107 (if (or (efs-get-host-property host 'chmod-failed)
|
|
|
8108 (null (memq (efs-host-type host user) efs-unix-host-types)))
|
|
|
8109 (message "Unable to set file modes for %s to %s." file omode)
|
|
|
8110 (efs-send-cmd
|
|
|
8111 host user
|
|
|
8112 (list 'quote 'site 'chmod omode r-file)
|
|
|
8113 nil nil
|
|
|
8114 (efs-cont (result line cont-lines) (host file r-file omode)
|
|
|
8115 (if result
|
|
|
8116 (progn
|
|
|
8117 (efs-set-host-property host 'chmod-failed t)
|
|
|
8118 (message "CHMOD %s failed for %s on %s." omode r-file host)
|
|
|
8119 (if efs-ding-on-chmod-failure
|
|
|
8120 (progn (ding) (sit-for 1))))
|
|
|
8121 (let ((ent (efs-get-file-entry file)))
|
|
|
8122 (if ent
|
|
|
8123 (let* ((type
|
|
|
8124 (cond
|
|
|
8125 ((null (car ent)) "-")
|
|
|
8126 ((eq (car ent) t) "d")
|
|
|
8127 ((stringp (car ent)) "s")
|
|
|
8128 (t
|
|
|
8129 (error
|
|
|
8130 "Weird error in efs-set-file-modes"))))
|
|
|
8131 (mode-string (concat
|
|
|
8132 type
|
|
|
8133 (efs-mode-string
|
|
|
8134 (string-to-int omode))))
|
|
|
8135 (tail (nthcdr 3 ent)))
|
|
|
8136 (if (consp tail)
|
|
|
8137 (setcar tail mode-string)
|
|
|
8138 (efs-add-file-entry nil file (car ent) (nth 1 ent)
|
|
|
8139 (nth 2 ent) mode-string)))))))
|
|
|
8140 0)))) ; It should be safe to do this NOWAIT = 0
|
|
|
8141 ;; set-file-modes returns nil
|
|
|
8142 nil)
|
|
|
8143
|
|
|
8144 (defmacro efs-parse-mode-element (modes)
|
|
|
8145 ;; Parses MODES, a string of three chars, and returns an integer
|
|
|
8146 ;; between 0 and 7 according to how unix file modes are represented
|
|
|
8147 ;; for chmod.
|
|
|
8148 (` (if (= (length (, modes)) 3)
|
|
|
8149 (let ((list (mapcar
|
|
|
8150 (function (lambda (char)
|
|
|
8151 (if (memq char '( ?- ?S ?T)) 0 1)))
|
|
|
8152 (, modes))))
|
|
|
8153 ;; Convert to octal
|
|
|
8154 (+ (* (car list) 4) (* (nth 1 list) 2) (nth 2 list)))
|
|
|
8155 (error "Can't parse modes %s" (, modes)))))
|
|
|
8156
|
|
|
8157 (defun efs-parse-mode-string (string)
|
|
|
8158 ;; Parse a 9-character mode string, and return what it represents
|
|
|
8159 ;; as a decimal integer.
|
|
|
8160 (let ((owner (efs-parse-mode-element (substring string 0 3)))
|
|
|
8161 (group (efs-parse-mode-element (substring string 3 6)))
|
|
|
8162 (other (efs-parse-mode-element (substring string 6 9)))
|
|
|
8163 (owner-x (elt string 2))
|
|
|
8164 (group-x (elt string 5))
|
|
|
8165 (other-x (elt string 8)))
|
|
|
8166 (+ (* (+ (if (memq owner-x '(?s ?S)) 4 0)
|
|
|
8167 (if (memq group-x '(?s ?S)) 2 0)
|
|
|
8168 (if (memq other-x '(?t ?T)) 1 0))
|
|
|
8169 512)
|
|
|
8170 (* owner 64)
|
|
|
8171 (* group 8)
|
|
|
8172 other)))
|
|
|
8173
|
|
|
8174 (defun efs-file-modes (file)
|
|
|
8175 ;; Version of file-modes for remote files.
|
|
|
8176 ;; Returns nil if the file modes can't be determined, either because
|
|
|
8177 ;; the file doesn't exist, or for any other reason.
|
|
|
8178 (let* ((file (expand-file-name file))
|
|
|
8179 (parsed (efs-ftp-path file)))
|
|
|
8180 (and (memq (efs-host-type (car parsed)) efs-unix-host-types)
|
|
|
8181 ;; Someday we should cache mode strings for non-unix, but they
|
|
|
8182 ;; won't be in unix format. Also, CHMOD doesn't work for non-unix
|
|
|
8183 ;; hosts, so returning this info to emacs is a waste.
|
|
|
8184 (let* ((ent (efs-get-file-entry file))
|
|
|
8185 (modes (nth 3 ent)))
|
|
|
8186 (and modes
|
|
|
8187 (efs-parse-mode-string (substring modes 1)))))))
|
|
|
8188
|
|
|
8189 ;;;; ------------------------------------------------------------
|
|
|
8190 ;;;; Redefinition of Emacs file modtime support.
|
|
|
8191 ;;;; ------------------------------------------------------------
|
|
|
8192
|
|
|
8193 (defun efs-day-number (year month day)
|
|
|
8194 ;; Returns the day number within year of date. Taken from calendar.el,
|
|
|
8195 ;; by Edward Reingold. Thanks.
|
|
|
8196 ;; An explanation of the calculation can be found in PascAlgorithms by
|
|
|
8197 ;; Edward and Ruth Reingold, Scott-Foresman/Little, Brown, 1988.
|
|
|
8198 (let ((day-of-year (+ day (* 31 (1- month)))))
|
|
|
8199 (if (> month 2)
|
|
|
8200 (progn
|
|
|
8201 (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10)))
|
|
|
8202 (if (zerop (% year 4))
|
|
|
8203 (setq day-of-year (1+ day-of-year)))))
|
|
|
8204 day-of-year))
|
|
|
8205
|
|
|
8206 (defun efs-days-elapsed (year month day)
|
|
|
8207 ;; Number of days elapsed since Jan 1, `efs-time-zero'
|
|
|
8208 (+ (efs-day-number year month day) ; days this year
|
|
|
8209 (* 365 (- year efs-time-zero)) ; days in prior years
|
|
|
8210 (- (/ (max (1- year) efs-time-zero) 4)
|
|
|
8211 (/ efs-time-zero 4)) ; leap years
|
|
|
8212 -1 )) ; don't count today
|
|
|
8213
|
|
|
8214 ;; 2^16 = 65536
|
|
|
8215 ;; Use this to avoid overflows
|
|
|
8216
|
|
|
8217 (defun efs-seconds-elapsed (year month day hours minutes seconds)
|
|
|
8218 ;; Computes the seconds elapsed from `efs-time-zero', in emacs'
|
|
|
8219 ;; format of a list of two integers, the first the higher 16-bits,
|
|
|
8220 ;; the second the lower 16-bits.
|
|
|
8221 (let* ((days (efs-days-elapsed year month day))
|
|
|
8222 ;; compute hours
|
|
|
8223 (hours (+ (* 24 days) hours))
|
|
|
8224 (high (lsh hours -16))
|
|
|
8225 (low (- hours (lsh high 16)))
|
|
|
8226 ;; compute minutes
|
|
|
8227 (low (+ (* low 60) minutes))
|
|
|
8228 (carry (lsh low -16))
|
|
|
8229 (high (+ (* high 60) carry))
|
|
|
8230 (low (- low (lsh carry 16)))
|
|
|
8231 ;; compute seconds
|
|
|
8232 (low (+ (* low 60) seconds))
|
|
|
8233 (carry (lsh low -16))
|
|
|
8234 (high (+ (* high 60) carry))
|
|
|
8235 (low (- low (lsh carry 16))))
|
|
|
8236 (list high low)))
|
|
|
8237
|
|
|
8238 (defun efs-parse-mdtime (string)
|
|
|
8239 ;; Parse a string, which is assumed to be the result of an ftp MDTM command.
|
|
|
8240 (efs-save-match-data
|
|
|
8241 (if (string-match efs-mdtm-msgs string)
|
|
|
8242 (efs-seconds-elapsed
|
|
|
8243 (string-to-int (substring string 4 8))
|
|
|
8244 (string-to-int (substring string 8 10))
|
|
|
8245 (string-to-int (substring string 10 12))
|
|
|
8246 (string-to-int (substring string 12 14))
|
|
|
8247 (string-to-int (substring string 14 16))
|
|
|
8248 (string-to-int (substring string 16 18))))))
|
|
|
8249
|
|
|
8250 (defun efs-parse-ctime (string)
|
|
|
8251 ;; Parse STRING which is assumed to be the result of a query over port 37.
|
|
|
8252 ;; Returns the number of seconds since the turn of the century, as a
|
|
|
8253 ;; list of two 16-bit integers.
|
|
|
8254 (and (= (length string) 4)
|
|
|
8255 (list (+ (lsh (aref string 0) 8) (aref string 1))
|
|
|
8256 (+ (lsh (aref string 2) 8) (aref string 3)))))
|
|
|
8257
|
|
|
8258 (defun efs-time-minus (time1 time2)
|
|
|
8259 ;; Subtract 32-bit integers, represented as two 16-bit integers.
|
|
|
8260 (let ((high (- (car time1) (car time2)))
|
|
|
8261 (low (- (nth 1 time1) (nth 1 time2))))
|
|
|
8262 (cond
|
|
|
8263 ((and (< high 0) (> low 0))
|
|
|
8264 (setq high (1+ high)
|
|
|
8265 low (- low 65536)))
|
|
|
8266 ((and (> high 0) (< low 0))
|
|
|
8267 (setq high (1- high)
|
|
|
8268 low (+ 65536 low))))
|
|
|
8269 (list high low)))
|
|
|
8270
|
|
|
8271 (defun efs-time-greater (time1 time2)
|
|
|
8272 ;; Compare two 32-bit integers, each represented as a list of two 16-bit
|
|
|
8273 ;; integers.
|
|
|
8274 (or (> (car time1) (car time2))
|
|
|
8275 (and (= (car time1) (car time2))
|
|
|
8276 (> (nth 1 time1) (nth 1 time2)))))
|
|
|
8277
|
|
|
8278 (defun efs-century-time (host &optional nowait cont)
|
|
|
8279 ;; Treat nil as the local host.
|
|
|
8280 ;; Returns the # of seconds since the turn of the century, according
|
|
|
8281 ;; to the system clock on host.
|
|
|
8282 ;; CONT is called with first arg HOST and second the # of seconds.
|
|
|
8283 (or host (setq host (system-name)))
|
|
|
8284 (efs-set-host-property host 'last-ctime nil)
|
|
|
8285 (efs-set-host-property host 'ctime-cont cont)
|
|
|
8286 (let ((name (format efs-ctime-process-name-format host))
|
|
|
8287 proc)
|
|
|
8288 (condition-case nil (delete-process name) (error nil))
|
|
|
8289 (if (and
|
|
|
8290 (or (efs-save-match-data (string-match efs-local-host-regexp host))
|
|
|
8291 (string-equal host (system-name)))
|
|
|
8292 (setq proc (condition-case nil
|
|
|
8293 (open-network-stream name nil host 37)
|
|
|
8294 (error nil))))
|
|
|
8295 (progn
|
|
|
8296 (set (intern name) "")
|
|
|
8297 (set-process-filter
|
|
|
8298 proc
|
|
|
8299 (function
|
|
|
8300 (lambda (proc string)
|
|
|
8301 (let ((name (process-name proc))
|
|
|
8302 result)
|
|
|
8303 (set (intern name) (concat (symbol-value (intern name))
|
|
|
8304 string))
|
|
|
8305 (setq result (efs-parse-ctime
|
|
|
8306 (symbol-value (intern name))))
|
|
|
8307 (if result
|
|
|
8308 (let* ((host (substring name 11 -1))
|
|
|
8309 (cont (efs-get-host-property host 'ctime-cont)))
|
|
|
8310 (efs-set-host-property host 'last-ctime result)
|
|
|
8311 (condition-case nil (delete-process proc) (error nil))
|
|
|
8312 (if cont
|
|
|
8313 (progn
|
|
|
8314 (efs-set-host-property host 'ctime-cont nil)
|
|
|
8315 (efs-call-cont cont host result)))))))))
|
|
|
8316 (set-process-sentinel
|
|
|
8317 proc
|
|
|
8318 (function
|
|
|
8319 (lambda (proc state)
|
|
|
8320 (let* ((name (process-name proc))
|
|
|
8321 (host (substring name 11 -1))
|
|
|
8322 (cont (efs-get-host-property host 'ctime-cont)))
|
|
|
8323 (makunbound (intern name))
|
|
|
8324 (or (efs-get-host-property host 'last-ctime)
|
|
|
8325 (if cont
|
|
|
8326 (progn
|
|
|
8327 (efs-set-host-property host 'ctime-cont nil)
|
|
|
8328 (efs-call-cont cont host 'failed))))))))
|
|
|
8329 (if nowait
|
|
|
8330 nil
|
|
|
8331 (let ((quit-flag nil)
|
|
|
8332 (inhibit-quit nil))
|
|
|
8333 (while (memq (process-status proc) '(run open))
|
|
|
8334 (accept-process-output)))
|
|
|
8335 (accept-process-output)
|
|
|
8336 (or (efs-get-host-property host 'last-ctime)
|
|
|
8337 'failed)))
|
|
|
8338 (if cont
|
|
|
8339 (progn
|
|
|
8340 (efs-set-host-property host 'ctime-cont nil)
|
|
|
8341 (efs-call-cont cont host 'failed)))
|
|
|
8342 (if nowait nil 'failed))))
|
|
|
8343
|
|
|
8344 (defun efs-clock-difference (host &optional nowait)
|
|
|
8345 ;; clock difference with the local host
|
|
|
8346 (let ((result (efs-get-host-property host 'clock-diff)))
|
|
|
8347 (or
|
|
|
8348 result
|
|
|
8349 (progn
|
|
|
8350 (efs-century-time
|
|
|
8351 host nowait
|
|
|
8352 (efs-cont (host result) (nowait)
|
|
|
8353 (if (eq result 'failed)
|
|
|
8354 (efs-set-host-property host 'clock-diff 'failed)
|
|
|
8355 (efs-century-time
|
|
|
8356 nil nowait
|
|
|
8357 (efs-cont (lhost lresult) (host result)
|
|
|
8358 (if (eq lresult 'failed)
|
|
|
8359 (efs-set-host-property host 'clock-diff 'failed)
|
|
|
8360 (efs-set-host-property host 'clock-diff
|
|
|
8361 (efs-time-minus result lresult))))))))
|
|
|
8362 (and (null nowait)
|
|
|
8363 (or (efs-get-host-property host 'clock-diff)
|
|
|
8364 'failed))))))
|
|
|
8365
|
|
|
8366 (defun efs-get-file-mdtm (host user file path)
|
|
|
8367 "For HOST and USER, return FILE's last modification time.
|
|
|
8368 PATH is the file name in full efs syntax.
|
|
|
8369 Returns a list of two six-digit integers which represent the 16 high order
|
|
|
8370 bits, and 16 low order bits of the number of elapsed seconds since
|
|
|
8371 `efs-time-zero'"
|
|
|
8372 (and (null (efs-get-host-property host 'mdtm-failed))
|
|
|
8373 (let ((result (efs-send-cmd host user (list 'quote 'mdtm file)
|
|
|
8374 (and (eq efs-verbose t)
|
|
|
8375 "Getting modtime")))
|
|
|
8376 parsed)
|
|
|
8377 (if (and (null (car result))
|
|
|
8378 (setq parsed (efs-parse-mdtime (nth 1 result))))
|
|
|
8379 (let ((ent (efs-get-file-entry path)))
|
|
|
8380 (if ent
|
|
|
8381 (setcdr ent (list (nth 1 ent) (nth 2 ent)
|
|
|
8382 (nth 3 ent) (nth 4 ent)
|
|
|
8383 parsed)))
|
|
|
8384 parsed)
|
|
|
8385 (efs-save-match-data
|
|
|
8386 ;; The 550 error is for a nonexistent file. Actually implies
|
|
|
8387 ;; that MDTM works.
|
|
|
8388 (if (string-match "^550 " (nth 1 result))
|
|
|
8389 '(0 0)
|
|
|
8390 (efs-set-host-property host 'mdtm-failed t)
|
|
|
8391 nil))))))
|
|
|
8392
|
|
|
8393 (efs-define-fun efs-set-emacs-bvf-mdtm (buffer mdtm)
|
|
|
8394 ;; Sets cached value for the buffer visited file modtime.
|
|
|
8395 (if (get-buffer buffer)
|
|
|
8396 (save-excursion
|
|
|
8397 (set-buffer buffer)
|
|
|
8398 (let (file-name-handler-alist)
|
|
|
8399 (set-visited-file-modtime mdtm)))))
|
|
|
8400
|
|
|
8401 ;; (defun efs-set-visited-file-modtime (&optional time)
|
|
|
8402 ;; ;; For remote files sets the modtime for a buffer to be that of the
|
|
|
8403 ;; ;; visited file. With arg TIME sets the modtime to TIME. TIME must be a list
|
|
|
8404 ;; ;; of two 16-bit integers.
|
|
|
8405 ;; ;; The function set-visited-file-modtime is for emacs-19. It doesn't
|
|
|
8406 ;; ;; exist in emacs 18. If you're running efs, it will work in emacs 18 for
|
|
|
8407 ;; ;; remote files only.
|
|
|
8408 ;; (if time
|
|
|
8409 ;; (efs-set-emacs-bvf-mdtm (current-buffer) time)
|
|
|
8410 ;; (let* ((path buffer-file-name)
|
|
|
8411 ;; (parsed (efs-ftp-path path))
|
|
|
8412 ;; (host (car parsed))
|
|
|
8413 ;; (user (nth 1 parsed))
|
|
|
8414 ;; (file (nth 2 parsed))
|
|
|
8415 ;; (buffer (current-buffer)))
|
|
|
8416 ;; (if (efs-save-match-data
|
|
|
8417 ;; (and efs-verify-modtime-host-regexp
|
|
|
8418 ;; (string-match efs-verify-modtime-host-regexp host)
|
|
|
8419 ;; (or efs-verify-anonymous-modtime
|
|
|
8420 ;; (not (efs-anonymous-p user)))
|
|
|
8421 ;; (not (efs-get-host-property host 'mdtm-failed))))
|
|
|
8422 ;; (efs-send-cmd
|
|
|
8423 ;; host user (list 'quote 'mdtm file)
|
|
|
8424 ;; nil nil
|
|
|
8425 ;; (efs-cont (result line cont-lines) (host user path buffer)
|
|
|
8426 ;; (let (modtime)
|
|
|
8427 ;; (if (and (null result)
|
|
|
8428 ;; (setq modtime (efs-parse-mdtime line)))
|
|
|
8429 ;; (let ((ent (efs-get-file-entry path)))
|
|
|
8430 ;; (if ent
|
|
|
8431 ;; (setcdr ent (list (nth 1 ent) (nth 2 ent)
|
|
|
8432 ;; (nth 3 ent) (nth 4 ent)
|
|
|
8433 ;; modtime)))
|
|
|
8434 ;; (setq buffer (and (setq buffer (get-buffer buffer))
|
|
|
8435 ;; (buffer-name buffer)))
|
|
|
8436 ;; ;; Beware that since this is happening asynch, the buffer
|
|
|
8437 ;; ;; may have disappeared.
|
|
|
8438 ;; (and buffer (efs-set-emacs-bvf-mdtm buffer modtime)))
|
|
|
8439 ;; (efs-save-match-data
|
|
|
8440 ;; (or (string-match "^550 " line)
|
|
|
8441 ;; (efs-set-host-property host 'mdtm-failed t)))
|
|
|
8442 ;; (efs-set-emacs-bvf-mdtm buffer 0)))) ; store dummy values
|
|
|
8443 ;; 0) ; Always do this NOWAIT = 0
|
|
|
8444 ;; (efs-set-emacs-bvf-mdtm buffer 0))
|
|
|
8445 ;; nil) ; return NIL
|
|
|
8446 ;; ))
|
|
|
8447
|
|
|
8448 (defvar efs-set-modtimes-synchronously nil
|
|
|
8449 "*Whether efs uses a synchronous FTP command to set the visited file modtime.
|
|
|
8450 Setting this variable to non-nil means that efs will set visited file modtimes
|
|
|
8451 synchronously.
|
|
|
8452
|
|
|
8453 Asynchronous setting of visited file modtimes leaves a very small
|
|
|
8454 window where Emacs may fail to detect a super session. However, it gives
|
|
|
8455 faster user access to newly visited files.")
|
|
|
8456
|
|
|
8457
|
|
|
8458 (defun efs-set-visited-file-modtime (&optional time)
|
|
|
8459 ;; For remote files sets the modtime for a buffer to be that of the
|
|
|
8460 ;; visited file. With arg TIME sets the modtime to TIME. TIME must be a list
|
|
|
8461 ;; of two 16-bit integers.
|
|
|
8462 ;; The function set-visited-file-modtime is for emacs-19. It doesn't
|
|
|
8463 ;; exist in emacs 18. If you're running efs, it will work in emacs 18 for
|
|
|
8464 ;; remote files only.
|
|
|
8465 (if time
|
|
|
8466 (efs-set-emacs-bvf-mdtm (current-buffer) time)
|
|
|
8467 (let* ((path buffer-file-name)
|
|
|
8468 (parsed (efs-ftp-path path))
|
|
|
8469 (host (car parsed))
|
|
|
8470 (user (nth 1 parsed))
|
|
|
8471 (file (nth 2 parsed))
|
|
|
8472 (buffer (current-buffer)))
|
|
|
8473 (if (efs-save-match-data
|
|
|
8474 (and efs-verify-modtime-host-regexp
|
|
|
8475 (string-match efs-verify-modtime-host-regexp host)
|
|
|
8476 (or efs-verify-anonymous-modtime
|
|
|
8477 (not (efs-anonymous-p user)))
|
|
|
8478 (not (efs-get-host-property host 'mdtm-failed))))
|
|
|
8479 (progn
|
|
|
8480 (or efs-set-modtimes-synchronously (clear-visited-file-modtime))
|
|
|
8481 (efs-send-cmd
|
|
|
8482 host user (list 'quote 'mdtm file)
|
|
|
8483 nil nil
|
|
|
8484 (efs-cont (result line cont-lines) (host user path buffer)
|
|
|
8485 (let (modtime)
|
|
|
8486 (if (and (null result)
|
|
|
8487 (setq modtime (efs-parse-mdtime line)))
|
|
|
8488 (let ((ent (efs-get-file-entry path)))
|
|
|
8489 (if ent
|
|
|
8490 (setcdr ent (list (nth 1 ent) (nth 2 ent)
|
|
|
8491 (nth 3 ent) (nth 4 ent)
|
|
|
8492 modtime)))
|
|
|
8493 (setq buffer (and (setq buffer (get-buffer buffer))
|
|
|
8494 (buffer-name buffer)))
|
|
|
8495 ;; Beware that since might be happening asynch,
|
|
|
8496 ;; the buffer may have disappeared.
|
|
|
8497 (and buffer (efs-set-emacs-bvf-mdtm buffer modtime)))
|
|
|
8498 (efs-save-match-data
|
|
|
8499 (or (string-match "^550 " line)
|
|
|
8500 (efs-set-host-property host 'mdtm-failed t)))
|
|
|
8501 (efs-set-emacs-bvf-mdtm buffer '(0 0))))) ; store dummy values
|
|
|
8502 (and (null efs-set-modtimes-synchronously) 0)))
|
|
|
8503 (efs-set-emacs-bvf-mdtm buffer '(0 0)))
|
|
|
8504 nil))) ; return NIL
|
|
|
8505
|
|
|
8506 (defun efs-file-newer-than-file-p (file1 file2)
|
|
|
8507 ;; Version of file-newer-than-file-p for remote files.
|
|
|
8508 (let* ((file1 (expand-file-name file1))
|
|
|
8509 (file2 (expand-file-name file2))
|
|
|
8510 (parsed1 (efs-ftp-path file1))
|
|
|
8511 (parsed2 (efs-ftp-path file2))
|
|
|
8512 (host1 (car parsed1))
|
|
|
8513 (host2 (car parsed2))
|
|
|
8514 (user1 (nth 1 parsed1))
|
|
|
8515 (user2 (nth 1 parsed2)))
|
|
|
8516 (cond
|
|
|
8517 ;; If the first file doedn't exist, or is remote but
|
|
|
8518 ;; we're not supposed to check modtimes on it, return nil.
|
|
|
8519 ((or (null (file-exists-p file1))
|
|
|
8520 (and parsed1
|
|
|
8521 (or
|
|
|
8522 (null efs-verify-modtime-host-regexp)
|
|
|
8523 (efs-get-host-property host1 'mdtm-failed)
|
|
|
8524 (not (string-match efs-verify-modtime-host-regexp host1))
|
|
|
8525 (and (null efs-verify-anonymous-modtime)
|
|
|
8526 (efs-anonymous-p user1)))))
|
|
|
8527 nil)
|
|
|
8528 ;; If the same is true for the second file, return t.
|
|
|
8529 ((or (null (file-exists-p file2))
|
|
|
8530 (and parsed2
|
|
|
8531 (or
|
|
|
8532 (null efs-verify-modtime-host-regexp)
|
|
|
8533 (efs-get-host-property host2 'mdtm-failed)
|
|
|
8534 (not (string-match efs-verify-modtime-host-regexp host2))
|
|
|
8535 (and (null efs-verify-anonymous-modtime)
|
|
|
8536 (efs-anonymous-p user2)))))
|
|
|
8537 t)
|
|
|
8538 ;; Calculate modtimes. If we get here, any remote files should
|
|
|
8539 ;; have a file entry.
|
|
|
8540 (t
|
|
|
8541 (let (mod1 mod2 shift1 shift2)
|
|
|
8542 (if parsed1
|
|
|
8543 (let ((ent (efs-get-file-entry file1)))
|
|
|
8544 (setq mod1 (nth 5 ent)
|
|
|
8545 shift1 (efs-clock-difference host1))
|
|
|
8546 (or mod1
|
|
|
8547 (setq mod1 (efs-get-file-mdtm
|
|
|
8548 host1 user1 (nth 2 parsed1) file1))))
|
|
|
8549 (setq mod1 (nth 5 (file-attributes file1))))
|
|
|
8550 (if parsed2
|
|
|
8551 (let ((ent (efs-get-file-entry file2)))
|
|
|
8552 (setq mod2 (nth 5 ent)
|
|
|
8553 shift2 (efs-clock-difference host2))
|
|
|
8554 (or mod2
|
|
|
8555 (setq mod2 (efs-get-file-mdtm
|
|
|
8556 host2 user2 (nth 2 parsed2) file2))))
|
|
|
8557 (setq mod2 (nth 5 (file-attributes file2))))
|
|
|
8558 ;; If we can't compute clock shifts, we act as if we don't
|
|
|
8559 ;; even know the modtime. Should we have more faith in ntp?
|
|
|
8560 (cond
|
|
|
8561 ((or (null mod1) (eq shift1 'failed))
|
|
|
8562 nil)
|
|
|
8563 ((or (null mod2) (eq shift2 'failed))
|
|
|
8564 t)
|
|
|
8565 ;; We get to compute something!
|
|
|
8566 (t
|
|
|
8567 (efs-time-greater
|
|
|
8568 (if shift1 (efs-time-minus mod1 shift1) mod1)
|
|
|
8569 (if shift2 (efs-time-minus mod2 shift2) mod2)))))))))
|
|
|
8570
|
|
|
8571 (defun efs-verify-visited-file-modtime (buff)
|
|
|
8572 ;; Verifies the modtime for buffers visiting remote files.
|
|
|
8573 ;; Won't get called for buffer not visiting any file.
|
|
|
8574 (let ((buff (get-buffer buff)))
|
|
|
8575 (null
|
|
|
8576 (and buff ; return t if no buffer? Need to beware of multi-threading.
|
|
|
8577 (buffer-file-name buff) ; t if no file
|
|
|
8578 (let ((mdtm (save-excursion
|
|
|
8579 (set-buffer buff)
|
|
|
8580 (visited-file-modtime))))
|
|
|
8581 (and
|
|
|
8582 (not (eq mdtm 0))
|
|
|
8583 (not (equal mdtm '(0 0)))
|
|
|
8584 efs-verify-modtime-host-regexp
|
|
|
8585 (let* ((path (buffer-file-name buff))
|
|
|
8586 (parsed (efs-ftp-path path))
|
|
|
8587 (host (car parsed))
|
|
|
8588 (user (nth 1 parsed))
|
|
|
8589 nmdtm)
|
|
|
8590 (and
|
|
|
8591 (null (efs-get-host-property host 'mdtm-failed))
|
|
|
8592 (efs-save-match-data
|
|
|
8593 (string-match
|
|
|
8594 efs-verify-modtime-host-regexp host))
|
|
|
8595 (or efs-verify-anonymous-modtime
|
|
|
8596 (not (efs-anonymous-p user)))
|
|
|
8597 (setq nmdtm (efs-get-file-mdtm host user (nth 2 parsed) path))
|
|
|
8598 (progn
|
|
|
8599 (or (equal nmdtm '(0 0))
|
|
|
8600 (file-exists-p path) ; Make sure that there is an entry.
|
|
|
8601 (null
|
|
|
8602 (efs-get-files
|
|
|
8603 (file-name-directory
|
|
|
8604 (efs-internal-directory-file-name path))))
|
|
|
8605 (efs-add-file-entry
|
|
|
8606 (efs-host-type host) path nil nil nil nil nil nmdtm))
|
|
|
8607 (null (and (eq (cdr mdtm) (nth 1 nmdtm))
|
|
|
8608 (eq (car mdtm) (car nmdtm)))))))))))))
|
|
|
8609
|
|
|
8610 ;;;; -----------------------------------------------------------
|
|
|
8611 ;;;; Redefinition of Emacs file name completion
|
|
|
8612 ;;;; -----------------------------------------------------------
|
|
|
8613
|
|
|
8614 (defmacro efs-set-completion-ignored-pattern ()
|
|
|
8615 ;; Set regexp efs-completion-ignored-pattern
|
|
|
8616 ;; to use for filename completion.
|
|
|
8617 (`
|
|
|
8618 (or (equal efs-completion-ignored-extensions
|
|
|
8619 completion-ignored-extensions)
|
|
|
8620 (setq efs-completion-ignored-extensions
|
|
|
8621 completion-ignored-extensions
|
|
|
8622 efs-completion-ignored-pattern
|
|
|
8623 (mapconcat (function
|
|
|
8624 (lambda (s) (if (stringp s)
|
|
|
8625 (concat (regexp-quote s) "$")
|
|
|
8626 "/"))) ; / never in filename
|
|
|
8627 efs-completion-ignored-extensions
|
|
|
8628 "\\|")))))
|
|
|
8629
|
|
|
8630 (defun efs-file-entry-active-p (sym)
|
|
|
8631 ;; If the file entry is a symlink, returns whether the file pointed to
|
|
|
8632 ;; exists.
|
|
|
8633 ;; Note that DIR is dynamically bound.
|
|
|
8634 (let ((file-type (car (get sym 'val))))
|
|
|
8635 (or (not (stringp file-type))
|
|
|
8636 (file-exists-p (efs-chase-symlinks
|
|
|
8637 (expand-file-name file-type efs-completion-dir))))))
|
|
|
8638
|
|
|
8639 (defun efs-file-entry-not-ignored-p (sym)
|
|
|
8640 ;; If the file entry is not a directory (nor a symlink pointing to a
|
|
|
8641 ;; directory) returns whether the file (or file pointed to by the symlink)
|
|
|
8642 ;; is ignored by completion-ignored-extensions.
|
|
|
8643 (let ((file-type (car (get sym 'val)))
|
|
|
8644 (symname (symbol-name sym)))
|
|
|
8645 (if (stringp file-type)
|
|
|
8646 ;; Maybe file-truename would be better here, but it is very costly
|
|
|
8647 ;; to chase symlinks at every level over FTP.
|
|
|
8648 (let ((file (efs-chase-symlinks (expand-file-name
|
|
|
8649 file-type efs-completion-dir))))
|
|
|
8650 (or (file-directory-p file)
|
|
|
8651 (and (file-exists-p file)
|
|
|
8652 (not (string-match efs-completion-ignored-pattern
|
|
|
8653 symname)))))
|
|
|
8654 (or file-type ; is a directory name
|
|
|
8655 (not (string-match efs-completion-ignored-pattern symname))))))
|
|
|
8656
|
|
|
8657 (defun efs-file-name-all-completions (file dir)
|
|
|
8658 ;; Does file-name-all-completions in remote directories.
|
|
|
8659 (efs-barf-if-not-directory dir)
|
|
|
8660 (let* ((efs-completion-dir (file-name-as-directory (expand-file-name dir)))
|
|
|
8661 (completion-ignore-case
|
|
|
8662 (memq (efs-host-type (car (efs-ftp-path efs-completion-dir)))
|
|
|
8663 efs-case-insensitive-host-types))
|
|
|
8664 (tbl (efs-get-files efs-completion-dir))
|
|
|
8665 (completions
|
|
|
8666 (all-completions file tbl
|
|
|
8667 (function efs-file-entry-active-p))))
|
|
|
8668 ;; see whether each matching file is a directory or not...
|
|
|
8669 (mapcar
|
|
|
8670 ;; Since the entries in completions will match the case
|
|
|
8671 ;; of the entries in tbl, don't need to case-fold
|
|
|
8672 ;; in efs-get-hash-entry below.
|
|
|
8673 (function
|
|
|
8674 (lambda (file)
|
|
|
8675 (let ((ent (car (efs-get-hash-entry file tbl))))
|
|
|
8676 (if (or (eq ent t)
|
|
|
8677 (and (stringp ent)
|
|
|
8678 (file-directory-p (efs-chase-symlinks
|
|
|
8679 (expand-file-name
|
|
|
8680 ent efs-completion-dir)))))
|
|
|
8681 (concat file "/")
|
|
|
8682 file))))
|
|
|
8683 completions)))
|
|
|
8684
|
|
|
8685 (defun efs-file-name-completion (file dir)
|
|
|
8686 ;; Does file name expansion in remote directories.
|
|
|
8687 (efs-barf-if-not-directory dir)
|
|
|
8688 (if (equal file "")
|
|
|
8689 ""
|
|
|
8690 (let* ((efs-completion-dir (file-name-as-directory (expand-file-name dir)))
|
|
|
8691 (completion-ignore-case
|
|
|
8692 (memq (efs-host-type (car (efs-ftp-path efs-completion-dir)))
|
|
|
8693 efs-case-insensitive-host-types))
|
|
|
8694 (tbl (efs-get-files efs-completion-dir)))
|
|
|
8695 (efs-set-completion-ignored-pattern)
|
|
|
8696 (efs-save-match-data
|
|
|
8697 (or (efs-file-name-completion-1
|
|
|
8698 file tbl efs-completion-dir
|
|
|
8699 (function efs-file-entry-not-ignored-p))
|
|
|
8700 (efs-file-name-completion-1
|
|
|
8701 file tbl efs-completion-dir
|
|
|
8702 (function efs-file-entry-active-p)))))))
|
|
|
8703
|
|
|
8704 (defun efs-file-name-completion-1 (file tbl dir predicate)
|
|
|
8705 ;; Internal subroutine for efs-file-name-completion. Do not call this.
|
|
|
8706 (let ((bestmatch (try-completion file tbl predicate)))
|
|
|
8707 (if bestmatch
|
|
|
8708 (if (eq bestmatch t)
|
|
|
8709 (if (file-directory-p (expand-file-name file dir))
|
|
|
8710 (concat file "/")
|
|
|
8711 t)
|
|
|
8712 (if (and (eq (try-completion bestmatch tbl predicate) t)
|
|
|
8713 (file-directory-p
|
|
|
8714 (expand-file-name bestmatch dir)))
|
|
|
8715 (concat bestmatch "/")
|
|
|
8716 bestmatch)))))
|
|
|
8717
|
|
|
8718 ;;;; ----------------------------------------------------------
|
|
|
8719 ;;;; Functions for loading lisp.
|
|
|
8720 ;;;; ----------------------------------------------------------
|
|
|
8721
|
|
|
8722 ;;; jka-load provided ideas here. Thanks, Jay.
|
|
|
8723
|
|
|
8724 (defun efs-load-openp (str suffixes)
|
|
|
8725 ;; Given STR, searches load-path and efs-load-lisp-extensions
|
|
|
8726 ;; for the name of a file to load. Returns the full path, or nil
|
|
|
8727 ;; if none found.
|
|
|
8728 (let ((path-list (if (file-name-absolute-p str) t load-path))
|
|
|
8729 root result)
|
|
|
8730 ;; If there is no load-path, at least try the default directory.
|
|
|
8731 (or path-list
|
|
|
8732 (setq path-list (list default-directory)))
|
|
|
8733 (while (and path-list (null result))
|
|
|
8734 (if (eq path-list t)
|
|
|
8735 (setq path-list nil
|
|
|
8736 root str)
|
|
|
8737 (setq root (expand-file-name str (car path-list))
|
|
|
8738 path-list (cdr path-list))
|
|
|
8739 (or (file-name-absolute-p root)
|
|
|
8740 (setq root (expand-file-name root default-directory))))
|
|
|
8741 (let ((suff-list suffixes))
|
|
|
8742 (while (and suff-list (null result))
|
|
|
8743 (let ((try (concat root (car suff-list))))
|
|
|
8744 (if (or (not (file-readable-p try))
|
|
|
8745 (file-directory-p try))
|
|
|
8746 (setq suff-list (cdr suff-list))
|
|
|
8747 (setq result try))))))
|
|
|
8748 result))
|
|
|
8749
|
|
|
8750 (defun efs-load (file &optional noerror nomessage nosuffix)
|
|
|
8751 "Documented as original."
|
|
|
8752 (let ((filename (efs-load-openp
|
|
|
8753 file
|
|
|
8754 (if nosuffix '("") efs-load-lisp-extensions))))
|
|
|
8755 (if (not filename)
|
|
|
8756 (and (null noerror) (error "Cannot open load file %s" file))
|
|
|
8757 (let ((parsed (efs-ftp-path filename))
|
|
|
8758 (after-load (and (boundp 'after-load-alist)
|
|
|
8759 (assoc file after-load-alist))))
|
|
|
8760 (if parsed
|
|
|
8761 (let ((temp (car (efs-make-tmp-name nil (car parsed)))))
|
|
|
8762 (unwind-protect
|
|
|
8763 (progn
|
|
|
8764 (efs-copy-file-internal
|
|
|
8765 filename parsed temp nil t nil
|
|
|
8766 (format "Getting %s" filename))
|
|
|
8767 (or (file-readable-p temp)
|
|
|
8768 (error
|
|
|
8769 "efs-load: temp file %s is unreadable" temp))
|
|
|
8770 (or nomessage
|
|
|
8771 (message "Loading %s..." file))
|
|
|
8772 ;; temp is an absolute filename, so load path
|
|
|
8773 ;; won't be searched.
|
|
|
8774 (let (after-load-alist)
|
|
|
8775 (efs-real-load temp t t t))
|
|
|
8776 (or nomessage
|
|
|
8777 (message "Loading %s...done" file))
|
|
|
8778 (if after-load (mapcar 'eval (cdr after-load)))
|
|
|
8779 t) ; return t if everything worked
|
|
|
8780 (efs-del-tmp-name temp)))
|
|
|
8781 (prog2
|
|
|
8782 (or nomessage
|
|
|
8783 (message "Loading %s..." file))
|
|
|
8784 (let (after-load-alist)
|
|
|
8785 (or (efs-real-load filename noerror t t)
|
|
|
8786 (setq after-load nil)))
|
|
|
8787 (or nomessage
|
|
|
8788 (message "Loading %s...done" file))
|
|
|
8789 (if after-load (mapcar 'eval (cdr after-load)))))))))
|
|
|
8790
|
|
|
8791 (defun efs-require (feature &optional filename)
|
|
|
8792 "Documented as original."
|
|
|
8793 (if (eq feature 'ange-ftp) (efs-require-scream-and-yell))
|
|
|
8794 (if (featurep feature)
|
|
|
8795 feature
|
|
|
8796 (or filename (setq filename (symbol-name feature)))
|
|
|
8797 (let ((fullpath (efs-load-openp filename
|
|
|
8798 efs-load-lisp-extensions)))
|
|
|
8799 (if (not fullpath)
|
|
|
8800 (error "Cannot open load file: %s" filename)
|
|
|
8801 (let ((parsed (efs-ftp-path fullpath)))
|
|
|
8802 (if parsed
|
|
|
8803 (let ((temp (car (efs-make-tmp-name nil (car parsed)))))
|
|
|
8804 (unwind-protect
|
|
|
8805 (progn
|
|
|
8806 (efs-copy-file-internal
|
|
|
8807 fullpath parsed temp nil t nil
|
|
|
8808 (format "Getting %s" fullpath))
|
|
|
8809 (or (file-readable-p temp)
|
|
|
8810 (error
|
|
|
8811 "efs-require: temp file %s is unreadable" temp))
|
|
|
8812 (efs-real-require feature temp))
|
|
|
8813 (efs-del-tmp-name temp)))
|
|
|
8814 (efs-real-require feature fullpath)))))))
|
|
|
8815
|
|
|
8816 (defun efs-require-scream-and-yell ()
|
|
|
8817 ;; Complain if something attempts to load ange-ftp.
|
|
|
8818 (with-output-to-temp-buffer "*Help*"
|
|
|
8819 (princ
|
|
|
8820 "Something tried to load ange-ftp.
|
|
|
8821 EFS AND ANGE-FTP DO NOT WORK TOGETHER.
|
|
|
8822
|
|
|
8823 If the culprit package does need to access ange-ftp internal functions,
|
|
|
8824 then it should be adequate to simply remove the \(require 'ange-ftp\)
|
|
|
8825 line and let efs handle remote file access. Otherwise, it will need to
|
|
|
8826 be ported to efs. This may already have been done, and you can find out
|
|
|
8827 by sending an enquiry to efs-help@cuckoo.hpl.hp.com.
|
|
|
8828
|
|
|
8829 Signalling an error with backtrace will allow you to determine which
|
|
|
8830 package was requiring ange-ftp.\n"))
|
|
|
8831 (select-window (get-buffer-window "*Help*"))
|
|
|
8832 (enlarge-window (- (count-lines (point-min) (point-max))
|
|
|
8833 (window-height) -1))
|
|
|
8834 (if (y-or-n-p "Signal error with backtrace? ")
|
|
|
8835 (let ((stack-trace-on-error t))
|
|
|
8836 (error "Attempt to require ange-ftp"))))
|
|
|
8837
|
|
|
8838 ;;;; -----------------------------------------------------------
|
|
|
8839 ;;;; Redefinition of Emacs functions for reading file names.
|
|
|
8840 ;;;; -----------------------------------------------------------
|
|
|
8841
|
|
|
8842 (defun efs-unexpand-parsed-filename (host user path)
|
|
|
8843 ;; Replaces the home directory in path with "~". Returns the unexpanded
|
|
|
8844 ;; full-path.
|
|
|
8845 (let* ((path-len (length path))
|
|
|
8846 (def-user (efs-get-user host))
|
|
|
8847 (host-type (efs-host-type host user))
|
|
|
8848 (ignore-case (memq host-type efs-case-insensitive-host-types)))
|
|
|
8849 (if (> path-len 1)
|
|
|
8850 (let* ((home (efs-expand-tilde "~" host-type host user))
|
|
|
8851 (home-len (length home)))
|
|
|
8852 (if (and (> path-len home-len)
|
|
|
8853 (if ignore-case (string-equal (downcase home)
|
|
|
8854 (downcase
|
|
|
8855 (substring path
|
|
|
8856 0 home-len)))
|
|
|
8857 (string-equal home (substring path 0 home-len)))
|
|
|
8858 (= (aref path home-len) ?/))
|
|
|
8859 (setq path (concat "~" (substring path home-len))))))
|
|
|
8860 (if (if ignore-case (string-equal (downcase user)
|
|
|
8861 (downcase def-user))
|
|
|
8862 (string-equal user def-user))
|
|
|
8863 (format efs-path-format-without-user host path)
|
|
|
8864 (format efs-path-format-string user host path))))
|
|
|
8865
|
|
|
8866 (efs-define-fun efs-abbreviate-file-name (filename)
|
|
|
8867 ;; Version of abbreviate-file-name for remote files.
|
|
|
8868 (efs-save-match-data
|
|
|
8869 (let ((tail directory-abbrev-alist))
|
|
|
8870 (while tail
|
|
|
8871 (if (string-match (car (car tail)) filename)
|
|
|
8872 (setq filename
|
|
|
8873 (concat (cdr (car tail))
|
|
|
8874 (substring filename (match-end 0)))))
|
|
|
8875 (setq tail (cdr tail)))
|
|
|
8876 (apply 'efs-unexpand-parsed-filename (efs-ftp-path filename)))))
|
|
|
8877
|
|
|
8878 (defun efs-default-dir-function ()
|
|
|
8879 (let ((parsed (efs-ftp-path default-directory))
|
|
|
8880 (dd default-directory))
|
|
|
8881 (if parsed
|
|
|
8882 (efs-save-match-data
|
|
|
8883 (let ((tail directory-abbrev-alist))
|
|
|
8884 (while tail
|
|
|
8885 (if (string-match (car (car tail)) dd)
|
|
|
8886 (setq dd (concat (cdr (car tail))
|
|
|
8887 (substring dd (match-end 0)))
|
|
|
8888 parsed nil))
|
|
|
8889 (setq tail (cdr tail)))
|
|
|
8890 (apply 'efs-unexpand-parsed-filename
|
|
|
8891 (or parsed (efs-ftp-path dd)))))
|
|
|
8892 default-directory)))
|
|
|
8893
|
|
|
8894 (defun efs-re-read-dir (&optional dir)
|
|
|
8895 "Forces a re-read of the directory DIR.
|
|
|
8896 If DIR is omitted then it defaults to the directory part of the contents
|
|
|
8897 of the current buffer. This is so this function can be caled from the
|
|
|
8898 minibuffer."
|
|
|
8899 (interactive)
|
|
|
8900 (if dir
|
|
|
8901 (setq dir (expand-file-name dir))
|
|
|
8902 (setq dir (file-name-directory (expand-file-name (buffer-string)))))
|
|
|
8903 (let ((parsed (efs-ftp-path dir)))
|
|
|
8904 (if parsed
|
|
|
8905 (let ((efs-ls-uncache t))
|
|
|
8906 (efs-del-hash-entry (efs-canonize-file-name dir)
|
|
|
8907 efs-files-hashtable)
|
|
|
8908 (efs-get-files dir t)))))
|
|
|
8909
|
|
|
8910 ;;;; ---------------------------------------------------------------
|
|
|
8911 ;;;; Creation and deletion of files and directories.
|
|
|
8912 ;;;; ---------------------------------------------------------------
|
|
|
8913
|
|
|
8914 (defun efs-delete-file (file)
|
|
|
8915 ;; Deletes remote files.
|
|
|
8916 (let* ((file (expand-file-name file))
|
|
|
8917 (parsed (efs-ftp-path file))
|
|
|
8918 (host (car parsed))
|
|
|
8919 (user (nth 1 parsed))
|
|
|
8920 (host-type (efs-host-type host user))
|
|
|
8921 (path (nth 2 parsed))
|
|
|
8922 (abbr (efs-relativize-filename file))
|
|
|
8923 (result (efs-send-cmd host user (list 'delete path)
|
|
|
8924 (format "Deleting %s" abbr))))
|
|
|
8925 (if (car result)
|
|
|
8926 (signal 'ftp-error
|
|
|
8927 (list "Removing old name"
|
|
|
8928 (format "FTP Error: \"%s\"" (nth 1 result))
|
|
|
8929 file)))
|
|
|
8930 (efs-delete-file-entry host-type file)))
|
|
|
8931
|
|
|
8932 (defun efs-make-directory-internal (dir)
|
|
|
8933 ;; version of make-directory-internal for remote directories.
|
|
|
8934 (if (file-exists-p dir)
|
|
|
8935 (error "Cannot make directory %s: file already exists" dir)
|
|
|
8936 (let* ((parsed (efs-ftp-path dir))
|
|
|
8937 (host (nth 0 parsed))
|
|
|
8938 (user (nth 1 parsed))
|
|
|
8939 (host-type (efs-host-type host user))
|
|
|
8940 ;; Some ftp's on unix machines (at least on Suns)
|
|
|
8941 ;; insist that mkdir take a filename, and not a
|
|
|
8942 ;; directory-name name as an arg. Argh!! This is a bug.
|
|
|
8943 ;; Non-unix machines will probably always insist
|
|
|
8944 ;; that mkdir takes a directory-name as an arg
|
|
|
8945 ;; (as the ftp man page says it should).
|
|
|
8946 (path (if (or (memq host-type efs-unix-host-types)
|
|
|
8947 (memq host-type '(os2 dos)))
|
|
|
8948 (efs-internal-directory-file-name (nth 2 parsed))
|
|
|
8949 (efs-internal-file-name-as-directory
|
|
|
8950 host-type (nth 2 parsed))))
|
|
|
8951 (abbr (efs-relativize-filename dir))
|
|
|
8952 (result (efs-send-cmd host user
|
|
|
8953 (list 'mkdir path)
|
|
|
8954 (format "Making directory %s"
|
|
|
8955 abbr))))
|
|
|
8956 (if (car result)
|
|
|
8957 (efs-error host user
|
|
|
8958 (format "Could not make directory %s: %s" dir
|
|
|
8959 (nth 1 result))))
|
|
|
8960 (efs-add-file-entry host-type dir t nil user))))
|
|
|
8961
|
|
|
8962 ;; V19 calls this function delete-directory. It used to be called
|
|
|
8963 ;; remove-directory.
|
|
|
8964
|
|
|
8965 (defun efs-delete-directory (dir)
|
|
|
8966 ;; Version of delete-directory for remote directories.
|
|
|
8967 (if (file-directory-p dir)
|
|
|
8968 (let* ((parsed (efs-ftp-path dir))
|
|
|
8969 (host (nth 0 parsed))
|
|
|
8970 (user (nth 1 parsed))
|
|
|
8971 (host-type (efs-host-type host user))
|
|
|
8972 ;; Some ftp's on unix machines (at least on Suns)
|
|
|
8973 ;; insist that rmdir take a filename, and not a
|
|
|
8974 ;; directory-name name as an arg. Argh!! This is a bug.
|
|
|
8975 ;; Non-unix machines will probably always insist
|
|
|
8976 ;; that rmdir takes a directory-name as an arg
|
|
|
8977 ;; (as the ftp man page says it should).
|
|
|
8978 (path
|
|
|
8979 (if (or (memq host-type efs-unix-host-types)
|
|
|
8980 (memq host-type '(os2 dos)))
|
|
|
8981 (efs-internal-directory-file-name (nth 2 parsed))
|
|
|
8982 (efs-internal-file-name-as-directory
|
|
|
8983 host-type (nth 2 parsed))))
|
|
|
8984 (abbr (efs-relativize-filename dir))
|
|
|
8985 (result (efs-send-cmd host user
|
|
|
8986 (list 'rmdir path)
|
|
|
8987 (format "Deleting directory %s" abbr))))
|
|
|
8988 (if (car result)
|
|
|
8989 (efs-error host user
|
|
|
8990 (format "Could not delete directory %s: %s"
|
|
|
8991 dir (nth 1 result))))
|
|
|
8992 (efs-delete-file-entry host-type dir t))
|
|
|
8993 (error "Not a directory: %s" dir)))
|
|
|
8994
|
|
|
8995 (defun efs-file-local-copy (file)
|
|
|
8996 ;; internal function for diff.el (dired 6.3 or later)
|
|
|
8997 ;; Makes a temp file containing the contents of file.
|
|
|
8998 ;; returns the name of the tmp file created, or nil if none is.
|
|
|
8999 ;; This function should have optional cont and nowait args.
|
|
|
9000 (let* ((file (expand-file-name file))
|
|
|
9001 (tmp (car (efs-make-tmp-name nil (car (efs-ftp-path file))))))
|
|
|
9002 (efs-copy-file-internal file (efs-ftp-path file)
|
|
|
9003 tmp nil t nil (format "Getting %s" file))
|
|
|
9004 tmp))
|
|
|
9005
|
|
|
9006 (defun efs-diff/grep-del-temp-file (temp)
|
|
|
9007 ;; internal function for diff.el and grep.el
|
|
|
9008 ;; if TEMP is non-nil, deletes the temp file TEMP.
|
|
|
9009 ;; if TEMP is nil, does nothing.
|
|
|
9010 (and temp
|
|
|
9011 (efs-del-tmp-name temp)))
|
|
|
9012
|
|
|
9013 ;;;; ------------------------------------------------------------
|
|
|
9014 ;;;; File copying support...
|
|
|
9015 ;;;; ------------------------------------------------------------
|
|
|
9016
|
|
|
9017 ;;; - totally re-written 6/24/92.
|
|
|
9018 ;;; - re-written again 9/3/93
|
|
|
9019 ;;; - and again 14/4/93
|
|
|
9020 ;;; - and again 17/8/93
|
|
|
9021
|
|
|
9022 (defun efs-barf-or-query-if-file-exists (absname querystring interactive)
|
|
|
9023 (if (file-exists-p absname)
|
|
|
9024 (if (not interactive)
|
|
|
9025 (signal 'file-already-exists (list absname))
|
|
|
9026 (if (not (yes-or-no-p (format "File %s already exists; %s anyway? "
|
|
|
9027 absname querystring)))
|
|
|
9028 (signal 'file-already-exists (list absname))))))
|
|
|
9029
|
|
|
9030 (defun efs-concatenate-files (file1 file2)
|
|
|
9031 ;; Concatenates file1 to file2. Both must be local files.
|
|
|
9032 ;; Needed because the efs version of copy-file understands
|
|
|
9033 ;; ok-if-already-exists = 'append
|
|
|
9034 (or (file-readable-p file1)
|
|
|
9035 (signal 'file-error
|
|
|
9036 (list (format "Input file %s not readable." file1))))
|
|
|
9037 (or (file-writable-p file2)
|
|
|
9038 (signal 'file-error
|
|
|
9039 (list (format "Output file %s not writable." file2))))
|
|
|
9040 (let ((default-directory exec-directory))
|
|
|
9041 (call-process "sh" nil nil nil "-c" (format "cat %s >> %s" file1 file2))))
|
|
|
9042
|
|
|
9043 (defun efs-copy-add-file-entry (newname host-type user size append)
|
|
|
9044 ;; Add an entry in `efs-files-hashtable' for a file newly created via a copy.
|
|
|
9045 (if (eq size -1) (setq size nil))
|
|
|
9046 (if append
|
|
|
9047 (let ((ent (efs-get-file-entry newname)))
|
|
|
9048 (if (and ent (null (car ent)))
|
|
|
9049 (if (and size (numberp (nth 1 ent)))
|
|
|
9050 (setcar (cdr ent) (+ size (nth 1 ent)))
|
|
|
9051 (setcar (cdr ent) nil))
|
|
|
9052 ;; If the ent is a symlink or directory, don't overwrite that entry.
|
|
|
9053 (if (null ent)
|
|
|
9054 (efs-add-file-entry host-type newname nil nil nil))))
|
|
|
9055 (efs-add-file-entry host-type newname nil size user)))
|
|
|
9056
|
|
|
9057 (defun efs-copy-remote-to-remote (f-host-type f-host f-user f-path filename
|
|
|
9058 t-host-type t-host t-user
|
|
|
9059 t-path newname append msg cont
|
|
|
9060 nowait xfer-type)
|
|
|
9061 ;; Use a 3rd data connection to copy from F-HOST for F-USER to T-HOST
|
|
|
9062 ;; for T-USER.
|
|
|
9063 (if (efs-get-host-property t-host 'pasv-failed)
|
|
|
9064 ;; PASV didn't work before, don't try again.
|
|
|
9065 (if cont (efs-call-cont cont 'failed "" ""))
|
|
|
9066 (or xfer-type
|
|
|
9067 (setq xfer-type (efs-xfer-type f-host-type filename
|
|
|
9068 t-host-type newname)))
|
|
|
9069 (efs-send-cmd
|
|
|
9070 t-host t-user '(quote pasv) nil nil
|
|
|
9071 (efs-cont (pasv-result pasv-line pasv-cont-lines)
|
|
|
9072 (cont nowait f-host-type f-host f-user f-path filename
|
|
|
9073 t-host-type t-host t-user t-path newname xfer-type msg append)
|
|
|
9074 (efs-save-match-data
|
|
|
9075 (if (or pasv-result
|
|
|
9076 (not (string-match efs-pasv-msgs pasv-line)))
|
|
|
9077 (progn
|
|
|
9078 (efs-set-host-property t-host 'pasv-failed t)
|
|
|
9079 (if cont
|
|
|
9080 (efs-call-cont
|
|
|
9081 cont (or pasv-result 'failed) pasv-line pasv-cont-lines)))
|
|
|
9082 (let ((address (substring pasv-line (match-beginning 1)
|
|
|
9083 (match-end 1))))
|
|
|
9084 (efs-send-cmd
|
|
|
9085 f-host f-user
|
|
|
9086 (list 'quote 'port address) nil nil
|
|
|
9087 (efs-cont (port-result port-line port-cont-lines)
|
|
|
9088 (cont f-host f-user f-host-type f-path filename
|
|
|
9089 xfer-type msg)
|
|
|
9090 (if port-result
|
|
|
9091 (if cont
|
|
|
9092 (efs-call-cont
|
|
|
9093 cont port-result port-line port-cont-lines)
|
|
|
9094 (efs-error f-host f-user
|
|
|
9095 (format "PORT failed for %s: %s"
|
|
|
9096 filename port-line)))
|
|
|
9097 (efs-send-cmd
|
|
|
9098 f-host f-user
|
|
|
9099 (list 'quote 'retr f-path xfer-type)
|
|
|
9100 msg nil
|
|
|
9101 (efs-cont (retr-result retr-line retr-cont-lines)
|
|
|
9102 (cont f-host f-user f-path)
|
|
|
9103 (and retr-result
|
|
|
9104 (null cont)
|
|
|
9105 (efs-error
|
|
|
9106 f-host f-user
|
|
|
9107 (format "RETR failed for %s: %s"
|
|
|
9108 f-path retr-line)))
|
|
|
9109 (if cont (efs-call-cont
|
|
|
9110 cont retr-result retr-line retr-cont-lines)))
|
|
|
9111 (if (eq nowait t) 1 nowait))))
|
|
|
9112 1) ; can't ever wait on this command.
|
|
|
9113 (efs-send-cmd
|
|
|
9114 t-host t-user
|
|
|
9115 (list 'quote (if append 'appe 'stor) t-path xfer-type)
|
|
|
9116 nil nil
|
|
|
9117 (efs-cont (stor-result stor-line stor-cont-lines)
|
|
|
9118 (t-host t-user t-path t-host-type newname filename
|
|
|
9119 append)
|
|
|
9120 (if stor-result
|
|
|
9121 (efs-error
|
|
|
9122 t-host t-user (format "%s failed for %s: %s"
|
|
|
9123 (if append "APPE" "STOR")
|
|
|
9124 t-path stor-line))
|
|
|
9125 (efs-copy-add-file-entry
|
|
|
9126 newname t-host-type t-user
|
|
|
9127 (nth 1 (efs-get-file-entry filename)) append)))
|
|
|
9128 (if (eq nowait t) 1 nowait))))))
|
|
|
9129 nowait)))
|
|
|
9130
|
|
|
9131 (defun efs-copy-on-remote (host user host-type filename newname filename-parsed
|
|
|
9132 newname-parsed keep-date append-p msg cont
|
|
|
9133 nowait xfer-type)
|
|
|
9134 ;; Uses site exec to copy the file on a remote host
|
|
|
9135 (let ((exec-cp (efs-get-host-property host 'exec-cp)))
|
|
|
9136 (if (or append-p
|
|
|
9137 (not (memq host-type efs-unix-host-types))
|
|
|
9138 (efs-get-host-property host 'exec-failed)
|
|
|
9139 (eq exec-cp 'failed))
|
|
|
9140 (efs-copy-via-temp filename filename-parsed newname newname-parsed
|
|
|
9141 append-p keep-date msg cont nowait xfer-type)
|
|
|
9142 (if (eq exec-cp 'works)
|
|
|
9143 (efs-send-cmd
|
|
|
9144 host user
|
|
|
9145 (list 'quote 'site 'exec
|
|
|
9146 (format "cp %s%s %s" (if keep-date "-p " "")
|
|
|
9147 (nth 2 filename-parsed) (nth 2 newname-parsed)))
|
|
|
9148 msg nil
|
|
|
9149 (efs-cont (result line cont-lines) (host user filename newname
|
|
|
9150 host-type filename-parsed
|
|
|
9151 newname-parsed
|
|
|
9152 keep-date append-p msg cont
|
|
|
9153 xfer-type nowait)
|
|
|
9154 (if result
|
|
|
9155 (progn
|
|
|
9156 (efs-set-host-property host 'exec-failed t)
|
|
|
9157 (efs-copy-via-temp filename filename-parsed newname
|
|
|
9158 newname-parsed append-p keep-date
|
|
|
9159 nil cont nowait xfer-type))
|
|
|
9160 (efs-save-match-data
|
|
|
9161 (if (string-match "\n200-\\([^\n]*\\)" cont-lines)
|
|
|
9162 (let ((err (substring cont-lines (match-beginning 1)
|
|
|
9163 (match-end 1))))
|
|
|
9164 (if cont
|
|
|
9165 (efs-call-cont cont 'failed err cont-lines)
|
|
|
9166 (efs-error host user err)))
|
|
|
9167 (efs-copy-add-file-entry
|
|
|
9168 newname host-type user
|
|
|
9169 (nth 7 (efs-file-attributes filename)) nil)
|
|
|
9170 (if cont (efs-call-cont cont nil line cont-lines))))))
|
|
|
9171 nowait)
|
|
|
9172 (message "Checking for cp executable on %s..." host)
|
|
|
9173 (efs-send-cmd
|
|
|
9174 host user (list 'quote 'site 'exec "cp / /") nil nil
|
|
|
9175 (efs-cont (result line cont-lines) (host user filename newname
|
|
|
9176 host-type filename-parsed
|
|
|
9177 newname-parsed
|
|
|
9178 keep-date append-p msg cont
|
|
|
9179 xfer-type nowait)
|
|
|
9180 (efs-save-match-data
|
|
|
9181 (if (string-match "\n200-" cont-lines)
|
|
|
9182 (efs-set-host-property host 'exec-cp 'works)
|
|
|
9183 (efs-set-host-property host 'exec-cp 'failed)))
|
|
|
9184 (efs-copy-on-remote host user host-type filename newname
|
|
|
9185 filename-parsed newname-parsed keep-date
|
|
|
9186 append-p msg cont nowait xfer-type))
|
|
|
9187 nowait)))))
|
|
|
9188
|
|
|
9189 (defun efs-copy-via-temp (filename filename-parsed newname newname-parsed
|
|
|
9190 append keep-date msg cont nowait xfer-type)
|
|
|
9191 ;; Copies from FILENAME to NEWNAME via a temp file.
|
|
|
9192 (let* ((temp (car (if (efs-use-gateway-p (car filename-parsed) t)
|
|
|
9193 (efs-make-tmp-name (car filename-parsed)
|
|
|
9194 (car newname-parsed))
|
|
|
9195 (efs-make-tmp-name (car newname-parsed)
|
|
|
9196 (car filename-parsed)))))
|
|
|
9197 (temp-parsed (efs-ftp-path temp)))
|
|
|
9198 (or xfer-type (setq xfer-type
|
|
|
9199 (efs-xfer-type
|
|
|
9200 (efs-host-type (car filename-parsed)) filename
|
|
|
9201 (efs-host-type (car newname-parsed)) newname
|
|
|
9202 t)))
|
|
|
9203 (efs-copy-file-internal
|
|
|
9204 filename filename-parsed temp temp-parsed t nil (if (eq 0 msg) 2 msg)
|
|
|
9205 (efs-cont (result line cont-lines) (newname newname-parsed temp
|
|
|
9206 temp-parsed append msg cont
|
|
|
9207 nowait xfer-type)
|
|
|
9208 (if result
|
|
|
9209 (progn
|
|
|
9210 (efs-del-tmp-name temp)
|
|
|
9211 (if cont
|
|
|
9212 (efs-call-cont cont result line cont-lines)
|
|
|
9213 (signal 'ftp-error
|
|
|
9214 (list "Opening input file"
|
|
|
9215 (format "FTP Error: \"%s\" " line) filename))))
|
|
|
9216 (efs-copy-file-internal
|
|
|
9217 temp temp-parsed newname newname-parsed (if append 'append t) nil
|
|
|
9218 (if (eq msg 0) 1 msg)
|
|
|
9219 (efs-cont (result line cont-lines) (temp newname cont)
|
|
|
9220 (efs-del-tmp-name temp)
|
|
|
9221 (if cont
|
|
|
9222 (efs-call-cont cont result line cont-lines)
|
|
|
9223 (if result
|
|
|
9224 (signal 'ftp-error
|
|
|
9225 (list "Opening output file"
|
|
|
9226 (format "FTP Error: \"%s\" " line) newname)))))
|
|
|
9227 nowait xfer-type)))
|
|
|
9228 nowait xfer-type)))
|
|
|
9229
|
|
|
9230 (defun efs-copy-file-internal (filename filename-parsed newname newname-parsed
|
|
|
9231 ok-if-already-exists keep-date
|
|
|
9232 &optional msg cont nowait xfer-type)
|
|
|
9233 ;; Internal function for copying a file from FILENAME to NEWNAME.
|
|
|
9234 ;; FILENAME-PARSED and NEWNAME-PARSED are the lists obtained by parsing
|
|
|
9235 ;; FILENAME and NEWNAME with efs-ftp-path.
|
|
|
9236 ;; If OK-IF-ALREADY-EXISTS is nil, then existing files will not be
|
|
|
9237 ;; overwritten.
|
|
|
9238 ;; If it is a number, then the user will be prompted about overwriting.
|
|
|
9239 ;; If it eq 'append, then an existing file will be appended to.
|
|
|
9240 ;; If it has anyother value, then existing files will be silently
|
|
|
9241 ;; overwritten.
|
|
|
9242 ;; If KEEP-DATE is t then we will attempt to reatin the date of the
|
|
|
9243 ;; original copy of the file. If this is a string, the modtime of the
|
|
|
9244 ;; NEWNAME will be set to this date. Must be in touch -t format.
|
|
|
9245 ;; If MSG is nil, then the copying will be done silently.
|
|
|
9246 ;; If it is a string, then that will be the massage displayed while copying.
|
|
|
9247 ;; If it is 0, then a suitable default message will be computed.
|
|
|
9248 ;; If it is 1, then a suitable default will be computed, assuming
|
|
|
9249 ;; that FILENAME is a temporary file, whose name is not suitable to use
|
|
|
9250 ;; in a status message.
|
|
|
9251 ;; If it is 2, then a suitable default will be used, assuming that
|
|
|
9252 ;; NEWNAME is a temporary file.
|
|
|
9253 ;; CONT is a continuation to call after completing the copy.
|
|
|
9254 ;; The first two args are RESULT and LINE, the result symbol and status
|
|
|
9255 ;; line of the FTP command. If more than one ftp command has been used,
|
|
|
9256 ;; then these values for the last FTP command are given.
|
|
|
9257 ;; NOWAIT can be either nil, 0, 1, t. See `efs-send-cmd' for an explanation.
|
|
|
9258 ;; XFER-TYPE is the transfer type to use for transferring the files.
|
|
|
9259 ;; If this is nil, than a suitable transfer type is computed.
|
|
|
9260 ;; Does not call expand-file-name. Do that yourself.
|
|
|
9261
|
|
|
9262 ;; check to see if we can overwrite
|
|
|
9263 (if (or (not ok-if-already-exists)
|
|
|
9264 (numberp ok-if-already-exists))
|
|
|
9265 (efs-barf-or-query-if-file-exists
|
|
|
9266 newname "copy to it" (numberp ok-if-already-exists)))
|
|
|
9267 (if (null (or filename-parsed newname-parsed))
|
|
|
9268 ;; local to local copy
|
|
|
9269 (progn
|
|
|
9270 (if (eq ok-if-already-exists 'append)
|
|
|
9271 (efs-concatenate-files filename newname)
|
|
|
9272 (copy-file filename newname ok-if-already-exists keep-date))
|
|
|
9273 (if cont
|
|
|
9274 (efs-call-cont cont nil "Copied locally" "")))
|
|
|
9275 (let* ((f-host (car filename-parsed))
|
|
|
9276 (f-user (nth 1 filename-parsed))
|
|
|
9277 (f-path (nth 2 filename-parsed))
|
|
|
9278 (f-host-type (efs-host-type f-host f-user))
|
|
|
9279 (f-gate-p (efs-use-gateway-p f-host t))
|
|
|
9280 (t-host (car newname-parsed))
|
|
|
9281 (t-user (nth 1 newname-parsed))
|
|
|
9282 (t-path (nth 2 newname-parsed))
|
|
|
9283 (t-host-type (efs-host-type t-host t-user))
|
|
|
9284 (t-gate-p (efs-use-gateway-p t-host t))
|
|
|
9285 (append-p (eq ok-if-already-exists 'append))
|
|
|
9286 gatename)
|
|
|
9287
|
|
|
9288 (if (and (eq keep-date t) (null newname-parsed))
|
|
|
9289 ;; f-host must be remote now.
|
|
|
9290 (setq keep-date filename))
|
|
|
9291
|
|
|
9292 (cond
|
|
|
9293
|
|
|
9294 ;; Check to see if we can do a PUT
|
|
|
9295 ((or
|
|
|
9296 (and (null f-host)
|
|
|
9297 (or (null t-gate-p)
|
|
|
9298 (setq gatename (efs-local-to-gateway-filename filename))))
|
|
|
9299 (and t-gate-p
|
|
|
9300 f-host
|
|
|
9301 (string-equal (downcase f-host) (downcase efs-gateway-host))
|
|
|
9302 (if (memq f-host-type efs-case-insensitive-host-types)
|
|
|
9303 (string-equal (downcase f-user)
|
|
|
9304 (downcase (efs-get-user efs-gateway-host)))
|
|
|
9305 (string-equal f-user (efs-get-user efs-gateway-host)))))
|
|
|
9306 (or f-host (let (file-name-handler-alist)
|
|
|
9307 (if (file-exists-p filename)
|
|
|
9308 (cond
|
|
|
9309 ((file-directory-p filename)
|
|
|
9310 (signal 'file-error
|
|
|
9311 (list "Non-regular file"
|
|
|
9312 "is a directory" filename)))
|
|
|
9313 ((not (file-readable-p filename))
|
|
|
9314 (signal 'file-error
|
|
|
9315 (list "Opening input file"
|
|
|
9316 "permission denied" filename))))
|
|
|
9317 (signal 'file-error
|
|
|
9318 (list "Opening input file"
|
|
|
9319 "no such file or directory" filename)))))
|
|
|
9320 (or xfer-type
|
|
|
9321 (setq xfer-type
|
|
|
9322 (efs-xfer-type f-host-type filename t-host-type newname)))
|
|
|
9323 (let ((size (and (or (null f-host-type)
|
|
|
9324 (efs-file-entry-p filename))
|
|
|
9325 (nth 7 (file-attributes filename)))))
|
|
|
9326 ;; -1 is a bogus size for remote files
|
|
|
9327 (if (eq size -1) (setq size nil))
|
|
|
9328 (efs-send-cmd
|
|
|
9329 t-host t-user
|
|
|
9330 (list (if append-p 'append 'put)
|
|
|
9331 (if f-host
|
|
|
9332 f-path
|
|
|
9333 (or gatename filename))
|
|
|
9334 t-path
|
|
|
9335 xfer-type)
|
|
|
9336 (cond ((eq msg 2)
|
|
|
9337 (concat (if append-p "Appending " "Putting ")
|
|
|
9338 (efs-relativize-filename filename)))
|
|
|
9339 ((eq msg 1)
|
|
|
9340 (concat (if append-p "Appending " "Putting ")
|
|
|
9341 (efs-relativize-filename newname)))
|
|
|
9342 ((eq msg 0)
|
|
|
9343 (concat (if append-p "Appending " "Copying ")
|
|
|
9344 (efs-relativize-filename filename)
|
|
|
9345 " to "
|
|
|
9346 (efs-relativize-filename
|
|
|
9347 newname (file-name-directory filename) filename)))
|
|
|
9348 (t msg))
|
|
|
9349 (and size (list 'efs-set-xfer-size t-host t-user size))
|
|
|
9350 (efs-cont (result line cont-lines) (newname t-host-type t-user size
|
|
|
9351 append-p cont)
|
|
|
9352 (if result
|
|
|
9353 (if cont
|
|
|
9354 (efs-call-cont cont result line cont-lines)
|
|
|
9355 (signal 'ftp-error
|
|
|
9356 (list "Opening output file"
|
|
|
9357 (format "FTP Error: \"%s\" " line) newname)))
|
|
|
9358 ;; add file entry
|
|
|
9359 (efs-copy-add-file-entry newname t-host-type t-user
|
|
|
9360 size append-p)
|
|
|
9361 (if cont
|
|
|
9362 (efs-call-cont cont result line cont-lines))))
|
|
|
9363 nowait)))
|
|
|
9364
|
|
|
9365 ;; Check to see if we can do a GET
|
|
|
9366 ((and
|
|
|
9367 ;; I think that giving the append arg, will cause this function
|
|
|
9368 ;; to make a temp file, recursively call itself, and append the temp
|
|
|
9369 ;; file to the local file. Hope it works out...
|
|
|
9370 (null append-p)
|
|
|
9371 (or
|
|
|
9372 (and (null t-host)
|
|
|
9373 (or (null f-gate-p)
|
|
|
9374 (setq gatename (efs-local-to-gateway-filename newname))))
|
|
|
9375 (and f-gate-p
|
|
|
9376 t-host
|
|
|
9377 (string-equal (downcase t-host) (downcase efs-gateway-host))
|
|
|
9378 (if (memq t-host-type efs-case-insensitive-host-types)
|
|
|
9379 (string-equal (downcase t-user)
|
|
|
9380 (downcase (efs-get-user efs-gateway-host)))
|
|
|
9381 (string-equal t-user (efs-get-user efs-gateway-host))))))
|
|
|
9382 (or t-host (let (file-name-handler-alist)
|
|
|
9383 (cond ((not (file-writable-p newname))
|
|
|
9384 (signal 'file-error
|
|
|
9385 (list "Opening output file"
|
|
|
9386 "permission denied" newname)))
|
|
|
9387 ((file-directory-p newname)
|
|
|
9388 (signal 'file-error
|
|
|
9389 (list "Opening output file"
|
|
|
9390 "is a directory" newname))))))
|
|
|
9391 (or xfer-type
|
|
|
9392 (setq xfer-type
|
|
|
9393 (efs-xfer-type f-host-type filename t-host-type newname)))
|
|
|
9394 (let ((size (and (or (null f-host-type)
|
|
|
9395 (efs-file-entry-p filename))
|
|
|
9396 (nth 7 (file-attributes filename)))))
|
|
|
9397 ;; -1 is a bogus size for remote files.
|
|
|
9398 (if (eq size -1) (setq size nil))
|
|
|
9399 (efs-send-cmd
|
|
|
9400 f-host f-user
|
|
|
9401 (list 'get
|
|
|
9402 f-path
|
|
|
9403 (if t-host
|
|
|
9404 t-path
|
|
|
9405 (or gatename newname))
|
|
|
9406 xfer-type)
|
|
|
9407 (cond ((eq msg 0)
|
|
|
9408 (concat "Copying "
|
|
|
9409 (efs-relativize-filename filename)
|
|
|
9410 " to "
|
|
|
9411 (efs-relativize-filename
|
|
|
9412 newname (file-name-directory filename) filename)))
|
|
|
9413 ((eq msg 2)
|
|
|
9414 (concat "Getting " (efs-relativize-filename filename)))
|
|
|
9415 ((eq msg 1)
|
|
|
9416 (concat "Getting " (efs-relativize-filename newname)))
|
|
|
9417 (t msg))
|
|
|
9418 ;; If the server emits a efs-xfer-size-msgs, it will over-ride this.
|
|
|
9419 ;; With no xfer msg, this is will do the job.
|
|
|
9420 (and size (list 'efs-set-xfer-size f-host f-user size))
|
|
|
9421 (efs-cont (result line cont-lines) (filename newname size
|
|
|
9422 t-host-type t-user
|
|
|
9423 cont keep-date)
|
|
|
9424 (if result
|
|
|
9425 (if cont
|
|
|
9426 (efs-call-cont cont result line cont-lines)
|
|
|
9427 (signal 'ftp-error
|
|
|
9428 (list "Opening input file"
|
|
|
9429 (format "FTP Error: \"%s\" " line) filename)))
|
|
|
9430 ;; Add a new file entry, if relevant.
|
|
|
9431 (if t-host-type
|
|
|
9432 ;; t-host will be equal to efs-gateway-host, if t-host-type
|
|
|
9433 ;; is non-nil.
|
|
|
9434 (efs-copy-add-file-entry newname t-host-type
|
|
|
9435 t-user size nil))
|
|
|
9436 (if (and (null t-host-type) (stringp keep-date))
|
|
|
9437 (efs-set-mdtm-of
|
|
|
9438 filename newname
|
|
|
9439 (and cont
|
|
|
9440 (efs-cont (result1 line1 cont-lines1) (result
|
|
|
9441 line cont-lines
|
|
|
9442 cont)
|
|
|
9443 (efs-call-cont cont result line cont-lines))))
|
|
|
9444 (if cont
|
|
|
9445 (efs-call-cont cont result line cont-lines)))))
|
|
|
9446 nowait)))
|
|
|
9447
|
|
|
9448 ;; Can we do a EXEC cp?
|
|
|
9449 ((and t-host f-host
|
|
|
9450 (string-equal (downcase t-host) (downcase f-host))
|
|
|
9451 (if (memq t-host-type efs-case-insensitive-host-types)
|
|
|
9452 (string-equal (downcase t-user) (downcase f-user))
|
|
|
9453 (string-equal t-user f-user)))
|
|
|
9454 (efs-copy-on-remote
|
|
|
9455 t-host t-user t-host-type filename newname filename-parsed
|
|
|
9456 newname-parsed keep-date append-p
|
|
|
9457 (cond ((eq msg 0)
|
|
|
9458 (concat "Copying "
|
|
|
9459 (efs-relativize-filename filename)
|
|
|
9460 " to "
|
|
|
9461 (efs-relativize-filename
|
|
|
9462 newname (file-name-directory filename) filename)))
|
|
|
9463 ((eq msg 1)
|
|
|
9464 (concat "Copying " (efs-relativize-filename newname)))
|
|
|
9465 ((eq msg 2)
|
|
|
9466 (concat "Copying " (efs-relativize-filename filename)))
|
|
|
9467 (t msg))
|
|
|
9468 cont nowait xfer-type))
|
|
|
9469
|
|
|
9470 ;; Try for a copy with PASV
|
|
|
9471 ((and t-host f-host
|
|
|
9472 (not (and (string-equal (downcase t-host) (downcase f-host))
|
|
|
9473 (if (memq t-host-type efs-case-insensitive-host-types)
|
|
|
9474 (string-equal (downcase t-user) (downcase f-user))
|
|
|
9475 (string-equal t-user f-user))))
|
|
|
9476 (or
|
|
|
9477 (and efs-gateway-host
|
|
|
9478 ;; The gateway should be able to talk to anything.
|
|
|
9479 (let ((gh (downcase efs-gateway-host)))
|
|
|
9480 (or (string-equal (downcase t-host) gh)
|
|
|
9481 (string-equal (downcase f-host) gh))))
|
|
|
9482 (efs-save-match-data
|
|
|
9483 (eq (null (string-match efs-local-host-regexp t-host))
|
|
|
9484 (null (string-match efs-local-host-regexp f-host))))))
|
|
|
9485 (efs-copy-remote-to-remote
|
|
|
9486 f-host-type f-host f-user f-path filename
|
|
|
9487 t-host-type t-host t-user t-path newname
|
|
|
9488 append-p
|
|
|
9489 (cond ((eq msg 0)
|
|
|
9490 (concat "Copying "
|
|
|
9491 (efs-relativize-filename filename)
|
|
|
9492 " to "
|
|
|
9493 (efs-relativize-filename
|
|
|
9494 newname (file-name-directory filename) filename)))
|
|
|
9495 ((eq msg 1)
|
|
|
9496 (concat "Copying " (efs-relativize-filename newname)))
|
|
|
9497 ((eq msg 2)
|
|
|
9498 (concat "Copying " (efs-relativize-filename filename)))
|
|
|
9499 (t msg))
|
|
|
9500 (efs-cont (result line cont-lines)
|
|
|
9501 (filename filename-parsed newname newname-parsed
|
|
|
9502 append-p keep-date msg cont nowait xfer-type)
|
|
|
9503 (if result
|
|
|
9504 ;; PASV didn't work. Do things the old-fashioned
|
|
|
9505 ;; way.
|
|
|
9506 (efs-copy-via-temp
|
|
|
9507 filename filename-parsed newname newname-parsed
|
|
|
9508 append-p keep-date msg cont nowait xfer-type)
|
|
|
9509 (if cont
|
|
|
9510 (efs-call-cont cont result line cont-lines))))
|
|
|
9511 nowait xfer-type))
|
|
|
9512
|
|
|
9513 ;; Can't do anything direct. Divide and conquer.
|
|
|
9514 (t
|
|
|
9515 (efs-copy-via-temp filename filename-parsed newname newname-parsed
|
|
|
9516 append-p keep-date msg cont nowait xfer-type))))))
|
|
|
9517
|
|
|
9518 (defun efs-copy-file (filename newname &optional ok-if-already-exists
|
|
|
9519 keep-date nowait)
|
|
|
9520 ;; Version of copy file for remote files. Actually, will also work
|
|
|
9521 ;; for local files too, since efs-copy-file-internal can copy anything.
|
|
|
9522 ;; If called interactively, copies asynchronously.
|
|
|
9523 (setq filename (expand-file-name filename)
|
|
|
9524 newname (expand-file-name newname))
|
|
|
9525 (if (eq ok-if-already-exists 'append)
|
|
|
9526 (setq ok-if-already-exists t))
|
|
|
9527 (efs-copy-file-internal filename (efs-ftp-path filename)
|
|
|
9528 newname (efs-ftp-path newname)
|
|
|
9529 ok-if-already-exists keep-date 0 nil nowait))
|
|
|
9530
|
|
|
9531 ;;;; ------------------------------------------------------------
|
|
|
9532 ;;;; File renaming support.
|
|
|
9533 ;;;; ------------------------------------------------------------
|
|
|
9534
|
|
|
9535 (defun efs-rename-get-file-list (dir ent)
|
|
|
9536 ;; From hashtable ENT for DIR returns a list of all files except "."
|
|
|
9537 ;; and "..".
|
|
|
9538 (let (list)
|
|
|
9539 (efs-map-hashtable
|
|
|
9540 (function
|
|
|
9541 (lambda (key val)
|
|
|
9542 (or (string-equal "." key) (string-equal ".." key)
|
|
|
9543 (setq list
|
|
|
9544 (cons (expand-file-name key dir) list)))))
|
|
|
9545 ent)
|
|
|
9546 list))
|
|
|
9547
|
|
|
9548 (defun efs-rename-get-files (dir cont nowait)
|
|
|
9549 ;; Obtains a list of files in directory DIR (except . and ..), and applies
|
|
|
9550 ;; CONT to the list. Doesn't return anything useful.
|
|
|
9551 (let* ((dir (file-name-as-directory dir))
|
|
|
9552 (ent (efs-get-files-hashtable-entry dir)))
|
|
|
9553 (if ent
|
|
|
9554 (efs-call-cont cont (efs-rename-get-file-list dir ent))
|
|
|
9555 (efs-ls
|
|
|
9556 dir (efs-ls-guess-switches) t nil t nowait
|
|
|
9557 (efs-cont (listing) (dir cont)
|
|
|
9558 (efs-call-cont
|
|
|
9559 cont (and listing
|
|
|
9560 (efs-rename-get-file-list
|
|
|
9561 dir (efs-get-files-hashtable-entry dir)))))))))
|
|
|
9562
|
|
|
9563 (defun efs-rename-get-local-file-tree (dir)
|
|
|
9564 ;; Returns a list of the full directory tree under DIR, for DIR on the
|
|
|
9565 ;; local host. The list is in tree order.
|
|
|
9566 (let ((res (list dir)))
|
|
|
9567 (mapcar
|
|
|
9568 (function
|
|
|
9569 (lambda (file)
|
|
|
9570 (if (file-directory-p file)
|
|
|
9571 (nconc res (delq nil (mapcar
|
|
|
9572 (function
|
|
|
9573 (lambda (f)
|
|
|
9574 (and (not (string-equal "." f))
|
|
|
9575 (not (string-equal ".." f))
|
|
|
9576 (expand-file-name f file))))
|
|
|
9577 (directory-files file)))))))
|
|
|
9578 res)
|
|
|
9579 res))
|
|
|
9580
|
|
|
9581 (defun efs-rename-get-remote-file-tree (next curr total cont nowait)
|
|
|
9582 ;; Builds a hierarchy of files.
|
|
|
9583 ;; NEXT is the next level so far.
|
|
|
9584 ;; CURR are unprocessed files in the current level.
|
|
|
9585 ;; TOTAL is the processed files so far.
|
|
|
9586 ;; CONT is a cont. function called on the total list after all files
|
|
|
9587 ;; are processed.
|
|
|
9588 ;; NOWAIT non-nil means run asynch.
|
|
|
9589 (or curr (setq curr next
|
|
|
9590 next nil))
|
|
|
9591 (if curr
|
|
|
9592 (let ((file (car curr)))
|
|
|
9593 (setq curr (cdr curr)
|
|
|
9594 total (cons file total))
|
|
|
9595 (if (file-directory-p file)
|
|
|
9596 (efs-rename-get-files
|
|
|
9597 file
|
|
|
9598 (efs-cont (list) (next curr total cont nowait)
|
|
|
9599 (efs-rename-get-remote-file-tree (nconc next list)
|
|
|
9600 curr total cont nowait))
|
|
|
9601 nowait)
|
|
|
9602 (efs-rename-get-remote-file-tree next curr total cont nowait)))
|
|
|
9603 (efs-call-cont cont (nreverse total))))
|
|
|
9604
|
|
|
9605 (defun efs-rename-make-targets (files from-dir-len to-dir host user host-type
|
|
|
9606 cont nowait)
|
|
|
9607 ;; Make targets (copy a file or make a subdir) on local or host
|
|
|
9608 ;; for the files in list. Afterwhich, call CONT.
|
|
|
9609 (if files
|
|
|
9610 (let* ((from (car files))
|
|
|
9611 (files (cdr files))
|
|
|
9612 (to (concat to-dir (substring from from-dir-len))))
|
|
|
9613 (if (file-directory-p from)
|
|
|
9614 (if host-type
|
|
|
9615 (let ((dir (nth 2 (efs-ftp-path to))))
|
|
|
9616 (or (memq host-type efs-unix-host-types)
|
|
|
9617 (memq host-type '(dos os2))
|
|
|
9618 (setq dir (efs-internal-file-name-as-directory nil dir)))
|
|
|
9619 (efs-send-cmd
|
|
|
9620 host user (list 'mkdir dir)
|
|
|
9621 (format "Making directory %s" (efs-relativize-filename to))
|
|
|
9622 nil
|
|
|
9623 (efs-cont (res line cont-lines) (to files from-dir-len
|
|
|
9624 to-dir host user
|
|
|
9625 host-type cont nowait)
|
|
|
9626 (if res
|
|
|
9627 (if cont
|
|
|
9628 (efs-call-cont cont res line cont-lines)
|
|
|
9629 (signal 'ftp-error
|
|
|
9630 (list "Making directory"
|
|
|
9631 (format "FTP Error: \"%s\"" line)
|
|
|
9632 to)))
|
|
|
9633 (efs-rename-make-targets
|
|
|
9634 files from-dir-len to-dir host user
|
|
|
9635 host-type cont nowait)))
|
|
|
9636 nowait))
|
|
|
9637 (condition-case nil
|
|
|
9638 (make-directory-internal to)
|
|
|
9639 (error (efs-call-cont
|
|
|
9640 cont 'failed (format "Failed to mkdir %s" to) "")))
|
|
|
9641 (efs-rename-make-targets
|
|
|
9642 files from-dir-len to-dir host user host-type cont nowait))
|
|
|
9643 (efs-copy-file-internal
|
|
|
9644 from (efs-ftp-path from) to (and host-type (efs-ftp-path to)) nil t
|
|
|
9645 (format "Renaming %s to %s" (efs-relativize-filename from)
|
|
|
9646 (efs-relativize-filename to))
|
|
|
9647 (efs-cont (res line cont-lines) (from to files from-dir-len to-dir
|
|
|
9648 host user host-type cont
|
|
|
9649 nowait)
|
|
|
9650 (if res
|
|
|
9651 (if cont
|
|
|
9652 (efs-call-cont cont res line cont-lines)
|
|
|
9653 (signal 'ftp-error
|
|
|
9654 (list "Renaming"
|
|
|
9655 (format "FTP Error: \"%s\"" line) from to)))
|
|
|
9656 (efs-rename-make-targets
|
|
|
9657 files from-dir-len to-dir host user host-type cont nowait)))
|
|
|
9658 nowait)))
|
|
|
9659 (if cont (efs-call-cont cont nil "" ""))))
|
|
|
9660
|
|
|
9661 (defun efs-rename-delete-on-local (files)
|
|
|
9662 ;; Delete the files FILES, and then run CONT.
|
|
|
9663 ;; FILES are assumed to be in inverse tree order.
|
|
|
9664 (message "Deleting files...")
|
|
|
9665 (mapcar
|
|
|
9666 (function
|
|
|
9667 (lambda (f)
|
|
|
9668 (condition-case nil
|
|
|
9669 (if (file-directory-p f)
|
|
|
9670 (delete-directory f)
|
|
|
9671 (delete-file f))
|
|
|
9672 (file-error nil)))) ; don't complain if the file is already gone.
|
|
|
9673 files)
|
|
|
9674 (message "Deleting files...done"))
|
|
|
9675
|
|
|
9676 (defun efs-rename-delete-on-remote (files host user host-type cont nowait)
|
|
|
9677 ;; Deletes the list FILES on a remote host. When done calls CONT.
|
|
|
9678 ;; FILES is assumed to be in reverse tree order.
|
|
|
9679 (if files
|
|
|
9680 (let* ((f (car files))
|
|
|
9681 (rf (nth 2 (efs-ftp-path f))))
|
|
|
9682 (progn
|
|
|
9683 (setq files (cdr files))
|
|
|
9684 (if (file-directory-p f)
|
|
|
9685 (let ((rf (if (memq host-type (append efs-unix-host-types
|
|
|
9686 '(dos os2)))
|
|
|
9687 (efs-internal-directory-file-name f)
|
|
|
9688 (efs-internal-file-name-as-directory nil f))))
|
|
|
9689
|
|
|
9690 (efs-send-cmd
|
|
|
9691 host user (list 'rmdir rf)
|
|
|
9692 (concat "Deleting directory " (efs-relativize-filename f))
|
|
|
9693 nil
|
|
|
9694 (efs-cont (res line cont-lines) (f files host user host-type
|
|
|
9695 cont nowait)
|
|
|
9696 (if (and res
|
|
|
9697 (efs-save-match-data
|
|
|
9698 (not (string-match "^550 " line))))
|
|
|
9699 (if cont
|
|
|
9700 (efs-call-cont cont res line cont-lines)
|
|
|
9701 (signal 'ftp-error
|
|
|
9702 (list "Deleting directory"
|
|
|
9703 (format "FTP Error: \"%s\"" line)
|
|
|
9704 f)))
|
|
|
9705 (efs-rename-delete-on-remote
|
|
|
9706 files host user host-type cont nowait)))
|
|
|
9707 nowait))
|
|
|
9708 (efs-send-cmd
|
|
|
9709 host user (list 'delete rf)
|
|
|
9710 (concat "Deleting " rf)
|
|
|
9711 nil
|
|
|
9712 (efs-cont (res line cont-lines) (f files host user host-type
|
|
|
9713 cont nowait)
|
|
|
9714 (if (and res
|
|
|
9715 (efs-save-match-data
|
|
|
9716 (not (string-match "^550 " line))))
|
|
|
9717 (if cont
|
|
|
9718 (efs-call-cont cont res line cont-lines)
|
|
|
9719 (signal 'ftp-error
|
|
|
9720 (list "Deleting"
|
|
|
9721 (format "FTP Error: \"%s\"" line)
|
|
|
9722 f)))
|
|
|
9723 (efs-rename-delete-on-remote
|
|
|
9724 files host user host-type cont nowait)))
|
|
|
9725 nowait))))
|
|
|
9726 (if cont (efs-call-cont cont nil "" ""))))
|
|
|
9727
|
|
|
9728 (defun efs-rename-on-remote (host user old-path new-path old-file new-file
|
|
|
9729 msg nowait cont)
|
|
|
9730 ;; Run a rename command on the remote server.
|
|
|
9731 ;; OLD-PATH and NEW-PATH are in full efs syntax.
|
|
|
9732 ;; OLD-FILE and NEW-FILE are the remote full pathnames, not in efs syntax.
|
|
|
9733 (efs-send-cmd
|
|
|
9734 host user (list 'rename old-file new-file) msg nil
|
|
|
9735 (efs-cont (result line cont-lines) (cont old-path new-path host)
|
|
|
9736 (if result
|
|
|
9737 (progn
|
|
|
9738 (or (and (>= (length line) 4)
|
|
|
9739 (string-equal "550 " (substring line 0 4)))
|
|
|
9740 (efs-set-host-property host 'rnfr-failed t))
|
|
|
9741 (if cont
|
|
|
9742 (efs-call-cont cont result line cont-lines)
|
|
|
9743 (signal 'ftp-error
|
|
|
9744 (list "Renaming"
|
|
|
9745 (format "FTP Error: \"%s\"" line)
|
|
|
9746 old-path new-path))))
|
|
|
9747 (let ((entry (efs-get-file-entry old-path))
|
|
|
9748 (host-type (efs-host-type host))
|
|
|
9749 ;; If no file entry, do extra work on the hashtable,
|
|
|
9750 ;; rather than force a listing.
|
|
|
9751 (dir-p (or (not (efs-file-entry-p old-path))
|
|
|
9752 (file-directory-p old-path))))
|
|
|
9753 (apply 'efs-add-file-entry host-type new-path
|
|
|
9754 (eq (car entry) t) (cdr entry))
|
|
|
9755 (efs-delete-file-entry host-type old-path)
|
|
|
9756 (if dir-p
|
|
|
9757 (let* ((old (efs-canonize-file-name
|
|
|
9758 (file-name-as-directory old-path)))
|
|
|
9759 (new (efs-canonize-file-name
|
|
|
9760 (file-name-as-directory new-path)))
|
|
|
9761 (old-len (length old))
|
|
|
9762 (new-tbl (efs-make-hashtable
|
|
|
9763 (length efs-files-hashtable))))
|
|
|
9764 (efs-map-hashtable
|
|
|
9765 (function
|
|
|
9766 (lambda (key val)
|
|
|
9767 (if (and (>= (length key) old-len)
|
|
|
9768 (string-equal (substring key 0 old-len)
|
|
|
9769 old))
|
|
|
9770 (efs-put-hash-entry
|
|
|
9771 (concat new (substring key old-len)) val new-tbl)
|
|
|
9772 (efs-put-hash-entry key val new-tbl))))
|
|
|
9773 efs-files-hashtable)
|
|
|
9774 (setq efs-files-hashtable new-tbl)))
|
|
|
9775 (if cont (efs-call-cont cont result line cont-lines)))))
|
|
|
9776 nowait))
|
|
|
9777
|
|
|
9778 (defun efs-rename-local-to-remote (filename newname newname-parsed
|
|
|
9779 msg cont nowait)
|
|
|
9780 ;; Renames a file from the local host to a remote host.
|
|
|
9781 (if (file-directory-p filename)
|
|
|
9782 (let* ((files (efs-rename-get-local-file-tree filename))
|
|
|
9783 (to-dir (directory-file-name newname))
|
|
|
9784 (filename (directory-file-name filename))
|
|
|
9785 (len (length filename))
|
|
|
9786 (t-parsed (efs-ftp-path to-dir))
|
|
|
9787 (host (car t-parsed))
|
|
|
9788 (user (nth 1 t-parsed))
|
|
|
9789 (host-type (efs-host-type host)))
|
|
|
9790 ;; MSG is never passed here, instead messages are constructed
|
|
|
9791 ;; internally. I don't know how to use a single message
|
|
|
9792 ;; in a function which sends so many FTP commands.
|
|
|
9793 (efs-rename-make-targets
|
|
|
9794 files len to-dir host user host-type
|
|
|
9795 (efs-cont (result line cont-lines) (files filename newname cont)
|
|
|
9796 (if result
|
|
|
9797 (if cont
|
|
|
9798 (efs-call-cont cont result line cont-lines)
|
|
|
9799 (signal 'ftp-error
|
|
|
9800 (list "Renaming" (format "FTP Error: \"%s\"" line)
|
|
|
9801 filename newname)))
|
|
|
9802 (efs-rename-delete-on-local (nreverse files))
|
|
|
9803 (if cont (efs-call-cont cont result line cont-lines))))
|
|
|
9804 nowait))
|
|
|
9805 (efs-copy-file-internal
|
|
|
9806 filename nil newname newname-parsed t t msg
|
|
|
9807 (efs-cont (result line cont-lines) (filename cont)
|
|
|
9808 (if result
|
|
|
9809 (if cont
|
|
|
9810 (efs-call-cont cont result line cont-lines)
|
|
|
9811 (signal 'ftp-error
|
|
|
9812 (list "Renaming"
|
|
|
9813 (format "FTP Error: \"%s\"" line)
|
|
|
9814 filename newname)))
|
|
|
9815 (condition-case nil
|
|
|
9816 (delete-file filename)
|
|
|
9817 (error nil))
|
|
|
9818 (if cont (efs-call-cont cont result line cont-lines))))
|
|
|
9819 nowait)))
|
|
|
9820
|
|
|
9821 (defun efs-rename-from-remote (filename filename-parsed newname newname-parsed
|
|
|
9822 msg cont nowait)
|
|
|
9823 (let ((f-host (car filename-parsed))
|
|
|
9824 (f-user (nth 1 filename-parsed))
|
|
|
9825 (fast-nowait (if (eq nowait t) 1 nowait)))
|
|
|
9826 (if (file-directory-p filename)
|
|
|
9827 (let* ((t-host (car newname-parsed))
|
|
|
9828 (t-user (nth 1 newname-parsed))
|
|
|
9829 (t-host-type (and t-host (efs-host-type t-host)))
|
|
|
9830 (f-host-type (efs-host-type f-host)))
|
|
|
9831 (efs-rename-get-remote-file-tree
|
|
|
9832 nil (list filename) nil
|
|
|
9833 (efs-cont (list) (filename filename-parsed newname t-host t-user
|
|
|
9834 t-host-type f-host f-user f-host-type
|
|
|
9835 cont fast-nowait)
|
|
|
9836 (efs-rename-make-targets
|
|
|
9837 list (length filename) newname t-host t-user t-host-type
|
|
|
9838 (efs-cont (res line cont-lines) (filename newname f-host f-user
|
|
|
9839 f-host-type list cont
|
|
|
9840 fast-nowait)
|
|
|
9841 (if res
|
|
|
9842 (if cont
|
|
|
9843 (efs-call-cont cont res line cont-lines)
|
|
|
9844 (signal 'ftp-error
|
|
|
9845 (list "Renaming"
|
|
|
9846 (format "FTP Error: \"%s\"" line)
|
|
|
9847 filename newname)))
|
|
|
9848 (efs-rename-delete-on-remote
|
|
|
9849 (nreverse list) f-host f-user f-host-type cont
|
|
|
9850 fast-nowait)))
|
|
|
9851 fast-nowait)) nowait))
|
|
|
9852 ;; Do things the simple way.
|
|
|
9853 (let ((f-path (nth 2 filename-parsed))
|
|
|
9854 (f-abbr (efs-relativize-filename filename)))
|
|
|
9855 (efs-copy-file-internal
|
|
|
9856 filename filename-parsed newname newname-parsed t t msg
|
|
|
9857 (efs-cont (result line cont-lines) (filename newname f-host f-user
|
|
|
9858 f-path f-abbr
|
|
|
9859 cont fast-nowait)
|
|
|
9860 (if result
|
|
|
9861 (if cont
|
|
|
9862 (efs-call-cont cont result line cont-lines)
|
|
|
9863 (signal 'ftp-error
|
|
|
9864 (list "Renaming"
|
|
|
9865 (format "FTP Error: \"%s\"" line)
|
|
|
9866 filename newname)))
|
|
|
9867 (efs-send-cmd
|
|
|
9868 f-host f-user (list 'delete f-path)
|
|
|
9869 (format "Removing %s" f-abbr) nil
|
|
|
9870 (efs-cont (result line cont-lines) (filename f-host cont)
|
|
|
9871 (if result
|
|
|
9872 (if cont
|
|
|
9873 (efs-call-cont cont result line cont-lines)
|
|
|
9874 (signal 'ftp-error
|
|
|
9875 (list "Renaming"
|
|
|
9876 (format "Failed to remove %s"
|
|
|
9877 filename)
|
|
|
9878 "FTP Error: \"%s\"" line)))
|
|
|
9879 (efs-delete-file-entry (efs-host-type f-host)
|
|
|
9880 filename)
|
|
|
9881 (if cont
|
|
|
9882 (efs-call-cont cont result line cont-lines))))
|
|
|
9883 fast-nowait))) nowait)))))
|
|
|
9884
|
|
|
9885 (defun efs-rename-file-internal (filename newname ok-if-already-exists
|
|
|
9886 &optional msg cont nowait)
|
|
|
9887 ;; Internal version of rename-file for remote files.
|
|
|
9888 ;; Takes CONT and NOWAIT args.
|
|
|
9889 (let ((filename (expand-file-name filename))
|
|
|
9890 (newname (expand-file-name newname)))
|
|
|
9891 (let ((f-parsed (efs-ftp-path filename))
|
|
|
9892 (t-parsed (efs-ftp-path newname)))
|
|
|
9893 (if (null (or f-parsed t-parsed))
|
|
|
9894 (progn
|
|
|
9895 ;; local rename
|
|
|
9896 (rename-file filename newname ok-if-already-exists)
|
|
|
9897 (if cont
|
|
|
9898 (efs-call-cont cont nil "Renamed locally" "")))
|
|
|
9899
|
|
|
9900 ;; check to see if we can overwrite
|
|
|
9901 (if (or (not ok-if-already-exists)
|
|
|
9902 (numberp ok-if-already-exists))
|
|
|
9903 (efs-barf-or-query-if-file-exists
|
|
|
9904 newname "rename to it" (numberp ok-if-already-exists)))
|
|
|
9905
|
|
|
9906 (let ((f-abbr (efs-relativize-filename filename))
|
|
|
9907 (t-abbr (efs-relativize-filename newname
|
|
|
9908 (file-name-directory filename)
|
|
|
9909 filename)))
|
|
|
9910 (or msg (setq msg (format "Renaming %s to %s" f-abbr t-abbr)))
|
|
|
9911 (if f-parsed
|
|
|
9912 (let* ((f-host (car f-parsed))
|
|
|
9913 (f-user (nth 1 f-parsed))
|
|
|
9914 (f-path (nth 2 f-parsed))
|
|
|
9915 (f-host-type (efs-host-type f-host)))
|
|
|
9916 (if (and t-parsed
|
|
|
9917 (string-equal (downcase f-host)
|
|
|
9918 (downcase (car t-parsed)))
|
|
|
9919 (not (efs-get-host-property f-host 'rnfr-failed))
|
|
|
9920 (if (memq f-host-type efs-case-insensitive-host-types)
|
|
|
9921 (string-equal (downcase f-user)
|
|
|
9922 (downcase (nth 1 t-parsed)))
|
|
|
9923 (string-equal f-user (nth 1 t-parsed))))
|
|
|
9924 ;; Can run a RENAME command on the server.
|
|
|
9925 (efs-rename-on-remote
|
|
|
9926 f-host f-user filename newname f-path (nth 2 t-parsed)
|
|
|
9927 msg nowait
|
|
|
9928 (efs-cont (result line cont-lines) (f-host
|
|
|
9929 filename
|
|
|
9930 newname
|
|
|
9931 ok-if-already-exists
|
|
|
9932 msg cont nowait)
|
|
|
9933 (if result
|
|
|
9934 (progn
|
|
|
9935 (efs-set-host-property f-host 'rnfr-failed t)
|
|
|
9936 (efs-rename-file-internal
|
|
|
9937 filename newname ok-if-already-exists msg cont
|
|
|
9938 (if (eq nowait t) 1 nowait)))
|
|
|
9939 (if cont
|
|
|
9940 (efs-call-cont cont result line cont-lines)))))
|
|
|
9941 ;; remote to remote
|
|
|
9942 (efs-rename-from-remote filename f-parsed newname t-parsed
|
|
|
9943 msg cont nowait)))
|
|
|
9944 ;; local to remote
|
|
|
9945 (efs-rename-local-to-remote
|
|
|
9946 filename newname t-parsed msg cont nowait)))))))
|
|
|
9947
|
|
|
9948 (defun efs-rename-file (filename newname &optional ok-if-already-exists nowait)
|
|
|
9949 ;; Does file renaming for remote files.
|
|
|
9950 (efs-rename-file-internal filename newname ok-if-already-exists
|
|
|
9951 nil nil nowait))
|
|
|
9952
|
|
|
9953 ;;;; ------------------------------------------------------------
|
|
|
9954 ;;;; Making symbolic and hard links.
|
|
|
9955 ;;;; ------------------------------------------------------------
|
|
|
9956
|
|
|
9957 ;;; These functions require that the remote FTP server understand
|
|
|
9958 ;;; SITE EXEC and that ln is in its the ftp-exec path.
|
|
|
9959
|
|
|
9960 (defun efs-try-ln (host user cont nowait)
|
|
|
9961 ;; Do some preemptive testing to see if exec ln works
|
|
|
9962 (if (efs-get-host-property host 'exec-failed)
|
|
|
9963 (signal 'ftp-error (list "Unable to exec ln on host" host)))
|
|
|
9964 (let ((exec-ln (efs-get-host-property host 'exec-ln)))
|
|
|
9965 (cond
|
|
|
9966 ((eq exec-ln 'failed)
|
|
|
9967 (signal 'ftp-error (list "ln is not in FTP exec path on host" host)))
|
|
|
9968 ((eq exec-ln 'works)
|
|
|
9969 (efs-call-cont cont))
|
|
|
9970 (t
|
|
|
9971 (message "Checking for ln executable on %s..." host)
|
|
|
9972 (efs-send-cmd
|
|
|
9973 host user '(quote site exec "ln / /")
|
|
|
9974 nil nil
|
|
|
9975 (efs-cont (result line cont-lines) (host user cont)
|
|
|
9976 (if result
|
|
|
9977 (progn
|
|
|
9978 (efs-set-host-property host 'exec-failed t)
|
|
|
9979 (efs-error host user (format "exec: %s" line)))
|
|
|
9980 ;; Look for an error message
|
|
|
9981 (if (efs-save-match-data
|
|
|
9982 (string-match "\n200-" cont-lines))
|
|
|
9983 (progn
|
|
|
9984 (efs-set-host-property host 'exec-ln 'works)
|
|
|
9985 (efs-call-cont cont))
|
|
|
9986 (efs-set-host-property host 'exec-ln 'failed)
|
|
|
9987 (efs-error host user
|
|
|
9988 (format "ln not in FTP exec path on host %s" host)))))
|
|
|
9989 nowait)))))
|
|
|
9990
|
|
|
9991 (defun efs-make-symbolic-link-internal
|
|
|
9992 (target linkname &optional ok-if-already-exists cont nowait)
|
|
|
9993 ;; Makes remote symbolic links. Assumes that linkname is already expanded.
|
|
|
9994 (let* ((parsed (efs-ftp-path linkname))
|
|
|
9995 (host (car parsed))
|
|
|
9996 (user (nth 1 parsed))
|
|
|
9997 (linkpath (nth 2 parsed))
|
|
|
9998 (abbr (efs-relativize-filename linkname
|
|
|
9999 (file-name-directory target) target))
|
|
|
10000 (tparsed (efs-ftp-path target))
|
|
|
10001 (com-target target)
|
|
|
10002 cmd-string)
|
|
|
10003 (if (null (file-directory-p
|
|
|
10004 (file-name-directory linkname)))
|
|
|
10005 (if cont
|
|
|
10006 (efs-call-cont cont 'failed
|
|
|
10007 (format "no such file or directory, %s" linkname)
|
|
|
10008 "")
|
|
|
10009 (signal 'file-error (list "no such file or directory" linkname)))
|
|
|
10010 (if (or (not ok-if-already-exists)
|
|
|
10011 (numberp ok-if-already-exists))
|
|
|
10012 (efs-barf-or-query-if-file-exists
|
|
|
10013 linkname "make symbolic link" (numberp ok-if-already-exists)))
|
|
|
10014 ;; Do this after above, so that hopefully the host type is sorted out
|
|
|
10015 ;; by now.
|
|
|
10016 (let ((host-type (efs-host-type host)))
|
|
|
10017 (if (or (not (memq host-type efs-unix-host-types))
|
|
|
10018 (memq host-type efs-dumb-host-types)
|
|
|
10019 (efs-get-host-property host 'exec-failed))
|
|
|
10020 (error "Unable to make symbolic links on %s." host)))
|
|
|
10021 ;; Be careful not to spoil relative links, or symlinks to other
|
|
|
10022 ;; machines, which maybe symlink-fix.el can sort out.
|
|
|
10023 (if (and tparsed
|
|
|
10024 (string-equal (downcase (car tparsed)) (downcase host))
|
|
|
10025 (string-equal (nth 1 tparsed) user))
|
|
|
10026 (setq com-target (nth 2 tparsed)))
|
|
|
10027 ;; symlinks only work for unix, so don't need to
|
|
|
10028 ;; convert pathnames. What about VOS?
|
|
|
10029 (setq cmd-string (concat "ln -sf " com-target " " linkpath))
|
|
|
10030 (efs-try-ln
|
|
|
10031 host user
|
|
|
10032 (efs-cont () (host user cmd-string target linkname com-target
|
|
|
10033 abbr cont nowait)
|
|
|
10034 (efs-send-cmd
|
|
|
10035 host user (list 'quote 'site 'exec cmd-string)
|
|
|
10036 (format "Symlinking %s to %s" target abbr)
|
|
|
10037 nil
|
|
|
10038 (efs-cont (result line cont-lines) (host user com-target linkname
|
|
|
10039 cont)
|
|
|
10040 (if result
|
|
|
10041 (progn
|
|
|
10042 (efs-set-host-property host 'exec-failed t)
|
|
|
10043 (efs-error host user (format "exec: %s" line)))
|
|
|
10044 (efs-save-match-data
|
|
|
10045 (if (string-match "\n200-\\([^\n]*\\)" cont-lines)
|
|
|
10046 (let ((err (substring cont-lines (match-beginning 1)
|
|
|
10047 (match-end 1))))
|
|
|
10048 (if cont
|
|
|
10049 (efs-call-cont cont 'failed err cont-lines)
|
|
|
10050 (efs-error host user err)))
|
|
|
10051 (efs-add-file-entry nil linkname com-target nil user)
|
|
|
10052 (if cont (efs-call-cont cont nil line cont-lines))))))
|
|
|
10053 nowait))
|
|
|
10054 nowait))))
|
|
|
10055
|
|
|
10056 (defun efs-make-symbolic-link (target linkname &optional ok-if-already-exists)
|
|
|
10057 ;; efs version of make-symbolic-link
|
|
|
10058 (let* ((linkname (expand-file-name linkname))
|
|
|
10059 (parsed (efs-ftp-path linkname)))
|
|
|
10060 (if parsed
|
|
|
10061 (efs-make-symbolic-link-internal target linkname ok-if-already-exists)
|
|
|
10062 ;; Handler will match on either target or linkname. We are only
|
|
|
10063 ;; interested in the linkname.
|
|
|
10064 (let ((file-name-handler-alist (efs-file-name-handler-alist-sans-fn
|
|
|
10065 'efs-file-handler-function)))
|
|
|
10066 (make-symbolic-link target linkname ok-if-already-exists)))))
|
|
|
10067
|
|
|
10068 (defun efs-add-name-to-file-internal
|
|
|
10069 (file newname &optional ok-if-already-exists cont nowait)
|
|
|
10070 ;; Makes remote symbolic links. Assumes that linkname is already expanded.
|
|
|
10071 (let* ((parsed (efs-ftp-path file))
|
|
|
10072 (host (car parsed))
|
|
|
10073 (user (nth 1 parsed))
|
|
|
10074 (path (nth 2 parsed))
|
|
|
10075 (nparsed (efs-ftp-path newname))
|
|
|
10076 (nhost (car nparsed))
|
|
|
10077 (nuser (nth 1 nparsed))
|
|
|
10078 (npath (nth 2 nparsed))
|
|
|
10079 (abbr (efs-relativize-filename newname
|
|
|
10080 (file-name-directory file)))
|
|
|
10081 (ent (efs-get-file-entry file))
|
|
|
10082 cmd-string)
|
|
|
10083 (or (and (string-equal (downcase host) (downcase nhost))
|
|
|
10084 (string-equal user nuser))
|
|
|
10085 (error "Cannot create hard links between different host user pairs."))
|
|
|
10086 (if (or (null ent) (stringp (car ent))
|
|
|
10087 (not (file-directory-p
|
|
|
10088 (file-name-directory newname))))
|
|
|
10089 (if cont
|
|
|
10090 (efs-call-cont cont 'failed
|
|
|
10091 (format "no such file or directory, %s %s"
|
|
|
10092 file newname) "")
|
|
|
10093 (signal 'file-error
|
|
|
10094 (list "no such file or directory"
|
|
|
10095 file newname)))
|
|
|
10096 (if (or (not ok-if-already-exists)
|
|
|
10097 (numberp ok-if-already-exists))
|
|
|
10098 (efs-barf-or-query-if-file-exists
|
|
|
10099 newname "make hard link" (numberp ok-if-already-exists)))
|
|
|
10100 ;; Do this last, so that hopefully the host type is known.
|
|
|
10101 (let ((host-type (efs-host-type host)))
|
|
|
10102 (if (or (not (memq host-type efs-unix-host-types))
|
|
|
10103 (memq host-type efs-dumb-host-types)
|
|
|
10104 (efs-get-host-property host 'exec-failed))
|
|
|
10105 (error "Unable to make hard links on %s." host)))
|
|
|
10106 (setq cmd-string (concat "ln -f " path " " npath))
|
|
|
10107 (efs-try-ln
|
|
|
10108 host user
|
|
|
10109 (efs-cont () (host user cmd-string file newname abbr cont nowait)
|
|
|
10110 (efs-send-cmd
|
|
|
10111 host user (list 'quote 'site 'exec cmd-string)
|
|
|
10112 (format "Adding to %s name %s" file abbr)
|
|
|
10113 nil
|
|
|
10114 (efs-cont (result line cont-lines) (host user file newname cont)
|
|
|
10115 (if result
|
|
|
10116 (progn
|
|
|
10117 (efs-set-host-property host 'exec-failed t)
|
|
|
10118 (efs-error host user (format "exec: %s" line)))
|
|
|
10119 (efs-save-match-data
|
|
|
10120 (if (string-match "\n200-\\([^\n]*\\)" cont-lines)
|
|
|
10121 (let ((err (substring cont-lines (match-beginning 1)
|
|
|
10122 (match-end 1))))
|
|
|
10123 (if cont
|
|
|
10124 (efs-call-cont cont 'failed err cont-lines)
|
|
|
10125 (efs-error host user err)))
|
|
|
10126 (let ((ent (efs-get-file-entry file)))
|
|
|
10127 (if ent
|
|
|
10128 (let ((nlinks (nthcdr 4 ent))
|
|
|
10129 new-nlinks)
|
|
|
10130 (and (integerp (car nlinks))
|
|
|
10131 (setq new-nlinks (1+ (car nlinks)))
|
|
|
10132 (setcar nlinks new-nlinks))
|
|
|
10133 (apply 'efs-add-file-entry nil newname ent)
|
|
|
10134 (if cont (efs-call-cont cont nil line cont-lines)))
|
|
|
10135 (let ((tbl (efs-get-files-hashtable-entry
|
|
|
10136 (file-name-directory
|
|
|
10137 (directory-file-name newname)))))
|
|
|
10138 (if tbl
|
|
|
10139 (efs-ls
|
|
|
10140 newname
|
|
|
10141 (concat (efs-ls-guess-switches) "d") t t nil
|
|
|
10142 nowait
|
|
|
10143 (efs-cont (listing) (newname cont line cont-lines)
|
|
|
10144 (efs-update-file-info
|
|
|
10145 newname efs-data-buffer-name)
|
|
|
10146 (if cont
|
|
|
10147 (efs-call-cont cont nil line cont-lines))))
|
|
|
10148 (if cont
|
|
|
10149 (efs-call-cont cont nil line cont-lines))))))))))
|
|
|
10150 nowait))
|
|
|
10151 nowait))))
|
|
|
10152
|
|
|
10153 (defun efs-add-name-to-file (file newname &optional ok-if-already-exists)
|
|
|
10154 ;; efs version of add-name-to-file
|
|
|
10155 (efs-add-name-to-file-internal file newname ok-if-already-exists))
|
|
|
10156
|
|
|
10157
|
|
|
10158 ;;;; ==============================================================
|
|
|
10159 ;;;; >9
|
|
|
10160 ;;;; Multiple Host Type Support.
|
|
|
10161 ;;;; The initial host type guessing is done in the PWD code below.
|
|
|
10162 ;;;; If necessary, further guessing is done in the listing parser.
|
|
|
10163 ;;;; ==============================================================
|
|
|
10164
|
|
|
10165
|
|
|
10166 ;;;; --------------------------------------------------------------
|
|
|
10167 ;;;; Functions for setting and retrieving host types.
|
|
|
10168 ;;;; --------------------------------------------------------------
|
|
|
10169
|
|
|
10170 (defun efs-add-host (type host)
|
|
|
10171 "Sets the TYPE of the remote host HOST.
|
|
|
10172 The host type is read with completion so this can be used to obtain a
|
|
|
10173 list of supported host types. HOST must be a string, giving the name of
|
|
|
10174 the host, exactly as given in file names. Setting the host type with
|
|
|
10175 this function is preferable to setting the efs-TYPE-host-regexp, as look up
|
|
|
10176 will be faster. Returns TYPE."
|
|
|
10177 ;; Since internet host names are always case-insensitive, we will cache
|
|
|
10178 ;; them in lower case.
|
|
|
10179 (interactive
|
|
|
10180 (list
|
|
|
10181 (intern
|
|
|
10182 (completing-read "Host type: "
|
|
|
10183 (mapcar
|
|
|
10184 (function (lambda (elt)
|
|
|
10185 (list (symbol-name (car elt)))))
|
|
|
10186 efs-host-type-alist)
|
|
|
10187 nil t))
|
|
|
10188 (read-string "Host: "
|
|
|
10189 (let ((name (or (buffer-file-name)
|
|
|
10190 (and (eq major-mode 'dired-mode)
|
|
|
10191 dired-directory))))
|
|
|
10192 (and name (car (efs-ftp-path name)))))))
|
|
|
10193 (setq host (downcase host))
|
|
|
10194 (efs-set-host-property host 'host-type type)
|
|
|
10195 (prog1
|
|
|
10196 (setq efs-host-cache host
|
|
|
10197 efs-host-type-cache type)
|
|
|
10198 (efs-set-process-host-type host)))
|
|
|
10199
|
|
|
10200 (defun efs-set-process-host-type (host &optional user)
|
|
|
10201 ;; Sets the value of efs-process-host-type so that it is shown
|
|
|
10202 ;; on the mode-line.
|
|
|
10203 (let ((buff-list (buffer-list)))
|
|
|
10204 (save-excursion
|
|
|
10205 (while buff-list
|
|
|
10206 (set-buffer (car buff-list))
|
|
|
10207 (if (equal efs-process-host host)
|
|
|
10208 (setq efs-process-host-type (concat " " (symbol-name
|
|
|
10209 (efs-host-type host))))
|
|
|
10210 (and efs-show-host-type-in-dired
|
|
|
10211 (eq major-mode 'dired-mode)
|
|
|
10212 efs-dired-host-type
|
|
|
10213 (string-equal (downcase
|
|
|
10214 (car (efs-ftp-path default-directory)))
|
|
|
10215 (downcase host))
|
|
|
10216 (if user
|
|
|
10217 (setq efs-dired-listing-type-string
|
|
|
10218 (concat
|
|
|
10219 " "
|
|
|
10220 (symbol-name (efs-listing-type host user))))
|
|
|
10221 (or efs-dired-listing-type-string
|
|
|
10222 (setq efs-dired-listing-type-string
|
|
|
10223 (concat " " (symbol-name (efs-host-type host))))))))
|
|
|
10224 (setq buff-list (cdr buff-list))))))
|
|
|
10225
|
|
|
10226 ;;;; ----------------------------------------------------------------
|
|
|
10227 ;;;; Functions for setting and retrieving listings types.
|
|
|
10228 ;;;; ----------------------------------------------------------------
|
|
|
10229
|
|
|
10230 ;;; listing types??
|
|
|
10231 ;;; These are distinguished from host types, in case some OS's have two
|
|
|
10232 ;;; breeds of listings. e.g. Unix descriptive listings.
|
|
|
10233 ;;; We also use this to support the myriad of DOS ftp servers.
|
|
|
10234
|
|
|
10235
|
|
|
10236 (defun efs-listing-type (host user)
|
|
|
10237 "Returns the type of listing used on HOST by USER.
|
|
|
10238 If there is no entry for a specialized listing, returns the host type."
|
|
|
10239 (or
|
|
|
10240 (efs-get-host-user-property host user 'listing-type)
|
|
|
10241 (efs-host-type host user)))
|
|
|
10242
|
|
|
10243 (defun efs-add-listing-type (type host user)
|
|
|
10244 "Interactively adds the specialized listing type TYPE for HOST and USER
|
|
|
10245 to the listing type cache."
|
|
|
10246 (interactive
|
|
|
10247 (let ((name (or (buffer-file-name)
|
|
|
10248 (and (eq major-mode 'dired-mode)
|
|
|
10249 dired-directory))))
|
|
|
10250 (list
|
|
|
10251 (intern
|
|
|
10252 (completing-read "Listing type: "
|
|
|
10253 (mapcar
|
|
|
10254 (function (lambda (elt)
|
|
|
10255 (list (symbol-name elt))))
|
|
|
10256 efs-listing-types)
|
|
|
10257 nil t))
|
|
|
10258 (read-string "Host: "
|
|
|
10259 (and name (car (efs-ftp-path name))))
|
|
|
10260 (read-string "User: "
|
|
|
10261 (and name (nth 1 (efs-ftp-path name)))))))
|
|
|
10262 (efs-set-host-user-property host user 'listing-type type)
|
|
|
10263 (efs-set-process-host-type host user))
|
|
|
10264
|
|
|
10265 ;;;; --------------------------------------------------------------
|
|
|
10266 ;;;; Auotomagic bug reporting for unrecognized host types.
|
|
|
10267 ;;;; --------------------------------------------------------------
|
|
|
10268
|
|
|
10269 (defun efs-scream-and-yell-1 (host user)
|
|
|
10270 ;; Internal for efs-scream-and-yell.
|
|
|
10271 (with-output-to-temp-buffer "*Help*"
|
|
|
10272 (princ
|
|
|
10273 (format
|
|
|
10274 "efs is unable to identify the remote host type of %s.
|
|
|
10275
|
|
|
10276 Please report this as a bug. It would be very helpful
|
|
|
10277 if your bug report contained at least the PWD command
|
|
|
10278 within the *ftp %s@%s* buffer.
|
|
|
10279 If you know them, also send the operating system
|
|
|
10280 and ftp server types of the remote host." host user host)))
|
|
|
10281 (if (y-or-n-p "Would you like to submit a bug report now? ")
|
|
|
10282 (efs-report-bug host user
|
|
|
10283 "Bug occurred during efs-guess-host-type." t)))
|
|
|
10284
|
|
|
10285 (defun efs-scream-and-yell (host user)
|
|
|
10286 ;; Advertises that something has gone wrong in identifying the host type.
|
|
|
10287 (if (eq (selected-window) (minibuffer-window))
|
|
|
10288 (efs-abort-recursive-edit-and-then 'efs-scream-and-yell-1 host user)
|
|
|
10289 (efs-scream-and-yell-1 host user)
|
|
|
10290 (error "Unable to identify remote host type")))
|
|
|
10291
|
|
|
10292 ;;;; --------------------------------------------------------
|
|
|
10293 ;;;; Guess at the host type using PWD syntax.
|
|
|
10294 ;;;; --------------------------------------------------------
|
|
|
10295
|
|
|
10296 ;; host-type path templates. These should match a pwd performed
|
|
|
10297 ;; as the first command after connecting. They should be as tight
|
|
|
10298 ;; as possible
|
|
|
10299
|
|
|
10300 (defconst efs-unix-path-template "^/")
|
|
|
10301 (defconst efs-apollo-unix-path-template "^//")
|
|
|
10302 (defconst efs-cms-path-template
|
|
|
10303 (concat
|
|
|
10304 "^[-A-Z0-9$*][-A-Z0-9$*]?[-A-Z0-9$*]?[-A-Z0-9$*]?[-A-Z0-9$*]?"
|
|
|
10305 "[-A-Z0-9$*]?[-A-Z0-9$*]?[-A-Z0-9$*]?\\.[0-9][0-9][0-9A-Z]$\\|"
|
|
|
10306 ;; For the SFS version of CMS
|
|
|
10307 "^[-A-Z0-9]+:[-A-Z0-9$*]+\\.$"))
|
|
|
10308
|
|
|
10309 (defconst efs-mvs-path-template "^'?[A-Z][0-9][0-9]?[0-9]?[0-9]?[0-9]?\\.'?")
|
|
|
10310
|
|
|
10311 (defconst efs-guardian-path-template
|
|
|
10312 (concat
|
|
|
10313 "^\\("
|
|
|
10314 "\\\\[A-Z0-9][A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?\\."
|
|
|
10315 "\\)?"
|
|
|
10316 "\\$[A-Z0-9][A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?\\."
|
|
|
10317 "[A-Z][A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?$"))
|
|
|
10318 ;; guardian and cms are very close to overlapping (they don't). Be careful.
|
|
|
10319 (defconst efs-vms-path-template
|
|
|
10320 "^[-A-Z0-9_$]+:\\[[-A-Z0-9_$]+\\(\\.[-A-Z0-9_$]+\\)*\\]$")
|
|
|
10321 (defconst efs-mts-path-template
|
|
|
10322 "^[A-Z0-9._][A-Z0-9._][A-Z0-9._][A-Z0-9._]:$")
|
|
|
10323 (defconst efs-ms-unix-path-template "^[A-Za-z0-9]:/")
|
|
|
10324
|
|
|
10325 ;; Following two are for TI lisp machines. Note that lisp machines
|
|
|
10326 ;; do not have a default directory, but only a default pathname against
|
|
|
10327 ;; which relative pathnames are merged (Jamie tells me).
|
|
|
10328 (defconst efs-ti-explorer-pwd-line-template
|
|
|
10329 (let* ((excluded-chars ":;<>.#\n\r\t\\/a-z ")
|
|
|
10330 (token (concat "[^" excluded-chars "]+")))
|
|
|
10331 (concat "^250 "
|
|
|
10332 token ": " ; host name
|
|
|
10333 token "\\(\\." token "\\)*; " ; directory
|
|
|
10334 "\\(\\*.\\*\\|\\*\\)#\\(\\*\\|>\\)" ; name, ext, version
|
|
|
10335 "$"))) ; "*.*#*" or "*.*#>" or "*#*" or "*#>" or "#*" ...
|
|
|
10336 (defconst efs-ti-twenex-path-template
|
|
|
10337 (let* ((excluded-chars ":;<>.#\n\r\t\\/a-z ")
|
|
|
10338 (token (concat "[^" excluded-chars "]+")))
|
|
|
10339 (concat "^"
|
|
|
10340 token ":" ; host name
|
|
|
10341 "<\\(" token "\\)?\\(\\." token "\\)*>" ; directory
|
|
|
10342 "\\(\\*.\\*\\|\\*\\)" ; name and extension
|
|
|
10343 "$")))
|
|
|
10344
|
|
|
10345 (defconst efs-tops-20-path-template
|
|
|
10346 "^[-A-Z0-9_$]+:<[-A-Z0-9_$]\\(.[-A-Z0-9_$]+\\)*>$")
|
|
|
10347 (defconst efs-pc-path-template
|
|
|
10348 "^[a-zA-Z0-9]:\\\\\\([-_+=a-zA-Z0-9.]+\\\\\\)*[-_+=a-zA-Z0-9.]*$")
|
|
|
10349 (defconst efs-mpe-path-template
|
|
|
10350 (let ((token (concat "[A-Z][A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?"
|
|
|
10351 "[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?")))
|
|
|
10352 (concat
|
|
|
10353 ;; optional session name
|
|
|
10354 "^\\(" token "\\)?,"
|
|
|
10355 ;; username
|
|
|
10356 token "."
|
|
|
10357 ;; account
|
|
|
10358 token ","
|
|
|
10359 ;; group
|
|
|
10360 token "$")))
|
|
|
10361 (defconst efs-vos-path-template
|
|
|
10362 (let ((token "[][@\\^`{}|~\"$+,---./:_a-zA-Z0-9]+"))
|
|
|
10363 (concat
|
|
|
10364 "%" token ; host
|
|
|
10365 "#" token ; disk
|
|
|
10366 "\\(>" token "\\)+" ; directories
|
|
|
10367 )))
|
|
|
10368 (defconst efs-netware-path-template "^[-A-Z0-9_][-A-Z0-9_/]*:/")
|
|
|
10369 ;; Sometimes netware doesn't return a device to a PWD. Then it will be
|
|
|
10370 ;; recognized by the listing parser.
|
|
|
10371
|
|
|
10372 (defconst efs-nos-ve-path-template "^:[A-Z0-9]")
|
|
|
10373 ;; Matches the path for NOS/VE
|
|
|
10374
|
|
|
10375 (defconst efs-mvs-pwd-line-template
|
|
|
10376 ;; Not sure how the PWD parser will do with empty strings, so treate
|
|
|
10377 ;; this as a line regexp.
|
|
|
10378 "^257 \\([Nn]o prefix defined\\|\"\" is working directory\\)")
|
|
|
10379 (defconst efs-cms-pwd-line-template
|
|
|
10380 "^450 No current working directory defined$")
|
|
|
10381 (defconst efs-tops-20-pwd-line-template
|
|
|
10382 "^500 I never heard of the \\(XPWD\\|PWD\\) command\\. Try HELP\\.$")
|
|
|
10383 (defconst efs-dos:ftp-pwd-line-template
|
|
|
10384 "^250 Current working directory is +")
|
|
|
10385 (defconst efs-coke-pwd-line-template "^257 Current balance \\$[0-9]")
|
|
|
10386
|
|
|
10387 (defconst efs-super-dumb-unix-tilde-regexp
|
|
|
10388 "^550 /.*: No such file or directory\\.?$")
|
|
|
10389 (defconst efs-cms-knet-tilde-regexp
|
|
|
10390 "^501 Invalid CMS fileid: ~$")
|
|
|
10391
|
|
|
10392
|
|
|
10393 ;; It might be nice to message users about the host type identified,
|
|
|
10394 ;; but there is so much other messaging going on, it would not be
|
|
|
10395 ;; seen. No point in slowing things down just so users can read
|
|
|
10396 ;; a host type message.
|
|
|
10397
|
|
|
10398 (defun efs-guess-host-type (host user)
|
|
|
10399 "Guess the host type of HOST.
|
|
|
10400 Does a PWD and examines the directory syntax. The PWD is then cached for use
|
|
|
10401 in file name expansion."
|
|
|
10402 (let ((host-type (efs-host-type host))
|
|
|
10403 (key (concat host "/" user "/~"))
|
|
|
10404 syst)
|
|
|
10405 (efs-save-match-data
|
|
|
10406 (if (eq host-type 'unknown)
|
|
|
10407 ;; Note that efs-host-type returns unknown as the default.
|
|
|
10408 ;; Since we don't yet know the host-type, we use the default
|
|
|
10409 ;; version of efs-send-pwd. We compensate if necessary
|
|
|
10410 ;; by looking at the entire line of output.
|
|
|
10411 (let* ((result (efs-send-pwd nil host user))
|
|
|
10412 (dir (car result))
|
|
|
10413 (line (cdr result)))
|
|
|
10414 (cond
|
|
|
10415
|
|
|
10416 ;; First sift through process lines to see if we recognize
|
|
|
10417 ;; any pwd errors, or full line messages.
|
|
|
10418
|
|
|
10419 ;; CMS
|
|
|
10420 ((string-match efs-cms-pwd-line-template line)
|
|
|
10421 (setq host-type (efs-add-host 'cms host)
|
|
|
10422 dir (concat "/" (if (> (length user) 8)
|
|
|
10423 (substring user 0 8)
|
|
|
10424 user)
|
|
|
10425 ".191"))
|
|
|
10426 (message
|
|
|
10427 "Unable to determine a \"home\" CMS minidisk. Assuming %s"
|
|
|
10428 dir)
|
|
|
10429 (sit-for 1))
|
|
|
10430
|
|
|
10431 ;; TOPS-20
|
|
|
10432 ((string-match efs-tops-20-pwd-line-template line)
|
|
|
10433 (setq host-type (efs-add-host 'tops-20 host)
|
|
|
10434 dir (car (efs-send-pwd 'tops-20 host user))))
|
|
|
10435
|
|
|
10436 ;; TI-EXPLORER lisp machine. pwd works here, but the output
|
|
|
10437 ;; needs to be specially parsed since spaces separate
|
|
|
10438 ;; hostnames from dirs from filenames.
|
|
|
10439 ((string-match efs-ti-explorer-pwd-line-template line)
|
|
|
10440 (setq host-type (efs-add-host 'ti-explorer host)
|
|
|
10441 dir (substring line 4)))
|
|
|
10442
|
|
|
10443 ;; FTP Software's DOS Server
|
|
|
10444 ((string-match efs-dos:ftp-pwd-line-template line)
|
|
|
10445 (setq host-type (efs-add-host 'dos host)
|
|
|
10446 dir (substring line (match-end 0)))
|
|
|
10447 (efs-add-listing-type 'dos:ftp host user))
|
|
|
10448
|
|
|
10449 ;; MVS
|
|
|
10450 ((string-match efs-mvs-pwd-line-template line)
|
|
|
10451 (setq host-type (efs-add-host 'mvs host)
|
|
|
10452 dir "")) ; "" will convert to /, which is always
|
|
|
10453 ; the mvs home dir.
|
|
|
10454
|
|
|
10455 ;; COKE
|
|
|
10456 ((string-match efs-coke-pwd-line-template line)
|
|
|
10457 (setq host-type (efs-add-host 'coke host)
|
|
|
10458 dir "/"))
|
|
|
10459
|
|
|
10460 ;; Try to get tilde.
|
|
|
10461 ((null dir)
|
|
|
10462 (let ((tilde (nth 1 (efs-send-cmd
|
|
|
10463 host user (list 'get "~" "/dev/null")))))
|
|
|
10464 (cond
|
|
|
10465 ;; super dumb unix
|
|
|
10466 ((string-match efs-super-dumb-unix-tilde-regexp tilde)
|
|
|
10467 (setq dir (car (efs-send-pwd 'super-dumb-unix host user))
|
|
|
10468 host-type (efs-add-host 'super-dumb-unix host)))
|
|
|
10469
|
|
|
10470 ;; Try for cms-knet
|
|
|
10471 ((string-match efs-cms-knet-tilde-regexp tilde)
|
|
|
10472 (setq dir (car (efs-send-pwd 'cms-knet host user))
|
|
|
10473 host-type (efs-add-host 'cms-knet host)))
|
|
|
10474
|
|
|
10475 ;; We don't know. Scream and yell.
|
|
|
10476 (efs-scream-and-yell host user))))
|
|
|
10477
|
|
|
10478 ;; Now look at dir to determine host type
|
|
|
10479
|
|
|
10480 ;; try for UN*X-y type stuff
|
|
|
10481 ((string-match efs-unix-path-template dir)
|
|
|
10482 (if
|
|
|
10483 ;; Check for apollo, so we know not to short-circuit //.
|
|
|
10484 (string-match efs-apollo-unix-path-template dir)
|
|
|
10485 (progn
|
|
|
10486 (setq host-type (efs-add-host 'apollo-unix host))
|
|
|
10487 (efs-add-listing-type 'unix:unknown host user))
|
|
|
10488 ;; could be ka9q, dos-distinct, plus any of the unix breeds,
|
|
|
10489 ;; except apollo.
|
|
|
10490 (if (setq syst (efs-get-syst host user))
|
|
|
10491 (let ((case-fold-search t))
|
|
|
10492 (cond
|
|
|
10493 ((string-match "\\bNetware\\b" syst)
|
|
|
10494 (setq host-type (efs-add-host 'netware host)))
|
|
|
10495 ((string-match "^Plan 9" syst)
|
|
|
10496 (setq host-type (efs-add-host 'plan9 host)))
|
|
|
10497 ((string-match "^UNIX" syst)
|
|
|
10498 (setq host-type (efs-add-host 'unix host))
|
|
|
10499 (efs-add-listing-type 'unix:unknown host user)))))))
|
|
|
10500
|
|
|
10501 ;; try for VMS
|
|
|
10502 ((string-match efs-vms-path-template dir)
|
|
|
10503 (setq host-type (efs-add-host 'vms host)))
|
|
|
10504
|
|
|
10505 ;; try for MTS
|
|
|
10506 ((string-match efs-mts-path-template dir)
|
|
|
10507 (setq host-type (efs-add-host 'mts host)))
|
|
|
10508
|
|
|
10509 ;; try for CMS
|
|
|
10510 ((string-match efs-cms-path-template dir)
|
|
|
10511 (setq host-type (efs-add-host 'cms host)))
|
|
|
10512
|
|
|
10513 ;; try for Tandem's guardian OS
|
|
|
10514 ((string-match efs-guardian-path-template dir)
|
|
|
10515 (setq host-type (efs-add-host 'guardian host)))
|
|
|
10516
|
|
|
10517 ;; Try for TOPS-20. pwd doesn't usually work for tops-20
|
|
|
10518 ;; But who knows???
|
|
|
10519 ((string-match efs-tops-20-path-template dir)
|
|
|
10520 (setq host-type (efs-add-host 'tops-20 host)))
|
|
|
10521
|
|
|
10522 ;; Try for DOS or OS/2.
|
|
|
10523 ((string-match efs-pc-path-template dir)
|
|
|
10524 (let ((syst (efs-get-syst host user))
|
|
|
10525 (case-fold-search t))
|
|
|
10526 (if (and syst (string-match "^OS/2 " syst))
|
|
|
10527 (setq host-type (efs-add-host 'os2 host))
|
|
|
10528 (setq host-type (efs-add-host 'dos host)))))
|
|
|
10529
|
|
|
10530 ;; try for TI-TWENEX lisp machine
|
|
|
10531 ((string-match efs-ti-twenex-path-template dir)
|
|
|
10532 (setq host-type (efs-add-host 'ti-twenex host)))
|
|
|
10533
|
|
|
10534 ;; try for MPE
|
|
|
10535 ((string-match efs-mpe-path-template dir)
|
|
|
10536 (setq host-type (efs-add-host 'mpe host)))
|
|
|
10537
|
|
|
10538 ;; try for VOS
|
|
|
10539 ((string-match efs-vos-path-template dir)
|
|
|
10540 (setq host-type (efs-add-host 'vos host)))
|
|
|
10541
|
|
|
10542 ;; try for the microsoft server in unix mode
|
|
|
10543 ((string-match efs-ms-unix-path-template dir)
|
|
|
10544 (setq host-type (efs-add-host 'ms-unix host)))
|
|
|
10545
|
|
|
10546 ;; Netware?
|
|
|
10547 ((string-match efs-netware-path-template dir)
|
|
|
10548 (setq host-type (efs-add-host 'netware host)))
|
|
|
10549
|
|
|
10550 ;; Try for MVS
|
|
|
10551 ((string-match efs-mvs-path-template dir)
|
|
|
10552 (if (string-match "^'.+'$" dir)
|
|
|
10553 ;; broken MVS PWD quoting
|
|
|
10554 (setq dir (substring dir 1 -1)))
|
|
|
10555 (setq host-type (efs-add-host 'mvs host)))
|
|
|
10556
|
|
|
10557 ;; Try for NOS/VE
|
|
|
10558 ((string-match efs-nos-ve-path-template dir)
|
|
|
10559 (setq host-type (efs-add-host 'nos-ve host)))
|
|
|
10560
|
|
|
10561 ;; We don't know. Scream and yell.
|
|
|
10562 (t
|
|
|
10563 (efs-scream-and-yell host user)))
|
|
|
10564
|
|
|
10565 ;; Now that we have done a pwd, might as well put it in
|
|
|
10566 ;; the expand-dir hashtable.
|
|
|
10567 (if dir
|
|
|
10568 (efs-put-hash-entry
|
|
|
10569 key
|
|
|
10570 (efs-internal-directory-file-name
|
|
|
10571 (efs-fix-path host-type dir 'reverse))
|
|
|
10572 efs-expand-dir-hashtable
|
|
|
10573 (memq host-type efs-case-insensitive-host-types))))
|
|
|
10574
|
|
|
10575 ;; host-type has been identified by regexp, set the mode-line.
|
|
|
10576 (efs-set-process-host-type host user)
|
|
|
10577
|
|
|
10578 ;; Some special cases, where we need to store the cwd on login.
|
|
|
10579 (if (not (efs-hash-entry-exists-p
|
|
|
10580 key efs-expand-dir-hashtable))
|
|
|
10581 (cond
|
|
|
10582 ;; CMS: We will be doing cd's, so we'd better make sure that
|
|
|
10583 ;; we know where home is.
|
|
|
10584 ((eq host-type 'cms)
|
|
|
10585 (let* ((res (efs-send-pwd 'cms host user))
|
|
|
10586 (dir (car res))
|
|
|
10587 (line (cdr res)))
|
|
|
10588 (if (and dir (not (string-match
|
|
|
10589 efs-cms-pwd-line-template line)))
|
|
|
10590 (setq dir (concat "/" dir))
|
|
|
10591 (setq dir (concat "/" (if (> (length user) 8)
|
|
|
10592 (substring user 0 8)
|
|
|
10593 user)
|
|
|
10594 ".191"))
|
|
|
10595 (message
|
|
|
10596 "Unable to determine a \"home\" CMS minidisk. Assuming %s"
|
|
|
10597 dir))
|
|
|
10598 (efs-put-hash-entry
|
|
|
10599 key dir efs-expand-dir-hashtable
|
|
|
10600 (memq 'cms efs-case-insensitive-host-types))))
|
|
|
10601 ;; MVS: pwd doesn't work in the root directory, so we stuff this
|
|
|
10602 ;; into the hashtable manually.
|
|
|
10603 ((eq host-type 'mvs)
|
|
|
10604 (efs-put-hash-entry key "/" efs-expand-dir-hashtable))
|
|
|
10605 ))))))
|
|
|
10606
|
|
|
10607
|
|
|
10608 ;;;; -----------------------------------------------------------
|
|
|
10609 ;;;; efs-autoloads
|
|
|
10610 ;;;; These provide the entry points for the non-unix packages.
|
|
|
10611 ;;;; -----------------------------------------------------------
|
|
|
10612
|
|
|
10613 (efs-autoload 'efs-fix-path vms "efs-vms")
|
|
|
10614 (efs-autoload 'efs-fix-path mts "efs-mts")
|
|
|
10615 (efs-autoload 'efs-fix-path cms "efs-cms")
|
|
|
10616 (efs-autoload 'efs-fix-path ti-explorer "efs-ti-explorer")
|
|
|
10617 (efs-autoload 'efs-fix-path ti-twenex "efs-ti-twenex")
|
|
|
10618 (efs-autoload 'efs-fix-path dos "efs-pc")
|
|
|
10619 (efs-autoload 'efs-fix-path mvs "efs-mvs")
|
|
|
10620 (efs-autoload 'efs-fix-path tops-20 "efs-tops-20")
|
|
|
10621 (efs-autoload 'efs-fix-path mpe "efs-mpe")
|
|
|
10622 (efs-autoload 'efs-fix-path os2 "efs-pc")
|
|
|
10623 (efs-autoload 'efs-fix-path vos "efs-vos")
|
|
|
10624 (efs-autoload 'efs-fix-path ms-unix "efs-ms-unix")
|
|
|
10625 (efs-autoload 'efs-fix-path netware "efs-netware")
|
|
|
10626 (efs-autoload 'efs-fix-path cms-knet "efs-cms-knet")
|
|
|
10627 (efs-autoload 'efs-fix-path guardian "efs-guardian")
|
|
|
10628 (efs-autoload 'efs-fix-path nos-ve "efs-nos-ve")
|
|
|
10629
|
|
|
10630 (efs-autoload 'efs-fix-dir-path vms "efs-vms")
|
|
|
10631 (efs-autoload 'efs-fix-dir-path mts "efs-mts")
|
|
|
10632 (efs-autoload 'efs-fix-dir-path cms "efs-cms")
|
|
|
10633 (efs-autoload 'efs-fix-dir-path ti-explorer "efs-ti-explorer")
|
|
|
10634 (efs-autoload 'efs-fix-dir-path ti-twenex "efs-ti-twenex")
|
|
|
10635 (efs-autoload 'efs-fix-dir-path dos "efs-pc")
|
|
|
10636 (efs-autoload 'efs-fix-dir-path mvs "efs-mvs")
|
|
|
10637 (efs-autoload 'efs-fix-dir-path tops-20 "efs-tops-20")
|
|
|
10638 (efs-autoload 'efs-fix-dir-path mpe "efs-mpe")
|
|
|
10639 (efs-autoload 'efs-fix-dir-path os2 "efs-pc")
|
|
|
10640 (efs-autoload 'efs-fix-dir-path vos "efs-vos")
|
|
|
10641 (efs-autoload 'efs-fix-dir-path hell "efs-hell")
|
|
|
10642 (efs-autoload 'efs-fix-dir-path ms-unix "efs-ms-unix")
|
|
|
10643 (efs-autoload 'efs-fix-dir-path netware "efs-netware")
|
|
|
10644 (efs-autoload 'efs-fix-dir-path plan9 "efs-plan9")
|
|
|
10645 (efs-autoload 'efs-fix-dir-path cms-knet "efs-cms-knet")
|
|
|
10646 (efs-autoload 'efs-fix-dir-path guardian "efs-guardian")
|
|
|
10647 (efs-autoload 'efs-fix-dir-path nos-ve "efs-nos-ve")
|
|
|
10648 (efs-autoload 'efs-fix-dir-path coke "efs-coke")
|
|
|
10649
|
|
|
10650 ;; A few need to autoload a pwd function
|
|
|
10651 (efs-autoload 'efs-send-pwd tops-20 "efs-tops-20")
|
|
|
10652 (efs-autoload 'efs-send-pwd cms-knet "efs-cms-knet")
|
|
|
10653 (efs-autoload 'efs-send-pwd ti-explorer "efs-ti-explorer")
|
|
|
10654 (efs-autoload 'efs-send-pwd hell "efs-hell")
|
|
|
10655 (efs-autoload 'efs-send-pwd mvs "efs-mvs")
|
|
|
10656 (efs-autoload 'efs-send-pwd coke "efs-coke")
|
|
|
10657
|
|
|
10658 ;; A few packages are loaded by the listing parser.
|
|
|
10659 (efs-autoload 'efs-parse-listing ka9q "efs-ka9q")
|
|
|
10660 (efs-autoload 'efs-parse-listing unix:dl "efs-dl")
|
|
|
10661 (efs-autoload 'efs-parse-listing dos-distinct "efs-dos-distinct")
|
|
|
10662 (efs-autoload 'efs-parse-listing hell "efs-hell")
|
|
|
10663 (efs-autoload 'efs-parse-listing netware "efs-netware")
|
|
|
10664
|
|
|
10665 ;; Packages that need to autoload for child-lookup
|
|
|
10666 (efs-autoload 'efs-allow-child-lookup plan9 "efs-plan9")
|
|
|
10667 (efs-autoload 'efs-allow-child-lookup coke "efs-coke")
|
|
|
10668
|
|
|
10669 ;; Packages that need to autoload for file-exists-p and file-directory-p
|
|
|
10670 (efs-autoload 'efs-internal-file-exists-p guardian "efs-guardian")
|
|
|
10671 (efs-autoload 'efs-internal-file-directory-p guardian "efs-guardian")
|
|
|
10672
|
|
|
10673
|
|
|
10674
|
|
|
10675 ;;;; ============================================================
|
|
|
10676 ;;;; >10
|
|
|
10677 ;;;; Attaching onto the appropriate Emacs version
|
|
|
10678 ;;;; ============================================================
|
|
|
10679
|
|
|
10680 ;;;; -------------------------------------------------------------------
|
|
|
10681 ;;;; Connect to various hooks.
|
|
|
10682 ;;;; -------------------------------------------------------------------
|
|
|
10683
|
|
|
10684 (or (memq 'efs-set-buffer-mode find-file-hooks)
|
|
|
10685 (setq find-file-hooks
|
|
|
10686 (cons 'efs-set-buffer-mode find-file-hooks)))
|
|
|
10687
|
|
|
10688 ;;; We are using our own dired.el, so this doesn't depend on Emacs flavour.
|
|
|
10689
|
|
|
10690 (if (featurep 'dired)
|
|
|
10691 (require 'efs-dired)
|
|
|
10692 (add-hook 'dired-load-hook (function
|
|
|
10693 (lambda ()
|
|
|
10694 (require 'efs-dired)))))
|
|
|
10695
|
|
|
10696 ;;;; ------------------------------------------------------------
|
|
|
10697 ;;;; Add to minor-mode-alist.
|
|
|
10698 ;;;; ------------------------------------------------------------
|
|
|
10699
|
|
|
10700 (or (assq 'efs-process-host-type minor-mode-alist)
|
|
|
10701 (if (assq 'dired-sort-mode minor-mode-alist)
|
|
|
10702 (let ((our-list
|
|
|
10703 (nconc
|
|
|
10704 (delq nil
|
|
|
10705 (list (assq 'dired-sort-mode minor-mode-alist)
|
|
|
10706 (assq 'dired-subdir-omit minor-mode-alist)
|
|
|
10707 (assq 'dired-marker-stack minor-mode-alist)))
|
|
|
10708 (list '(efs-process-host-type efs-process-host-type)
|
|
|
10709 '(efs-dired-listing-type
|
|
|
10710 efs-dired-listing-type-string))))
|
|
|
10711 (old-list (delq
|
|
|
10712 (assq 'efs-process-host-type minor-mode-alist)
|
|
|
10713 (delq
|
|
|
10714 (assq 'efs-dired-listing-type minor-mode-alist)
|
|
|
10715 minor-mode-alist))))
|
|
|
10716 (setq minor-mode-alist nil)
|
|
|
10717 (while old-list
|
|
|
10718 (or (assq (car (car old-list)) our-list)
|
|
|
10719 (setq minor-mode-alist (nconc minor-mode-alist
|
|
|
10720 (list (car old-list)))))
|
|
|
10721 (setq old-list (cdr old-list)))
|
|
|
10722 (setq minor-mode-alist (nconc our-list minor-mode-alist)))
|
|
|
10723 (setq minor-mode-alist
|
|
|
10724 (nconc
|
|
|
10725 (list '(efs-process-host-type efs-process-host-type)
|
|
|
10726 '(efs-dired-listing-type efs-dired-listing-type-string))
|
|
|
10727 minor-mode-alist))))
|
|
|
10728
|
|
|
10729 ;;;; ------------------------------------------------------------
|
|
|
10730 ;;;; File name handlers
|
|
|
10731 ;;;; ------------------------------------------------------------
|
|
|
10732
|
|
|
10733 (defun efs-file-handler-function (operation &rest args)
|
|
|
10734 "Function to call special file handlers for remote files."
|
|
|
10735 (let ((handler (get operation 'efs)))
|
|
|
10736 (if handler
|
|
|
10737 (apply handler args)
|
|
|
10738 (let ((inhibit-file-name-handlers
|
|
|
10739 (cons 'efs-file-handler-function
|
|
|
10740 (and (eq inhibit-file-name-operation operation)
|
|
|
10741 inhibit-file-name-handlers)))
|
|
|
10742 (inhibit-file-name-operation operation))
|
|
|
10743 (apply operation args)))))
|
|
|
10744
|
|
|
10745 (defun efs-sifn-handler-function (operation &rest args)
|
|
|
10746 ;; Handler function for substitute-in-file-name
|
|
|
10747 (if (eq operation 'substitute-in-file-name)
|
|
|
10748 (apply 'efs-substitute-in-file-name args)
|
|
|
10749 (let ((inhibit-file-name-handlers
|
|
|
10750 (cons 'efs-sifn-handler-function
|
|
|
10751 (and (eq operation inhibit-file-name-operation)
|
|
|
10752 inhibit-file-name-handlers)))
|
|
|
10753 (inhibit-file-name-operation operation))
|
|
|
10754 (apply operation args))))
|
|
|
10755
|
|
|
10756 ;; Yes, this is what it looks like. I'm defining the handler to run our
|
|
|
10757 ;; version whenever there is an environment variable.
|
|
|
10758
|
|
|
10759 (nconc file-name-handler-alist
|
|
|
10760 (list
|
|
|
10761 (cons "\\(^\\|[^$]\\)\\(\\$\\$\\)*\\$[{a-zA-Z0-9]"
|
|
|
10762 'efs-sifn-handler-function)))
|
|
|
10763
|
|
|
10764 ;;;; ------------------------------------------------------------
|
|
|
10765 ;;;; Necessary overloads.
|
|
|
10766 ;;;; ------------------------------------------------------------
|
|
|
10767
|
|
|
10768 ;;; The following functions are overloaded, instead of extended via
|
|
|
10769 ;;; the file-name-handler-alist. For various reasons, the
|
|
|
10770 ;;; file-name-handler-alist doesn't work for them. It would be nice if
|
|
|
10771 ;;; this list could be shortened in the future.
|
|
|
10772
|
|
|
10773 ;; File name exansion. It is not until _after_ a file name has been
|
|
|
10774 ;; expanded that it is reasonable to test it for a file name handler.
|
|
|
10775 (efs-overwrite-fn "efs" 'expand-file-name)
|
|
|
10776
|
|
|
10777 ;; Loading lisp files. The problem with using the file-name-handler-alist
|
|
|
10778 ;; here is that we don't know what is to be handled, until after searching
|
|
|
10779 ;; the load-path. The solution is to change the C code for Fload.
|
|
|
10780 ;; A patch to do this has been written by Jay Adams <jka@ece.cmu.edu>.
|
|
|
10781 (efs-overwrite-fn "efs" 'load)
|
|
|
10782 (efs-overwrite-fn "efs" 'require)
|
|
|
10783
|
|
|
10784 ;;;; ------------------------------------------------------------
|
|
|
10785 ;;;; Install the file handlers for efs-file-handler-function.
|
|
|
10786 ;;;; ------------------------------------------------------------
|
|
|
10787
|
|
|
10788 ;; I/O
|
|
|
10789 (put 'insert-file-contents 'efs 'efs-insert-file-contents)
|
|
|
10790 (put 'write-region 'efs 'efs-write-region)
|
|
|
10791 (put 'directory-files 'efs 'efs-directory-files)
|
|
|
10792 (put 'list-directory 'efs 'efs-list-directory)
|
|
|
10793 (put 'insert-directory 'efs 'efs-insert-directory)
|
|
|
10794 (put 'recover-file 'efs 'efs-recover-file)
|
|
|
10795 ;; file properties
|
|
|
10796 (put 'file-directory-p 'efs 'efs-file-directory-p)
|
|
|
10797 (put 'file-writable-p 'efs 'efs-file-writable-p)
|
|
|
10798 (put 'file-readable-p 'efs 'efs-file-readable-p)
|
|
|
10799 (put 'file-executable-p 'efs 'efs-file-executable-p)
|
|
|
10800 (put 'file-symlink-p 'efs 'efs-file-symlink-p)
|
|
|
10801 (put 'file-attributes 'efs 'efs-file-attributes)
|
|
|
10802 (put 'file-exists-p 'efs 'efs-file-exists-p)
|
|
|
10803 (put 'file-accessible-directory-p 'efs 'efs-file-accessible-directory-p)
|
|
|
10804 ;; manipulating file names
|
|
|
10805 (put 'file-name-directory 'efs 'efs-file-name-directory)
|
|
|
10806 (put 'file-name-nondirectory 'efs 'efs-file-name-nondirectory)
|
|
|
10807 (put 'file-name-as-directory 'efs 'efs-file-name-as-directory)
|
|
|
10808 (put 'directory-file-name 'efs 'efs-directory-file-name)
|
|
|
10809 (put 'abbreviate-file-name 'efs 'efs-abbreviate-file-name)
|
|
|
10810 (put 'file-name-sans-versions 'efs 'efs-file-name-sans-versions)
|
|
|
10811 (put 'unhandled-file-name-directory 'efs 'efs-unhandled-file-name-directory)
|
|
|
10812 (put 'diff-latest-backup-file 'efs 'efs-diff-latest-backup-file)
|
|
|
10813 (put 'file-truename 'efs 'efs-file-truename)
|
|
|
10814 ;; modtimes
|
|
|
10815 (put 'verify-visited-file-modtime 'efs 'efs-verify-visited-file-modtime)
|
|
|
10816 (put 'file-newer-than-file-p 'efs 'efs-file-newer-than-file-p)
|
|
|
10817 (put 'set-visited-file-modtime 'efs 'efs-set-visited-file-modtime)
|
|
|
10818 ;; file modes
|
|
|
10819 (put 'set-file-modes 'efs 'efs-set-file-modes)
|
|
|
10820 (put 'file-modes 'efs 'efs-file-modes)
|
|
|
10821 ;; buffers
|
|
|
10822 (put 'backup-buffer 'efs 'efs-backup-buffer)
|
|
|
10823 (put 'get-file-buffer 'efs 'efs-get-file-buffer)
|
|
|
10824 (put 'create-file-buffer 'efs 'efs-create-file-buffer)
|
|
|
10825 ;; creating and removing files
|
|
|
10826 (put 'delete-file 'efs 'efs-delete-file)
|
|
|
10827 (put 'copy-file 'efs 'efs-copy-file)
|
|
|
10828 (put 'rename-file 'efs 'efs-rename-file)
|
|
|
10829 (put 'file-local-copy 'efs 'efs-file-local-copy)
|
|
|
10830 (put 'make-directory-internal 'efs 'efs-make-directory-internal)
|
|
|
10831 (put 'delete-directory 'efs 'efs-delete-directory)
|
|
|
10832 (put 'add-name-to-file 'efs 'efs-add-name-to-file)
|
|
|
10833 (put 'make-symbolic-link 'efs 'efs-make-symbolic-link)
|
|
|
10834 ;; file name completion
|
|
|
10835 (put 'file-name-completion 'efs 'efs-file-name-completion)
|
|
|
10836 (put 'file-name-all-completions 'efs 'efs-file-name-all-completions)
|
|
|
10837
|
|
|
10838 ;;;; ------------------------------------------------------------
|
|
|
10839 ;;;; Finally run any load-hooks.
|
|
|
10840 ;;;; ------------------------------------------------------------
|
|
|
10841
|
|
|
10842 (run-hooks 'efs-load-hook)
|
|
|
10843
|
|
|
10844 ;;; end of efs.el
|
