|
98
|
1 ;; -*-Emacs-Lisp-*-
|
|
|
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
3 ;;
|
|
|
4 ;; File: efs.el
|
|
|
5 ;; Release: $efs release: 1.15 $
|
|
116
|
6 ;; Version: #Revision: 1.56 $
|
|
98
|
7 ;; RCS:
|
|
|
8 ;; Description: Transparent FTP support for the original GNU Emacs
|
|
118
|
9 ;; from FSF and XEmacs
|
|
98
|
10 ;; Authors: Andy Norman <ange@hplb.hpl.hp.com>,
|
|
|
11 ;; Sandy Rutherford <sandy@ibm550.sissa.it>
|
|
|
12 ;; Created: Thu Oct 12 14:00:05 1989 (as ange-ftp)
|
|
|
13 ;;
|
|
|
14 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
15
|
|
|
16 ;;; The following restrictions apply to all of the files in the efs
|
|
|
17 ;;; distribution.
|
|
|
18 ;;;
|
|
|
19 ;;; Copyright (C) 1993 Andy Norman / Sandy Rutherford
|
|
|
20 ;;;
|
|
|
21 ;;; Authors:
|
|
|
22 ;;; Andy Norman (ange@hplb.hpl.hp.com)
|
|
|
23 ;;; Sandy Rutherford (sandy@ibm550.sissa.it)
|
|
|
24 ;;;
|
|
|
25 ;;; The authors of some of the sub-files of efs are different
|
|
|
26 ;;; from the above. We are very grateful to people who have
|
|
|
27 ;;; contributed code to efs.
|
|
|
28 ;;;
|
|
|
29 ;;; This program is free software; you can redistribute it and/or modify
|
|
|
30 ;;; it under the terms of the GNU General Public License as published by
|
|
|
31 ;;; the Free Software Foundation; either version 1, or (at your option)
|
|
|
32 ;;; any later version.
|
|
|
33 ;;;
|
|
|
34 ;;; This program is distributed in the hope that it will be useful,
|
|
|
35 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
36 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
37 ;;; GNU General Public License for more details.
|
|
|
38 ;;;
|
|
|
39 ;;; A copy of the GNU General Public License can be obtained from this
|
|
|
40 ;;; program's authors (send electronic mail to ange@hplb.hpl.hp.com) or
|
|
|
41 ;;; from the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,
|
|
|
42 ;;; MA 02139, USA.
|
|
|
43
|
|
|
44 ;;; Description:
|
|
|
45 ;;;
|
|
|
46 ;;; This package attempts to make accessing files and directories on
|
|
|
47 ;;; remote computers from within GNU Emacs as simple and transparent
|
|
|
48 ;;; as possible. Currently all remote files are accessed using FTP.
|
|
|
49 ;;; The goal is to make the entire internet accessible as a virtual
|
|
|
50 ;;; file system.
|
|
|
51
|
|
|
52 ;;; Acknowledgements: << please add to this list >>
|
|
|
53 ;;;
|
|
|
54 ;;; Corny de Souza for writing efs-mpe.el.
|
|
|
55 ;;; Jamie Zawinski for writing efs-ti-twenex.el and efs-ti-explorer.el
|
|
|
56 ;;; Joe Wells for writing the first pass at vms support for ange-ftp.el.
|
|
|
57 ;;; Sebastian Kremer for helping with dired support.
|
|
|
58 ;;; Ishikawa Ichiro for MULE support.
|
|
|
59 ;;;
|
|
|
60 ;;; Many other people have contributed code, advice, and beta testing
|
|
|
61 ;;; (sometimes without even realizing it) to both ange-ftp and efs:
|
|
|
62 ;;;
|
|
|
63 ;;; Rob Austein, Doug Bagley, Andy Caiger, Jim Franklin, Noah
|
|
|
64 ;;; Friedman, Aksnes Knut-Havard, Elmar Heeb, John Interrante, Roland
|
|
|
65 ;;; McGrath, Jeff Morgenthaler, Mike Northam, Jens Petersen, Jack
|
|
|
66 ;;; Repenning, Joerg-Martin Schwarz, Michael Sperber, Svein Tjemsland,
|
|
|
67 ;;; Andy Whitcroft, Raymond A. Wiker
|
|
|
68 ;;;
|
|
|
69 ;;; Also, thank you to all the people on the efs-testers mailing list.
|
|
|
70 ;;;
|
|
|
71
|
|
|
72 ;;; --------------------------------------------------------------
|
|
|
73 ;;; Documentation:
|
|
|
74 ;;; --------------------------------------------------------------
|
|
|
75 ;;;
|
|
114
|
76 ;;; If you have any problems with efs, please read this section
|
|
|
77 ;;; *before* submitting a bug report.
|
|
98
|
78
|
|
|
79 ;;; Installation:
|
|
|
80 ;;;
|
|
|
81 ;;; For byte compiling the efs package, a Makefile is provided.
|
|
|
82 ;;; You should follow the instructions at the top of the Makefile.
|
|
|
83 ;;; If you have any problems, please let us know so that we can fix
|
|
|
84 ;;; them for other users. Don't even consider using efs without
|
|
|
85 ;;; byte compiling it. It will be far too slow.
|
|
|
86 ;;;
|
|
|
87 ;;; If you decide to byte compile efs by hand, it is important that
|
|
|
88 ;;; the file efs-defun.el be byte compiled first, followed by efs.el.
|
|
|
89 ;;; The other files may be byte compiled in any order.
|
|
|
90 ;;;
|
|
|
91 ;;; To use efs, simply put the byte compiled files in your load path
|
|
|
92 ;;; and add
|
|
|
93 ;;;
|
|
|
94 ;;; (require 'efs)
|
|
|
95 ;;;
|
|
100
|
96 ;;; in your .emacs file. Note this takes awhile, and some users have
|
|
|
97 ;;; found this to be unbearably slow. Therefore ...
|
|
98
|
98 ;;;
|
|
|
99 ;;; If you would like efs to be autoloaded when you attempt to access
|
|
|
100 ;;; a remote file, put
|
|
|
101 ;;;
|
|
|
102 ;;; (require 'efs-auto)
|
|
|
103 ;;;
|
|
|
104 ;;; in your .emacs file. Note that there are some limitations associated
|
|
|
105 ;;; with autoloading efs. A discussion of them is given at the top of
|
|
|
106 ;;; efs-auto.el.
|
|
|
107
|
|
|
108 ;;; Configuration variables:
|
|
|
109 ;;;
|
|
|
110 ;;; It is important that you read through the section on user customization
|
|
|
111 ;;; variables (search forward for the string ">>>"). If your local network
|
|
|
112 ;;; is not fully connected to the internet, but accesses the internet only
|
|
|
113 ;;; via a gateway, then it is vital to set the appropriate variables to
|
|
|
114 ;;; inform efs about the geometry of your local network. Also, see the
|
|
|
115 ;;; paragraph on gateways below.
|
|
|
116
|
|
|
117 ;;; Usage:
|
|
|
118 ;;;
|
|
|
119 ;;; Once installed, efs operates largely transparently. All files
|
|
|
120 ;;; normally accessible to you on the internet, become part of a large
|
|
|
121 ;;; virtual file system. These files are accessed using an extended
|
|
|
122 ;;; file name syntax. To access file <path> on remote host <host> by
|
|
|
123 ;;; logging in as user <user>, you simply specify the full path of the
|
|
|
124 ;;; file as /<user>@<host>:<path>. Nearly all GNU Emacs file handling
|
|
|
125 ;;; functions work for remote files. It is not possible to access
|
|
|
126 ;;; remote files using shell commands in an emacs *shell* buffer, as such
|
|
|
127 ;;; commands are passed directly to the shell, and not handled by emacs.
|
|
|
128 ;;; FTP is the underlying utility that efs uses to operate on remote files.
|
|
|
129 ;;;
|
|
|
130 ;;; For example, if find-file is given a filename of:
|
|
|
131 ;;;
|
|
|
132 ;;; /ange@anorman:/tmp/notes
|
|
|
133 ;;;
|
|
|
134 ;;; then efs will spawn an FTP process, connect to the host 'anorman' as
|
|
|
135 ;;; user 'ange', get the file '/tmp/notes' and pop up a buffer containing the
|
|
|
136 ;;; contents of that file as if it were on the local file system. If efs
|
|
|
137 ;;; needed a password to connect then it would prompt the user in the
|
|
|
138 ;;; minibuffer. For further discussion of the efs path syntax, see the
|
|
|
139 ;;; paragraph on extended file name syntax below.
|
|
|
140
|
|
|
141 ;;; Ports:
|
|
|
142 ;;;
|
|
|
143 ;;; efs supports the use of nonstandard ports on remote hosts.
|
|
|
144 ;;; To specify that port <port> should be used, give the host name as
|
|
|
145 ;;; host#<port>. Host names may be given in this form anywhere that efs
|
|
|
146 ;;; normally expects a host name. This includes in the .netrc file.
|
|
|
147 ;;; Logically, efs treats different ports to correspond to different
|
|
|
148 ;;; remote hosts.
|
|
|
149
|
|
|
150 ;;; Extended filename syntax:
|
|
|
151 ;;;
|
|
|
152 ;;; The default full efs path syntax is
|
|
|
153 ;;;
|
|
|
154 ;;; /<user>@<host>#<port>:<path>
|
|
|
155 ;;;
|
|
|
156 ;;; Both the `#<port>' and `<user>@' may be omitted.
|
|
|
157 ;;;
|
|
|
158 ;;; If the `#<port>' is omitted, then the default port is taken to be 21,
|
|
|
159 ;;; the usual FTP port. For most users, the port syntax will only
|
|
|
160 ;;; very rarely be necessary.
|
|
|
161 ;;;
|
|
|
162 ;;; If the `<user>@' is omitted, then efs will use a default user. If a
|
|
|
163 ;;; login token is specified in your .netrc file, then this will be used as
|
|
|
164 ;;; the default user for <host>. Otherwise, it is determined based on the
|
|
|
165 ;;; value of the variable efs-default-user.
|
|
|
166 ;;;
|
|
|
167 ;;; This efs path syntax can be customised to a certain extent by
|
|
|
168 ;;; changing a number of variables in the subsection Internal Variables.
|
|
|
169 ;;; To undertake such a customization requires some knowledge about the
|
|
|
170 ;;; internal workings of efs.
|
|
|
171
|
|
|
172 ;;; Passwords:
|
|
|
173 ;;;
|
|
|
174 ;;; A password is required for each host / user pair. This will be
|
|
|
175 ;;; prompted for when needed, unless already set by calling
|
|
|
176 ;;; efs-set-passwd, or specified in a *valid* ~/.netrc file.
|
|
|
177 ;;;
|
|
|
178 ;;; When efs prompts for a password, it provides defaults from its
|
|
|
179 ;;; cache of currently known passwords. The defaults are ordered such
|
|
|
180 ;;; that passwords for accounts which have the same user name as the
|
|
|
181 ;;; login which is currently underway have priority. You can cycle
|
|
|
182 ;;; through your list of defaults with C-n to cycle forwards and C-p
|
|
|
183 ;;; to cycle backwards. The list is circular.
|
|
|
184
|
|
|
185 ;;; Passwords for user "anonymous":
|
|
|
186 ;;;
|
|
|
187 ;;; Passwords for the user "anonymous" (or "ftp") are handled
|
|
|
188 ;;; specially. The variable efs-generate-anonymous-password controls
|
|
|
189 ;;; what happens. If the value of this variable is a string, then this
|
|
|
190 ;;; is used as the password; if non-nil, then a password is created
|
|
|
191 ;;; from the name of the user and the hostname of the machine on which
|
|
|
192 ;;; GNU Emacs is running; if nil (the default) then the user is
|
|
|
193 ;;; prompted for a password as normal.
|
|
|
194
|
|
|
195 ;;; "Dumb" UNIX hosts:
|
|
|
196 ;;;
|
|
|
197 ;;; The FTP servers on some UNIX machines have problems if the "ls"
|
|
|
198 ;;; command is used. efs will try to correct for this automatically,
|
|
|
199 ;;; and send the "dir" command instead. If it fails, you can call the
|
|
|
200 ;;; function efs-add-host, and give the host type as dumb-unix. Note
|
|
|
201 ;;; that this change will take effect for the current GNU Emacs
|
|
|
202 ;;; session only. To make this specification for future emacs
|
|
|
203 ;;; sessions, put
|
|
|
204 ;;;
|
|
|
205 ;;; (efs-add-host 'dumb-unix "hostname")
|
|
|
206 ;;;
|
|
|
207 ;;; in your .emacs file. Also, please report any failure to automatically
|
|
|
208 ;;; recognize dumb unix to the "bugs" address given below, so that we can
|
|
|
209 ;;; fix the auto recognition code.
|
|
|
210
|
|
|
211 ;;; File name completion:
|
|
|
212 ;;;
|
|
|
213 ;;; Full file-name completion is supported on every type of remote
|
|
|
214 ;;; host. To do filename completion, efs needs a listing from the
|
|
|
215 ;;; remote host. Therefore, for very slow connections, it might not
|
|
|
216 ;;; save any time. However, the listing is cached, so subsequent uses
|
|
|
217 ;;; of file-name completion will be just as fast as for local file
|
|
|
218 ;;; names.
|
|
|
219
|
|
|
220 ;;; FTP processes:
|
|
|
221 ;;;
|
|
|
222 ;;; When efs starts up an FTP process, it leaves it running for speed
|
|
|
223 ;;; purposes. Some FTP servers will close the connection after a period of
|
|
|
224 ;;; time, but efs should be able to quietly reconnect the next time that
|
|
|
225 ;;; the process is needed.
|
|
|
226 ;;;
|
|
|
227 ;;; The FTP process will be killed should the associated "*ftp user@host*"
|
|
|
228 ;;; buffer be deleted. This should not cause efs any grief.
|
|
|
229
|
|
|
230 ;;; Showing background FTP activity on the mode-line:
|
|
|
231 ;;;
|
|
|
232 ;;; After efs is loaded, the command efs-display-ftp-activity will cause
|
|
|
233 ;;; background FTP activity to be displayed on the mode line. The variable
|
|
|
234 ;;; efs-mode-line-format is used to determine how this data is displayed.
|
|
|
235 ;;; efs does not continuously track the number of active sessions, as this
|
|
|
236 ;;; would cause the display to change too rapidly. Rather, it uses a heuristic
|
|
|
237 ;;; algorithm to determine when there is a significant change in FTP activity.
|
|
|
238
|
|
|
239 ;;; File types:
|
|
|
240 ;;;
|
|
|
241 ;;; By default efs will assume that all files are ASCII. If a file
|
|
|
242 ;;; being transferred matches the value of efs-binary-file-name-regexp
|
|
|
243 ;;; then the file will be assumed to be a binary file, and efs will
|
|
|
244 ;;; transfer it using "type image". ASCII files will be transferred
|
|
|
245 ;;; using a transfer type which efs computes to be correct according
|
|
|
246 ;;; to its knowledge of the file system of the remote host. The
|
|
|
247 ;;; command `efs-prompt-for-transfer-type' toggles the variable
|
|
|
248 ;;; `efs-prompt-for-transfer-type'. When this variable is non-nil, efs
|
|
|
249 ;;; will prompt the user for the transfer type to use for every FTP
|
|
|
250 ;;; transfer. Having this set all the time is annoying, but it is
|
|
|
251 ;;; useful to give special treatment to a small set of files.
|
|
|
252 ;;; There is also variable efs-text-file-name-regexp. This is tested before
|
|
|
253 ;;; efs-binary-file-name-regexp, so if you set efs-text-file-name-regexp
|
|
|
254 ;;; to a non-trivial regular expression, and efs-binary-file-name-regexp
|
|
|
255 ;;; to ".*", the result will to make image the default tranfer type.
|
|
|
256 ;;;
|
|
|
257 ;;; Also, if you set efs-treat-crlf-as-nl, then efs will use type image
|
|
|
258 ;;; to transfer files between hosts whose file system differ only in that
|
|
|
259 ;;; one specifies end of line as CR-LF, and the other as NL. This is useful
|
|
|
260 ;;; if you are transferring files between UNIX and DOS machines, and have a
|
|
|
261 ;;; package such as dos-mode.el, that handles the extra ^M's.
|
|
|
262
|
|
|
263 ;;; Account passwords:
|
|
|
264 ;;;
|
|
|
265 ;;; Some FTP servers require an additional password which is sent by
|
|
|
266 ;;; the ACCOUNT command. efs will detect this and prompt the user for
|
|
|
267 ;;; an account password if the server expects one. Also, an account
|
|
|
268 ;;; password can be set by calling efs-set-account, or by specifying
|
|
|
269 ;;; an account token in the .netrc file.
|
|
|
270 ;;;
|
|
|
271 ;;; Some operating systems, such as CMS, require that ACCOUNT be used to
|
|
|
272 ;;; give a write access password for minidisks. efs-set-account can be used
|
|
|
273 ;;; to set a write password for a specific minidisk. Also, tokens of the form
|
|
|
274 ;;; minidisk <minidisk name> <password>
|
|
|
275 ;;; may be added to host lines in your .netrc file. Minidisk tokens must be
|
|
|
276 ;;; at the end of the host line, however there may be an arbitrary number of
|
|
|
277 ;;; them for any given host.
|
|
|
278
|
|
|
279 ;;; Preloading:
|
|
|
280 ;;;
|
|
|
281 ;;; efs can be preloaded, but must be put in the site-init.el file and
|
|
|
282 ;;; not the site-load.el file in order for the documentation strings for the
|
|
|
283 ;;; functions being overloaded to be available.
|
|
|
284
|
|
|
285 ;;; Status reports:
|
|
|
286 ;;;
|
|
|
287 ;;; Most efs commands that talk to the FTP process output a status
|
|
|
288 ;;; message on what they are doing. In addition, efs can take advantage
|
|
|
289 ;;; of the FTP client's HASH command to display the status of transferring
|
|
|
290 ;;; files and listing directories. See the documentation for the variables
|
|
|
291 ;;; efs-hash-mark-size, efs-send-hash and efs-verbose for more details.
|
|
|
292
|
|
|
293 ;;; Caching of directory information:
|
|
|
294 ;;;
|
|
|
295 ;;; efs keeps an internal cache of file listings from remote hosts.
|
|
|
296 ;;; If this cache gets out of synch, it can be renewed by reverting a
|
|
|
297 ;;; dired buffer for the appropriate directory (dired-revert is usually
|
|
|
298 ;;; bound to "g").
|
|
|
299 ;;;
|
|
|
300 ;;; Alternatively, you can add the following two lines to your .emacs file
|
|
|
301 ;;; if you want C-r to refresh efs's cache whilst doing filename
|
|
|
302 ;;; completion.
|
|
|
303 ;;; (define-key minibuffer-local-completion-map "\C-r" 'efs-re-read-dir)
|
|
|
304 ;;; (define-key minibuffer-local-must-match-map "\C-r" 'efs-re-read-dir)
|
|
|
305
|
|
|
306 ;;; Gateways:
|
|
|
307 ;;;
|
|
114
|
308 ;;; Sometimes it is necessary for the FTP process to be run on a different
|
|
98
|
309 ;;; machine than the machine running GNU Emacs. This can happen when the
|
|
|
310 ;;; local machine has restrictions on what hosts it can access.
|
|
|
311 ;;;
|
|
|
312 ;;; efs has support for running the ftp process on a different (gateway)
|
|
|
313 ;;; machine. The way it works is as follows:
|
|
|
314 ;;;
|
|
|
315 ;;; 1) Set the variable 'efs-gateway-host' to the name of a machine
|
|
|
316 ;;; that doesn't have the access restrictions. If you need to use
|
|
|
317 ;;; a nonstandard port to access this host for gateway use, then
|
|
|
318 ;;; specify efs-gateway-host as "<hostname>#<port>".
|
|
|
319 ;;;
|
|
|
320 ;;; 2) Set the variable 'efs-ftp-local-host-regexp' to a regular expression
|
|
|
321 ;;; that matches hosts that can be contacted from running a local ftp
|
|
|
322 ;;; process, but fails to match hosts that can't be accessed locally. For
|
|
|
323 ;;; example:
|
|
|
324 ;;;
|
|
|
325 ;;; "\\.hp\\.com$\\|^[^.]*$"
|
|
|
326 ;;;
|
|
|
327 ;;; will match all hosts that are in the .hp.com domain, or don't have an
|
|
|
328 ;;; explicit domain in their name, but will fail to match hosts with
|
|
|
329 ;;; explicit domains or that are specified by their ip address.
|
|
|
330 ;;;
|
|
|
331 ;;; 3) Set the variable `efs-local-host-regexp' to machines that you have
|
|
|
332 ;;; direct TCP/IP access. In other words, you must be able to ping these
|
|
|
333 ;;; hosts. Usually, efs-ftp-local-host-regexp and efs-local-host-regexp
|
|
|
334 ;;; will be the same. However, they will differ for so-called transparent
|
|
|
335 ;;; gateways. See #7 below for more details.
|
|
|
336 ;;;
|
|
|
337 ;;; 4) Set the variable 'efs-gateway-tmp-name-template' to the name of
|
|
|
338 ;;; a directory plus an identifying filename prefix for making temporary
|
|
|
339 ;;; files on the gateway. For example: "/tmp/hplose/ange/efs"
|
|
|
340 ;;;
|
|
|
341 ;;; 5) If the gateway and the local host share cross-mounted directories,
|
|
|
342 ;;; set the value of `efs-gateway-mounted-dirs-alist' accordingly. It
|
|
|
343 ;;; is particularly useful, but not mandatory, that the directory
|
|
|
344 ;;; of `efs-gateway-tmp-name-template' be cross-mounted.
|
|
|
345 ;;;
|
|
|
346 ;;; 6) Set the variable `efs-gateway-type' to the type gateway that you have.
|
|
|
347 ;;; This variable is a list, the first element of which is a symbol
|
|
|
348 ;;; denoting the type of gateway. Following elements give further
|
|
|
349 ;;; data on the gateway.
|
|
|
350 ;;;
|
|
|
351 ;;; Supported gateway types:
|
|
|
352 ;;;
|
|
|
353 ;;; a) local:
|
|
|
354 ;;; This means that your local host is itself the gateway. However,
|
|
|
355 ;;; it is necessary to use a different FTP client to gain access to
|
|
|
356 ;;; the outside world. If the name of the FTP client were xftp, you might
|
|
|
357 ;;; set efs-gateway-type to
|
|
|
358 ;;;
|
|
|
359 ;;; (list 'local "xftp" efs-ftp-program-args)
|
|
|
360 ;;;
|
|
|
361 ;;; If xftp required special arguments, then give them in place of
|
|
|
362 ;;; efs-ftp-program-args. See the documentation for efs-ftp-program-args
|
|
|
363 ;;; for the syntax.
|
|
|
364 ;;;
|
|
|
365 ;;; b) proxy:
|
|
|
366 ;;; This indicates that your gateway works by first FTP'ing to it, and
|
|
|
367 ;;; then issuing a USER command of the form
|
|
|
368 ;;;
|
|
|
369 ;;; USER <username>@<host>
|
|
|
370 ;;;
|
|
|
371 ;;; In this case, you might set efs-gateway-type to
|
|
|
372 ;;;
|
|
|
373 ;;; (list 'proxy "ftp" efs-ftp-program-args)
|
|
|
374 ;;;
|
|
|
375 ;;; If you need to use a nonstandard client, such as iftp, give this
|
|
|
376 ;;; instead of "ftp". If this client needs to take special arguments,
|
|
|
377 ;;; give them instead of efs-ftp-program-args.
|
|
|
378 ;;;
|
|
|
379 ;;; c) remsh:
|
|
|
380 ;;; For this type of gateway, you need to start a remote shell on
|
|
|
381 ;;; your gateway, using either remsh or rsh. You should set
|
|
|
382 ;;; efs-gateway-type to something like
|
|
|
383 ;;;
|
|
|
384 ;;; (list 'remsh "remsh" nil "ftp" efs-ftp-program-args)
|
|
|
385 ;;;
|
|
|
386 ;;; If you use rsh instead of remsh, change the second element from
|
|
|
387 ;;; "remsh" to "rsh". Note that the symbol indicating the gateway
|
|
|
388 ;;; type should still be 'remsh. If you want to pass arguments
|
|
|
389 ;;; to the remsh program, give them as the third element. For example,
|
|
|
390 ;;; if you need to specify a user, make this (list "-l" "sandy").
|
|
|
391 ;;; If you need to use a nonstandard FTP client, specify that as the fourth
|
|
|
392 ;;; element. If your FTP client needs to be given special arguments,
|
|
|
393 ;;; give them instead of efs-ftp-program-args.
|
|
|
394 ;;;
|
|
|
395 ;;; d) interactive:
|
|
|
396 ;;; This indicates that you need to establish a login on the gateway,
|
|
|
397 ;;; using either telnet or rlogin.
|
|
|
398 ;;; You should set efs-gateway-type to something like
|
|
|
399 ;;;
|
|
|
400 ;;; (list 'interactive "rlogin" nil "exec ftp" efs-ftp-program-args)
|
|
|
401 ;;;
|
|
|
402 ;;; If you need to use telnet, then give "telnet" in place of the second
|
|
|
403 ;;; element "rlogin". If your login program needs to be given arguments,
|
|
|
404 ;;; then they should be given in the third slot. The fourth element
|
|
|
405 ;;; is for the name of the FTP client program. Giving this as "exec ftp",
|
|
|
406 ;;; instead of "ftp", ensures that you are logged out if the FTP client
|
|
|
407 ;;; dies. If the FTP client takes special arguments, give these instead
|
|
|
408 ;;; of efs-ftp-program-args. Furthermore, you should see the documentation
|
|
|
409 ;;; at the top of efs-gwp.el. You may need to set the variables
|
|
|
410 ;;; efs-gwp-setup-term-command, and efs-gwp-prompt-pattern.
|
|
|
411 ;;;
|
|
|
412 ;;; e) raptor:
|
|
|
413 ;;; This is a type of gateway where efs is expected to specify a gateway
|
|
|
414 ;;; user, and send a password for this user using the ACCOUNT command.
|
|
|
415 ;;; For example, to log in to foobar.edu as sandy, while using the account
|
|
|
416 ;;; ange on the gateway, the following commands would be sent:
|
|
|
417 ;;;
|
|
|
418 ;;; open raptorgate.com
|
|
|
419 ;;; quote USER sandy@foobar.edu ange
|
|
|
420 ;;; quote pass <sandy's password on foobar>
|
|
|
421 ;;; quote account <ange's password on raptorgate>
|
|
|
422 ;;;
|
|
|
423 ;;; For such a gateway, you would set efs-gateway-type to
|
|
|
424 ;;;
|
|
|
425 ;;; (list 'raptor efs-ftp-program efs-ftp-program-args <GATEWAY USER>)
|
|
|
426 ;;;
|
|
|
427 ;;; where <GATEWAY USER> is the name of your account on the gateway. In
|
|
|
428 ;;; the above example, this would be "ange". You can set your gateway
|
|
|
429 ;;; password by simply setting an account password for the gateway host.
|
|
|
430 ;;; This can be done with either efs-set-account, or within your .netrc
|
|
|
431 ;;; file. If no password is set, you will be prompted for one.
|
|
|
432 ;;;
|
|
|
433 ;;; f) interlock:
|
|
|
434 ;;; This is a type of gateway where you are expected to send a PASS
|
|
|
435 ;;; command after opening the connection to the gateway.
|
|
|
436 ;;; The precise login sequence is
|
|
|
437 ;;;
|
|
|
438 ;;; open interlockgate
|
|
|
439 ;;; quote PASS <sandy's password on interlockgate>
|
|
|
440 ;;; quote USER sandy@foobar.edu
|
|
|
441 ;;; quote PASS <sandy's password on foobar.edu>
|
|
|
442 ;;;
|
|
|
443 ;;; For such a gateway, you should set efs-gateway-type to
|
|
|
444 ;;;
|
|
|
445 ;;; (list 'interlock efs-ftp-program efs-ftp-program-args)
|
|
|
446 ;;;
|
|
|
447 ;;; If you need to use a nonstandard name for your FTP client,
|
|
|
448 ;;; then replace efs-ftp-program with this name. If your FTP client
|
|
|
449 ;;; needs to take nonstandard arguments, then replace efs-ftp-program-args
|
|
|
450 ;;; with these arguments. See efs-ftp-program-args <V> for the required
|
|
|
451 ;;; syntax.
|
|
|
452 ;;;
|
|
|
453 ;;; If your gateway returns both a 220 code and a 331 code to the
|
|
|
454 ;;; "open interlockgate" command, then you should add a regular
|
|
|
455 ;;; expression to efs-skip-msgs <V> that matches the 220 response.
|
|
|
456 ;;; Returning two response codes to a single FTP command is not permitted
|
|
|
457 ;;; in RFC 959. It is not possible for efs to ignore the 220 by default,
|
|
|
458 ;;; because than it would hang for interlock installations which do not
|
|
|
459 ;;; require a password.
|
|
|
460 ;;;
|
|
|
461 ;;; g) kerberos:
|
|
|
462 ;;; With this gateway, you need to authenticate yourself by getting a
|
|
|
463 ;;; kerberos "ticket" first. Usually, this is done with the kinit program.
|
|
|
464 ;;; Once authenticated, you connect to foobar.com as user sandy with the
|
|
|
465 ;;; sequence: (Note that the "-n" argument inhibits automatic login.
|
|
|
466 ;;; Although, in manual use you probably don't use it, efs always uses it.)
|
|
|
467 ;;;
|
|
|
468 ;;; iftp -n
|
|
|
469 ;;; open foobar.com
|
|
|
470 ;;; user sandy@foobar.com
|
|
|
471 ;;;
|
|
|
472 ;;; You should set efs-gateway-type to something like
|
|
|
473 ;;;
|
|
|
474 ;;; (list 'kerberos "iftp" efs-ftp-program-args "kinit" <KINIT-ARGS>)
|
|
|
475 ;;;
|
|
|
476 ;;; If you use an FTP client other than iftp, insert its name instead
|
|
|
477 ;;; of "iftp" above. If your FTP client needs special arguments, give
|
|
|
478 ;;; them as a list of strings in place of efs-ftp-program-args. If
|
|
|
479 ;;; the program that you use to collect a ticket in not called "kinit",
|
|
|
480 ;;; then give its name in place of "kinit" above. <KINIT-ARGS> should be
|
|
|
481 ;;; any arguments that you need to pass to your kinit program, given as a
|
|
|
482 ;;; list of strings. Most likely, you will give this as nil.
|
|
|
483 ;;;
|
|
|
484 ;;; See the file efs-kerberos.el for more configuration variables. If you
|
|
|
485 ;;; need to adjust any of these variables, please report this to us so that
|
|
|
486 ;;; we can fix them for other users.
|
|
|
487 ;;;
|
|
|
488 ;;; If efs detects that you are not authenticated to use the gateway, it
|
|
|
489 ;;; will run the kinit program automatically, prompting you for a password.
|
|
|
490 ;;; If you give a password in your .netrc file for login the value of
|
|
|
491 ;;; efs-gateway-host <V> and user kerberos, then efs will use this to
|
|
|
492 ;;; obtain gateway authentication.
|
|
|
493 ;;;
|
|
|
494 ;;; 7) Transparent gateways:
|
|
|
495 ;;;
|
|
|
496 ;;; If your gateway is completely transparent (for example it uses
|
|
|
497 ;;; socks), then you should set efs-gateway-type to nil. Also,
|
|
|
498 ;;; set efs-ftp-local-host-regexp to ".*". However, efs-local-host-regexp,
|
|
|
499 ;;; must still be set to a regular expression matching hosts in your local
|
|
|
500 ;;; domain. efs uses this to determine which machines that it can
|
|
|
501 ;;; open-network-stream to. Furthermore, you should still set
|
|
|
502 ;;; efs-gateway-host to the name of your gateway machine. That way efs
|
|
|
503 ;;; will know that this is a special machine having direct TCP/IP access
|
|
|
504 ;;; to both hosts in the outside world, and hosts in your local domain.
|
|
|
505 ;;;
|
|
|
506 ;;; 8) Common Problems with Gateways:
|
|
|
507 ;;;
|
|
|
508 ;;; a) Spurious 220 responses:
|
|
|
509 ;;; Some proxy-style gateways (eg gateway type 'proxy or 'raptor),
|
|
|
510 ;;; return two 3-digit FTP reply codes to the USER command.
|
|
|
511 ;;; For example:
|
|
|
512 ;;;
|
|
|
513 ;;; open gateway.weird
|
|
|
514 ;;; 220 Connected to gateway.weird
|
|
|
515 ;;; quote USER sandy@foobar
|
|
|
516 ;;; 220 Connected to foobar
|
|
|
517 ;;; 331 Password required for sandy
|
|
|
518 ;;;
|
|
|
519 ;;; This is wrong, according to the FT Protocol. Each command must return
|
|
|
520 ;;; exactly one 3-digit reply code. It may be preceded by continuation
|
|
|
521 ;;; lines. What should really be returned is:
|
|
|
522 ;;;
|
|
|
523 ;;; quote USER sandy@foobar
|
|
|
524 ;;; 331-Connected to foobar.
|
|
|
525 ;;; 331 Password required for sandy.
|
|
|
526 ;;;
|
|
|
527 ;;; or even
|
|
|
528 ;;;
|
|
|
529 ;;; quote USER sandy@foobar
|
|
|
530 ;;; 331-220 Connected to foobar.
|
|
|
531 ;;; 331 Password required for sandy.
|
|
|
532 ;;;
|
|
|
533 ;;; Even though the "331-220" looks strange, it is correct protocol, and
|
|
|
534 ;;; efs will parse it properly.
|
|
|
535 ;;;
|
|
|
536 ;;; If your gateway is returning a spurious 220 to USER, a work-around
|
|
|
537 ;;; is to add a regular expression to `efs-skip-msgs' that matches
|
|
|
538 ;;; this line. It must not match the 220 line returned to the open
|
|
|
539 ;;; command. This work-around may not work, as some system FTP clients
|
|
|
540 ;;; also get confused by the spurious 220. In this case, the only
|
|
|
541 ;;; solution is to patch the gateway server. In either case, please
|
|
|
542 ;;; send a bug report to the author of your gateway software.
|
|
|
543 ;;;
|
|
|
544 ;;; b) Case-sensitive parsing of FTP commands:
|
|
|
545 ;;; Some gateway servers seem to treat FTP commands case-sensitively.
|
|
|
546 ;;; This is incorrect, as RFC 959 clearly states that FTP commands
|
|
|
547 ;;; are always to be case-insensitive. If this is a problem with your
|
|
|
548 ;;; gateway server, you should send a bug report to its author.
|
|
|
549 ;;; If efs is using a case for FTP commands that does not suit your server,
|
|
|
550 ;;; a possible work-around is to edit the efs source so that the required
|
|
|
551 ;;; case is used. However, we will not be making any changes to the
|
|
|
552 ;;; standard efs distribution to support this type of server behaviour.
|
|
|
553 ;;; If you need help changing the efs source, you should enquire with the
|
|
|
554 ;;; efs-help mailing list.
|
|
|
555 ;;;
|
|
|
556
|
|
|
557 ;;; ---------------------------------------------------------------
|
|
|
558 ;;; Tips for using efs:
|
|
|
559 ;;; ---------------------------------------------------------------
|
|
|
560
|
|
|
561 ;;; 1) Beware of compressing files on non-UNIX hosts. efs will do it by
|
|
|
562 ;;; copying the file to the local machine, compressing it there, and then
|
|
|
563 ;;; sending it back. Binary file transfers between machines of different
|
|
|
564 ;;; architectures can be a risky business. Test things out first on some
|
|
|
565 ;;; test files. See "Bugs" below. Also, note that efs sometimes
|
|
|
566 ;;; copies files by moving them through the local machine. Again,
|
|
|
567 ;;; be careful when doing this with binary files on non-Unix
|
|
|
568 ;;; machines.
|
|
|
569 ;;;
|
|
|
570 ;;; 2) Beware that dired over ftp will use your setting of dired-no-confirm
|
|
|
571 ;;; (list of dired commands for which confirmation is not asked).
|
|
|
572 ;;; You might want to reconsider your setting of this variable,
|
|
|
573 ;;; because you might want confirmation for more commands on remote
|
|
|
574 ;;; direds than on local direds. For example, I strongly recommend
|
|
|
575 ;;; that you not include compress in this list. If there is enough
|
|
|
576 ;;; demand it might be a good idea to have an alist
|
|
|
577 ;;; efs-dired-no-confirm of pairs ( TYPE . LIST ), where TYPE is an
|
|
|
578 ;;; operating system type and LIST is a list of commands for which
|
|
|
579 ;;; confirmation would be suppressed. Then remote dired listings
|
|
|
580 ;;; would take their (buffer-local) value of dired-no-confirm from
|
|
|
581 ;;; this alist. Who votes for this?
|
|
|
582 ;;;
|
|
|
583 ;;; 3) Some combinations of FTP clients and servers break and get out of sync
|
|
|
584 ;;; when asked to list a non-existent directory. Some of the ai.mit.edu
|
|
|
585 ;;; machines cause this problem for some FTP clients. Using
|
|
|
586 ;;; efs-kill-ftp-process can be used to restart the ftp process, which
|
|
|
587 ;;; should get things back in synch.
|
|
|
588 ;;;
|
|
|
589 ;;; 4) Some ftp servers impose a length limit on the password that can
|
|
|
590 ;;; be sent. If this limit is exceeded they may bomb in an
|
|
|
591 ;;; incomprehensible way. This sort of behaviour is common with
|
|
|
592 ;;; MVS servers. Therefore, you should beware of this possibility
|
|
|
593 ;;; if you are generating a long password (like an email address)
|
|
|
594 ;;; with efs-generate-anonymous-password.
|
|
|
595 ;;;
|
|
|
596 ;;; 5) Some antiquated FTP servers hang when asked for an RNFR command.
|
|
|
597 ;;; efs sometimes uses this to test whether its local cache is stale.
|
|
|
598 ;;; If your server for HOST hangs when asked for this command, put
|
|
|
599 ;;; (efs-set-host-property HOST 'rnfr-failed t)
|
|
|
600 ;;; in your efs-ftp-startup-function-alist entry for HOST.
|
|
|
601 ;;;
|
|
|
602
|
|
|
603 ;;; -----------------------------------------------------------------------
|
|
|
604 ;;; Where to get the latest version of efs:
|
|
|
605 ;;; -----------------------------------------------------------------------
|
|
|
606 ;;;
|
|
|
607 ;;; The authors are grateful to anyone or any organization which
|
|
|
608 ;;; provides anonymous FTP distribution for efs.
|
|
|
609 ;;;
|
|
|
610 ;;;
|
|
|
611 ;;; Europe:
|
|
|
612 ;;;
|
|
|
613 ;;; Switzerland
|
|
|
614 ;;; /anonymous@itp.ethz.ch:/sandy/efs/
|
|
|
615 ;;;
|
|
|
616 ;;; North America:
|
|
|
617 ;;;
|
|
|
618 ;;; Massachusetts, USA
|
|
|
619 ;;; /anonymous@alpha.gnu.ai.mit.edu:/efs/
|
|
|
620 ;;;
|
|
|
621 ;;; California, USA
|
|
|
622 ;;; /anonymous@ftp.hmc.edu:/pub/emacs/packages/efs/
|
|
|
623 ;;;
|
|
|
624 ;;; Australia and New Zealand:
|
|
|
625 ;;;
|
|
|
626 ;;; ????????????
|
|
|
627 ;;;
|
|
|
628 ;;; Japan:
|
|
|
629 ;;;
|
|
|
630 ;;; ????????????
|
|
|
631
|
|
|
632 ;;; ---------------------------------------------------------------------
|
|
|
633 ;;; Non-UNIX support:
|
|
|
634 ;;; ---------------------------------------------------------------------
|
|
|
635
|
|
|
636 ;;; efs has full support, incuding file name completion and tree dired
|
|
|
637 ;;; for:
|
|
|
638 ;;;
|
|
|
639 ;;; VMS, CMS, MTS, MVS, ti-twenex, ti-explorer (the last two are lisp
|
|
|
640 ;;; machines), TOPS-20, DOS (running the Distinct, Novell, FTP
|
|
|
641 ;;; software, NCSA, Microsoft in both unix and DOS mode, Super TCP, and
|
|
|
642 ;;; Hellsoft FTP servers), unix descriptive listings (dl), KA9Q, OS/2,
|
|
|
643 ;;; VOS, NOS/VE, CMS running the KNET server, Tandem's Guardian OS, COKE
|
|
|
644 ;;;
|
|
|
645 ;;; efs should be able to automatically recognize any of the operating
|
|
|
646 ;;; systems and FTP servers that it supports. Please report any
|
|
|
647 ;;; failure to do so to the "bugs" address below. You can specify a
|
|
|
648 ;;; certain host as being of a given host type with the command
|
|
|
649 ;;;
|
|
|
650 ;;; (efs-add-host <host-type> <host>)
|
|
|
651 ;;;
|
|
|
652 ;;; <host-type> is a symbol, <host> is a string. If this command is
|
|
|
653 ;;; used interactively, then <host-type> is prompted for with
|
|
|
654 ;;; completion. Some host types have regexps that can be used to
|
|
|
655 ;;; specify a class of host names as being of a certain type. Note
|
|
|
656 ;;; that if you specify a host as being of a certain type, efs does
|
|
|
657 ;;; not verify that that is really the type of the host. This calls
|
|
|
658 ;;; for caution when using regexps to specify host types, as an
|
|
|
659 ;;; inadvertent match to a regexp might have unpleasant consequences.
|
|
|
660 ;;;
|
|
|
661 ;;; See the respective efs-TYPE.el files for more information.
|
|
|
662 ;;; When or if we get a tex info file, it should contain some more
|
|
|
663 ;;; details on the non-unix support.
|
|
|
664
|
|
|
665 ;;; ------------------------------------------------------------------
|
|
|
666 ;;; Bugs and other things that go clunk in the night:
|
|
|
667 ;;; ------------------------------------------------------------------
|
|
|
668
|
|
|
669 ;;; How to report a bug:
|
|
|
670 ;;; --------------------
|
|
|
671 ;;;
|
|
|
672 ;;; Type M-x efs-report-bug
|
|
|
673 ;;; or
|
|
|
674 ;;; send mail to efs-bugs@cuckoo.hpl.hp.com.
|
|
|
675 ;;;
|
|
|
676 ;;; efs is a "free" program. This means that you didn't (or shouldn't
|
|
|
677 ;;; have) paid anything for it. It also means that nobody is paid to
|
|
|
678 ;;; maintain it, and the authors weren't paid for writing it.
|
|
|
679 ;;; Therefore, please try to write your bug report in a clear and
|
|
|
680 ;;; complete fashion. It will greatly enhance the probability that
|
|
|
681 ;;; something will be done about your problem.
|
|
|
682 ;;;
|
|
|
683 ;;; Note that efs relies heavily in cached information, so the bug may
|
|
|
684 ;;; depend in a complicated fashion on commands that were performed on
|
|
|
685 ;;; remote files from the beginning of your emacs session. Trying to
|
|
|
686 ;;; reproduce your bug starting from a fresh emacs session is usually
|
|
|
687 ;;; a good idea.
|
|
|
688 ;;;
|
|
|
689
|
|
|
690 ;;; Fan/hate mail:
|
|
|
691 ;;; --------------
|
|
|
692 ;;;
|
|
|
693 ;;; efs has its own mailing list called efs-help. All users of efs
|
|
|
694 ;;; are welcome to subscribe (see below) and to discuss aspects of
|
|
|
695 ;;; efs. New versions of efs are posted periodically to the mailing
|
|
|
696 ;;; list.
|
|
|
697 ;;;
|
|
|
698 ;;; To [un]subscribe to efs-help, or to report mailer problems with the
|
|
|
699 ;;; list, please mail one of the following addresses:
|
|
|
700 ;;;
|
|
|
701 ;;; efs-help-request@cuckoo.hpl.hp.com
|
|
|
702 ;;; or
|
|
|
703 ;;; efs-help-request%cuckoo.hpl.hp.com@hplb.hpl.hp.com
|
|
|
704 ;;;
|
|
|
705 ;;; Please don't forget the -request part.
|
|
|
706 ;;;
|
|
|
707 ;;; For mail to be posted directly to efs-help, send to one of the
|
|
|
708 ;;; following addresses:
|
|
|
709 ;;;
|
|
|
710 ;;; efs-help@cuckoo.hpl.hp.com
|
|
|
711 ;;; or
|
|
|
712 ;;; efs-help%cuckoo.hpl.hp.com@hplb.hpl.hp.com
|
|
|
713 ;;;
|
|
|
714 ;;; Alternatively, there is a mailing list that only gets
|
|
|
715 ;;; announcements of new efs releases. This is called efs-announce,
|
|
|
716 ;;; and can be subscribed to by e-mailing to the -request address as
|
|
|
717 ;;; above. Please make it clear in the request which mailing list you
|
|
|
718 ;;; wish to join.
|
|
|
719 ;;;
|
|
|
720
|
|
|
721 ;;; Known bugs:
|
|
|
722 ;;; -----------
|
|
|
723 ;;;
|
|
|
724 ;;; If you hit a bug in this list, please report it anyway. Most of
|
|
|
725 ;;; the bugs here remain unfixed because they are considered too
|
|
|
726 ;;; esoteric to be a high priority. If one of them gets reported
|
|
|
727 ;;; enough, we will likely change our view on that.
|
|
|
728 ;;;
|
|
|
729 ;;; 1) efs does not check to make sure that when creating a new file,
|
|
|
730 ;;; you provide a valid filename for the remote operating system.
|
|
|
731 ;;; If you do not, then the remote FTP server will most likely
|
|
|
732 ;;; translate your filename in some way. This may cause efs to
|
|
|
733 ;;; get confused about what exactly is the name of the file.
|
|
|
734 ;;;
|
|
|
735 ;;; 2) For CMS support, we send too many cd's. Since cd's are cheap, I haven't
|
|
|
736 ;;; worried about this too much. Eventually, we should have some caching
|
|
|
737 ;;; of the current minidisk. This is complicated by the fact that some
|
|
|
738 ;;; CMS servers lie about the current minidisk, so sending redundant
|
|
|
739 ;;; cd's helps us recover in this case.
|
|
|
740 ;;;
|
|
|
741 ;;; 3) The code to do compression of files over ftp is not as careful as it
|
|
|
742 ;;; should be. It deletes the old remote version of the file, before
|
|
|
743 ;;; actually checking if the local to remote transfer of the compressed
|
|
|
744 ;;; file succeeds. Of course to delete the original version of the file
|
|
|
745 ;;; after transferring the compressed version back is also dangerous,
|
|
|
746 ;;; because some OS's have severe restrictions on the length of filenames,
|
|
|
747 ;;; and when the compressed version is copied back the "-Z" or ".Z" may be
|
|
|
748 ;;; truncated. Then, efs would delete the only remaining version of
|
|
|
749 ;;; the file. Maybe efs should make backups when it compresses files
|
|
|
750 ;;; (of course, the backup "~" could also be truncated off, sigh...).
|
|
|
751 ;;; Suggestions?
|
|
|
752 ;;;
|
|
|
753 ;;; 4) If a dir listing is attempted for an empty directory on (at least
|
|
|
754 ;;; some) VMS hosts, an ftp error is given. This is really an ftp bug, and
|
|
|
755 ;;; I don't know how to get efs work to around it.
|
|
|
756 ;;;
|
|
|
757 ;;; 5) efs gets confused by directories containing file names with
|
|
|
758 ;;; embedded newlines. A temporary solution is to add "q" to your
|
|
|
759 ;;; dired listing switches. As long as your dired listing switches
|
|
|
760 ;;; also contain "l" and either "a" or "A", efs will use these
|
|
|
761 ;;; switches to get listings for its internal cache. The "q" switch
|
|
|
762 ;;; should force listings to be exactly one file per line. You
|
|
|
763 ;;; still will not be able to access a file with embedded newlines,
|
|
|
764 ;;; but at least it won't mess up the parsing of the rest of the files.
|
|
|
765 ;;;
|
|
|
766 ;;; 6) efs cannot parse symlinks which have an embedded " -> "
|
|
|
767 ;;; in their name. It's alright to have an embedded " -> " in the name
|
|
|
768 ;;; of any other type of file. A fix is possible, but probably not worth
|
|
|
769 ;;; the trouble. If you disagree, send us a bug report.
|
|
|
770 ;;;
|
|
|
771 ;;; 7) efs doesn't handle context-dep. files in H-switch listings on
|
|
|
772 ;;; HP's. It wouldn't be such a big roaring deal to fix this. I'm
|
|
|
773 ;;; waiting until I get an actual bug report though.
|
|
|
774 ;;;
|
|
|
775 ;;; 8) If a hard link is added or deleted, efs will not update its
|
|
|
776 ;;; internal cache of the link count for other names of the file.
|
|
|
777 ;;; This may cause file-nlinks to return incorrectly. Reverting
|
|
|
778 ;;; any dired buffer containing other names for the file will
|
|
|
779 ;;; cause the file data to be updated, including the link counts.
|
|
|
780 ;;; A fix for this problem is known and will be eventually
|
|
|
781 ;;; implemented. How it is implemented will depend on how we decide
|
|
|
782 ;;; to handle inodes. See below.
|
|
|
783 ;;;
|
|
|
784 ;;; 9) efs is unable to parse R-switch listings from remote unix hosts.
|
|
|
785 ;;; This is inefficient, because efs will insist on doing individual
|
|
|
786 ;;; listings of the subdirectories to get its file information.
|
|
|
787 ;;; This may be fixed if there is enough demand.
|
|
|
788 ;;;
|
|
|
789 ;;; 10) In file-attributes, efs returns a fake inode number. Of course
|
|
|
790 ;;; this is necessary, but this inode number is not even necessarily
|
|
|
791 ;;; unique. It is simply the sum of the characters (treated as
|
|
|
792 ;;; integers) in the host name, user name, and file name. Possible
|
|
|
793 ;;; ways to get a unique inode number are:
|
|
|
794 ;;; a) Simply keep a count of all remote file in the cache, and
|
|
|
795 ;;; return the file's position in this count as a negative number.
|
|
|
796 ;;; b) For unix systems, we could actually get at the real inode
|
|
|
797 ;;; number on the remote host, by adding an "i" to the ls switches.
|
|
|
798 ;;; The inode numbers would then be removed from the listing
|
|
|
799 ;;; returned by efs-ls, if the caller hadn't requested the "i"
|
|
|
800 ;;; switch. We could then make a unique number out of the host name
|
|
|
801 ;;; and the real inode number.
|
|
|
802 ;;;
|
|
|
803 ;;; 11) efs tries to determine if a file is readable or writable by comparing
|
|
|
804 ;;; the file modes, file owner, and user name under which it is logged
|
|
|
805 ;;; into the remote host. This does not take into account groups.
|
|
|
806 ;;; We simply assume that the user belongs to all groups. As a result
|
|
|
807 ;;; we may assume that a file is writable, when in fact it is not.
|
|
|
808 ;;; Groups are tough to handle correctly over FTP. Suggestions?
|
|
|
809 ;;; (For new FTP servers, can do a "QUOTE SITE EXEC groups" to
|
|
|
810 ;;; handle this.)
|
|
|
811
|
|
|
812 ;;; -----------------------------------------------------------
|
|
|
813 ;;; Technical information on this package:
|
|
|
814 ;;; -----------------------------------------------------------
|
|
|
815
|
|
|
816 ;;; efs hooks onto the following functions using the
|
|
|
817 ;;; file-name-handler-alist. Depending on which version of emacs you
|
|
|
818 ;;; are using, not all of these functions may access this alist. In
|
|
|
819 ;;; this case, efs overloads the definitions of these functions with
|
|
|
820 ;;; versions that do access the file-name-handler-alist. These
|
|
|
821 ;;; overloads are done in efs's version-specific files.
|
|
|
822 ;;;
|
|
|
823 ;;; abbreviate-file-name
|
|
|
824 ;;; backup-buffer
|
|
|
825 ;;; copy-file
|
|
|
826 ;;; create-file-buffer
|
|
|
827 ;;; delete-directory
|
|
|
828 ;;; delete-file
|
|
|
829 ;;; directory-file-name
|
|
|
830 ;;; directory-files
|
|
|
831 ;;; file-attributes
|
|
|
832 ;;; file-directory-p
|
|
|
833 ;;; file-exists-p
|
|
|
834 ;;; file-local-copy
|
|
|
835 ;;; file-modes
|
|
|
836 ;;; file-name-all-completions
|
|
|
837 ;;; file-name-as-directory
|
|
|
838 ;;; file-name-completion
|
|
|
839 ;;; file-name-directory
|
|
|
840 ;;; file-name-nondirectory
|
|
|
841 ;;; file-name-sans-versions
|
|
|
842 ;;; file-newer-than-file-p
|
|
|
843 ;;; file-readable-p
|
|
|
844 ;;; file-executable-p
|
|
|
845 ;;; file-accessible-directory-p
|
|
|
846 ;;; file-symlink-p
|
|
|
847 ;;; file-writable-p
|
|
|
848 ;;; get-file-buffer
|
|
|
849 ;;; insert-directory
|
|
|
850 ;;; insert-file-contents
|
|
|
851 ;;; list-directory
|
|
|
852 ;;; make-directory-internal
|
|
|
853 ;;; rename-file
|
|
|
854 ;;; set-file-modes
|
|
|
855 ;;; set-visited-file-modtime
|
|
|
856 ;;; substitute-in-file-name
|
|
|
857 ;;; verify-visited-file-modtime
|
|
|
858 ;;; write-region
|
|
|
859 ;;;
|
|
|
860 ;;; The following functions are overloaded in efs.el, because they cannot
|
|
|
861 ;;; be handled via the file-name-handler-alist.
|
|
|
862 ;;;
|
|
|
863 ;;; expand-file-name
|
|
|
864 ;;; load
|
|
|
865 ;;; read-file-name-internal (Emacs 18, only)
|
|
|
866 ;;; require
|
|
|
867 ;;;
|
|
|
868 ;;; The following dired functions are handled by hooking them into the
|
|
|
869 ;;; the file-name-handler-alist. This is done in efs-dired.el.
|
|
|
870 ;;;
|
|
|
871 ;;; efs-dired-compress-file
|
|
|
872 ;;; eds-dired-print-file
|
|
|
873 ;;; efs-dired-make-compressed-filename
|
|
|
874 ;;; efs-compress-file
|
|
|
875 ;;; efs-dired-print-file
|
|
|
876 ;;; efs-dired-create-directory
|
|
|
877 ;;; efs-dired-recursive-delete-directory
|
|
|
878 ;;; efs-dired-uncache
|
|
|
879 ;;; efs-dired-call-process
|
|
|
880 ;;;
|
|
|
881 ;;; In efs-dired.el, the following dired finctions are overloaded.
|
|
|
882 ;;;
|
|
|
883 ;;; dired-collect-file-versions
|
|
|
884 ;;; dired-find-file
|
|
|
885 ;;; dired-flag-backup-files
|
|
|
886 ;;; dired-get-filename
|
|
|
887 ;;; dired-insert-headerline
|
|
|
888 ;;; dired-move-to-end-of-filename
|
|
|
889 ;;; dired-move-to-filename
|
|
|
890 ;;; dired-run-shell-command
|
|
|
891 ;;;
|
|
|
892 ;;; efs makes use of the following hooks
|
|
|
893 ;;;
|
|
|
894 ;;; diff-load-hook
|
|
|
895 ;;; dired-before-readin-hook
|
|
|
896 ;;; find-file-hooks
|
|
|
897 ;;; dired-grep-load-hook
|
|
|
898
|
|
|
899 ;;; LISPDIR ENTRY for the Elisp Archive:
|
|
|
900 ;;;
|
|
|
901 ;;; LCD Archive Entry:
|
|
|
902 ;;; efs|Andy Norman and Sandy Rutherford
|
|
|
903 ;;; |ange@hplb.hpl.hp.com and sandy@ibm550.sissa.it
|
|
|
904 ;;; |transparent FTP Support for GNU Emacs
|
|
118
|
905 ;;; |$Date: 1997/04/05 18:07:24 $|$efs release: 1.15 beta $|
|
|
98
|
906
|
|
|
907 ;;; Host and listing type notation:
|
|
|
908 ;;;
|
|
|
909 ;;; The functions efs-host-type and efs-listing-type, and the
|
|
|
910 ;;; variable efs-dired-host-type follow the following conventions
|
|
|
911 ;;; for remote host types.
|
|
|
912 ;;;
|
|
|
913 ;;; nil = local host type, whatever that is (probably unix).
|
|
|
914 ;;; Think nil as in "not a remote host". This value is used by
|
|
|
915 ;;; efs-dired-host-type for local buffers.
|
|
|
916 ;;; (efs-host-type nil) => nil
|
|
|
917 ;;;
|
|
|
918 ;;; 'type = a remote host of TYPE type.
|
|
|
919 ;;;
|
|
|
920 ;;; 'type:list = a remote host using listing type 'type:list.
|
|
|
921 ;;; This is currently used for Unix dl (descriptive
|
|
|
922 ;;; listings), when efs-dired-host-type is set to
|
|
|
923 ;;; 'unix:dl, and to support the myriad of DOS FTP
|
|
|
924 ;;; servers.
|
|
|
925
|
|
|
926 ;;; Supported host and listing types:
|
|
|
927 ;;;
|
|
|
928 ;;; unknown, unix, dumb-unix, bsd-unix, sysV-unix, next-unix,
|
|
|
929 ;;; super-dumb-unix, dumb-apollo-unix,
|
|
|
930 ;;; apollo-unix, unix:dl, dos-distinct, ka9q, dos, dos:ftp, dos:novell,
|
|
|
931 ;;; dos:ncsa, dos:winsock, vos, hell, dos:microsoft, super-dumb-unix
|
|
|
932 ;;; vms, cms, mts, mvs, mvs:tcp mvs:nih tops-20, mpe, ti-twenex,
|
|
|
933 ;;; ti-explorer, os2, vos,
|
|
|
934 ;;; vms:full, guardian, ms-unix (This is the Microsoft NT Windows server
|
|
|
935 ;;; in unix mode.), plan9, unix:unknown, nos-ve (actually NOS/VE).
|
|
|
936
|
|
|
937 ;;; Host and listing type hierarchy:
|
|
|
938 ;;;
|
|
|
939 ;;; unknown: unix, dumb-unix, sysV-unix, bsd-unix, next-unix, apollo-unix,
|
|
|
940 ;;; ka9q, dos-distinct, unix:dl, hell,
|
|
|
941 ;;; super-dumb-unix, dumb-apollo-unix
|
|
|
942 ;;; unix: sysV-unix, bsd-unix, next-unix, apollo-unix, unix:dl
|
|
|
943 ;;; dos: dos:ftp, dos:novell, dos:ncsa, dos:microsoft, dos:winsock
|
|
|
944 ;;; dumb-unix:
|
|
|
945 ;;; bsd-unix:
|
|
|
946 ;;; sysV-unix:
|
|
|
947 ;;; next-unix:
|
|
|
948 ;;; apollo-unix:
|
|
|
949 ;;; dumb-apollo-unix:
|
|
|
950 ;;; unix:dl:
|
|
|
951 ;;; unix:unknown: unix:dl, unix
|
|
|
952 ;;; super-dumb-unix:
|
|
|
953 ;;; dos-distinct:
|
|
|
954 ;;; dos:ftp:
|
|
|
955 ;;; dos:novell:
|
|
|
956 ;;; dos:microsoft
|
|
|
957 ;;; ka9q:
|
|
|
958 ;;; vms: vms:full
|
|
|
959 ;;; cms:
|
|
|
960 ;;; mts:
|
|
|
961 ;;; mvs: mvs:tcp, mvs:nih
|
|
|
962 ;;; mvs:tcp:
|
|
|
963 ;;; mvs:nih:
|
|
|
964 ;;; tops-20:
|
|
|
965 ;;; ti-twenex:
|
|
|
966 ;;; ti-explorer:
|
|
|
967 ;;; os2:
|
|
|
968 ;;; vos:
|
|
|
969 ;;; vms:full:
|
|
|
970 ;;; dos:ncsa:
|
|
|
971 ;;; dos:winsock:
|
|
|
972 ;;; vos:
|
|
|
973 ;;; hell:
|
|
|
974 ;;; guardian:
|
|
|
975 ;;; ms-unix:
|
|
|
976 ;;; plan9:
|
|
|
977 ;;; nos-ve:
|
|
|
978 ;;; coke:
|
|
|
979 ;;;
|
|
|
980
|
|
|
981
|
|
|
982 ;;;; ================================================================
|
|
|
983 ;;;; >0
|
|
|
984 ;;;; Table of Contents for efs.el
|
|
|
985 ;;;; ================================================================
|
|
|
986 ;;
|
|
|
987 ;; Each section of efs.el is labelled by >#, where # is the number of
|
|
|
988 ;; the section.
|
|
|
989 ;;
|
|
|
990 ;; 1. Provisions, requirements, and autoloads.
|
|
|
991 ;; 2. Variable definitions.
|
|
|
992 ;; 3. Utilities.
|
|
|
993 ;; 4. Hosts, users, accounts, and passwords.
|
|
|
994 ;; 5. FTP client process and server responses.
|
|
|
995 ;; 6. Sending commands to the FTP server.
|
|
|
996 ;; 7. Parsing and storing remote file system data.
|
|
|
997 ;; 8. Redefinitions of standard GNU Emacs functions.
|
|
|
998 ;; 9. Multiple host type support.
|
|
|
999 ;; 10. Attaching onto the appropriate emacs version.
|
|
|
1000
|
|
|
1001
|
|
|
1002 ;;;; ================================================================
|
|
|
1003 ;;;; >1
|
|
|
1004 ;;;; General provisions, requirements, and autoloads.
|
|
|
1005 ;;;; Host type, and local emacs type dependent loads, and autoloads
|
|
|
1006 ;;;; are in the last two sections of this file.
|
|
|
1007 ;;;; ================================================================
|
|
|
1008
|
|
|
1009 ;;;; ----------------------------------------------------------------
|
|
|
1010 ;;;; Provide the package (Do this now to avoid an infinite loop)
|
|
|
1011 ;;;; ----------------------------------------------------------------
|
|
|
1012
|
|
|
1013 (provide 'efs)
|
|
|
1014
|
|
|
1015 ;;;; ----------------------------------------------------------------
|
|
|
1016 ;;;; Our requirements.
|
|
|
1017 ;;;; ----------------------------------------------------------------
|
|
|
1018
|
|
|
1019 (require 'backquote)
|
|
|
1020 (require 'comint)
|
|
|
1021 (require 'efs-defun)
|
|
|
1022 (require 'efs-netrc)
|
|
|
1023 (require 'efs-cu)
|
|
|
1024 (require 'efs-ovwrt)
|
|
|
1025 ;; Do this last, as it installs efs into the file-name-handler-alist.
|
|
|
1026 (require 'efs-fnh)
|
|
|
1027
|
|
|
1028 (autoload 'efs-report-bug "efs-report" "Submit a bug report for efs." t)
|
|
|
1029 (autoload 'efs-gwp-start "efs-gwp" ; For interactive gateways.
|
|
|
1030 "Login to the gateway machine and fire up an FTP client.")
|
|
|
1031 (autoload 'efs-kerberos-login "efs-kerberos")
|
|
|
1032 (autoload 'efs-insert-directory "efs-dired" "Insert a directory listing.")
|
|
|
1033 (autoload 'efs-set-mdtm-of "efs-cp-p")
|
|
|
1034 (autoload 'diff-latest-backup-file "diff")
|
|
|
1035 (autoload 'read-passwd "passwd" "Read a password from the minibuffer." t)
|
|
|
1036
|
|
|
1037
|
|
|
1038 ;;;; ============================================================
|
|
|
1039 ;;;; >2
|
|
|
1040 ;;;; Variable Definitions
|
|
|
1041 ;;;; **** The user configuration variables are in ****
|
|
|
1042 ;;;; **** the second subsection of this section. ****
|
|
|
1043 ;;;; ============================================================
|
|
|
1044
|
|
|
1045 ;;;; ------------------------------------------------------------
|
|
|
1046 ;;;; Constant Definitions
|
|
|
1047 ;;;; ------------------------------------------------------------
|
|
|
1048
|
|
|
1049 (defconst efs-version
|
|
|
1050 (concat (substring "$efs release: 1.15 $" 14 -2)
|
|
|
1051 "/"
|
|
116
|
1052 (substring "#Revision: 1.56 $" 11 -2)))
|
|
98
|
1053
|
|
|
1054 (defconst efs-time-zero 1970) ; we count time from midnight, Jan 1, 1970 GMT.
|
|
|
1055
|
|
|
1056 (defconst efs-dumb-host-types
|
|
|
1057 '(dumb-unix super-dumb-unix vms cms mts ti-twenex ti-explorer dos mvs
|
|
|
1058 tops-20 mpe ka9q dos-distinct os2 vos hell guardian
|
|
|
1059 netware cms-knet nos-ve coke dumb-apollo-unix)
|
|
|
1060 "List of host types that can't take UNIX ls-style listing options.")
|
|
|
1061 ;; dos-distinct only ignores ls switches; it doesn't barf.
|
|
|
1062 ;; Still treat it as dumb.
|
|
|
1063
|
|
|
1064 (defconst efs-unix-host-types
|
|
|
1065 '(unix sysV-unix bsd-unix next-unix apollo-unix dumb-unix
|
|
|
1066 dumb-apollo-unix super-dumb-unix)
|
|
|
1067 "List of unix host types.")
|
|
|
1068
|
|
|
1069 (defconst efs-version-host-types '(vms tops-20 ti-twenex ti-explorer)
|
|
|
1070 "List of host-types which associated a version number to all files.
|
|
|
1071 This is not the same as associating version numbers to only backup files.")
|
|
|
1072 ;; Note that on these systems,
|
|
|
1073 ;; (file-name-sans-versions EXISTING-FILE) does not exist as a file.
|
|
|
1074
|
|
|
1075 (defconst efs-single-extension-host-types
|
|
|
1076 '(vms tops-20 ti-twenex ti-explorer cms mvs dos ka9q dos-distinct hell
|
|
|
1077 netware ms-unix plan9 cms-knet nos-ve)
|
|
|
1078 "List of host types which allow at most one extension on a file name.
|
|
|
1079 Extensions are deliminated by \".\". In addition, these host-types must
|
|
|
1080 allow \"-\" in file names, because it will be used to add additional extensions
|
|
|
1081 to indicate compressed files.")
|
|
|
1082
|
|
|
1083 (defconst efs-idle-host-types
|
|
|
1084 (append '(coke unknown) efs-unix-host-types))
|
|
|
1085 ;; List of host types for which it is possible that the SITE IDLE command
|
|
|
1086 ;; is supported.
|
|
|
1087
|
|
|
1088 (defconst efs-listing-types
|
|
|
1089 '(unix:dl unix:unknown
|
|
|
1090 dos:novell dos:ftp dos:ncsa dos:microsoft dos:stcp dos:winsock
|
|
|
1091 mvs:nih mvs:tcp mvs:tcp
|
|
|
1092 vms:full)
|
|
|
1093 "List of supported listing types")
|
|
|
1094
|
|
|
1095 (defconst efs-nlist-listing-types
|
|
|
1096 '(vms:full))
|
|
|
1097 ;; Listing types which give a long useless listing when asked for a
|
|
|
1098 ;; LIST. For these, use an NLST instead. This can only be done
|
|
|
1099 ;; when there is some way to distinguish directories from
|
|
|
1100 ;; plain files in an NLST.
|
|
|
1101
|
|
|
1102 (defconst efs-opaque-gateways '(remsh interactive))
|
|
|
1103 ;; List of gateway types for which we need to do explicit file handling on
|
|
|
1104 ;; the gateway machine.
|
|
|
1105
|
|
|
1106 ;;;; ------------------------------------------------------------------
|
|
|
1107 ;;;; User customization variables. Please read through these carefully.
|
|
|
1108 ;;;; ------------------------------------------------------------------
|
|
|
1109
|
|
|
1110 ;;;>>>> If you are not fully connected to the internet, <<<<
|
|
|
1111 ;;;>>>> and need to use a gateway (no matter how transparent) <<<<
|
|
|
1112 ;;;>>>> you will need to set some of the following variables. <<<<
|
|
|
1113 ;;;>>>> Read the documentation carefully. <<<<
|
|
|
1114
|
|
|
1115 (defvar efs-local-host-regexp ".*"
|
|
|
1116 "Regexp to match names of local hosts.
|
|
|
1117 These are hosts to which it is possible to obtain a direct internet
|
|
|
1118 connection. Even if the host is accessible by a very transparent FTP gateway,
|
|
|
1119 it does not qualify as a local host. The test to determine if machine A is
|
|
|
1120 local to your machine is if it is possible to ftp from A _back_ to your
|
|
|
1121 local machine. Also, open-network-stream must be able to reach the host
|
|
|
1122 in question.")
|
|
|
1123
|
|
|
1124 (defvar efs-ftp-local-host-regexp ".*"
|
|
|
1125 "Regexp to match the names of hosts reachable by a direct ftp connection.
|
|
|
1126 This regexp should match the names of hosts which can be reached using ftp,
|
|
|
1127 without requiring any explicit connection to a gateway. If you have a smart
|
|
|
1128 ftp client which is able to transparently go through a gateway, this will
|
|
|
1129 differ from `efs-local-host-regexp'.")
|
|
|
1130
|
|
|
1131 (defvar efs-gateway-host nil
|
|
|
1132 "If non-nil, this must be the name of your ftp gateway machine.
|
|
|
1133 If your net world is divided into two domains according to
|
|
|
1134 `efs-local-ftp-host-regexp', set this variable to the name of the
|
|
|
1135 gateway machine.")
|
|
|
1136
|
|
|
1137 (defvar efs-gateway-type nil
|
|
|
1138 "Specifies which type of gateway you wish efs to use.
|
|
|
1139 This should be a list, the first element of which is a symbol denoting the
|
|
|
1140 gateway type, and following elements give data on how to use the gateway.
|
|
|
1141
|
|
|
1142 The following possibilities are supported:
|
|
|
1143
|
|
|
1144 '(local FTP-PROGRAM FTP-PROGRAM-ARGS)
|
|
|
1145 This means that your local host is itself the gateway. However,
|
|
|
1146 you need to run a special FTP client to access outside hosts.
|
|
|
1147 FTP-PROGRAM should be the name of this FTP client, and FTP-PROGRAM-ARGS
|
|
|
1148 is a list of arguments to pass to it \(probably set this to the value of
|
|
|
1149 efs-ftp-program-args <V>\). Note that if your gateway is of this type,
|
|
|
1150 then you would set efs-gateway-host to nil.
|
|
|
1151
|
|
|
1152 '(proxy FTP-PROGRAM FTP-PROGRAM-ARGS)
|
|
|
1153 This indicates that your gateway works by first FTP'ing to it, and
|
|
|
1154 then giving a USER command of the form \"USER <username>@<host>\".
|
|
|
1155 FTP-PROGRAM is the FTP program to use to connect to the gateway; this
|
|
|
1156 is most likely \"ftp\". FTP-PROGRAM-ARGS is a list of arguments to
|
|
|
1157 pass to it. You likely want this to be set to the value of
|
|
|
1158 efs-ftp-program-args <V>. If the connection to the gateway FTP server
|
|
|
1159 is to be on a port different from 21, set efs-gateway-host to
|
|
|
1160 \"<host>#<port>\".
|
|
|
1161
|
|
|
1162 '(raptor FTP-PROGRAM FTP-PROGRAM-ARGS USER)
|
|
|
1163 This is for the gateway called raptor by Eagle. After connecting to the
|
|
|
1164 the gateway, the command \"user <user>@host USER\" is issued to login
|
|
|
1165 as <user> on <host>, where USER is an authentication username for the
|
|
|
1166 gateway. After issuing the password for the remote host, efs will
|
|
|
1167 send the password for USER on efs-gateway-host <V> as an account command.
|
|
|
1168
|
|
|
1169 '(interlock FTP-PROGRAM FTP-PROGRAM-ARGS)
|
|
|
1170 This is for the interlock gateway. The exact login sequence is to
|
|
|
1171 connect to the gateway specified by efs-gateway-host <V>, send the
|
|
|
1172 gateway password with a PASS command, send the command
|
|
|
1173 \"user <user>@<host>\" to connect to remote host <host> as user <user>,
|
|
|
1174 and finally to send the password for <user> on <host> with a second
|
|
|
1175 PASS command.
|
|
|
1176
|
|
|
1177 '(kerberos FTP-PROGRAM FTP-PROGRAM-ARGS KINIT-PROGRAM KINIT-PROGRAM-ARGS)
|
|
|
1178 This is for the kerberos gateway where you need to run a program (kinit) to
|
|
|
1179 obtain a ticket for gateway authroization first. FTP-PROGRAM should be
|
|
|
1180 the name of the FTP client that you use to connect to the gateway. This
|
|
|
1181 may likely be \"iftp\". FTP-PROGRAM-ARGS are the arguments that you need
|
|
|
1182 to pass to FTP-PROGRAM. This is probably the value of
|
|
|
1183 efs-ftp-program-args <V>. KINIT-PROGRAM is the name of the program to
|
|
|
1184 run in order to obtain a ticket. This is probably \"kinit\".
|
|
|
1185 KINIT-PROGRAM-ARGS is a list og strings indicating any arguments that you
|
|
|
1186 need to pass to KINIT-PROGRAM. Most likely this is nil.
|
|
|
1187
|
|
|
1188 '(remsh GATEWAY-PROGRAM GATEWAY-PROGRAM-ARGS FTP-PROGRAM FTP-PROGRAM-ARGS)
|
|
|
1189 This indicates that you wish to run FTP on your gateway using a remote shell.
|
|
|
1190 GATEWAY-PROGRAM is the name of the program to use to start a remote shell.
|
|
|
1191 It is assumed that it is not necessary to provide a password to start
|
|
|
1192 this remote shell. Likely values are \"remsh\" or \"rsh\".
|
|
|
1193 GATEWAY-PROGRAM-ARGS is a list of arguments to pass to GATEWAY-PROGRAM.
|
|
|
1194 FTP-PROGRAM is the name of the FTP program on the gateway. A likely setting
|
|
|
1195 of this is \"ftp\". FTP-PROGRAM-ARGS is a list of arguments to pass to
|
|
|
1196 FTP-PROGRAM. Most likely these should be set to the value of
|
|
|
1197 efs-ftp-program-args <V>.
|
|
|
1198
|
|
|
1199 '(interactive GATEWAY-PROGRAM GATEWAY-PROGRAM-ARGS FTP-PROGRAM
|
|
|
1200 FTP-PROGRAM-ARGS)
|
|
|
1201 This indicates that you need to start an interactive login on your gatway,
|
|
|
1202 using rlogin, telnet, or something similar. GATEWAY-PROGRAM is the name
|
|
|
1203 of the program to use to log in to the gateway, and GATEWAY-PROGRAM-ARGS
|
|
|
1204 is a list of arguments to pass to it. FTP-PROGRAM is the name of the FTP
|
|
|
1205 program on the gateway. A likely setting for this variable would be
|
|
|
1206 \"exec ftp\". FTP-PROGRAM-ARGS is a list of arguments to pass
|
|
|
1207 to FTP-PROGRAM. You probably want to set these to the same value as
|
|
|
1208 efs-ftp-program-args <V>. If you are using this option, read the
|
|
|
1209 documentation at the top of efs-gwp.el, and see
|
|
|
1210 efs-gwp-setup-term-command <V>.")
|
|
|
1211
|
|
|
1212 (defvar efs-gateway-hash-mark-size nil
|
|
|
1213 "*Value of `efs-hash-mark-size' for FTP clients on `efs-gateway-host'.
|
|
|
1214 See the documentation of these variables for more information.")
|
|
|
1215
|
|
|
1216 (defvar efs-gateway-incoming-binary-hm-size nil
|
|
|
1217 "*Value of `efs-incoming-binary-hm-size' for `efs-gateway-host'.
|
|
|
1218 See documentation of these variables for more information.")
|
|
|
1219
|
|
|
1220 (defvar efs-gateway-tmp-name-template "/tmp/efs"
|
|
|
1221 "Template used to create temporary files when ftp-ing through a gateway.
|
|
|
1222 This should be the name of the file on the gateway, and not necessarily
|
|
|
1223 the name on the local host.")
|
|
|
1224
|
|
|
1225 (defvar efs-gateway-mounted-dirs-alist nil
|
|
|
1226 "An alist of directories cross-mounted between the gateway and local host.
|
|
|
1227 Each entry is of the form \( DIR1 . DIR2 \), where DIR1 is the name of the
|
|
|
1228 directory on the local host, and DIR2 is its name on the remote host. Both
|
|
|
1229 DIR1 and DIR2 must be specified in directory syntax, i.e. end in a slash.
|
|
|
1230 Note that we will assume that subdirs of DIR1 and DIR2 are also accessible
|
|
|
1231 on both machines.")
|
|
|
1232
|
|
|
1233 (defvar efs-gateway-ftp-prompt-regexp "^\\(ftp\\|Ftp\\|FTP\\)> *"
|
|
|
1234 "*Regular expression to match the prompt of the gateway FTP client.")
|
|
|
1235
|
|
|
1236 ;;; End of gateway config variables.
|
|
|
1237
|
|
|
1238 (defvar efs-tmp-name-template "/tmp/efs"
|
|
|
1239 "Template used to create temporary files.
|
|
|
1240 If you are worried about security, make this a directory in some
|
|
|
1241 bomb-proof cave somewhere. efs does clean up its temp files, but
|
|
|
1242 they do live for short periods of time.")
|
|
|
1243
|
|
|
1244 (defvar efs-generate-anonymous-password t
|
|
|
1245 "*If t, use a password of `user@host' when logging in as the anonymous user.
|
|
|
1246 `host' is generated by the function `efs-system-fqdn'. If `system name' returns
|
|
|
1247 a fully qualified domain name, `efs-system-fqdn' will return this. Otherwise,
|
|
|
1248 it will attempt to use nslookup to obtain a fully qualified domain name. If
|
|
|
1249 this is unsuccessful, the returned value will be the same as `system-name',
|
|
|
1250 whether this is a fully qualified domain name or not.
|
|
|
1251
|
|
|
1252 If a string then use that as the password.
|
|
|
1253
|
|
|
1254 If nil then prompt the user for a password.
|
|
|
1255
|
|
|
1256 Beware that some operating systems, such as MVS, restrict substantially
|
|
|
1257 the password length. The login will fail with a weird error message
|
|
|
1258 if you exceed it.")
|
|
|
1259
|
|
|
1260 (defvar efs-high-security-hosts nil
|
|
|
1261 "*Indicates host user pairs for which passwords should not be cached.
|
|
|
1262 If non-nil, should be a regexp matching user@host constructions for which
|
|
|
1263 efs should not store passwords in its internal cache.")
|
|
|
1264
|
|
|
1265 ;; The following regexps are tested in the following order:
|
|
|
1266 ;; efs-binary-file-host-regexp, efs-36-bit-binary-file-name-regexp,
|
|
|
1267 ;; efs-binary-file-name-regexp, efs-text-file-name-regexp.
|
|
|
1268 ;; File names which match nothing are transferred in 'image mode.
|
|
|
1269
|
|
|
1270 ;; If we're not careful, we're going to blow the regexp stack here.
|
|
|
1271 ;; Probably should move to a list of regexps. Slower, but safer.
|
|
|
1272 ;; This is not a problem in Emacs 19.
|
|
|
1273 (defvar efs-binary-file-name-regexp
|
|
|
1274 (concat "\\." ; the dot
|
|
|
1275 ;; extensions
|
|
|
1276 "\\([zZ]\\|t?gz\\|lzh\\|arc\\|zip\\|zoo\\|ta[rz]\\|dvi\\|sit\\|"
|
|
|
1277 "ps\\|elc\\|gif\\|Z-part-..\\|tpz\\|exe\\|[jm]pg\\|TZ[a-z]?\\|lib\\)"
|
|
|
1278 "\\(~\\|~[0-9]+~\\)?$" ; backups
|
|
|
1279 "\\|"
|
|
|
1280 ;; UPPER CASE LAND
|
|
|
1281 "\\."
|
|
|
1282 "\\(ARC\\|ELC\\|TAGS\\|EXE\\|ZIP\\|DVI\|ZOO\\|GIF\\|T?GZ\\|"
|
|
|
1283 "[JM]PG\\)"
|
|
|
1284 "\\([.#;][0-9]+\\)?$" ; versions
|
|
|
1285 )
|
|
|
1286 "*Files whose names match this regexp will be considered to be binary.
|
|
|
1287 By binary here, we mean 8-bit binary files (the usual unix binary files).
|
|
|
1288 If nil, no files will be considered to be binary.")
|
|
|
1289
|
|
|
1290 (defvar efs-binary-file-host-regexp nil
|
|
|
1291 "*All files on hosts matching this regexp are treated as 8-bit binary.
|
|
|
1292 Setting this to nil, inhibits this feature.")
|
|
|
1293
|
|
|
1294 (defvar efs-36-bit-binary-file-name-regexp nil
|
|
|
1295 "*Files whose names match this regexp will be considered to PDP 10 binaries.
|
|
|
1296 These are 36-bit word-aligned binary files. This is really only relevant for
|
|
|
1297 files on PDP 10's, and similar machines. If nil, no files will be considered
|
|
|
1298 to be PDP 10 binaries.")
|
|
|
1299
|
|
|
1300 (defvar efs-text-file-name-regexp ".*"
|
|
|
1301 "*Files whose names match this regexp will be considered to be text files.")
|
|
|
1302
|
|
|
1303 (defvar efs-prompt-for-transfer-type nil
|
|
|
1304 "*If non-nil, efs will prompt for the transfer type for each file transfer.
|
|
|
1305 The command efs-prompt-for-transfer-type can be used to toggle its value.")
|
|
|
1306
|
|
|
1307 (defvar efs-treat-crlf-as-nl nil
|
|
|
1308 "*Controls how file systems using CRLF as end of line are treated.
|
|
|
1309 If non-nil, such file systems will be considered equivalent to those which use
|
|
|
1310 LF as end of line. This is particularly relevant to transfers between DOS
|
|
|
1311 systems and UNIX. Setting this to be non-nil will cause all file transfers
|
|
|
1312 between DOS and UNIX systems to use be image or binary transfers.")
|
|
|
1313
|
|
|
1314 (defvar efs-send-hash t
|
|
|
1315 "*If non-nil, send the HASH command to the FTP client.")
|
|
|
1316
|
|
|
1317 (defvar efs-hash-mark-size nil
|
|
|
1318 "*Default size, in bytes, between hash-marks when transferring a file.
|
|
|
1319 If this is nil then efs will attempt to assign a value based on the
|
|
|
1320 output of the HASH command. Also, if this variable is incorrectly set,
|
|
|
1321 then efs will try to correct it based on the size of the last file
|
|
|
1322 transferred, and the number hashes outputed by the client during the
|
|
|
1323 transfer.
|
|
|
1324
|
|
|
1325 The variable `efs-gateway-hash-mark-size' defines the corresponding value
|
|
|
1326 for the FTP client on the gateway, if you are using a gateway.
|
|
|
1327
|
|
|
1328 Some client-server combinations do not correctly compute the number of hash
|
|
|
1329 marks for incoming binary transfers. In this case, a separate variable
|
|
|
1330 `efs-incoming-binary-hm-size' can be used to set a default value of the
|
|
|
1331 hash mark size for incoming binary transfers.")
|
|
|
1332
|
|
|
1333 (defvar efs-incoming-binary-hm-size nil
|
|
|
1334 "*Default hash mark size for incoming binary transfers.
|
|
|
1335 If this is nil, incoming binary transfers will use `efs-hash-mark-size' as
|
|
|
1336 the default. See the documentation of this variable for more details.")
|
|
|
1337
|
|
|
1338 (defvar efs-verbose t
|
|
|
1339 "*If non-NIL then be chatty about interaction with the FTP process.
|
|
|
1340 If 0 do not give % transferred reports for asynchronous commands and status
|
|
|
1341 reports for commands verifying file modtimes, but report on everything else.")
|
|
|
1342
|
|
|
1343 (defvar efs-message-interval 0
|
|
|
1344 "*Defines the minimum time in seconds between status messages.
|
|
|
1345 A new status message is not displayed, if one has already been given
|
|
|
1346 within this period of time.")
|
|
|
1347
|
|
|
1348 (defvar efs-max-ftp-buffer-size 3000
|
|
|
1349 "*Maximum size in characters of FTP process buffer, before it is trimmed.
|
|
|
1350 The buffer is trimmed to approximately half this size. Setting this to nil
|
|
|
1351 inhibits trimming of FTP process buffers.")
|
|
|
1352
|
|
|
1353 (defvar efs-ls-cache-max 5
|
|
|
1354 "*Maximum number of directory listings to be cached in efs-ls-cache.")
|
|
|
1355
|
|
|
1356 (defvar efs-mode-line-format " ftp(%d)"
|
|
|
1357 "Format string used to determine how FTP activity is shown on the mode line.
|
|
|
1358 It is passed to format, with second argument the number of active FTP
|
|
|
1359 sessions as an integer.")
|
|
|
1360
|
|
|
1361 (defvar efs-show-host-type-in-dired t
|
|
|
1362 "If non-nil, show the system type on the mode line of remote dired buffers.")
|
|
|
1363
|
|
|
1364 (defvar efs-ftp-activity-function nil
|
|
|
1365 "Function called to indicate FTP activity.
|
|
|
1366 It must have exactly one argument, the number of active FTP sessions as an
|
|
|
1367 integer.")
|
|
|
1368
|
|
|
1369 (defvar efs-ftp-program-name "ftp"
|
|
|
1370 "Name of FTP program to run.")
|
|
|
1371
|
|
|
1372 (defvar efs-ftp-program-args '("-i" "-n" "-g" "-v")
|
|
|
1373 "*A list of arguments passed to the FTP program when started.")
|
|
|
1374
|
|
|
1375 (defvar efs-ftp-prompt-regexp "^\\(ftp\\|Ftp\\|FTP\\)> *"
|
|
|
1376 "*Regular expression to match the prompt of your FTP client.")
|
|
|
1377
|
|
|
1378 (defvar efs-nslookup-program "nslookup"
|
|
|
1379 "*If non-NIL then a string naming nslookup program." )
|
|
|
1380
|
|
|
1381 (defvar efs-nslookup-on-connect nil
|
|
|
1382 "*If non-NIL then use nslookup to resolve the host name before connecting.")
|
|
|
1383
|
|
|
1384 (defvar efs-nslookup-threshold 1000
|
|
|
1385 "How many iterations efs waits on the nslookup program.
|
|
|
1386 Applies when nslookup is used to compute a fully qualified domain name
|
|
|
1387 for the local host, in the case when `system-name' does not return one.
|
|
|
1388 If you set this to nil, efs will wait an arbitrary amount of time to get
|
|
|
1389 output.")
|
|
|
1390
|
|
118
|
1391 (defvar efs-remote-shell-file-name
|
|
|
1392 (if (memq system-type '(hpux usg-unix-v)) ; hope that's right
|
|
|
1393 "remsh"
|
|
|
1394 "rsh")
|
|
|
1395 "Remote shell used by efs.")
|
|
|
1396
|
|
|
1397 (defvar efs-remote-shell-takes-user
|
|
|
1398 (null (null (memq system-type '(aix aix-v3 hpux silicon-graphics-unix
|
|
|
1399 berkeley-unix))))
|
|
|
1400 ;; Complete? Doubt it.
|
|
|
1401 "Set to non-nil if your remote shell command takes \"-l USER\".")
|
|
|
1402
|
|
98
|
1403 (defvar efs-make-backup-files efs-unix-host-types
|
|
|
1404 "*A list of operating systems for which efs will make Emacs backup files.
|
|
|
1405 The backup files are made on the remote host.
|
|
|
1406
|
|
|
1407 For example:
|
|
|
1408 '\(unix sysV-unix bsd-unix apollo-unix dumb-unix\) makes sense, but
|
|
|
1409 '\(unix vms\) would be silly, since vms makes its own backups.")
|
|
|
1410
|
|
|
1411 ;; Is this variable really useful? We should try to figure a way to
|
|
|
1412 ;; do local copies on a remote machine that doesn't take forever.
|
|
|
1413 (defvar efs-backup-by-copying nil
|
|
|
1414 "*Version of `backup by copying' for remote files.
|
|
|
1415 If non-nil, remote files will be backed up by copying, instead of by renaming.
|
|
|
1416 Note the copying will be done by moving the file through the local host -- a
|
|
|
1417 very time consuming operation.")
|
|
|
1418
|
|
|
1419 ;;; Auto-save variables. Relevant for auto-save.el
|
|
|
1420
|
|
|
1421 (defvar efs-auto-save 0
|
|
|
1422 "*If 1, allows efs files to be auto-saved.
|
|
|
1423 If 0, suppresses auto-saving of efs files.
|
|
|
1424 Don't use any other value.")
|
|
|
1425
|
|
|
1426 (defvar efs-auto-save-remotely nil
|
|
|
1427 "*Determines where remote files are auto-saved.
|
|
|
1428
|
|
|
1429 If nil, auto-saves for remote files will be written in `auto-save-directory'
|
|
|
1430 or `auto-save-directory-fallback' if this isn't defined.
|
|
|
1431
|
|
|
1432 If non-nil, causes the auto-save file for an efs file to be written in
|
|
|
1433 the remote directory containing the file, rather than in a local directory.
|
|
|
1434 For remote files, this overrides a non-nil `auto-save-directory'. Local files
|
|
|
1435 are unaffected. If you want to use this feature, you probably only want to
|
|
|
1436 set this true in a few buffers, rather than globally. You might want to give
|
|
|
1437 each buffer its own value using `make-variable-buffer-local'. It is usually
|
|
|
1438 a good idea to auto-save remote files locally, because it is not only faster,
|
|
|
1439 but provides protection against a connection going down.
|
|
|
1440
|
|
|
1441 See also variable `efs-auto-save'.")
|
|
|
1442
|
|
|
1443 (defvar efs-short-circuit-to-remote-root nil
|
|
|
1444 "*Defines whether \"//\" short-circuits to the remote or local root.")
|
|
|
1445
|
|
|
1446 ;; Can we somehow grok this from system type? No.
|
|
|
1447 (defvar efs-local-apollo-unix
|
|
|
1448 (eq 0 (string-match "//" (or (getenv "HOME") (getenv "SHELL") "")))
|
|
|
1449 "*Defines whether the local machine is an apollo running Domain.
|
|
|
1450 This variable has nothing to do with efs, and should be basic to all
|
|
|
1451 of emacs.")
|
|
|
1452
|
|
|
1453 (defvar efs-root-umask nil
|
|
|
1454 "*umask to use for root logins.")
|
|
|
1455
|
|
|
1456 (defvar efs-anonymous-umask nil
|
|
|
1457 "*umask to use for anonymous logins.")
|
|
|
1458
|
|
|
1459 (defvar efs-umask nil
|
|
|
1460 "*umask to use for efs sessions.
|
|
|
1461 If this is nil, then the setting of umask on the local host is used.")
|
|
|
1462
|
|
|
1463 ;; Eliminate these variables when Sun gets around to getting its FTP server
|
|
|
1464 ;; out of the stone age.
|
|
|
1465 (defvar efs-ding-on-umask-failure t
|
|
|
1466 "*Ring the bell if the umask command fails on a unix host. Many servers don't
|
|
|
1467 support this command, so if you get a lot of annoying failures, set this
|
|
|
1468 to nil.")
|
|
|
1469
|
|
|
1470 (defvar efs-ding-on-chmod-failure t
|
|
|
1471 "*Ring the bell if the chmod command fails on a unix host. Some servers don't
|
|
|
1472 support this command, so if you get a lot of annoying failures, set this
|
|
|
1473 to nil.")
|
|
|
1474
|
|
|
1475 ;; Please let us know if you can contribute more entries to this guessing game.
|
|
|
1476 (defvar efs-nlist-cmd
|
|
|
1477 (cond
|
|
|
1478 ;; Covers Ultrix, SunOS, and NeXT.
|
|
|
1479 ((eq system-type 'berkeley-unix)
|
|
|
1480 "ls")
|
|
|
1481 ((memq system-type '(hpux aix-v3 silicon-graphics-unix))
|
|
|
1482 "nlist")
|
|
|
1483 ;; Blind guess
|
|
|
1484 ("ls"))
|
|
|
1485 "*FTP client command for getting a brief listing (NLST) from the FTP server.
|
|
|
1486 We try to guess this based on the local system-type, but obviously if you
|
|
|
1487 are using a gateway, you'll have to set it yourself.")
|
|
|
1488
|
|
|
1489 (defvar efs-compute-remote-buffer-file-truename nil
|
|
|
1490 "*If non-nil, `buffer-file-truename' will be computed for remote buffers.
|
|
|
1491 In emacs 19, each buffer has a local variable, `buffer-file-truename',
|
|
|
1492 which is used to ensure that symbolic links will not confuse emacs into
|
|
|
1493 visiting the same file with two buffers. This variable is computed by
|
|
|
1494 chasing all symbolic links in `buffer-file-name', both at the level of the
|
|
|
1495 file and at the level of all parent directories. Since this operation can be
|
|
|
1496 very time-consuming over FTP, this variable can be used to inhibit it.")
|
|
|
1497
|
|
|
1498 (defvar efs-buffer-name-case nil
|
|
|
1499 "*Selects the case used for buffer names of case-insensitive file names.
|
|
|
1500 Case-insensitive file names are files on hosts whose host type is in
|
|
|
1501 `efs-case-insensitive-host-types'.
|
|
|
1502
|
|
|
1503 If this is 'up upper case is used, if it is 'down lower case is used.
|
|
|
1504 If this has any other value, the case is inherited from the name used
|
|
|
1505 to access the file.")
|
|
|
1506
|
|
|
1507 (defvar efs-fancy-buffer-names "%s@%s"
|
|
|
1508 "Format used to compute names of buffers attached to remote files.
|
|
|
1509
|
|
|
1510 If this is nil, buffer names are computed in the usual way.
|
|
|
1511
|
|
|
1512 If it is a string, then the it is passed to format with second and third
|
|
|
1513 arguments the host name and file name.
|
|
|
1514
|
|
|
1515 Otherwise, it is assumed to be function taking three arguments, the host name,
|
|
|
1516 the user name, and the truncated file name. It should returns the name to
|
|
|
1517 be used for the buffer.")
|
|
|
1518
|
|
|
1519 (defvar efs-verify-anonymous-modtime nil
|
|
|
1520 "*Determines if efs checks modtimes for remote files on anonymous logins.
|
|
|
1521 If non-nil, efs runs `verify-visited-file-modtime' for remote files on
|
|
|
1522 anonymous ftp logins. Since verify-visited-file-modtime slows things down,
|
|
|
1523 and most people aren't editing files on anonymous ftp logins, this is nil
|
|
|
1524 by default.")
|
|
|
1525
|
|
|
1526 (defvar efs-verify-modtime-host-regexp ".*"
|
|
|
1527 "*Regexp to match host names for which efs checks file modtimes.
|
|
|
1528 If non-nil, efs will run `verify-visited-file-modtime' for remote
|
|
|
1529 files on hosts matching this regexp. If nil, verify-visited-file-modtime
|
|
|
1530 is supressed for all remote hosts. This is tested before
|
|
|
1531 `efs-verify-anonymous-modtime'.")
|
|
|
1532
|
|
|
1533 (defvar efs-maximize-idle nil
|
|
|
1534 "*If non-nil, efs will attempt to maximize the idle time out period.
|
|
|
1535 At some idle moment in the connection after login, efs will attempt to
|
|
|
1536 set the idle time out period to the maximum amount allowed by the server.
|
|
|
1537 It applies only to non-anonymous logins on unix hosts.")
|
|
|
1538
|
|
|
1539 (defvar efs-expire-ftp-buffers t
|
|
|
1540 "*If non-nil ftp buffers will be expired.
|
|
|
1541 The buffers will be killed either after `efs-ftp-buffer-expire-time' has
|
|
|
1542 elapsed with no activity, or the remote FTP server has timed out.")
|
|
|
1543
|
|
|
1544 (defvar efs-ftp-buffer-expire-time nil
|
|
|
1545 "*If non-nil, the time after which ftp buffers will be expired.
|
|
|
1546 If nil, ftp buffers will be expired only when the remote server has timed out.
|
|
|
1547 If an integer, ftp buffers will be expired either when the remote server
|
|
|
1548 has timed out, or when this many seconds on inactivity has elapsed.")
|
|
|
1549
|
|
|
1550 ;; If you need to increase this variable much, it is likely that
|
|
|
1551 ;; the true problem is timing errors between the efs process filter
|
|
|
1552 ;; and the FTP server. This could either be caused by the server
|
|
|
1553 ;; not following RFC959 response codes, or a bug in efs. In either
|
|
|
1554 ;; case please report the problem to us. If it's a bug, we'll fix it.
|
|
|
1555 ;; If the server is at fault we may try to do something. Our rule
|
|
|
1556 ;; of thumb is that we will support non-RFC959 behaviour, as long as
|
|
|
1557 ;; it doesn't risk breaking efs for servers which behave properly.
|
|
|
1558
|
|
|
1559 (defvar efs-retry-time 5
|
|
|
1560 "*Number of seconds to wait before retrying if data doesn't arrive.
|
|
|
1561 The FTP command isn't retried, rather efs just takes a second look
|
|
|
1562 for the data file. This might need to be increased for very slow FTP
|
|
|
1563 clients.")
|
|
|
1564
|
|
|
1565 (defvar efs-pty-check-threshold 1000
|
|
|
1566 "*How long efs waits before deciding that it doesn't have a pty.
|
|
|
1567 Specifically it is the number of iterations through `accept-process-output'
|
|
|
1568 that `efs-pty-p' waits before deciding that the pty is really a pipe.
|
|
|
1569 Set this to nil to inhibit checking for pty's. If efs seems to be
|
|
|
1570 mistaking some pty's for pipes, try increasing this number.")
|
|
|
1571
|
|
|
1572 (defvar efs-pty-check-retry-time 5
|
|
|
1573 "*Number of seconds that efs waits before retrying a pty check.
|
|
|
1574 This can be lengthened, if your FTP client is slow to start.")
|
|
|
1575
|
|
|
1576 (defvar efs-suppress-abort-recursive-edit-and-then nil
|
|
|
1577 "*If non-nil, `efs-abort-recursive-edit-and-then' will not run its function.
|
|
|
1578 This means that when a recursive edit is in progress, automatic popping of the
|
|
|
1579 FTP process buffer, and automatic popping of the bug report buffer will not
|
|
|
1580 work. `efs-abort-recursive-edit-and-then' works by forking a \"sleep 0\"
|
|
|
1581 process. On some unix implementations the forked process might be of the same
|
|
|
1582 size as the original GNU Emacs process. Forking such a large process just to
|
|
|
1583 do a \"sleep 0\" is probably not good.")
|
|
|
1584
|
|
|
1585 (defvar efs-ftp-buffer-format "*ftp %s@%s*"
|
|
|
1586 "Format to construct the name of FTP process buffers.
|
|
|
1587 This string is fed to `format' with second and third arguments the user
|
|
|
1588 name and host name.")
|
|
|
1589 ;; This does not affect the process name of the FTP client process.
|
|
|
1590 ;; That is always *ftp USER@HOST*
|
|
|
1591
|
|
|
1592 (defvar efs-debug-ftp-connection nil
|
|
|
1593 "*If non-nil, the user will be permitted to debug the FTP connection.
|
|
|
1594 This means that typing a C-g to the FTP process filter will give the user
|
|
|
1595 the option to type commands at the FTP connection. Normally, the connection
|
|
|
1596 is killed first. Note that doing this may result in the FTP process filter
|
|
|
1597 getting out of synch with the FTP client, so using this feature routinely
|
|
|
1598 isn't recommended.")
|
|
|
1599
|
|
|
1600 ;;; Hooks and crooks.
|
|
|
1601
|
|
|
1602 (defvar efs-ftp-startup-hook nil
|
|
|
1603 "Hook to run immediately after starting the FTP client.
|
|
|
1604 This hook is run before the FTP OPEN command is sent.")
|
|
|
1605
|
|
|
1606 (defvar efs-ftp-startup-function-alist nil
|
|
|
1607 "Association list of functions to running after FTP login.
|
|
|
1608 This should be an alist of the form '\(\(REGEXP . FUNCTION\) ...\), where
|
|
|
1609 REGEXP is a regular expression matched against the name of the remote host,
|
|
|
1610 and FUNCTION is a function of two arguments, HOST and USER. REGEXP is
|
|
|
1611 compared to the host name with `case-fold-search' bound to t. Only the first
|
|
|
1612 match in the alist is run.")
|
|
|
1613
|
|
|
1614 (defvar efs-load-hook nil
|
|
|
1615 "Hook to run immediately after loading efs.el.
|
|
|
1616 You can use it to alter definitions in efs.el, but why would you want
|
|
|
1617 to do such a thing?")
|
|
|
1618
|
|
|
1619 ;;;; -----------------------------------------------------------
|
|
|
1620 ;;;; Regexps for parsing FTP server responses.
|
|
|
1621 ;;;; -----------------------------------------------------------
|
|
|
1622 ;;;
|
|
|
1623 ;;; If you have to tune these variables, please let us know, so that
|
|
|
1624 ;;; we can get them right in the next release.
|
|
|
1625
|
|
|
1626 (defvar efs-multi-msgs
|
|
|
1627 ;; RFC959 compliant codes
|
|
|
1628 "^[1-5][0-5][0-7]-")
|
|
|
1629 ;; Regexp to match the start of an FTP server multiline reply.
|
|
|
1630
|
|
|
1631 (defvar efs-skip-msgs
|
|
|
1632 ;; RFC959 compliant codes
|
|
|
1633 (concat
|
|
|
1634 "^110 \\|" ; Restart marker reply.
|
|
|
1635 "^125 \\|" ; Data connection already open; transfer starting.
|
|
|
1636 "^150 ")) ; File status OK; about to open connection.
|
|
|
1637 ;; Regexp to match an FTP server response which we wish to ignore.
|
|
|
1638
|
|
|
1639 (defvar efs-cmd-ok-msgs
|
|
|
1640 ;; RFC959 compliant
|
|
|
1641 "^200 \\|^227 ")
|
|
|
1642 ;; Regexp to match the server command OK response.
|
|
|
1643 ;; Because PORT commands return this we usually ignore it. However, it is
|
|
|
1644 ;; a valid response for TYPE, SITE, and a few other commands (cf. RFC 959).
|
|
|
1645 ;; If we are explicitly sending a PORT, or one of these other commands,
|
|
|
1646 ;; then we don't want to ignore this response code. Also use this to match
|
|
|
1647 ;; the return code for PASV, as some clients burp these things out at odd
|
|
|
1648 ;; times.
|
|
|
1649
|
|
|
1650 (defvar efs-pending-msgs
|
|
|
1651 ;; RFC959 compliant
|
|
|
1652 "^350 ") ; Requested file action, pending further information.
|
|
|
1653 ;; Regexp to match the \"requested file action, pending further information\"
|
|
|
1654 ;; message. These are usually ignored, except if we are using RNFR to test for
|
|
|
1655 ;; file existence.
|
|
|
1656
|
|
|
1657 (defvar efs-cmd-ok-cmds
|
|
|
1658 (concat
|
|
|
1659 "^quote port \\|^type \\|^quote site \\|^chmod \\|^quote noop\\|"
|
|
|
1660 "^quote pasv"))
|
|
|
1661 ;; Regexp to match commands for which efs-cmd-ok-msgs is a valid server
|
|
|
1662 ;; response for success.
|
|
|
1663
|
|
|
1664 (defvar efs-passwd-cmds
|
|
|
1665 "^quote pass \\|^quote acct \\|^quote site gpass ")
|
|
|
1666 ;; Regexp to match commands for sending passwords.
|
|
|
1667 ;; All text following (match-end 0) will be replaced by "Turtle Power!"
|
|
|
1668
|
|
|
1669 (defvar efs-bytes-received-msgs
|
|
|
1670 ;; Strictly a client response
|
|
|
1671 "^[0-9]+ bytes ")
|
|
|
1672 ;; Regexp to match the reply from the FTP client that it has finished
|
|
|
1673 ;; receiving data.
|
|
|
1674
|
|
|
1675 (defvar efs-server-confused-msgs
|
|
|
1676 ;; ka9q uses this to indicate an incorrectly set transfer mode, and
|
|
|
1677 ;; then does send a second completion code for the command. This does
|
|
|
1678 ;; *not* conform to RFC959.
|
|
|
1679 "^100 Warning: type is ")
|
|
|
1680 ;; Regexp to match non-standard response from the FTP server. This can
|
|
|
1681 ;; sometimes be the result of an incorrectly set transfer mode. In this case
|
|
|
1682 ;; we do not rely on the server to tell us when the data transfer is complete,
|
|
|
1683 ;; but check with the client.
|
|
|
1684
|
|
|
1685 (defvar efs-good-msgs
|
|
|
1686 (concat
|
|
|
1687 ;; RFC959 compliant codes
|
|
|
1688 "^2[01345][0-7] \\|" ; 2yz = positive completion reply
|
|
|
1689 "^22[02-7] \\|" ; 221 = successful logout
|
|
|
1690 ; (Sometimes get this with a timeout,
|
|
|
1691 ; so treat as fatal.)
|
|
|
1692 "^3[0-5][0-7] \\|" ; 3yz = positive intermediate reply
|
|
|
1693 ;; client codes
|
|
|
1694 "^[Hh]ash mark "))
|
|
|
1695 ;; Response to indicate that the requested action was successfully completed.
|
|
|
1696
|
|
|
1697 (defvar efs-failed-msgs
|
|
|
1698 (concat
|
|
|
1699 ;; RFC959 compliant codes
|
|
|
1700 "^120 \\|" ; Service ready in nnn minutes.
|
|
|
1701 "^450 \\|" ; File action not taken; file is unavailable, or busy.
|
|
|
1702 "^452 \\|" ; Insufficient storage space on system.
|
|
|
1703 "^5[0-5][0-7] \\|" ; Permanent negative reply codes.
|
|
|
1704 ;; When clients tell us that a file doesn't exist, or can't access.
|
|
|
1705 "^\\(local: +\\)?/[^ ]* +"
|
|
|
1706 "\\([Nn]o such file or directory\\|[Nn]ot a plain file\\|"
|
|
|
1707 "The file access permissions do not allow \\|Is a directory\\b\\)"))
|
|
|
1708 ;; Regexp to match responses for failed commands. However, the ftp connection
|
|
|
1709 ;; is assumed to be good.
|
|
|
1710
|
|
|
1711 (defvar efs-fatal-msgs
|
|
|
1712 (concat
|
|
|
1713 ;; RFC959 codes
|
|
|
1714 "^221 \\|" ; Service closing control connection.
|
|
|
1715 "^421 \\|" ; Service not available.
|
|
|
1716 "^425 \\|" ; Can't open data connection.
|
|
|
1717 "^426 \\|" ; Connection closed, transfer aborted.
|
|
|
1718 "^451 \\|" ; Requested action aborted, local error in processing.
|
|
|
1719 ;; RFC959 non-compliant codes
|
|
|
1720 "^552 Maximum Idle Time Exceded\\.$\\|" ; Hellsoft server uses this to
|
|
|
1721 ; indicate a timeout. 552 is
|
|
|
1722 ; supposed to be used for exceeded
|
|
|
1723 ; storage allocation. Note that
|
|
|
1724 ; they also misspelled the error
|
|
|
1725 ; message.
|
|
|
1726 ;; client problems
|
|
|
1727 "^ftp: \\|^Not connected\\|^rcmd: \\|^No control connection\\|"
|
|
|
1728 "^unknown host\\|: unknown host$\\|^lost connection\\|"
|
|
|
1729 "^[Ss]egmentation fault\\|"
|
|
|
1730 ;; Make sure that the "local: " isn't just a message about a file.
|
|
|
1731 "^local: [^/]\\|"
|
|
|
1732 ;; Gateways
|
|
|
1733 "^iftp: cannot authenticate to server\\b"
|
|
|
1734 ))
|
|
|
1735 ;; Regexp to match responses that something has gone drastically wrong with
|
|
|
1736 ;; either the client, server, or connection. We kill the ftp process, and start
|
|
|
1737 ;; anew.
|
|
|
1738
|
|
|
1739 (defvar efs-unknown-response-msgs
|
|
|
1740 "^[0-9][0-9][0-9] ")
|
|
|
1741 ;; Regexp to match server response codes that we don't understand. This
|
|
|
1742 ;; is tested after all the other regexp, so it can match everything.
|
|
|
1743
|
|
|
1744 (defvar efs-pasv-msgs
|
|
|
1745 ;; According to RFC959.
|
|
|
1746 "^227 .*(\\([0-9]+,[0-9]+,[0-9]+,[0-9]+,[0-9]+,[0-9]+\\))$")
|
|
|
1747 ;; Matches the output of a PASV. (match-beginning 1) and (match-end 1)
|
|
|
1748 ;; must bracket the IP address and port.
|
|
|
1749
|
|
|
1750 (defvar efs-syst-msgs "^215 \\|^210 ")
|
|
|
1751 ;; 215 is RFC959. Plan 9 FTP server returns a 210. 210 is not assigned in
|
|
|
1752 ;; RFC 959.
|
|
|
1753 ;; The plan 9 people tell me that they fixed this. -- sr 18/4/94
|
|
|
1754 ;; Matches the output of a SYST.
|
|
|
1755
|
|
|
1756 (defvar efs-mdtm-msgs
|
|
|
1757 (concat
|
|
|
1758 "^213 [0-9][0-9][0-9][0-9][0-9][0-9][0-9]"
|
|
|
1759 "[0-9][0-9][0-9][0-9][0-9][0-9][0-9]$"))
|
|
|
1760 ;; Regexp to match the output of a quote mdtm command.
|
|
|
1761
|
|
|
1762 (defvar efs-idle-msgs
|
|
|
1763 "^200 [^0-9]+ \\([0-9]+\\)[^0-9]* max \\([0-9]+\\)")
|
|
|
1764 ;; Regexp to match the output of a SITE IDLE command.
|
|
|
1765 ;; Match 1 should refer to the current idle time, and match 2 the maximum
|
|
|
1766 ;; idle time.
|
|
|
1767
|
|
|
1768 (defvar efs-write-protect-msgs "^532 ") ; RFC959
|
|
|
1769 ;; Regexp to match a server ressponse to indicate that a STOR failed
|
|
|
1770 ;; because of insufficient write privileges.
|
|
|
1771
|
|
|
1772 (defvar efs-hash-mark-msgs
|
|
|
1773 "[hH]ash mark [^0-9]*\\([0-9]+\\)")
|
|
|
1774 ;; Regexp matching the FTP client's output upon doing a HASH command.
|
|
|
1775
|
|
|
1776 (defvar efs-xfer-size-msgs
|
|
|
1777 (concat
|
|
|
1778 ;; UN*X
|
|
|
1779 "^150 .* connection for .* (\\([0-9]+\\) bytes)\\|"
|
|
|
1780 ;; Wollongong VMS server.
|
|
|
1781 "^125 .* transfer started for .* (\\([0-9]+\\) bytes)\\|"
|
|
|
1782 ;; TOPS-20 server
|
|
|
1783 "^150 .* retrieve of .* ([0-9]+ pages?, \\([0-9]+\\) 7-bit bytes)"))
|
|
|
1784 ;; Regular expression used to determine the number of bytes
|
|
|
1785 ;; in a FTP transfer. The first (match-beginning #) which is non-nil is assumed
|
|
|
1786 ;; to give the size.
|
|
|
1787
|
|
|
1788 (defvar efs-expand-dir-msgs "^550 \\([^: ]+\\):")
|
|
|
1789 ;; Regexp to match the error response from a "get ~sandy".
|
|
|
1790 ;; By parsing the error, we can get a quick expansion of ~sandy
|
|
|
1791 ;; According to RFC 959, should be a 550.
|
|
|
1792
|
|
|
1793 (defvar efs-gateway-fatal-msgs
|
|
|
1794 "No route to host\\|Connection closed\\|No such host\\|Login incorrect")
|
|
|
1795 ;; Regular expression matching messages from the rlogin / telnet process that
|
|
|
1796 ;; indicates that logging in to the gateway machine has gone wrong.
|
|
|
1797
|
|
|
1798 (defvar efs-too-many-users-msgs
|
|
|
1799 ;; The test for "two many" is because some people can't spell.
|
|
|
1800 ;; I allow for up to two adjectives before "users".
|
|
|
1801 (concat
|
|
|
1802 "\\b[Tt][wo]o many\\( +[^ \n]+\\)?\\( +[^ \n]+\\)? +users\\b\\|"
|
|
|
1803 "\\btry back later\\b"))
|
|
|
1804 ;; Regular expresion to match what servers output when there are too many
|
|
|
1805 ;; anonymous logins. It is assumed that this is part of a 530 or 530- response
|
|
|
1806 ;; to USER or PASS.
|
|
|
1807
|
|
|
1808 ;;;; -------------------------------------------------------------
|
|
|
1809 ;;;; Buffer local FTP process variables
|
|
|
1810 ;;;; -------------------------------------------------------------
|
|
|
1811
|
|
|
1812 ;;; Variables buffer local to the process buffers are
|
|
|
1813 ;;; named with the prefix efs-process-
|
|
|
1814
|
|
|
1815 (defvar efs-process-q nil)
|
|
|
1816 ;; List of functions to be performed asynch.
|
|
|
1817 (make-variable-buffer-local 'efs-process-q)
|
|
|
1818
|
|
|
1819 (defvar efs-process-cmd-waiting nil)
|
|
|
1820 ;; Set to t if a process has a synchronous cmd waiting to execute.
|
|
|
1821 ;; In this case, it will allow the synch. cmd to run before returning to
|
|
|
1822 ;; the cmd queue.
|
|
|
1823 (make-variable-buffer-local 'efs-process-cmd-waiting)
|
|
|
1824
|
|
|
1825 (defvar efs-process-server-confused nil)
|
|
|
1826 (make-variable-buffer-local 'efs-process-server-confused)
|
|
|
1827
|
|
|
1828 (defvar efs-process-cmd nil)
|
|
|
1829 ;; The command currently being executed, as a string.
|
|
|
1830 (make-variable-buffer-local 'efs-process-cmd)
|
|
|
1831
|
|
|
1832 (defvar efs-process-xfer-size 0)
|
|
|
1833 (make-variable-buffer-local 'efs-process-xfer-size)
|
|
|
1834
|
|
|
1835 (defvar efs-process-umask nil)
|
|
|
1836 ;; nil if the umask hash not been set
|
|
|
1837 ;; an integer (the umask) if the umask has been set
|
|
|
1838 (make-variable-buffer-local 'efs-process-umask)
|
|
|
1839
|
|
|
1840 (defvar efs-process-idle-time nil)
|
|
|
1841 ;; If non-nil, the idle time of the server in seconds.
|
|
|
1842 (make-variable-buffer-local 'efs-process-idle-time)
|
|
|
1843
|
|
|
1844 (defvar efs-process-busy nil)
|
|
|
1845 (make-variable-buffer-local 'efs-process-busy)
|
|
|
1846
|
|
|
1847 (defvar efs-process-result-line "")
|
|
|
1848 (make-variable-buffer-local 'efs-process-result-line)
|
|
|
1849
|
|
|
1850 (defvar efs-process-result nil)
|
|
|
1851 (make-variable-buffer-local 'efs-process-result)
|
|
|
1852
|
|
|
1853 (defvar efs-process-result-cont-lines "")
|
|
|
1854 (make-variable-buffer-local 'efs-process-result-cont-lines)
|
|
|
1855
|
|
|
1856 (defvar efs-process-msg "")
|
|
|
1857 (make-variable-buffer-local 'efs-process-msg)
|
|
|
1858
|
|
|
1859 (defvar efs-process-nowait nil)
|
|
|
1860 (make-variable-buffer-local 'efs-process-nowait)
|
|
|
1861
|
|
|
1862 (defvar efs-process-string "")
|
|
|
1863 (make-variable-buffer-local 'efs-process-string)
|
|
|
1864
|
|
|
1865 (defvar efs-process-continue nil)
|
|
|
1866 (make-variable-buffer-local 'efs-process-continue)
|
|
|
1867
|
|
|
1868 (defvar efs-process-hash-mark-count 0)
|
|
|
1869 (make-variable-buffer-local 'efs-process-hash-mark-count)
|
|
|
1870
|
|
|
1871 (defvar efs-process-hash-mark-unit nil)
|
|
|
1872 (make-variable-buffer-local 'efs-process-hash-mark-unit)
|
|
|
1873
|
|
|
1874 (defvar efs-process-last-percent -1)
|
|
|
1875 (make-variable-buffer-local 'efs-process-last-percent)
|
|
|
1876
|
|
|
1877 (defvar efs-process-host nil)
|
|
|
1878 (make-variable-buffer-local 'efs-process-host)
|
|
|
1879
|
|
|
1880 (defvar efs-process-user nil)
|
|
|
1881 (make-variable-buffer-local 'efs-process-user)
|
|
|
1882
|
|
|
1883 (defvar efs-process-host-type nil)
|
|
|
1884 ;; Holds the host-type as a string, for showing it on the mode line.
|
|
|
1885 (make-variable-buffer-local 'efs-process-host-type)
|
|
|
1886
|
|
|
1887 (defvar efs-process-xfer-type nil)
|
|
|
1888 ;; Set to one of 'ascii, 'ebcdic, 'image, 'tenex, or nil to indicate
|
|
|
1889 ;; the current setting of the transfer type for the connection. nil means
|
|
|
1890 ;; that we don't know.
|
|
|
1891 (make-variable-buffer-local 'efs-process-xfer-type)
|
|
|
1892
|
|
|
1893 (defvar efs-process-client-altered-xfer-type nil)
|
|
|
1894 ;; Sometimes clients alter the xfer type, such as doing
|
|
|
1895 ;; an ls it is changed to ascii. If we are using quoted commands
|
|
|
1896 ;; to do xfers the client doesn't get a chance to set it back.
|
|
|
1897 (make-variable-buffer-local 'efs-process-client-altered-xfer-type)
|
|
|
1898
|
|
|
1899 (defvar efs-process-prompt-regexp nil)
|
|
|
1900 ;; local value of prompt of FTP client.
|
|
|
1901 (make-variable-buffer-local 'efs-process-prompt-regexp)
|
|
|
1902
|
|
|
1903 (defvar efs-process-cmd-counter 0)
|
|
|
1904 ;; Counts FTP commands, mod 16.
|
|
|
1905 (make-variable-buffer-local 'efs-process-cmd-counter)
|
|
|
1906
|
|
|
1907 ;;;; ------------------------------------------------------------
|
|
|
1908 ;;;; General Internal Variables.
|
|
|
1909 ;;;; ------------------------------------------------------------
|
|
|
1910
|
|
|
1911 ;;; For the byte compiler
|
|
|
1912 ;;
|
|
|
1913 ;; These variables are usually unbound. We are just notifying the
|
|
|
1914 ;; byte compiler that we know what we are doing.
|
|
|
1915
|
|
|
1916 (defvar bv-length) ; getting file versions.
|
|
|
1917 (defvar default-file-name-handler-alist) ; for file-name-handler-alist
|
|
|
1918 (defvar efs-completion-dir) ; for file name completion predicates
|
|
|
1919 (defvar dired-directory) ; for default actions in interactive specs
|
|
|
1920 (defvar dired-local-variables-file) ; for inhibiting child look ups
|
|
|
1921 (defvar dired-in-query) ; don't clobber dired queries with stat messages
|
|
|
1922 (defvar after-load-alist) ; in case we're in emacs 18.
|
|
|
1923 (defvar comint-last-input-start)
|
|
|
1924 (defvar comint-last-input-end)
|
|
|
1925 (defvar explicit-shell-file-name)
|
|
|
1926
|
|
|
1927 ;;; fluid vars
|
|
|
1928
|
|
|
1929 (defvar efs-allow-child-lookup t)
|
|
|
1930 ;; let-bind to nil, if want to inhibit child lookups.
|
|
|
1931
|
|
|
1932 (defvar efs-nested-cmd nil)
|
|
|
1933 ;; let-bound to t, when a cmd is executed by a cont or pre-cont.
|
|
|
1934 ;; Such cmds will never end by looking at the next item in the queue,
|
|
|
1935 ;; if they are run synchronously, but rely on their calling function
|
|
|
1936 ;; to do this.
|
|
|
1937
|
|
|
1938 ;;; polling ftp buffers
|
|
|
1939
|
|
|
1940 (defvar efs-ftp-buffer-poll-time 300
|
|
|
1941 "Period, in seconds, which efs will poll ftp buffers for activity.
|
|
|
1942 Used for expiring \(killing\) inactive ftp buffers.")
|
|
|
1943
|
|
|
1944 (defconst efs-ftp-buffer-alist nil)
|
|
|
1945 ;; alist of ftp buffers, and the total number of seconds that they
|
|
|
1946 ;; have been idle.
|
|
|
1947
|
|
|
1948 ;;; load extensions
|
|
|
1949
|
|
|
1950 (defvar efs-load-lisp-extensions '(".elc" ".el" "")
|
|
|
1951 "List of extensions to try when loading lisp files.")
|
|
|
1952
|
|
|
1953 ;;; mode-line
|
|
|
1954
|
|
|
1955 (defvar efs-mode-line-string "")
|
|
|
1956 ;; Stores the string that efs displays on the mode line.
|
|
|
1957
|
|
|
1958 ;;; data & temporary buffers
|
|
|
1959
|
|
|
1960 (defvar efs-data-buffer-name " *ftp data*")
|
|
|
1961 ;; Buffer name to hold directory listing data received from ftp process.
|
|
|
1962
|
|
|
1963 (defvar efs-data-buffer-name-2 " *ftp data-2*")
|
|
|
1964 ;; A second buffer name in which to hold directory listings.
|
|
|
1965 ;; Used for listings which are made during another directory listing.
|
|
|
1966
|
|
|
1967 ;;; process names
|
|
|
1968
|
|
|
1969 (defvar efs-ctime-process-name-format "*efs ctime %s*")
|
|
|
1970 ;; Passed to format with second arg the host name.
|
|
|
1971
|
|
|
1972 ;;; For temporary files.
|
|
|
1973
|
|
|
1974 ;; This is a list of symbols.
|
|
|
1975 (defconst efs-tmp-name-files ())
|
|
|
1976 ;; Here is where these symbols live:
|
|
|
1977 (defconst efs-tmp-name-obarray (make-vector 7 0))
|
|
|
1978 ;; We put our version of the emacs PID here:
|
|
|
1979 (defvar efs-pid nil)
|
|
|
1980
|
|
|
1981 ;;; For abort-recursive-edit
|
|
|
1982
|
|
|
1983 (defvar efs-abort-recursive-edit-data nil)
|
|
|
1984 (defvar efs-abort-recursive-edit-delay 5)
|
|
|
1985 ;; Number of seconds after which efs-abort-recursive-edit-and-then
|
|
|
1986 ;; will decide not to runs its sentinel. The assumption is that something
|
|
|
1987 ;; went wrong.
|
|
|
1988
|
|
|
1989 ;;; hashtables (Use defconst's to clobber any user silliness.)
|
|
|
1990
|
|
|
1991 (defconst efs-files-hashtable (efs-make-hashtable 97))
|
|
|
1992 ;; Hash table for storing directories and their respective files.
|
|
|
1993
|
|
|
1994 (defconst efs-expand-dir-hashtable (efs-make-hashtable))
|
|
|
1995 ;; Hash table of tilde expansions for remote directories.
|
|
|
1996
|
|
|
1997 (defconst efs-ls-converter-hashtable (efs-make-hashtable 37))
|
|
|
1998 ;; Hashtable for storing functions to convert listings from one
|
|
|
1999 ;; format to another. Keys are the required switches, and the values
|
|
|
2000 ;; are alist of the form ((SWITCHES . CONVERTER)...) where is SWITCHES
|
|
|
2001 ;; are the listing switches for the original listing, and CONVERTER is a
|
|
|
2002 ;; function of one-variable, the listing-type, to do the conversion
|
|
|
2003 ;; on data in the current buffer. SWITCHES is either a string, or nil.
|
|
|
2004 ;; nil means that the listing can be converted from cache in
|
|
|
2005 ;; efs-files-hashtable, a string from cache in efs-ls-cache. For the latter,
|
|
|
2006 ;; listings with no switches (dumb listings), represent SWITCHES as a string
|
|
|
2007 ;; consisting only of the ASCII null character.
|
|
|
2008
|
|
|
2009 ;;; cache variables (Use defconst's to clobber any user sillines.)
|
|
|
2010
|
|
|
2011 (defconst efs-ls-cache nil
|
|
|
2012 "List of results from efs-ls.
|
|
|
2013 Each entry is a list of four elements, the file listed, the switches used
|
|
|
2014 \(nil if none\), the listing string, and whether this string has already been
|
|
|
2015 parsed.")
|
|
|
2016
|
|
|
2017 (defvar efs-ls-uncache nil)
|
|
|
2018 ;; let-bind this to t, if you want to be sure that efs-ls will replace any
|
|
|
2019 ;; cache entries.
|
|
|
2020
|
|
|
2021 ;; This is a cache to see if the user has changed
|
|
|
2022 ;; completion-ignored-extensions.
|
|
|
2023 (defconst efs-completion-ignored-extensions completion-ignored-extensions
|
|
|
2024 "This variable is internal to efs. Do not set.
|
|
|
2025 See completion-ignored-extensions, instead.")
|
|
|
2026
|
|
|
2027 ;; We cache the regexp we use for completion-ignored-extensions. This
|
|
|
2028 ;; saves building a string every time we do completion. String construction
|
|
|
2029 ;; is costly in emacs.
|
|
|
2030 (defconst efs-completion-ignored-pattern
|
|
|
2031 (mapconcat (function
|
|
|
2032 (lambda (s) (if (stringp s)
|
|
|
2033 (concat (regexp-quote s) "$")
|
|
|
2034 "/"))) ; / never in filename
|
|
|
2035 efs-completion-ignored-extensions
|
|
|
2036 "\\|")
|
|
|
2037 "This variable is internal to efs. Do not set.
|
|
|
2038 See completion-ignored-extensions, instead.")
|
|
|
2039
|
|
|
2040 (defvar efs-system-fqdn nil
|
|
|
2041 "Cached value of the local systems' fully qualified domain name.")
|
|
|
2042
|
|
|
2043 ;;; The file-type-alist
|
|
|
2044
|
|
|
2045 ;; efs-file-type-alist is an alist indexed by host-type
|
|
|
2046 ;; which stores data on how files are structured on the given
|
|
|
2047 ;; host-type. Each entry is a list of three elements. The first is the
|
|
|
2048 ;; definition of a `byte', the second the native character representation,
|
|
|
2049 ;; and the third, the file structure.
|
|
|
2050 ;;
|
|
|
2051 ;; Meanings of the symbols:
|
|
|
2052 ;; ------------------------
|
|
|
2053 ;; The byte symbols:
|
|
|
2054 ;; 8-bit = bytes of 8-bits
|
|
|
2055 ;; 36-bit-wa = 36-bit word aligned. Precisely, the addressing unit is that
|
|
|
2056 ;; of a PDP-10 using the "<440700,,0> byte pointer".
|
|
|
2057 ;;
|
|
|
2058 ;; The native character set symbols:
|
|
|
2059 ;; 8-ascii = 8-bit NVT-ASCII
|
|
|
2060 ;; 7-ascii = 7-bit ascii as on a PDP-10
|
|
|
2061 ;; ebcdic = EBCDIC as on an IBM mainframe
|
|
|
2062 ;; lispm = the native character set on a lispm (Symbolics and LMI)
|
|
|
2063 ;; mts = native character representation in the Michigan Terminal System
|
|
|
2064 ;; (which runs on IBM and Amdal mainframes), similar to ebcdic
|
|
|
2065 ;;
|
|
|
2066 ;; The file structure symbols:
|
|
|
2067 ;;
|
|
|
2068 ;; file-nl = data is stored as a contiguous sequence of data bytes
|
|
|
2069 ;; with EOL denoted by <NL>.
|
|
|
2070 ;; file-crlf = data is stored as a contiguous sequence of data bytes
|
|
|
2071 ;; with EOL denoted by <CR-LF>
|
|
|
2072 ;; record = data is stored as a sequence of records
|
|
|
2073 ;; file-lispm = data as stored on a lispm. i.e. a sequence of bits
|
|
|
2074 ;; with EOL denoted by character code 138 (?)
|
|
|
2075 ;;
|
|
|
2076 ;; If we've messed anything up here, please let us know.
|
|
|
2077
|
|
|
2078 (defvar efs-file-type-alist
|
|
|
2079 '((unix . (8-bit 8-ascii file-nl))
|
|
|
2080 (sysV-unix . (8-bit 8-ascii file-nl))
|
|
|
2081 (bsd-unix . (8-bit 8-ascii file-nl))
|
|
|
2082 (apollo-unix . (8-bit 8-ascii file-nl))
|
|
|
2083 (dumb-apollo-unix . (8-bit 8-ascii file-nl))
|
|
|
2084 (dumb-unix . (8-bit 8-ascii file-nl))
|
|
|
2085 (super-dumb-unix . (8-bit 8-ascii file-nl))
|
|
|
2086 (guardian . (8-bit ascii file-nl))
|
|
|
2087 (plan9 . (8-bit 8-ascii file-nl))
|
|
|
2088 (dos . (8-bit 8-ascii file-crlf))
|
|
|
2089 (ms-unix . (8-bit 8-ascii file-crlf))
|
|
|
2090 (netware . (8-bit 8-ascii file-crlf))
|
|
|
2091 (os2 . (8-bit 8-ascii file-crlf))
|
|
|
2092 (tops-20 . (36-bit-wa 7-ascii file-crlf))
|
|
|
2093 (mpe . (8-bit 8-ascii record))
|
|
|
2094 (mvs . (8-bit ebcdic record))
|
|
|
2095 (cms . (8-bit ebcdic record))
|
|
|
2096 (cms-knet . (8-bit ebcdic record))
|
|
|
2097 (mts . (8-bit mts record)) ; mts seems to have its own char rep.
|
|
|
2098 ; Seems to be close to ebcdic, but not the same.
|
|
|
2099 (dos-distinct . (8-bit 8-ascii file-crlf))
|
|
|
2100 (ka9q . (8-bit 8-ascii file-crlf))
|
|
|
2101 (vms . (8-bit 8-ascii record)) ; The mysteries of VMS's RMS.
|
|
|
2102 (hell . (8-bit 8-ascii file-crlf))
|
|
|
2103 (vos . (8-bit 8-ascii record))
|
|
|
2104 (ti-explorer . (8-bit lispm file-lispm)) ; lispms use a file structure, but
|
|
|
2105 ; use an out of range char to
|
|
|
2106 ; indicate EOL.
|
|
|
2107 (ti-twenex . (8-bit lispm file-lispm))
|
|
|
2108 (nos-ve . (8-bit 8-ascii record))
|
|
|
2109 (coke . (8-bit 8-ascii file-nl)) ; only support 8-bit beverages
|
|
|
2110 (nil . (8-bit 8-ascii file-nl)))) ; the local host
|
|
|
2111
|
|
|
2112 ;;; Status messages
|
|
|
2113
|
|
|
2114 (defvar efs-last-message-time -86400) ; yesterday
|
|
|
2115 ;; The time of the last efs status message. c.f. efs-message-interval
|
|
|
2116
|
|
|
2117 ;;; For handling dir listings
|
|
|
2118
|
|
|
2119 ;; This MUST match all the way to to the start of the filename.
|
|
|
2120 ;; This version corresponds to what dired now uses (sandy, 14.1.93)
|
|
|
2121 (defvar efs-month-and-time-regexp
|
|
|
2122 (concat
|
|
|
2123 " \\([0-9]+\\) +" ; file size
|
|
|
2124 "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|June?\\|July?\\|Aug\\|Sep\\|Oct"
|
|
|
2125 ; June and July are for HP-UX 9.0
|
|
|
2126 "\\|Nov\\|Dec\\) \\([ 0-3][0-9]\\)\\("
|
|
|
2127 " [012][0-9]:[0-6][0-9] \\|" ; time
|
|
|
2128 " [12][90][0-9][0-9] \\|" ; year on IRIX, NeXT, SunOS, ULTRIX, Apollo
|
|
|
2129 ; HP-UX, A/UX
|
|
|
2130 " [12][90][0-9][0-9] \\)" ; year on AIX
|
|
|
2131 ))
|
|
|
2132
|
|
|
2133 (defvar efs-month-alist
|
|
|
2134 '(("Jan" . 1) ("Feb". 2) ("Mar" . 3) ("Apr" . 4) ("May" . 5) ("Jun" . 6)
|
|
|
2135 ("June" . 6) ("Jul" . 7) ("July" . 7) ("Aug" . 8) ("Sep" . 9) ("Oct" . 10)
|
|
|
2136 ("Nov" . 11) ("Dec" . 12)))
|
|
|
2137
|
|
|
2138 ;; Matches the file modes, link number, and owner string.
|
|
|
2139 ;; The +/- is for extended file access permissions.
|
|
|
2140 (defvar efs-modes-links-owner-regexp
|
|
|
2141 (concat
|
|
|
2142 "\\([^ ][-r][-w][^ ][-r][-w][^ ][-r][-w][^ ]\\)[-+]? *\\([0-9]+\\)"
|
|
|
2143 " +\\([^ ]+\\) "))
|
|
|
2144
|
|
|
2145 ;;;; ---------------------------------------------------------------
|
|
|
2146 ;;;; efs-dired variables
|
|
|
2147 ;;;; ---------------------------------------------------------------
|
|
|
2148
|
|
|
2149 ;; These variables must be here, instead of in efs-dired.el, because
|
|
|
2150 ;; the efs-HOST-TYPE.el files need to add to it.
|
|
|
2151 (defvar efs-dired-re-exe-alist nil
|
|
|
2152 "Association list of regexps which match file lines of executable files.")
|
|
|
2153
|
|
|
2154 (defvar efs-dired-re-dir-alist nil
|
|
|
2155 "Association list of regexps which match file lines of subdirectories.")
|
|
|
2156
|
|
|
2157 (defvar efs-dired-host-type nil
|
|
|
2158 "Host type of a dired buffer. \(buffer local\)")
|
|
|
2159 (make-variable-buffer-local 'efs-dired-host-type)
|
|
|
2160
|
|
|
2161 (defvar efs-dired-listing-type nil
|
|
|
2162 "Listing type of a dired buffer. \(buffer local\)")
|
|
|
2163 (make-variable-buffer-local 'efs-dired-listing-type)
|
|
|
2164
|
|
|
2165 (defvar efs-dired-listing-type-string nil)
|
|
|
2166 (make-variable-buffer-local 'efs-dired-listing-type-string)
|
|
|
2167
|
|
|
2168 ;;;; -------------------------------------------------------------
|
|
|
2169 ;;;; New error symbols.
|
|
|
2170 ;;;; -------------------------------------------------------------
|
|
|
2171
|
|
|
2172 (put 'ftp-error 'error-conditions '(ftp-error file-error error))
|
|
|
2173 ;; (put 'ftp-error 'error-message "FTP error")
|
|
|
2174
|
|
|
2175
|
|
|
2176 ;;;; =============================================================
|
|
|
2177 ;;;; >3
|
|
|
2178 ;;;; Utilities
|
|
|
2179 ;;;; =============================================================
|
|
|
2180
|
|
|
2181 ;;; -------------------------------------------------------------------
|
|
|
2182 ;;; General Macros (Make sure that macros are defined before they're
|
|
|
2183 ;;; used, for the byte compiler.
|
|
|
2184 ;;; -------------------------------------------------------------------
|
|
|
2185
|
|
|
2186 (defmacro efs-kbd-quit-protect (proc &rest body)
|
|
|
2187 ;; When an efs function controlling an FTP connection gets a kbd-quit
|
|
|
2188 ;; this tries to make sure that everything unwinds consistently.
|
|
|
2189 (let ((temp (make-symbol "continue")))
|
|
|
2190 (list 'let
|
|
|
2191 (list '(quit-flag nil)
|
|
|
2192 '(inhibit-quit nil)
|
|
|
2193 (list temp t))
|
|
|
2194 (list
|
|
|
2195 'while temp
|
|
|
2196 (list 'setq temp nil)
|
|
|
2197 (list
|
|
|
2198 'condition-case nil
|
|
|
2199 (cons 'progn
|
|
|
2200 body)
|
|
|
2201 (list 'quit
|
|
|
2202 (list 'setq temp
|
|
|
2203 (list 'efs-kbd-quit-protect-cover-quit proc))))))))
|
|
|
2204
|
|
|
2205 (defun efs-kbd-quit-protect-cover-quit (proc)
|
|
|
2206 ;; This function exists to keep the macro expansion of the
|
|
|
2207 ;; efs-kbd-quit-protect down to a reasonable size.
|
|
|
2208 (let ((pop-up-windows t)
|
|
|
2209 (buff (get-buffer (process-buffer proc)))
|
|
|
2210 res)
|
|
|
2211 (if (save-window-excursion
|
|
|
2212 (if buff
|
|
|
2213 (progn
|
|
|
2214 (pop-to-buffer buff)
|
|
|
2215 (goto-char (point-max))
|
|
|
2216 (recenter (- (window-height)
|
|
|
2217 2))))
|
|
|
2218 (setq res (efs-kill-ftp-buffer-with-prompt proc buff)))
|
|
|
2219 (progn
|
|
|
2220 (if (eq res 0)
|
|
|
2221 (if (eq (selected-window)
|
|
|
2222 (minibuffer-window))
|
|
|
2223 (efs-abort-recursive-edit-and-then
|
|
|
2224 (function
|
|
|
2225 (lambda (buff)
|
|
|
2226 (if (get-buffer buff)
|
|
|
2227 (display-buffer buff))))
|
|
|
2228 buff)
|
|
|
2229 (if (get-buffer buff)
|
|
|
2230 (display-buffer buff))
|
|
|
2231 (signal 'quit nil))
|
|
|
2232 (if (eq (selected-window) (minibuffer-window))
|
|
|
2233 (abort-recursive-edit)
|
|
|
2234 (signal (quote quit) nil)))
|
|
|
2235 nil)
|
|
|
2236 (sit-for 0)
|
|
|
2237 (message "Waiting on %s..." (or (car (efs-parse-proc-name proc))
|
|
|
2238 "a whim"))
|
|
|
2239 t)))
|
|
|
2240
|
|
|
2241 (put 'efs-kbd-quit-protect 'lisp-indent-hook 1)
|
|
|
2242
|
|
|
2243 (defmacro efs-save-buffer-excursion (&rest forms)
|
|
|
2244 "Execute FORMS, restoring the current buffer afterwards.
|
|
|
2245 Unlike, save-excursion, this does not restore the point."
|
|
|
2246 (let ((temp (make-symbol "saved-buff")))
|
|
|
2247 (list 'let
|
|
|
2248 (list (list temp '(current-buffer)))
|
|
|
2249 (list 'unwind-protect
|
|
|
2250 (cons 'progn forms)
|
|
|
2251 (list 'condition-case nil
|
|
|
2252 (list 'set-buffer temp)
|
|
|
2253 '(error nil))))))
|
|
|
2254
|
|
|
2255 (put 'efs-save-buffer-excursion 'lisp-indent-hook 0)
|
|
|
2256
|
|
|
2257 (defmacro efs-unquote-dollars (string)
|
|
|
2258 ;; Unquote $$'s to $'s in STRING.
|
|
|
2259 (` (let ((string (, string))
|
|
|
2260 (start 0)
|
|
|
2261 new)
|
|
|
2262 (while (string-match "\\$\\$" string start)
|
|
|
2263 (setq new (concat new (substring
|
|
|
2264 string start (1+ (match-beginning 0))))
|
|
|
2265 start (match-end 0)))
|
|
|
2266 (if new
|
|
|
2267 (concat new (substring string start))
|
|
|
2268 string))))
|
|
|
2269
|
|
|
2270 (defmacro efs-get-file-part (path)
|
|
|
2271 ;; Given PATH, return the file part used for looking up the file's entry
|
|
|
2272 ;; in a hashtable.
|
|
|
2273 ;; This need not be the same thing as file-name-nondirectory.
|
|
|
2274 (` (let ((file (file-name-nondirectory (, path))))
|
|
|
2275 (if (string-equal file "")
|
|
|
2276 "."
|
|
|
2277 file))))
|
|
|
2278
|
|
|
2279 (defmacro efs-ftp-path-macro (path)
|
|
|
2280 ;; Just a macro version of efs-ftp-path, for speed critical
|
|
|
2281 ;; situations. Could use (inline ...) instead, but not everybody
|
|
|
2282 ;; uses the V19 byte-compiler. Also, doesn't call efs-save-match-data,
|
|
|
2283 ;; but assumes that the calling function does it.
|
|
|
2284 (`
|
|
|
2285 (let ((path (, path)))
|
|
|
2286 (or (string-equal path efs-ftp-path-arg)
|
|
|
2287 (setq efs-ftp-path-res
|
|
|
2288 (and (string-match efs-path-regexp path)
|
|
|
2289 (let ((host (substring path (match-beginning 2)
|
|
|
2290 (match-end 2)))
|
|
|
2291 (user (and (match-beginning 1)
|
|
|
2292 (substring path (match-beginning 1)
|
|
|
2293 (1- (match-end 1)))))
|
|
|
2294 (rpath (substring path (1+ (match-end 2)))))
|
|
|
2295 (list (if (string-equal host "")
|
|
|
2296 (setq host (system-name))
|
|
|
2297 host)
|
|
|
2298 (or user (efs-get-user host))
|
|
|
2299 rpath)))
|
|
|
2300 ;; Set this last, in case efs-get-user calls this function,
|
|
|
2301 ;; which would modify an earlier setting.
|
|
|
2302 efs-ftp-path-arg path))
|
|
|
2303 efs-ftp-path-res)))
|
|
|
2304
|
|
|
2305 (defmacro efs-canonize-switches (switches)
|
|
|
2306 ;; Converts a switches string, into a lexographically ordered string,
|
|
|
2307 ;; omitting - and spaces. Should we remove duplicate characters too?
|
|
|
2308 (` (if (, switches)
|
|
|
2309 (mapconcat
|
|
|
2310 'char-to-string
|
|
|
2311 (sort (delq ?- (delq ?\ (mapcar 'identity (, switches)))) '<) "")
|
|
|
2312 ;; For the purpose of interning in a hashtable, represent the nil
|
|
|
2313 ;; switches, as a string consisting of the ascii null character.
|
|
|
2314 (char-to-string 0))))
|
|
|
2315
|
|
|
2316 (defmacro efs-canonize-file-name (fn)
|
|
|
2317 ;; Canonizes the case of file names.
|
|
|
2318 (` (let ((parsed (efs-ftp-path (, fn))))
|
|
|
2319 (if parsed
|
|
|
2320 (let ((host (car parsed)))
|
|
|
2321 (if (memq (efs-host-type host) efs-case-insensitive-host-types)
|
|
|
2322 (downcase (, fn))
|
|
|
2323 (format efs-path-format-string (nth 1 parsed) (downcase host)
|
|
|
2324 (nth 2 parsed))))
|
|
|
2325 (, fn)))))
|
|
|
2326
|
|
|
2327 (defmacro efs-get-files-hashtable-entry (fn)
|
|
|
2328 (` (efs-get-hash-entry (efs-canonize-file-name (, fn)) efs-files-hashtable)))
|
|
|
2329
|
|
|
2330 ;;;; ------------------------------------------------------------
|
|
|
2331 ;;;; Utility Functions
|
|
|
2332 ;;;; ------------------------------------------------------------
|
|
|
2333
|
|
|
2334 (defun efs-kill-ftp-buffer-with-prompt (proc buffer)
|
|
|
2335 ;; Does a 3-way prompt to kill a ftp PROC and BUFFER.
|
|
|
2336 ;; Returns t if buffer was killed, 0 if only process, nil otherwise.
|
|
|
2337 (let ((inhibit-quit t)
|
|
|
2338 (cursor-in-echo-area t)
|
|
|
2339 char)
|
|
|
2340 (message
|
|
|
2341 (if efs-debug-ftp-connection
|
|
|
2342 "Kill ftp process and buffer (y[es], n[o], c[lose], d[ebug] ) "
|
|
|
2343 "Kill ftp process and buffer? (y or n, c to only close process) "))
|
|
|
2344 (setq char (read-char))
|
|
|
2345 (prog1
|
|
|
2346 (cond
|
|
|
2347 ((memq char '(?y ?Y ?\ ))
|
|
|
2348 (set-process-sentinel proc nil)
|
|
|
2349 (condition-case nil
|
|
|
2350 (kill-buffer buffer)
|
|
|
2351 (error nil))
|
|
|
2352 t)
|
|
|
2353 ((memq char '(?c ?C))
|
|
|
2354 (set-process-sentinel proc nil)
|
|
|
2355 (condition-case nil
|
|
|
2356 (save-excursion
|
|
|
2357 (set-buffer buffer)
|
|
|
2358 (setq efs-process-busy nil
|
|
|
2359 efs-process-q nil)
|
|
|
2360 (delete-process proc))
|
|
|
2361 (error nil))
|
|
|
2362 0)
|
|
|
2363 ((memq char '(?n ?N))
|
|
|
2364 (message "")
|
|
|
2365 nil)
|
|
|
2366 ((and efs-debug-ftp-connection
|
|
|
2367 (memq char '(?d ?D)))
|
|
|
2368 (condition-case nil
|
|
|
2369 (save-excursion
|
|
|
2370 (set-buffer buffer)
|
|
|
2371 (setq efs-process-busy nil
|
|
|
2372 efs-process-q nil))
|
|
|
2373 (error nil))
|
|
|
2374 0)
|
|
|
2375 (t
|
|
|
2376 (message
|
|
|
2377 (if efs-debug-ftp-connection
|
|
|
2378 "Type one of y, n, c or d."
|
|
|
2379 "Type one of y, n or c."))
|
|
|
2380 (ding)
|
|
|
2381 (sit-for 1)
|
|
|
2382 (setq quit-flag nil)
|
|
|
2383 (efs-kill-ftp-buffer-with-prompt proc buffer))))))
|
|
|
2384
|
|
|
2385 (defun efs-barf-if-not-directory (directory)
|
|
|
2386 ;; Signal an error if DIRECTORY is not one.
|
|
|
2387 (or (file-directory-p directory)
|
|
|
2388 (signal 'file-error
|
|
|
2389 (list "Opening directory"
|
|
|
2390 (if (file-exists-p directory)
|
|
|
2391 "not a directory"
|
|
|
2392 "no such file or directory")
|
|
|
2393 directory))))
|
|
|
2394
|
|
|
2395 (defun efs-call-cont (cont &rest args)
|
|
|
2396 "Call the function specified by CONT.
|
|
|
2397 CONT can be either a function or a list of a function and some args.
|
|
|
2398 The first parameters passed to the function will be ARGS. The remaining
|
|
|
2399 args will be taken from CONT if a list was passed."
|
|
|
2400 (if cont
|
|
|
2401 (let ((efs-nested-cmd t)) ; let-bound so that conts don't pop any queues
|
|
|
2402 (efs-save-buffer-excursion
|
|
|
2403 (if (and (listp cont)
|
|
|
2404 (not (eq (car cont) 'lambda)))
|
|
|
2405 (apply (car cont) (append args (cdr cont)))
|
|
|
2406 (apply cont args))))))
|
|
|
2407
|
|
|
2408 (defun efs-replace-path-component (fullpath path)
|
|
|
2409 "For FULLPATH matching efs-path-regexp replace the path component with PATH."
|
|
|
2410 (efs-save-match-data
|
|
|
2411 (if (string-match efs-path-root-regexp fullpath)
|
|
|
2412 (concat (substring fullpath 0 (match-end 0)) path)
|
|
|
2413 path)))
|
|
|
2414
|
|
|
2415 (defun efs-abort-recursive-edit-and-then (fun &rest args)
|
|
|
2416 ;; Does an abort-recursive-edit, and runs fun _after_ emacs returns to
|
|
|
2417 ;; top level.
|
|
|
2418 (if (get-process "efs-abort-recursive-edit")
|
|
|
2419 ;; Don't queue these things. Clean them out.
|
|
|
2420 (delete-process "efs-abort-recursive-edit"))
|
|
|
2421 (or efs-suppress-abort-recursive-edit-and-then
|
|
|
2422 (progn
|
|
|
2423 (setq efs-abort-recursive-edit-data (cons (nth 1 (current-time))
|
|
|
2424 (cons fun args)))
|
|
|
2425 (condition-case nil
|
|
|
2426 (set-process-sentinel
|
|
|
2427 (let ((default-directory exec-directory)
|
|
|
2428 (process-connection-type nil))
|
|
|
2429 (start-process "efs-abort-recursive-edit" nil "sleep" "0"))
|
|
|
2430 (function
|
|
|
2431 (lambda (proc string)
|
|
|
2432 (let ((data efs-abort-recursive-edit-data))
|
|
|
2433 (setq efs-abort-recursive-edit-data)
|
|
|
2434 (if (and data
|
|
|
2435 (integerp (car data))
|
|
|
2436 (<= (- (nth 1 (current-time)) (car data))
|
|
|
2437 efs-abort-recursive-edit-delay))
|
|
|
2438 (apply (nth 1 data) (nthcdr 2 data)))))))
|
|
|
2439 (error nil))))
|
|
|
2440 (abort-recursive-edit))
|
|
|
2441
|
|
|
2442 (defun efs-occur-in-string (char string)
|
|
|
2443 ;; Return the number of occurrences of CHAR in STRING.
|
|
|
2444 (efs-save-match-data
|
|
|
2445 (let ((regexp (regexp-quote (char-to-string char)))
|
|
|
2446 (count 0)
|
|
|
2447 (start 0))
|
|
|
2448 (while (string-match regexp string start)
|
|
|
2449 (setq start (match-end 0)
|
|
|
2450 count (1+ count)))
|
|
|
2451 count)))
|
|
|
2452
|
|
|
2453 (defun efs-parse-proc-name (proc)
|
|
|
2454 ;; Parses the name of process to return a list \(host user\).
|
|
|
2455 (efs-save-match-data
|
|
|
2456 (let ((name (process-name proc)))
|
|
|
2457 (and name
|
|
|
2458 (string-match "^\\*ftp \\([^@]*\\)@\\([^*]+\\)\\*$" name)
|
|
|
2459 (list (substring name (match-beginning 2) (match-end 2))
|
|
|
2460 (substring name (match-beginning 1) (match-end 1)))))))
|
|
|
2461
|
|
|
2462 ;;;; ------------------------------------------------------------
|
|
|
2463 ;;;; Of Geography, connectivity, and the internet... Gateways.
|
|
|
2464 ;;;; ------------------------------------------------------------
|
|
|
2465
|
|
|
2466 (defun efs-use-gateway-p (host &optional opaque-p)
|
|
|
2467 ;; Returns whether to access this host via a gateway.
|
|
|
2468 ;; Returns the gateway type as a symbol. See efs-gateway-type <V>.
|
|
|
2469 ;; If optional OPAQUE-P is non-nil, only returns non-nil if the gateway
|
|
|
2470 ;; type is in the list efs-opaque-gateways <V>.
|
|
|
2471 (and efs-gateway-type
|
|
|
2472 host ;local host is nil
|
|
|
2473 (efs-save-match-data
|
|
|
2474 (and (not (string-match efs-ftp-local-host-regexp host))
|
|
|
2475 (let ((type (car efs-gateway-type)))
|
|
|
2476 (if opaque-p
|
|
|
2477 (and (memq type efs-opaque-gateways) type)
|
|
|
2478 type))))))
|
|
|
2479
|
|
|
2480 (defun efs-local-to-gateway-filename (filename &optional reverse)
|
|
|
2481 ;; Converts a FILENAME on the local host to its name on the gateway,
|
|
|
2482 ;; using efs-gateway-mounted-dirs-alist. If REVERSE is non-nil, does just
|
|
|
2483 ;; that. If the there is no corresponding name because non of its parent
|
|
|
2484 ;; directories are mounted, returns nil.
|
|
|
2485 (if efs-gateway-mounted-dirs-alist
|
|
|
2486 (let ((len (length filename))
|
|
|
2487 (alist efs-gateway-mounted-dirs-alist)
|
|
|
2488 result elt elt-len)
|
|
|
2489 (if reverse
|
|
|
2490 (while (setq elt (car alist))
|
|
|
2491 (if (and (>= len (setq elt-len (length (cdr elt))))
|
|
|
2492 (string-equal (cdr elt) (substring filename 0 elt-len)))
|
|
|
2493 (setq result (concat (car elt)
|
|
|
2494 (substring filename elt-len))
|
|
|
2495 alist nil)
|
|
|
2496 (setq alist (cdr alist))))
|
|
|
2497 (while (setq elt (car alist))
|
|
|
2498 (if (and (>= len (setq elt-len (length (car elt))))
|
|
|
2499 (string-equal (car elt) (substring filename 0 elt-len)))
|
|
|
2500 (setq result (concat (cdr elt)
|
|
|
2501 (substring filename elt-len))
|
|
|
2502 alist nil)
|
|
|
2503 (setq alist (cdr alist)))))
|
|
|
2504 result)))
|
|
|
2505
|
|
|
2506 ;;; ------------------------------------------------------------
|
|
|
2507 ;;; Enhanced message support.
|
|
|
2508 ;;; ------------------------------------------------------------
|
|
|
2509
|
|
|
2510 (defun efs-message (fmt &rest args)
|
|
|
2511 "Output the given message, truncating to the size of the minibuffer window."
|
|
|
2512 (let ((msg (apply (function format) fmt args))
|
|
|
2513 (max (window-width (minibuffer-window))))
|
|
|
2514 (if (>= (length msg) max)
|
|
|
2515 (setq msg (concat "> " (substring msg (- 3 max)))))
|
|
|
2516 (message "%s" msg)))
|
|
|
2517
|
|
|
2518 (defun efs-message-p ()
|
|
|
2519 ;; Returns t, if efs is allowed to display a status message.
|
|
|
2520 (not
|
|
|
2521 (or (and (boundp 'dired-in-query) dired-in-query)
|
|
|
2522 (boundp 'search-message)
|
|
|
2523 cursor-in-echo-area
|
|
|
2524 (and (/= efs-message-interval 0)
|
|
|
2525 (let ((diff (- efs-last-message-time
|
|
|
2526 (setq efs-last-message-time
|
|
|
2527 (nth 1 (current-time))))))
|
|
|
2528 (and
|
|
|
2529 (> diff (- efs-message-interval))
|
|
|
2530 (< diff 0))))))) ; in case the clock wraps.
|
|
|
2531
|
|
|
2532 (efs-define-fun efs-relativize-filename (file &optional dir new)
|
|
|
2533 "Abbreviate the given filename relative to DIR .
|
|
|
2534 If DIR is nil, use the value of `default-directory' for the currently selected
|
|
|
2535 window. If the optional parameter NEW is given and the
|
|
|
2536 non-directory parts match, only return the directory part of the file."
|
|
|
2537 (let* ((dir (or dir (save-excursion
|
|
|
2538 (set-buffer (window-buffer (selected-window)))
|
|
|
2539 default-directory)))
|
|
|
2540 (dlen (length dir))
|
|
|
2541 (result file))
|
|
|
2542 (and (> (length file) dlen)
|
|
|
2543 (string-equal (substring file 0 dlen) dir)
|
|
|
2544 (setq result (substring file dlen)))
|
|
|
2545 (and new
|
|
|
2546 (string-equal (file-name-nondirectory result)
|
|
|
2547 (file-name-nondirectory new))
|
|
|
2548 (or (setq result (file-name-directory result))
|
|
|
2549 (setq result "./")))
|
|
|
2550 (abbreviate-file-name result)))
|
|
|
2551
|
|
|
2552 ;;; ------------------------------------------------------------
|
|
|
2553 ;;; Temporary file location and deletion...
|
|
|
2554 ;;; ------------------------------------------------------------
|
|
|
2555
|
|
|
2556 (defun efs-get-pid ()
|
|
|
2557 ;; Half-hearted attempt to get the current process's id.
|
|
|
2558 (setq efs-pid (substring (make-temp-name "") 1)))
|
|
|
2559
|
|
|
2560 (defun efs-make-tmp-name (host1 host2)
|
|
|
2561 ;; Returns the name of a new temp file, for moving data between HOST1
|
|
|
2562 ;; and HOST2. This temp file must be directly accessible to the
|
|
|
2563 ;; FTP client connected to HOST1. Using nil for either HOST1 or
|
|
|
2564 ;; HOST2 means the local host. The return value is actually a list
|
|
|
2565 ;; whose car is the name of the temp file wrto to the local host
|
|
|
2566 ;; and whose cdr is the name of the temp file wrto to the host
|
|
|
2567 ;; on which the client connected to HOST1 is running. If the gateway
|
|
|
2568 ;; is only accessible by FTP, then the car of this may be in efs extended
|
|
|
2569 ;; file name syntax.
|
|
|
2570 (let ((pid (or efs-pid (efs-get-pid)))
|
|
|
2571 (start ?a)
|
|
|
2572 file entry template rem-template template-len)
|
|
|
2573 ;; Compute the templates.
|
|
|
2574 (if (null (and host1 (efs-use-gateway-p host1 t)))
|
|
|
2575 ;; file must be local
|
|
|
2576 (if (null (and host2 (efs-use-gateway-p host2 t)))
|
|
|
2577 (setq template efs-tmp-name-template)
|
|
|
2578 (setq template (or (efs-local-to-gateway-filename
|
|
|
2579 efs-gateway-tmp-name-template t)
|
|
|
2580 efs-tmp-name-template)))
|
|
|
2581 ;; file must be on the gateway -- make sure that the gateway
|
|
|
2582 ;; configuration is sensible.
|
|
|
2583 (efs-save-match-data
|
|
|
2584 (or (string-match efs-ftp-local-host-regexp efs-gateway-host)
|
|
|
2585 (error "Gateway %s must be directly ftp accessible."
|
|
|
2586 efs-gateway-host)))
|
|
|
2587 (setq rem-template efs-gateway-tmp-name-template
|
|
|
2588 template (or (efs-local-to-gateway-filename
|
|
|
2589 efs-gateway-tmp-name-template t)
|
|
|
2590 (format efs-path-format-string
|
|
|
2591 (efs-get-user efs-gateway-host)
|
|
|
2592 efs-gateway-host
|
|
|
2593 efs-gateway-tmp-name-template))
|
|
|
2594 template-len (length template)))
|
|
|
2595 ;; Compute a new file name.
|
|
|
2596 (while (let (efs-verbose)
|
|
|
2597 (setq file (format "%s%c%s" template start pid)
|
|
|
2598 entry (intern file efs-tmp-name-obarray))
|
|
|
2599 (or (memq entry efs-tmp-name-files)
|
|
|
2600 (file-exists-p file)))
|
|
|
2601 (if (> (setq start (1+ start)) ?z)
|
|
|
2602 (progn
|
|
|
2603 (setq template (concat template "X"))
|
|
|
2604 (setq start ?a))))
|
|
|
2605 (setq efs-tmp-name-files
|
|
|
2606 (cons entry efs-tmp-name-files))
|
|
|
2607 (if rem-template
|
|
|
2608 (cons file (concat rem-template (substring file template-len)))
|
|
|
2609 (cons file file))))
|
|
|
2610
|
|
|
2611 (defun efs-del-tmp-name (temp)
|
|
|
2612 ;; Deletes file TEMP, a string.
|
|
|
2613 (setq efs-tmp-name-files
|
|
|
2614 (delq (intern temp efs-tmp-name-obarray)
|
|
|
2615 efs-tmp-name-files))
|
|
|
2616 (condition-case ()
|
|
|
2617 (let (efs-verbose)
|
|
|
2618 (delete-file temp))
|
|
|
2619 (error nil)))
|
|
|
2620
|
|
|
2621
|
|
|
2622 ;;;; ==============================================================
|
|
|
2623 ;;;; >4
|
|
|
2624 ;;;; Hosts, Users, Accounts, and Passwords
|
|
|
2625 ;;;; ==============================================================
|
|
|
2626 ;;;
|
|
|
2627 ;;; A lot of the support for this type of thing is in efs-netrc.el.
|
|
|
2628
|
|
|
2629 ;;;; ------------------------------------------------------------
|
|
|
2630 ;;;; Password support.
|
|
|
2631 ;;;; ------------------------------------------------------------
|
|
|
2632
|
|
|
2633 (defun efs-lookup-passwd (host user)
|
|
|
2634 ;; Look up the password for HOST and USER.
|
|
|
2635 (let ((ent (efs-get-host-user-property host user 'passwd)))
|
|
|
2636 (and ent (efs-code-string ent))))
|
|
|
2637
|
|
|
2638 (defun efs-system-fqdn ()
|
|
|
2639 "Returns a fully qualified domain name for the current host, if possible."
|
|
|
2640 (or efs-system-fqdn
|
|
|
2641 (setq efs-system-fqdn
|
|
|
2642 (let ((sys (system-name)))
|
|
|
2643 (if (string-match "\\." sys)
|
|
|
2644 sys
|
|
|
2645 (if efs-nslookup-program
|
|
|
2646 (let ((proc (let ((default-directory exec-directory)
|
|
|
2647 (process-connection-type nil))
|
|
|
2648 (start-process " *nslookup*" " *nslookup*"
|
|
|
2649 efs-nslookup-program sys)))
|
|
|
2650 (res sys)
|
|
|
2651 (n 0))
|
|
|
2652 (process-kill-without-query proc)
|
|
|
2653 (save-excursion
|
|
|
2654 (set-buffer (process-buffer proc))
|
|
|
2655 (let ((quit-flag nil)
|
|
|
2656 (inhibit-quit nil))
|
|
|
2657 (if efs-nslookup-threshold
|
|
|
2658 (progn
|
|
|
2659 (while (and (memq (process-status proc)
|
|
|
2660 '(run open))
|
|
|
2661 (< n efs-nslookup-threshold))
|
|
|
2662 (accept-process-output)
|
|
|
2663 (setq n (1+ n)))
|
|
|
2664 (if (>= n efs-nslookup-threshold)
|
|
|
2665 (progn
|
|
|
2666 (with-output-to-temp-buffer "*Help*"
|
|
|
2667 (princ (format "\
|
|
|
2668 efs is unable to determine a fully qualified domain name
|
|
|
2669 for the local host to send as an anonymous ftp password.
|
|
|
2670
|
|
|
2671 The function `system-name' is not returning a fully qualified
|
|
|
2672 domain name. An attempt to obtain a fully qualified domain name
|
|
|
2673 with `efs-nslookup-program' (currently set to \"%s\") has
|
|
|
2674 elicited no response from that program. Consider setting
|
|
|
2675 `efs-generate-anonymous-password' to an email address for anonymous
|
|
|
2676 ftp passwords.
|
|
|
2677
|
|
|
2678 For more information see the documentation (use C-h v) for the
|
|
|
2679 variables `efs-nslookup-program' and `efs-nslookup-threshold'."
|
|
|
2680 efs-nslookup-program)))
|
|
|
2681 (error "No response from %s"
|
|
|
2682 efs-nslookup-program))))
|
|
|
2683 (while (memq (process-status proc) '(run open))
|
|
|
2684 (accept-process-output proc)))
|
|
|
2685 (goto-char (point-min))
|
|
|
2686 (if (re-search-forward
|
|
|
2687 (format "^Name: *\\(%s\\.[^ \n\t]+\\)"
|
|
|
2688 sys) nil t)
|
|
|
2689 (setq res (buffer-substring
|
|
|
2690 (match-beginning 1)
|
|
|
2691 (match-end 1)))
|
|
|
2692 (kill-buffer (current-buffer)))))
|
|
|
2693 res)
|
|
|
2694 sys))))))
|
|
|
2695
|
|
|
2696 (defun efs-passwd-unique-list (alist)
|
|
|
2697 ;; Preserving the relative order of ALIST, remove all entries with duplicate
|
|
|
2698 ;; cars.
|
|
|
2699 (let (result)
|
|
|
2700 (while alist
|
|
|
2701 (or (assoc (car alist) result)
|
|
|
2702 (setq result (cons (car alist) result)))
|
|
|
2703 (setq alist (cdr alist)))
|
|
|
2704 (nreverse result)))
|
|
|
2705
|
|
|
2706 (defun efs-get-passwd-list (user host)
|
|
|
2707 ;; Returns an alist of the form '((pass host user) ...).
|
|
|
2708 ;; The order is essentially arbitrary, except that entries with user
|
|
|
2709 ;; equal to USER will appear first. Followed by entries with host equal to
|
|
|
2710 ;; HOST. Also, there will be no entries with duplicate values of pass.
|
|
|
2711 (efs-parse-netrc)
|
|
|
2712 (let* ((user-template (concat "/" user))
|
|
|
2713 (ulen (length user-template))
|
|
|
2714 (hlen (length host))
|
|
|
2715 primaries secondaries tertiaries)
|
|
|
2716 (efs-save-match-data
|
|
|
2717 (efs-map-hashtable
|
|
|
2718 (function
|
|
|
2719 (lambda (key passwd)
|
|
|
2720 (cond ((null passwd) nil)
|
|
|
2721 ((and (> (length key) ulen)
|
|
|
2722 (string-equal user-template
|
|
|
2723 (substring key (- ulen))))
|
|
|
2724 (setq primaries (cons (list (efs-code-string passwd)
|
|
|
2725 (substring key 0 (- ulen))
|
|
|
2726 (substring user-template 1))
|
|
|
2727 primaries)))
|
|
|
2728 ((and (> (length key) hlen)
|
|
|
2729 (string-equal host (substring key 0 hlen))
|
|
|
2730 (memq (aref key hlen) '(?/ ?.)))
|
|
|
2731 (if (string-match "/" key hlen)
|
|
|
2732 (setq secondaries
|
|
|
2733 (cons (list (efs-code-string passwd)
|
|
|
2734 (substring key 0 (match-beginning 0))
|
|
|
2735 (substring key (match-end 0)))
|
|
|
2736 secondaries))))
|
|
|
2737 ((string-match "/" key)
|
|
|
2738 (setq tertiaries
|
|
|
2739 (cons (list (efs-code-string passwd)
|
|
|
2740 (substring key 0 (match-beginning 0))
|
|
|
2741 (substring key (match-end 0)))
|
|
|
2742 tertiaries))))))
|
|
|
2743 efs-host-user-hashtable 'passwd))
|
|
|
2744 (efs-passwd-unique-list (nconc primaries secondaries tertiaries))))
|
|
|
2745
|
|
|
2746 (defun efs-get-passwd (host user)
|
|
|
2747 "Given a HOST and USER, return the FTP password, prompting if it was not
|
|
|
2748 previously set."
|
|
|
2749 (efs-parse-netrc)
|
|
|
2750
|
|
|
2751 ;; look up password in the hash table first; user might have overriden the
|
|
|
2752 ;; defaults.
|
|
|
2753 (cond ((efs-lookup-passwd host user))
|
|
|
2754
|
|
|
2755 ;; see if default user and password set from the .netrc file.
|
|
|
2756 ((and (stringp efs-default-user)
|
|
|
2757 efs-default-password
|
|
|
2758 (string-equal user efs-default-user))
|
|
|
2759 (copy-sequence efs-default-password))
|
|
|
2760
|
|
|
2761 ;; anonymous ftp password is handled specially since there is an
|
|
|
2762 ;; unwritten rule about how that is used on the Internet.
|
|
|
2763 ((and (efs-anonymous-p user)
|
|
|
2764 efs-generate-anonymous-password)
|
|
|
2765 (if (stringp efs-generate-anonymous-password)
|
|
|
2766 (copy-sequence efs-generate-anonymous-password)
|
|
|
2767 (concat (user-login-name) "@" (efs-system-fqdn))))
|
|
|
2768
|
|
|
2769 ;; see if same user has logged in to other hosts; if so then prompt
|
|
|
2770 ;; with the password that was used there.
|
|
|
2771 (t
|
|
|
2772 (let (others defaults passwd)
|
|
|
2773 (unwind-protect
|
|
|
2774 (progn
|
|
|
2775 (setq others (efs-get-passwd-list user host)
|
|
|
2776 defaults (mapcar
|
|
|
2777 (function
|
|
|
2778 (lambda (x)
|
|
|
2779 (cons
|
|
|
2780 (format
|
|
|
2781 "Passwd for %s@%s (same as %s@%s): "
|
|
|
2782 user host (nth 2 x) (nth 1 x))
|
|
|
2783 (car x))))
|
|
|
2784 others))
|
|
|
2785 (setq passwd
|
|
|
2786 (read-passwd
|
|
|
2787 (or defaults
|
|
|
2788 (format "Password for %s@%s: " user host)))))
|
|
|
2789 (while others
|
|
|
2790 (fillarray (car (car others)) 0)
|
|
|
2791 (setq others (cdr others))))
|
|
|
2792 (or (null passwd)
|
|
|
2793 (and efs-high-security-hosts
|
|
|
2794 (efs-save-match-data
|
|
|
2795 (string-match efs-high-security-hosts
|
|
|
2796 (format "%s@%s" user host))))
|
|
|
2797 (efs-set-passwd host user passwd))
|
|
|
2798 passwd))))
|
|
|
2799
|
|
|
2800 ;;;; ------------------------------------------------------------
|
|
|
2801 ;;;; Account support
|
|
|
2802 ;;;; ------------------------------------------------------------
|
|
|
2803
|
|
|
2804 (defun efs-get-account (host user &optional minidisk really)
|
|
|
2805 "Given a HOST, USER, and optional MINIDISK return the FTP account password.
|
|
|
2806 If the optional REALLY argument is given, prompts the user if it can't find
|
|
|
2807 one."
|
|
|
2808 (efs-parse-netrc)
|
|
|
2809 (let ((account (if minidisk
|
|
|
2810 (efs-get-hash-entry
|
|
|
2811 (concat (downcase host) "/" user "/" minidisk)
|
|
|
2812 efs-minidisk-hashtable
|
|
|
2813 (memq (efs-host-type host)
|
|
|
2814 efs-case-insensitive-host-types))
|
|
|
2815 (efs-get-host-user-property host user 'account))))
|
|
|
2816 (if account
|
|
|
2817 (efs-code-string account)
|
|
|
2818 ;; Do we really want to send the default-account passwd for all
|
|
|
2819 ;; minidisks?
|
|
|
2820 (if (and (stringp efs-default-user)
|
|
|
2821 (string-equal user efs-default-user)
|
|
|
2822 efs-default-account)
|
|
|
2823 efs-default-account
|
|
|
2824 (and really
|
|
|
2825 (let ((acct
|
|
|
2826 (read-passwd
|
|
|
2827 (if minidisk
|
|
|
2828 (format
|
|
|
2829 "Write access password for minidisk %s on %s@%s: "
|
|
|
2830 minidisk user host)
|
|
|
2831 (format
|
|
|
2832 "Account password for %s@%s: " user host)))))
|
|
|
2833 (or (and efs-high-security-hosts
|
|
|
2834 (efs-save-match-data
|
|
|
2835 efs-high-security-hosts
|
|
|
2836 (format "%s@%s" user host)))
|
|
|
2837 (efs-set-account host user minidisk acct))
|
|
|
2838 acct))))))
|
|
|
2839
|
|
|
2840 ;;;; -------------------------------------------------------------
|
|
|
2841 ;;;; Special classes of users.
|
|
|
2842 ;;;; -------------------------------------------------------------
|
|
|
2843
|
|
|
2844 (defun efs-anonymous-p (user)
|
|
|
2845 ;; Returns t if USER should be treated as an anonymous FTP login.
|
|
|
2846 (let ((user (downcase user)))
|
|
|
2847 (or (string-equal user "anonymous") (string-equal user "ftp"))))
|
|
|
2848
|
|
|
2849
|
|
|
2850 ;;;; =============================================================
|
|
|
2851 ;;;; >5
|
|
|
2852 ;;;; FTP client process, and server responses
|
|
|
2853 ;;;; =============================================================
|
|
|
2854
|
|
|
2855 ;;;; ---------------------------------------------------------
|
|
|
2856 ;;;; Support for asynch process queues.
|
|
|
2857 ;;;; ---------------------------------------------------------
|
|
|
2858
|
|
|
2859 (defun efs-add-to-queue (host user item)
|
|
|
2860 "To the end of the command queue for HOST and USER, adds ITEM.
|
|
|
2861 Does nothing if there is no process buffer for HOST and USER."
|
|
|
2862 (let ((buff (efs-ftp-process-buffer host user)))
|
|
|
2863 (if (get-buffer buff)
|
|
|
2864 (save-excursion
|
|
|
2865 (set-buffer buff)
|
|
|
2866 (setq efs-process-q
|
|
|
2867 (nconc efs-process-q (list item)))))))
|
|
|
2868
|
|
|
2869 ;;;; -------------------------------------------------------
|
|
|
2870 ;;;; Error recovery for the process filter.
|
|
|
2871 ;;;; -------------------------------------------------------
|
|
|
2872
|
|
|
2873 ;;; Could make this better, but it's such an unlikely error to hit.
|
|
|
2874 (defun efs-process-scream-and-yell (line)
|
|
|
2875 (let* ((buff (buffer-name (current-buffer)))
|
|
|
2876 (host (and (string-match "@\\(.*\\)\\*$" buff)
|
|
|
2877 (substring buff (match-beginning 1) (match-end 1)))))
|
|
|
2878 (with-output-to-temp-buffer "*Help*"
|
|
|
2879 (princ
|
|
|
2880 (concat
|
|
|
2881 "efs is unable to identify the following reply code
|
|
|
2882 from the ftp server " host ":\n\n" line "
|
|
|
2883
|
|
|
2884 Please send a bug report to ange@hplb.hpl.hp.com.
|
|
|
2885 In your report include a transcript of your\n"
|
|
|
2886 buff " buffer."))))
|
|
|
2887 (error "Unable to identify server code."))
|
|
|
2888
|
|
|
2889 (defun efs-error (host user msg)
|
|
|
2890 "Signal \'ftp-error for the FTP connection for HOST and USER.
|
|
|
2891 The error gives the string MSG as text. The process buffer for the FTP
|
|
|
2892 is popped up in another window."
|
|
|
2893 (let ((cur (selected-window))
|
|
|
2894 (pop-up-windows t)
|
|
|
2895 (buff (get-buffer (efs-ftp-process-buffer host user))))
|
|
|
2896 (if buff
|
|
|
2897 (progn
|
|
|
2898 (pop-to-buffer buff)
|
|
|
2899 (goto-char (point-max))
|
|
|
2900 (select-window cur))))
|
|
|
2901 (signal 'ftp-error (list (format "FTP Error: %s" msg))))
|
|
|
2902
|
|
|
2903 ;;;; --------------------------------------------------------------------
|
|
|
2904 ;;;; Process filter and supporting functions for handling FTP codes.
|
|
|
2905 ;;;; --------------------------------------------------------------------
|
|
|
2906
|
|
|
2907 (defun efs-process-handle-line (line proc)
|
|
|
2908 ;; Look at the given LINE from the ftp process PROC and try to catagorize it.
|
|
|
2909 (cond ((string-match efs-xfer-size-msgs line)
|
|
|
2910 (let ((n 1))
|
|
|
2911 ;; this loop will bomb with an args out of range error at 10
|
|
|
2912 (while (not (match-beginning n))
|
|
|
2913 (setq n (1+ n)))
|
|
|
2914 (setq efs-process-xfer-size
|
|
|
2915 (ash (string-to-int (substring line
|
|
|
2916 (match-beginning n)
|
|
|
2917 (match-end n)))
|
|
|
2918 -10))))
|
|
|
2919
|
|
|
2920 ((string-match efs-multi-msgs line)
|
|
|
2921 (setq efs-process-result-cont-lines
|
|
|
2922 (concat efs-process-result-cont-lines line "\n")))
|
|
|
2923
|
|
|
2924 ((string-match efs-skip-msgs line))
|
|
|
2925
|
|
|
2926 ((string-match efs-cmd-ok-msgs line)
|
|
|
2927 (if (string-match efs-cmd-ok-cmds efs-process-cmd)
|
|
|
2928 (setq efs-process-busy nil
|
|
|
2929 efs-process-result nil
|
|
|
2930 efs-process-result-line line)))
|
|
|
2931
|
|
|
2932 ((string-match efs-pending-msgs line)
|
|
|
2933 (if (string-match "^quote rnfr " efs-process-cmd)
|
|
|
2934 (setq efs-process-busy nil
|
|
|
2935 efs-process-result nil
|
|
|
2936 efs-process-result-line line)))
|
|
|
2937
|
|
|
2938 ((string-match efs-bytes-received-msgs line)
|
|
|
2939 (if efs-process-server-confused
|
|
|
2940 (setq efs-process-busy nil
|
|
|
2941 efs-process-result nil
|
|
|
2942 efs-process-result-line line)))
|
|
|
2943
|
|
|
2944 ((string-match efs-server-confused-msgs line)
|
|
|
2945 (setq efs-process-server-confused t))
|
|
|
2946
|
|
|
2947 ((string-match efs-good-msgs line)
|
|
|
2948 (setq efs-process-busy nil
|
|
|
2949 efs-process-result nil
|
|
|
2950 efs-process-result-line line))
|
|
|
2951
|
|
|
2952 ((string-match efs-fatal-msgs line)
|
|
|
2953 (set-process-sentinel proc nil)
|
|
|
2954 (delete-process proc)
|
|
|
2955 (setq efs-process-busy nil
|
|
|
2956 efs-process-result 'fatal
|
|
|
2957 efs-process-result-line line))
|
|
|
2958
|
|
|
2959 ((string-match efs-failed-msgs line)
|
|
|
2960 (setq efs-process-busy nil
|
|
|
2961 efs-process-result 'failed
|
|
|
2962 efs-process-result-line line))
|
|
|
2963
|
|
|
2964 ((string-match efs-unknown-response-msgs line)
|
|
|
2965 (setq efs-process-busy nil
|
|
|
2966 efs-process-result 'weird
|
|
|
2967 efs-process-result-line line)
|
|
|
2968 (efs-process-scream-and-yell line))))
|
|
|
2969
|
|
|
2970 (efs-define-fun efs-process-log-string (proc str)
|
|
|
2971 ;; For a given PROCESS, log the given STRING at the end of its
|
|
|
2972 ;; associated buffer.
|
|
|
2973 (let ((buff (get-buffer (process-buffer proc))))
|
|
|
2974 (if buff
|
|
|
2975 (efs-save-buffer-excursion
|
|
|
2976 (set-buffer buff)
|
|
|
2977 (comint-output-filter proc str)))))
|
|
|
2978
|
|
|
2979 (defun efs-process-filter (proc str)
|
|
|
2980 ;; Build up a complete line of output from the ftp PROCESS and pass it
|
|
|
2981 ;; on to efs-process-handle-line to deal with.
|
|
|
2982 (let ((inhibit-quit t)
|
|
|
2983 (buffer (get-buffer (process-buffer proc)))
|
|
|
2984 (efs-default-directory default-directory))
|
|
|
2985
|
|
|
2986 ;; see if the buffer is still around... it could have been deleted.
|
|
|
2987 (if buffer
|
|
|
2988 (efs-save-buffer-excursion
|
|
|
2989 (set-buffer (process-buffer proc))
|
|
|
2990 (efs-save-match-data
|
|
|
2991
|
|
|
2992 ;; handle hash mark printing
|
|
|
2993 (if efs-process-busy
|
|
|
2994 (setq str (efs-process-handle-hash str)
|
|
|
2995 efs-process-string (concat efs-process-string str)))
|
|
|
2996 (efs-process-log-string proc str)
|
|
|
2997 (while (and efs-process-busy
|
|
|
2998 (string-match "\n" efs-process-string))
|
|
|
2999 (let ((line (substring efs-process-string
|
|
|
3000 0
|
|
|
3001 (match-beginning 0))))
|
|
|
3002 (setq efs-process-string (substring
|
|
|
3003 efs-process-string
|
|
|
3004 (match-end 0)))
|
|
|
3005 ;; If we are in synch with the client, we should
|
|
|
3006 ;; never get prompts in the wrong place. Just to be safe,
|
|
|
3007 ;; chew them off.
|
|
|
3008 (while (string-match efs-process-prompt-regexp line)
|
|
|
3009 (setq line (substring line (match-end 0))))
|
|
|
3010 (efs-process-handle-line line proc)))
|
|
|
3011
|
|
|
3012 ;; has the ftp client finished? if so then do some clean-up
|
|
|
3013 ;; actions.
|
|
|
3014 (if (not efs-process-busy)
|
|
|
3015 (progn
|
|
|
3016 (efs-correct-hash-mark-size)
|
|
|
3017 ;; reset process-kill-without-query
|
|
|
3018 (process-kill-without-query proc)
|
|
|
3019 ;; issue the "done" message since we've finished.
|
|
|
3020 (if (and efs-process-msg
|
|
|
3021 (efs-message-p)
|
|
|
3022 (null efs-process-result))
|
|
|
3023 (progn
|
|
|
3024
|
|
|
3025 (efs-message "%s...done" efs-process-msg)
|
|
|
3026 (setq efs-process-msg nil)))
|
|
|
3027
|
|
|
3028 (if (and efs-process-nowait
|
|
|
3029 (null efs-process-cmd-waiting))
|
|
|
3030
|
|
|
3031 (progn
|
|
|
3032 ;; Is there a continuation we should be calling?
|
|
|
3033 ;; If so, we'd better call it, making sure we
|
|
|
3034 ;; only call it once.
|
|
|
3035 (if efs-process-continue
|
|
|
3036 (let ((cont efs-process-continue))
|
|
|
3037 (setq efs-process-continue nil)
|
|
|
3038 (efs-call-cont
|
|
|
3039 cont
|
|
|
3040 efs-process-result
|
|
|
3041 efs-process-result-line
|
|
|
3042 efs-process-result-cont-lines)))
|
|
|
3043 ;; If the cmd was run asynch, run the next
|
|
|
3044 ;; cmd from the queue. For synch cmds, this
|
|
|
3045 ;; is done by efs-send-cmd. For asynch
|
|
|
3046 ;; cmds we don't care about
|
|
|
3047 ;; efs-nested-cmd, since nothing is
|
|
|
3048 ;; waiting for the cmd to complete. If
|
|
|
3049 ;; efs-process-cmd-waiting is t, exit
|
|
|
3050 ;; to let this command run.
|
|
|
3051 (if (and efs-process-q
|
|
|
3052 ;; Be careful to check efs-process-busy
|
|
|
3053 ;; again, because the cont may have started
|
|
|
3054 ;; some new ftp action.
|
|
|
3055 ;; wheels within wheels...
|
|
|
3056 (null efs-process-busy))
|
|
|
3057 (let ((next (car efs-process-q)))
|
|
|
3058 (setq efs-process-q
|
|
|
3059 (cdr efs-process-q))
|
|
|
3060 (apply 'efs-send-cmd
|
|
|
3061 efs-process-host
|
|
|
3062 efs-process-user
|
|
|
3063 next))))
|
|
|
3064
|
|
|
3065 (if efs-process-continue
|
|
|
3066 (let ((cont efs-process-continue))
|
|
|
3067 (setq efs-process-continue nil)
|
|
|
3068 (efs-call-cont
|
|
|
3069 cont
|
|
|
3070 efs-process-result
|
|
|
3071 efs-process-result-line
|
|
|
3072 efs-process-result-cont-lines))))
|
|
|
3073
|
|
|
3074 ;; Update the mode line
|
|
|
3075 ;; We can't test nowait to see if we changed the
|
|
|
3076 ;; modeline in the first place, because conts
|
|
|
3077 ;; may be running now, which will confuse the issue.
|
|
|
3078 ;; The logic is simpler if we update the modeline
|
|
|
3079 ;; before the cont, but then the user sees the
|
|
|
3080 ;; modeline track the cont execution. It's dizzying.
|
|
|
3081 (if (and (or efs-mode-line-format
|
|
|
3082 efs-ftp-activity-function)
|
|
|
3083 (null efs-process-busy))
|
|
|
3084 (efs-update-mode-line)))))
|
|
|
3085
|
|
|
3086 ;; Trim buffer, if required.
|
|
|
3087 (and efs-max-ftp-buffer-size
|
|
|
3088 (zerop efs-process-cmd-counter)
|
|
|
3089 (> (point-max) efs-max-ftp-buffer-size)
|
|
|
3090 (= (point-min) 1) ; who knows, the user may have narrowed.
|
|
|
3091 (null (get-buffer-window (current-buffer)))
|
|
|
3092 (save-excursion
|
|
|
3093 (goto-char (/ efs-max-ftp-buffer-size 2))
|
|
|
3094 (forward-line 1)
|
|
|
3095 (delete-region (point-min) (point))))))))
|
|
|
3096
|
|
|
3097 ;;;; ------------------------------------------------------------------
|
|
|
3098 ;;;; Functions for counting hashes and reporting on bytes transferred.
|
|
|
3099 ;;;; ------------------------------------------------------------------
|
|
|
3100
|
|
|
3101 (defun efs-set-xfer-size (host user bytes)
|
|
|
3102 ;; Set the size of the next FTP transfer in bytes.
|
|
|
3103 (let ((proc (efs-get-process host user)))
|
|
|
3104 (if proc
|
|
|
3105 (let ((buf (process-buffer proc)))
|
|
|
3106 (if buf
|
|
|
3107 (save-excursion
|
|
|
3108 (set-buffer buf)
|
|
|
3109 (setq efs-process-xfer-size (ash bytes -10))))))))
|
|
|
3110
|
|
|
3111 (defun efs-guess-incoming-bin-hm-size ()
|
|
|
3112 ;; Guess at the hash mark size for incoming binary transfers by taking
|
|
|
3113 ;; the average value for such transfers to other hosts.
|
|
|
3114 (let ((total 0)
|
|
|
3115 (n 0))
|
|
|
3116 (efs-map-hashtable
|
|
|
3117 (function
|
|
|
3118 (lambda (host hm-size)
|
|
|
3119 (if hm-size (setq total (+ total hm-size)
|
|
|
3120 n (1+ n)))))
|
|
|
3121 efs-host-hashtable
|
|
|
3122 'incoming-bin-hm-size)
|
|
|
3123 (and (> n 0) (/ total n))))
|
|
|
3124
|
|
|
3125 (defun efs-set-hash-mark-unit (host user &optional incoming)
|
|
|
3126 ;; Sets the value of efs-process-hash-mark-unit according to the xfer-type.
|
|
|
3127 ;; efs-hash-mark-unit is the number of bytes represented by a hash mark,
|
|
|
3128 ;; in units of 16. If INCOMING is non-nil, the xfer will be a GET.
|
|
|
3129 (if efs-send-hash
|
|
|
3130 (let ((buff (efs-ftp-process-buffer host user))
|
|
|
3131 (gate-p (efs-use-gateway-p host t)))
|
|
|
3132 (if buff
|
|
|
3133 (save-excursion
|
|
|
3134 (set-buffer buff)
|
|
|
3135 (setq efs-process-hash-mark-unit
|
|
|
3136 (ash (or
|
|
|
3137 (and incoming (eq efs-process-xfer-type 'image)
|
|
|
3138 (or (efs-get-host-property
|
|
|
3139 host 'incoming-bin-hm-size)
|
|
|
3140 (if gate-p
|
|
|
3141 efs-gateway-incoming-binary-hm-size
|
|
|
3142 efs-incoming-binary-hm-size)
|
|
|
3143 (let ((guess
|
|
|
3144 (efs-guess-incoming-bin-hm-size)))
|
|
|
3145 (and guess
|
|
|
3146 (efs-set-host-property
|
|
|
3147 host 'incoming-bin-hm-size
|
|
|
3148 guess)))))
|
|
|
3149 (if gate-p
|
|
|
3150 efs-gateway-hash-mark-size
|
|
|
3151 efs-hash-mark-size)
|
|
|
3152 1024) ; make sure that we have some integer
|
|
|
3153 -4)))))))
|
|
|
3154
|
|
|
3155 (defun efs-correct-hash-mark-size ()
|
|
|
3156 ;; Corrects the value of efs-{ascii,binary}-hash-mark-size.
|
|
|
3157 ;; Must be run in the process buffer.
|
|
|
3158 (and efs-send-hash
|
|
|
3159 efs-process-hash-mark-unit
|
|
|
3160 (> efs-process-xfer-size 0)
|
|
|
3161 (< efs-process-xfer-size 524288) ; 2^19, prevent overflows
|
|
|
3162 (> efs-process-hash-mark-count 0)
|
|
|
3163 (or (> efs-process-last-percent 100)
|
|
|
3164 (< (ash (* efs-process-hash-mark-unit
|
|
|
3165 (1+ efs-process-hash-mark-count )) -6)
|
|
|
3166 efs-process-xfer-size))
|
|
|
3167 (let ((val (ash (/ (ash efs-process-xfer-size 6)
|
|
|
3168 efs-process-hash-mark-count) 4)))
|
|
|
3169 (if (and (eq efs-process-xfer-type 'image)
|
|
|
3170 (>= (length efs-process-cmd) 4)
|
|
|
3171 (string-equal (downcase (substring efs-process-cmd 0 4))
|
|
|
3172 "get "))
|
|
|
3173 (efs-set-host-property efs-process-host 'incoming-bin-hm-size val)
|
|
|
3174 (set (if (efs-use-gateway-p efs-process-host t)
|
|
|
3175 'efs-gateway-hash-mark-size
|
|
|
3176 'efs-hash-mark-size)
|
|
|
3177 val)))))
|
|
|
3178
|
|
|
3179 (defun efs-process-handle-hash (str)
|
|
|
3180 ;; Remove hash marks from STRING and display count so far.
|
|
|
3181 (if (string-match "^#+$" str)
|
|
|
3182 (progn
|
|
|
3183 (setq efs-process-hash-mark-count
|
|
|
3184 (+ efs-process-hash-mark-count
|
|
|
3185 (- (match-end 0) (match-beginning 0))))
|
|
|
3186 (and
|
|
|
3187 efs-process-msg
|
|
|
3188 efs-process-hash-mark-unit
|
|
|
3189 (not (and efs-process-nowait
|
|
|
3190 (or (eq efs-verbose 0)
|
|
|
3191 (eq (selected-window) (minibuffer-window)))))
|
|
|
3192 (efs-message-p)
|
|
|
3193 (let* ((big (> efs-process-hash-mark-count 65536)) ; 2^16
|
|
|
3194 (kbytes (if big
|
|
|
3195 (* efs-process-hash-mark-unit
|
|
|
3196 (ash efs-process-hash-mark-count -6))
|
|
|
3197 (ash (* efs-process-hash-mark-unit
|
|
|
3198 efs-process-hash-mark-count)
|
|
|
3199 -6))))
|
|
|
3200 (if (zerop efs-process-xfer-size)
|
|
|
3201 (or (zerop kbytes)
|
|
|
3202 (efs-message "%s...%dk" efs-process-msg kbytes))
|
|
|
3203 (let ((percent (if big
|
|
|
3204 (/ (* 100 (ash kbytes -7))
|
|
|
3205 (ash efs-process-xfer-size -7))
|
|
|
3206 (/ (* 100 kbytes) efs-process-xfer-size))))
|
|
|
3207 ;; Don't display %'s betwwen 100 and 110
|
|
|
3208 (and (> percent 100) (< percent 110) (setq percent 100))
|
|
|
3209 ;; cut out the redisplay of identical %-age messages.
|
|
|
3210 (or (eq percent efs-process-last-percent)
|
|
|
3211 (progn
|
|
|
3212 (setq efs-process-last-percent percent)
|
|
|
3213 (efs-message "%s...%d%%" efs-process-msg percent)))))))
|
|
|
3214 (concat (substring str 0 (match-beginning 0))
|
|
|
3215 (and (/= (length str) (match-end 0))
|
|
|
3216 (substring str (1+ (match-end 0))))))
|
|
|
3217 str))
|
|
|
3218
|
|
|
3219 ;;;; ------------------------------------------------------------------
|
|
|
3220 ;;;; Keeping track of the number of active background connections.
|
|
|
3221 ;;;; ------------------------------------------------------------------
|
|
|
3222
|
|
|
3223 (defun efs-ftp-processes-active ()
|
|
|
3224 ;; Return the number of FTP processes busy.
|
|
|
3225 (save-excursion
|
|
|
3226 (length
|
|
|
3227 (delq nil
|
|
|
3228 (mapcar
|
|
|
3229 (function
|
|
|
3230 (lambda (buff)
|
|
|
3231 (set-buffer buff)
|
|
|
3232 (and (boundp 'efs-process-busy)
|
|
|
3233 efs-process-busy)))
|
|
|
3234 (buffer-list))))))
|
|
|
3235
|
|
|
3236 (defun efs-update-mode-line ()
|
|
|
3237 ;; Updates the mode with FTP activity, and runs `efs-ftp-activity-function'.
|
|
|
3238 (let ((num (efs-ftp-processes-active)))
|
|
|
3239 (if efs-mode-line-format
|
|
|
3240 (progn
|
|
|
3241 (if (zerop num)
|
|
|
3242 (setq efs-mode-line-string "")
|
|
|
3243 (setq efs-mode-line-string (format efs-mode-line-format num)))
|
|
|
3244 ;; fake emacs into re-calculating all the mode lines.
|
|
|
3245 (save-excursion (set-buffer (other-buffer)))
|
|
|
3246 (set-buffer-modified-p (buffer-modified-p))))
|
|
|
3247 (if efs-ftp-activity-function
|
|
|
3248 (funcall efs-ftp-activity-function num))))
|
|
|
3249
|
|
116
|
3250 ;;;###autoload
|
|
98
|
3251 (defun efs-display-ftp-activity ()
|
|
116
|
3252 "Displays the number of active background ftp sessions in the modeline.
|
|
98
|
3253 Uses the variable `efs-mode-line-format' to determine how this will be
|
|
|
3254 displayed."
|
|
|
3255 (interactive)
|
|
|
3256 (or (memq 'efs-mode-line-string global-mode-string)
|
|
|
3257 (if global-mode-string
|
|
|
3258 (nconc global-mode-string '(efs-mode-line-string))
|
|
|
3259 (setq global-mode-string '("" efs-mode-line-string)))))
|
|
|
3260
|
|
|
3261 ;;;; -------------------------------------------------------------------
|
|
|
3262 ;;;; Expiring inactive ftp buffers.
|
|
|
3263 ;;;; -------------------------------------------------------------------
|
|
|
3264
|
|
|
3265 (defun efs-start-polling ()
|
|
|
3266 ;; Start polling FTP buffers, to look for idle ones.
|
|
|
3267 (or (null efs-expire-ftp-buffers)
|
|
|
3268 (let ((proc (get-process "efs poll")))
|
|
|
3269 (or (and proc (eq (process-status proc) 'run))))
|
|
|
3270 (let ((default-directory exec-directory)
|
|
|
3271 (process-connection-type nil)
|
|
|
3272 new-proc)
|
|
|
3273 (condition-case nil
|
|
|
3274 (delete-process "efs poll")
|
|
|
3275 (error nil))
|
|
|
3276 (setq new-proc (start-process
|
|
|
3277 "efs poll" nil
|
|
|
3278 (concat exec-directory "wakeup")
|
|
|
3279 (int-to-string efs-ftp-buffer-poll-time)))
|
|
|
3280 (set-process-filter new-proc (function efs-expire-ftp-buffers-filter))
|
|
|
3281 (process-kill-without-query new-proc))))
|
|
|
3282
|
|
|
3283 (defun efs-connection-visited-p (host user)
|
|
|
3284 ;; Returns t if there are any buffers visiting files on HOST and USER.
|
|
|
3285 (save-excursion
|
|
|
3286 (let ((list (buffer-list))
|
|
|
3287 (case-fold (memq (efs-host-type host)
|
|
|
3288 efs-case-insensitive-host-types))
|
|
|
3289 (visited nil)
|
|
|
3290 parsed)
|
|
|
3291 (setq host (downcase host))
|
|
|
3292 (if case-fold (setq user (downcase user)))
|
|
|
3293 (while list
|
|
|
3294 (set-buffer (car list))
|
|
|
3295 (if (or (and buffer-file-name
|
|
|
3296 (setq parsed (efs-ftp-path buffer-file-name))
|
|
|
3297 (string-equal host (downcase (car parsed)))
|
|
|
3298 (string-equal user (if case-fold
|
|
|
3299 (downcase (nth 1 parsed))
|
|
|
3300 (nth 1 parsed))))
|
|
|
3301 (and (boundp 'dired-directory)
|
|
|
3302 (stringp dired-directory)
|
|
|
3303 efs-dired-host-type
|
|
|
3304 (setq parsed (efs-ftp-path dired-directory))
|
|
|
3305 (string-equal host (downcase (car parsed)))
|
|
|
3306 (string-equal user (if case-fold
|
|
|
3307 (downcase (nth 1 parsed))
|
|
|
3308 (nth 1 parsed)))))
|
|
|
3309 (setq visited t
|
|
|
3310 list nil)
|
|
|
3311 (setq list (cdr list))))
|
|
|
3312 visited)))
|
|
|
3313
|
|
|
3314 (defun efs-expire-ftp-buffers-filter (proc string)
|
|
|
3315 ;; Check all ftp buffers, and kill them if they have been inactive
|
|
|
3316 ;; for the minimum of efs-ftp-buffer-expire-time and their local
|
|
|
3317 ;; time out time.
|
|
|
3318 (if efs-expire-ftp-buffers
|
|
|
3319 (let ((list (buffer-list))
|
|
|
3320 new-alist)
|
|
|
3321 (save-excursion
|
|
|
3322 (while list
|
|
|
3323 (set-buffer (car list))
|
|
|
3324 (if (eq major-mode 'efs-mode)
|
|
|
3325 (let* ((proc (get-buffer-process (current-buffer)))
|
|
|
3326 (proc-p (and proc (memq (process-status proc)
|
|
|
3327 '(run open)))))
|
|
|
3328 (if (or efs-ftp-buffer-expire-time
|
|
|
3329 efs-process-idle-time
|
|
|
3330 (null proc-p))
|
|
|
3331 (let ((elt (assq (car list) efs-ftp-buffer-alist))
|
|
|
3332 (wind-p (get-buffer-window (car list))))
|
|
|
3333 (if (or (null elt) (buffer-modified-p)
|
|
|
3334 efs-process-busy wind-p)
|
|
|
3335 (progn
|
|
|
3336 (setq new-alist (cons (cons (car list) 0)
|
|
|
3337 new-alist))
|
|
|
3338 (or wind-p (set-buffer-modified-p nil)))
|
|
|
3339 (let ((idle (+ (cdr elt)
|
|
|
3340 efs-ftp-buffer-poll-time)))
|
|
|
3341 (if (and proc-p
|
|
|
3342 (< idle
|
|
|
3343 (if efs-ftp-buffer-expire-time
|
|
|
3344 (if efs-process-idle-time
|
|
|
3345 (min efs-ftp-buffer-expire-time
|
|
|
3346 efs-process-idle-time)
|
|
|
3347 efs-ftp-buffer-expire-time)
|
|
|
3348 efs-process-idle-time)))
|
|
|
3349 (progn
|
|
|
3350 (setq new-alist (cons (cons (car list) idle)
|
|
|
3351 new-alist))
|
|
|
3352 (set-buffer-modified-p nil))
|
|
|
3353 ;; If there are still buffers for host & user,
|
|
|
3354 ;; don't wipe the cache.
|
|
|
3355 (and proc
|
|
|
3356 (efs-connection-visited-p
|
|
|
3357 efs-process-host efs-process-user)
|
|
|
3358 (set-process-sentinel proc nil))
|
|
|
3359 (kill-buffer (car list)))))))))
|
|
|
3360 (setq list (cdr list))))
|
|
|
3361 (setq efs-ftp-buffer-alist new-alist))
|
|
|
3362 (condition-case nil
|
|
|
3363 (delete-process "efs poll")
|
|
|
3364 (error nil))))
|
|
|
3365
|
|
|
3366 ;;;; -------------------------------------------------------------------
|
|
|
3367 ;;;; When the FTP client process dies...
|
|
|
3368 ;;;; -------------------------------------------------------------------
|
|
|
3369
|
|
|
3370 (defun efs-process-sentinel (proc str)
|
|
|
3371 ;; When ftp process changes state, nuke all file-entries in cache.
|
|
|
3372 (let ((buff (process-buffer proc)))
|
|
|
3373 ;; If the client dies, make sure that efs doesn't think that
|
|
|
3374 ;; there is a running process.
|
|
|
3375 (save-excursion
|
|
|
3376 (condition-case nil
|
|
|
3377 (progn
|
|
|
3378 (set-buffer buff)
|
|
|
3379 (setq efs-process-busy nil))
|
|
|
3380 (error nil)))
|
|
|
3381 (let ((parsed (efs-parse-proc-name proc)))
|
|
|
3382 (if parsed
|
|
|
3383 (progn
|
|
|
3384 (apply 'efs-wipe-file-entries parsed)
|
|
|
3385 (apply 'efs-wipe-from-ls-cache parsed))))
|
|
|
3386 (if (or efs-mode-line-format efs-ftp-activity-function)
|
|
|
3387 (efs-update-mode-line))))
|
|
|
3388
|
|
|
3389 (defun efs-kill-ftp-process (buffer)
|
|
|
3390 "Kill an FTP connection and its associated process buffer.
|
|
|
3391 If the BUFFER's visited file name or default-directory is an efs remote
|
|
|
3392 file name, it is the connection for that file name that is killed."
|
|
|
3393 (interactive "bKill FTP process associated with buffer: ")
|
|
|
3394 (or buffer (setq buffer (current-buffer)))
|
|
|
3395 (save-excursion
|
|
|
3396 (set-buffer buffer)
|
|
|
3397 (if (eq major-mode 'efs-mode)
|
|
|
3398 (kill-buffer buffer)
|
|
|
3399 (let ((file (or (buffer-file-name) default-directory)))
|
|
|
3400 (if file
|
|
|
3401 (let ((parsed (efs-ftp-path (expand-file-name file))))
|
|
|
3402 (if parsed
|
|
|
3403 (let ((host (nth 0 parsed))
|
|
|
3404 (user (nth 1 parsed)))
|
|
|
3405 (kill-buffer
|
|
|
3406 (efs-ftp-process-buffer host user))))))))))
|
|
|
3407
|
|
|
3408 (defun efs-close-ftp-process (buffer)
|
|
|
3409 "Close an FTP connection.
|
|
|
3410 This kills the FTP client process, but unlike `efs-kill-ftp-process' this
|
|
|
3411 neither kills the process buffer, nor deletes cached data for the connection."
|
|
|
3412 (interactive "bClose FTP process associated with buffer: ")
|
|
|
3413 (or buffer (setq buffer (current-buffer)))
|
|
|
3414 (save-excursion
|
|
|
3415 (set-buffer buffer)
|
|
|
3416 (if (eq major-mode 'efs-mode)
|
|
|
3417 (let ((process (get-buffer-process buffer)))
|
|
|
3418 (if process
|
|
|
3419 (progn
|
|
|
3420 (set-process-sentinel process nil)
|
|
|
3421 (setq efs-process-busy nil
|
|
|
3422 efs-process-q nil)
|
|
|
3423 (if (or efs-mode-line-format efs-ftp-activity-function)
|
|
|
3424 (efs-update-mode-line))
|
|
|
3425 (delete-process process))))
|
|
|
3426 (let ((file (or (buffer-file-name) default-directory)))
|
|
|
3427 (if file
|
|
|
3428 (let ((parsed (efs-ftp-path (expand-file-name file))))
|
|
|
3429 (if parsed
|
|
|
3430 (let ((process (get-process
|
|
|
3431 (format "*ftp %s@%s*"
|
|
|
3432 (nth 1 parsed) (car parsed)))))
|
|
|
3433 (if process
|
|
|
3434 (progn
|
|
|
3435 (set-buffer (process-buffer process))
|
|
|
3436 (set-process-sentinel process nil)
|
|
|
3437 (setq efs-process-busy nil
|
|
|
3438 efs-process-q nil)
|
|
|
3439 (if (or efs-mode-line-format
|
|
|
3440 efs-ftp-activity-function)
|
|
|
3441 (efs-update-mode-line))
|
|
|
3442 (delete-process process)))))))))))
|
|
|
3443
|
|
|
3444 (defun efs-ping-ftp-connection (buffer)
|
|
|
3445 "Ping a connection by sending a NOOP command.
|
|
|
3446 Useful for waking up a possible expired connection."
|
|
|
3447 (interactive "bPing FTP connection associated with buffer: ")
|
|
|
3448 (or buffer (setq buffer (current-buffer)))
|
|
|
3449 (efs-save-buffer-excursion
|
|
|
3450 (set-buffer buffer)
|
|
|
3451 (let (file host user parsed)
|
|
|
3452 (if (or (and (eq major-mode 'efs-mode)
|
|
|
3453 (setq host efs-process-host
|
|
|
3454 user efs-process-user))
|
|
|
3455 (and (setq file (or (buffer-file-name) default-directory))
|
|
|
3456 (setq parsed (efs-ftp-path file))
|
|
|
3457 (setq host (car parsed)
|
|
|
3458 user (nth 1 parsed))))
|
|
|
3459 (or (car
|
|
|
3460 (efs-send-cmd
|
|
|
3461 host user '(quote noop)
|
|
|
3462 (format "Pinging connection %s@%s" user host)))
|
|
|
3463 (message "Connection %s@%s is alive." user host))))))
|
|
|
3464
|
|
|
3465 (defun efs-display-ftp-process-buffer (buffer)
|
|
|
3466 "Displays the FTP process buffer associated with the current buffer."
|
|
|
3467 (interactive "bDisplay FTP buffer associated with buffer: ")
|
|
|
3468 (if (null buffer) (setq buffer (current-buffer)))
|
|
|
3469 (let ((file (or (buffer-file-name) default-directory))
|
|
|
3470 parsed proc-buffer)
|
|
|
3471 (if (and file (setq parsed (efs-ftp-path file))
|
|
|
3472 (setq proc-buffer (get-buffer (efs-ftp-process-buffer
|
|
|
3473 (car parsed)
|
|
|
3474 (nth 1 parsed)))))
|
|
|
3475 (display-buffer proc-buffer)
|
|
|
3476 (error "Buffer %s not associated with an FTP process" buffer))))
|
|
|
3477
|
|
|
3478 ;;;; -------------------------------------------------------------------
|
|
|
3479 ;;;; Starting the FTP client process
|
|
|
3480 ;;;; -------------------------------------------------------------------
|
|
|
3481
|
|
|
3482 (defun efs-ftp-process-buffer (host user)
|
|
|
3483 "Return name of the process buffer for ftp process for HOST and USER."
|
|
|
3484 ;; Host names on the internet are case-insensitive.
|
|
|
3485 (format efs-ftp-buffer-format user (downcase host)))
|
|
|
3486
|
|
|
3487 (defun efs-pty-check (proc threshold)
|
|
|
3488 ;; Checks to see if PROC is a pty. Beware, it clobbers the process
|
|
|
3489 ;; filter, so run this before you set the filter.
|
|
|
3490 ;; THRESHOLD is an integer to tell it how long to wait for output.
|
|
|
3491 (sit-for 0) ; Update the display before doing any waiting.
|
|
|
3492 (let ((efs-pipe-p t)
|
|
|
3493 (n 0))
|
|
|
3494 (set-process-filter proc (function (lambda (proc string)
|
|
|
3495 (setq efs-pipe-p nil))))
|
|
|
3496 (while (and (< n threshold) efs-pipe-p)
|
|
|
3497 (accept-process-output)
|
|
|
3498 (setq n (1+ n)))
|
|
|
3499 (if efs-pipe-p
|
|
|
3500 (progn
|
|
|
3501 (sit-for 0) ; update display
|
|
|
3502 ;; Use a sleep-for as I don't want pty-checking to depend
|
|
|
3503 ;; on pending input.
|
|
|
3504 (sleep-for efs-pty-check-retry-time)))
|
|
|
3505 (accept-process-output)
|
|
|
3506 (if efs-pipe-p
|
|
|
3507 (if (or noninteractive
|
|
|
3508 (progn
|
|
|
3509 ;; in case the user typed something during the wait.
|
|
|
3510 (discard-input)
|
|
|
3511 (y-or-n-p
|
|
|
3512 (format "%s seems not a pty. Kill? " proc))))
|
|
|
3513 (progn
|
|
|
3514 (kill-buffer (process-buffer proc))
|
|
|
3515 (if (eq (selected-window) (minibuffer-window))
|
|
|
3516 (abort-recursive-edit)
|
|
|
3517 (signal 'quit nil))))
|
|
|
3518 ;; Need to send a \n to make sure, because sometimes we get the startup
|
|
|
3519 ;; prompt from a pipe.
|
|
|
3520 (sit-for 0)
|
|
|
3521 (process-send-string proc "\n")
|
|
|
3522 (setq efs-pipe-p t
|
|
|
3523 n 0)
|
|
|
3524 (while (and (< n threshold) efs-pipe-p)
|
|
|
3525 (accept-process-output)
|
|
|
3526 (setq n (1+ n)))
|
|
|
3527 (if efs-pipe-p
|
|
|
3528 (progn
|
|
|
3529 (sit-for 0)
|
|
|
3530 (sleep-for efs-pty-check-retry-time)))
|
|
|
3531 (accept-process-output)
|
|
|
3532 (if (and efs-pipe-p
|
|
|
3533 (or noninteractive
|
|
|
3534 (progn
|
|
|
3535 ;; in case the user typed something during the wait.
|
|
|
3536 (discard-input)
|
|
|
3537 (y-or-n-p
|
|
|
3538 (format "%s seems not a pty. Kill? " proc)))))
|
|
|
3539 (progn
|
|
|
3540 (kill-buffer (process-buffer proc))
|
|
|
3541 (if (eq (selected-window) (minibuffer-window))
|
|
|
3542 (abort-recursive-edit)
|
|
|
3543 (signal 'quit nil)))))))
|
|
|
3544
|
|
|
3545 (defun efs-start-process (host user name)
|
|
|
3546 "Spawn a new ftp process ready to connect to machine HOST as USER.
|
|
|
3547 If HOST is only ftp-able through a gateway machine then spawn a shell
|
|
|
3548 on the gateway machine to do the ftp instead. NAME is the name of the
|
|
|
3549 process."
|
|
|
3550 (let* ((use-gateway (efs-use-gateway-p host))
|
|
|
3551 (buffer (get-buffer-create (efs-ftp-process-buffer host user)))
|
|
|
3552 (process-connection-type t)
|
|
|
3553 (opaque-p (memq use-gateway efs-opaque-gateways))
|
|
|
3554 proc)
|
|
|
3555 (save-excursion
|
|
|
3556 (set-buffer buffer)
|
|
|
3557 (efs-mode host user (if opaque-p
|
|
|
3558 efs-gateway-ftp-prompt-regexp
|
|
|
3559 efs-ftp-prompt-regexp)))
|
|
|
3560 (cond
|
|
|
3561 ((null use-gateway)
|
|
|
3562 (message "Opening FTP connection to %s..." host)
|
|
|
3563 (setq proc (apply 'start-process name buffer efs-ftp-program-name
|
|
|
3564 efs-ftp-program-args)))
|
|
|
3565 ((eq use-gateway 'interactive)
|
|
|
3566 (setq proc (efs-gwp-start host user name)))
|
|
|
3567 ((eq use-gateway 'remsh)
|
|
|
3568 (message "Opening FTP connection to %s via %s..." host efs-gateway-host)
|
|
|
3569 (setq proc (apply 'start-process name buffer (nth 1 efs-gateway-type)
|
|
|
3570 (append (list efs-gateway-host)
|
|
|
3571 (nth 2 efs-gateway-type)
|
|
|
3572 (list (nth 3 efs-gateway-type))
|
|
|
3573 (nth 4 efs-gateway-type)))))
|
|
|
3574 ((memq use-gateway '(proxy raptor interlock kerberos))
|
|
|
3575 (message "Opening FTP connection to %s via %s..." host efs-gateway-host)
|
|
|
3576 (setq proc (apply 'start-process name buffer (nth 1 efs-gateway-type)
|
|
|
3577 (nth 2 efs-gateway-type))))
|
|
|
3578 ((eq use-gateway 'local)
|
|
|
3579 (message "Opening FTP connection to %s..." host)
|
|
|
3580 (setq proc (apply 'start-process name buffer (nth 1 efs-gateway-type)
|
|
|
3581 (nth 2 efs-gateway-type))))
|
|
|
3582 ((error "Never heard of gateway type %s" use-gateway)))
|
|
|
3583 (process-kill-without-query proc)
|
|
|
3584 (if opaque-p
|
|
|
3585 (accept-process-output proc)
|
|
|
3586 (if efs-pty-check-threshold
|
|
|
3587 (efs-pty-check proc efs-pty-check-threshold)
|
|
|
3588 (accept-process-output proc)))
|
|
|
3589 (set-process-sentinel proc (function efs-process-sentinel))
|
|
|
3590 (set-process-filter proc (function efs-process-filter))
|
|
|
3591 (efs-start-polling)
|
|
|
3592 (save-excursion
|
|
|
3593 (set-buffer buffer)
|
|
|
3594 (goto-char (point-max))
|
|
|
3595 (set-marker (process-mark proc) (point)))
|
|
|
3596 proc))
|
|
|
3597
|
|
|
3598 (defun efs-get-process-internal (host user)
|
|
|
3599 ;; Get's the first process for HOST and USER. If HOST runs a
|
|
|
3600 ;; a case insignificant OS, then case is not considered in USER.
|
|
|
3601 (let ((list (process-list))
|
|
|
3602 (case-fold (memq (efs-host-type host)
|
|
|
3603 efs-case-insensitive-host-types))
|
|
|
3604 (len (+ (length host) (length user) 7))
|
|
|
3605 fmt name found)
|
|
|
3606 (setq host (downcase host))
|
|
|
3607 (if case-fold (setq user (downcase user)))
|
|
|
3608 (while (and (not found) list)
|
|
|
3609 (setq name (process-name (car list)))
|
|
|
3610 (if (and (= (length name) len)
|
|
|
3611 (string-equal (substring name 0 5) "*ftp ")
|
|
|
3612 (string-equal
|
|
|
3613 (if case-fold (downcase (substring name 5)) (substring name 5))
|
|
|
3614 (or fmt (setq fmt (format "%s@%s*" user host))))
|
|
|
3615 (memq (process-status (car list)) '(run open)))
|
|
|
3616 (setq found (car list))
|
|
|
3617 (setq list (cdr list))))
|
|
|
3618 found))
|
|
|
3619
|
|
|
3620 ;; efs-guess-host-type calls this
|
|
|
3621 ;; function recursively. The (if (and proc... avoids an infinite
|
|
|
3622 ;; loop. We should make sure that this won't hang things if the
|
|
|
3623 ;; connection goes wrong.
|
|
|
3624
|
|
|
3625 (defun efs-get-process (host user)
|
|
|
3626 "Return the process object for the FTP process for HOST and USER.
|
|
|
3627 Create a new process if needed."
|
|
|
3628
|
|
|
3629 (let ((proc (efs-get-process-internal host user)))
|
|
|
3630 (if (and proc (memq (process-status proc) '(run open)))
|
|
|
3631 proc
|
|
|
3632
|
|
|
3633 ;; Make sure that the process isn't around in some strange state.
|
|
|
3634
|
|
|
3635 (setq host (downcase host))
|
|
|
3636 (let ((name (concat "*ftp " user "@" host "*")))
|
|
|
3637 (if proc (condition-case nil (delete-process proc) (error nil)))
|
|
|
3638
|
|
|
3639 ;; grab a suitable process.
|
|
|
3640 (setq proc (efs-start-process host user name))
|
|
|
3641
|
|
|
3642 (efs-save-match-data
|
|
|
3643 (efs-save-buffer-excursion
|
|
|
3644 (set-buffer (process-buffer proc))
|
|
|
3645
|
|
|
3646 ;; Run any user-specified hooks.
|
|
|
3647 (run-hooks 'efs-ftp-startup-hook)
|
|
|
3648
|
|
|
3649 ;; login to FTP server.
|
|
|
3650 (efs-login host user proc)
|
|
|
3651
|
|
|
3652 ;; Beware, the process may have died if the login went bad.
|
|
|
3653 (if (memq (process-status proc) '(run open))
|
|
|
3654
|
|
|
3655 (progn
|
|
|
3656 ;; Tell client to send back hash-marks as progress. It isn't
|
|
|
3657 ;; usually fatal if this command fails.
|
|
|
3658 (efs-guess-hash-mark-size proc)
|
|
|
3659
|
|
|
3660 ;; Run any user startup functions
|
|
|
3661 (let ((alist efs-ftp-startup-function-alist)
|
|
|
3662 (case-fold-search t))
|
|
|
3663 (while alist
|
|
|
3664 (if (string-match (car (car alist)) host)
|
|
|
3665 (progn
|
|
|
3666 (funcall (cdr (car alist)) host user)
|
|
|
3667 (setq alist nil))
|
|
|
3668 (setq alist (cdr alist)))))
|
|
|
3669
|
|
|
3670 ;; Guess at the host type.
|
|
|
3671 (efs-guess-host-type host user)
|
|
|
3672
|
|
|
3673 ;; Check the idle time.
|
|
|
3674 (efs-check-idle host user)
|
|
|
3675
|
|
|
3676 proc)
|
|
|
3677
|
|
|
3678 ;; Hopefully a recursive retry worked.
|
|
|
3679 (or (efs-get-process-internal host user)
|
|
|
3680 (error "No FTP process for %s@%s" user host)))))))))
|
|
|
3681
|
|
|
3682 (defun efs-guess-hash-mark-size (proc)
|
|
|
3683 ;; Doesn't run efs-save-match-data. You must do that yourself.
|
|
|
3684 (if efs-send-hash
|
|
|
3685 (save-excursion
|
|
|
3686 (set-buffer (process-buffer proc))
|
|
|
3687 (let ((line (nth 1 (efs-raw-send-cmd proc "hash")))
|
|
|
3688 (gate-p (efs-use-gateway-p efs-process-host t)))
|
|
|
3689 ;; Don't guess if the hash-mark-size is already set.
|
|
|
3690 (or (if gate-p efs-gateway-hash-mark-size efs-hash-mark-size)
|
|
|
3691 (if (string-match efs-hash-mark-msgs line)
|
|
|
3692 (let ((size (substring line (match-beginning 1)
|
|
|
3693 (match-end 1))))
|
|
|
3694 (if (string-match "^[0-9]+$" size)
|
|
|
3695 (set (if gate-p
|
|
|
3696 'efs-gateway-hash-mark-size
|
|
|
3697 'efs-hash-mark-size)
|
|
|
3698 (string-to-int size))))))))))
|
|
|
3699
|
|
|
3700 ;;;; ------------------------------------------------------------
|
|
|
3701 ;;;; Simple FTP process shell support.
|
|
|
3702 ;;;; ------------------------------------------------------------
|
|
|
3703
|
|
|
3704 (defun efs-mode (host user prompt)
|
|
|
3705 "Major mode for interacting with an FTP process.
|
|
|
3706 The user interface for sending commands to the FTP process is `comint-mode'.
|
|
|
3707 For more information see the documentation for `comint-mode'. This command
|
|
|
3708 is not intended for interactive use.
|
|
|
3709 Takes arguments: HOST USER PROMPT
|
|
|
3710
|
|
|
3711 Runs efs-mode-hook if it is not nil.
|
|
|
3712
|
|
|
3713 Key map:
|
|
|
3714 \\{comint-mode-map}"
|
|
|
3715 (let ((proc (get-buffer-process (current-buffer))))
|
|
|
3716 ;; Running comint-mode will kill-all-local-variables.
|
|
|
3717 (comint-mode)
|
|
|
3718 ;; All these variables are buffer local.
|
|
|
3719 (setq major-mode 'efs-mode
|
|
|
3720 mode-name "efs"
|
|
|
3721 default-directory (file-name-directory efs-tmp-name-template)
|
|
|
3722 comint-prompt-regexp prompt
|
|
|
3723 efs-process-host host
|
|
|
3724 efs-process-user user
|
|
|
3725 efs-process-prompt-regexp prompt)
|
|
|
3726 (set (make-local-variable 'paragraph-start) comint-prompt-regexp)
|
|
|
3727 ;; Old versions of comint don't have this. It does no harm for
|
|
|
3728 ;; the newer ones.
|
|
|
3729 (set (make-local-variable 'comint-last-input-start) (make-marker))
|
|
|
3730 (goto-char (point-max))
|
|
|
3731 ;; in case there is a running process
|
|
|
3732 (if proc (set-marker (process-mark proc) (point)))
|
|
|
3733 (run-hooks 'efs-mode-hook)))
|
|
|
3734
|
|
|
3735
|
|
|
3736 ;;;; =============================================================
|
|
|
3737 ;;;; >6
|
|
|
3738 ;;;; Sending commands to the FTP server.
|
|
|
3739 ;;;; =============================================================
|
|
|
3740
|
|
|
3741 ;;;; -------------------------------------------------------------
|
|
|
3742 ;;;; General purpose functions for sending commands.
|
|
|
3743 ;;;; -------------------------------------------------------------
|
|
|
3744
|
|
|
3745 (defun efs-raw-send-cmd (proc cmd &optional msg pre-cont cont nowait)
|
|
|
3746 ;; Low-level routine to send the given ftp CMD to the ftp PROCESS.
|
|
|
3747 ;; MSG is an optional message to output before and after the command.
|
|
|
3748 ;; If PRE-CONT is non-nil, it is called immediately after execution
|
|
|
3749 ;; of the command starts, but without waiting for it to finish.
|
|
|
3750 ;; If CONT is non-NIL then it is either a function or a list of function and
|
|
|
3751 ;; some arguments. The function will be called when the ftp command has
|
|
|
3752 ;; completed.
|
|
|
3753 ;; If CONT is NIL then this routine will return \( RESULT . LINE \) where
|
|
|
3754 ;; RESULT is whether the command was successful, and LINE is the line from
|
|
|
3755 ;; the FTP process that caused the command to complete.
|
|
|
3756 ;; If NOWAIT is nil then we will wait for the command to complete before
|
|
|
3757 ;; returning. If NOWAIT is 0, then we will wait until the command starts,
|
|
|
3758 ;; executing before returning. NOWAIT of 1 is like 0, except that the modeline
|
|
|
3759 ;; will indicate an asynch FTP command.
|
|
|
3760 ;; If NOWAIT has any other value, then we will simply queue the
|
|
|
3761 ;; command. In all cases, CONT will still be called
|
|
|
3762
|
|
|
3763 (if (memq (process-status proc) '(run open))
|
|
|
3764 (efs-save-buffer-excursion
|
|
|
3765 (set-buffer (process-buffer proc))
|
|
|
3766
|
|
|
3767 (if efs-process-busy
|
|
|
3768 ;; This function will always wait on a busy process.
|
|
|
3769 ;; Queueing is done by efs-send-cmd.
|
|
|
3770 (let ((efs-process-cmd-waiting t))
|
|
|
3771 (efs-kbd-quit-protect proc
|
|
|
3772 (while efs-process-busy
|
|
|
3773 (accept-process-output)))))
|
|
|
3774
|
|
|
3775 (setq efs-process-string ""
|
|
|
3776 efs-process-result-line ""
|
|
|
3777 efs-process-result-cont-lines ""
|
|
|
3778 efs-process-busy t
|
|
|
3779 efs-process-msg (and efs-verbose msg)
|
|
|
3780 efs-process-continue cont
|
|
|
3781 efs-process-server-confused nil
|
|
|
3782 efs-process-nowait nowait
|
|
|
3783 efs-process-hash-mark-count 0
|
|
|
3784 efs-process-last-percent -1
|
|
|
3785 efs-process-xfer-size 0
|
|
|
3786 efs-process-cmd-counter (% (1+ efs-process-cmd-counter) 16))
|
|
|
3787 (process-kill-without-query proc t)
|
|
|
3788 (and efs-process-msg
|
|
|
3789 (efs-message-p)
|
|
|
3790 (efs-message "%s..." efs-process-msg))
|
|
|
3791 (goto-char (point-max))
|
|
|
3792 (move-marker comint-last-input-start (point))
|
|
|
3793 (move-marker comint-last-input-end (point))
|
|
|
3794 ;; don't insert the password into the buffer on the USER command.
|
|
|
3795 (efs-save-match-data
|
|
|
3796 (if (string-match efs-passwd-cmds cmd)
|
|
|
3797 (insert (setq efs-process-cmd
|
|
|
3798 (substring cmd 0 (match-end 0)))
|
|
|
3799 " Turtle Power!\n")
|
|
|
3800 (setq efs-process-cmd cmd)
|
|
|
3801 (insert cmd "\n")))
|
|
|
3802 (process-send-string proc (concat cmd "\n"))
|
|
|
3803 (set-marker (process-mark proc) (point))
|
|
|
3804 ;; Update the mode-line
|
|
|
3805 (if (and (or efs-mode-line-format efs-ftp-activity-function)
|
|
|
3806 (memq nowait '(t 1)))
|
|
|
3807 (efs-update-mode-line))
|
|
|
3808 (if pre-cont
|
|
|
3809 (let ((efs-nested-cmd t))
|
|
|
3810 (save-excursion
|
|
|
3811 (apply (car pre-cont) (cdr pre-cont)))))
|
|
|
3812 (prog1
|
|
|
3813 (if nowait
|
|
|
3814 nil
|
|
|
3815 ;; hang around for command to complete
|
|
|
3816 ;; Some clients die after the command is sent, if the server
|
|
|
3817 ;; times out. Don't wait on dead processes.
|
|
|
3818 (efs-kbd-quit-protect proc
|
|
|
3819 (while (and efs-process-busy
|
|
|
3820 ;; Need to recheck nowait, since it may get reset
|
|
|
3821 ;; in a cont.
|
|
|
3822 (null efs-process-nowait)
|
|
|
3823 (memq (process-status proc) '(run open)))
|
|
|
3824 (accept-process-output proc)))
|
|
|
3825
|
|
|
3826 ;; cont is called by the process filter
|
|
|
3827 (if cont
|
|
|
3828 ;; Return nil if a cont was called.
|
|
|
3829 ;; Can't return process-result
|
|
|
3830 ;; and process-line since executing
|
|
|
3831 ;; the cont may have changed
|
|
|
3832 ;; the state of the process buffer.
|
|
|
3833 nil
|
|
|
3834 (list efs-process-result
|
|
|
3835 efs-process-result-line
|
|
|
3836 efs-process-result-cont-lines)))
|
|
|
3837
|
|
|
3838 ;; If the process died, the filter would have never got the chance
|
|
|
3839 ;; to call the cont. Try to jump start things.
|
|
|
3840
|
|
|
3841 (if (and (not (memq (process-status proc) '(run open)))
|
|
|
3842 (string-equal efs-process-result-line "")
|
|
|
3843 cont
|
|
|
3844 (equal cont efs-process-continue))
|
|
|
3845 (progn
|
|
|
3846 (setq efs-process-continue nil
|
|
|
3847 efs-process-busy nil)
|
|
|
3848 ;; The process may be in some strange state. Get rid of it.
|
|
|
3849 (condition-case nil (delete-process proc) (error nil))
|
|
|
3850 (efs-call-cont cont 'fatal "" "")))))
|
|
|
3851
|
|
|
3852 (error "FTP process %s has died." (process-name proc))))
|
|
|
3853
|
|
|
3854 (efs-defun efs-quote-string nil (string &optional not-space)
|
|
|
3855 "Quote any characters in STRING that may confuse the ftp process.
|
|
|
3856 If NOT-SPACE is non-nil, then blank characters are not quoted, because
|
|
|
3857 it is assumed that the string will be surrounded by \"'s."
|
|
|
3858 (apply (function concat)
|
|
|
3859 (mapcar (function
|
|
|
3860 (lambda (char)
|
|
|
3861 (if (or (< char ?\ )
|
|
|
3862 (and (null not-space) (= char ?\ ))
|
|
|
3863 (> char ?\~)
|
|
|
3864 (= char ?\")
|
|
|
3865 (= char ?\\))
|
|
|
3866 (vector ?\\ char)
|
|
|
3867 (vector char))))
|
|
|
3868 string)))
|
|
|
3869
|
|
|
3870 (efs-defun efs-fix-path nil (path &optional reverse)
|
|
|
3871 "Convert PATH from a unix format to a non-unix format.
|
|
|
3872 If optional REVERSE, convert in the opposite direction."
|
|
|
3873 (identity path))
|
|
|
3874
|
|
|
3875 (efs-defun efs-fix-dir-path nil (dir-path)
|
|
|
3876 "Convert DIR-PATH from unix format to a non-unix format for a dir listing"
|
|
|
3877 ;; The default def runs for dos-distinct, ka9q, and all the unix's.
|
|
|
3878 ;; To be more careful about distinguishing dirs from plain files,
|
|
|
3879 ;; we append a ".".
|
|
|
3880 (let ((len (length dir-path)))
|
|
|
3881 (if (and (not (zerop len)) (= (aref dir-path (1- len)) ?/))
|
|
|
3882 (concat dir-path ".")
|
|
|
3883 dir-path)))
|
|
|
3884
|
|
|
3885 (defun efs-send-cmd (host user cmd
|
|
|
3886 &optional msg pre-cont cont nowait noretry)
|
|
|
3887 "Find an ftp process connected to HOST logged in as USER and send it CMD.
|
|
|
3888 MSG is an optional status message to be output before and after issuing the
|
|
|
3889 command.
|
|
|
3890
|
|
|
3891 See the documentation for efs-raw-send-cmd for a description of CONT, PRE-CONT
|
|
|
3892 and NOWAIT. Normally, if the command fails it is retried. If NORETRY is
|
|
|
3893 non-nil, this is not done."
|
|
|
3894 ;; Handles conversion to remote pathname syntax and remote ls option
|
|
|
3895 ;; capability. Also, sends umask if nec.
|
|
|
3896
|
|
|
3897 (let ((proc (efs-get-process host user)))
|
|
|
3898
|
|
|
3899 (if (and
|
|
|
3900 (eq nowait t)
|
|
|
3901 (save-excursion
|
|
|
3902 (set-buffer (process-buffer proc))
|
|
|
3903 (or efs-process-busy
|
|
|
3904 efs-process-cmd-waiting)))
|
|
|
3905
|
|
|
3906 (progn
|
|
|
3907 (efs-add-to-queue
|
|
|
3908 host user
|
|
|
3909 ;; Not nec. to store host and user, because the queue is for
|
|
|
3910 ;; a specific host user pair anyway. Because the queue is always
|
|
|
3911 ;; examined when efs-process-busy
|
|
|
3912 ;; is nil, it should be impossible to get into a loop
|
|
|
3913 ;; where we keep re-queueing over and over. To be on the safe
|
|
|
3914 ;; side, store nowait as 1.
|
|
|
3915 (list cmd msg pre-cont cont 1 noretry))
|
|
|
3916 nil)
|
|
|
3917
|
|
|
3918 ;; Send a command.
|
|
|
3919
|
|
|
3920 (let (cmd-string afsc-result afsc-line afsc-cont-lines)
|
|
|
3921
|
|
|
3922 (let ((efs-nested-cmd t)
|
|
|
3923 (cmd0 (car cmd))
|
|
|
3924 (cmd1 (nth 1 cmd))
|
|
|
3925 (cmd2 (nth 2 cmd))
|
|
|
3926 (cmd3 (nth 3 cmd)))
|
|
|
3927
|
|
|
3928 (cond
|
|
|
3929
|
|
|
3930 ((eq cmd0 'quote)
|
|
|
3931 ;; QUOTEd commands
|
|
|
3932 (cond
|
|
|
3933
|
|
|
3934 ((eq cmd1 'site)
|
|
|
3935 ;; SITE commands
|
|
|
3936 (cond
|
|
|
3937 ((memq cmd2 '(umask idle dos exec nfs group gpass))
|
|
|
3938 ;; For UMASK cmd3 = value of umask
|
|
|
3939 ;; For IDLE cmd3 = idle setting, or nil if we're querying.
|
|
|
3940 ;; For DOS and NFS cmd3 is nil.
|
|
|
3941 ;; For EXEC cmd3 is the command to be exec'ed -- a string.
|
|
|
3942 (if cmd3 (setq cmd3 (concat " " cmd3)))
|
|
|
3943 (setq cmd-string (concat "quote site " (symbol-name cmd2)
|
|
|
3944 cmd3)))
|
|
|
3945 ((eq cmd2 'chmod)
|
|
|
3946 (let* ((host-type (efs-host-type host user))
|
|
|
3947 (cmd4 (efs-quote-string
|
|
|
3948 host-type (efs-fix-path host-type (nth 4 cmd)))))
|
|
|
3949 (setq cmd-string (concat "quote site chmod " cmd3 " "
|
|
|
3950 cmd4))))
|
|
|
3951 (t (error "efs: Don't know how to send %s %s %s %s"
|
|
|
3952 cmd0 cmd1 cmd2 cmd3))))
|
|
|
3953
|
|
|
3954 ((memq cmd1 '(pwd xpwd syst pasv noop))
|
|
|
3955 (setq cmd-string (concat "quote " (symbol-name cmd1))))
|
|
|
3956
|
|
|
3957 ;; PORT command (cmd2 is IP + port address)
|
|
|
3958 ((eq cmd1 'port)
|
|
|
3959 (setq cmd-string (concat "quote port " cmd2)))
|
|
|
3960
|
|
|
3961 ((memq cmd1 '(appe retr))
|
|
|
3962 (let ((host-type (efs-host-type host user)))
|
|
|
3963 ;; Set an xfer type
|
|
|
3964 (if cmd3 (efs-set-xfer-type host user cmd3 t))
|
|
|
3965 (setq cmd2 (efs-quote-string host-type
|
|
|
3966 (efs-fix-path host-type cmd2))
|
|
|
3967 cmd-string (concat "quote " (symbol-name cmd1) " "
|
|
|
3968 cmd2))))
|
|
|
3969
|
|
|
3970 ((eq cmd1 'stor)
|
|
|
3971 (let ((host-type (efs-host-type host user)))
|
|
|
3972 (if (memq host-type efs-unix-host-types)
|
|
|
3973 (efs-set-umask host user))
|
|
|
3974 ;; Set an xfer type
|
|
|
3975 (if cmd3 (efs-set-xfer-type host user cmd3 t))
|
|
|
3976 (setq cmd2 (efs-quote-string host-type
|
|
|
3977 (efs-fix-path host-type cmd2))
|
|
|
3978 cmd-string (concat "quote stor " cmd2))))
|
|
|
3979
|
|
|
3980 ((memq cmd1 '(size mdtm rnfr))
|
|
|
3981 (let ((host-type (efs-host-type host user)))
|
|
|
3982 (setq cmd2 (efs-quote-string host-type
|
|
|
3983 (efs-fix-path host-type cmd2))
|
|
|
3984 cmd-string (concat "quote "
|
|
|
3985 (symbol-name cmd1) " " cmd2))))
|
|
|
3986
|
|
|
3987 ((memq cmd1 '(pass user))
|
|
|
3988 (setq cmd-string (concat "quote " (symbol-name cmd1) " " cmd2)))
|
|
|
3989
|
|
|
3990 (t
|
|
|
3991 (error "efs: Don't know how to send %s %s %s %s"
|
|
|
3992 cmd0 cmd1 cmd2 cmd3))))
|
|
|
3993
|
|
|
3994 ;; TYPE command
|
|
|
3995 ((eq cmd0 'type)
|
|
|
3996 (setq cmd-string (concat "type " (symbol-name cmd1))))
|
|
|
3997
|
|
|
3998 ;; DIR command
|
|
|
3999 ;; cmd == 'dir "remote-path" "local-path" "ls-switches"
|
|
|
4000 ((memq cmd0 '(dir nlist))
|
|
|
4001 (let ((host-type (efs-host-type host user))
|
|
|
4002 (listing-type (efs-listing-type host user)))
|
|
|
4003 (setq cmd1 (efs-fix-dir-path host-type cmd1))
|
|
|
4004 (cond
|
|
|
4005 ((memq listing-type efs-nlist-listing-types)
|
|
|
4006 (setq cmd-string (concat efs-nlist-cmd " "
|
|
|
4007 (efs-quote-string host-type cmd1)
|
|
|
4008 " " cmd2)))
|
|
|
4009 ((or (memq host-type efs-dumb-host-types)
|
|
|
4010 (null cmd3))
|
|
|
4011 (setq cmd-string (format "%s %s %s"
|
|
|
4012 (if (eq cmd0 'nlist)
|
|
|
4013 efs-nlist-cmd
|
|
|
4014 "dir")
|
|
|
4015 (efs-quote-string host-type cmd1)
|
|
|
4016 cmd2)))
|
|
|
4017 ((setq cmd-string
|
|
|
4018 (format "%s \"%s %s\" %s"
|
|
|
4019 (if (eq cmd0 'nlist)
|
|
|
4020 efs-nlist-cmd
|
|
|
4021 "ls")
|
|
|
4022 cmd3 (efs-quote-string host-type cmd1 t)
|
|
|
4023 ;; cmd2 is a temp file, not nec. to quote.
|
|
|
4024 cmd2))))))
|
|
|
4025
|
|
|
4026 ;; First argument is the remote pathname
|
|
|
4027 ((memq cmd0 '(delete mkdir rmdir cd))
|
|
|
4028 (let ((host-type (efs-host-type host user)))
|
|
|
4029 (setq cmd1 (efs-quote-string host-type
|
|
|
4030 (efs-fix-path host-type cmd1))
|
|
|
4031 cmd-string (concat (symbol-name cmd0) " " cmd1))))
|
|
|
4032
|
|
|
4033 ;; GET command
|
|
|
4034 ((eq cmd0 'get)
|
|
|
4035 (let ((host-type (efs-host-type host user)))
|
|
|
4036 (if cmd3 (efs-set-xfer-type host user cmd3))
|
|
|
4037 (efs-set-hash-mark-unit host user t)
|
|
|
4038 (setq cmd1 (efs-quote-string host-type
|
|
|
4039 (efs-fix-path host-type cmd1))
|
|
|
4040 cmd2 (efs-quote-string host-type cmd2)
|
|
|
4041 cmd-string (concat "get " cmd1 " " cmd2))))
|
|
|
4042
|
|
|
4043 ;; PUT command
|
|
|
4044 ((eq cmd0 'put)
|
|
|
4045 (let ((host-type (efs-host-type host user)))
|
|
|
4046 (if (memq host-type efs-unix-host-types)
|
|
|
4047 (efs-set-umask host user))
|
|
|
4048 (if cmd3 (efs-set-xfer-type host user cmd3))
|
|
|
4049 (efs-set-hash-mark-unit host user)
|
|
|
4050 (setq cmd2 (efs-quote-string host-type
|
|
|
4051 (efs-fix-path host-type cmd2))
|
|
|
4052 cmd1 (efs-quote-string host-type cmd1)
|
|
|
4053 cmd-string (concat "put " cmd1 " " cmd2))))
|
|
|
4054
|
|
|
4055 ;; APPEND command
|
|
|
4056 ((eq cmd0 'append)
|
|
|
4057 (let ((host-type (efs-host-type host user)))
|
|
|
4058 (if cmd3 (efs-set-xfer-type host user cmd3))
|
|
|
4059 (efs-set-hash-mark-unit host user)
|
|
|
4060 (setq cmd2 (efs-quote-string host-type
|
|
|
4061 (efs-fix-path host-type cmd2))
|
|
|
4062 cmd1 (efs-quote-string host-type cmd1)
|
|
|
4063 cmd-string (concat "append " cmd1 " " cmd2))))
|
|
|
4064
|
|
|
4065 ;; CHMOD command
|
|
|
4066 ((eq cmd0 'chmod)
|
|
|
4067 (let ((host-type (efs-host-type host user)))
|
|
|
4068 (setq cmd2 (efs-quote-string host-type
|
|
|
4069 (efs-fix-path host-type cmd2))
|
|
|
4070 cmd-string (concat "chmod " cmd1 " " cmd2))))
|
|
|
4071
|
|
|
4072 ;; Both arguments are remote pathnames
|
|
|
4073 ((eq cmd0 'rename)
|
|
|
4074 (let ((host-type (efs-host-type host user)))
|
|
|
4075 (setq cmd1 (efs-quote-string host-type
|
|
|
4076 (efs-fix-path host-type cmd1))
|
|
|
4077 cmd2 (efs-quote-string host-type
|
|
|
4078 (efs-fix-path host-type cmd2))
|
|
|
4079 cmd-string (concat "rename " cmd1 " " cmd2))))
|
|
|
4080
|
|
|
4081 (t
|
|
|
4082 (error "efs: Don't know how to send %s %s %s %s"
|
|
|
4083 cmd0 cmd1 cmd2 cmd3))))
|
|
|
4084
|
|
|
4085 ;; Actually send the resulting command.
|
|
|
4086 ;; Why do we use this complicated binding of afsc-{result,line},
|
|
|
4087 ;; rather then use the fact that efs-raw-send-cmd returns?
|
|
|
4088 ;; Because efs-raw-send-cmd returns the result of the first
|
|
|
4089 ;; attempt only. efs-send-cmd should return the result of
|
|
|
4090 ;; the retry, if one was necessary.
|
|
|
4091 ;; Maybe it would be better if efs-raw-send-cmd returned
|
|
|
4092 ;; the result of cont, if nowait was nil? Or maybe still return
|
|
|
4093 ;; \(result line \)? As long as nowait is nil, it should
|
|
|
4094 ;; return something useful.
|
|
|
4095
|
|
|
4096 ;; Beware, if some of the above FTP commands had to restart
|
|
|
4097 ;; the process, PROC won't be set to the right process object.
|
|
|
4098 (setq proc (efs-get-process host user))
|
|
|
4099
|
|
|
4100 (efs-raw-send-cmd
|
|
|
4101 proc
|
|
|
4102 cmd-string
|
|
|
4103 msg
|
|
|
4104 pre-cont
|
|
|
4105 (efs-cont (result line cont-lines) (host user proc cmd msg pre-cont
|
|
|
4106 cont nowait noretry)
|
|
|
4107 (cond ((and (null noretry) (eq result 'fatal))
|
|
|
4108 (let ((retry
|
|
|
4109 (efs-send-cmd
|
|
|
4110 host user cmd msg pre-cont cont
|
|
|
4111 (if (eq nowait t) 1 nowait) t)))
|
|
|
4112 (or cont nowait
|
|
|
4113 (setq afsc-result (car retry)
|
|
|
4114 afsc-line (nth 1 retry)
|
|
|
4115 afsc-cont-lines (nth 2 retry)))))
|
|
|
4116 ((and (eq result 'failed)
|
|
|
4117 (or (memq (car cmd) '(append rename put))
|
|
|
4118 (and (eq (car cmd) 'quote)
|
|
|
4119 (eq (nth 1 cmd) 'stor)))
|
|
|
4120 (efs-save-match-data
|
|
|
4121 (string-match efs-write-protect-msgs line)))
|
|
|
4122 (let ((retry (efs-write-recover
|
|
|
4123 (efs-host-type host)
|
|
|
4124 line cont-lines host user cmd msg pre-cont
|
|
|
4125 cont nowait noretry)))
|
|
|
4126 (or cont nowait
|
|
|
4127 (setq afsc-result (car retry)
|
|
|
4128 afsc-line (nth 1 retry)
|
|
|
4129 afsc-cont-lines (nth 2 retry)))))
|
|
|
4130
|
|
|
4131 (t (if cont
|
|
|
4132 (efs-call-cont cont result line cont-lines)
|
|
|
4133 (or nowait
|
|
|
4134 (setq afsc-result result
|
|
|
4135 afsc-line line
|
|
|
4136 afsc-cont-lines cont-lines))))))
|
|
|
4137 nowait)
|
|
|
4138
|
|
|
4139 (prog1
|
|
|
4140 (if (or nowait cont)
|
|
|
4141 nil
|
|
|
4142 (list afsc-result afsc-line afsc-cont-lines))
|
|
|
4143
|
|
|
4144 ;; Check the queue
|
|
|
4145 (or nowait
|
|
|
4146 efs-nested-cmd
|
|
|
4147 (let ((buff (efs-ftp-process-buffer host user)))
|
|
|
4148 (if (get-buffer buff)
|
|
|
4149 (save-excursion
|
|
|
4150 (set-buffer buff)
|
|
|
4151 (if efs-process-q
|
|
|
4152 (let ((next (car efs-process-q)))
|
|
|
4153 (setq efs-process-q (cdr efs-process-q))
|
|
|
4154 (apply 'efs-send-cmd host user next))))))))))))
|
|
|
4155
|
|
|
4156 (efs-defun efs-write-recover nil
|
|
|
4157 (line cont-lines host user cmd msg pre-cont cont nowait noretry)
|
|
|
4158 "Called when a write command fails with `efs-write-protect-msgs'.
|
|
|
4159 Should return \(result line cont-lines\), like `efs-raw-send-cmd'."
|
|
|
4160 ;; This default version doesn't do anything.
|
|
|
4161 (if cont
|
|
|
4162 (progn
|
|
|
4163 (efs-call-cont cont 'failed line cont-lines)
|
|
|
4164 nil)
|
|
|
4165 (if nowait nil (list 'failed line cont-lines))))
|
|
|
4166
|
|
|
4167 ;;;; ---------------------------------------------------------------------
|
|
|
4168 ;;;; The login sequence. (The follows RFC959 rather tightly. If a server
|
|
|
4169 ;;;; can't even get the login codes right, it is
|
|
|
4170 ;;;; pretty much scrap metal.)
|
|
|
4171 ;;;; ---------------------------------------------------------------------
|
|
|
4172
|
|
114
|
4173 ;;;###autoload
|
|
98
|
4174 (defun efs-nslookup-host (host)
|
|
|
4175 "Attempt to resolve the given HOSTNAME using nslookup if possible."
|
|
|
4176 (interactive "sHost: ")
|
|
|
4177 (if efs-nslookup-program
|
|
|
4178 (let* ((default-directory exec-directory)
|
|
|
4179 (default-major-mode 'fundamental-mode)
|
|
|
4180 (process-connection-type nil)
|
|
|
4181 (proc (start-process " *nslookup*" " *nslookup*"
|
|
|
4182 efs-nslookup-program host))
|
|
|
4183 (res host))
|
|
|
4184 (process-kill-without-query proc)
|
|
|
4185 (save-excursion
|
|
|
4186 (set-buffer (process-buffer proc))
|
|
|
4187 (let ((quit-flag nil)
|
|
|
4188 (inhibit-quit nil))
|
|
|
4189 (while (memq (process-status proc) '(run open))
|
|
|
4190 (accept-process-output proc)))
|
|
|
4191 (goto-char (point-min))
|
|
|
4192 (if (re-search-forward
|
|
|
4193 "Name:.*\nAddress\\(es\\)?: *\\([.0-9]+\\)$" nil t)
|
|
|
4194 (setq res (buffer-substring (match-beginning 2)
|
|
|
4195 (match-end 2))))
|
|
|
4196 (kill-buffer (current-buffer)))
|
|
|
4197 (if (interactive-p)
|
|
|
4198 (message "%s: %s" host res))
|
|
|
4199 res)
|
|
|
4200 (if (interactive-p)
|
|
|
4201 (message
|
|
|
4202 "No nslookup program. See the variable efs-nslookup-program."))
|
|
|
4203 host))
|
|
|
4204
|
|
|
4205 (defun efs-login (host user proc)
|
|
|
4206 "Connect to the FTP-server on HOST as USER.
|
|
|
4207 PROC is the process to the FTP-client. Doesn't call efs-save-match-data.
|
|
|
4208 You must do that yourself."
|
|
|
4209 (let ((gate (efs-use-gateway-p host)))
|
|
|
4210 (if (eq gate 'kerberos)
|
|
|
4211 (progn
|
|
|
4212 (setq proc (efs-kerberos-login host user proc))
|
|
|
4213 (efs-login-send-user host user proc gate))
|
|
|
4214 (let ((to (if (memq gate '(proxy local raptor))
|
|
|
4215 efs-gateway-host
|
|
|
4216 host))
|
|
|
4217 port cmd result)
|
|
|
4218 (if (string-match "#" to)
|
|
|
4219 (setq port (substring to (match-end 0))
|
|
|
4220 to (substring to 0 (match-beginning 0))))
|
|
|
4221 (and efs-nslookup-on-connect
|
|
|
4222 (string-match "[^0-9.]" to)
|
|
|
4223 (setq to (efs-nslookup-host to)))
|
|
|
4224 (setq cmd (concat "open " to))
|
|
|
4225 (if port (setq cmd (concat cmd " " port)))
|
|
|
4226
|
|
|
4227 ;; Send OPEN command.
|
|
|
4228 (setq result (efs-raw-send-cmd proc cmd nil))
|
|
|
4229
|
|
|
4230 (and (eq gate 'interlock) (string-match "^331 " (nth 1 result))
|
|
|
4231 (setq result (efs-login-send-pass
|
|
|
4232 efs-gateway-host
|
|
|
4233 (efs-get-user efs-gateway-host) proc)))
|
|
|
4234
|
|
|
4235 ;; Analyze result of OPEN.
|
|
|
4236 (if (car result)
|
|
|
4237 (progn
|
|
|
4238 (condition-case nil (delete-process proc) (error nil))
|
|
|
4239 (efs-error host user (concat "OPEN request failed: "
|
|
|
4240 (nth 1 result))))
|
|
|
4241 (efs-login-send-user host user proc gate))))))
|
|
|
4242
|
|
|
4243 (defun efs-login-send-user (host user proc &optional gate retry)
|
|
|
4244 "Send user command to HOST and USER. PROC is the ftp client process.
|
|
|
4245 Optional argument GATE specifies which type of gateway is being used.
|
|
|
4246 RETRY argument specifies to try twice if we get a 421 response."
|
|
|
4247 (let ((cmd (cond
|
|
|
4248 ((memq gate '(local proxy interlock))
|
|
|
4249 (format "quote USER \"%s\"@%s" user
|
|
|
4250 (if (and efs-nslookup-on-connect
|
|
|
4251 (string-match "[^0-9.]" host))
|
|
|
4252 (efs-nslookup-host host)
|
|
|
4253 host)))
|
|
|
4254 ((eq gate 'raptor)
|
|
|
4255 (format "quote USER \"%s\"@%s %s" user
|
|
|
4256 (if (and efs-nslookup-on-connect
|
|
|
4257 (string-match "[^0-9.]" host))
|
|
|
4258 (efs-nslookup-host host)
|
|
|
4259 host)
|
|
|
4260 (nth 3 efs-gateway-type)))
|
|
|
4261 ((eq gate 'kerberos)
|
|
|
4262 (let ((to host)
|
|
|
4263 port)
|
|
|
4264 (if (string-match "#" host)
|
|
|
4265 (progn
|
|
|
4266 (setq to (substring host 0 (match-beginning 0))
|
|
|
4267 port (substring host (match-end 0)))
|
|
|
4268 (and efs-nslookup-on-connect
|
|
|
4269 (string-match "[^0-9.]" to)
|
|
|
4270 (efs-nslookup-host to))
|
|
|
4271 (setq to (concat to "@" port))))
|
|
|
4272 (format "quote user \"%s\"@%s" user to)))
|
|
|
4273 (t
|
|
|
4274 (format "quote user \"%s\"" user))))
|
|
|
4275 (msg (format "Logging in as user %s%s..." user
|
|
|
4276 (if (memq gate '(proxy local raptor kerberos))
|
|
|
4277 (concat "@" host) "")))
|
|
|
4278 result code)
|
|
|
4279
|
|
|
4280 ;; Send the message by hand so that we can report on the size
|
|
|
4281 ;; of the MOTD.
|
|
|
4282 (message msg)
|
|
|
4283
|
|
|
4284 ;; Send USER command.
|
|
|
4285 (setq result (efs-raw-send-cmd proc cmd nil))
|
|
|
4286
|
|
|
4287 ;; Analyze result of USER (this follows RFC959 strictly)
|
|
|
4288 (if (< (length (nth 1 result)) 4)
|
|
|
4289 (progn
|
|
|
4290 (condition-case nil (delete-process proc) (error nil))
|
|
|
4291 (efs-error host user
|
|
|
4292 (concat "USER request failed: " (nth 1 result))))
|
|
|
4293
|
|
|
4294 (setq code (substring (nth 1 result) 0 4))
|
|
|
4295 (cond
|
|
|
4296
|
|
|
4297 ((string-equal "331 " code)
|
|
|
4298 ;; Need password
|
|
|
4299 (setq result (efs-login-send-pass host user proc gate)))
|
|
|
4300
|
|
|
4301 ((string-equal "332 " code)
|
|
|
4302 ;; Need an account, but no password
|
|
|
4303 (setq result (efs-login-send-acct host user proc gate)))
|
|
|
4304
|
|
|
4305 ((null (car result))
|
|
|
4306 ;; logged in proceed
|
|
|
4307 nil)
|
|
|
4308
|
|
|
4309 ((and (or (string-equal "530 " code) (string-equal "421 " code))
|
|
|
4310 (efs-anonymous-p user)
|
|
|
4311 (or (string-match efs-too-many-users-msgs (nth 1 result))
|
|
|
4312 (string-match efs-too-many-users-msgs (nth 2 result))))
|
|
|
4313 (if (save-window-excursion
|
|
|
4314 (condition-case nil
|
|
|
4315 (display-buffer (process-buffer proc))
|
|
|
4316 (error nil))
|
|
|
4317 (y-or-n-p (format
|
|
|
4318 "Too many users for %s@%s. Try again? "
|
|
|
4319 user host)))
|
|
|
4320 (progn
|
|
|
4321 ;; Set result to nil if we are doing a retry, so done
|
|
|
4322 ;; message only gets sent once.
|
|
|
4323 (setq result nil)
|
|
|
4324 (if (string-equal code "530 ")
|
|
|
4325 (efs-login-send-user host user proc gate t)
|
|
|
4326 (efs-get-process host user)))
|
|
|
4327 (signal 'quit nil)))
|
|
|
4328
|
|
|
4329 ((and retry (string-equal code "421 "))
|
|
|
4330 (setq result nil)
|
|
|
4331 (efs-get-process host user))
|
|
|
4332
|
|
|
4333 (t ; bombed
|
|
|
4334 (condition-case nil (delete-process proc) (error nil))
|
|
|
4335 ;; Wrong username?
|
|
|
4336 (efs-set-user host nil)
|
|
|
4337 (efs-error host user
|
|
|
4338 (concat "USER request failed: " (nth 1 result)))))
|
|
|
4339 (and (null (car result))
|
|
|
4340 (stringp (nth 2 result))
|
|
|
4341 (message "%sdone%s" msg
|
|
|
4342 (let ((n (efs-occur-in-string ?\n (nth 2 result))))
|
|
|
4343 (if (> n 1)
|
|
|
4344 (format "; MOTD of %d lines" n)
|
|
|
4345 "")))))))
|
|
|
4346
|
|
|
4347 (defun efs-login-send-pass (host user proc &optional gate)
|
|
|
4348 "Sends password to HOST and USER. PROC is the ftp client process.
|
|
|
4349 Doesn't call efs-save-match data. You must do that yourself."
|
|
|
4350 ;; Note that efs-get-password always returns something.
|
|
|
4351 ;; It prompts the user if necessary. Even if the returned password is
|
|
|
4352 ;; \"\", send it, because we wouldn't be running this function
|
|
|
4353 ;; if the server wasn't insisting on a password.
|
|
|
4354 (let* ((pass "")
|
|
|
4355 (qpass "")
|
|
|
4356 (cmd "")
|
|
|
4357 (result (unwind-protect
|
|
|
4358 (progn
|
|
|
4359 (condition-case nil
|
|
|
4360 (setq pass (efs-get-passwd host user))
|
|
|
4361 (quit (condition-case nil
|
|
|
4362 (kill-buffer (process-buffer proc))
|
|
|
4363 (error nil))
|
|
|
4364 (signal 'quit nil)))
|
|
|
4365 (setq cmd (concat
|
|
|
4366 "quote pass "
|
|
|
4367 (setq qpass (efs-quote-string nil pass t))))
|
|
|
4368 (efs-raw-send-cmd proc cmd))
|
|
|
4369 (fillarray pass 0)
|
|
|
4370 (fillarray qpass 0)
|
|
|
4371 (fillarray cmd 0)))
|
|
|
4372 (code (and (>= (length (nth 1 result)) 4)
|
|
|
4373 (substring (nth 1 result) 0 4))))
|
|
|
4374 (or code (setq code ""))
|
|
|
4375 ;; Analyze the result.
|
|
|
4376 (cond
|
|
|
4377 ((string-equal code "332 ")
|
|
|
4378 ;; require an account passwd
|
|
|
4379 (setq result (efs-login-send-acct host user proc gate)))
|
|
|
4380 ((null (car result))
|
|
|
4381 ;; logged in proceed
|
|
|
4382 nil)
|
|
|
4383 ((or (string-equal code "530 ") (string-equal code "421 "))
|
|
|
4384 ;; Give the user another chance
|
|
|
4385 (condition-case nil
|
|
|
4386 (if (efs-anonymous-p user)
|
|
|
4387 (if (or (string-match efs-too-many-users-msgs (nth 1 result))
|
|
|
4388 (string-match efs-too-many-users-msgs (nth 2 result)))
|
|
|
4389 (if (save-window-excursion
|
|
|
4390 (condition-case nil
|
|
|
4391 (display-buffer (process-buffer proc))
|
|
|
4392 (error nil))
|
|
|
4393 (y-or-n-p (format
|
|
|
4394 "Too many users for %s@%s. Try again? "
|
|
|
4395 user host)))
|
|
|
4396 (progn
|
|
|
4397 ;; Return nil if we are doing a retry, so done
|
|
|
4398 ;; message only gets sent once.
|
|
|
4399 (setq result nil)
|
|
|
4400 (if (string-equal code "530 ")
|
|
|
4401 (efs-login-send-user host user proc gate)
|
|
|
4402 (efs-get-process host user)))
|
|
|
4403 (signal 'quit nil))
|
|
|
4404 (unwind-protect
|
|
|
4405 (efs-set-passwd
|
|
|
4406 host user
|
|
|
4407 (save-window-excursion
|
|
|
4408 (condition-case nil
|
|
|
4409 (display-buffer (process-buffer proc))
|
|
|
4410 (error nil))
|
|
|
4411 (setq pass
|
|
|
4412 (read-passwd
|
|
|
4413 (format
|
|
|
4414 "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 (unwind-protect
|
|
|
4420 (efs-set-passwd
|
|
|
4421 host user
|
|
|
4422 (setq pass
|
|
|
4423 (read-passwd
|
|
|
4424 (format "Password for %s@%s failed. Try again: "
|
|
|
4425 user host))))
|
|
|
4426 (fillarray pass 0))
|
|
|
4427 (setq result nil)
|
|
|
4428 (efs-login-send-user host user proc gate))
|
|
|
4429 (quit (condition-case nil (delete-process proc) (error nil))
|
|
|
4430 (efs-set-user host nil)
|
|
|
4431 (efs-set-passwd host user nil)
|
|
|
4432 (signal 'quit nil))
|
|
|
4433 (error (condition-case nil (delete-process proc) (error nil))
|
|
|
4434 (efs-set-user host nil)
|
|
|
4435 (efs-set-passwd host user nil)
|
|
|
4436 (efs-error host user "PASS request failed."))))
|
|
|
4437 (t ; bombed for unexplained reasons
|
|
|
4438 (condition-case nil (delete-process proc) (error nil))
|
|
|
4439 (efs-error host user (concat "PASS request failed: " (nth 1 result)))))
|
|
|
4440 result))
|
|
|
4441
|
|
|
4442 (defun efs-login-send-acct (host user proc &optional gate)
|
|
|
4443 "Sends account password to HOST and USER. PROC is the ftp client process.
|
|
|
4444 Doesn't call efs-save-match data. You must do that yourself."
|
|
|
4445 (let* ((acct "")
|
|
|
4446 (qacct "")
|
|
|
4447 (cmd "")
|
|
|
4448 (result (unwind-protect
|
|
|
4449 (progn
|
|
|
4450 ;; The raptor gateway requires us to send a gateway
|
|
|
4451 ;; authentication password for account. What if the
|
|
|
4452 ;; remote server wants one too?
|
|
|
4453 (setq acct (if (eq gate 'raptor)
|
|
|
4454 (efs-get-account
|
|
|
4455 efs-gateway-host
|
|
|
4456 (nth 3 efs-gateway-type) nil t)
|
|
|
4457 (efs-get-account host user nil t))
|
|
|
4458 qacct (efs-quote-string nil acct t)
|
|
|
4459 cmd (concat "quote acct " qacct))
|
|
|
4460 (efs-raw-send-cmd proc cmd))
|
|
|
4461 (fillarray acct 0)
|
|
|
4462 (fillarray qacct 0)
|
|
|
4463 (fillarray cmd 0))))
|
|
|
4464 ;; Analyze the result
|
|
|
4465 (cond
|
|
|
4466 ((null (car result))
|
|
|
4467 ;; logged in proceed
|
|
|
4468 nil)
|
|
|
4469 ((eq (car result) 'failed)
|
|
|
4470 ;; Give the user another chance
|
|
|
4471 (condition-case nil
|
|
|
4472 (progn
|
|
|
4473 (unwind-protect
|
|
|
4474 (progn
|
|
|
4475 (setq acct (read-passwd
|
|
|
4476 (format
|
|
|
4477 "Account password for %s@%s failed. Try again: "
|
|
|
4478 user host)))
|
|
|
4479 (or (and efs-high-security-hosts
|
|
|
4480 (string-match efs-high-security-hosts
|
|
|
4481 (format "%s@%s" user host)))
|
|
|
4482 (efs-set-account host user nil acct)))
|
|
|
4483 (fillarray acct 0))
|
|
|
4484 (setq result (efs-login-send-user host user proc gate)))
|
|
|
4485 (quit (condition-case nil (delete-process proc) (error nil)))
|
|
|
4486 (error (condition-case nil (delete-process proc) (error nil))
|
|
|
4487 (efs-error host user "ACCT request failed."))))
|
|
|
4488 (t ; bombed for unexplained reasons
|
|
|
4489 (condition-case nil (delete-process proc) (error nil))
|
|
|
4490 (efs-error host user (concat "ACCT request failed: " (nth 1 result)))))
|
|
|
4491 result))
|
|
|
4492
|
|
|
4493 ;;;; ----------------------------------------------------------------------
|
|
|
4494 ;;;; Changing working directory.
|
|
|
4495 ;;;; ----------------------------------------------------------------------
|
|
|
4496
|
|
|
4497 (defun efs-raw-send-cd (host user dir &optional no-error)
|
|
|
4498 ;; If NO-ERROR, doesn't barf, but just returns success (t) or failure (nil).
|
|
|
4499 ;; This does not use efs-send-cmd.
|
|
|
4500 ;; Also DIR must be in the syntax of the remote host-type.
|
|
|
4501 (let* ((cmd (concat "cd " dir))
|
|
|
4502 cd-result cd-line)
|
|
|
4503 (efs-raw-send-cmd
|
|
|
4504 (efs-get-process host user)
|
|
|
4505 cmd nil nil
|
|
|
4506 (efs-cont (result line cont-lines) (cmd)
|
|
|
4507 (if (eq result 'fatal)
|
|
|
4508 (efs-raw-send-cmd
|
|
|
4509 (efs-get-process host user)
|
|
|
4510 cmd nil nil
|
|
|
4511 (function (lambda (result line cont-lines)
|
|
|
4512 (setq cd-result result
|
|
|
4513 cd-line line))))
|
|
|
4514 (setq cd-result result
|
|
|
4515 cd-line line))))
|
|
|
4516 (if no-error
|
|
|
4517 (null cd-result)
|
|
|
4518 (if cd-result
|
|
|
4519 (efs-error host user (concat "CD failed: " cd-line))))))
|
|
|
4520
|
|
|
4521 ;;;; --------------------------------------------------------------
|
|
|
4522 ;;;; Getting a PWD.
|
|
|
4523 ;;;; --------------------------------------------------------------
|
|
|
4524
|
|
|
4525 (defun efs-unquote-quotes (string)
|
|
|
4526 ;; Unquote \"\"'s in STRING to \".
|
|
|
4527 (let ((start 0)
|
|
|
4528 new)
|
|
|
4529 (while (string-match "\"\"" string start)
|
|
|
4530 (setq new (concat new (substring
|
|
|
4531 string start (1+ (match-beginning 0))))
|
|
|
4532 start (match-end 0)))
|
|
|
4533 (if new
|
|
|
4534 (concat new (substring string start))
|
|
|
4535 string)))
|
|
|
4536
|
|
|
4537 (efs-defun efs-send-pwd nil (host user &optional xpwd)
|
|
|
4538 "Attempts to get the current working directory for the given HOST/USER pair.
|
|
|
4539 Returns \( DIR . LINE \) where DIR is either the directory or NIL if not found,
|
|
|
4540 and LINE is the relevant success or fail line from the FTP-server. If the
|
|
|
4541 optional arg XPWD is given, uses this server command instead of PWD."
|
|
|
4542 (let* ((result (efs-send-cmd host user
|
|
|
4543 (list 'quote (if xpwd 'xpwd 'pwd))
|
|
|
4544 "Getting pwd"))
|
|
|
4545 (line (nth 1 result))
|
|
|
4546 dir)
|
|
|
4547 (or (car result)
|
|
|
4548 (efs-save-match-data
|
|
|
4549 (if (string-match "\"\\(.*\\)\"[^\"]*$" line)
|
|
|
4550 (setq dir (efs-unquote-quotes (substring line (match-beginning 1)
|
|
|
4551 (match-end 1))))
|
|
|
4552 (if (string-match " \\([^ ]+\\) " line) ; stone-age servers!
|
|
|
4553 (setq dir (substring line
|
|
|
4554 (match-beginning 1)
|
|
|
4555 (match-end 1)))))))
|
|
|
4556 (cons dir line)))
|
|
|
4557
|
|
|
4558 (efs-defun efs-send-pwd super-dumb-unix (host user &optional xpwd)
|
|
|
4559 ;; Guess at the pwd for a unix host that doesn't support pwd.
|
|
|
4560 (if (efs-anonymous-p user)
|
|
|
4561 ;; guess
|
|
|
4562 (cons "/" "")
|
|
|
4563 ;; Who knows?
|
|
|
4564 (message "Can't obtain pwd for %s" host)
|
|
|
4565 (ding)
|
|
|
4566 (sleep-for 2)
|
|
|
4567 (message "All file names must be specified as full paths.")
|
|
|
4568 (cons nil "")))
|
|
|
4569
|
|
|
4570 ;;;; --------------------------------------------------------
|
|
|
4571 ;;;; Getting the SIZE of a remote file.
|
|
|
4572 ;;;; --------------------------------------------------------
|
|
|
4573
|
|
|
4574 (defun efs-send-size (host user file)
|
|
|
4575 "For HOST and USER, get the size of FILE in bytes.
|
|
|
4576 This returns a list \( SIZE . LINE \), where SIZE is the file size in bytes,
|
|
|
4577 or nil if this couldn't be determined, and LINE is the output line of the
|
|
|
4578 FTP server."
|
|
|
4579 (efs-save-match-data
|
|
|
4580 (let ((result (efs-send-cmd host user (list 'quote 'size file))))
|
|
|
4581 (setcar result
|
|
|
4582 (and (null (car result))
|
|
|
4583 (string-match "^213 +\\([0-9]+\\)$" (nth 1 result))
|
|
|
4584 (string-to-int
|
|
|
4585 (substring
|
|
|
4586 (cdr result)
|
|
|
4587 (match-beginning 1) (match-end 1)))))
|
|
|
4588 result)))
|
|
|
4589
|
|
|
4590 ;;;; ------------------------------------------------------------
|
|
|
4591 ;;;; umask support
|
|
|
4592 ;;;; ------------------------------------------------------------
|
|
|
4593
|
|
|
4594 (defun efs-umask (user)
|
|
|
4595 "Returns the umask that efs will use for USER.
|
|
|
4596 If USER is root or anonymous, then the values of efs-root-umask
|
|
|
4597 and efs-anonymous-umask, respectively, take precedence, to be followed
|
|
|
4598 by the value of efs-umask, and if this is nil, it returns your current
|
|
|
4599 umask on the local machine. Returns nil if this can't be determined."
|
|
|
4600 (or
|
|
|
4601 (and (string-equal user "root") efs-root-umask)
|
|
|
4602 (and (efs-anonymous-p user)
|
|
|
4603 efs-anonymous-umask)
|
|
|
4604 efs-umask
|
|
|
4605 (let* ((shell (or (and (boundp 'explicit-shell-file-name)
|
|
|
4606 explicit-shell-file-name)
|
|
|
4607 (getenv "ESHELL")
|
|
|
4608 (getenv "SHELL")
|
|
|
4609 "/bin/sh"))
|
|
|
4610 (default-major-mode 'fundamental-mode)
|
|
|
4611 (default-directory exec-directory)
|
|
|
4612 (buff (get-buffer-create " *efs-umask-data*")))
|
|
|
4613 (unwind-protect
|
|
|
4614 (save-excursion
|
|
|
4615 (set-buffer buff)
|
|
|
4616 (call-process shell nil buff nil "-c" "umask")
|
|
|
4617 (goto-char (point-min))
|
|
|
4618 (if (re-search-forward "[0-7]?[0-7]?[0-7]" nil t)
|
|
|
4619 (string-to-int (buffer-substring (match-beginning 0)
|
|
|
4620 (match-end 0)))))
|
|
|
4621 (kill-buffer buff)))))
|
|
|
4622
|
|
|
4623 (defun efs-send-umask (host user mask)
|
|
|
4624 "Sets the umask on HOST for USER to MASK.
|
|
|
4625 Returns t for success, nil for failure."
|
|
|
4626 (interactive
|
|
|
4627 (let* ((path (or buffer-file-name
|
|
|
4628 (and (eq major-mode 'dired-mode)
|
|
|
4629 dired-directory)))
|
|
|
4630 (parsed (and path (efs-ftp-path path)))
|
|
|
4631 (default-host (car parsed))
|
|
|
4632 (default-user (nth 1 parsed))
|
|
|
4633 (default-mask (efs-umask default-user)))
|
|
|
4634 (list
|
|
|
4635 (read-string "Host: " default-host)
|
|
|
4636 (read-string "User: " default-user)
|
|
|
4637 (read-string "Umask: " (int-to-string default-mask)))))
|
|
|
4638 (let (int-mask)
|
|
|
4639 (if (integerp mask)
|
|
|
4640 (setq int-mask mask
|
|
|
4641 mask (int-to-string mask))
|
|
|
4642 (setq int-mask (string-to-int mask)))
|
|
|
4643 (or (string-match "^ *[0-7]?[0-7]?[0-7] *$" mask)
|
|
|
4644 (error "Invalid umask %s" mask))
|
|
|
4645 (efs-send-cmd host user
|
|
|
4646 (list 'quote 'site 'umask mask)
|
|
|
4647 (concat "Setting umask to " mask)
|
|
|
4648 (list
|
|
|
4649 (function
|
|
|
4650 (lambda (int-mask)
|
|
|
4651 (let ((buff (efs-ftp-process-buffer host user)))
|
|
|
4652 (if (get-buffer buff)
|
|
|
4653 (save-excursion
|
|
|
4654 (set-buffer buff)
|
|
|
4655 (setq efs-process-umask int-mask))))))
|
|
|
4656 int-mask)
|
|
|
4657 (efs-cont (result line cont-lines) (host user mask)
|
|
|
4658 (if result
|
|
|
4659 (let ((buff (efs-ftp-process-buffer host user)))
|
|
|
4660 (efs-set-host-property host 'umask-failed t)
|
|
|
4661 (if (get-buffer buff)
|
|
|
4662 (save-excursion
|
|
|
4663 (set-buffer buff)
|
|
|
4664 (setq efs-process-umask nil)))
|
|
|
4665 (message
|
|
|
4666 "Unable to set umask to %s on %s" mask host)
|
|
|
4667 (if efs-ding-on-umask-failure
|
|
|
4668 (progn
|
|
|
4669 (ding)
|
|
|
4670 (sit-for 1))))))
|
|
|
4671 0))) ; Do this NOWAIT = 0
|
|
|
4672
|
|
|
4673 (defun efs-set-umask (host user)
|
|
|
4674 "Sets the umask for HOST and USER, if it has not already been set."
|
|
|
4675 (save-excursion
|
|
|
4676 (set-buffer (process-buffer (efs-get-process host user)))
|
|
|
4677 (if (or efs-process-umask (efs-get-host-property host 'umask-failed))
|
|
|
4678 nil
|
|
|
4679 (let ((umask (efs-umask user)))
|
|
|
4680 (efs-send-umask host user umask)
|
|
|
4681 t)))) ; Tell the caller that we did something.
|
|
|
4682
|
|
|
4683 (defun efs-modes-from-umask (umask)
|
|
|
4684 ;; Given the 3 digit octal integer umask, returns the decimal integer
|
|
|
4685 ;; according to chmod that a file would be written with.
|
|
|
4686 ;; Assumes only ordinary files, so ignores x bits.
|
|
|
4687 (let* ((others (% umask 10))
|
|
|
4688 (umask (/ umask 10))
|
|
|
4689 (group (% umask 10))
|
|
|
4690 (umask (/ umask 10))
|
|
|
4691 (owner (% umask 10))
|
|
|
4692 (factor 1))
|
|
|
4693 (apply '+
|
|
|
4694 (mapcar
|
|
|
4695 (function
|
|
|
4696 (lambda (x)
|
|
|
4697 (prog1
|
|
|
4698 (* factor (- 6 (- x (% x 2))))
|
|
|
4699 (setq factor (* factor 8)))))
|
|
|
4700 (list others group owner)))))
|
|
|
4701
|
|
|
4702 ;;;; ------------------------------------------------------------
|
|
|
4703 ;;;; Idle time manipulation.
|
|
|
4704 ;;;; ------------------------------------------------------------
|
|
|
4705
|
|
|
4706 (defun efs-check-idle (host user)
|
|
|
4707 ;; We just toss it in the queue to run whenever there's time.
|
|
|
4708 ;; Just fail quietly if this doesn't work.
|
|
|
4709 (if (and (or efs-maximize-idle efs-expire-ftp-buffers)
|
|
|
4710 (memq (efs-host-type host) efs-idle-host-types)
|
|
|
4711 (null (efs-get-host-property host 'idle-failed)))
|
|
|
4712 (let ((buffname (efs-ftp-process-buffer host user)))
|
|
|
4713 (efs-add-to-queue
|
|
|
4714 host user
|
|
|
4715 (list '(quote site idle)
|
|
|
4716 nil nil
|
|
|
4717 (efs-cont (result line cont-lines) (host user buffname)
|
|
|
4718 (efs-save-match-data
|
|
|
4719 (if (and (null result)
|
|
|
4720 (string-match efs-idle-msgs line))
|
|
|
4721 (let ((max (substring line (match-beginning 2)
|
|
|
4722 (match-end 2))))
|
|
|
4723 (if (get-buffer buffname)
|
|
|
4724 (save-excursion
|
|
|
4725 (set-buffer buffname)
|
|
|
4726 (setq efs-process-idle-time
|
|
|
4727 (string-to-int
|
|
|
4728 (substring line (match-beginning 1)
|
|
|
4729 (match-end 1))))))
|
|
|
4730 (if (and efs-maximize-idle
|
|
|
4731 (not (efs-anonymous-p user)))
|
|
|
4732 (efs-add-to-queue
|
|
|
4733 host user
|
|
|
4734 (list
|
|
|
4735 (list 'quote 'site 'idle max)
|
|
|
4736 nil nil
|
|
|
4737 (efs-cont (result line cont-lines) (buffname
|
|
|
4738 max)
|
|
|
4739 (and (null result)
|
|
|
4740 (get-buffer buffname)
|
|
|
4741 (save-excursion
|
|
|
4742 (set-buffer buffname)
|
|
|
4743 (setq efs-process-idle-time
|
|
|
4744 (string-to-int max)))))
|
|
|
4745 0))))
|
|
|
4746 (efs-set-host-property host 'idle-failed t))))
|
|
|
4747 0 nil))))) ; Using NOWAIT = 0 inhibits mode line toggling.
|
|
|
4748
|
|
|
4749
|
|
|
4750 ;;;; ------------------------------------------------------------
|
|
|
4751 ;;;; Sending the SYST command for system type.
|
|
|
4752 ;;;; ------------------------------------------------------------
|
|
|
4753
|
|
|
4754 (defun efs-get-syst (host user)
|
|
|
4755 "Use SYST to get the remote system type.
|
|
|
4756 Returns the system type as a string if this succeeds, otherwise nil."
|
|
|
4757 (let* ((result (efs-send-cmd host user '(quote syst)))
|
|
|
4758 (line (nth 1 result)))
|
|
|
4759 (efs-save-match-data
|
|
|
4760 (and (null (car result))
|
|
|
4761 (string-match efs-syst-msgs line)
|
|
|
4762 (substring line (match-end 0))))))
|
|
|
4763
|
|
|
4764 ;;;; ------------------------------------------------------------
|
|
|
4765 ;;;; File transfer representation type support
|
|
|
4766 ;;;; ------------------------------------------------------------
|
|
|
4767
|
|
|
4768 ;;; Legal representation types are: image, ascii, ebcdic, tenex
|
|
|
4769
|
|
|
4770 (efs-defun efs-file-type nil (path)
|
|
|
4771 ;; Returns the file type for PATH, the full efs path, with filename FILE.
|
|
|
4772 ;; The return value is one of 'text, '8-binary, or '36-binary.
|
|
|
4773 (let ((parsed (efs-ftp-path path)))
|
|
|
4774 (efs-save-match-data
|
|
|
4775 (cond
|
|
|
4776 ;; There is no special significance to temp names, but we assume that
|
|
|
4777 ;; they exist on an 8-bit byte machine.
|
|
|
4778 ((or (null path)
|
|
|
4779 (let ((temp (intern-soft path efs-tmp-name-obarray)))
|
|
|
4780 (and temp (memq temp efs-tmp-name-files))))
|
|
|
4781 '8-binary)
|
|
|
4782 ((and (null parsed) (file-exists-p path))
|
|
|
4783 (efs-local-file-type path))
|
|
|
4784 ;; test special hosts
|
|
|
4785 ((and parsed
|
|
|
4786 efs-binary-file-host-regexp
|
|
|
4787 (let ((case-fold-search t))
|
|
|
4788 (string-match efs-binary-file-host-regexp (car parsed))))
|
|
|
4789 '8-binary)
|
|
|
4790 (t
|
|
|
4791 ;; Test file names
|
|
|
4792 (let ((file (efs-internal-file-name-nondirectory
|
|
|
4793 (or (nth 2 parsed) path))))
|
|
|
4794 (cond
|
|
|
4795 ;; test for PDP-10 binaries
|
|
|
4796 ((and efs-36-bit-binary-file-name-regexp
|
|
|
4797 (string-match efs-36-bit-binary-file-name-regexp file))
|
|
|
4798 '36-binary)
|
|
|
4799 ((and efs-binary-file-name-regexp
|
|
|
4800 (string-match efs-binary-file-name-regexp file))
|
|
|
4801 '8-binary)
|
|
|
4802 ((and efs-text-file-name-regexp
|
|
|
4803 (string-match efs-text-file-name-regexp file))
|
|
|
4804 'text)
|
|
|
4805 ;; by default
|
|
|
4806 (t
|
|
|
4807 '8-binary))))))))
|
|
|
4808
|
|
|
4809 (efs-define-fun efs-local-file-type (file)
|
|
|
4810 ;; Looks at the beginning (magic-cookie) of a local file to determine
|
|
|
4811 ;; if it is a text file or not. If it's not a text file, it doesn't care
|
|
|
4812 ;; about what type of binary file, so this doesn't really look for a magic
|
|
|
4813 ;; cookie.
|
|
|
4814 ;; Doesn't call efs-save-match-data. The caller should do so.
|
|
|
4815 (save-excursion
|
|
|
4816 (set-buffer (get-buffer-create efs-data-buffer-name))
|
|
|
4817 (erase-buffer)
|
|
|
4818 (insert-file-contents file nil 0 16)
|
|
|
4819 (if (looking-at "[ -~\n\r\C-L]*\\'")
|
|
|
4820 'text
|
|
|
4821 '8-binary)))
|
|
|
4822
|
|
|
4823 (defun efs-rationalize-file-type (f-type t-type)
|
|
|
4824 ;; When the original and new names for a file indicate
|
|
|
4825 ;; different file types, this function applies an ad hoc heuristic
|
|
|
4826 ;; to return a single file type.
|
|
|
4827 (cond
|
|
|
4828 ((eq f-type t-type)
|
|
|
4829 f-type)
|
|
|
4830 ((memq '36-binary (list f-type t-type))
|
|
|
4831 '36-binary)
|
|
|
4832 ((memq '8-binary (list f-type t-type))
|
|
|
4833 '8-binary)
|
|
|
4834 (t
|
|
|
4835 'text)))
|
|
|
4836
|
|
|
4837 (defun efs-prompt-for-transfer-type (arg)
|
|
|
4838 "Toggles value of efs-prompt-for-transfer-type.
|
|
|
4839 With prefix arg, turns prompting on if arg is positive, otherwise turns
|
|
|
4840 prompting off."
|
|
|
4841 (interactive "P")
|
|
|
4842 (if (if arg
|
|
|
4843 (> (prefix-numeric-value arg) 0)
|
|
|
4844 (null efs-prompt-for-transfer-type))
|
|
|
4845 ;; turn prompting on
|
|
|
4846 (prog1
|
|
|
4847 (setq efs-prompt-for-transfer-type t)
|
|
|
4848 (message "Prompting for FTP transfer TYPE is on."))
|
|
|
4849 (prog1
|
|
|
4850 (setq efs-prompt-for-transfer-type nil)
|
|
|
4851 (message "Prompting for FTP transfer TYPE is off."))))
|
|
|
4852
|
|
|
4853 (defun efs-read-xfer-type (path)
|
|
|
4854 ;; Prompt for the transfer type to use for PATH
|
|
|
4855 (let ((type
|
|
|
4856 (completing-read
|
|
|
4857 (format "FTP transfer TYPE for %s: " (efs-relativize-filename path))
|
|
|
4858 '(("binary") ("image") ("ascii") ("ebcdic") ("tenex"))
|
|
|
4859 nil t)))
|
|
|
4860 (if (string-equal type "binary")
|
|
|
4861 'image
|
|
|
4862 (intern type))))
|
|
|
4863
|
|
|
4864 (defun efs-xfer-type (f-host-type f-path t-host-type t-path
|
|
|
4865 &optional via-local)
|
|
|
4866 ;; Returns the transfer type for transferring a file.
|
|
|
4867 ;; F-HOST-TYPE = the host type of the machine on which the file is from.
|
|
|
4868 ;; F-PATH = path, in full efs-syntax, of the original file
|
|
|
4869 ;; T-HOST-TYPE = host-type of the machine to which the file is being
|
|
|
4870 ;; transferred.
|
|
|
4871 ;; VIA-LOCAL = non-nil of the file is being moved through the local, or
|
|
|
4872 ;; a gateway machine.
|
|
|
4873 ;; Set F-PATH or T-PATH to nil, to indicate that the file is being
|
|
|
4874 ;; transferred from/to a temporary file, whose name has no significance.
|
|
|
4875 (let (temp)
|
|
|
4876 (and f-path
|
|
|
4877 (setq temp (intern-soft f-path efs-tmp-name-obarray))
|
|
|
4878 (memq temp efs-tmp-name-files)
|
|
|
4879 (setq f-path nil))
|
|
|
4880 (and t-path
|
|
|
4881 (setq temp (intern-soft t-path efs-tmp-name-obarray))
|
|
|
4882 (memq temp efs-tmp-name-files)
|
|
|
4883 (setq t-path nil)))
|
|
|
4884 (if (or (null (or f-host-type t-host-type)) (null (or f-path t-path)))
|
|
|
4885 'image ; local copy?
|
|
|
4886 (if efs-prompt-for-transfer-type
|
|
|
4887 (efs-read-xfer-type (if f-path f-path t-path))
|
|
|
4888 (let ((f-fs (cdr (assq f-host-type efs-file-type-alist)))
|
|
|
4889 (t-fs (cdr (assq t-host-type efs-file-type-alist))))
|
|
|
4890 (if (and f-fs t-fs
|
|
|
4891 (if efs-treat-crlf-as-nl
|
|
|
4892 (and (eq (car f-fs) (car t-fs))
|
|
|
4893 (eq (nth 1 f-fs) (nth 1 t-fs))
|
|
|
4894 (let ((f2-fs (nth 2 f-fs))
|
|
|
4895 (t2-fs (nth 2 t-fs)))
|
|
|
4896 (or (eq f2-fs t2-fs)
|
|
|
4897 (and (memq f2-fs '(file-crlf file-nl))
|
|
|
4898 (memq t2-fs '(file-crlf file-nl))))))
|
|
|
4899 (equal f-fs t-fs)))
|
|
|
4900 'image
|
|
|
4901 (let ((type (cond
|
|
|
4902 ((and f-path t-path)
|
|
|
4903 (efs-rationalize-file-type
|
|
|
4904 (efs-file-type t-host-type t-path)
|
|
|
4905 (efs-file-type f-host-type f-path)))
|
|
|
4906 (f-path
|
|
|
4907 (efs-file-type f-host-type f-path))
|
|
|
4908 (t-path
|
|
|
4909 (efs-file-type t-host-type t-path)))))
|
|
|
4910 (cond
|
|
|
4911 ((eq type '36-binary)
|
|
|
4912 'image)
|
|
|
4913 ((eq type '8-binary)
|
|
|
4914 (if (or (eq (car f-fs) '36-bit-wa)
|
|
|
4915 (eq (car t-fs) '36-bit-wa))
|
|
|
4916 'tenex
|
|
|
4917 'image))
|
|
|
4918 (t ; handles 'text
|
|
|
4919 (if (and t-fs f-fs (eq (nth 1 f-fs) 'ebcdic)
|
|
|
4920 (eq (nth 1 t-fs) 'ebcdic) (null via-local))
|
|
|
4921 'ebcdic
|
|
|
4922 'ascii)))))))))
|
|
|
4923
|
|
|
4924 (defun efs-set-xfer-type (host user type &optional clientless)
|
|
|
4925 ;; Sets the xfer type for HOST and USER to TYPE.
|
|
|
4926 ;; If the connection is already using the required type, does nothing.
|
|
|
4927 ;; If clientless is non-nil, we are using a quoted xfer command, and
|
|
|
4928 ;; need to check if the client has changed things.
|
|
|
4929 (save-excursion
|
|
|
4930 (let ((buff (process-buffer (efs-get-process host user))))
|
|
|
4931 (set-buffer buff)
|
|
|
4932 (or (if (and clientless efs-process-client-altered-xfer-type)
|
|
|
4933 (or (eq type efs-process-client-altered-xfer-type)
|
|
|
4934 (setq efs-process-client-altered-xfer-type nil))
|
|
|
4935 ;; We are sending a non-clientless command, so the client
|
|
|
4936 ;; gets back in synch.
|
|
|
4937 (setq efs-process-client-altered-xfer-type nil)
|
|
|
4938 (and efs-process-xfer-type
|
|
|
4939 (eq type efs-process-xfer-type)))
|
|
|
4940 (let ((otype efs-process-xfer-type))
|
|
|
4941 ;; Set this now in anticipation that the TYPE command will work,
|
|
|
4942 ;; in case other commands, such as efs-set-hash-mark-unit want to
|
|
|
4943 ;; grok this before the TYPE command completes.
|
|
|
4944 (setq efs-process-xfer-type type)
|
|
|
4945 (efs-send-cmd
|
|
|
4946 host user (list 'type type)
|
|
|
4947 nil nil
|
|
|
4948 (efs-cont (result line cont-lines) (host user type otype buff)
|
|
|
4949 (if result
|
|
|
4950 (unwind-protect
|
|
|
4951 (efs-error host user (format "TYPE %s failed: %s"
|
|
|
4952 (upcase (symbol-name type))
|
|
|
4953 line))
|
|
|
4954 (if (get-buffer buff)
|
|
|
4955 (save-excursion
|
|
|
4956 (set-buffer buff)
|
|
|
4957 (setq efs-process-xfer-type otype))))))
|
|
|
4958 0)))))) ; always send type commands NOWAIT = 0
|
|
|
4959
|
|
|
4960
|
|
|
4961 ;;;; ------------------------------------------------------------
|
|
|
4962 ;;;; Obtaining DIR listings.
|
|
|
4963 ;;;; ------------------------------------------------------------
|
|
|
4964
|
|
|
4965 (defun efs-ls-guess-switches ()
|
|
|
4966 ;; Tries to determine what would be the most useful switches
|
|
|
4967 ;; to use for a DIR listing.
|
|
|
4968 (if (and (boundp 'dired-listing-switches)
|
|
|
4969 (stringp dired-listing-switches)
|
|
|
4970 (efs-parsable-switches-p dired-listing-switches t))
|
|
|
4971 dired-listing-switches
|
|
|
4972 "-al"))
|
|
|
4973
|
|
|
4974 (efs-defun efs-ls-dumb-check nil (line host file path lsargs msg noparse
|
|
|
4975 noerror nowait cont)
|
|
|
4976 nil)
|
|
|
4977
|
|
|
4978 (efs-defun efs-ls-dumb-check unknown (line host file path lsargs
|
|
|
4979 msg noparse noerror nowait cont)
|
|
|
4980 ;; Checks to see if the host type might be dumb unix. If so, returns the
|
|
|
4981 ;; listing otherwise nil.
|
|
|
4982 (and
|
|
|
4983 lsargs
|
|
|
4984 (string-match
|
|
|
4985 ;; Some CMU servers return a 530 here. 550 is correct.
|
|
|
4986 (concat "^5[35]0 \\(The file \\)?"
|
|
|
4987 (regexp-quote (concat lsargs " " path)))
|
|
|
4988 ;; 550 is for a non-accessible file -- RFC959
|
|
|
4989 line)
|
|
|
4990 (progn
|
|
|
4991 (if (eq (efs-host-type host) 'apollo-unix)
|
|
|
4992 (efs-add-host 'dumb-apollo-unix host)
|
|
|
4993 (efs-add-host 'dumb-unix host))
|
|
|
4994 ;; try again
|
|
|
4995 (if nowait
|
|
|
4996 t ; return t if asynch
|
|
|
4997 ; This is because dumb-check can't run asynch.
|
|
|
4998 ; This means that we can't recognize dumb hosts asynch.
|
|
|
4999 ; Shouldn't be a problem.
|
|
|
5000 (efs-ls file nil
|
|
|
5001 (if (eq msg t)
|
|
|
5002 (format "Relisting %s" (efs-relativize-filename file))
|
|
|
5003 msg)
|
|
|
5004 noparse noerror nowait cont)))))
|
|
|
5005
|
|
|
5006 ;; With no-error nil, this function returns:
|
|
|
5007 ;; an error if file is not an efs-path
|
|
|
5008 ;; (This should never happen.)
|
|
|
5009 ;; an error if either the listing is unreadable or there is an ftp error.
|
|
|
5010 ;; the listing (a string), if everything works.
|
|
|
5011 ;;
|
|
|
5012 ;; With no-error t, it returns:
|
|
|
5013 ;; an error if not an efs-path
|
|
|
5014 ;; error if listing is unreable (most likely caused by a slow connection)
|
|
|
5015 ;; nil if ftp error (this is because although asking to list a nonexistent
|
|
|
5016 ;; directory on a remote unix machine usually (except
|
|
|
5017 ;; maybe for dumb hosts) returns an ls error, but no
|
|
|
5018 ;; ftp error, if the same is done on a VMS machine,
|
|
|
5019 ;; an ftp error is returned. Need to trap the error
|
|
|
5020 ;; so we can go on and try to list the parent.)
|
|
|
5021 ;; the listing, if everything works.
|
|
|
5022
|
|
|
5023 (defun efs-ls (file lsargs msg &optional noparse noerror nowait cont nlist)
|
|
|
5024 "Return the output of a `DIR' or `ls' command done over ftp.
|
|
|
5025 FILE is the full name of the remote file, LSARGS is any args to pass to the
|
|
|
5026 `ls' command. MSG is a message to be displayed while listing, if MSG is given
|
|
|
5027 as t, a suitable message will be computed. If nil, no message will be
|
|
|
5028 displayed. If NOPARSE is non-nil, then the listing will not be parsed and
|
|
|
5029 stored in internal cache. Otherwise, the listing will be parsed, if LSARGS
|
|
|
5030 allow it. If NOERROR is non-nil, then we return nil if the listing fails,
|
|
|
5031 rather than signal an error. If NOWAIT is non-nil, we do the listing
|
|
|
5032 asynchronously, returning nil. If CONT is non-nil it is called with first
|
|
|
5033 argument the listing string."
|
|
|
5034 ;; If lsargs are nil, this forces a one-time only dumb listing using dir.
|
|
|
5035 (setq file (efs-expand-file-name file))
|
|
|
5036 (let ((parsed (efs-ftp-path file)))
|
|
|
5037 (if parsed
|
|
|
5038 (let* ((host (nth 0 parsed))
|
|
|
5039 (user (nth 1 parsed))
|
|
|
5040 (path (nth 2 parsed))
|
|
|
5041 (host-type (efs-host-type host user))
|
|
|
5042 (listing-type (efs-listing-type host user))
|
|
|
5043 (parse (cond
|
|
|
5044 ((null noparse)
|
|
|
5045 (efs-parsable-switches-p lsargs t))
|
|
|
5046 ((eq noparse 'parse)
|
|
|
5047 t)
|
|
|
5048 (t nil)))
|
|
|
5049 (switches lsargs)
|
|
|
5050 cache)
|
|
|
5051
|
|
|
5052 (if (memq host-type efs-dumb-host-types)
|
|
|
5053 (setq lsargs nil))
|
|
|
5054 (if (and (null efs-ls-uncache)
|
|
|
5055 (setq cache
|
|
|
5056 (or (efs-get-from-ls-cache file switches)
|
|
|
5057 (and switches
|
|
|
5058 (efs-convert-from-ls-cache
|
|
|
5059 file switches host-type listing-type)))))
|
|
|
5060 ;; The listing is in the mail, errr... cache.
|
|
|
5061 (let (listing)
|
|
|
5062 (if (stringp cache)
|
|
|
5063 (setq listing cache)
|
|
|
5064 (setq listing (car cache))
|
|
|
5065 (if (and parse (null (nth 1 cache)))
|
|
|
5066 (save-excursion
|
|
|
5067 (set-buffer
|
|
|
5068 (let ((default-major-mode 'fundamental-mode))
|
|
|
5069 (get-buffer-create
|
|
|
5070 efs-data-buffer-name)))
|
|
|
5071 (erase-buffer)
|
|
|
5072 (insert listing)
|
|
|
5073 (goto-char (point-min))
|
|
|
5074 (efs-set-files
|
|
|
5075 file
|
|
|
5076 (efs-parse-listing listing-type
|
|
|
5077 host user path
|
|
|
5078 file lsargs))
|
|
|
5079 ;; Note that we have parsed it now.
|
|
|
5080 (setcar (cdr cache) t))))
|
|
|
5081 (if cont (efs-call-cont cont listing))
|
|
|
5082 listing)
|
|
|
5083
|
|
|
5084 (if cache
|
|
|
5085 (efs-del-from-ls-cache file nil nil))
|
|
|
5086 ;; Need to get the listing via FTP.
|
|
|
5087 (let* ((temp (efs-make-tmp-name host nil))
|
|
|
5088 (temp-file (car temp))
|
|
|
5089 listing-result)
|
|
|
5090 (efs-send-cmd
|
|
|
5091 host user
|
|
|
5092 (list (if nlist 'nlist 'dir) path (cdr temp) lsargs)
|
|
|
5093 (if (eq msg t)
|
|
|
5094 (format "Listing %s" (efs-relativize-filename file))
|
|
|
5095 msg)
|
|
|
5096 nil
|
|
|
5097 (efs-cont (result line cont-lines)
|
|
|
5098 (host-type listing-type host user temp-file path
|
|
|
5099 switches file lsargs noparse parse noerror
|
|
|
5100 msg nowait cont)
|
|
|
5101 ;; The client flipped to ascii, remember this.
|
|
|
5102 (let ((buff (get-buffer
|
|
|
5103 (efs-ftp-process-buffer host user))))
|
|
|
5104 (if buff
|
|
|
5105 (efs-save-buffer-excursion
|
|
|
5106 (set-buffer buff)
|
|
|
5107 (setq efs-process-client-altered-xfer-type
|
|
|
5108 'ascii))))
|
|
|
5109 (unwind-protect
|
|
|
5110 (if result
|
|
|
5111 (or (setq listing-result
|
|
|
5112 (efs-ls-dumb-check
|
|
|
5113 (and (or (eq host-type 'unknown)
|
|
|
5114 (eq listing-type 'unix:unknown))
|
|
|
5115 'unknown)
|
|
|
5116 line host file path lsargs msg
|
|
|
5117 noparse noerror nowait cont))
|
|
|
5118 ;; If dumb-check returns non-nil
|
|
|
5119 ;; then it would have handled any error recovery
|
|
|
5120 ;; and conts. listing-result would only be set to
|
|
|
5121 ;; t if nowait was non-nil. Therefore, the final
|
|
|
5122 ;; return for efs-ls could never be t, even if I
|
|
|
5123 ;; set listing-result to t here.
|
|
|
5124 (if noerror
|
|
|
5125 (if cont
|
|
|
5126 (efs-call-cont cont nil))
|
|
|
5127 (efs-error host user
|
|
|
5128 (concat "DIR failed: "
|
|
|
5129 line))))
|
|
|
5130
|
|
|
5131 ;; listing worked
|
|
|
5132 (if (efs-ftp-path temp-file)
|
|
|
5133 (efs-add-file-entry (efs-host-type efs-gateway-host)
|
|
|
5134 temp-file nil nil nil))
|
|
|
5135 (save-excursion
|
|
|
5136 ;; A hack to get around a jka-compr problem.
|
|
|
5137 ;; Do we still need it?
|
|
|
5138 (let ((default-major-mode 'fundamental-mode)
|
|
|
5139 efs-verbose jka-compr-enabled)
|
|
|
5140 (set-buffer (get-buffer-create
|
|
|
5141 efs-data-buffer-name))
|
|
|
5142 (erase-buffer)
|
|
|
5143 (if (or (file-readable-p temp-file)
|
|
|
5144 (sleep-for efs-retry-time)
|
|
|
5145 (file-readable-p temp-file))
|
|
|
5146 (insert-file-contents temp-file)
|
|
|
5147 (efs-error host user
|
|
|
5148 (format
|
|
|
5149 "list data file %s not readable"
|
|
|
5150 temp-file))))
|
|
|
5151 (if parse
|
|
|
5152 (progn
|
|
|
5153 (efs-set-files
|
|
|
5154 file
|
|
|
5155 (efs-parse-listing listing-type host user path
|
|
|
5156 file lsargs))
|
|
|
5157 ;; Parsing may update the host type.
|
|
|
5158 (and lsargs (memq (efs-host-type host)
|
|
|
5159 efs-dumb-host-types)
|
|
|
5160 (setq lsargs nil))))
|
|
|
5161 (let ((listing (buffer-string)))
|
|
|
5162 (efs-add-to-ls-cache file lsargs listing parse)
|
|
|
5163 (if (and (null lsargs) switches)
|
|
|
5164 ;; Try to convert
|
|
|
5165 (let ((conv (efs-get-ls-converter switches)))
|
|
|
5166 (and conv
|
|
|
5167 (setq conv (assoc
|
|
|
5168 (char-to-string 0)
|
|
|
5169 conv))
|
|
|
5170 (funcall (cdr conv) listing-type nil)
|
|
|
5171 (setq listing (buffer-string)))))
|
|
|
5172 (or nowait (setq listing-result listing))
|
|
|
5173 ;; Call the ls cont, with first arg the
|
|
|
5174 ;; listing string.
|
|
|
5175 (if cont
|
|
|
5176 (efs-call-cont cont listing)))))
|
|
|
5177 (efs-del-tmp-name temp-file)))
|
|
|
5178 nowait)
|
|
|
5179 (and (null nowait) listing-result))))
|
|
|
5180 (error "Attempt to get a remote listing for the local file %s" file))))
|
|
|
5181
|
|
|
5182
|
|
|
5183 ;;;; ===============================================================
|
|
|
5184 ;;;; >7
|
|
|
5185 ;;;; Parsing and storing remote file system data.
|
|
|
5186 ;;;; ===============================================================
|
|
|
5187
|
|
|
5188 ;;; The directory listing parsers do some host type guessing.
|
|
|
5189 ;;; Most of the host type guessing is done when the PWD output
|
|
|
5190 ;;; is parsed. A bit is done when the error codes for DIR are
|
|
|
5191 ;;; analyzed.
|
|
|
5192
|
|
|
5193 ;;;; -----------------------------------------------------------
|
|
|
5194 ;;;; Caching directory listings.
|
|
|
5195 ;;;; -----------------------------------------------------------
|
|
|
5196
|
|
|
5197 ;;; Aside from storing files data in a hashtable, a limited number
|
|
|
5198 ;;; of listings are stored in complete form in `efs-ls-cache'.
|
|
|
5199
|
|
|
5200 (defun efs-del-from-ls-cache (file &optional parent-p dir-p)
|
|
|
5201 ;; Deletes from the ls cache the listing for FILE.
|
|
|
5202 ;; With optional PARENT-P, deletes any entry for the parent
|
|
|
5203 ;; directory of FILE too.
|
|
|
5204 ;; If DIR-P is non-nil, then the directory listing of FILE is to be deleted.
|
|
|
5205 (if dir-p
|
|
|
5206 (setq file (file-name-as-directory file))
|
|
|
5207 (setq file (directory-file-name file)))
|
|
|
5208 (setq file (efs-canonize-file-name file))
|
|
|
5209 (if parent-p
|
|
|
5210 (setq parent-p (file-name-directory
|
|
|
5211 (if dir-p
|
|
|
5212 (directory-file-name file)
|
|
|
5213 file))))
|
|
|
5214 (setq efs-ls-cache
|
|
|
5215 (delq nil
|
|
|
5216 (mapcar
|
|
|
5217 (if parent-p
|
|
|
5218 (function
|
|
|
5219 (lambda (x)
|
|
|
5220 (let ((f-ent (car x)))
|
|
|
5221 (and (not (string-equal file f-ent))
|
|
|
5222 (not (string-equal parent-p f-ent))
|
|
|
5223 x))))
|
|
|
5224 (function
|
|
|
5225 (lambda (x)
|
|
|
5226 (and (not (string-equal file (car x)))
|
|
|
5227 x))))
|
|
|
5228 efs-ls-cache))))
|
|
|
5229
|
|
|
5230 (defun efs-wipe-from-ls-cache (host user)
|
|
|
5231 ;; Remove from efs-ls-cache all listings for HOST and USER.
|
|
|
5232 (let ((host (downcase host))
|
|
|
5233 (case-insens (memq (efs-host-type host)
|
|
|
5234 efs-case-insensitive-host-types)))
|
|
|
5235 (if case-insens (setq user (downcase user)))
|
|
|
5236 (setq efs-ls-cache
|
|
|
5237 (delq nil
|
|
|
5238 (mapcar
|
|
|
5239 (function
|
|
|
5240 (lambda (x)
|
|
|
5241 (let ((parsed (efs-ftp-path (car x))))
|
|
|
5242 (and (not
|
|
|
5243 (and (string-equal (car parsed) host)
|
|
|
5244 (string-equal (if case-insens
|
|
|
5245 (downcase (nth 1 parsed))
|
|
|
5246 (nth 1 parsed))
|
|
|
5247 user)))
|
|
|
5248 x))))
|
|
|
5249 efs-ls-cache)))))
|
|
|
5250
|
|
|
5251 (defun efs-get-from-ls-cache (file switches)
|
|
|
5252 ;; Returns the value in `ls-cache' for FILE and SWITCHES.
|
|
|
5253 ;; Returns a list consisting of the listing string, and whether its
|
|
|
5254 ;; already been parsed. This list is eq to the nthcdr 2 of the actual
|
|
|
5255 ;; cache entry, so you can setcar it.
|
|
|
5256 ;; For dumb listings, SWITCHES will be nil.
|
|
|
5257 (let ((list efs-ls-cache)
|
|
|
5258 (switches (efs-canonize-switches switches))
|
|
|
5259 (file (efs-canonize-file-name file)))
|
|
|
5260 (catch 'done
|
|
|
5261 (while list
|
|
|
5262 (if (and (string-equal file (car (car list)))
|
|
|
5263 (string-equal switches (nth 1 (car list))))
|
|
|
5264 (throw 'done (nthcdr 2 (car list)))
|
|
|
5265 (setq list (cdr list)))))))
|
|
|
5266
|
|
|
5267 (defun efs-add-to-ls-cache (file switches listing parsed)
|
|
|
5268 ;; Only call after efs-get-from-cache returns nil, to avoid duplicate
|
|
|
5269 ;; entries. PARSED should be t, if the listing has already been parsed.
|
|
|
5270 (and (> efs-ls-cache-max 0)
|
|
|
5271 (let ((switches (efs-canonize-switches switches))
|
|
|
5272 (file (efs-canonize-file-name file)))
|
|
|
5273 (if (= efs-ls-cache-max 1)
|
|
|
5274 (setq efs-ls-cache
|
|
|
5275 (list (list file switches listing parsed)))
|
|
|
5276 (if (>= (length efs-ls-cache) efs-ls-cache-max)
|
|
|
5277 (setcdr (nthcdr (- efs-ls-cache-max 2) efs-ls-cache) nil))
|
|
|
5278 (setq efs-ls-cache (cons (list file switches listing parsed)
|
|
|
5279 efs-ls-cache))))))
|
|
|
5280
|
|
|
5281 ;;;; --------------------------------------------------------------
|
|
|
5282 ;;;; Converting listings from cache.
|
|
|
5283 ;;;; --------------------------------------------------------------
|
|
|
5284
|
|
|
5285 (defun efs-get-ls-converter (to-switches)
|
|
|
5286 ;; Returns converter alist for TO-SWITCHES
|
|
|
5287 (efs-get-hash-entry (efs-canonize-switches to-switches)
|
|
|
5288 efs-ls-converter-hashtable))
|
|
|
5289
|
|
|
5290 (defun efs-add-ls-converter (to-switches from-switches converter)
|
|
|
5291 ;; Adds an entry to `efs-ls-converter-hashtable'.
|
|
|
5292 ;; If from-switches is t, the converter converts from internal files
|
|
|
5293 ;; hashtable.
|
|
|
5294 (let* ((to-switches (efs-canonize-switches to-switches))
|
|
|
5295 (ent (efs-get-hash-entry to-switches efs-ls-converter-hashtable))
|
|
|
5296 (add (cons (or (eq from-switches t)
|
|
|
5297 (efs-canonize-switches from-switches))
|
|
|
5298 converter)))
|
|
|
5299 (if ent
|
|
|
5300 (or (member add ent)
|
|
|
5301 (nconc ent (list add)))
|
|
|
5302 (efs-put-hash-entry to-switches (list add) efs-ls-converter-hashtable))))
|
|
|
5303
|
|
|
5304 (defun efs-convert-from-ls-cache (file switches host-type listing-type)
|
|
|
5305 ;; Returns a listing by converting the switches from a cached listing.
|
|
|
5306 (let ((clist (efs-get-ls-converter switches))
|
|
|
5307 (dir-p (= ?/ (aref file (1- (length file)))))
|
|
|
5308 elt listing result regexp alist)
|
|
|
5309 (while file ; this loop will iterate at most twice.
|
|
|
5310 (setq alist clist)
|
|
|
5311 (while alist
|
|
|
5312 (setq elt (car alist))
|
|
|
5313 (if (eq (car elt) t)
|
|
|
5314 (if (and dir-p (setq result (funcall (cdr elt) host-type
|
|
|
5315 (let ((efs-ls-uncache t))
|
|
|
5316 (efs-get-files file))
|
|
|
5317 regexp)))
|
|
|
5318 (setq alist nil
|
|
|
5319 file nil)
|
|
|
5320 (setq alist (cdr alist)))
|
|
|
5321 (if (and (setq listing
|
|
|
5322 (efs-get-from-ls-cache file (car elt)))
|
|
|
5323 (save-excursion
|
|
|
5324 (set-buffer
|
|
|
5325 (let ((default-major-mode 'fundamental-mode))
|
|
|
5326 (get-buffer-create efs-data-buffer-name)))
|
|
|
5327 (erase-buffer)
|
|
|
5328 (insert (car listing))
|
|
|
5329 (and (funcall (cdr elt) listing-type regexp)
|
|
|
5330 (setq result (buffer-string)))))
|
|
|
5331 (setq alist nil
|
|
|
5332 file nil)
|
|
|
5333 (setq alist (cdr alist)))))
|
|
|
5334 ;; Look for wildcards.
|
|
|
5335 (if (and file (null dir-p) (null regexp))
|
|
|
5336 (setq regexp (efs-shell-regexp-to-regexp
|
|
|
5337 (file-name-nondirectory file))
|
|
|
5338 file (file-name-directory file)
|
|
|
5339 dir-p t)
|
|
|
5340 (setq file nil)))
|
|
|
5341 result))
|
|
|
5342
|
|
|
5343 ;;; Define some converters
|
|
|
5344
|
|
|
5345 (defun efs-unix-t-converter-sort-pred (elt1 elt2)
|
|
|
5346 (let* ((data1 (car elt1))
|
|
|
5347 (data2 (car elt2))
|
|
|
5348 (year1 (car data1))
|
|
|
5349 (year2 (car data2))
|
|
|
5350 (month1 (nth 1 data1))
|
|
|
5351 (month2 (nth 1 data2))
|
|
|
5352 (day1 (nth 2 data1))
|
|
|
5353 (day2 (nth 2 data2))
|
|
|
5354 (hour1 (nth 3 data1))
|
|
|
5355 (hour2 (nth 3 data2))
|
|
|
5356 (minutes1 (nth 4 data1))
|
|
|
5357 (minutes2 (nth 4 data2)))
|
|
|
5358 (if year1
|
|
|
5359 (and year2
|
|
|
5360 (or (> year1 year2)
|
|
|
5361 (and (= year1 year2)
|
|
|
5362 (or (> month1 month2)
|
|
|
5363 (and (= month1 month2)
|
|
|
5364 (> day1 day2))))))
|
|
|
5365 (if year2
|
|
|
5366 t
|
|
|
5367 (or (> month1 month2)
|
|
|
5368 (and (= month1 month2)
|
|
|
5369 (or (> day1 day2)
|
|
|
5370 (and (= day1 day2)
|
|
|
5371 (or (> hour1 hour2)
|
|
|
5372 (and (= hour1 hour2)
|
|
|
5373 (> minutes1 minutes2)))))))))))
|
|
|
5374
|
|
|
5375 (defun efs-unix-t-converter (&optional regexp reverse)
|
|
|
5376 (if regexp
|
|
|
5377 nil
|
|
|
5378 (goto-char (point-min))
|
|
|
5379 (efs-save-match-data
|
|
|
5380 (if (re-search-forward efs-month-and-time-regexp nil t)
|
|
|
5381 (let ((current-month (cdr (assoc (substring
|
|
|
5382 (current-time-string) 4 7)
|
|
|
5383 efs-month-alist)))
|
|
|
5384 list-start start end list year month day hour minutes)
|
|
|
5385 (beginning-of-line)
|
|
|
5386 (setq list-start (point))
|
|
|
5387 (while (progn
|
|
|
5388 (setq start (point))
|
|
|
5389 (forward-line 1)
|
|
|
5390 (setq end (point))
|
|
|
5391 (goto-char start)
|
|
|
5392 (re-search-forward efs-month-and-time-regexp end t))
|
|
|
5393 ;; Need to measure wrto the current month
|
|
|
5394 ;; There is a bug here if because of time-zone shifts, the
|
|
|
5395 ;; local machine and the remote one are on different months.
|
|
|
5396 (setq month (% (+ (- 11 current-month)
|
|
|
5397 (cdr (assoc
|
|
|
5398 (buffer-substring (match-beginning 2)
|
|
|
5399 (match-end 2))
|
|
|
5400 efs-month-alist))) 12)
|
|
|
5401 day (string-to-int
|
|
|
5402 (buffer-substring (match-beginning 3) (match-end 3)))
|
|
|
5403 year (buffer-substring (match-beginning 4) (match-end 4)))
|
|
|
5404 (if (string-match ":" year)
|
|
|
5405 (setq hour (string-to-int (substring year 0
|
|
|
5406 (match-beginning 0)))
|
|
|
5407 minutes (string-to-int (substring year (match-end 0)))
|
|
|
5408 year nil)
|
|
|
5409 (setq hour nil
|
|
|
5410 minutes nil
|
|
|
5411 year (string-to-int year)))
|
|
|
5412 (setq list (cons
|
|
|
5413 (cons
|
|
|
5414 (list year month day hour minutes)
|
|
|
5415 (buffer-substring start end))
|
|
|
5416 list))
|
|
|
5417 (goto-char end))
|
|
|
5418 (setq list
|
|
|
5419 (mapcar 'cdr
|
|
|
5420 (sort list 'efs-unix-t-converter-sort-pred)))
|
|
|
5421 (if reverse (setq list (nreverse list)))
|
|
|
5422 (delete-region list-start (point))
|
|
|
5423 (apply 'insert list)
|
|
|
5424 t)))))
|
|
|
5425
|
|
|
5426 (efs-defun efs-t-converter nil (&optional regexp reverse)
|
|
|
5427 ;; Converts listing without the t-switch, to ones with it.
|
|
|
5428 nil) ; by default assume that we cannot work.
|
|
|
5429
|
|
|
5430 (efs-fset 'efs-t-converter 'unix 'efs-unix-t-converter)
|
|
|
5431 (efs-fset 'efs-t-converter 'sysV-unix 'efs-unix-t-converter)
|
|
|
5432 (efs-fset 'efs-t-converter 'apollo-unix 'efs-unix-t-converter)
|
|
|
5433 (efs-fset 'efs-t-converter 'bsd-unix 'efs-unix-t-converter)
|
|
|
5434 (efs-fset 'efs-t-converter 'dumb-unix 'efs-unix-t-converter)
|
|
|
5435 (efs-fset 'efs-t-converter 'dumb-apollo-unix 'efs-unix-t-converter)
|
|
|
5436 (efs-fset 'efs-t-converter 'super-dumb-unix 'efs-unix-t-converter)
|
|
|
5437
|
|
|
5438 (defun efs-rt-converter (listing-type &optional regexp)
|
|
|
5439 ;; Reverse time sorting
|
|
|
5440 (efs-t-converter listing-type regexp t))
|
|
|
5441
|
|
|
5442 (defun efs-unix-alpha-converter (&optional regexp reverse)
|
|
|
5443 (if regexp
|
|
|
5444 nil
|
|
|
5445 (goto-char (point-min))
|
|
|
5446 (efs-save-match-data
|
|
|
5447 (if (re-search-forward efs-month-and-time-regexp nil t)
|
|
|
5448 (let (list list-start end start next)
|
|
|
5449 (beginning-of-line)
|
|
|
5450 (setq list-start (point))
|
|
|
5451 (while (progn
|
|
|
5452 (setq start (point))
|
|
|
5453 (end-of-line)
|
|
|
5454 (setq end (point)
|
|
|
5455 next (1+ end))
|
|
|
5456 (goto-char start)
|
|
|
5457 (re-search-forward efs-month-and-time-regexp end t))
|
|
|
5458 ;; Need to measure wrto the current month
|
|
|
5459 ;; There is a bug here if because of time-zone shifts, the
|
|
|
5460 ;; local machine and the remote one are on different months.
|
|
|
5461 (setq list
|
|
|
5462 (cons
|
|
|
5463 (cons (buffer-substring (point) end)
|
|
|
5464 (buffer-substring start next))
|
|
|
5465 list))
|
|
|
5466 (goto-char next))
|
|
|
5467 (delete-region list-start (point))
|
|
|
5468 (apply 'insert
|
|
|
5469 (mapcar 'cdr
|
|
|
5470 (sort list (if reverse
|
|
|
5471 (function
|
|
|
5472 (lambda (x y)
|
|
|
5473 (string< (car y) (car x))))
|
|
|
5474 (function
|
|
|
5475 (lambda (x y)
|
|
|
5476 (string< (car x) (car y))))))))
|
|
|
5477 t)))))
|
|
|
5478
|
|
|
5479 (efs-defun efs-alpha-converter nil (&optional regexp reverse)
|
|
|
5480 ;; Converts listing to lexigraphical order.
|
|
|
5481 nil) ; by default assume that we cannot work.
|
|
|
5482
|
|
|
5483 (efs-fset 'efs-alpha-converter 'unix 'efs-unix-alpha-converter)
|
|
|
5484 (efs-fset 'efs-alpha-converter 'sysV-unix 'efs-unix-alpha-converter)
|
|
|
5485 (efs-fset 'efs-alpha-converter 'apollo-unix 'efs-unix-alpha-converter)
|
|
|
5486 (efs-fset 'efs-alpha-converter 'bsd-unix 'efs-unix-alpha-converter)
|
|
|
5487 (efs-fset 'efs-alpha-converter 'dumb-unix 'efs-unix-alpha-converter)
|
|
|
5488 (efs-fset 'efs-alpha-converter 'dumb-apollo-unix 'efs-unix-alpha-converter)
|
|
|
5489 (efs-fset 'efs-alpha-converter 'super-dumb-unix 'efs-unix-alpha-converter)
|
|
|
5490
|
|
|
5491 (defun efs-ralpha-converter (listing-type &optional regexp)
|
|
|
5492 ;; Reverse alphabetic
|
|
|
5493 (efs-alpha-converter listing-type regexp t))
|
|
|
5494
|
|
|
5495 (defun efs-unix-S-converter (&optional regexp reverse)
|
|
|
5496 (if regexp
|
|
|
5497 nil
|
|
|
5498 (goto-char (point-min))
|
|
|
5499 (efs-save-match-data
|
|
|
5500 (if (re-search-forward efs-month-and-time-regexp nil t)
|
|
|
5501 (let (list list-start start next)
|
|
|
5502 (beginning-of-line)
|
|
|
5503 (setq list-start (point))
|
|
|
5504 (while (progn
|
|
|
5505 (setq start (point))
|
|
|
5506 (forward-line 1)
|
|
|
5507 (setq next (point))
|
|
|
5508 (goto-char start)
|
|
|
5509 (re-search-forward efs-month-and-time-regexp next t))
|
|
|
5510 ;; Need to measure wrto the current month
|
|
|
5511 ;; There is a bug here if because of time-zone shifts, the
|
|
|
5512 ;; local machine and the remote one are on different months.
|
|
|
5513 (setq list
|
|
|
5514 (cons
|
|
|
5515 (cons (string-to-int
|
|
|
5516 (buffer-substring (match-beginning 1)
|
|
|
5517 (match-end 1)))
|
|
|
5518 (buffer-substring start next))
|
|
|
5519 list))
|
|
|
5520 (goto-char next))
|
|
|
5521 (delete-region list-start (point))
|
|
|
5522 (apply 'insert
|
|
|
5523 (mapcar 'cdr
|
|
|
5524 (sort list (if reverse
|
|
|
5525 (function
|
|
|
5526 (lambda (x y)
|
|
|
5527 (< (car x) (car y))))
|
|
|
5528 (function
|
|
|
5529 (lambda (x y)
|
|
|
5530 (> (car x) (car y))))))))
|
|
|
5531 t)))))
|
|
|
5532
|
|
|
5533 (efs-defun efs-S-converter nil (&optional regexp reverse)
|
|
|
5534 ;; Converts listing without the S-switch, to ones with it.
|
|
|
5535 nil) ; by default assume that we cannot work.
|
|
|
5536
|
|
|
5537 (efs-fset 'efs-S-converter 'unix 'efs-unix-S-converter)
|
|
|
5538 (efs-fset 'efs-S-converter 'sysV-unix 'efs-unix-S-converter)
|
|
|
5539 (efs-fset 'efs-S-converter 'apollo-unix 'efs-unix-S-converter)
|
|
|
5540 (efs-fset 'efs-S-converter 'bsd-unix 'efs-unix-S-converter)
|
|
|
5541 (efs-fset 'efs-S-converter 'dumb-unix 'efs-unix-S-converter)
|
|
|
5542 (efs-fset 'efs-S-converter 'dumb-apollo-unix 'efs-unix-S-converter)
|
|
|
5543 (efs-fset 'efs-S-converter 'super-dumb-unix 'efs-unix-S-converter)
|
|
|
5544
|
|
|
5545 (defun efs-rS-converter (listing-type &optional regexp)
|
|
|
5546 ;; Reverse S switch.
|
|
|
5547 (efs-S-converter listing-type regexp t))
|
|
|
5548
|
|
|
5549 (defun efs-unix-X-converter (&optional regexp reverse)
|
|
|
5550 (if regexp
|
|
|
5551 nil
|
|
|
5552 (goto-char (point-min))
|
|
|
5553 (efs-save-match-data
|
|
|
5554 (if (re-search-forward efs-month-and-time-regexp nil t)
|
|
|
5555 (let (next list list-start fnstart eol start end link-p)
|
|
|
5556 (beginning-of-line)
|
|
|
5557 (setq list-start (point))
|
|
|
5558 (while (progn
|
|
|
5559 (setq start (point))
|
|
|
5560 (skip-chars-forward "0-9 ")
|
|
|
5561 (setq link-p (= (following-char) ?l))
|
|
|
5562 (end-of-line)
|
|
|
5563 (setq eol (point)
|
|
|
5564 next (1+ eol))
|
|
|
5565 (goto-char start)
|
|
|
5566 (re-search-forward efs-month-and-time-regexp eol t))
|
|
|
5567 ;; Need to measure wrto the current month
|
|
|
5568 ;; There is a bug here if because of time-zone shifts, the
|
|
|
5569 ;; local machine and the remote one are on different months.
|
|
|
5570 (setq fnstart (point))
|
|
|
5571 (or (and link-p (search-forward " -> " eol t)
|
|
|
5572 (goto-char (match-beginning 0)))
|
|
|
5573 (goto-char eol))
|
|
|
5574 (setq end (point))
|
|
|
5575 (skip-chars-backward "^." fnstart)
|
|
|
5576 (setq list
|
|
|
5577 (cons
|
|
|
5578 (cons
|
|
|
5579 (if (= (point) fnstart)
|
|
|
5580 ""
|
|
|
5581 (buffer-substring (point) end))
|
|
|
5582 (buffer-substring start next))
|
|
|
5583 list))
|
|
|
5584 (goto-char next))
|
|
|
5585 (delete-region list-start (point))
|
|
|
5586 (apply 'insert
|
|
|
5587 (mapcar 'cdr
|
|
|
5588 (sort list (if reverse
|
|
|
5589 (function
|
|
|
5590 (lambda (x y)
|
|
|
5591 (string< (car y) (car x))))
|
|
|
5592 (function
|
|
|
5593 (lambda (x y)
|
|
|
5594 (string< (car x) (car y))))))))
|
|
|
5595 t)))))
|
|
|
5596
|
|
|
5597 (efs-defun efs-X-converter nil (&optional regexp reverse)
|
|
|
5598 ;; Sort on file name extension. By default do nothing
|
|
|
5599 nil)
|
|
|
5600
|
|
|
5601 (defun efs-rX-converter (listing-type &optional regexp)
|
|
|
5602 (efs-X-converter listing-type regexp t))
|
|
|
5603
|
|
|
5604 (efs-fset 'efs-X-converter 'unix 'efs-unix-X-converter)
|
|
|
5605 (efs-fset 'efs-X-converter 'sysV-unix 'efs-unix-X-converter)
|
|
|
5606 (efs-fset 'efs-X-converter 'apollo-unix 'efs-unix-X-converter)
|
|
|
5607 (efs-fset 'efs-X-converter 'bsd-unix 'efs-unix-X-converter)
|
|
|
5608 (efs-fset 'efs-X-converter 'dumb-unix 'efs-unix-X-converter)
|
|
|
5609 (efs-fset 'efs-X-converter 'dumb-apollo-unix 'efs-unix-X-converter)
|
|
|
5610 (efs-fset 'efs-X-converter 'super-dumb-unix 'efs-unix-X-converter)
|
|
|
5611
|
|
|
5612 ;;; Brief listings
|
|
|
5613
|
|
|
5614 ;;; The following functions do a heap better at packing than
|
|
|
5615 ;;; the usual ls listing. A variable column width is used.
|
|
|
5616 (defun efs-column-widths (columns list &optional across)
|
|
|
5617 ;; Returns the column widths for breaking LIST into
|
|
|
5618 ;; COLUMNS number of columns.
|
|
|
5619 (cond
|
|
|
5620 ((null list)
|
|
|
5621 nil)
|
|
|
5622 ((= columns 1)
|
|
|
5623 (list (apply 'max (mapcar 'length list))))
|
|
|
5624 ((let* ((len (length list))
|
|
|
5625 (col-length (/ len columns))
|
|
|
5626 (remainder (% len columns))
|
|
|
5627 (i 0)
|
|
|
5628 (j 0)
|
|
|
5629 (max-width 0)
|
|
|
5630 widths padding)
|
|
|
5631 (if (zerop remainder)
|
|
|
5632 (setq padding 0)
|
|
|
5633 (setq col-length (1+ col-length)
|
|
|
5634 padding (- columns remainder)))
|
|
|
5635 (setq list (nconc (copy-sequence list) (make-list padding nil)))
|
|
|
5636 (setcdr (nthcdr (1- (+ len padding)) list) list)
|
|
|
5637 (while (< i columns)
|
|
|
5638 (while (< j col-length)
|
|
|
5639 (setq max-width (max max-width (length (car list)))
|
|
|
5640 list (if across (nthcdr columns list) (cdr list))
|
|
|
5641 j (1+ j)))
|
|
|
5642 (setq widths (cons (+ max-width 2) widths)
|
|
|
5643 max-width 0
|
|
|
5644 j 0
|
|
|
5645 i (1+ i))
|
|
|
5646 (if across (setq list (cdr list))))
|
|
|
5647 (setcar widths (- (car widths) 2))
|
|
|
5648 (nreverse widths)))))
|
|
|
5649
|
|
|
5650 (defun efs-calculate-columns (list &optional across)
|
|
|
5651 ;; Returns a list of integers which are the column widths that best pack
|
|
|
5652 ;; LIST, a list of strings, onto the screen.
|
|
|
5653 (and list
|
|
|
5654 (let* ((width (1- (window-width)))
|
|
|
5655 (columns (max 1 (/ width
|
|
|
5656 (+ 2 (apply 'max (mapcar 'length list))))))
|
|
|
5657 col-list last-col-list)
|
|
|
5658 (while (<= (apply '+ (setq col-list
|
|
|
5659 (efs-column-widths columns list across)))
|
|
|
5660 width)
|
|
|
5661 (setq columns (1+ columns)
|
|
|
5662 last-col-list col-list))
|
|
|
5663 (or last-col-list col-list))))
|
|
|
5664
|
|
|
5665 (defun efs-format-columns-of-files (files &optional across)
|
|
|
5666 ;; Returns the number of lines used.
|
|
|
5667 ;; If ACROSS is non-nil, sorts across rather than down the buffer, like
|
|
|
5668 ;; ls -x
|
|
|
5669 ;; A beefed up version of the function in dired. Thanks Sebastian.
|
|
|
5670 (and files
|
|
|
5671 (let* ((columns (efs-calculate-columns files across))
|
|
|
5672 (ncols (length columns))
|
|
|
5673 (ncols1 (1- ncols))
|
|
|
5674 (nfiles (length files))
|
|
|
5675 (nrows (+ (/ nfiles ncols)
|
|
|
5676 (if (zerop (% nfiles ncols)) 0 1)))
|
|
|
5677 (space-left (- (window-width) (apply '+ columns) 1))
|
|
|
5678 (stretch (/ space-left ncols1))
|
|
|
5679 (float-stretch (if (zerop ncols1) 0 (% space-left ncols1)))
|
|
|
5680 (i 0)
|
|
|
5681 (j 0)
|
|
|
5682 (result "")
|
|
|
5683 file padding)
|
|
|
5684 (setq files (nconc (copy-sequence files) ; fill up with empty fns
|
|
|
5685 (make-list (- (* ncols nrows) nfiles) "")))
|
|
|
5686 (setcdr (nthcdr (1- (length files)) files) files) ; make circular
|
|
|
5687 (while (< j nrows)
|
|
|
5688 (while (< i ncols)
|
|
|
5689 (setq result (concat result (setq file (car files))))
|
|
|
5690 (setq padding (- (nth i columns) (length file)))
|
|
|
5691 (or (= i ncols1)
|
|
|
5692 (progn
|
|
|
5693 (setq padding (+ padding stretch))
|
|
|
5694 (if (< i float-stretch) (setq padding (1+ padding)))))
|
|
|
5695 (setq result (concat result (make-string padding ?\ )))
|
|
|
5696 (setq files (if across (cdr files) (nthcdr nrows files))
|
|
|
5697 i (1+ i)))
|
|
|
5698 (setq result (concat result "\n"))
|
|
|
5699 (setq i 0
|
|
|
5700 j (1+ j))
|
|
|
5701 (or across (setq files (cdr files))))
|
|
|
5702 result)))
|
|
|
5703
|
|
|
5704 (defun efs-brief-converter (host-type file-table F a A p x C &optional regexp)
|
|
|
5705 ;; Builds a brief directory listing for file cache, with
|
|
|
5706 ;; possible switches F, a, A, p, x.
|
|
|
5707 (efs-save-match-data
|
|
|
5708 (let (list ent modes)
|
|
|
5709 (efs-map-hashtable
|
|
|
5710 (function
|
|
|
5711 (lambda (key val)
|
|
|
5712 (if (and
|
|
|
5713 (efs-really-file-p host-type key val)
|
|
|
5714 (or a
|
|
|
5715 (and A (not (or (string-equal "." key)
|
|
|
5716 (string-equal ".." key))))
|
|
|
5717 (/= (string-to-char key) ?.))
|
|
|
5718 (or (null regexp)
|
|
|
5719 (string-match regexp key)))
|
|
|
5720 (setq ent (car val)
|
|
|
5721 modes (nth 3 val)
|
|
|
5722 list (cons
|
|
|
5723 (cond ((null (or F p))
|
|
|
5724 key)
|
|
|
5725 ((eq t ent)
|
|
|
5726 (concat key "/"))
|
|
|
5727 ((cond
|
|
|
5728 ((null F)
|
|
|
5729 key)
|
|
|
5730 ((stringp ent)
|
|
|
5731 (concat key "@"))
|
|
|
5732 ((null modes)
|
|
|
5733 key)
|
|
|
5734 ((eq (string-to-char modes) ?s)
|
|
|
5735 ;; a socket
|
|
|
5736 (concat key "="))
|
|
|
5737 ((or
|
|
|
5738 (memq (elt modes 3) '(?x ?s ?t))
|
|
|
5739 (memq (elt modes 6) '(?x ?s ?t))
|
|
|
5740 (memq (elt modes 9) '(?x ?s ?t)))
|
|
|
5741 (concat key "*"))
|
|
|
5742 (t
|
|
|
5743 key))))
|
|
|
5744 list)))))
|
|
|
5745 file-table)
|
|
|
5746 (setq list (sort list 'string<))
|
|
|
5747 (if (or C x)
|
|
|
5748 (efs-format-columns-of-files list x)
|
|
|
5749 (concat (mapconcat 'identity list "\n") "\n")))))
|
|
|
5750
|
|
|
5751 ;;; Store converters.
|
|
|
5752
|
|
|
5753 ;; The cheaters.
|
|
|
5754 (efs-add-ls-converter "-al" nil (function
|
|
|
5755 (lambda (listing-type &optional regexp)
|
|
|
5756 (null regexp))))
|
|
|
5757 (efs-add-ls-converter "-Al" nil (function
|
|
|
5758 (lambda (listing-type &optional regexp)
|
|
|
5759 (null regexp))))
|
|
|
5760 (efs-add-ls-converter "-alF" nil (function
|
|
|
5761 (lambda (listing-type &optional regexp)
|
|
|
5762 (null regexp))))
|
|
|
5763 (efs-add-ls-converter "-AlF" nil (function
|
|
|
5764 (lambda (listing-type &optional regexp)
|
|
|
5765 (null regexp))))
|
|
|
5766
|
|
|
5767 (efs-add-ls-converter "-alt" "-al" 'efs-t-converter)
|
|
|
5768 (efs-add-ls-converter "-Alt" "-Al" 'efs-t-converter)
|
|
|
5769 (efs-add-ls-converter "-lt" "-l" 'efs-t-converter)
|
|
|
5770 (efs-add-ls-converter "-altF" "-alF" 'efs-t-converter)
|
|
|
5771 (efs-add-ls-converter "-AltF" "-AlF" 'efs-t-converter)
|
|
|
5772 (efs-add-ls-converter "-ltF" "-lF" 'efs-t-converter)
|
|
|
5773 (efs-add-ls-converter "-alt" nil 'efs-t-converter)
|
|
|
5774 (efs-add-ls-converter "-altF" nil 'efs-t-converter)
|
|
|
5775 (efs-add-ls-converter "-Alt" nil 'efs-t-converter) ; cheating a bit
|
|
|
5776 (efs-add-ls-converter "-AltF" nil 'efs-t-converter) ; cheating a bit
|
|
|
5777
|
|
|
5778 (efs-add-ls-converter "-altr" "-al" 'efs-rt-converter)
|
|
|
5779 (efs-add-ls-converter "-Altr" "-Al" 'efs-rt-converter)
|
|
|
5780 (efs-add-ls-converter "-ltr" "-l" 'efs-rt-converter)
|
|
|
5781 (efs-add-ls-converter "-altFr" "-alF" 'efs-rt-converter)
|
|
|
5782 (efs-add-ls-converter "-AltFr" "-AlF" 'efs-rt-converter)
|
|
|
5783 (efs-add-ls-converter "-ltFr" "-lF" 'efs-rt-converter)
|
|
|
5784 (efs-add-ls-converter "-altr" nil 'efs-rt-converter)
|
|
|
5785 (efs-add-ls-converter "-Altr" nil 'efs-rt-converter)
|
|
|
5786
|
|
|
5787 (efs-add-ls-converter "-alr" "-alt" 'efs-alpha-converter)
|
|
|
5788 (efs-add-ls-converter "-Alr" "-Alt" 'efs-alpha-converter)
|
|
|
5789 (efs-add-ls-converter "-lr" "-lt" 'efs-alpha-converter)
|
|
|
5790 (efs-add-ls-converter "-alFr" "-alFt" 'efs-alpha-converter)
|
|
|
5791 (efs-add-ls-converter "-AlFr" "-AlFt" 'efs-alpha-converter)
|
|
|
5792 (efs-add-ls-converter "-lFr" "-lFt" 'efs-alpha-converter)
|
|
|
5793
|
|
|
5794 (efs-add-ls-converter "-al" "-alt" 'efs-alpha-converter)
|
|
|
5795 (efs-add-ls-converter "-Al" "-Alt" 'efs-alpha-converter)
|
|
|
5796 (efs-add-ls-converter "-l" "-lt" 'efs-alpha-converter)
|
|
|
5797 (efs-add-ls-converter "-alF" "-alFt" 'efs-alpha-converter)
|
|
|
5798 (efs-add-ls-converter "-AlF" "-AlFt" 'efs-alpha-converter)
|
|
|
5799 (efs-add-ls-converter "-lF" "-lFt" 'efs-alpha-converter)
|
|
|
5800 (efs-add-ls-converter nil "-alt" 'efs-alpha-converter)
|
|
|
5801
|
|
|
5802 (efs-add-ls-converter "-alr" "-al" 'efs-ralpha-converter)
|
|
|
5803 (efs-add-ls-converter "-Alr" "-Al" 'efs-ralpha-converter)
|
|
|
5804 (efs-add-ls-converter "-lr" "-l" 'efs-ralpha-converter)
|
|
|
5805 (efs-add-ls-converter "-alFr" "-alF" 'efs-ralpha-converter)
|
|
|
5806 (efs-add-ls-converter "-lAFr" "-lAF" 'efs-ralpha-converter)
|
|
|
5807 (efs-add-ls-converter "-lFr" "-lF" 'efs-ralpha-converter)
|
|
|
5808 (efs-add-ls-converter "-alr" nil 'efs-ralpha-converter)
|
|
|
5809
|
|
|
5810 (efs-add-ls-converter "-alr" "-alt" 'efs-ralpha-converter)
|
|
|
5811 (efs-add-ls-converter "-Alr" "-Alt" 'efs-ralpha-converter)
|
|
|
5812 (efs-add-ls-converter "-lr" "-lt" 'efs-ralpha-converter)
|
|
|
5813 (efs-add-ls-converter "-alFr" "-alFt" 'efs-ralpha-converter)
|
|
|
5814 (efs-add-ls-converter "-lAFr" "-lAFt" 'efs-ralpha-converter)
|
|
|
5815 (efs-add-ls-converter "-lFr" "-lFt" 'efs-ralpha-converter)
|
|
|
5816
|
|
|
5817 (efs-add-ls-converter "-alS" "-al" 'efs-S-converter)
|
|
|
5818 (efs-add-ls-converter "-AlS" "-Al" 'efs-S-converter)
|
|
|
5819 (efs-add-ls-converter "-lS" "-l" 'efs-S-converter)
|
|
|
5820 (efs-add-ls-converter "-alSF" "-alF" 'efs-S-converter)
|
|
|
5821 (efs-add-ls-converter "-AlSF" "-AlF" 'efs-S-converter)
|
|
|
5822 (efs-add-ls-converter "-lSF" "-lF" 'efs-S-converter)
|
|
|
5823 (efs-add-ls-converter "-alS" nil 'efs-S-converter)
|
|
|
5824
|
|
|
5825 (efs-add-ls-converter "-alSr" "-al" 'efs-rS-converter)
|
|
|
5826 (efs-add-ls-converter "-AlSr" "-Al" 'efs-rS-converter)
|
|
|
5827 (efs-add-ls-converter "-lSr" "-l" 'efs-rS-converter)
|
|
|
5828 (efs-add-ls-converter "-alSFr" "-alF" 'efs-rS-converter)
|
|
|
5829 (efs-add-ls-converter "-AlSFr" "-AlF" 'efs-rS-converter)
|
|
|
5830 (efs-add-ls-converter "-lSFr" "-lF" 'efs-rS-converter)
|
|
|
5831 (efs-add-ls-converter "-alSr" nil 'efs-rS-converter)
|
|
|
5832
|
|
|
5833 (efs-add-ls-converter "-alS" "-alt" 'efs-S-converter)
|
|
|
5834 (efs-add-ls-converter "-AlS" "-Alt" 'efs-S-converter)
|
|
|
5835 (efs-add-ls-converter "-lS" "-lt" 'efs-S-converter)
|
|
|
5836 (efs-add-ls-converter "-alSF" "-alFt" 'efs-S-converter)
|
|
|
5837 (efs-add-ls-converter "-AlSF" "-AlFt" 'efs-S-converter)
|
|
|
5838 (efs-add-ls-converter "-lSF" "-lFt" 'efs-S-converter)
|
|
|
5839
|
|
|
5840 (efs-add-ls-converter "-alSr" "-alt" 'efs-rS-converter)
|
|
|
5841 (efs-add-ls-converter "-AlSr" "-Alt" 'efs-rS-converter)
|
|
|
5842 (efs-add-ls-converter "-lSr" "-lt" 'efs-rS-converter)
|
|
|
5843 (efs-add-ls-converter "-alSFr" "-alFt" 'efs-rS-converter)
|
|
|
5844 (efs-add-ls-converter "-AlSFr" "-AlFt" 'efs-rS-converter)
|
|
|
5845 (efs-add-ls-converter "-lSFr" "-lFt" 'efs-rS-converter)
|
|
|
5846
|
|
|
5847 (efs-add-ls-converter "-AlX" nil 'efs-X-converter)
|
|
|
5848 (efs-add-ls-converter "-alX" nil 'efs-X-converter)
|
|
|
5849 (efs-add-ls-converter "-AlXr" nil 'efs-rX-converter)
|
|
|
5850 (efs-add-ls-converter "-alXr" nil 'efs-rX-converter)
|
|
|
5851
|
|
|
5852 (efs-add-ls-converter "-alX" "-al" 'efs-X-converter)
|
|
|
5853 (efs-add-ls-converter "-AlX" "-Al" 'efs-X-converter)
|
|
|
5854 (efs-add-ls-converter "-lX" "-l" 'efs-X-converter)
|
|
|
5855 (efs-add-ls-converter "-alXF" "-alF" 'efs-X-converter)
|
|
|
5856 (efs-add-ls-converter "-AlXF" "-AlF" 'efs-X-converter)
|
|
|
5857 (efs-add-ls-converter "-lXF" "-lF" 'efs-X-converter)
|
|
|
5858
|
|
|
5859 (efs-add-ls-converter "-alXr" "-al" 'efs-rX-converter)
|
|
|
5860 (efs-add-ls-converter "-AlXr" "-Al" 'efs-rX-converter)
|
|
|
5861 (efs-add-ls-converter "-lXr" "-l" 'efs-rX-converter)
|
|
|
5862 (efs-add-ls-converter "-alXFr" "-alF" 'efs-rX-converter)
|
|
|
5863 (efs-add-ls-converter "-AlXFr" "-AlF" 'efs-rX-converter)
|
|
|
5864 (efs-add-ls-converter "-lXFr" "-lF" 'efs-rX-converter)
|
|
|
5865
|
|
|
5866 ;;; Converters for efs-files-hashtable
|
|
|
5867
|
|
|
5868 (efs-add-ls-converter
|
|
|
5869 "" t (function
|
|
|
5870 (lambda (host-type files &optional regexp)
|
|
|
5871 (efs-brief-converter host-type files
|
|
|
5872 nil nil nil nil nil nil regexp))))
|
|
|
5873 (efs-add-ls-converter
|
|
|
5874 "-C" t (function
|
|
|
5875 (lambda (host-type files &optional regexp)
|
|
|
5876 (efs-brief-converter host-type files
|
|
|
5877 nil nil nil nil nil t regexp))))
|
|
|
5878 (efs-add-ls-converter
|
|
|
5879 "-F" t (function
|
|
|
5880 (lambda (host-type files &optional regexp)
|
|
|
5881 (efs-brief-converter host-type files
|
|
|
5882 t nil nil nil nil nil regexp))))
|
|
|
5883 (efs-add-ls-converter
|
|
|
5884 "-p" t (function
|
|
|
5885 (lambda (host-type files &optional regexp)
|
|
|
5886 (efs-brief-converter host-type files
|
|
|
5887 nil nil nil t nil nil regexp))))
|
|
|
5888 (efs-add-ls-converter
|
|
|
5889 "-CF" t (function
|
|
|
5890 (lambda (host-type files &optional regexp)
|
|
|
5891 (efs-brief-converter host-type files
|
|
|
5892 t nil nil nil nil t regexp))))
|
|
|
5893 (efs-add-ls-converter
|
|
|
5894 "-Cp" t (function
|
|
|
5895 (lambda (host-type files &optional regexp)
|
|
|
5896 (efs-brief-converter host-type files nil nil nil t nil t regexp))))
|
|
|
5897 (efs-add-ls-converter
|
|
|
5898 "-x" t (function
|
|
|
5899 (lambda (host-type files &optional regexp)
|
|
|
5900 (efs-brief-converter host-type files
|
|
|
5901 nil nil nil nil t nil regexp))))
|
|
|
5902 (efs-add-ls-converter
|
|
|
5903 "-xF" t (function
|
|
|
5904 (lambda (host-type files &optional regexp)
|
|
|
5905 (efs-brief-converter host-type files t nil nil nil t nil regexp))))
|
|
|
5906 (efs-add-ls-converter
|
|
|
5907 "-xp" t (function
|
|
|
5908 (lambda (host-type files &optional regexp)
|
|
|
5909 (efs-brief-converter host-type files nil nil nil t t nil regexp))))
|
|
|
5910 (efs-add-ls-converter
|
|
|
5911 "-Ca" t (function
|
|
|
5912 (lambda (host-type files &optional regexp)
|
|
|
5913 (efs-brief-converter host-type files nil t nil nil nil t regexp))))
|
|
|
5914 (efs-add-ls-converter
|
|
|
5915 "-CFa" t (function
|
|
|
5916 (lambda (host-type files &optional regexp)
|
|
|
5917 (efs-brief-converter host-type files t t nil nil nil t regexp))))
|
|
|
5918 (efs-add-ls-converter
|
|
|
5919 "-Cpa" t (function
|
|
|
5920 (lambda (host-type files &optional regexp)
|
|
|
5921 (efs-brief-converter host-type files nil t nil t nil t regexp))))
|
|
|
5922 (efs-add-ls-converter
|
|
|
5923 "-xa" t (function
|
|
|
5924 (lambda (host-type files &optional regexp)
|
|
|
5925 (efs-brief-converter host-type files nil t nil nil t nil regexp))))
|
|
|
5926 (efs-add-ls-converter
|
|
|
5927 "-xFa" t (function
|
|
|
5928 (lambda (host-type files &optional regexp)
|
|
|
5929 (efs-brief-converter host-type files t t nil nil t nil regexp))))
|
|
|
5930 (efs-add-ls-converter
|
|
|
5931 "-xpa" t (function
|
|
|
5932 (lambda (host-type files &optional regexp)
|
|
|
5933 (efs-brief-converter host-type files nil t nil t t nil regexp))))
|
|
|
5934 (efs-add-ls-converter
|
|
|
5935 "-CA" t (function
|
|
|
5936 (lambda (host-type files &optional regexp)
|
|
|
5937 (efs-brief-converter host-type files nil nil t nil nil t regexp))))
|
|
|
5938 (efs-add-ls-converter
|
|
|
5939 "-CFA" t (function
|
|
|
5940 (lambda (host-type files &optional regexp)
|
|
|
5941 (efs-brief-converter host-type files t nil t nil nil t regexp))))
|
|
|
5942 (efs-add-ls-converter
|
|
|
5943 "-CpA" t (function
|
|
|
5944 (lambda (host-type files &optional regexp)
|
|
|
5945 (efs-brief-converter host-type files nil nil t t nil t regexp))))
|
|
|
5946 (efs-add-ls-converter
|
|
|
5947 "-xA" t (function
|
|
|
5948 (lambda (host-type files &optional regexp)
|
|
|
5949 (efs-brief-converter host-type files nil nil t nil t nil regexp))))
|
|
|
5950 (efs-add-ls-converter
|
|
|
5951 "-xFA" t (function
|
|
|
5952 (lambda (host-type files &optional regexp)
|
|
|
5953 (efs-brief-converter host-type files t nil t nil t nil regexp))))
|
|
|
5954 (efs-add-ls-converter
|
|
|
5955 "-xpA" t (function
|
|
|
5956 (lambda (host-type files &optional regexp)
|
|
|
5957 (efs-brief-converter host-type files nil nil t t t nil regexp))))
|
|
|
5958
|
|
|
5959 ;;;; ------------------------------------------------------------
|
|
|
5960 ;;;; Directory Listing Parsers
|
|
|
5961 ;;;; ------------------------------------------------------------
|
|
|
5962
|
|
|
5963 (defconst efs-unix:dl-listing-regexp
|
|
|
5964 "^[^ \n\t]+\n? +\\([0-9]+\\|-\\|=\\) ")
|
|
|
5965
|
|
|
5966 ;; Note to progammers:
|
|
|
5967 ;; Below are a series of macros and functions used for parsing unix
|
|
|
5968 ;; file listings. They are intended only to be used together, so be careful
|
|
|
5969 ;; about using them out of context.
|
|
|
5970
|
|
|
5971 (defmacro efs-ls-parse-file-line ()
|
|
|
5972 ;; Extract the filename, size, and permission string from the current
|
|
|
5973 ;; line of a dired-like listing. Assumes that the point is at
|
|
|
5974 ;; the beginning of the line, leaves it just before the size entry.
|
|
|
5975 ;; Returns a list (name size perm-string nlinks owner).
|
|
|
5976 ;; If there is no file on the line, returns nil.
|
|
|
5977 (` (let ((eol (save-excursion (end-of-line) (point)))
|
|
|
5978 name size modes nlinks owner)
|
|
|
5979 (skip-chars-forward " 0-9" eol)
|
|
|
5980 (and
|
|
|
5981 (looking-at efs-modes-links-owner-regexp)
|
|
|
5982 (setq modes (buffer-substring (match-beginning 1)
|
|
|
5983 (match-end 1))
|
|
|
5984 nlinks (string-to-int (buffer-substring (match-beginning 2)
|
|
|
5985 (match-end 2)))
|
|
|
5986 owner (buffer-substring (match-beginning 3) (match-end 3)))
|
|
|
5987 (re-search-forward efs-month-and-time-regexp eol t)
|
|
|
5988 (setq name (buffer-substring (point) eol)
|
|
|
5989 size (string-to-int (buffer-substring (match-beginning 1)
|
|
|
5990 (match-end 1))))
|
|
|
5991 (list name size modes nlinks owner)))))
|
|
|
5992
|
|
|
5993 (defun efs-relist-symlink (host user symlink path switches)
|
|
|
5994 ;; Does a re-list of a single symlink in efs-data-buffer-name-2,
|
|
|
5995 ;; HOST = remote host
|
|
|
5996 ;; USER = remote username
|
|
|
5997 ;; SYMLINK = symbolic link name as a remote fullpath
|
|
|
5998 ;; PATH = efs full path syntax for the dir. being listed
|
|
|
5999 ;; SWITCHES = ls switches to use for the re-list
|
|
|
6000 ;; Returns (symlink-name symlink-target), as given by the listing. Returns
|
|
|
6001 ;; nil if the listing fails.
|
|
|
6002 ;; Does NOT correct for any symlink marking.
|
|
|
6003 (let* ((temp (efs-make-tmp-name host nil))
|
|
|
6004 (temp-file (car temp))
|
|
|
6005 (default-major-mode 'fundamental-mode)
|
|
|
6006 spot)
|
|
|
6007 (unwind-protect
|
|
|
6008 (and
|
|
|
6009 (prog1
|
|
|
6010 (null
|
|
|
6011 (car
|
|
|
6012 (efs-send-cmd host user
|
|
|
6013 (list 'dir symlink (cdr temp) switches)
|
|
|
6014 (format "Listing %s"
|
|
|
6015 (efs-relativize-filename
|
|
|
6016 (efs-replace-path-component
|
|
|
6017 path symlink))))))
|
|
|
6018 ;; Put the old message back.
|
|
|
6019 (if (and efs-verbose
|
|
|
6020 (not (and (boundp 'dired-in-query) dired-in-query)))
|
|
|
6021 (message "Listing %s..."
|
|
|
6022 (efs-relativize-filename path))))
|
|
|
6023 (save-excursion
|
|
|
6024 (if (efs-ftp-path temp-file)
|
|
|
6025 (efs-add-file-entry (efs-host-type efs-gateway-host)
|
|
|
6026 temp-file nil nil nil))
|
|
|
6027 (set-buffer (get-buffer-create efs-data-buffer-name-2))
|
|
|
6028 (erase-buffer)
|
|
|
6029 (if (or (file-readable-p temp-file)
|
|
|
6030 (sleep-for efs-retry-time)
|
|
|
6031 (file-readable-p temp-file))
|
|
|
6032 (let (efs-verbose)
|
|
|
6033 (insert-file-contents temp-file))
|
|
|
6034 (efs-error host user
|
|
|
6035 (format
|
|
|
6036 "list data file %s not readable" temp-file)))
|
|
|
6037 (skip-chars-forward " 0-9")
|
|
|
6038 (and
|
|
|
6039 (eq (following-char) ?l)
|
|
|
6040 (re-search-forward efs-month-and-time-regexp nil t)
|
|
|
6041 (setq spot (point))
|
|
|
6042 (re-search-forward " -> " nil t)
|
|
|
6043 (progn
|
|
|
6044 (end-of-line)
|
|
|
6045 (list
|
|
|
6046 ;; We might get the full path in the listing.
|
|
|
6047 (file-name-nondirectory
|
|
|
6048 (buffer-substring spot (match-beginning 0)))
|
|
|
6049 (buffer-substring (match-end 0) (point)))))))
|
|
|
6050 (efs-del-tmp-name temp-file))))
|
|
|
6051
|
|
|
6052 (defun efs-ls-sysV-p (host user dir linkname path)
|
|
|
6053 ;; Returns t if the symlink is listed in sysV style. i.e. The
|
|
|
6054 ;; symlink name is marked with an @.
|
|
|
6055 ;; HOST = remote host name
|
|
|
6056 ;; USER = remote user name
|
|
|
6057 ;; DIR = directory being listed as a remote full path.
|
|
|
6058 ;; LINKNAME = relative name of symbolic link as derived from an ls -..F...
|
|
|
6059 ;; this is assumed to end with an @
|
|
|
6060 ;; PATH = efs full path synatx for the directory
|
|
|
6061 (let ((link (car (efs-relist-symlink
|
|
|
6062 host user
|
|
|
6063 (concat dir (substring linkname 0 -1))
|
|
|
6064 path "-lFd" ))))
|
|
|
6065 (and link (string-equal link linkname))))
|
|
|
6066
|
|
|
6067 (defun efs-ls-next-p (host user dir linkname target path)
|
|
|
6068 ;; Returns t is the symlink is marked in the NeXT style.
|
|
|
6069 ;; i.e. The symlink destination is marked with an @.
|
|
|
6070 ;; This assumes that the host-type has already been identified
|
|
|
6071 ;; as NOT sysV-unix, and that target ends in an "@".
|
|
|
6072 ;; HOST = remote host name
|
|
|
6073 ;; USER = remote user name
|
|
|
6074 ;; DIR = remote directory being listed, as a remore full path
|
|
|
6075 ;; LINKNAME = relative name of symbolic link
|
|
|
6076 ;; Since we've eliminated sysV, it won't be marked with an @
|
|
|
6077 ;; TARGET = target of symbolic link, as derived from an ls -..F..
|
|
|
6078 ;; PATH = directory being listed in full efs path syntax.
|
|
|
6079 (let ((no-F-target (nth 1 (efs-relist-symlink
|
|
|
6080 host user
|
|
|
6081 (concat dir linkname)
|
|
|
6082 path "-ld"))))
|
|
|
6083 (and no-F-target
|
|
|
6084 (string-equal (concat no-F-target "@") target))))
|
|
|
6085
|
|
|
6086 ;; This deals with the F switch. Should also do something about
|
|
|
6087 ;; unquoting names obtained with the SysV b switch and the GNU Q
|
|
|
6088 ;; switch. See Sebastian's dired-get-filename.
|
|
|
6089
|
|
|
6090 (defun efs-ls-parser (host-type host user dir path switches)
|
|
|
6091 ;; Meant to be called by efs-parse-listing.
|
|
|
6092 ;; Assumes that point is at the beginning of the first file line.
|
|
|
6093 ;; Assumes that SWITCHES has already been bound to nil for a dumb host.
|
|
|
6094 ;; HOST-TYPE is the remote host-type
|
|
|
6095 ;; HOST is the remote host name
|
|
|
6096 ;; USER is the remote user name
|
|
|
6097 ;; DIR is the remote directory as a full path
|
|
|
6098 ;; PATH is the directory in full efs syntax, and directory syntax.
|
|
|
6099 ;; SWITCHES is the ls listing switches
|
|
|
6100 (let ((tbl (efs-make-hashtable))
|
|
|
6101 (used-F (and switches (string-match "F" switches)))
|
|
|
6102 (old-tbl (efs-get-files-hashtable-entry path))
|
|
|
6103 file-type symlink directory file size modes nlinks owner)
|
|
|
6104 (while (setq file (efs-ls-parse-file-line))
|
|
|
6105 (setq size (nth 1 file)
|
|
|
6106 modes (nth 2 file)
|
|
|
6107 nlinks (nth 3 file)
|
|
|
6108 owner (nth 4 file)
|
|
|
6109 file (car file)
|
|
|
6110 file-type (string-to-char modes)
|
|
|
6111 directory (eq file-type ?d))
|
|
|
6112 (if (eq file-type ?l)
|
|
|
6113 (if (string-match " -> " file)
|
|
|
6114 (setq symlink (substring file (match-end 0))
|
|
|
6115 file (substring file 0 (match-beginning 0)))
|
|
|
6116 ;; Shouldn't happen
|
|
|
6117 (setq symlink ""))
|
|
|
6118 (setq symlink nil))
|
|
|
6119 (if used-F
|
|
|
6120 ;; The F-switch jungle
|
|
|
6121 (let ((socket (eq file-type ?s))
|
|
|
6122 (fifo (eq file-type ?p))
|
|
|
6123 (executable
|
|
|
6124 (and (not symlink) ; x bits don't mean a thing for symlinks
|
|
|
6125 (or (memq (elt modes 3) '(?x ?s ?t))
|
|
|
6126 (memq (elt modes 6) '(?x ?s ?t))
|
|
|
6127 (memq (elt modes 9) '(?x ?s ?t))))))
|
|
|
6128 ;; Deal with marking of directories, executables, and sockets.
|
|
|
6129 (if (or (and executable (string-match "*$" file))
|
|
|
6130 (and socket (string-match "=$" file))
|
|
|
6131 (and fifo (string-match "|$" file)))
|
|
|
6132 (setq file (substring file 0 -1))
|
|
|
6133 ;; Do the symlink dance.
|
|
|
6134 (if symlink
|
|
|
6135 (let ((fat-p (string-match "@$" file))
|
|
|
6136 (sat-p (string-match "@$" symlink)))
|
|
|
6137 (cond
|
|
|
6138 ;; Those that mark the file
|
|
|
6139 ((and (memq host-type '(sysV-unix apollo-unix)) fat-p)
|
|
|
6140 (setq file (substring file 0 -1)))
|
|
|
6141 ;; Those that mark nothing
|
|
|
6142 ((memq host-type '(bsd-unix dumb-unix)))
|
|
|
6143 ;; Those that mark the target
|
|
|
6144 ((and (eq host-type 'next-unix) sat-p)
|
|
|
6145 (setq symlink (substring symlink 0 -1)))
|
|
|
6146 ;; We don't know
|
|
|
6147 ((eq host-type 'unix)
|
|
|
6148 (if fat-p
|
|
|
6149 (cond
|
|
|
6150 ((efs-ls-sysV-p host user dir
|
|
|
6151 file path)
|
|
|
6152 (setq host-type 'sysV-unix
|
|
|
6153 file (substring file 0 -1))
|
|
|
6154 (efs-add-host 'sysV-unix host)
|
|
|
6155 (efs-add-listing-type 'sysV-unix host user))
|
|
|
6156 ((and sat-p
|
|
|
6157 (efs-ls-next-p host user dir file symlink
|
|
|
6158 path))
|
|
|
6159 (setq host-type 'next-unix
|
|
|
6160 symlink (substring symlink 0 -1))
|
|
|
6161 (efs-add-host 'next-unix host)
|
|
|
6162 (efs-add-listing-type 'next-unix host user))
|
|
|
6163 (t
|
|
|
6164 (setq host-type 'bsd-unix)
|
|
|
6165 (efs-add-host 'bsd-unix host)
|
|
|
6166 (efs-add-listing-type 'bsd-unix host user)))
|
|
|
6167 (if (and sat-p
|
|
|
6168 (efs-ls-next-p host user dir file
|
|
|
6169 symlink path))
|
|
|
6170 (progn
|
|
|
6171 (setq host-type 'next-unix
|
|
|
6172 symlink (substring symlink 0 -1))
|
|
|
6173 (efs-add-host 'next-unix host)
|
|
|
6174 (efs-add-listing-type 'next-unix host user))
|
|
|
6175 (setq host-type 'bsd-unix)
|
|
|
6176 (efs-add-host 'bsd-unix host)
|
|
|
6177 (efs-add-listing-type 'bsd-unix host user)))))
|
|
|
6178 ;; Look out for marking of symlink
|
|
|
6179 ;; If we really wanted to, at this point we
|
|
|
6180 ;; could distinguish aix from hp-ux, ultrix, irix and a/ux,
|
|
|
6181 ;; allowing us to skip the re-list in the future, for the
|
|
|
6182 ;; later 4 host types. Another version...
|
|
|
6183 (if (string-match "[=|*]$" symlink)
|
|
|
6184 (let ((relist (efs-relist-symlink
|
|
|
6185 host user (concat dir file)
|
|
|
6186 path "-dl")))
|
|
|
6187 (if relist (setq symlink (nth 1 relist))))))))))
|
|
|
6188 ;; Strip / off the end unconditionally. It's not a valid file character
|
|
|
6189 ;; anyway.
|
|
|
6190 (if (string-match "/$" file) (setq file (substring file 0 -1)))
|
|
|
6191 (let ((mdtm (and old-tbl (nth 5 (efs-get-hash-entry file old-tbl)))))
|
|
|
6192 (if mdtm
|
|
|
6193 (efs-put-hash-entry file (list (or symlink directory) size owner
|
|
|
6194 modes nlinks mdtm) tbl)
|
|
|
6195 (efs-put-hash-entry file (list (or symlink directory) size owner
|
|
|
6196 modes nlinks) tbl)))
|
|
|
6197 (forward-line 1))
|
|
|
6198 (efs-put-hash-entry "." '(t) tbl)
|
|
|
6199 (efs-put-hash-entry ".." '(t) tbl)
|
|
|
6200 tbl))
|
|
|
6201
|
|
|
6202 (efs-defun efs-parse-listing nil (host user dir path &optional switches)
|
|
|
6203 ;; Parse the a listing which is assumed to be from some type of unix host.
|
|
|
6204 ;; Note that efs-key will be bound to the actual host type.
|
|
|
6205 ;; HOST = remote host name
|
|
|
6206 ;; USER = remote user name
|
|
|
6207 ;; DIR = directory as a remote full path
|
|
|
6208 ;; PATH = directory in full efs path syntax
|
|
|
6209 ;; SWITCHES = ls switches used for the listing
|
|
|
6210 (efs-save-match-data
|
|
|
6211 (cond
|
|
|
6212 ;; look for total line
|
|
|
6213 ((looking-at "^total [0-9]+$")
|
|
|
6214 (forward-line 1)
|
|
|
6215 ;; Beware of machines that put a blank line after the totals line.
|
|
|
6216 (skip-chars-forward " \t\n")
|
|
|
6217 (efs-ls-parser efs-key host user dir path switches))
|
|
|
6218 ;; look for errors
|
|
|
6219 ((looking-at "[^\n]+\\( not found\\|: Not a directory\\)\n\\'")
|
|
|
6220 ;; It's an ls error message.
|
|
|
6221 nil)
|
|
|
6222 ((eobp) ; i.e. zerop buffer-size
|
|
|
6223 nil) ; assume an ls error message
|
|
|
6224 ;; look for listings without total lines
|
|
|
6225 ((re-search-forward efs-month-and-time-regexp nil t)
|
|
|
6226 (beginning-of-line)
|
|
|
6227 (efs-ls-parser efs-key host user dir path switches))
|
|
|
6228 (t nil))))
|
|
|
6229
|
|
|
6230 (efs-defun efs-parse-listing unix:unknown
|
|
|
6231 (host user dir path &optional switches)
|
|
|
6232 ;; Parse the a listing which is assumed to be from some type of unix host,
|
|
|
6233 ;; possibly one doing a dl listing.
|
|
|
6234 ;; HOST = remote host name
|
|
|
6235 ;; USER = remote user name
|
|
|
6236 ;; DIR = directory as a remote full path
|
|
|
6237 ;; PATH = directory in full efs path syntax
|
|
|
6238 ;; SWITCHES = ls switches used for the listing
|
|
|
6239 (efs-save-match-data
|
|
|
6240 (cond
|
|
|
6241 ;; look for total line
|
|
|
6242 ((looking-at "^total [0-9]+$")
|
|
|
6243 (forward-line 1)
|
|
|
6244 ;; Beware of machines that put a blank line after the totals line.
|
|
|
6245 (skip-chars-forward " \t\n")
|
|
|
6246 ;; This will make the listing-type track the host-type.
|
|
|
6247 (efs-add-listing-type nil host user)
|
|
|
6248 (efs-ls-parser 'unix host user dir path switches))
|
|
|
6249 ;; look for errors
|
|
|
6250 ((looking-at "[^\n]+\\( not found\\|: Not a directory\\)\n\\'")
|
|
|
6251 ;; It's an ls error message.
|
|
|
6252 nil)
|
|
|
6253 ((eobp) ; i.e. zerop buffer-size
|
|
|
6254 nil) ; assume an ls error message
|
|
|
6255 ;; look for listings without total lines
|
|
|
6256 ((and (re-search-forward efs-month-and-time-regexp nil t)
|
|
|
6257 (progn
|
|
|
6258 (beginning-of-line)
|
|
|
6259 (looking-at efs-modes-links-owner-regexp)))
|
|
|
6260 (efs-add-listing-type nil host user)
|
|
|
6261 (efs-ls-parser 'unix host user dir path switches))
|
|
|
6262 ;; look for dumb listings
|
|
|
6263 ((re-search-forward
|
|
|
6264 (concat (regexp-quote switches)
|
|
|
6265 " not found\\|\\(^ls: +illegal option -- \\)")
|
|
|
6266 (save-excursion (end-of-line) (point)) t)
|
|
|
6267 (if (eq (efs-host-type host) 'apollo-unix)
|
|
|
6268 (progn
|
|
|
6269 (efs-add-host 'dumb-apollo-unix host)
|
|
|
6270 (efs-add-listing-type 'dumb-apollo-unix host user))
|
|
|
6271 (efs-add-host 'dumb-unix host)
|
|
|
6272 (efs-add-listing-type 'dumb-unix host user))
|
|
|
6273 (if (match-beginning 1)
|
|
|
6274 ;; Need to try to list again.
|
|
|
6275 (let ((efs-ls-uncache t))
|
|
|
6276 (efs-ls
|
|
|
6277 path nil (format "Relisting %s" (efs-relativize-filename path)) t)
|
|
|
6278 (goto-char (point-min))
|
|
|
6279 (efs-parse-listing nil host user dir path switches))
|
|
|
6280 (if (re-search-forward "^total [0-9]+$" nil t)
|
|
|
6281 (progn
|
|
|
6282 (beginning-of-line)
|
|
|
6283 (delete-region (point-min) (point))
|
|
|
6284 (forward-line 1)
|
|
|
6285 (efs-ls-parser 'dumb-unix host user dir path switches)))))
|
|
|
6286 ;; Look for dl listings.
|
|
|
6287 ((re-search-forward efs-unix:dl-listing-regexp nil t)
|
|
|
6288 (efs-add-host 'unix host)
|
|
|
6289 (efs-add-listing-type 'unix:dl host user)
|
|
|
6290 (efs-parse-listing 'unix:dl host user dir path switches))
|
|
|
6291 ;; don't know, return nil
|
|
|
6292 (t nil))))
|
|
|
6293
|
|
|
6294 (defun efs-ls-parse-1-liner (filename buffer &optional symlink)
|
|
|
6295 ;; Parse a 1-line listing for FILENAME in BUFFER, and update
|
|
|
6296 ;; the cached info for FILENAME.
|
|
|
6297 ;; Optional SYMLINK arg gives the expected target of a symlink.
|
|
|
6298 ;; Since one-line listings are usually used to update info for
|
|
|
6299 ;; newly created files, we usually know what sort of a file to expect.
|
|
|
6300 ;; Actually trying to parse out the symlink target could be impossible
|
|
|
6301 ;; for some types of switches.
|
|
|
6302 (efs-save-buffer-excursion
|
|
|
6303 (set-buffer buffer)
|
|
|
6304 (goto-char (point-min))
|
|
|
6305 (skip-chars-forward " 0-9")
|
|
|
6306 (efs-save-match-data
|
|
|
6307 (let (modes nlinks owner size)
|
|
|
6308 (and
|
|
|
6309 (looking-at efs-modes-links-owner-regexp)
|
|
|
6310 (setq modes (buffer-substring (match-beginning 1) (match-end 1))
|
|
|
6311 nlinks (string-to-int (buffer-substring (match-beginning 2)
|
|
|
6312 (match-end 2)))
|
|
|
6313 owner (buffer-substring (match-beginning 3) (match-end 3)))
|
|
|
6314 (re-search-forward efs-month-and-time-regexp nil t)
|
|
|
6315 (setq size (string-to-int (buffer-substring (match-beginning 1)
|
|
|
6316 (match-end 1))))
|
|
|
6317 (let* ((filename (directory-file-name filename))
|
|
|
6318 (files (efs-get-files-hashtable-entry
|
|
|
6319 (file-name-directory filename))))
|
|
|
6320 (if files
|
|
|
6321 (let* ((key (efs-get-file-part filename))
|
|
|
6322 (ignore-case (memq (efs-host-type
|
|
|
6323 (car (efs-ftp-path filename)))
|
|
|
6324 efs-case-insensitive-host-types))
|
|
|
6325 (ent (efs-get-hash-entry key files ignore-case))
|
|
|
6326 (mdtm (nth 5 ent))
|
|
|
6327 type)
|
|
|
6328 (if (= (string-to-char modes) ?l)
|
|
|
6329 (setq type
|
|
|
6330 (cond
|
|
|
6331 ((stringp symlink)
|
|
|
6332 symlink)
|
|
|
6333 ((stringp (car ent))
|
|
|
6334 (car ent))
|
|
|
6335 (t ; something weird happened.
|
|
|
6336 "")))
|
|
|
6337 (if (= (string-to-char modes) ?d)
|
|
|
6338 (setq type t)))
|
|
|
6339 (efs-put-hash-entry
|
|
|
6340 key (list type size owner modes nlinks mdtm)
|
|
|
6341 files ignore-case)))))))))
|
|
|
6342
|
|
|
6343 (efs-defun efs-update-file-info nil (file buffer &optional symlink)
|
|
|
6344 "For FILE, update cache information from a single file listing in BUFFER."
|
|
|
6345 ;; By default, this does nothing.
|
|
|
6346 nil)
|
|
|
6347
|
|
|
6348 (efs-defun efs-update-file-info unix (file buffer &optional symlink)
|
|
|
6349 (efs-ls-parse-1-liner file buffer))
|
|
|
6350 (efs-defun efs-update-file-info sysV-unix (file buffer &optional symlink)
|
|
|
6351 (efs-ls-parse-1-liner file buffer))
|
|
|
6352 (efs-defun efs-update-file-info bsd-unix (file buffer &optional symlink)
|
|
|
6353 (efs-ls-parse-1-liner file buffer))
|
|
|
6354 (efs-defun efs-update-file-info next-unix (file buffer &optional symlink)
|
|
|
6355 (efs-ls-parse-1-liner file buffer))
|
|
|
6356 (efs-defun efs-update-file-info apollo-unix (file buffer &optional symlink)
|
|
|
6357 (efs-ls-parse-1-liner file buffer))
|
|
|
6358 (efs-defun efs-update-file-info dumb-unix (file buffer &optional symlink)
|
|
|
6359 (efs-ls-parse-1-liner file buffer))
|
|
|
6360 (efs-defun efs-update-file-info dumb-apollo-unix
|
|
|
6361 (file buffer &optional symlink)
|
|
|
6362 (efs-ls-parse-1-liner file buffer))
|
|
|
6363 (efs-defun efs-update-file-info super-dumb-unix (file buffer &optional symlink)
|
|
|
6364 (efs-ls-parse-1-liner file buffer))
|
|
|
6365
|
|
|
6366 ;;;; ----------------------------------------------------------------
|
|
|
6367 ;;;; The 'unknown listing parser. This does some host-type guessing.
|
|
|
6368 ;;;; ----------------------------------------------------------------
|
|
|
6369
|
|
|
6370 ;;; Regexps for host and listing type guessing from the listing syntax.
|
|
|
6371
|
|
|
6372 (defconst efs-ka9q-listing-regexp
|
|
|
6373 (concat
|
|
|
6374 "^\\([0-9,.]+\\|No\\) files\\. [0-9,.]+ bytes free\\. "
|
|
|
6375 "Disk size [0-9,]+ bytes\\.$"))
|
|
|
6376 ;; This version of the regexp is really for hosts which allow some switches,
|
|
|
6377 ;; but not ours. Rather than determine which switches we could be using
|
|
|
6378 ;; we just assume that it's dumb.
|
|
|
6379 (defconst efs-dumb-unix-listing-regexp
|
|
|
6380 (concat
|
|
|
6381 "^[Uu]sage: +ls +-[a-zA-Z0-9]+[ \n]\\|"
|
|
|
6382 ;; Unitree server
|
|
|
6383 "^Error getting stats for \"-[a-zA-Z0-9]+\""))
|
|
|
6384
|
|
|
6385 (defconst efs-dos-distinct-date-and-time-regexp
|
|
|
6386 (concat
|
|
|
6387 " \\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct"
|
|
|
6388 "\\|Nov\\|Dec\\) [ 0-3][0-9],[12][90][0-9][0-9] "
|
|
|
6389 "[ 12][0-9]:[0-5][0-9] "))
|
|
|
6390 ;; Regexp to match the output from the hellsoft ftp server to an
|
|
|
6391 ;; ls -al. Unfortunately, this looks a lot like some unix ls error
|
|
|
6392 ;; messages.
|
|
|
6393 (defconst efs-hell-listing-regexp
|
|
|
6394 (concat
|
|
|
6395 "ls: file or directory not found\n\\'\\|"
|
|
|
6396 "[-d]\\[[-A-Z][-A-Z][-A-Z][-A-Z][-A-Z][-A-Z][-A-Z]\\]"))
|
|
|
6397
|
|
|
6398 (efs-defun efs-parse-listing unknown
|
|
|
6399 (host user dir path &optional switches)
|
|
|
6400 "Parse the current buffer which is assumed to contain a dir listing.
|
|
|
6401 Return a hashtable as the result. If the listing is not really a
|
|
|
6402 directory listing, then return nil.
|
|
|
6403
|
|
|
6404 HOST is the remote host's name.
|
|
|
6405 USER is the remote user name.
|
|
|
6406 DIR is the directory as a full remote path.
|
|
|
6407 PATH is the directory in full efs path synatx.
|
|
|
6408 SWITCHES are the switches passed to ls. If SWITCHES is nil, then a
|
|
|
6409 dumb \(with dir\) listing has been done."
|
|
|
6410 (efs-save-match-data
|
|
|
6411 (cond
|
|
|
6412
|
|
|
6413 ;; look for total line
|
|
|
6414 ((looking-at "^total [0-9]+$")
|
|
|
6415 (efs-add-host 'unix host)
|
|
|
6416 (forward-line 1)
|
|
|
6417 ;; Beware of machines that put a blank line after the totals line.
|
|
|
6418 (skip-chars-forward " \t\n")
|
|
|
6419 (efs-ls-parser 'unix host user dir path switches))
|
|
|
6420
|
|
|
6421 ;; Look for hellsoft. Need to do this before looking
|
|
|
6422 ;; for ls errors, since the hellsoft output looks a lot like an ls error.
|
|
|
6423 ((looking-at efs-hell-listing-regexp)
|
|
|
6424 (if (null (car (efs-send-cmd host user '(quote site dos))))
|
|
|
6425 (let* ((key (concat host "/" user "/~"))
|
|
|
6426 (tilde (efs-get-hash-entry
|
|
|
6427 key efs-expand-dir-hashtable)))
|
|
|
6428 (efs-add-host 'hell host)
|
|
|
6429 ;; downcase the expansion of ~
|
|
|
6430 (if (and tilde (string-match "^[^a-z]+$" tilde))
|
|
|
6431 (efs-put-hash-entry key (downcase tilde)
|
|
|
6432 efs-expand-dir-hashtable))
|
|
|
6433 ;; Downcase dir, in case its got some upper case stuff in it.
|
|
|
6434 (setq dir (downcase dir)
|
|
|
6435 path (efs-replace-path-component path dir))
|
|
|
6436 (let ((efs-ls-uncache t))
|
|
|
6437 ;; This will force the data buffer to be re-filled
|
|
|
6438 (efs-ls path nil (format "Relisting %s"
|
|
|
6439 (efs-relativize-filename path))
|
|
|
6440 t))
|
|
|
6441 (efs-parse-listing 'hell host user dir path))
|
|
|
6442 ;; Don't know, give unix a try.
|
|
|
6443 (efs-add-host 'unix host)
|
|
|
6444 nil))
|
|
|
6445
|
|
|
6446 ;; look for ls errors
|
|
|
6447 ((looking-at "[^\n]+\\( not found\\|: Not a directory\\)\n\\'")
|
|
|
6448 ;; It's an ls error message.
|
|
|
6449 (efs-add-host 'unix host)
|
|
|
6450 nil)
|
|
|
6451
|
|
|
6452 ((eobp) ; i.e. (zerop (buffer-size))
|
|
|
6453 ;; This could be one of:
|
|
|
6454 ;; (1) An Ultrix ls error message
|
|
|
6455 ;; (2) A listing with the A switch of an empty directory
|
|
|
6456 ;; on a machine which doesn't give a total line.
|
|
|
6457 ;; (3) The result of an attempt at an nlist. (This would mean a
|
|
|
6458 ;; dumb host.)
|
|
|
6459 ;; (4) The twilight zone.
|
|
|
6460 (cond
|
|
|
6461 ((save-excursion
|
|
|
6462 (set-buffer (process-buffer
|
|
|
6463 (efs-get-process host user)))
|
|
|
6464 (save-excursion
|
|
|
6465 (goto-char (point-max))
|
|
|
6466 (and
|
|
|
6467 ;; The dir ftp output starts with a 200 cmd.
|
|
|
6468 (re-search-backward "^150 " nil t)
|
|
|
6469 ;; We never do an nlist (it's a short listing).
|
|
|
6470 ;; If the machine thinks that we did, it's dumb.
|
|
|
6471 (looking-at "[^\n]+ NLST "))))
|
|
|
6472 ;; It's dumb-unix or ka9q. Anything else?
|
|
|
6473 ;; This will re-fill the data buffer with a dumb listing.
|
|
|
6474 (let ((efs-ls-uncache t))
|
|
|
6475 (efs-ls path nil (format "Relisting %s"
|
|
|
6476 (efs-relativize-filename path))
|
|
|
6477 t))
|
|
|
6478 (cond
|
|
|
6479 ;; check for dumb-unix
|
|
|
6480 ((re-search-forward efs-month-and-time-regexp nil t)
|
|
|
6481 (efs-add-host 'dumb-unix host)
|
|
|
6482 (beginning-of-line)
|
|
|
6483 (efs-parse-listing 'dumb-unix host user dir path))
|
|
|
6484 ;; check for ka9q
|
|
|
6485 ((save-excursion
|
|
|
6486 (goto-char (point-max))
|
|
|
6487 (forward-line -1)
|
|
|
6488 (looking-at efs-ka9q-listing-regexp))
|
|
|
6489 (efs-add-host 'ka9q host)
|
|
|
6490 (efs-parse-listing 'ka9q host user dir path))
|
|
|
6491 (t ; Don't know, try unix.
|
|
|
6492 (efs-add-host 'unix host)
|
|
|
6493 nil)))
|
|
|
6494 ;; check for Novell Netware
|
|
|
6495 ((null (car (efs-send-cmd host user '(quote site nfs))))
|
|
|
6496 (efs-add-host 'netware host)
|
|
|
6497 (let ((efs-ls-uncache t))
|
|
|
6498 (efs-ls path nil (format "Relisting %s"
|
|
|
6499 (efs-relativize-filename path))
|
|
|
6500 t))
|
|
|
6501 (efs-parse-listing 'netware host user dir path))
|
|
|
6502 (t
|
|
|
6503 ;; Assume (1), an Ultrix error message.
|
|
|
6504 (efs-add-host 'unix host)
|
|
|
6505 nil)))
|
|
|
6506
|
|
|
6507 ;; unix without a total line
|
|
|
6508 ((re-search-forward efs-month-and-time-regexp nil t)
|
|
|
6509 (efs-add-host 'unix host)
|
|
|
6510 (beginning-of-line)
|
|
|
6511 (efs-ls-parser 'unix host user dir path switches))
|
|
|
6512
|
|
|
6513 ;; Now we look for host-types, or listing-types which are auto-rec
|
|
|
6514 ;; by the listing parser, because it's not possible to pick them out
|
|
|
6515 ;; from a pwd.
|
|
|
6516
|
|
|
6517 ;; check for dumb-unix
|
|
|
6518 ;; (Guessing of dumb-unix hosts which return an ftp error message is
|
|
|
6519 ;; done in efs-ls.)
|
|
|
6520 ((re-search-forward efs-dumb-unix-listing-regexp nil t)
|
|
|
6521 (efs-add-host 'dumb-unix host)
|
|
|
6522 ;; This will force the data buffer to be re-filled
|
|
|
6523 (let ((efs-ls-uncache t))
|
|
|
6524 (efs-ls path nil (format "Relisting %s"
|
|
|
6525 (efs-relativize-filename path))
|
|
|
6526 t))
|
|
|
6527 (efs-parse-listing 'dumb-unix host user dir path))
|
|
|
6528
|
|
|
6529 ;; check for Distinct's DOS ftp server
|
|
|
6530 ((re-search-forward efs-dos-distinct-date-and-time-regexp nil t)
|
|
|
6531 (efs-add-host 'dos-distinct host)
|
|
|
6532 (efs-parse-listing 'dos-distinct host user dir path))
|
|
|
6533
|
|
|
6534 ;; check for KA9Q pseudo-unix (LINUX?)
|
|
|
6535 ((save-excursion
|
|
|
6536 (goto-char (point-max))
|
|
|
6537 (forward-line -1)
|
|
|
6538 (looking-at efs-ka9q-listing-regexp))
|
|
|
6539 (efs-add-host 'ka9q host)
|
|
|
6540 ;; This will re-fill the data buffer.
|
|
|
6541 ;; Need to do this because ka9q is a dumb host.
|
|
|
6542 (let ((efs-ls-uncache t))
|
|
|
6543 (efs-ls path nil (format "Relisting %s"
|
|
|
6544 (efs-relativize-filename path))
|
|
|
6545 t))
|
|
|
6546 (efs-parse-listing 'ka9q host user dir path))
|
|
|
6547
|
|
|
6548 ;; Check for a unix descriptive (dl) listing
|
|
|
6549 ;; Do this last, because it's hard to guess.
|
|
|
6550 ((re-search-forward efs-unix:dl-listing-regexp nil t)
|
|
|
6551 (efs-add-host 'unix host)
|
|
|
6552 (efs-add-listing-type 'unix:dl host user)
|
|
|
6553 (efs-parse-listing 'unix:dl host user dir path switches))
|
|
|
6554
|
|
|
6555 ;; Don't know what's going on. Return nil, and assume unix.
|
|
|
6556 (t
|
|
|
6557 (efs-add-host 'unix host)
|
|
|
6558 nil))))
|
|
|
6559
|
|
|
6560 ;;;; ------------------------------------------------------------
|
|
|
6561 ;;;; Directory information hashtable.
|
|
|
6562 ;;;; ------------------------------------------------------------
|
|
|
6563
|
|
|
6564 (efs-defun efs-really-file-p nil (file ent)
|
|
|
6565 ;; efs-files-hashtable sometimes contains fictitious entries, when
|
|
|
6566 ;; some OS's allow a file to be accessed by another name. For example,
|
|
|
6567 ;; in VMS the highest version of a file may be accessed by omitting the
|
|
|
6568 ;; the file version number. This function should return t if the
|
|
|
6569 ;; filename FILE is really a file. ENT is the hash entry of the file.
|
|
|
6570 t)
|
|
|
6571
|
|
|
6572 (efs-defun efs-add-file-entry nil (path type size owner
|
|
|
6573 &optional modes nlinks mdtm)
|
|
|
6574 ;; Add a new file entry for PATH
|
|
|
6575 ;; TYPE is nil for a plain file, t for a directory, and a string
|
|
|
6576 ;; (the target of the link) for a symlink.
|
|
|
6577 ;; SIZE is the size of the file in bytes.
|
|
|
6578 ;; OWNER is the owner of the file, as a string.
|
|
|
6579 ;; MODES is the file modes, as a string. In Unix, this will be 10 cars.
|
|
|
6580 ;; NLINKS is the number of links for the file.
|
|
|
6581 ;; MDTM is the last modtime obtained for the file. This is for
|
|
|
6582 ;; short-term cache only, as emacs often has sequences of functions
|
|
|
6583 ;; doing modtime lookup. If you really want to be sure of the modtime,
|
|
|
6584 ;; use efs-get-file-mdtm, which asks the remote server.
|
|
|
6585
|
|
|
6586 (and (eq type t)
|
|
|
6587 (setq path (directory-file-name path)))
|
|
|
6588 (let ((files (efs-get-files-hashtable-entry (file-name-directory path))))
|
|
|
6589 (if files
|
|
|
6590 (efs-put-hash-entry
|
|
|
6591 (efs-get-file-part path)
|
|
|
6592 (cond (mdtm
|
|
|
6593 (list type size owner modes nlinks
|
|
|
6594 mdtm))
|
|
|
6595 (nlinks
|
|
|
6596 (list type size owner modes nlinks))
|
|
|
6597 (modes (list type size owner modes))
|
|
|
6598 (t (list type size owner)))
|
|
|
6599 files
|
|
|
6600 (memq efs-key efs-case-insensitive-host-types)))
|
|
|
6601 (efs-del-from-ls-cache path t nil)))
|
|
|
6602
|
|
|
6603 (efs-defun efs-delete-file-entry nil (path &optional dir-p)
|
|
|
6604 "Delete the file entry for PATH, if its directory info exists."
|
|
|
6605 (if dir-p
|
|
|
6606 (progn
|
|
|
6607 (setq path (file-name-as-directory path))
|
|
|
6608 (efs-del-hash-entry (efs-canonize-file-name path)
|
|
|
6609 efs-files-hashtable)
|
|
|
6610 ;; Note that file-name-as-directory followed by
|
|
|
6611 ;; (substring path 0 -1)
|
|
|
6612 ;; serves to canonicalize directory file names to their unix form.
|
|
|
6613 ;; i.e. in VMS, FOO.DIR -> FOO/ -> FOO
|
|
|
6614 ;; PATH is supposed to be s fully expanded efs-style path.
|
|
|
6615 (setq path (substring path 0 -1))))
|
|
|
6616 (let ((files (efs-get-files-hashtable-entry (file-name-directory path))))
|
|
|
6617 (if files
|
|
|
6618 (efs-del-hash-entry
|
|
|
6619 (efs-get-file-part path)
|
|
|
6620 files
|
|
|
6621 (memq (efs-host-type (car (efs-ftp-path path)))
|
|
|
6622 efs-case-insensitive-host-types))))
|
|
|
6623 (efs-del-from-ls-cache path t nil)
|
|
|
6624 (if dir-p (efs-del-from-ls-cache path nil t)))
|
|
|
6625
|
|
|
6626 (defun efs-set-files (directory files)
|
|
|
6627 "For DIRECTORY, set or change the associated FILES hashtable."
|
|
|
6628 (if files
|
|
|
6629 (efs-put-hash-entry
|
|
|
6630 (efs-canonize-file-name (file-name-as-directory directory))
|
|
|
6631 files efs-files-hashtable)))
|
|
|
6632
|
|
|
6633 (defun efs-parsable-switches-p (switches &optional full-dir)
|
|
|
6634 ;; Returns non-nil if SWITCHES would give an ls listing suitable for parsing
|
|
|
6635 ;; If FULL-DIR is non-nil, the switches must be suitable for parsing a full
|
|
|
6636 ;; ditectory.
|
|
|
6637 (or (null switches)
|
|
|
6638 (efs-save-match-data
|
|
|
6639 (and (string-match "[aA]" switches)
|
|
|
6640 ;; g is not good enough, need l or o for owner.
|
|
|
6641 (string-match "[lo]" switches)
|
|
|
6642 ;; L shows link target, rather than link. We need both.
|
|
|
6643 (not (string-match "[RfL]" switches))
|
|
|
6644 (not (and full-dir (string-match "d" switches)))))))
|
|
|
6645
|
|
|
6646 (defun efs-get-files (directory &optional no-error)
|
|
|
6647 "For DIRECTORY, return a hashtable of file entries.
|
|
|
6648 This will give an error or return nil, depending on the value of
|
|
|
6649 NO-ERROR, if a listing for DIRECTORY cannot be obtained."
|
|
|
6650 (let ((directory (file-name-as-directory directory)))
|
|
|
6651 (or (efs-get-files-hashtable-entry directory)
|
|
|
6652 (and (efs-ls directory (efs-ls-guess-switches) t 'parse no-error)
|
|
|
6653 (efs-get-files-hashtable-entry directory)))))
|
|
|
6654
|
|
|
6655 (efs-defun efs-allow-child-lookup nil (host user dir file)
|
|
|
6656 ;; Returns non-nil if in directory DIR, FILE could possibly be a subdir
|
|
|
6657 ;; according to its file-name syntax, and therefore a child listing should
|
|
|
6658 ;; be attempted. Note that DIR is in directory syntax.
|
|
|
6659 ;; i.e. /foo/bar/, not /foo/bar.
|
|
|
6660 ;; Deal with dired. Anything else?
|
|
|
6661 (not (and (boundp 'dired-local-variables-file)
|
|
|
6662 (stringp dired-local-variables-file)
|
|
|
6663 (string-equal dired-local-variables-file file))))
|
|
|
6664
|
|
|
6665 (defmacro efs-ancestral-check (host-type path ignore-case)
|
|
|
6666 ;; Checks to see if something in a path's ancient parentage
|
|
|
6667 ;; would make it impossible for the path to exist in the directory
|
|
|
6668 ;; tree. In this case it returns nil. Otherwise returns t (there
|
|
|
6669 ;; is essentially no information returned in this case, the file
|
|
|
6670 ;; may exist or not).
|
|
|
6671 ;; This macro should make working with RCS more efficient.
|
|
|
6672 ;; It also helps with FTP servers that go into fits if we ask to
|
|
|
6673 ;; list a non-existent dir.
|
|
|
6674 ;; Yes, I know that the function mapped over the hashtable can
|
|
|
6675 ;; be written more cleanly with a concat, but this is faster.
|
|
|
6676 ;; concat's cause a lot of consing. So do regexp-quote's, but we can't
|
|
|
6677 ;; avoid it.
|
|
|
6678 ;; Probably doesn't make much sense for this to be an efs-defun, since
|
|
|
6679 ;; the host-type dependence is very mild.
|
|
|
6680 (`
|
|
|
6681 (let ((path (, path)) ; expand once
|
|
|
6682 (ignore-case (, ignore-case))
|
|
|
6683 str)
|
|
|
6684 ;; eliminate flat file systems -- should have a constant for this
|
|
|
6685 (or (memq (, host-type) '(mts cms mvs cms-knet))
|
|
|
6686 (efs-save-match-data
|
|
|
6687 (catch 'foo
|
|
|
6688 (efs-map-hashtable
|
|
|
6689 (function
|
|
|
6690 (lambda (key val)
|
|
|
6691 (and (eq (string-match (regexp-quote key) path) 0)
|
|
|
6692 (setq str (substring path (match-end 0)))
|
|
|
6693 (string-match "^[^/]+" str)
|
|
|
6694 (not (efs-hash-entry-exists-p
|
|
|
6695 (substring str 0 (match-end 0))
|
|
|
6696 val ignore-case))
|
|
|
6697 (throw 'foo nil))))
|
|
|
6698 efs-files-hashtable)
|
|
|
6699 t))))))
|
|
|
6700
|
|
|
6701 (defun efs-file-entry-p (path)
|
|
|
6702 ;; Return whether there is a file entry for PATH.
|
|
|
6703 ;; Under no circumstances does this cause FTP activity.
|
|
|
6704 (let* ((path (directory-file-name (efs-canonize-file-name path)))
|
|
|
6705 (dir (file-name-directory path))
|
|
|
6706 (file (efs-get-file-part path))
|
|
|
6707 (tbl (efs-get-files-hashtable-entry dir)))
|
|
|
6708 (and tbl (efs-hash-entry-exists-p
|
|
|
6709 file tbl
|
|
|
6710 (memq (efs-host-type (car (efs-ftp-path dir)))
|
|
|
6711 efs-case-insensitive-host-types)) t)))
|
|
|
6712
|
|
|
6713 (defun efs-get-file-entry (path)
|
|
|
6714 "Return the given file entry for PATH.
|
|
|
6715 This is a list of the form \(type size owner modes nlinks modtm\),
|
|
|
6716 where type is nil for a normal file, t for a directory, and a string for a
|
|
|
6717 symlink, size is the size of the file in bytes, if known, and modes are
|
|
|
6718 the permission modes of the file as a string. modtm is short-term the
|
|
|
6719 cache of the file modtime. It is not used by `verify-visited-file-modtime'.
|
|
|
6720 If the file isn't in the hashtable, this returns nil."
|
|
|
6721 (let* ((path (directory-file-name (efs-canonize-file-name path)))
|
|
|
6722 (dir (file-name-directory path))
|
|
|
6723 (file (efs-get-file-part path))
|
|
|
6724 (parsed (efs-ftp-path dir))
|
|
|
6725 (host (car parsed))
|
|
|
6726 (host-type (efs-host-type host))
|
|
|
6727 (ent (efs-get-files-hashtable-entry dir))
|
|
|
6728 (ignore-case (memq host-type efs-case-insensitive-host-types)))
|
|
|
6729 (if ent
|
|
|
6730 (efs-get-hash-entry file ent ignore-case)
|
|
|
6731 (let ((user (nth 1 parsed))
|
|
|
6732 (r-dir (nth 2 parsed)))
|
|
|
6733 (and (efs-ancestral-check host-type path ignore-case)
|
|
|
6734 (or (and efs-allow-child-lookup
|
|
|
6735 (efs-allow-child-lookup host-type
|
|
|
6736 host user r-dir file)
|
|
|
6737 (setq ent (efs-get-files path t))
|
|
|
6738 (efs-get-hash-entry "." ent))
|
|
|
6739 ;; i.e. it's a directory by child lookup
|
|
|
6740 (efs-get-hash-entry
|
|
|
6741 file (efs-get-files dir) ignore-case)))))))
|
|
|
6742
|
|
|
6743 (defun efs-wipe-file-entries (host user)
|
|
|
6744 "Remove cache data for all files on HOST and USER.
|
|
|
6745 This replaces the file entry information hashtable with one that
|
|
|
6746 doesn't have any entries for the given HOST, USER pair."
|
|
|
6747 (let ((new-tbl (efs-make-hashtable (length efs-files-hashtable)))
|
|
|
6748 (host (downcase host))
|
|
|
6749 (case-fold (memq (efs-host-type host)
|
|
|
6750 efs-case-insensitive-host-types)))
|
|
|
6751 (if case-fold (setq user (downcase user)))
|
|
|
6752 (efs-map-hashtable
|
|
|
6753 (function
|
|
|
6754 (lambda (key val)
|
|
|
6755 (let ((parsed (efs-ftp-path key)))
|
|
|
6756 (if parsed
|
|
|
6757 (let ((h (nth 0 parsed))
|
|
|
6758 (u (nth 1 parsed)))
|
|
|
6759 (or (and (string-equal host (downcase h))
|
|
|
6760 (string-equal user (if case-fold (downcase u) u)))
|
|
|
6761 (efs-put-hash-entry key val new-tbl)))))))
|
|
|
6762 efs-files-hashtable)
|
|
|
6763 (setq efs-files-hashtable new-tbl)))
|
|
|
6764
|
|
|
6765
|
|
|
6766 ;;;; ============================================================
|
|
|
6767 ;;;; >8
|
|
|
6768 ;;;; Redefinitions of standard GNU Emacs functions.
|
|
|
6769 ;;;; ============================================================
|
|
|
6770
|
|
|
6771 ;;;; ------------------------------------------------------------
|
|
|
6772 ;;;; expand-file-name and friends...
|
|
|
6773 ;;;; ------------------------------------------------------------
|
|
|
6774
|
|
|
6775 ;; New filename expansion code for efs.
|
|
|
6776 ;; The overall structure is based around the following internal
|
|
|
6777 ;; functions and macros. Since these are internal, they do NOT
|
|
|
6778 ;; call efs-save-match-data. This is done by their calling
|
|
|
6779 ;; function.
|
|
|
6780 ;;
|
|
|
6781 ;; efs-expand-tilde
|
|
|
6782 ;; - expands all ~ constructs, both local and remote.
|
|
|
6783 ;; efs-short-circuit-file-name
|
|
|
6784 ;; - short-circuits //'s and /~'s, for both local and remote paths.
|
|
|
6785 ;; efs-de-dot-file-name
|
|
|
6786 ;; - canonizes /../ and /./'s in both local and remote paths.
|
|
|
6787 ;;
|
|
|
6788 ;; The following two functions overload existing emacs functions.
|
|
|
6789 ;; They are the entry points to this filename expansion code, and as such
|
|
|
6790 ;; call efs-save-match-data.
|
|
|
6791 ;;
|
|
|
6792 ;; efs-expand-file-name
|
|
|
6793 ;; efs-substitute-in-file-name
|
|
|
6794
|
|
|
6795 ;;; utility macros
|
|
|
6796
|
|
|
6797 (defmacro efs-short-circuit-file-name (filename)
|
|
|
6798 ;; Short-circuits //'s and /~'s in filenames.
|
|
|
6799 ;; Returns a list consisting of the local path,
|
|
|
6800 ;; host-type, host, user. For local hosts,
|
|
|
6801 ;; host-type, host, and user are all nil.
|
|
|
6802 (`
|
|
|
6803 (let ((start 0)
|
|
|
6804 (string (, filename))
|
|
|
6805 backskip regexp lbackskip
|
|
|
6806 lregexp parsed host-type host user)
|
|
|
6807
|
|
|
6808 (if efs-local-apollo-unix
|
|
|
6809 (setq lregexp ".//+"
|
|
|
6810 lbackskip 2)
|
|
|
6811 (setq lregexp "//+"
|
|
|
6812 lbackskip 1))
|
|
|
6813
|
|
|
6814 ;; Short circuit /user@mach: roots. It is important to do this
|
|
|
6815 ;; now to avoid unnecessary ftp connections.
|
|
|
6816
|
|
|
6817 (while (string-match efs-path-root-short-circuit-regexp string start)
|
|
|
6818 (setq start (1+ (match-beginning 0))))
|
|
|
6819 (or (zerop start) (setq string (substring string start)
|
|
|
6820 start 0))
|
|
|
6821
|
|
|
6822 ;; identify remote root
|
|
|
6823
|
|
|
6824 (if (setq parsed (efs-ftp-path-macro string))
|
|
|
6825 (if (memq (setq string (nth 2 parsed)
|
|
|
6826 host-type
|
|
|
6827 (efs-host-type (setq host (car parsed))
|
|
|
6828 (setq user (nth 1 parsed))))
|
|
|
6829 '(apollo-unix dumb-apollo-unix))
|
|
|
6830 (setq regexp ".//+"
|
|
|
6831 backskip 2)
|
|
|
6832 (setq regexp "//+"
|
|
|
6833 backskip 1))
|
|
|
6834 (setq regexp lregexp
|
|
|
6835 backskip lbackskip))
|
|
|
6836
|
|
|
6837 ;; Now short-circuit in an apollo and efs sensitive way.
|
|
|
6838
|
|
|
6839 (while (cond ((string-match regexp string start)
|
|
|
6840 (setq start (- (match-end 0) backskip)))
|
|
|
6841 ((string-match "/~" string start)
|
|
|
6842 (setq start (1- (match-end 0)))))
|
|
|
6843
|
|
|
6844 (and host-type
|
|
|
6845 (null efs-short-circuit-to-remote-root)
|
|
|
6846 (setq host-type nil
|
|
|
6847 regexp lregexp
|
|
|
6848 backskip lbackskip)))
|
|
|
6849 (or (zerop start) (setq string (substring string start)))
|
|
|
6850 (list string host-type (and host-type host) (and host-type user)))))
|
|
|
6851
|
|
|
6852 (defmacro efs-expand-tilde (tilde host-type host user)
|
|
|
6853 ;; Expands a TILDE (~ or ~sandy type construction)
|
|
|
6854 ;; Takes as an arg a filename (not directory name!)
|
|
|
6855 ;; and returns a filename. HOST-TYPE is the type of remote host.
|
|
|
6856 ;; nil is the type of the local host.
|
|
|
6857 (`
|
|
|
6858 (if (, host-type) ; nil host-type is the local machine
|
|
|
6859 (let* ((host (downcase (, host)))
|
|
|
6860 (host-type (, host-type))
|
|
|
6861 (ignore-case (memq host-type
|
|
|
6862 efs-case-insensitive-host-types))
|
|
|
6863 (tilde (, tilde))
|
|
|
6864 (user (, user))
|
|
|
6865 (key (concat host "/" user "/" tilde))
|
|
|
6866 (res (efs-get-hash-entry
|
|
|
6867 key efs-expand-dir-hashtable ignore-case)))
|
|
|
6868 (or res
|
|
|
6869 ;; for real accounts on unix systems, use the get trick
|
|
|
6870 (and (not (efs-anonymous-p user))
|
|
|
6871 (memq host-type efs-unix-host-types)
|
|
|
6872 (let ((line (nth 1 (efs-send-cmd
|
|
|
6873 host user
|
|
|
6874 (list 'get tilde "/dev/null")
|
|
|
6875 (format "expanding %s" tilde)))))
|
|
|
6876 (setq res
|
|
|
6877 (and (string-match efs-expand-dir-msgs line)
|
|
|
6878 (substring line
|
|
|
6879 (match-beginning 1)
|
|
|
6880 (match-end 1))))
|
|
|
6881 (if res
|
|
|
6882 (progn
|
|
|
6883 (setq res (efs-internal-directory-file-name res))
|
|
|
6884 (efs-put-hash-entry
|
|
|
6885 key res efs-expand-dir-hashtable ignore-case)
|
|
|
6886 res))))
|
|
|
6887 (progn
|
|
|
6888 (setq res
|
|
|
6889 (if (string-equal tilde "~")
|
|
|
6890 (car (efs-send-pwd
|
|
|
6891 host-type host user))
|
|
|
6892 (let* ((home-key (concat host "/" user "/~"))
|
|
|
6893 (home (efs-get-hash-entry
|
|
|
6894 home-key efs-expand-dir-hashtable
|
|
|
6895 ignore-case))
|
|
|
6896 pwd-result)
|
|
|
6897 (if home
|
|
|
6898 (setq home
|
|
|
6899 (efs-fix-path
|
|
|
6900 host-type
|
|
|
6901 (efs-internal-file-name-as-directory
|
|
|
6902 host-type home)))
|
|
|
6903 (if (setq home
|
|
|
6904 (car
|
|
|
6905 (setq pwd-result
|
|
|
6906 (efs-send-pwd
|
|
|
6907 host-type
|
|
|
6908 host user))))
|
|
|
6909 (efs-put-hash-entry
|
|
|
6910 home-key
|
|
|
6911 (efs-internal-directory-file-name
|
|
|
6912 (efs-fix-path host-type home 'reverse))
|
|
|
6913 efs-expand-dir-hashtable ignore-case)
|
|
|
6914 (efs-error host user
|
|
|
6915 (concat "PWD failed: "
|
|
|
6916 (cdr pwd-result)))))
|
|
|
6917 (unwind-protect
|
|
|
6918 (and (efs-raw-send-cd host user
|
|
|
6919 (efs-fix-path
|
|
|
6920 host-type tilde) t)
|
|
|
6921 (car
|
|
|
6922 (efs-send-pwd
|
|
|
6923 host-type host user)))
|
|
|
6924 (efs-raw-send-cd host user home)))))
|
|
|
6925 (if res
|
|
|
6926 (progn
|
|
|
6927 (setq res (efs-internal-directory-file-name
|
|
|
6928 (efs-fix-path host-type res 'reverse)))
|
|
|
6929 (efs-put-hash-entry
|
|
|
6930 key res efs-expand-dir-hashtable ignore-case)
|
|
|
6931 res)))
|
|
|
6932 (if (string-equal tilde "~")
|
|
|
6933 (error "Cannot get home directory on %s" host)
|
|
|
6934 (error "User %s is not known on %s" (substring tilde 1) host))))
|
|
|
6935 ;; local machine
|
|
|
6936 (efs-real-expand-file-name (, tilde)))))
|
|
|
6937
|
|
|
6938 (defmacro efs-de-dot-file-name (string)
|
|
|
6939 ;; Takes a string as arguments, and removes /../'s and /./'s.
|
|
|
6940 (`
|
|
|
6941 (let ((string (, string))
|
|
|
6942 (start 0)
|
|
|
6943 new make-dir)
|
|
|
6944 ;; to make the regexp's simpler, canonicalize to directory name.
|
|
|
6945 (if (setq make-dir (string-match "/\\.\\.?$" string))
|
|
|
6946 (setq string (concat string "/")))
|
|
|
6947 (while (string-match "/\\./" string start)
|
|
|
6948 (setq new (concat new
|
|
|
6949 (substring string
|
|
|
6950 start (match-beginning 0)))
|
|
|
6951 start (1- (match-end 0))))
|
|
|
6952
|
|
|
6953 (if new (setq string (concat new (substring string start))))
|
|
|
6954
|
|
|
6955 (while (string-match "/[^/]+/\\.\\./" string)
|
|
|
6956 ;; Is there a way to avoid all this concating and copying?
|
|
|
6957 (setq string (concat (substring string 0 (1+ (match-beginning 0)))
|
|
|
6958 (substring string (match-end 0)))))
|
|
|
6959
|
|
|
6960 ;; Do /../ and //../ special cases. They should expand to
|
|
|
6961 ;; / and //, respectively.
|
|
|
6962 (if (string-match "^\\(/+\\)\\.\\./" string)
|
|
|
6963 (setq string (concat (substring string 0 (match-end 1))
|
|
|
6964 (substring string (match-end 0)))))
|
|
|
6965
|
|
|
6966 (if (and make-dir
|
|
|
6967 (not (string-match "^/+$" string)))
|
|
|
6968 (substring string 0 -1)
|
|
|
6969 string))))
|
|
|
6970
|
|
|
6971 (defun efs-substitute-in-file-name (string)
|
|
|
6972 "Documented as original."
|
|
|
6973 ;; Because of the complicated interaction between short-circuiting
|
|
|
6974 ;; and environment variable substitution, this can't call the macro
|
|
|
6975 ;; efs-short-circuit-file-name.
|
|
|
6976 (efs-save-match-data
|
|
|
6977 (let ((start 0)
|
|
|
6978 var new root backskip regexp lbackskip
|
|
|
6979 lregexp parsed fudge-host-type rstart error)
|
|
|
6980
|
|
|
6981 (if efs-local-apollo-unix
|
|
|
6982 (setq lregexp ".//+"
|
|
|
6983 lbackskip 2)
|
|
|
6984 (setq lregexp "//+"
|
|
|
6985 lbackskip 1))
|
|
|
6986
|
|
|
6987 ;; Subst. existing env variables
|
|
|
6988 (while (string-match "\\$" string start)
|
|
|
6989 (setq new (concat new (substring string start (match-beginning 0)))
|
|
|
6990 start (match-end 0))
|
|
|
6991 (cond ((eq (string-match "\\$" string start) start)
|
|
|
6992 (setq start (1+ start)
|
|
|
6993 new (concat new "$$")))
|
|
|
6994 ((eq (string-match "{" string start) start)
|
|
|
6995 (if (and (string-match "}" string start)
|
|
|
6996 (setq var (getenv
|
|
|
6997 (substring string (1+ start)
|
|
|
6998 (1- (match-end 0))))))
|
|
|
6999 (setq start (match-end 0)
|
|
|
7000 new (concat new var))
|
|
|
7001 (setq new (concat new "$"))))
|
|
|
7002 ((eq (string-match "[a-zA-Z0-9]+" string start) start)
|
|
|
7003 (if (setq var (getenv
|
|
|
7004 (substring string start (match-end 0))))
|
|
|
7005 (setq start (match-end 0)
|
|
|
7006 new (concat new var))
|
|
|
7007 (setq new (concat new "$"))))
|
|
|
7008 ((setq new (concat new "$")))))
|
|
|
7009 (if new (setq string (concat new (substring string start))
|
|
|
7010 start 0))
|
|
|
7011
|
|
|
7012 ;; Short circuit /user@mach: roots. It is important to do this
|
|
|
7013 ;; now to avoid unnecessary ftp connections.
|
|
|
7014
|
|
|
7015 (while (string-match efs-path-root-short-circuit-regexp
|
|
|
7016 string start)
|
|
|
7017 (setq start (1+ (match-beginning 0))))
|
|
|
7018 (or (zerop start) (setq string (substring string start)
|
|
|
7019 start 0))
|
|
|
7020
|
|
|
7021 ;; Look for invalid environment variables in the root. If one is found,
|
|
|
7022 ;; we set the host-type to 'unix. Since we can't login in to determine
|
|
|
7023 ;; it. There is a good chance that we will bomb later with an error,
|
|
|
7024 ;; but the day may yet be saved if the root is short-circuited off.
|
|
|
7025
|
|
|
7026 (if (string-match efs-path-root-regexp string)
|
|
|
7027 (progn
|
|
|
7028 (setq root (substring string 0 (match-end 0))
|
|
|
7029 start (match-end 0))
|
|
|
7030 (if (string-match "[^$]\\(\\$\\$\\)*\\$[^$]" root)
|
|
|
7031 (progn
|
|
|
7032 (setq rstart (1- (match-end 0))
|
|
|
7033 fudge-host-type t)
|
|
|
7034 (cond
|
|
|
7035 ((eq (elt root rstart) ?{)
|
|
|
7036 (setq
|
|
|
7037 error
|
|
|
7038 (if (string-match "}" root rstart)
|
|
|
7039 (concat
|
|
|
7040 "Subsituting non-existent environment variable "
|
|
|
7041 (substring root (1+ rstart) (match-beginning 0)))
|
|
|
7042 "Missing \"}\" in environment-variable substitution")))
|
|
|
7043 ((eq (string-match "[A-Za-z0-9]+" root rstart) rstart)
|
|
|
7044 (setq
|
|
|
7045 error
|
|
|
7046 (concat
|
|
|
7047 "Subsituting non-existent environment variable "
|
|
|
7048 (substring root rstart (match-beginning 0)))))
|
|
|
7049 (t
|
|
|
7050 (setq
|
|
|
7051 error
|
|
|
7052 "Bad format environment-variable substitution")))))
|
|
|
7053 (setq root (efs-unquote-dollars root)
|
|
|
7054 parsed (efs-ftp-path root))
|
|
|
7055
|
|
|
7056 (if (and (not fudge-host-type)
|
|
|
7057 ;; This may trigger an FTP connection
|
|
|
7058 (memq (efs-host-type (car parsed) (nth 1 parsed))
|
|
|
7059 '(apollo-unix dumb-apollo-unix)))
|
|
|
7060 (setq regexp ".//+"
|
|
|
7061 backskip 2)
|
|
|
7062 (setq regexp "//+"
|
|
|
7063 backskip 1)))
|
|
|
7064 ;; no root, we're local
|
|
|
7065 (setq regexp lregexp
|
|
|
7066 backskip lbackskip))
|
|
|
7067
|
|
|
7068 ;; Now short-circuit in an apollo and efs sensitive way.
|
|
|
7069
|
|
|
7070 (while (cond ((string-match regexp string start)
|
|
|
7071 (setq start (- (match-end 0) backskip)))
|
|
|
7072 ((string-match "/~" string start)
|
|
|
7073 (setq start (1- (match-end 0)))))
|
|
|
7074
|
|
|
7075 (and root
|
|
|
7076 (null efs-short-circuit-to-remote-root)
|
|
|
7077 (setq root nil
|
|
|
7078 regexp lregexp
|
|
|
7079 backskip lbackskip)))
|
|
|
7080
|
|
|
7081 ;; If we still have a bad root, barf.
|
|
|
7082 (if (and root error) (error error))
|
|
|
7083
|
|
|
7084 ;; look for non-existent evironment variables in the path
|
|
|
7085
|
|
|
7086 (if (string-match
|
|
|
7087 "\\([^$]\\|^\\)\\(\\$\\$\\)*\\$\\([^$]\\|$\\)" string start)
|
|
|
7088 (progn
|
|
|
7089 (setq start (match-beginning 3))
|
|
|
7090 (cond
|
|
|
7091 ((eq (length string) start)
|
|
|
7092 (error "Empty string is an invalid environment variable"))
|
|
|
7093 ((eq (elt string start) ?{)
|
|
|
7094 (if (string-match "}" string start)
|
|
|
7095 (error
|
|
|
7096 "Subsituting non-existent environment variable %s"
|
|
|
7097 (substring string (1+ start) (match-end 0)))
|
|
|
7098 (error
|
|
|
7099 "Missing \"}\" in environment-variable substitution")))
|
|
|
7100 ((eq (string-match "[A-Za-z0-9]+" string start) start)
|
|
|
7101 (error
|
|
|
7102 "Subsituting non-existent environment variable %s"
|
|
|
7103 (substring string start (match-end 0))))
|
|
|
7104 (t
|
|
|
7105 (error
|
|
|
7106 "Bad format environment-variable substitution")))))
|
|
|
7107
|
|
|
7108 (if root
|
|
|
7109 (concat root
|
|
|
7110 (efs-unquote-dollars
|
|
|
7111 (if (zerop start)
|
|
|
7112 string
|
|
|
7113 (substring string start))))
|
|
|
7114 (efs-unquote-dollars
|
|
|
7115 (if (zerop start)
|
|
|
7116 string
|
|
|
7117 (substring string start)))))))
|
|
|
7118
|
|
|
7119 (defun efs-expand-file-name (name &optional default)
|
|
|
7120 "Documented as original."
|
|
|
7121 (let (s-c-res path host user host-type)
|
|
|
7122 (efs-save-match-data
|
|
|
7123 (or (file-name-absolute-p name)
|
|
|
7124 (setq name (concat
|
|
|
7125 (file-name-as-directory
|
|
|
7126 (or default default-directory))
|
|
|
7127 name)))
|
|
|
7128 (setq s-c-res (efs-short-circuit-file-name name)
|
|
|
7129 path (car s-c-res)
|
|
|
7130 host-type (nth 1 s-c-res)
|
|
|
7131 host (nth 2 s-c-res)
|
|
|
7132 user (nth 3 s-c-res))
|
|
|
7133 (cond ((string-match "^~[^/]*" path)
|
|
|
7134 (let ((start (match-end 0)))
|
|
|
7135 (setq path (concat
|
|
|
7136 (efs-expand-tilde
|
|
|
7137 (substring path 0 start)
|
|
|
7138 host-type host user)
|
|
|
7139 (substring path start)))))
|
|
|
7140 ((and host-type (not (file-name-absolute-p path)))
|
|
|
7141 ;; We expand the empty string to a directory.
|
|
|
7142 ;; This can be more efficient for filename
|
|
|
7143 ;; completion. It's also consistent with non-unix.
|
|
|
7144 (let ((tilde (efs-expand-tilde
|
|
|
7145 "~" host-type host user)))
|
|
|
7146 (if (string-equal tilde "/")
|
|
|
7147 (setq path (concat "/" path))
|
|
|
7148 (setq path (concat tilde "/" path))))))
|
|
|
7149
|
|
|
7150 (setq path (efs-de-dot-file-name path))
|
|
|
7151 (if host-type
|
|
|
7152 (format efs-path-format-string user host path)
|
|
|
7153 path))))
|
|
|
7154
|
|
|
7155 ;;;; ------------------------------------------------------------
|
|
|
7156 ;;;; Other functions for manipulating file names.
|
|
|
7157 ;;;; ------------------------------------------------------------
|
|
|
7158
|
|
|
7159 (defun efs-internal-file-name-extension (filename)
|
|
|
7160 ;; Returns the extension for file name FN.
|
|
|
7161 (save-match-data
|
|
|
7162 (let ((file (file-name-sans-versions (file-name-nondirectory filename))))
|
|
|
7163 (if (string-match "\\.[^.]*\\'" file)
|
|
|
7164 (substring file (match-beginning 0))
|
|
|
7165 ""))))
|
|
|
7166
|
|
|
7167 (defun efs-file-name-as-directory (name)
|
|
|
7168 ;; version of file-name-as-directory for remote files.
|
|
|
7169 ;; Usually just appends a / if there isn't one already.
|
|
|
7170 ;; For some systems, it may also remove .DIR like extensions.
|
|
|
7171 (let* ((parsed (efs-ftp-path name))
|
|
|
7172 (file (nth 2 parsed)))
|
|
|
7173 (if (string-equal file "")
|
|
|
7174 name
|
|
|
7175 (efs-internal-file-name-as-directory
|
|
|
7176 (efs-host-type (car parsed) (nth 1 parsed)) name))))
|
|
|
7177
|
|
|
7178 (efs-defun efs-internal-file-name-as-directory nil (name)
|
|
|
7179 ;; By default, simply adds a trailing /, if there isn't one.
|
|
|
7180 ;; Note that for expanded filenames, it pays to call this rather
|
|
|
7181 ;; than efs-file-name-as-directory.
|
|
|
7182 (let (file-name-handler-alist)
|
|
|
7183 (file-name-as-directory name)))
|
|
|
7184
|
|
|
7185 (defun efs-file-name-directory (name)
|
|
|
7186 ;; file-name-directory for remote files. Takes care not to
|
|
|
7187 ;; turn /user@host: into /.
|
|
|
7188 (let ((path (nth 2 (efs-ftp-path name)))
|
|
|
7189 file-name-handler-alist)
|
|
|
7190 (if (or (string-equal path "")
|
|
|
7191 (and (= (string-to-char path) ?~)
|
|
|
7192 (not
|
|
|
7193 (efs-save-match-data
|
|
|
7194 (string-match "/" path 1)))))
|
|
|
7195 name
|
|
|
7196 (if (efs-save-match-data
|
|
|
7197 (not (string-match "/" path)))
|
|
|
7198 (efs-replace-path-component name "")
|
|
|
7199 (file-name-directory name)))))
|
|
|
7200
|
|
|
7201 (defun efs-file-name-nondirectory (name)
|
|
|
7202 ;; Computes file-name-nondirectory for remote files.
|
|
|
7203 ;; For expanded filenames, can just call efs-internal-file-name-nondirectory.
|
|
|
7204 (let ((file (nth 2 (efs-ftp-path name))))
|
|
|
7205 (if (or (string-equal file "")
|
|
|
7206 (and (= (string-to-char file) ?~)
|
|
|
7207 (not
|
|
|
7208 (efs-save-match-data
|
|
|
7209 (string-match "/" file 1)))))
|
|
|
7210 ""
|
|
|
7211 (if (efs-save-match-data
|
|
|
7212 (not (string-match "/" file)))
|
|
|
7213 file
|
|
|
7214 (efs-internal-file-name-nondirectory name)))))
|
|
|
7215
|
|
|
7216 (defun efs-internal-file-name-nondirectory (name)
|
|
|
7217 ;; Version of file-name-nondirectory, without the efs-file-handler-function.
|
|
|
7218 ;; Useful to call this, if we have already decomposed the filename.
|
|
|
7219 (let (file-name-handler-alist)
|
|
|
7220 (file-name-nondirectory name)))
|
|
|
7221
|
|
|
7222 (defun efs-directory-file-name (dir)
|
|
|
7223 ;; Computes directory-file-name for remote files.
|
|
|
7224 ;; Needs to be careful not to turn /foo@bar:/ into /foo@bar:
|
|
|
7225 (let ((parsed (efs-ftp-path dir)))
|
|
|
7226 (if (string-equal "/" (nth 2 parsed))
|
|
|
7227 dir
|
|
|
7228 (efs-internal-directory-file-name dir))))
|
|
|
7229
|
|
|
7230 (defun efs-internal-directory-file-name (dir)
|
|
|
7231 ;; Call this if you want to apply directory-file-name to the remote
|
|
|
7232 ;; part of a efs-style path. Don't call for non-efs-style paths,
|
|
|
7233 ;; as this short-circuits the file-name-handler-alist completely.
|
|
|
7234 (let (file-name-handler-alist)
|
|
|
7235 (directory-file-name dir)))
|
|
|
7236
|
|
|
7237 (efs-defun efs-remote-directory-file-name nil (dir)
|
|
|
7238 "Returns the file name on the remote system of directory DIR.
|
|
|
7239 If the remote system is not unix, this may not be the same as the file name
|
|
|
7240 of the directory in efs's internal cache."
|
|
|
7241 (directory-file-name dir))
|
|
|
7242
|
|
|
7243 (defun efs-file-name-sans-versions (filename &optional keep-backup-versions)
|
|
|
7244 ;; Version of file-name-sans-versions for remote files.
|
|
|
7245 (or (file-name-absolute-p filename)
|
|
|
7246 (setq filename (expand-file-name filename)))
|
|
|
7247 (let ((parsed (efs-ftp-path filename)))
|
|
|
7248 (efs-internal-file-name-sans-versions
|
|
|
7249 (efs-host-type (car parsed) (nth 1 parsed))
|
|
|
7250 filename keep-backup-versions)))
|
|
|
7251
|
|
|
7252 (efs-defun efs-internal-file-name-sans-versions nil
|
|
|
7253 (filename &optional keep-backup-versions)
|
|
|
7254 (let (file-name-handler-alist)
|
|
|
7255 (file-name-sans-versions filename keep-backup-versions)))
|
|
|
7256
|
|
|
7257 (defun efs-diff-latest-backup-file (fn)
|
|
|
7258 ;; Version of diff latest backup file for remote files.
|
|
|
7259 ;; Accomodates non-unix.
|
|
|
7260 ;; Returns the latest backup for fn, according to the numbering
|
|
|
7261 ;; of the backups. Does not check file-newer-than-file-p.
|
|
|
7262 (let ((parsed (efs-ftp-path fn)))
|
|
|
7263 (efs-internal-diff-latest-backup-file
|
|
|
7264 (efs-host-type (car parsed) (nth 1 parsed)) fn)))
|
|
|
7265
|
|
|
7266 (efs-defun efs-internal-diff-latest-backup-file nil (fn)
|
|
|
7267 ;; Default behaviour is the behaviour in diff.el
|
|
|
7268 (let (file-name-handler-alist)
|
|
|
7269 (diff-latest-backup-file fn)))
|
|
|
7270
|
|
|
7271 (defun efs-unhandled-file-name-directory (filename)
|
|
|
7272 ;; Calculate a default unhandled directory for an efs buffer.
|
|
|
7273 ;; This is used to compute directories in which to execute
|
|
|
7274 ;; processes. This is relevant to V19 only. Doesn't do any harm for
|
|
|
7275 ;; older versions though. It would be nice if this wasn't such a
|
|
|
7276 ;; kludge.
|
|
|
7277 (file-name-directory efs-tmp-name-template))
|
|
|
7278
|
|
|
7279 (defun efs-file-truename (filename)
|
|
|
7280 ;; Calculates a remote file's truename, if this isn't inhibited.
|
|
|
7281 (let ((filename (expand-file-name filename)))
|
|
|
7282 (if (and efs-compute-remote-buffer-file-truename
|
|
|
7283 (memq (efs-host-type (car (efs-ftp-path filename)))
|
|
|
7284 efs-unix-host-types))
|
|
|
7285 (efs-internal-file-truename filename)
|
|
|
7286 filename)))
|
|
|
7287
|
|
|
7288 (defun efs-internal-file-truename (filename)
|
|
|
7289 ;; Internal function so that we don't keep checking
|
|
|
7290 ;; efs-compute-remote-buffer-file-truename, etc, as we recurse.
|
|
|
7291 (let ((dir (efs-file-name-directory filename))
|
|
|
7292 target dirfile)
|
|
|
7293 ;; Get the truename of the directory.
|
|
|
7294 (setq dirfile (efs-directory-file-name dir))
|
|
|
7295 ;; If these are equal, we have the (or a) root directory.
|
|
|
7296 (or (string= dir dirfile)
|
|
|
7297 (setq dir (efs-file-name-as-directory
|
|
|
7298 (efs-internal-file-truename dirfile))))
|
|
|
7299 (if (equal ".." (efs-file-name-nondirectory filename))
|
|
|
7300 (efs-directory-file-name (efs-file-name-directory
|
|
|
7301 (efs-directory-file-name dir)))
|
|
|
7302 (if (equal "." (efs-file-name-nondirectory filename))
|
|
|
7303 (efs-directory-file-name dir)
|
|
|
7304 ;; Put it back on the file name.
|
|
|
7305 (setq filename (concat dir (efs-file-name-nondirectory filename)))
|
|
|
7306 ;; Is the file name the name of a link?
|
|
|
7307 (setq target (efs-file-symlink-p filename))
|
|
|
7308 (if target
|
|
|
7309 ;; Yes => chase that link, then start all over
|
|
|
7310 ;; since the link may point to a directory name that uses links.
|
|
|
7311 ;; We can't safely use expand-file-name here
|
|
|
7312 ;; since target might look like foo/../bar where foo
|
|
|
7313 ;; is itself a link. Instead, we handle . and .. above.
|
|
|
7314 (if (file-name-absolute-p target)
|
|
|
7315 (efs-internal-file-truename target)
|
|
|
7316 (efs-internal-file-truename (concat dir target)))
|
|
|
7317 ;; No, we are done!
|
|
|
7318 filename)))))
|
|
|
7319
|
|
|
7320
|
|
|
7321 ;;;; ----------------------------------------------------------------
|
|
|
7322 ;;;; I/O functions
|
|
|
7323 ;;;; ----------------------------------------------------------------
|
|
|
7324
|
|
|
7325 (efs-define-fun efs-set-buffer-file-name (filename)
|
|
|
7326 ;; Sets the buffer local variables for filename appropriately.
|
|
|
7327 ;; A special function because Lucid and FSF do this differently.
|
|
|
7328 ;; This default behaviour is the lowest common denominator.
|
|
|
7329 (setq buffer-file-name filename))
|
|
|
7330
|
|
|
7331 (defun efs-write-region (start end filename &optional append visit &rest args)
|
|
|
7332 ;; write-region for remote files.
|
|
|
7333 ;; This version accepts the V19 interpretation for the arg VISIT.
|
|
|
7334 ;; However, making use of this within V18 may cause errors to crop up.
|
|
|
7335 ;; ARGS should catch the MULE coding-system argument.
|
|
|
7336 (if (stringp visit) (setq visit (expand-file-name visit)))
|
|
|
7337 (setq filename (expand-file-name filename))
|
|
|
7338 (let ((parsed (efs-ftp-path filename))
|
|
|
7339 ;; Make sure that the after-write-region-hook isn't called inside
|
|
|
7340 ;; the file-handler-alist
|
|
|
7341 (after-write-region-hook nil))
|
|
|
7342 (if parsed
|
|
|
7343 (let* ((host (car parsed))
|
|
|
7344 (user (nth 1 parsed))
|
|
|
7345 (host-type (efs-host-type host user))
|
|
|
7346 (temp (car (efs-make-tmp-name nil host)))
|
|
|
7347 (type (efs-xfer-type nil nil host-type filename))
|
|
|
7348 (abbr (and (or (stringp visit) (eq t visit) (null visit))
|
|
|
7349 (efs-relativize-filename
|
|
|
7350 (if (stringp visit) visit filename))))
|
|
|
7351 (buffer (current-buffer))
|
|
|
7352 (b-file-name buffer-file-name)
|
|
|
7353 (mod-p (buffer-modified-p)))
|
|
|
7354 (unwind-protect
|
|
|
7355 (progn
|
|
|
7356 (condition-case err
|
|
|
7357 (progn
|
|
|
7358 (unwind-protect
|
|
|
7359 (let ((executing-macro t))
|
|
|
7360 ;; let-bind executing-macro to inhibit messaging.
|
|
|
7361 ;; Setting VISIT to 'quiet is more elegant.
|
|
|
7362 ;; But in Emacs 18, doing it this way allows
|
|
|
7363 ;; us to modify the visited file modtime, so
|
|
|
7364 ;; that undo's show the buffer modified.
|
|
|
7365 (apply 'write-region start end
|
|
|
7366 temp nil visit args))
|
|
|
7367 ;; buffer-modified-p is now correctly set
|
|
|
7368 (setq buffer-file-name b-file-name)
|
|
|
7369 ;; File modtime is bogus, so clear.
|
|
|
7370 (clear-visited-file-modtime))
|
|
|
7371 (efs-copy-file-internal
|
|
|
7372 temp nil filename parsed (if append 'append t)
|
|
|
7373 nil (and abbr (format "Writing %s" abbr))
|
|
|
7374 ;; cont
|
|
|
7375 (efs-cont (result line cont-lines) (filename buffer
|
|
|
7376 visit)
|
|
|
7377 (if result
|
|
|
7378 (signal 'ftp-error
|
|
|
7379 (list "Opening output file"
|
|
|
7380 (format "FTP Error: \"%s\"" line)
|
|
|
7381 filename)))
|
|
|
7382 ;; The new file entry will be added by
|
|
|
7383 ;; efs-copy-file-internal.
|
|
|
7384 (cond
|
|
|
7385 ((eq visit t)
|
|
|
7386 ;; This will run asynch.
|
|
|
7387 (efs-save-buffer-excursion
|
|
|
7388 (set-buffer buffer)
|
|
|
7389 (efs-set-buffer-file-name filename)
|
|
|
7390 (efs-set-visited-file-modtime)))
|
|
|
7391 ((stringp visit)
|
|
|
7392 (efs-save-buffer-excursion
|
|
|
7393 (set-buffer buffer)
|
|
|
7394 (efs-set-buffer-file-name visit)
|
|
|
7395 (set-visited-file-modtime)))))
|
|
|
7396 nil type))
|
|
|
7397 (error
|
|
|
7398 ;; restore buffer-modified-p
|
|
|
7399 (let (file-name-handler-alist)
|
|
|
7400 (set-buffer-modified-p mod-p))
|
|
|
7401 (signal (car err) (cdr err))))
|
|
|
7402 (if (or (eq visit t)
|
|
|
7403 (and (stringp visit)
|
|
|
7404 (efs-ftp-path visit)))
|
|
|
7405 (efs-set-buffer-mode)))
|
|
|
7406 (efs-del-tmp-name temp))
|
|
|
7407 (and abbr (efs-message "Wrote %s" abbr)))
|
|
|
7408 (if (and (stringp visit) (efs-ftp-path visit))
|
|
|
7409 (progn
|
|
|
7410 (apply 'write-region start end filename append visit args)
|
|
|
7411 (efs-set-buffer-file-name visit)
|
|
|
7412 (efs-set-visited-file-modtime)
|
|
|
7413 (efs-set-buffer-mode))
|
|
|
7414 (error "efs-write-region called for a local file")))))
|
|
|
7415
|
|
|
7416 (defun efs-insert-file-contents (filename &optional visit &rest args)
|
|
|
7417 ;; Inserts file contents for remote files.
|
|
|
7418 ;; The additional ARGS covers V19 BEG and END. Should also handle the
|
|
|
7419 ;; CODING-SYSTEM arg for mule. Hope the two don't trip over each other.
|
|
|
7420 (barf-if-buffer-read-only)
|
|
|
7421 (unwind-protect
|
|
|
7422 (let* ((filename (expand-file-name filename))
|
|
|
7423 (parsed (efs-ftp-path filename))
|
|
|
7424 (host (car parsed))
|
|
|
7425 (host-type (efs-host-type host))
|
|
|
7426 (user (nth 1 parsed))
|
|
|
7427 (path (nth 2 parsed))
|
|
|
7428 (buffer (current-buffer)))
|
|
|
7429
|
|
|
7430 (if (or (file-exists-p filename)
|
|
|
7431 (let* ((res (and
|
|
|
7432 (not (efs-get-host-property host 'rnfr-failed))
|
|
|
7433 (efs-send-cmd
|
|
|
7434 host user (list 'quote 'rnfr path))))
|
|
|
7435 (line (nth 1 res)))
|
|
|
7436 ;; RNFR returns a 550 if the file doesn't exist.
|
|
|
7437 (if (and line (>= (length line) 4)
|
|
|
7438 (string-equal "550 " (substring line 0 4)))
|
|
|
7439 nil
|
|
|
7440 (if (car res) (efs-set-host-property host 'rnfr-failed t))
|
|
|
7441 (efs-del-from-ls-cache filename t nil)
|
|
|
7442 (efs-del-hash-entry
|
|
|
7443 (efs-canonize-file-name (file-name-directory filename))
|
|
|
7444 efs-files-hashtable)
|
|
|
7445 (file-exists-p filename))))
|
|
|
7446
|
|
|
7447 (let ((temp (concat
|
|
|
7448 (car (efs-make-tmp-name nil host))
|
|
|
7449 (efs-internal-file-name-extension filename)))
|
|
|
7450 (type (efs-xfer-type host-type filename nil nil))
|
|
|
7451 (abbr (efs-relativize-filename filename))
|
|
|
7452 (i-f-c-size 0))
|
|
|
7453
|
|
|
7454 (unwind-protect
|
|
|
7455 (efs-copy-file-internal
|
|
|
7456 filename parsed temp nil t nil
|
|
|
7457 (format "Retrieving %s" abbr)
|
|
|
7458 (efs-cont (result line cont-lines) (filename visit buffer
|
|
|
7459 host-type
|
|
|
7460 temp args)
|
|
|
7461 (if result
|
|
|
7462 (signal 'ftp-error
|
|
|
7463 (list "Opening input file"
|
|
|
7464 (format "FTP Error: \"%s\""
|
|
|
7465 line)
|
|
|
7466 filename))
|
|
|
7467 (if (eq host-type 'coke)
|
|
|
7468 (efs-coke-insert-beverage-contents buffer filename
|
|
|
7469 line)
|
|
|
7470 (efs-save-buffer-excursion
|
|
|
7471 (set-buffer buffer)
|
|
|
7472 (if (or (file-readable-p temp)
|
|
|
7473 (sleep-for efs-retry-time)
|
|
|
7474 ;; Wait for file to hopefully appear.
|
|
|
7475 (file-readable-p temp))
|
|
|
7476
|
|
|
7477 (setq i-f-c-size
|
|
|
7478 (nth 1 (apply 'insert-file-contents
|
|
|
7479 temp visit args)))
|
|
|
7480 (signal 'ftp-error
|
|
|
7481 (list
|
|
|
7482 "Opening input file:"
|
|
|
7483 (format
|
|
|
7484 "FTP Error: %s not arrived or readable"
|
|
|
7485 filename))))
|
|
|
7486 ;; This is done asynch
|
|
|
7487 (if visit
|
|
|
7488 (let ((buffer-file-name filename))
|
|
|
7489 (efs-set-visited-file-modtime)))))))
|
|
|
7490 nil type)
|
|
|
7491 (efs-del-tmp-name temp))
|
|
|
7492 ;; Return (FILENAME SIZE)
|
|
|
7493 (list filename i-f-c-size))
|
|
|
7494 (signal 'file-error (list "Opening input file" filename))))
|
|
|
7495 ;; Set buffer-file-name at the very last, so if anything bombs, we're
|
|
|
7496 ;; not visiting.
|
|
|
7497 (if visit
|
|
|
7498 (efs-set-buffer-file-name filename))))
|
|
|
7499
|
|
|
7500 (defun efs-revert-buffer (arg noconfirm)
|
|
|
7501 "Revert this buffer from a remote file using ftp."
|
|
|
7502 (let ((opoint (point)))
|
|
|
7503 (cond ((null buffer-file-name)
|
|
|
7504 (error "Buffer does not seem to be associated with any file"))
|
|
|
7505 ((or noconfirm
|
|
|
7506 (yes-or-no-p (format "Revert buffer from file %s? "
|
|
|
7507 buffer-file-name)))
|
|
|
7508 (let ((buffer-read-only nil))
|
|
|
7509 ;; Set buffer-file-name to nil
|
|
|
7510 ;; so that we don't try to lock the file.
|
|
|
7511 (let ((buffer-file-name nil))
|
|
|
7512 (unlock-buffer)
|
|
|
7513 (erase-buffer))
|
|
|
7514 (insert-file-contents buffer-file-name t))
|
|
|
7515 (goto-char (min opoint (point-max)))
|
|
|
7516 (after-find-file nil)
|
|
|
7517 t))))
|
|
|
7518
|
|
|
7519 (defun efs-recover-file (file)
|
|
|
7520 ;; Version of recover file for remote files, and remote autosave files too.
|
|
|
7521 (if (auto-save-file-name-p file) (error "%s is an auto-save file" file))
|
|
|
7522 (let* ((file-name (let ((buffer-file-name file)) (make-auto-save-file-name)))
|
|
|
7523 (file-name-parsed (efs-ftp-path file-name))
|
|
|
7524 (file-parsed (efs-ftp-path file))
|
|
|
7525 (efs-ls-uncache t))
|
|
|
7526 (cond ((not (file-newer-than-file-p file-name file))
|
|
|
7527 (error "Auto-save file %s not current" file-name))
|
|
|
7528 ((save-window-excursion
|
|
|
7529 (or (eq system-type 'vax-vms)
|
|
|
7530 (progn
|
|
|
7531 (with-output-to-temp-buffer "*Directory*"
|
|
|
7532 (buffer-disable-undo standard-output)
|
|
|
7533 (if file-parsed
|
|
|
7534 (progn
|
|
|
7535 (princ (format "On the host %s:\n"
|
|
|
7536 (car file-parsed)))
|
|
|
7537 (princ
|
|
|
7538 (let ((default-directory exec-directory))
|
|
|
7539 (efs-ls file (if (file-symlink-p file)
|
|
|
7540 "-lL" "-l")
|
|
|
7541 t t))))
|
|
|
7542 (princ "On the local host:\n")
|
|
|
7543 (let ((default-directory exec-directory))
|
|
|
7544 (call-process "ls" nil standard-output nil
|
|
|
7545 (if (file-symlink-p file) "-lL" "-l")
|
|
|
7546 file)))
|
|
|
7547 (princ "\nAUTO SAVE FILE on the ")
|
|
|
7548 (if file-name-parsed
|
|
|
7549 (progn
|
|
|
7550 (princ (format "host %s:\n"
|
|
|
7551 (car file-name-parsed)))
|
|
|
7552 (princ
|
|
|
7553 (efs-ls file-name
|
|
|
7554 (if (file-symlink-p file-name) "-lL" "-l")
|
|
|
7555 t t)))
|
|
|
7556 (princ "local host:\n")
|
|
|
7557 (let ((default-directory exec-directory))
|
|
|
7558 (call-process "ls" nil standard-output nil
|
|
|
7559 "-l" file-name)))
|
|
|
7560 (princ "\nFile modification times are given in ")
|
|
|
7561 (princ "the local time of each host.\n"))
|
|
|
7562 (save-excursion
|
|
|
7563 (set-buffer "*Directory*")
|
|
|
7564 (goto-char (point-min))
|
|
|
7565 (while (not (eobp))
|
|
|
7566 (end-of-line)
|
|
|
7567 (if (> (current-column) (window-width))
|
|
|
7568 (progn
|
|
|
7569 (skip-chars-backward " \t")
|
|
|
7570 (skip-chars-backward "^ \t\n")
|
|
|
7571 (if (> (current-column) 12)
|
|
|
7572 (progn
|
|
|
7573 (delete-horizontal-space)
|
|
|
7574 (insert "\n ")))))
|
|
|
7575 (forward-line 1))
|
|
|
7576 (set-buffer-modified-p nil)
|
|
|
7577 (goto-char (point-min)))))
|
|
|
7578 (yes-or-no-p (format "Recover using this auto save file? ")))
|
|
|
7579 (switch-to-buffer (find-file-noselect file t))
|
|
|
7580 (let ((buffer-read-only nil))
|
|
|
7581 (erase-buffer)
|
|
|
7582 (insert-file-contents file-name nil))
|
|
|
7583 (after-find-file nil))
|
|
|
7584 (t (error "Recover-file cancelled."))))
|
|
|
7585 ;; This is no longer done in V19. However, I like the caution for
|
|
|
7586 ;; remote files, where file-newer-than-file-p may lie.
|
|
|
7587 (setq buffer-auto-save-file-name nil)
|
|
|
7588 (message "Auto-save off in this buffer till you do M-x auto-save-mode."))
|
|
|
7589
|
|
|
7590 ;;;; ------------------------------------------------------------------
|
|
|
7591 ;;;; Attributes of files.
|
|
|
7592 ;;;; ------------------------------------------------------------------
|
|
|
7593
|
|
|
7594 (defun efs-file-symlink-p (file)
|
|
|
7595 ;; Version of file-symlink-p for remote files.
|
|
|
7596 ;; Call efs-expand-file-name rather than the normal
|
|
|
7597 ;; expand-file-name to stop loops when using a package that
|
|
|
7598 ;; redefines both file-symlink-p and expand-file-name.
|
|
|
7599 ;; Do not use efs-get-file-entry, because a child-lookup won't do.
|
|
|
7600 (let* ((file (efs-expand-file-name file))
|
|
|
7601 (ignore-case (memq (efs-host-type (car (efs-ftp-path file)))
|
|
|
7602 efs-case-insensitive-host-types))
|
|
|
7603 (file-type (car (efs-get-hash-entry
|
|
|
7604 (efs-get-file-part file)
|
|
|
7605 (efs-get-files (file-name-directory file))
|
|
|
7606 ignore-case))))
|
|
|
7607 (and (stringp file-type)
|
|
|
7608 (if (file-name-absolute-p file-type)
|
|
|
7609 (efs-replace-path-component file file-type)
|
|
|
7610 file-type))))
|
|
|
7611
|
|
|
7612 (defun efs-file-exists-p (path)
|
|
|
7613 ;; file-exists-p for remote file. Uses the cache if possible.
|
|
|
7614 (let* ((path (expand-file-name path))
|
|
|
7615 (parsed (efs-ftp-path path)))
|
|
|
7616 (efs-internal-file-exists-p (efs-host-type (car parsed) (nth 1 parsed))
|
|
|
7617 path)))
|
|
|
7618
|
|
|
7619 (efs-defun efs-internal-file-exists-p nil (path)
|
|
|
7620 (and (efs-get-file-entry path) t))
|
|
|
7621
|
|
|
7622 (defun efs-file-directory-p (file)
|
|
|
7623 (let* ((file (expand-file-name file))
|
|
|
7624 (parsed (efs-ftp-path file)))
|
|
|
7625 (efs-internal-file-directory-p (efs-host-type (car parsed) (nth 1 parsed))
|
|
|
7626 file)))
|
|
|
7627
|
|
|
7628 (efs-defun efs-internal-file-directory-p nil (path)
|
|
|
7629 ;; Version of file-directory-p for remote files.
|
|
|
7630 (let ((parsed (efs-ftp-path path)))
|
|
|
7631 (or (string-equal (nth 2 parsed) "/") ; root is always a directory
|
|
|
7632 (let ((file-ent (car (efs-get-file-entry
|
|
|
7633 (efs-internal-file-name-as-directory
|
|
|
7634 (efs-host-type (car parsed) (nth 1 parsed))
|
|
|
7635 path)))))
|
|
|
7636 ;; We do a file-name-as-directory on path here because some
|
|
|
7637 ;; machines (VMS) use a .DIR to indicate the filename associated
|
|
|
7638 ;; with a directory. This needs to be canonicalized.
|
|
|
7639 (if (stringp file-ent)
|
|
|
7640 (efs-internal-file-directory-p
|
|
|
7641 nil
|
|
|
7642 (efs-chase-symlinks
|
|
|
7643 ;; efs-internal-directory-file-name
|
|
|
7644 ;; only loses for paths where the remote file
|
|
|
7645 ;; is /. This has been eliminated.
|
|
|
7646 (efs-internal-directory-file-name path)))
|
|
|
7647 file-ent)))))
|
|
|
7648
|
|
|
7649 (defun efs-file-attributes (file)
|
|
|
7650 ;; Returns file-file-attributes for a remote file.
|
|
|
7651 ;; For the file modtime does not return efs's cached value, as that
|
|
|
7652 ;; corresponds to buffer-file-modtime (i.e. the modtime of the file
|
|
|
7653 ;; the last time the buffer was vsisted or saved). Caching modtimes
|
|
|
7654 ;; does not make much sense, as they are usually used to determine
|
|
|
7655 ;; if a cache is stale. The modtime if a remote file can be obtained with
|
|
|
7656 ;; efs-get-file-mdtm. This is _not_ returned for the 5th entry here,
|
|
|
7657 ;; because it requires an FTP transaction, and a priori we don't know
|
|
|
7658 ;; if the caller actually cares about this info. Having file-attributes
|
|
|
7659 ;; return such a long list of info is not well suited to remote files,
|
|
|
7660 ;; as some of this info may be costly to obtain.
|
|
|
7661 (let* ((file (expand-file-name file))
|
|
|
7662 (ent (efs-get-file-entry file)))
|
|
|
7663 (if ent
|
|
|
7664 (let* ((parsed (efs-ftp-path file))
|
|
|
7665 (host (nth 0 parsed))
|
|
|
7666 (user (nth 1 parsed))
|
|
|
7667 (path (nth 2 parsed))
|
|
|
7668 (type (car ent))
|
|
|
7669 (size (or (nth 1 ent) -1))
|
|
|
7670 (owner (nth 2 ent))
|
|
|
7671 (modes (nth 3 ent))
|
|
|
7672 ;; Hack to give remote files a "unique" "inode number".
|
|
|
7673 ;; It's actually the sum of the characters in its name.
|
|
|
7674 ;; It's not even really unique.
|
|
|
7675 (inode (apply '+
|
|
|
7676 (nconc (mapcar 'identity host)
|
|
|
7677 (mapcar 'identity user)
|
|
|
7678 (mapcar 'identity
|
|
|
7679 (efs-internal-directory-file-name
|
|
|
7680 path)))))
|
|
|
7681 (nlinks (or (nth 4 ent) -1))) ; return -1 if we don't know
|
|
|
7682 (list
|
|
|
7683 (if (and (stringp type) (file-name-absolute-p type))
|
|
|
7684 (efs-replace-path-component file type)
|
|
|
7685 type) ;0 file type
|
|
|
7686 nlinks ;1 link count
|
|
|
7687 (if owner ;2 uid
|
|
|
7688 ;; Not really a unique integer,
|
|
|
7689 ;; just a half-hearted attempt
|
|
|
7690 (apply '+ (mapcar 'identity owner))
|
|
|
7691 -1)
|
|
|
7692 -1 ;3 gid
|
|
|
7693 '(0 0) ;4 atime
|
|
|
7694 '(0 0) ;5 mtime
|
|
|
7695 '(0 0) ;6 ctime
|
|
|
7696 size ;7 size
|
|
|
7697 (or modes ;8 mode
|
|
|
7698 (concat
|
|
|
7699 (cond ((stringp type) "l")
|
|
|
7700 (type "d")
|
|
|
7701 (t "-"))
|
|
|
7702 "?????????"))
|
|
|
7703 nil ;9 gid weird (Who knows if the gid
|
|
|
7704 ; would be changed?)
|
|
|
7705 inode ;10 inode
|
|
|
7706 -1 ;11 device number [v19 only]
|
|
|
7707 )))))
|
|
|
7708
|
|
|
7709 (defun efs-file-writable-p (file)
|
|
|
7710 ;; file-writable-p for remote files.
|
|
|
7711 ;; Does not attempt to open the file, but just looks at the cached file
|
|
|
7712 ;; modes.
|
|
|
7713 (let* ((file (expand-file-name file))
|
|
|
7714 (ent (efs-get-file-entry file)))
|
|
|
7715 (if (and ent (or (not (stringp (car ent)))
|
|
|
7716 (setq file (efs-chase-symlinks file)
|
|
|
7717 ent (efs-get-file-entry file))))
|
|
|
7718 (let* ((owner (nth 2 ent))
|
|
|
7719 (modes (nth 3 ent))
|
|
|
7720 (parsed (efs-ftp-path file))
|
|
|
7721 (host-type (efs-host-type (car parsed)))
|
|
|
7722 (user (nth 1 parsed)))
|
|
|
7723 (if (memq host-type efs-unix-host-types)
|
|
|
7724 (setq host-type 'unix))
|
|
|
7725 (efs-internal-file-writable-p host-type user owner modes))
|
|
|
7726 (let ((dir (file-name-directory file)))
|
|
|
7727 (and
|
|
|
7728 (not (string-equal dir file))
|
|
|
7729 (file-directory-p dir)
|
|
|
7730 (file-writable-p dir))))))
|
|
|
7731
|
|
|
7732 (efs-defun efs-internal-file-writable-p nil (user owner modes)
|
|
|
7733 ;; By default, we'll just guess yes.
|
|
|
7734 t)
|
|
|
7735
|
|
|
7736 (efs-defun efs-internal-file-writable-p unix (user owner modes)
|
|
|
7737 (if (and modes
|
|
|
7738 (not (string-equal user "root")))
|
|
|
7739 (null
|
|
|
7740 (null
|
|
|
7741 (if (string-equal user owner)
|
|
|
7742 (memq ?w (list (aref modes 2) (aref modes 5)
|
|
|
7743 (aref modes 8)))
|
|
|
7744 (memq ?w (list (aref modes 5) (aref modes 8))))))
|
|
|
7745 t)) ; guess
|
|
|
7746
|
|
|
7747 (defun efs-file-readable-p (file)
|
|
|
7748 ;; Version of file-readable-p that works for remote files.
|
|
|
7749 ;; Works by checking efs's cache of the file modes.
|
|
|
7750 (let* ((file (expand-file-name file))
|
|
|
7751 (ent (efs-get-file-entry file)))
|
|
|
7752 (and ent
|
|
|
7753 (or (not (stringp (car ent)))
|
|
|
7754 (setq ent (efs-get-file-entry (efs-chase-symlinks file))))
|
|
|
7755 ;; file exists
|
|
|
7756 (let* ((parsed (efs-ftp-path file))
|
|
|
7757 (owner (nth 2 ent))
|
|
|
7758 (modes (nth 3 ent))
|
|
|
7759 (host-type (efs-host-type (car parsed)))
|
|
|
7760 (user (nth 1 parsed)))
|
|
|
7761 (if (memq host-type efs-unix-host-types)
|
|
|
7762 (setq host-type 'unix))
|
|
|
7763 (efs-internal-file-readable-p host-type user owner modes)))))
|
|
|
7764
|
|
|
7765 (efs-defun efs-internal-file-readable-p nil (user owner modes)
|
|
|
7766 ;; Guess t by default
|
|
|
7767 t)
|
|
|
7768
|
|
|
7769 (efs-defun efs-internal-file-readable-p unix (user owner modes)
|
|
|
7770 (if (and modes
|
|
|
7771 (not (string-equal user "root")))
|
|
|
7772 (null
|
|
|
7773 (null
|
|
|
7774 (if (string-equal user owner)
|
|
|
7775 (memq ?r (list (aref modes 1) (aref modes 4)
|
|
|
7776 (aref modes 7)))
|
|
|
7777 (memq ?r (list (aref modes 4) (aref modes 7))))))
|
|
|
7778 t)) ; guess
|
|
|
7779
|
|
|
7780 (defun efs-file-executable-p (file)
|
|
|
7781 ;; Version of file-executable-p for remote files.
|
|
|
7782 (let ((ent (efs-get-file-entry file)))
|
|
|
7783 (and ent
|
|
|
7784 (or (not (stringp (car ent)))
|
|
|
7785 (setq ent (efs-get-file-entry (efs-chase-symlinks file))))
|
|
|
7786 ;; file exists
|
|
|
7787 (let* ((parsed (efs-ftp-path file))
|
|
|
7788 (owner (nth 2 ent))
|
|
|
7789 (modes (nth 3 ent))
|
|
|
7790 (host-type (efs-host-type (car parsed)))
|
|
|
7791 (user (nth 1 parsed)))
|
|
|
7792 (if (memq host-type efs-unix-host-types)
|
|
|
7793 (setq host-type 'unix))
|
|
|
7794 (efs-internal-file-executable-p host-type user owner modes)))))
|
|
|
7795
|
|
|
7796 (efs-defun efs-internal-file-executable-p nil (user owner modes)
|
|
|
7797 ;; Guess t by default
|
|
|
7798 t)
|
|
|
7799
|
|
|
7800 (efs-defun efs-internal-file-executable-p unix (user owner modes)
|
|
|
7801 (if (and modes
|
|
|
7802 (not (string-equal user "root")))
|
|
|
7803 (null
|
|
|
7804 (null
|
|
|
7805 (if (string-equal user owner)
|
|
|
7806 (memq ?x (list (aref modes 3) (aref modes 6)
|
|
|
7807 (aref modes 9)))
|
|
|
7808 (memq ?x (list (aref modes 6) (aref modes 9))))))
|
|
|
7809 t)) ; guess
|
|
|
7810
|
|
|
7811 (defun efs-file-accessible-directory-p (dir)
|
|
|
7812 ;; Version of file-accessible-directory-p for remote directories.
|
|
|
7813 (let ((file (directory-file-name dir)))
|
|
|
7814 (and (efs-file-directory-p file) (efs-file-executable-p file))))
|
|
|
7815
|
|
|
7816 ;;;; --------------------------------------------------------------
|
|
|
7817 ;;;; Listing directories.
|
|
|
7818 ;;;; --------------------------------------------------------------
|
|
|
7819
|
|
|
7820 (defun efs-shell-regexp-to-regexp (regexp)
|
|
|
7821 ;; Converts a shell regexp to an emacs regexp.
|
|
|
7822 ;; Probably full of bugs. Tries to follow csh globbing.
|
|
|
7823 (let ((curly 0)
|
|
|
7824 backslash)
|
|
|
7825 (concat "^"
|
|
|
7826 (mapconcat
|
|
|
7827 (function
|
|
|
7828 (lambda (char)
|
|
|
7829 (cond
|
|
|
7830 (backslash
|
|
|
7831 (setq backslash nil)
|
|
|
7832 (regexp-quote (char-to-string char)))
|
|
|
7833 ((and (> curly 0) (eq char ?,))
|
|
|
7834 "\\|")
|
|
|
7835 ((memq char '(?[ ?]))
|
|
|
7836 (char-to-string char))
|
|
|
7837 ((eq char ??)
|
|
|
7838 ".")
|
|
|
7839 ((eq char ?\\)
|
|
|
7840 (setq backslash t)
|
|
|
7841 "")
|
|
|
7842 ((eq char ?*)
|
|
|
7843 ".*")
|
|
|
7844 ((eq char ?{)
|
|
|
7845 (setq curly (1+ curly))
|
|
|
7846 "\\(")
|
|
|
7847 ((and (eq char ?}) (> curly 0))
|
|
|
7848 (setq curly (1- curly))
|
|
|
7849 "\\)")
|
|
|
7850 (t (regexp-quote (char-to-string char))))))
|
|
|
7851 regexp nil)
|
|
|
7852 "$")))
|
|
|
7853
|
|
|
7854
|
|
|
7855 ;;; Getting directory listings.
|
|
|
7856
|
|
116
|
7857 (defun efs-directory-files (directory &optional full match nosort &rest ignored-for-now)
|
|
98
|
7858 ;; Returns directory-files for remote directories.
|
|
|
7859 ;; NOSORT is a V19 arg.
|
|
|
7860 (let* ((directory (expand-file-name directory))
|
|
|
7861 (parsed (efs-ftp-path directory))
|
|
|
7862 (directory (efs-internal-file-name-as-directory
|
|
|
7863 (efs-host-type (car parsed) (nth 1 parsed)) directory))
|
|
|
7864 files)
|
|
|
7865 (efs-barf-if-not-directory directory)
|
|
|
7866 (setq files (efs-hash-table-keys (efs-get-files directory) nosort))
|
|
|
7867 (cond
|
|
|
7868 ((null (or full match))
|
|
|
7869 files)
|
|
|
7870 (match ; this is slow case
|
|
|
7871 (let (res f)
|
|
|
7872 (efs-save-match-data
|
|
|
7873 (while files
|
|
|
7874 (setq f (if full (concat directory (car files)) (car files))
|
|
|
7875 files (cdr files))
|
|
|
7876 (if (string-match match f)
|
|
|
7877 (setq res (nconc res (list f))))))
|
|
|
7878 res))
|
|
|
7879 (full
|
|
|
7880 (mapcar (function
|
|
|
7881 (lambda (fn)
|
|
|
7882 (concat directory fn)))
|
|
|
7883 files)))))
|
|
|
7884
|
|
|
7885 (defun efs-list-directory (dirname &optional verbose)
|
|
|
7886 ;; Version of list-directory for remote directories.
|
|
|
7887 ;; If verbose is nil, it gets its information from efs's
|
|
|
7888 ;; internal cache.
|
|
|
7889 (let* ((dirname (expand-file-name (or dirname default-directory)))
|
|
|
7890 header)
|
|
|
7891 (if (file-directory-p dirname)
|
|
|
7892 (setq dirname (file-name-as-directory dirname)))
|
|
|
7893 (setq header dirname)
|
|
|
7894 (with-output-to-temp-buffer "*Directory*"
|
|
|
7895 (buffer-disable-undo standard-output)
|
|
|
7896 (princ "Directory ")
|
|
|
7897 (princ header)
|
|
|
7898 (terpri)
|
|
|
7899 (princ
|
|
|
7900 (efs-ls dirname (if verbose
|
|
|
7901 list-directory-verbose-switches
|
|
|
7902 list-directory-brief-switches)
|
|
|
7903 t)))))
|
|
|
7904
|
|
|
7905 ;;;; -------------------------------------------------------------------
|
|
|
7906 ;;;; Manipulating buffers.
|
|
|
7907 ;;;; -------------------------------------------------------------------
|
|
|
7908
|
|
|
7909 (defun efs-get-file-buffer (file)
|
|
|
7910 ;; Version of get-file-buffer for remote files. Needs to fuss over things
|
|
|
7911 ;; like OS's which are case-insens. for file names.
|
|
|
7912 (let ((file (efs-canonize-file-name (expand-file-name file)))
|
|
|
7913 (buff-list (buffer-list))
|
|
|
7914 buff-name)
|
|
|
7915 (catch 'match
|
|
|
7916 (while buff-list
|
|
|
7917 (and (setq buff-name (buffer-file-name (car buff-list)))
|
|
|
7918 (= (length buff-name) (length file)) ; efficiency hack
|
|
|
7919 (string-equal (efs-canonize-file-name buff-name) file)
|
|
|
7920 (throw 'match (car buff-list)))
|
|
|
7921 (setq buff-list (cdr buff-list))))))
|
|
|
7922
|
|
|
7923 (defun efs-create-file-buffer (filename)
|
|
|
7924 ;; Version of create-file-buffer for remote file names.
|
|
|
7925 (let* ((parsed (efs-ftp-path (expand-file-name filename)))
|
|
|
7926 (file (nth 2 parsed))
|
|
|
7927 (host (car parsed))
|
|
|
7928 (host-type (efs-host-type host))
|
|
|
7929 (buff (cond
|
|
|
7930 ((null efs-fancy-buffer-names)
|
|
|
7931 (if (string-equal file "/")
|
|
|
7932 "/"
|
|
|
7933 (efs-internal-file-name-nondirectory
|
|
|
7934 (efs-internal-directory-file-name file))))
|
|
|
7935 ((stringp efs-fancy-buffer-names)
|
|
|
7936 (format efs-fancy-buffer-names
|
|
|
7937 (if (string-equal file "/")
|
|
|
7938 "/"
|
|
|
7939 (efs-internal-file-name-nondirectory
|
|
|
7940 (efs-internal-directory-file-name file)))
|
|
|
7941 (substring host 0 (string-match "\\." host 1))))
|
|
|
7942 (t ; efs-fancy-buffer-names had better be a function
|
|
|
7943 (funcall efs-fancy-buffer-names host
|
|
|
7944 (nth 1 parsed) file)))))
|
|
|
7945 (if (memq host-type efs-case-insensitive-host-types)
|
|
|
7946 (cond ((eq efs-buffer-name-case 'down)
|
|
|
7947 (setq buff (downcase buff)))
|
|
|
7948 ((eq efs-buffer-name-case 'up)
|
|
|
7949 (setq buff (upcase buff)))))
|
|
|
7950 (get-buffer-create (generate-new-buffer-name buff))))
|
|
|
7951
|
|
|
7952 (defun efs-set-buffer-mode ()
|
|
|
7953 "Set correct modes for the current buffer if it is visiting a remote file."
|
|
|
7954 (if (and (stringp buffer-file-name)
|
|
|
7955 (efs-ftp-path buffer-file-name))
|
|
|
7956 (progn
|
|
|
7957 (auto-save-mode efs-auto-save)
|
|
|
7958 (set (make-local-variable 'revert-buffer-function)
|
|
|
7959 'efs-revert-buffer)
|
|
|
7960 (set (make-local-variable 'default-directory-function)
|
|
|
7961 'efs-default-dir-function))))
|
|
|
7962
|
|
|
7963 ;;;; ---------------------------------------------------------
|
|
|
7964 ;;;; Functions for doing backups.
|
|
|
7965 ;;;; ---------------------------------------------------------
|
|
|
7966
|
|
|
7967 (defun efs-backup-buffer ()
|
|
|
7968 ;; Version of backup-buffer for buffers visiting remote files.
|
|
|
7969 (if efs-make-backup-files
|
|
|
7970 (let* ((parsed (efs-ftp-path buffer-file-name))
|
|
|
7971 (host (car parsed))
|
|
|
7972 (host-type (efs-host-type (car parsed))))
|
|
|
7973 (if (or (not (listp efs-make-backup-files))
|
|
|
7974 (memq host-type efs-make-backup-files))
|
|
|
7975 (efs-internal-backup-buffer
|
|
|
7976 host host-type (nth 1 parsed) (nth 2 parsed))))))
|
|
|
7977
|
|
|
7978 (defun efs-internal-backup-buffer (host host-type user remote-path)
|
|
|
7979 ;; This is almost a copy of the function in files.el, modified
|
|
|
7980 ;; to check to see if the backup file exists, before deleting it.
|
|
|
7981 ;; It also supports efs-backup-by-copying, and tries to do the
|
|
|
7982 ;; right thing about backup-by-copying-when-mismatch. Only called
|
|
|
7983 ;; for remote files.
|
|
|
7984 ;; Set the umask now, so that `setmodes' knows about it.
|
|
|
7985 (efs-set-umask host user)
|
|
|
7986 (let ((ent (efs-get-file-entry (expand-file-name buffer-file-name)))
|
|
|
7987 ;; Never do version-control if the remote operating system is doing it.
|
|
|
7988 (version-control (if (memq host-type efs-version-host-types)
|
|
|
7989 'never
|
|
|
7990 version-control))
|
|
|
7991 modstring)
|
|
|
7992 (and make-backup-files
|
|
|
7993 (not buffer-backed-up)
|
|
|
7994 ent ; i.e. file-exists-p
|
|
|
7995 (not (eq t (car ent)))
|
|
|
7996 (or (null (setq modstring (nth 3 ent)))
|
|
|
7997 (not (memq host-type efs-unix-host-types))
|
|
|
7998 (memq (aref modstring 0) '(?- ?l)))
|
|
|
7999 (or (< (length remote-path) 5)
|
|
|
8000 (not (string-equal "/tmp/" (substring remote-path 0 5))))
|
|
|
8001 (condition-case ()
|
|
|
8002 (let* ((backup-info (find-backup-file-name buffer-file-name))
|
|
|
8003 (backupname (car backup-info))
|
|
|
8004 (targets (cdr backup-info))
|
|
|
8005 (links (nth 4 ent))
|
|
|
8006 setmodes)
|
|
|
8007 (condition-case ()
|
|
|
8008 (if (or file-precious-flag
|
|
|
8009 (stringp (car ent)) ; symlinkp
|
|
|
8010 efs-backup-by-copying
|
|
|
8011 (and backup-by-copying-when-linked
|
|
|
8012 links (> links 1))
|
|
|
8013 (and backup-by-copying-when-mismatch
|
|
|
8014 (not
|
|
|
8015 (if (memq
|
|
|
8016 host-type
|
|
|
8017 efs-case-insensitive-host-types)
|
|
|
8018 (string-equal
|
|
|
8019 (downcase user) (downcase (nth 2 ent)))
|
|
|
8020 (string-equal user (nth 2 ent))))))
|
|
|
8021 (copy-file buffer-file-name backupname t t)
|
|
|
8022 (condition-case ()
|
|
|
8023 (if (file-exists-p backupname)
|
|
|
8024 (delete-file backupname))
|
|
|
8025 (file-error nil))
|
|
|
8026 (rename-file buffer-file-name backupname t)
|
|
|
8027 (setq setmodes (file-modes backupname)))
|
|
|
8028 (file-error
|
|
|
8029 ;; If trouble writing the backup, write it in ~.
|
|
|
8030 (setq backupname (expand-file-name "~/%backup%~"))
|
|
|
8031 (message
|
|
|
8032 "Cannot write backup file; backing up in ~/%%backup%%~")
|
|
|
8033 (sleep-for 1)
|
|
|
8034 (copy-file buffer-file-name backupname t t)))
|
|
|
8035 (setq buffer-backed-up t)
|
|
|
8036 ;; Starting with 19.26, trim-versions-without-asking
|
|
|
8037 ;; has been renamed to delete-old-verions.
|
|
|
8038 (if (and targets
|
|
|
8039 (or (if (boundp 'trim-versions-without-asking)
|
|
|
8040 trim-versions-without-asking
|
|
|
8041 (and
|
|
|
8042 (boundp 'delete-old-versions)
|
|
|
8043 delete-old-versions))
|
|
|
8044 (y-or-n-p (format
|
|
|
8045 "Delete excess backup versions of %s? "
|
|
|
8046 buffer-file-name))))
|
|
|
8047 (while targets
|
|
|
8048 (condition-case ()
|
|
|
8049 (delete-file (car targets))
|
|
|
8050 (file-error nil))
|
|
|
8051 (setq targets (cdr targets))))
|
|
|
8052 ;; If the file was already written with the right modes,
|
|
|
8053 ;; don't return set-modes.
|
|
|
8054 (and setmodes
|
|
|
8055 (null
|
|
|
8056 (let ((buff (get-buffer
|
|
|
8057 (efs-ftp-process-buffer host user))))
|
|
|
8058 (and buff
|
|
|
8059 (save-excursion
|
|
|
8060 (set-buffer buff)
|
|
|
8061 (and (integerp efs-process-umask)
|
|
|
8062 (= (efs-modes-from-umask efs-process-umask)
|
|
|
8063 setmodes))))))
|
|
|
8064 setmodes))
|
|
|
8065 (file-error nil)))))
|
|
|
8066
|
|
|
8067 ;;;; ------------------------------------------------------------
|
|
|
8068 ;;;; Redefinition for Emacs file mode support
|
|
|
8069 ;;;; ------------------------------------------------------------
|
|
|
8070
|
|
|
8071 (defmacro efs-build-mode-string-element (int suid-p sticky-p)
|
|
|
8072 ;; INT is between 0 and 7.
|
|
|
8073 ;; If SUID-P is non-nil, we are building the 3-char string for either
|
|
|
8074 ;; the owner or group, and the s[ug]id bit is set.
|
|
|
8075 ;; If STICKY-P is non-nil, we are building the string for other perms,
|
|
|
8076 ;; and the sticky bit is set.
|
|
|
8077 ;; It doesn't make sense for both SUID-P and STICKY-P be non-nil!
|
|
|
8078 (` (let* ((int (, int))
|
|
|
8079 (suid-p (, suid-p))
|
|
|
8080 (sticky-p (, sticky-p))
|
|
|
8081 (read-bit (if (memq int '(4 5 6 7)) "r" "-"))
|
|
|
8082 (write-bit (if (memq int '(2 3 6 7)) "w" "-"))
|
|
|
8083 (x-bit (if (memq int '(1 3 5 7))
|
|
|
8084 (cond (suid-p "s") (sticky-p "t") ("x"))
|
|
|
8085 (cond (suid-p "S") (sticky-p "T") ("-")))))
|
|
|
8086 (concat read-bit write-bit x-bit))))
|
|
|
8087
|
|
|
8088 (defun efs-mode-string (int)
|
|
|
8089 ;; Takes an octal integer between 0 and 7777, and returns the 9 character
|
|
|
8090 ;; mode string.
|
|
|
8091 (let* ((other-int (% int 10))
|
|
|
8092 (int (/ int 10))
|
|
|
8093 (group-int (% int 10))
|
|
|
8094 (int (/ int 10))
|
|
|
8095 (owner-int (% int 10))
|
|
|
8096 (int (/ int 10))
|
|
|
8097 (suid (memq int '(4 5 6 7)))
|
|
|
8098 (sgid (memq int '(2 3 6 7)))
|
|
|
8099 (sticky (memq int '(1 3 5 7))))
|
|
|
8100 (concat (efs-build-mode-string-element owner-int suid nil)
|
|
|
8101 (efs-build-mode-string-element group-int sgid nil)
|
|
|
8102 (efs-build-mode-string-element other-int nil sticky))))
|
|
|
8103
|
|
118
|
8104 (defun efs-shell-call-process (command dir &optional in-background)
|
|
|
8105 ;; Runs shell process on remote hosts.
|
|
|
8106 (let* ((parsed (efs-ftp-path dir))
|
|
|
8107 (host (car parsed))
|
|
|
8108 (user (nth 1 parsed))
|
|
|
8109 (rdir (nth 2 parsed))
|
|
|
8110 (file-name-handler-alist nil))
|
|
|
8111 (or (string-equal (efs-internal-directory-file-name dir)
|
|
|
8112 (efs-expand-tilde "~" (efs-host-type host) host user))
|
|
|
8113 (string-match "^cd " command)
|
|
|
8114 (setq command (concat "cd " rdir "; " command)))
|
|
|
8115 (setq command
|
|
|
8116 (format "%s %s%s \"%s\"" ; remsh -l USER does not work well
|
|
|
8117 ; on a hp-ux machine I tried
|
|
|
8118 efs-remote-shell-file-name host
|
|
|
8119 (if efs-remote-shell-takes-user
|
|
|
8120 (concat " -l " user)
|
|
|
8121 "")
|
|
|
8122 command))
|
|
|
8123 (message "Doing shell command on %s..." host)
|
|
|
8124 ;; do it
|
|
|
8125 (let ((process-connection-type ; don't waste pty's
|
|
|
8126 (null (null in-background))))
|
|
|
8127 (setq default-directory (file-name-directory efs-tmp-name-template))
|
|
|
8128 (if in-background
|
|
|
8129 (progn
|
|
|
8130 (setq mode-line-process '(": %s"))
|
|
|
8131 (start-process "Shell" (current-buffer)
|
|
|
8132 shell-file-name "-c" command))
|
|
|
8133 (call-process shell-file-name nil t nil "-c" command)))))
|
|
|
8134
|
|
98
|
8135 (defun efs-set-file-modes (file mode)
|
|
|
8136 ;; set-file-modes for remote files.
|
|
|
8137 ;; For remote files, if mode is nil, does nothing.
|
|
|
8138 ;; This is because efs-file-modes returns nil if the modes
|
|
|
8139 ;; of a remote file couldn't be determined, even if the file exists.
|
|
|
8140 (and mode
|
|
|
8141 (let* ((file (expand-file-name file))
|
|
|
8142 (parsed (efs-ftp-path file))
|
|
|
8143 (host (car parsed))
|
|
|
8144 (user (nth 1 parsed))
|
|
|
8145 (r-file (nth 2 parsed))
|
|
|
8146 ;; convert to octal, and keep only 12 lowest order bits.
|
|
|
8147 (omode (format "%o" (- mode (lsh (lsh mode -12) 12)))))
|
|
|
8148 (if (or (efs-get-host-property host 'chmod-failed)
|
|
|
8149 (null (memq (efs-host-type host user) efs-unix-host-types)))
|
|
|
8150 (message "Unable to set file modes for %s to %s." file omode)
|
|
|
8151 (efs-send-cmd
|
|
|
8152 host user
|
|
|
8153 (list 'quote 'site 'chmod omode r-file)
|
|
|
8154 nil nil
|
|
|
8155 (efs-cont (result line cont-lines) (host file r-file omode)
|
|
|
8156 (if result
|
|
118
|
8157 (let ((exit-code
|
|
|
8158 (efs-shell-call-process
|
|
|
8159 (concat "chmod " mode " " (file-name-nondirectory file))
|
|
|
8160 (file-name-directory file))))
|
|
|
8161 (if (not (equal 0 exit-code))
|
|
|
8162 (progn
|
|
|
8163 (efs-set-host-property host 'chmod-failed t)
|
|
|
8164 (message "CHMOD %s failed for %s on %s." omode r-file host)
|
|
|
8165 (if efs-ding-on-chmod-failure
|
|
|
8166 (progn (ding) (sit-for 1))))))
|
|
98
|
8167 (let ((ent (efs-get-file-entry file)))
|
|
|
8168 (if ent
|
|
|
8169 (let* ((type
|
|
|
8170 (cond
|
|
|
8171 ((null (car ent)) "-")
|
|
|
8172 ((eq (car ent) t) "d")
|
|
|
8173 ((stringp (car ent)) "s")
|
|
|
8174 (t
|
|
|
8175 (error
|
|
|
8176 "Weird error in efs-set-file-modes"))))
|
|
|
8177 (mode-string (concat
|
|
|
8178 type
|
|
|
8179 (efs-mode-string
|
|
|
8180 (string-to-int omode))))
|
|
|
8181 (tail (nthcdr 3 ent)))
|
|
|
8182 (if (consp tail)
|
|
|
8183 (setcar tail mode-string)
|
|
|
8184 (efs-add-file-entry nil file (car ent) (nth 1 ent)
|
|
|
8185 (nth 2 ent) mode-string)))))))
|
|
|
8186 0)))) ; It should be safe to do this NOWAIT = 0
|
|
|
8187 ;; set-file-modes returns nil
|
|
|
8188 nil)
|
|
|
8189
|
|
|
8190 (defmacro efs-parse-mode-element (modes)
|
|
|
8191 ;; Parses MODES, a string of three chars, and returns an integer
|
|
|
8192 ;; between 0 and 7 according to how unix file modes are represented
|
|
|
8193 ;; for chmod.
|
|
|
8194 (` (if (= (length (, modes)) 3)
|
|
|
8195 (let ((list (mapcar
|
|
|
8196 (function (lambda (char)
|
|
|
8197 (if (memq char '( ?- ?S ?T)) 0 1)))
|
|
|
8198 (, modes))))
|
|
|
8199 ;; Convert to octal
|
|
|
8200 (+ (* (car list) 4) (* (nth 1 list) 2) (nth 2 list)))
|
|
|
8201 (error "Can't parse modes %s" (, modes)))))
|
|
|
8202
|
|
|
8203 (defun efs-parse-mode-string (string)
|
|
|
8204 ;; Parse a 9-character mode string, and return what it represents
|
|
|
8205 ;; as a decimal integer.
|
|
|
8206 (let ((owner (efs-parse-mode-element (substring string 0 3)))
|
|
|
8207 (group (efs-parse-mode-element (substring string 3 6)))
|
|
|
8208 (other (efs-parse-mode-element (substring string 6 9)))
|
|
|
8209 (owner-x (elt string 2))
|
|
|
8210 (group-x (elt string 5))
|
|
|
8211 (other-x (elt string 8)))
|
|
|
8212 (+ (* (+ (if (memq owner-x '(?s ?S)) 4 0)
|
|
|
8213 (if (memq group-x '(?s ?S)) 2 0)
|
|
|
8214 (if (memq other-x '(?t ?T)) 1 0))
|
|
|
8215 512)
|
|
|
8216 (* owner 64)
|
|
|
8217 (* group 8)
|
|
|
8218 other)))
|
|
|
8219
|
|
|
8220 (defun efs-file-modes (file)
|
|
|
8221 ;; Version of file-modes for remote files.
|
|
|
8222 ;; Returns nil if the file modes can't be determined, either because
|
|
|
8223 ;; the file doesn't exist, or for any other reason.
|
|
|
8224 (let* ((file (expand-file-name file))
|
|
|
8225 (parsed (efs-ftp-path file)))
|
|
|
8226 (and (memq (efs-host-type (car parsed)) efs-unix-host-types)
|
|
|
8227 ;; Someday we should cache mode strings for non-unix, but they
|
|
|
8228 ;; won't be in unix format. Also, CHMOD doesn't work for non-unix
|
|
|
8229 ;; hosts, so returning this info to emacs is a waste.
|
|
|
8230 (let* ((ent (efs-get-file-entry file))
|
|
|
8231 (modes (nth 3 ent)))
|
|
|
8232 (and modes
|
|
|
8233 (efs-parse-mode-string (substring modes 1)))))))
|
|
|
8234
|
|
|
8235 ;;;; ------------------------------------------------------------
|
|
|
8236 ;;;; Redefinition of Emacs file modtime support.
|
|
|
8237 ;;;; ------------------------------------------------------------
|
|
|
8238
|
|
|
8239 (defun efs-day-number (year month day)
|
|
|
8240 ;; Returns the day number within year of date. Taken from calendar.el,
|
|
|
8241 ;; by Edward Reingold. Thanks.
|
|
|
8242 ;; An explanation of the calculation can be found in PascAlgorithms by
|
|
|
8243 ;; Edward and Ruth Reingold, Scott-Foresman/Little, Brown, 1988.
|
|
|
8244 (let ((day-of-year (+ day (* 31 (1- month)))))
|
|
|
8245 (if (> month 2)
|
|
|
8246 (progn
|
|
|
8247 (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10)))
|
|
|
8248 (if (zerop (% year 4))
|
|
|
8249 (setq day-of-year (1+ day-of-year)))))
|
|
|
8250 day-of-year))
|
|
|
8251
|
|
|
8252 (defun efs-days-elapsed (year month day)
|
|
|
8253 ;; Number of days elapsed since Jan 1, `efs-time-zero'
|
|
|
8254 (+ (efs-day-number year month day) ; days this year
|
|
|
8255 (* 365 (- year efs-time-zero)) ; days in prior years
|
|
|
8256 (- (/ (max (1- year) efs-time-zero) 4)
|
|
|
8257 (/ efs-time-zero 4)) ; leap years
|
|
|
8258 -1 )) ; don't count today
|
|
|
8259
|
|
|
8260 ;; 2^16 = 65536
|
|
|
8261 ;; Use this to avoid overflows
|
|
|
8262
|
|
|
8263 (defun efs-seconds-elapsed (year month day hours minutes seconds)
|
|
|
8264 ;; Computes the seconds elapsed from `efs-time-zero', in emacs'
|
|
|
8265 ;; format of a list of two integers, the first the higher 16-bits,
|
|
|
8266 ;; the second the lower 16-bits.
|
|
|
8267 (let* ((days (efs-days-elapsed year month day))
|
|
|
8268 ;; compute hours
|
|
|
8269 (hours (+ (* 24 days) hours))
|
|
|
8270 (high (lsh hours -16))
|
|
|
8271 (low (- hours (lsh high 16)))
|
|
|
8272 ;; compute minutes
|
|
|
8273 (low (+ (* low 60) minutes))
|
|
|
8274 (carry (lsh low -16))
|
|
|
8275 (high (+ (* high 60) carry))
|
|
|
8276 (low (- low (lsh carry 16)))
|
|
|
8277 ;; compute seconds
|
|
|
8278 (low (+ (* low 60) seconds))
|
|
|
8279 (carry (lsh low -16))
|
|
|
8280 (high (+ (* high 60) carry))
|
|
|
8281 (low (- low (lsh carry 16))))
|
|
|
8282 (list high low)))
|
|
|
8283
|
|
|
8284 (defun efs-parse-mdtime (string)
|
|
|
8285 ;; Parse a string, which is assumed to be the result of an ftp MDTM command.
|
|
|
8286 (efs-save-match-data
|
|
|
8287 (if (string-match efs-mdtm-msgs string)
|
|
|
8288 (efs-seconds-elapsed
|
|
|
8289 (string-to-int (substring string 4 8))
|
|
|
8290 (string-to-int (substring string 8 10))
|
|
|
8291 (string-to-int (substring string 10 12))
|
|
|
8292 (string-to-int (substring string 12 14))
|
|
|
8293 (string-to-int (substring string 14 16))
|
|
|
8294 (string-to-int (substring string 16 18))))))
|
|
|
8295
|
|
|
8296 (defun efs-parse-ctime (string)
|
|
|
8297 ;; Parse STRING which is assumed to be the result of a query over port 37.
|
|
|
8298 ;; Returns the number of seconds since the turn of the century, as a
|
|
|
8299 ;; list of two 16-bit integers.
|
|
|
8300 (and (= (length string) 4)
|
|
|
8301 (list (+ (lsh (aref string 0) 8) (aref string 1))
|
|
|
8302 (+ (lsh (aref string 2) 8) (aref string 3)))))
|
|
|
8303
|
|
|
8304 (defun efs-time-minus (time1 time2)
|
|
|
8305 ;; Subtract 32-bit integers, represented as two 16-bit integers.
|
|
|
8306 (let ((high (- (car time1) (car time2)))
|
|
|
8307 (low (- (nth 1 time1) (nth 1 time2))))
|
|
|
8308 (cond
|
|
|
8309 ((and (< high 0) (> low 0))
|
|
|
8310 (setq high (1+ high)
|
|
|
8311 low (- low 65536)))
|
|
|
8312 ((and (> high 0) (< low 0))
|
|
|
8313 (setq high (1- high)
|
|
|
8314 low (+ 65536 low))))
|
|
|
8315 (list high low)))
|
|
|
8316
|
|
|
8317 (defun efs-time-greater (time1 time2)
|
|
|
8318 ;; Compare two 32-bit integers, each represented as a list of two 16-bit
|
|
|
8319 ;; integers.
|
|
|
8320 (or (> (car time1) (car time2))
|
|
|
8321 (and (= (car time1) (car time2))
|
|
|
8322 (> (nth 1 time1) (nth 1 time2)))))
|
|
|
8323
|
|
|
8324 (defun efs-century-time (host &optional nowait cont)
|
|
|
8325 ;; Treat nil as the local host.
|
|
|
8326 ;; Returns the # of seconds since the turn of the century, according
|
|
|
8327 ;; to the system clock on host.
|
|
|
8328 ;; CONT is called with first arg HOST and second the # of seconds.
|
|
|
8329 (or host (setq host (system-name)))
|
|
|
8330 (efs-set-host-property host 'last-ctime nil)
|
|
|
8331 (efs-set-host-property host 'ctime-cont cont)
|
|
|
8332 (let ((name (format efs-ctime-process-name-format host))
|
|
|
8333 proc)
|
|
|
8334 (condition-case nil (delete-process name) (error nil))
|
|
|
8335 (if (and
|
|
|
8336 (or (efs-save-match-data (string-match efs-local-host-regexp host))
|
|
|
8337 (string-equal host (system-name)))
|
|
|
8338 (setq proc (condition-case nil
|
|
|
8339 (open-network-stream name nil host 37)
|
|
|
8340 (error nil))))
|
|
|
8341 (progn
|
|
|
8342 (set (intern name) "")
|
|
|
8343 (set-process-filter
|
|
|
8344 proc
|
|
|
8345 (function
|
|
|
8346 (lambda (proc string)
|
|
|
8347 (let ((name (process-name proc))
|
|
|
8348 result)
|
|
|
8349 (set (intern name) (concat (symbol-value (intern name))
|
|
|
8350 string))
|
|
|
8351 (setq result (efs-parse-ctime
|
|
|
8352 (symbol-value (intern name))))
|
|
|
8353 (if result
|
|
|
8354 (let* ((host (substring name 11 -1))
|
|
|
8355 (cont (efs-get-host-property host 'ctime-cont)))
|
|
|
8356 (efs-set-host-property host 'last-ctime result)
|
|
|
8357 (condition-case nil (delete-process proc) (error nil))
|
|
|
8358 (if cont
|
|
|
8359 (progn
|
|
|
8360 (efs-set-host-property host 'ctime-cont nil)
|
|
|
8361 (efs-call-cont cont host result)))))))))
|
|
|
8362 (set-process-sentinel
|
|
|
8363 proc
|
|
|
8364 (function
|
|
|
8365 (lambda (proc state)
|
|
|
8366 (let* ((name (process-name proc))
|
|
|
8367 (host (substring name 11 -1))
|
|
|
8368 (cont (efs-get-host-property host 'ctime-cont)))
|
|
|
8369 (makunbound (intern name))
|
|
|
8370 (or (efs-get-host-property host 'last-ctime)
|
|
|
8371 (if cont
|
|
|
8372 (progn
|
|
|
8373 (efs-set-host-property host 'ctime-cont nil)
|
|
|
8374 (efs-call-cont cont host 'failed))))))))
|
|
|
8375 (if nowait
|
|
|
8376 nil
|
|
|
8377 (let ((quit-flag nil)
|
|
|
8378 (inhibit-quit nil))
|
|
|
8379 (while (memq (process-status proc) '(run open))
|
|
|
8380 (accept-process-output)))
|
|
|
8381 (accept-process-output)
|
|
|
8382 (or (efs-get-host-property host 'last-ctime)
|
|
|
8383 'failed)))
|
|
|
8384 (if cont
|
|
|
8385 (progn
|
|
|
8386 (efs-set-host-property host 'ctime-cont nil)
|
|
|
8387 (efs-call-cont cont host 'failed)))
|
|
|
8388 (if nowait nil 'failed))))
|
|
|
8389
|
|
|
8390 (defun efs-clock-difference (host &optional nowait)
|
|
|
8391 ;; clock difference with the local host
|
|
|
8392 (let ((result (efs-get-host-property host 'clock-diff)))
|
|
|
8393 (or
|
|
|
8394 result
|
|
|
8395 (progn
|
|
|
8396 (efs-century-time
|
|
|
8397 host nowait
|
|
|
8398 (efs-cont (host result) (nowait)
|
|
|
8399 (if (eq result 'failed)
|
|
|
8400 (efs-set-host-property host 'clock-diff 'failed)
|
|
|
8401 (efs-century-time
|
|
|
8402 nil nowait
|
|
|
8403 (efs-cont (lhost lresult) (host result)
|
|
|
8404 (if (eq lresult 'failed)
|
|
|
8405 (efs-set-host-property host 'clock-diff 'failed)
|
|
|
8406 (efs-set-host-property host 'clock-diff
|
|
|
8407 (efs-time-minus result lresult))))))))
|
|
|
8408 (and (null nowait)
|
|
|
8409 (or (efs-get-host-property host 'clock-diff)
|
|
|
8410 'failed))))))
|
|
|
8411
|
|
|
8412 (defun efs-get-file-mdtm (host user file path)
|
|
|
8413 "For HOST and USER, return FILE's last modification time.
|
|
|
8414 PATH is the file name in full efs syntax.
|
|
|
8415 Returns a list of two six-digit integers which represent the 16 high order
|
|
|
8416 bits, and 16 low order bits of the number of elapsed seconds since
|
|
|
8417 `efs-time-zero'"
|
|
|
8418 (and (null (efs-get-host-property host 'mdtm-failed))
|
|
|
8419 (let ((result (efs-send-cmd host user (list 'quote 'mdtm file)
|
|
|
8420 (and (eq efs-verbose t)
|
|
|
8421 "Getting modtime")))
|
|
|
8422 parsed)
|
|
|
8423 (if (and (null (car result))
|
|
|
8424 (setq parsed (efs-parse-mdtime (nth 1 result))))
|
|
|
8425 (let ((ent (efs-get-file-entry path)))
|
|
|
8426 (if ent
|
|
|
8427 (setcdr ent (list (nth 1 ent) (nth 2 ent)
|
|
|
8428 (nth 3 ent) (nth 4 ent)
|
|
|
8429 parsed)))
|
|
|
8430 parsed)
|
|
|
8431 (efs-save-match-data
|
|
|
8432 ;; The 550 error is for a nonexistent file. Actually implies
|
|
|
8433 ;; that MDTM works.
|
|
|
8434 (if (string-match "^550 " (nth 1 result))
|
|
|
8435 '(0 0)
|
|
|
8436 (efs-set-host-property host 'mdtm-failed t)
|
|
|
8437 nil))))))
|
|
|
8438
|
|
|
8439 (efs-define-fun efs-set-emacs-bvf-mdtm (buffer mdtm)
|
|
|
8440 ;; Sets cached value for the buffer visited file modtime.
|
|
|
8441 (if (get-buffer buffer)
|
|
|
8442 (save-excursion
|
|
|
8443 (set-buffer buffer)
|
|
|
8444 (let (file-name-handler-alist)
|
|
|
8445 (set-visited-file-modtime mdtm)))))
|
|
|
8446
|
|
|
8447 ;; (defun efs-set-visited-file-modtime (&optional time)
|
|
|
8448 ;; ;; For remote files sets the modtime for a buffer to be that of the
|
|
|
8449 ;; ;; visited file. With arg TIME sets the modtime to TIME. TIME must be a list
|
|
|
8450 ;; ;; of two 16-bit integers.
|
|
|
8451 ;; ;; The function set-visited-file-modtime is for emacs-19. It doesn't
|
|
|
8452 ;; ;; exist in emacs 18. If you're running efs, it will work in emacs 18 for
|
|
|
8453 ;; ;; remote files only.
|
|
|
8454 ;; (if time
|
|
|
8455 ;; (efs-set-emacs-bvf-mdtm (current-buffer) time)
|
|
|
8456 ;; (let* ((path buffer-file-name)
|
|
|
8457 ;; (parsed (efs-ftp-path path))
|
|
|
8458 ;; (host (car parsed))
|
|
|
8459 ;; (user (nth 1 parsed))
|
|
|
8460 ;; (file (nth 2 parsed))
|
|
|
8461 ;; (buffer (current-buffer)))
|
|
|
8462 ;; (if (efs-save-match-data
|
|
|
8463 ;; (and efs-verify-modtime-host-regexp
|
|
|
8464 ;; (string-match efs-verify-modtime-host-regexp host)
|
|
|
8465 ;; (or efs-verify-anonymous-modtime
|
|
|
8466 ;; (not (efs-anonymous-p user)))
|
|
|
8467 ;; (not (efs-get-host-property host 'mdtm-failed))))
|
|
|
8468 ;; (efs-send-cmd
|
|
|
8469 ;; host user (list 'quote 'mdtm file)
|
|
|
8470 ;; nil nil
|
|
|
8471 ;; (efs-cont (result line cont-lines) (host user path buffer)
|
|
|
8472 ;; (let (modtime)
|
|
|
8473 ;; (if (and (null result)
|
|
|
8474 ;; (setq modtime (efs-parse-mdtime line)))
|
|
|
8475 ;; (let ((ent (efs-get-file-entry path)))
|
|
|
8476 ;; (if ent
|
|
|
8477 ;; (setcdr ent (list (nth 1 ent) (nth 2 ent)
|
|
|
8478 ;; (nth 3 ent) (nth 4 ent)
|
|
|
8479 ;; modtime)))
|
|
|
8480 ;; (setq buffer (and (setq buffer (get-buffer buffer))
|
|
|
8481 ;; (buffer-name buffer)))
|
|
|
8482 ;; ;; Beware that since this is happening asynch, the buffer
|
|
|
8483 ;; ;; may have disappeared.
|
|
|
8484 ;; (and buffer (efs-set-emacs-bvf-mdtm buffer modtime)))
|
|
|
8485 ;; (efs-save-match-data
|
|
|
8486 ;; (or (string-match "^550 " line)
|
|
|
8487 ;; (efs-set-host-property host 'mdtm-failed t)))
|
|
|
8488 ;; (efs-set-emacs-bvf-mdtm buffer 0)))) ; store dummy values
|
|
|
8489 ;; 0) ; Always do this NOWAIT = 0
|
|
|
8490 ;; (efs-set-emacs-bvf-mdtm buffer 0))
|
|
|
8491 ;; nil) ; return NIL
|
|
|
8492 ;; ))
|
|
|
8493
|
|
|
8494 (defvar efs-set-modtimes-synchronously nil
|
|
|
8495 "*Whether efs uses a synchronous FTP command to set the visited file modtime.
|
|
|
8496 Setting this variable to non-nil means that efs will set visited file modtimes
|
|
|
8497 synchronously.
|
|
|
8498
|
|
|
8499 Asynchronous setting of visited file modtimes leaves a very small
|
|
|
8500 window where Emacs may fail to detect a super session. However, it gives
|
|
|
8501 faster user access to newly visited files.")
|
|
|
8502
|
|
|
8503
|
|
|
8504 (defun efs-set-visited-file-modtime (&optional time)
|
|
|
8505 ;; For remote files sets the modtime for a buffer to be that of the
|
|
|
8506 ;; visited file. With arg TIME sets the modtime to TIME. TIME must be a list
|
|
|
8507 ;; of two 16-bit integers.
|
|
|
8508 ;; The function set-visited-file-modtime is for emacs-19. It doesn't
|
|
|
8509 ;; exist in emacs 18. If you're running efs, it will work in emacs 18 for
|
|
|
8510 ;; remote files only.
|
|
|
8511 (if time
|
|
|
8512 (efs-set-emacs-bvf-mdtm (current-buffer) time)
|
|
|
8513 (let* ((path buffer-file-name)
|
|
|
8514 (parsed (efs-ftp-path path))
|
|
|
8515 (host (car parsed))
|
|
|
8516 (user (nth 1 parsed))
|
|
|
8517 (file (nth 2 parsed))
|
|
|
8518 (buffer (current-buffer)))
|
|
|
8519 (if (efs-save-match-data
|
|
|
8520 (and efs-verify-modtime-host-regexp
|
|
|
8521 (string-match efs-verify-modtime-host-regexp host)
|
|
|
8522 (or efs-verify-anonymous-modtime
|
|
|
8523 (not (efs-anonymous-p user)))
|
|
|
8524 (not (efs-get-host-property host 'mdtm-failed))))
|
|
|
8525 (progn
|
|
|
8526 (or efs-set-modtimes-synchronously (clear-visited-file-modtime))
|
|
|
8527 (efs-send-cmd
|
|
|
8528 host user (list 'quote 'mdtm file)
|
|
|
8529 nil nil
|
|
|
8530 (efs-cont (result line cont-lines) (host user path buffer)
|
|
|
8531 (let (modtime)
|
|
|
8532 (if (and (null result)
|
|
|
8533 (setq modtime (efs-parse-mdtime line)))
|
|
|
8534 (let ((ent (efs-get-file-entry path)))
|
|
|
8535 (if ent
|
|
|
8536 (setcdr ent (list (nth 1 ent) (nth 2 ent)
|
|
|
8537 (nth 3 ent) (nth 4 ent)
|
|
|
8538 modtime)))
|
|
|
8539 (setq buffer (and (setq buffer (get-buffer buffer))
|
|
|
8540 (buffer-name buffer)))
|
|
|
8541 ;; Beware that since might be happening asynch,
|
|
|
8542 ;; the buffer may have disappeared.
|
|
|
8543 (and buffer (efs-set-emacs-bvf-mdtm buffer modtime)))
|
|
|
8544 (efs-save-match-data
|
|
|
8545 (or (string-match "^550 " line)
|
|
|
8546 (efs-set-host-property host 'mdtm-failed t)))
|
|
|
8547 (efs-set-emacs-bvf-mdtm buffer '(0 0))))) ; store dummy values
|
|
|
8548 (and (null efs-set-modtimes-synchronously) 0)))
|
|
|
8549 (efs-set-emacs-bvf-mdtm buffer '(0 0)))
|
|
|
8550 nil))) ; return NIL
|
|
|
8551
|
|
|
8552 (defun efs-file-newer-than-file-p (file1 file2)
|
|
|
8553 ;; Version of file-newer-than-file-p for remote files.
|
|
|
8554 (let* ((file1 (expand-file-name file1))
|
|
|
8555 (file2 (expand-file-name file2))
|
|
|
8556 (parsed1 (efs-ftp-path file1))
|
|
|
8557 (parsed2 (efs-ftp-path file2))
|
|
|
8558 (host1 (car parsed1))
|
|
|
8559 (host2 (car parsed2))
|
|
|
8560 (user1 (nth 1 parsed1))
|
|
|
8561 (user2 (nth 1 parsed2)))
|
|
|
8562 (cond
|
|
|
8563 ;; If the first file doedn't exist, or is remote but
|
|
|
8564 ;; we're not supposed to check modtimes on it, return nil.
|
|
|
8565 ((or (null (file-exists-p file1))
|
|
|
8566 (and parsed1
|
|
|
8567 (or
|
|
|
8568 (null efs-verify-modtime-host-regexp)
|
|
|
8569 (efs-get-host-property host1 'mdtm-failed)
|
|
|
8570 (not (string-match efs-verify-modtime-host-regexp host1))
|
|
|
8571 (and (null efs-verify-anonymous-modtime)
|
|
|
8572 (efs-anonymous-p user1)))))
|
|
|
8573 nil)
|
|
|
8574 ;; If the same is true for the second file, return t.
|
|
|
8575 ((or (null (file-exists-p file2))
|
|
|
8576 (and parsed2
|
|
|
8577 (or
|
|
|
8578 (null efs-verify-modtime-host-regexp)
|
|
|
8579 (efs-get-host-property host2 'mdtm-failed)
|
|
|
8580 (not (string-match efs-verify-modtime-host-regexp host2))
|
|
|
8581 (and (null efs-verify-anonymous-modtime)
|
|
|
8582 (efs-anonymous-p user2)))))
|
|
|
8583 t)
|
|
|
8584 ;; Calculate modtimes. If we get here, any remote files should
|
|
|
8585 ;; have a file entry.
|
|
|
8586 (t
|
|
|
8587 (let (mod1 mod2 shift1 shift2)
|
|
|
8588 (if parsed1
|
|
|
8589 (let ((ent (efs-get-file-entry file1)))
|
|
|
8590 (setq mod1 (nth 5 ent)
|
|
|
8591 shift1 (efs-clock-difference host1))
|
|
|
8592 (or mod1
|
|
|
8593 (setq mod1 (efs-get-file-mdtm
|
|
|
8594 host1 user1 (nth 2 parsed1) file1))))
|
|
|
8595 (setq mod1 (nth 5 (file-attributes file1))))
|
|
|
8596 (if parsed2
|
|
|
8597 (let ((ent (efs-get-file-entry file2)))
|
|
|
8598 (setq mod2 (nth 5 ent)
|
|
|
8599 shift2 (efs-clock-difference host2))
|
|
|
8600 (or mod2
|
|
|
8601 (setq mod2 (efs-get-file-mdtm
|
|
|
8602 host2 user2 (nth 2 parsed2) file2))))
|
|
|
8603 (setq mod2 (nth 5 (file-attributes file2))))
|
|
|
8604 ;; If we can't compute clock shifts, we act as if we don't
|
|
|
8605 ;; even know the modtime. Should we have more faith in ntp?
|
|
|
8606 (cond
|
|
|
8607 ((or (null mod1) (eq shift1 'failed))
|
|
|
8608 nil)
|
|
|
8609 ((or (null mod2) (eq shift2 'failed))
|
|
|
8610 t)
|
|
|
8611 ;; We get to compute something!
|
|
|
8612 (t
|
|
|
8613 (efs-time-greater
|
|
|
8614 (if shift1 (efs-time-minus mod1 shift1) mod1)
|
|
|
8615 (if shift2 (efs-time-minus mod2 shift2) mod2)))))))))
|
|
|
8616
|
|
|
8617 (defun efs-verify-visited-file-modtime (buff)
|
|
|
8618 ;; Verifies the modtime for buffers visiting remote files.
|
|
|
8619 ;; Won't get called for buffer not visiting any file.
|
|
|
8620 (let ((buff (get-buffer buff)))
|
|
|
8621 (null
|
|
|
8622 (and buff ; return t if no buffer? Need to beware of multi-threading.
|
|
|
8623 (buffer-file-name buff) ; t if no file
|
|
|
8624 (let ((mdtm (save-excursion
|
|
|
8625 (set-buffer buff)
|
|
|
8626 (visited-file-modtime))))
|
|
|
8627 (and
|
|
|
8628 (not (eq mdtm 0))
|
|
|
8629 (not (equal mdtm '(0 0)))
|
|
|
8630 efs-verify-modtime-host-regexp
|
|
|
8631 (let* ((path (buffer-file-name buff))
|
|
|
8632 (parsed (efs-ftp-path path))
|
|
|
8633 (host (car parsed))
|
|
|
8634 (user (nth 1 parsed))
|
|
|
8635 nmdtm)
|
|
|
8636 (and
|
|
|
8637 (null (efs-get-host-property host 'mdtm-failed))
|
|
|
8638 (efs-save-match-data
|
|
|
8639 (string-match
|
|
|
8640 efs-verify-modtime-host-regexp host))
|
|
|
8641 (or efs-verify-anonymous-modtime
|
|
|
8642 (not (efs-anonymous-p user)))
|
|
|
8643 (setq nmdtm (efs-get-file-mdtm host user (nth 2 parsed) path))
|
|
|
8644 (progn
|
|
|
8645 (or (equal nmdtm '(0 0))
|
|
|
8646 (file-exists-p path) ; Make sure that there is an entry.
|
|
|
8647 (null
|
|
|
8648 (efs-get-files
|
|
|
8649 (file-name-directory
|
|
|
8650 (efs-internal-directory-file-name path))))
|
|
|
8651 (efs-add-file-entry
|
|
|
8652 (efs-host-type host) path nil nil nil nil nil nmdtm))
|
|
|
8653 (null (and (eq (cdr mdtm) (nth 1 nmdtm))
|
|
|
8654 (eq (car mdtm) (car nmdtm)))))))))))))
|
|
|
8655
|
|
|
8656 ;;;; -----------------------------------------------------------
|
|
|
8657 ;;;; Redefinition of Emacs file name completion
|
|
|
8658 ;;;; -----------------------------------------------------------
|
|
|
8659
|
|
|
8660 (defmacro efs-set-completion-ignored-pattern ()
|
|
|
8661 ;; Set regexp efs-completion-ignored-pattern
|
|
|
8662 ;; to use for filename completion.
|
|
|
8663 (`
|
|
|
8664 (or (equal efs-completion-ignored-extensions
|
|
|
8665 completion-ignored-extensions)
|
|
|
8666 (setq efs-completion-ignored-extensions
|
|
|
8667 completion-ignored-extensions
|
|
|
8668 efs-completion-ignored-pattern
|
|
|
8669 (mapconcat (function
|
|
|
8670 (lambda (s) (if (stringp s)
|
|
|
8671 (concat (regexp-quote s) "$")
|
|
|
8672 "/"))) ; / never in filename
|
|
|
8673 efs-completion-ignored-extensions
|
|
|
8674 "\\|")))))
|
|
|
8675
|
|
|
8676 (defun efs-file-entry-active-p (sym)
|
|
|
8677 ;; If the file entry is a symlink, returns whether the file pointed to
|
|
|
8678 ;; exists.
|
|
|
8679 ;; Note that DIR is dynamically bound.
|
|
|
8680 (let ((file-type (car (get sym 'val))))
|
|
|
8681 (or (not (stringp file-type))
|
|
|
8682 (file-exists-p (efs-chase-symlinks
|
|
|
8683 (expand-file-name file-type efs-completion-dir))))))
|
|
|
8684
|
|
|
8685 (defun efs-file-entry-not-ignored-p (sym)
|
|
|
8686 ;; If the file entry is not a directory (nor a symlink pointing to a
|
|
|
8687 ;; directory) returns whether the file (or file pointed to by the symlink)
|
|
|
8688 ;; is ignored by completion-ignored-extensions.
|
|
|
8689 (let ((file-type (car (get sym 'val)))
|
|
|
8690 (symname (symbol-name sym)))
|
|
|
8691 (if (stringp file-type)
|
|
|
8692 ;; Maybe file-truename would be better here, but it is very costly
|
|
|
8693 ;; to chase symlinks at every level over FTP.
|
|
|
8694 (let ((file (efs-chase-symlinks (expand-file-name
|
|
|
8695 file-type efs-completion-dir))))
|
|
|
8696 (or (file-directory-p file)
|
|
|
8697 (and (file-exists-p file)
|
|
|
8698 (not (string-match efs-completion-ignored-pattern
|
|
|
8699 symname)))))
|
|
|
8700 (or file-type ; is a directory name
|
|
|
8701 (not (string-match efs-completion-ignored-pattern symname))))))
|
|
|
8702
|
|
|
8703 (defun efs-file-name-all-completions (file dir)
|
|
|
8704 ;; Does file-name-all-completions in remote directories.
|
|
|
8705 (efs-barf-if-not-directory dir)
|
|
|
8706 (let* ((efs-completion-dir (file-name-as-directory (expand-file-name dir)))
|
|
|
8707 (completion-ignore-case
|
|
|
8708 (memq (efs-host-type (car (efs-ftp-path efs-completion-dir)))
|
|
|
8709 efs-case-insensitive-host-types))
|
|
|
8710 (tbl (efs-get-files efs-completion-dir))
|
|
|
8711 (completions
|
|
|
8712 (all-completions file tbl
|
|
|
8713 (function efs-file-entry-active-p))))
|
|
|
8714 ;; see whether each matching file is a directory or not...
|
|
|
8715 (mapcar
|
|
|
8716 ;; Since the entries in completions will match the case
|
|
|
8717 ;; of the entries in tbl, don't need to case-fold
|
|
|
8718 ;; in efs-get-hash-entry below.
|
|
|
8719 (function
|
|
|
8720 (lambda (file)
|
|
|
8721 (let ((ent (car (efs-get-hash-entry file tbl))))
|
|
|
8722 (if (or (eq ent t)
|
|
|
8723 (and (stringp ent)
|
|
|
8724 (file-directory-p (efs-chase-symlinks
|
|
|
8725 (expand-file-name
|
|
|
8726 ent efs-completion-dir)))))
|
|
|
8727 (concat file "/")
|
|
|
8728 file))))
|
|
|
8729 completions)))
|
|
|
8730
|
|
|
8731 (defun efs-file-name-completion (file dir)
|
|
|
8732 ;; Does file name expansion in remote directories.
|
|
|
8733 (efs-barf-if-not-directory dir)
|
|
|
8734 (if (equal file "")
|
|
|
8735 ""
|
|
|
8736 (let* ((efs-completion-dir (file-name-as-directory (expand-file-name dir)))
|
|
|
8737 (completion-ignore-case
|
|
|
8738 (memq (efs-host-type (car (efs-ftp-path efs-completion-dir)))
|
|
|
8739 efs-case-insensitive-host-types))
|
|
|
8740 (tbl (efs-get-files efs-completion-dir)))
|
|
|
8741 (efs-set-completion-ignored-pattern)
|
|
|
8742 (efs-save-match-data
|
|
|
8743 (or (efs-file-name-completion-1
|
|
|
8744 file tbl efs-completion-dir
|
|
|
8745 (function efs-file-entry-not-ignored-p))
|
|
|
8746 (efs-file-name-completion-1
|
|
|
8747 file tbl efs-completion-dir
|
|
|
8748 (function efs-file-entry-active-p)))))))
|
|
|
8749
|
|
|
8750 (defun efs-file-name-completion-1 (file tbl dir predicate)
|
|
|
8751 ;; Internal subroutine for efs-file-name-completion. Do not call this.
|
|
|
8752 (let ((bestmatch (try-completion file tbl predicate)))
|
|
|
8753 (if bestmatch
|
|
|
8754 (if (eq bestmatch t)
|
|
|
8755 (if (file-directory-p (expand-file-name file dir))
|
|
|
8756 (concat file "/")
|
|
|
8757 t)
|
|
|
8758 (if (and (eq (try-completion bestmatch tbl predicate) t)
|
|
|
8759 (file-directory-p
|
|
|
8760 (expand-file-name bestmatch dir)))
|
|
|
8761 (concat bestmatch "/")
|
|
|
8762 bestmatch)))))
|
|
|
8763
|
|
|
8764 ;;;; ----------------------------------------------------------
|
|
|
8765 ;;;; Functions for loading lisp.
|
|
|
8766 ;;;; ----------------------------------------------------------
|
|
|
8767
|
|
|
8768 ;;; jka-load provided ideas here. Thanks, Jay.
|
|
|
8769
|
|
|
8770 (defun efs-load-openp (str suffixes)
|
|
|
8771 ;; Given STR, searches load-path and efs-load-lisp-extensions
|
|
|
8772 ;; for the name of a file to load. Returns the full path, or nil
|
|
|
8773 ;; if none found.
|
|
|
8774 (let ((path-list (if (file-name-absolute-p str) t load-path))
|
|
|
8775 root result)
|
|
|
8776 ;; If there is no load-path, at least try the default directory.
|
|
|
8777 (or path-list
|
|
|
8778 (setq path-list (list default-directory)))
|
|
|
8779 (while (and path-list (null result))
|
|
|
8780 (if (eq path-list t)
|
|
|
8781 (setq path-list nil
|
|
|
8782 root str)
|
|
|
8783 (setq root (expand-file-name str (car path-list))
|
|
|
8784 path-list (cdr path-list))
|
|
|
8785 (or (file-name-absolute-p root)
|
|
|
8786 (setq root (expand-file-name root default-directory))))
|
|
|
8787 (let ((suff-list suffixes))
|
|
|
8788 (while (and suff-list (null result))
|
|
|
8789 (let ((try (concat root (car suff-list))))
|
|
|
8790 (if (or (not (file-readable-p try))
|
|
|
8791 (file-directory-p try))
|
|
|
8792 (setq suff-list (cdr suff-list))
|
|
|
8793 (setq result try))))))
|
|
|
8794 result))
|
|
|
8795
|
|
|
8796 (defun efs-load (file &optional noerror nomessage nosuffix)
|
|
|
8797 "Documented as original."
|
|
|
8798 (let ((filename (efs-load-openp
|
|
|
8799 file
|
|
|
8800 (if nosuffix '("") efs-load-lisp-extensions))))
|
|
|
8801 (if (not filename)
|
|
|
8802 (and (null noerror) (error "Cannot open load file %s" file))
|
|
|
8803 (let ((parsed (efs-ftp-path filename))
|
|
|
8804 (after-load (and (boundp 'after-load-alist)
|
|
|
8805 (assoc file after-load-alist))))
|
|
|
8806 (if parsed
|
|
|
8807 (let ((temp (car (efs-make-tmp-name nil (car parsed)))))
|
|
|
8808 (unwind-protect
|
|
|
8809 (progn
|
|
|
8810 (efs-copy-file-internal
|
|
|
8811 filename parsed temp nil t nil
|
|
|
8812 (format "Getting %s" filename))
|
|
|
8813 (or (file-readable-p temp)
|
|
|
8814 (error
|
|
|
8815 "efs-load: temp file %s is unreadable" temp))
|
|
|
8816 (or nomessage
|
|
|
8817 (message "Loading %s..." file))
|
|
|
8818 ;; temp is an absolute filename, so load path
|
|
|
8819 ;; won't be searched.
|
|
|
8820 (let (after-load-alist)
|
|
|
8821 (efs-real-load temp t t t))
|
|
|
8822 (or nomessage
|
|
|
8823 (message "Loading %s...done" file))
|
|
|
8824 (if after-load (mapcar 'eval (cdr after-load)))
|
|
|
8825 t) ; return t if everything worked
|
|
|
8826 (efs-del-tmp-name temp)))
|
|
|
8827 (prog2
|
|
|
8828 (or nomessage
|
|
|
8829 (message "Loading %s..." file))
|
|
|
8830 (let (after-load-alist)
|
|
|
8831 (or (efs-real-load filename noerror t t)
|
|
|
8832 (setq after-load nil)))
|
|
|
8833 (or nomessage
|
|
|
8834 (message "Loading %s...done" file))
|
|
|
8835 (if after-load (mapcar 'eval (cdr after-load)))))))))
|
|
|
8836
|
|
|
8837 (defun efs-require (feature &optional filename)
|
|
|
8838 "Documented as original."
|
|
|
8839 (if (eq feature 'ange-ftp) (efs-require-scream-and-yell))
|
|
|
8840 (if (featurep feature)
|
|
|
8841 feature
|
|
|
8842 (or filename (setq filename (symbol-name feature)))
|
|
|
8843 (let ((fullpath (efs-load-openp filename
|
|
|
8844 efs-load-lisp-extensions)))
|
|
|
8845 (if (not fullpath)
|
|
|
8846 (error "Cannot open load file: %s" filename)
|
|
|
8847 (let ((parsed (efs-ftp-path fullpath)))
|
|
|
8848 (if parsed
|
|
|
8849 (let ((temp (car (efs-make-tmp-name nil (car parsed)))))
|
|
|
8850 (unwind-protect
|
|
|
8851 (progn
|
|
|
8852 (efs-copy-file-internal
|
|
|
8853 fullpath parsed temp nil t nil
|
|
|
8854 (format "Getting %s" fullpath))
|
|
|
8855 (or (file-readable-p temp)
|
|
|
8856 (error
|
|
|
8857 "efs-require: temp file %s is unreadable" temp))
|
|
|
8858 (efs-real-require feature temp))
|
|
|
8859 (efs-del-tmp-name temp)))
|
|
|
8860 (efs-real-require feature fullpath)))))))
|
|
|
8861
|
|
|
8862 (defun efs-require-scream-and-yell ()
|
|
|
8863 ;; Complain if something attempts to load ange-ftp.
|
|
|
8864 (with-output-to-temp-buffer "*Help*"
|
|
|
8865 (princ
|
|
|
8866 "Something tried to load ange-ftp.
|
|
|
8867 EFS AND ANGE-FTP DO NOT WORK TOGETHER.
|
|
|
8868
|
|
|
8869 If the culprit package does need to access ange-ftp internal functions,
|
|
|
8870 then it should be adequate to simply remove the \(require 'ange-ftp\)
|
|
|
8871 line and let efs handle remote file access. Otherwise, it will need to
|
|
|
8872 be ported to efs. This may already have been done, and you can find out
|
|
|
8873 by sending an enquiry to efs-help@cuckoo.hpl.hp.com.
|
|
|
8874
|
|
|
8875 Signalling an error with backtrace will allow you to determine which
|
|
|
8876 package was requiring ange-ftp.\n"))
|
|
|
8877 (select-window (get-buffer-window "*Help*"))
|
|
|
8878 (enlarge-window (- (count-lines (point-min) (point-max))
|
|
|
8879 (window-height) -1))
|
|
|
8880 (if (y-or-n-p "Signal error with backtrace? ")
|
|
|
8881 (let ((stack-trace-on-error t))
|
|
|
8882 (error "Attempt to require ange-ftp"))))
|
|
|
8883
|
|
|
8884 ;;;; -----------------------------------------------------------
|
|
|
8885 ;;;; Redefinition of Emacs functions for reading file names.
|
|
|
8886 ;;;; -----------------------------------------------------------
|
|
|
8887
|
|
|
8888 (defun efs-unexpand-parsed-filename (host user path)
|
|
|
8889 ;; Replaces the home directory in path with "~". Returns the unexpanded
|
|
|
8890 ;; full-path.
|
|
|
8891 (let* ((path-len (length path))
|
|
|
8892 (def-user (efs-get-user host))
|
|
|
8893 (host-type (efs-host-type host user))
|
|
|
8894 (ignore-case (memq host-type efs-case-insensitive-host-types)))
|
|
|
8895 (if (> path-len 1)
|
|
|
8896 (let* ((home (efs-expand-tilde "~" host-type host user))
|
|
|
8897 (home-len (length home)))
|
|
|
8898 (if (and (> path-len home-len)
|
|
|
8899 (if ignore-case (string-equal (downcase home)
|
|
|
8900 (downcase
|
|
|
8901 (substring path
|
|
|
8902 0 home-len)))
|
|
|
8903 (string-equal home (substring path 0 home-len)))
|
|
|
8904 (= (aref path home-len) ?/))
|
|
|
8905 (setq path (concat "~" (substring path home-len))))))
|
|
|
8906 (if (if ignore-case (string-equal (downcase user)
|
|
|
8907 (downcase def-user))
|
|
|
8908 (string-equal user def-user))
|
|
|
8909 (format efs-path-format-without-user host path)
|
|
|
8910 (format efs-path-format-string user host path))))
|
|
|
8911
|
|
118
|
8912 (efs-define-fun efs-abbreviate-file-name (filename &optional ignored-for-now)
|
|
98
|
8913 ;; Version of abbreviate-file-name for remote files.
|
|
|
8914 (efs-save-match-data
|
|
|
8915 (let ((tail directory-abbrev-alist))
|
|
|
8916 (while tail
|
|
|
8917 (if (string-match (car (car tail)) filename)
|
|
|
8918 (setq filename
|
|
|
8919 (concat (cdr (car tail))
|
|
|
8920 (substring filename (match-end 0)))))
|
|
|
8921 (setq tail (cdr tail)))
|
|
|
8922 (apply 'efs-unexpand-parsed-filename (efs-ftp-path filename)))))
|
|
|
8923
|
|
|
8924 (defun efs-default-dir-function ()
|
|
|
8925 (let ((parsed (efs-ftp-path default-directory))
|
|
|
8926 (dd default-directory))
|
|
|
8927 (if parsed
|
|
|
8928 (efs-save-match-data
|
|
|
8929 (let ((tail directory-abbrev-alist))
|
|
|
8930 (while tail
|
|
|
8931 (if (string-match (car (car tail)) dd)
|
|
|
8932 (setq dd (concat (cdr (car tail))
|
|
|
8933 (substring dd (match-end 0)))
|
|
|
8934 parsed nil))
|
|
|
8935 (setq tail (cdr tail)))
|
|
|
8936 (apply 'efs-unexpand-parsed-filename
|
|
|
8937 (or parsed (efs-ftp-path dd)))))
|
|
|
8938 default-directory)))
|
|
|
8939
|
|
|
8940 (defun efs-re-read-dir (&optional dir)
|
|
|
8941 "Forces a re-read of the directory DIR.
|
|
|
8942 If DIR is omitted then it defaults to the directory part of the contents
|
|
|
8943 of the current buffer. This is so this function can be caled from the
|
|
|
8944 minibuffer."
|
|
|
8945 (interactive)
|
|
|
8946 (if dir
|
|
|
8947 (setq dir (expand-file-name dir))
|
|
|
8948 (setq dir (file-name-directory (expand-file-name (buffer-string)))))
|
|
|
8949 (let ((parsed (efs-ftp-path dir)))
|
|
|
8950 (if parsed
|
|
|
8951 (let ((efs-ls-uncache t))
|
|
|
8952 (efs-del-hash-entry (efs-canonize-file-name dir)
|
|
|
8953 efs-files-hashtable)
|
|
|
8954 (efs-get-files dir t)))))
|
|
|
8955
|
|
|
8956 ;;;; ---------------------------------------------------------------
|
|
|
8957 ;;;; Creation and deletion of files and directories.
|
|
|
8958 ;;;; ---------------------------------------------------------------
|
|
|
8959
|
|
|
8960 (defun efs-delete-file (file)
|
|
|
8961 ;; Deletes remote files.
|
|
|
8962 (let* ((file (expand-file-name file))
|
|
|
8963 (parsed (efs-ftp-path file))
|
|
|
8964 (host (car parsed))
|
|
|
8965 (user (nth 1 parsed))
|
|
|
8966 (host-type (efs-host-type host user))
|
|
|
8967 (path (nth 2 parsed))
|
|
|
8968 (abbr (efs-relativize-filename file))
|
|
|
8969 (result (efs-send-cmd host user (list 'delete path)
|
|
|
8970 (format "Deleting %s" abbr))))
|
|
|
8971 (if (car result)
|
|
|
8972 (signal 'ftp-error
|
|
|
8973 (list "Removing old name"
|
|
|
8974 (format "FTP Error: \"%s\"" (nth 1 result))
|
|
|
8975 file)))
|
|
|
8976 (efs-delete-file-entry host-type file)))
|
|
|
8977
|
|
|
8978 (defun efs-make-directory-internal (dir)
|
|
|
8979 ;; version of make-directory-internal for remote directories.
|
|
|
8980 (if (file-exists-p dir)
|
|
|
8981 (error "Cannot make directory %s: file already exists" dir)
|
|
|
8982 (let* ((parsed (efs-ftp-path dir))
|
|
|
8983 (host (nth 0 parsed))
|
|
|
8984 (user (nth 1 parsed))
|
|
|
8985 (host-type (efs-host-type host user))
|
|
|
8986 ;; Some ftp's on unix machines (at least on Suns)
|
|
|
8987 ;; insist that mkdir take a filename, and not a
|
|
|
8988 ;; directory-name name as an arg. Argh!! This is a bug.
|
|
|
8989 ;; Non-unix machines will probably always insist
|
|
|
8990 ;; that mkdir takes a directory-name as an arg
|
|
|
8991 ;; (as the ftp man page says it should).
|
|
|
8992 (path (if (or (memq host-type efs-unix-host-types)
|
|
|
8993 (memq host-type '(os2 dos)))
|
|
|
8994 (efs-internal-directory-file-name (nth 2 parsed))
|
|
|
8995 (efs-internal-file-name-as-directory
|
|
|
8996 host-type (nth 2 parsed))))
|
|
|
8997 (abbr (efs-relativize-filename dir))
|
|
|
8998 (result (efs-send-cmd host user
|
|
|
8999 (list 'mkdir path)
|
|
|
9000 (format "Making directory %s"
|
|
|
9001 abbr))))
|
|
|
9002 (if (car result)
|
|
|
9003 (efs-error host user
|
|
|
9004 (format "Could not make directory %s: %s" dir
|
|
|
9005 (nth 1 result))))
|
|
|
9006 (efs-add-file-entry host-type dir t nil user))))
|
|
|
9007
|
|
|
9008 ;; V19 calls this function delete-directory. It used to be called
|
|
|
9009 ;; remove-directory.
|
|
|
9010
|
|
|
9011 (defun efs-delete-directory (dir)
|
|
|
9012 ;; Version of delete-directory for remote directories.
|
|
|
9013 (if (file-directory-p dir)
|
|
|
9014 (let* ((parsed (efs-ftp-path dir))
|
|
|
9015 (host (nth 0 parsed))
|
|
|
9016 (user (nth 1 parsed))
|
|
|
9017 (host-type (efs-host-type host user))
|
|
|
9018 ;; Some ftp's on unix machines (at least on Suns)
|
|
|
9019 ;; insist that rmdir take a filename, and not a
|
|
|
9020 ;; directory-name name as an arg. Argh!! This is a bug.
|
|
|
9021 ;; Non-unix machines will probably always insist
|
|
|
9022 ;; that rmdir takes a directory-name as an arg
|
|
|
9023 ;; (as the ftp man page says it should).
|
|
|
9024 (path
|
|
|
9025 (if (or (memq host-type efs-unix-host-types)
|
|
|
9026 (memq host-type '(os2 dos)))
|
|
|
9027 (efs-internal-directory-file-name (nth 2 parsed))
|
|
|
9028 (efs-internal-file-name-as-directory
|
|
|
9029 host-type (nth 2 parsed))))
|
|
|
9030 (abbr (efs-relativize-filename dir))
|
|
|
9031 (result (efs-send-cmd host user
|
|
|
9032 (list 'rmdir path)
|
|
|
9033 (format "Deleting directory %s" abbr))))
|
|
|
9034 (if (car result)
|
|
|
9035 (efs-error host user
|
|
|
9036 (format "Could not delete directory %s: %s"
|
|
|
9037 dir (nth 1 result))))
|
|
|
9038 (efs-delete-file-entry host-type dir t))
|
|
|
9039 (error "Not a directory: %s" dir)))
|
|
|
9040
|
|
|
9041 (defun efs-file-local-copy (file)
|
|
|
9042 ;; internal function for diff.el (dired 6.3 or later)
|
|
|
9043 ;; Makes a temp file containing the contents of file.
|
|
|
9044 ;; returns the name of the tmp file created, or nil if none is.
|
|
|
9045 ;; This function should have optional cont and nowait args.
|
|
|
9046 (let* ((file (expand-file-name file))
|
|
|
9047 (tmp (car (efs-make-tmp-name nil (car (efs-ftp-path file))))))
|
|
|
9048 (efs-copy-file-internal file (efs-ftp-path file)
|
|
|
9049 tmp nil t nil (format "Getting %s" file))
|
|
|
9050 tmp))
|
|
|
9051
|
|
|
9052 (defun efs-diff/grep-del-temp-file (temp)
|
|
|
9053 ;; internal function for diff.el and grep.el
|
|
|
9054 ;; if TEMP is non-nil, deletes the temp file TEMP.
|
|
|
9055 ;; if TEMP is nil, does nothing.
|
|
|
9056 (and temp
|
|
|
9057 (efs-del-tmp-name temp)))
|
|
|
9058
|
|
|
9059 ;;;; ------------------------------------------------------------
|
|
|
9060 ;;;; File copying support...
|
|
|
9061 ;;;; ------------------------------------------------------------
|
|
|
9062
|
|
|
9063 ;;; - totally re-written 6/24/92.
|
|
|
9064 ;;; - re-written again 9/3/93
|
|
|
9065 ;;; - and again 14/4/93
|
|
|
9066 ;;; - and again 17/8/93
|
|
|
9067
|
|
|
9068 (defun efs-barf-or-query-if-file-exists (absname querystring interactive)
|
|
|
9069 (if (file-exists-p absname)
|
|
|
9070 (if (not interactive)
|
|
|
9071 (signal 'file-already-exists (list absname))
|
|
|
9072 (if (not (yes-or-no-p (format "File %s already exists; %s anyway? "
|
|
|
9073 absname querystring)))
|
|
|
9074 (signal 'file-already-exists (list absname))))))
|
|
|
9075
|
|
|
9076 (defun efs-concatenate-files (file1 file2)
|
|
|
9077 ;; Concatenates file1 to file2. Both must be local files.
|
|
|
9078 ;; Needed because the efs version of copy-file understands
|
|
|
9079 ;; ok-if-already-exists = 'append
|
|
|
9080 (or (file-readable-p file1)
|
|
|
9081 (signal 'file-error
|
|
|
9082 (list (format "Input file %s not readable." file1))))
|
|
|
9083 (or (file-writable-p file2)
|
|
|
9084 (signal 'file-error
|
|
|
9085 (list (format "Output file %s not writable." file2))))
|
|
|
9086 (let ((default-directory exec-directory))
|
|
|
9087 (call-process "sh" nil nil nil "-c" (format "cat %s >> %s" file1 file2))))
|
|
|
9088
|
|
|
9089 (defun efs-copy-add-file-entry (newname host-type user size append)
|
|
|
9090 ;; Add an entry in `efs-files-hashtable' for a file newly created via a copy.
|
|
|
9091 (if (eq size -1) (setq size nil))
|
|
|
9092 (if append
|
|
|
9093 (let ((ent (efs-get-file-entry newname)))
|
|
|
9094 (if (and ent (null (car ent)))
|
|
|
9095 (if (and size (numberp (nth 1 ent)))
|
|
|
9096 (setcar (cdr ent) (+ size (nth 1 ent)))
|
|
|
9097 (setcar (cdr ent) nil))
|
|
|
9098 ;; If the ent is a symlink or directory, don't overwrite that entry.
|
|
|
9099 (if (null ent)
|
|
|
9100 (efs-add-file-entry host-type newname nil nil nil))))
|
|
|
9101 (efs-add-file-entry host-type newname nil size user)))
|
|
|
9102
|
|
|
9103 (defun efs-copy-remote-to-remote (f-host-type f-host f-user f-path filename
|
|
|
9104 t-host-type t-host t-user
|
|
|
9105 t-path newname append msg cont
|
|
|
9106 nowait xfer-type)
|
|
|
9107 ;; Use a 3rd data connection to copy from F-HOST for F-USER to T-HOST
|
|
|
9108 ;; for T-USER.
|
|
|
9109 (if (efs-get-host-property t-host 'pasv-failed)
|
|
|
9110 ;; PASV didn't work before, don't try again.
|
|
|
9111 (if cont (efs-call-cont cont 'failed "" ""))
|
|
|
9112 (or xfer-type
|
|
|
9113 (setq xfer-type (efs-xfer-type f-host-type filename
|
|
|
9114 t-host-type newname)))
|
|
|
9115 (efs-send-cmd
|
|
|
9116 t-host t-user '(quote pasv) nil nil
|
|
|
9117 (efs-cont (pasv-result pasv-line pasv-cont-lines)
|
|
|
9118 (cont nowait f-host-type f-host f-user f-path filename
|
|
|
9119 t-host-type t-host t-user t-path newname xfer-type msg append)
|
|
|
9120 (efs-save-match-data
|
|
|
9121 (if (or pasv-result
|
|
|
9122 (not (string-match efs-pasv-msgs pasv-line)))
|
|
|
9123 (progn
|
|
|
9124 (efs-set-host-property t-host 'pasv-failed t)
|
|
|
9125 (if cont
|
|
|
9126 (efs-call-cont
|
|
|
9127 cont (or pasv-result 'failed) pasv-line pasv-cont-lines)))
|
|
|
9128 (let ((address (substring pasv-line (match-beginning 1)
|
|
|
9129 (match-end 1))))
|
|
|
9130 (efs-send-cmd
|
|
|
9131 f-host f-user
|
|
|
9132 (list 'quote 'port address) nil nil
|
|
|
9133 (efs-cont (port-result port-line port-cont-lines)
|
|
|
9134 (cont f-host f-user f-host-type f-path filename
|
|
|
9135 xfer-type msg)
|
|
|
9136 (if port-result
|
|
|
9137 (if cont
|
|
|
9138 (efs-call-cont
|
|
|
9139 cont port-result port-line port-cont-lines)
|
|
|
9140 (efs-error f-host f-user
|
|
|
9141 (format "PORT failed for %s: %s"
|
|
|
9142 filename port-line)))
|
|
|
9143 (efs-send-cmd
|
|
|
9144 f-host f-user
|
|
|
9145 (list 'quote 'retr f-path xfer-type)
|
|
|
9146 msg nil
|
|
|
9147 (efs-cont (retr-result retr-line retr-cont-lines)
|
|
|
9148 (cont f-host f-user f-path)
|
|
|
9149 (and retr-result
|
|
|
9150 (null cont)
|
|
|
9151 (efs-error
|
|
|
9152 f-host f-user
|
|
|
9153 (format "RETR failed for %s: %s"
|
|
|
9154 f-path retr-line)))
|
|
|
9155 (if cont (efs-call-cont
|
|
|
9156 cont retr-result retr-line retr-cont-lines)))
|
|
|
9157 (if (eq nowait t) 1 nowait))))
|
|
|
9158 1) ; can't ever wait on this command.
|
|
|
9159 (efs-send-cmd
|
|
|
9160 t-host t-user
|
|
|
9161 (list 'quote (if append 'appe 'stor) t-path xfer-type)
|
|
|
9162 nil nil
|
|
|
9163 (efs-cont (stor-result stor-line stor-cont-lines)
|
|
|
9164 (t-host t-user t-path t-host-type newname filename
|
|
|
9165 append)
|
|
|
9166 (if stor-result
|
|
|
9167 (efs-error
|
|
|
9168 t-host t-user (format "%s failed for %s: %s"
|
|
|
9169 (if append "APPE" "STOR")
|
|
|
9170 t-path stor-line))
|
|
|
9171 (efs-copy-add-file-entry
|
|
|
9172 newname t-host-type t-user
|
|
|
9173 (nth 1 (efs-get-file-entry filename)) append)))
|
|
|
9174 (if (eq nowait t) 1 nowait))))))
|
|
|
9175 nowait)))
|
|
|
9176
|
|
|
9177 (defun efs-copy-on-remote (host user host-type filename newname filename-parsed
|
|
|
9178 newname-parsed keep-date append-p msg cont
|
|
|
9179 nowait xfer-type)
|
|
|
9180 ;; Uses site exec to copy the file on a remote host
|
|
|
9181 (let ((exec-cp (efs-get-host-property host 'exec-cp)))
|
|
|
9182 (if (or append-p
|
|
|
9183 (not (memq host-type efs-unix-host-types))
|
|
|
9184 (efs-get-host-property host 'exec-failed)
|
|
|
9185 (eq exec-cp 'failed))
|
|
|
9186 (efs-copy-via-temp filename filename-parsed newname newname-parsed
|
|
|
9187 append-p keep-date msg cont nowait xfer-type)
|
|
|
9188 (if (eq exec-cp 'works)
|
|
|
9189 (efs-send-cmd
|
|
|
9190 host user
|
|
|
9191 (list 'quote 'site 'exec
|
|
|
9192 (format "cp %s%s %s" (if keep-date "-p " "")
|
|
|
9193 (nth 2 filename-parsed) (nth 2 newname-parsed)))
|
|
|
9194 msg nil
|
|
|
9195 (efs-cont (result line cont-lines) (host user filename newname
|
|
|
9196 host-type filename-parsed
|
|
|
9197 newname-parsed
|
|
|
9198 keep-date append-p msg cont
|
|
|
9199 xfer-type nowait)
|
|
|
9200 (if result
|
|
|
9201 (progn
|
|
|
9202 (efs-set-host-property host 'exec-failed t)
|
|
|
9203 (efs-copy-via-temp filename filename-parsed newname
|
|
|
9204 newname-parsed append-p keep-date
|
|
|
9205 nil cont nowait xfer-type))
|
|
|
9206 (efs-save-match-data
|
|
|
9207 (if (string-match "\n200-\\([^\n]*\\)" cont-lines)
|
|
|
9208 (let ((err (substring cont-lines (match-beginning 1)
|
|
|
9209 (match-end 1))))
|
|
|
9210 (if cont
|
|
|
9211 (efs-call-cont cont 'failed err cont-lines)
|
|
|
9212 (efs-error host user err)))
|
|
|
9213 (efs-copy-add-file-entry
|
|
|
9214 newname host-type user
|
|
|
9215 (nth 7 (efs-file-attributes filename)) nil)
|
|
|
9216 (if cont (efs-call-cont cont nil line cont-lines))))))
|
|
|
9217 nowait)
|
|
|
9218 (message "Checking for cp executable on %s..." host)
|
|
|
9219 (efs-send-cmd
|
|
|
9220 host user (list 'quote 'site 'exec "cp / /") nil nil
|
|
|
9221 (efs-cont (result line cont-lines) (host user filename newname
|
|
|
9222 host-type filename-parsed
|
|
|
9223 newname-parsed
|
|
|
9224 keep-date append-p msg cont
|
|
|
9225 xfer-type nowait)
|
|
|
9226 (efs-save-match-data
|
|
|
9227 (if (string-match "\n200-" cont-lines)
|
|
|
9228 (efs-set-host-property host 'exec-cp 'works)
|
|
|
9229 (efs-set-host-property host 'exec-cp 'failed)))
|
|
|
9230 (efs-copy-on-remote host user host-type filename newname
|
|
|
9231 filename-parsed newname-parsed keep-date
|
|
|
9232 append-p msg cont nowait xfer-type))
|
|
|
9233 nowait)))))
|
|
|
9234
|
|
|
9235 (defun efs-copy-via-temp (filename filename-parsed newname newname-parsed
|
|
|
9236 append keep-date msg cont nowait xfer-type)
|
|
|
9237 ;; Copies from FILENAME to NEWNAME via a temp file.
|
|
|
9238 (let* ((temp (car (if (efs-use-gateway-p (car filename-parsed) t)
|
|
|
9239 (efs-make-tmp-name (car filename-parsed)
|
|
|
9240 (car newname-parsed))
|
|
|
9241 (efs-make-tmp-name (car newname-parsed)
|
|
|
9242 (car filename-parsed)))))
|
|
|
9243 (temp-parsed (efs-ftp-path temp)))
|
|
|
9244 (or xfer-type (setq xfer-type
|
|
|
9245 (efs-xfer-type
|
|
|
9246 (efs-host-type (car filename-parsed)) filename
|
|
|
9247 (efs-host-type (car newname-parsed)) newname
|
|
|
9248 t)))
|
|
|
9249 (efs-copy-file-internal
|
|
|
9250 filename filename-parsed temp temp-parsed t nil (if (eq 0 msg) 2 msg)
|
|
|
9251 (efs-cont (result line cont-lines) (newname newname-parsed temp
|
|
|
9252 temp-parsed append msg cont
|
|
|
9253 nowait xfer-type)
|
|
|
9254 (if result
|
|
|
9255 (progn
|
|
|
9256 (efs-del-tmp-name temp)
|
|
|
9257 (if cont
|
|
|
9258 (efs-call-cont cont result line cont-lines)
|
|
|
9259 (signal 'ftp-error
|
|
|
9260 (list "Opening input file"
|
|
|
9261 (format "FTP Error: \"%s\" " line) filename))))
|
|
|
9262 (efs-copy-file-internal
|
|
|
9263 temp temp-parsed newname newname-parsed (if append 'append t) nil
|
|
|
9264 (if (eq msg 0) 1 msg)
|
|
|
9265 (efs-cont (result line cont-lines) (temp newname cont)
|
|
|
9266 (efs-del-tmp-name temp)
|
|
|
9267 (if cont
|
|
|
9268 (efs-call-cont cont result line cont-lines)
|
|
|
9269 (if result
|
|
|
9270 (signal 'ftp-error
|
|
|
9271 (list "Opening output file"
|
|
|
9272 (format "FTP Error: \"%s\" " line) newname)))))
|
|
|
9273 nowait xfer-type)))
|
|
|
9274 nowait xfer-type)))
|
|
|
9275
|
|
|
9276 (defun efs-copy-file-internal (filename filename-parsed newname newname-parsed
|
|
|
9277 ok-if-already-exists keep-date
|
|
|
9278 &optional msg cont nowait xfer-type)
|
|
|
9279 ;; Internal function for copying a file from FILENAME to NEWNAME.
|
|
|
9280 ;; FILENAME-PARSED and NEWNAME-PARSED are the lists obtained by parsing
|
|
|
9281 ;; FILENAME and NEWNAME with efs-ftp-path.
|
|
|
9282 ;; If OK-IF-ALREADY-EXISTS is nil, then existing files will not be
|
|
|
9283 ;; overwritten.
|
|
|
9284 ;; If it is a number, then the user will be prompted about overwriting.
|
|
|
9285 ;; If it eq 'append, then an existing file will be appended to.
|
|
|
9286 ;; If it has anyother value, then existing files will be silently
|
|
|
9287 ;; overwritten.
|
|
|
9288 ;; If KEEP-DATE is t then we will attempt to reatin the date of the
|
|
|
9289 ;; original copy of the file. If this is a string, the modtime of the
|
|
|
9290 ;; NEWNAME will be set to this date. Must be in touch -t format.
|
|
|
9291 ;; If MSG is nil, then the copying will be done silently.
|
|
|
9292 ;; If it is a string, then that will be the massage displayed while copying.
|
|
|
9293 ;; If it is 0, then a suitable default message will be computed.
|
|
|
9294 ;; If it is 1, then a suitable default will be computed, assuming
|
|
|
9295 ;; that FILENAME is a temporary file, whose name is not suitable to use
|
|
|
9296 ;; in a status message.
|
|
|
9297 ;; If it is 2, then a suitable default will be used, assuming that
|
|
|
9298 ;; NEWNAME is a temporary file.
|
|
|
9299 ;; CONT is a continuation to call after completing the copy.
|
|
|
9300 ;; The first two args are RESULT and LINE, the result symbol and status
|
|
|
9301 ;; line of the FTP command. If more than one ftp command has been used,
|
|
|
9302 ;; then these values for the last FTP command are given.
|
|
|
9303 ;; NOWAIT can be either nil, 0, 1, t. See `efs-send-cmd' for an explanation.
|
|
|
9304 ;; XFER-TYPE is the transfer type to use for transferring the files.
|
|
|
9305 ;; If this is nil, than a suitable transfer type is computed.
|
|
|
9306 ;; Does not call expand-file-name. Do that yourself.
|
|
|
9307
|
|
|
9308 ;; check to see if we can overwrite
|
|
|
9309 (if (or (not ok-if-already-exists)
|
|
|
9310 (numberp ok-if-already-exists))
|
|
|
9311 (efs-barf-or-query-if-file-exists
|
|
|
9312 newname "copy to it" (numberp ok-if-already-exists)))
|
|
|
9313 (if (null (or filename-parsed newname-parsed))
|
|
|
9314 ;; local to local copy
|
|
|
9315 (progn
|
|
|
9316 (if (eq ok-if-already-exists 'append)
|
|
|
9317 (efs-concatenate-files filename newname)
|
|
|
9318 (copy-file filename newname ok-if-already-exists keep-date))
|
|
|
9319 (if cont
|
|
|
9320 (efs-call-cont cont nil "Copied locally" "")))
|
|
|
9321 (let* ((f-host (car filename-parsed))
|
|
|
9322 (f-user (nth 1 filename-parsed))
|
|
|
9323 (f-path (nth 2 filename-parsed))
|
|
|
9324 (f-host-type (efs-host-type f-host f-user))
|
|
|
9325 (f-gate-p (efs-use-gateway-p f-host t))
|
|
|
9326 (t-host (car newname-parsed))
|
|
|
9327 (t-user (nth 1 newname-parsed))
|
|
|
9328 (t-path (nth 2 newname-parsed))
|
|
|
9329 (t-host-type (efs-host-type t-host t-user))
|
|
|
9330 (t-gate-p (efs-use-gateway-p t-host t))
|
|
|
9331 (append-p (eq ok-if-already-exists 'append))
|
|
|
9332 gatename)
|
|
|
9333
|
|
|
9334 (if (and (eq keep-date t) (null newname-parsed))
|
|
|
9335 ;; f-host must be remote now.
|
|
|
9336 (setq keep-date filename))
|
|
|
9337
|
|
|
9338 (cond
|
|
|
9339
|
|
|
9340 ;; Check to see if we can do a PUT
|
|
|
9341 ((or
|
|
|
9342 (and (null f-host)
|
|
|
9343 (or (null t-gate-p)
|
|
|
9344 (setq gatename (efs-local-to-gateway-filename filename))))
|
|
|
9345 (and t-gate-p
|
|
|
9346 f-host
|
|
|
9347 (string-equal (downcase f-host) (downcase efs-gateway-host))
|
|
|
9348 (if (memq f-host-type efs-case-insensitive-host-types)
|
|
|
9349 (string-equal (downcase f-user)
|
|
|
9350 (downcase (efs-get-user efs-gateway-host)))
|
|
|
9351 (string-equal f-user (efs-get-user efs-gateway-host)))))
|
|
|
9352 (or f-host (let (file-name-handler-alist)
|
|
|
9353 (if (file-exists-p filename)
|
|
|
9354 (cond
|
|
|
9355 ((file-directory-p filename)
|
|
|
9356 (signal 'file-error
|
|
|
9357 (list "Non-regular file"
|
|
|
9358 "is a directory" filename)))
|
|
|
9359 ((not (file-readable-p filename))
|
|
|
9360 (signal 'file-error
|
|
|
9361 (list "Opening input file"
|
|
|
9362 "permission denied" filename))))
|
|
|
9363 (signal 'file-error
|
|
|
9364 (list "Opening input file"
|
|
|
9365 "no such file or directory" filename)))))
|
|
|
9366 (or xfer-type
|
|
|
9367 (setq xfer-type
|
|
|
9368 (efs-xfer-type f-host-type filename t-host-type newname)))
|
|
|
9369 (let ((size (and (or (null f-host-type)
|
|
|
9370 (efs-file-entry-p filename))
|
|
|
9371 (nth 7 (file-attributes filename)))))
|
|
|
9372 ;; -1 is a bogus size for remote files
|
|
|
9373 (if (eq size -1) (setq size nil))
|
|
|
9374 (efs-send-cmd
|
|
|
9375 t-host t-user
|
|
|
9376 (list (if append-p 'append 'put)
|
|
|
9377 (if f-host
|
|
|
9378 f-path
|
|
|
9379 (or gatename filename))
|
|
|
9380 t-path
|
|
|
9381 xfer-type)
|
|
|
9382 (cond ((eq msg 2)
|
|
|
9383 (concat (if append-p "Appending " "Putting ")
|
|
|
9384 (efs-relativize-filename filename)))
|
|
|
9385 ((eq msg 1)
|
|
|
9386 (concat (if append-p "Appending " "Putting ")
|
|
|
9387 (efs-relativize-filename newname)))
|
|
|
9388 ((eq msg 0)
|
|
|
9389 (concat (if append-p "Appending " "Copying ")
|
|
|
9390 (efs-relativize-filename filename)
|
|
|
9391 " to "
|
|
|
9392 (efs-relativize-filename
|
|
|
9393 newname (file-name-directory filename) filename)))
|
|
|
9394 (t msg))
|
|
|
9395 (and size (list 'efs-set-xfer-size t-host t-user size))
|
|
|
9396 (efs-cont (result line cont-lines) (newname t-host-type t-user size
|
|
|
9397 append-p cont)
|
|
|
9398 (if result
|
|
|
9399 (if cont
|
|
|
9400 (efs-call-cont cont result line cont-lines)
|
|
|
9401 (signal 'ftp-error
|
|
|
9402 (list "Opening output file"
|
|
|
9403 (format "FTP Error: \"%s\" " line) newname)))
|
|
|
9404 ;; add file entry
|
|
|
9405 (efs-copy-add-file-entry newname t-host-type t-user
|
|
|
9406 size append-p)
|
|
|
9407 (if cont
|
|
|
9408 (efs-call-cont cont result line cont-lines))))
|
|
|
9409 nowait)))
|
|
|
9410
|
|
|
9411 ;; Check to see if we can do a GET
|
|
|
9412 ((and
|
|
|
9413 ;; I think that giving the append arg, will cause this function
|
|
|
9414 ;; to make a temp file, recursively call itself, and append the temp
|
|
|
9415 ;; file to the local file. Hope it works out...
|
|
|
9416 (null append-p)
|
|
|
9417 (or
|
|
|
9418 (and (null t-host)
|
|
|
9419 (or (null f-gate-p)
|
|
|
9420 (setq gatename (efs-local-to-gateway-filename newname))))
|
|
|
9421 (and f-gate-p
|
|
|
9422 t-host
|
|
|
9423 (string-equal (downcase t-host) (downcase efs-gateway-host))
|
|
|
9424 (if (memq t-host-type efs-case-insensitive-host-types)
|
|
|
9425 (string-equal (downcase t-user)
|
|
|
9426 (downcase (efs-get-user efs-gateway-host)))
|
|
|
9427 (string-equal t-user (efs-get-user efs-gateway-host))))))
|
|
|
9428 (or t-host (let (file-name-handler-alist)
|
|
|
9429 (cond ((not (file-writable-p newname))
|
|
|
9430 (signal 'file-error
|
|
|
9431 (list "Opening output file"
|
|
|
9432 "permission denied" newname)))
|
|
|
9433 ((file-directory-p newname)
|
|
|
9434 (signal 'file-error
|
|
|
9435 (list "Opening output file"
|
|
|
9436 "is a directory" newname))))))
|
|
|
9437 (or xfer-type
|
|
|
9438 (setq xfer-type
|
|
|
9439 (efs-xfer-type f-host-type filename t-host-type newname)))
|
|
|
9440 (let ((size (and (or (null f-host-type)
|
|
|
9441 (efs-file-entry-p filename))
|
|
|
9442 (nth 7 (file-attributes filename)))))
|
|
|
9443 ;; -1 is a bogus size for remote files.
|
|
|
9444 (if (eq size -1) (setq size nil))
|
|
|
9445 (efs-send-cmd
|
|
|
9446 f-host f-user
|
|
|
9447 (list 'get
|
|
|
9448 f-path
|
|
|
9449 (if t-host
|
|
|
9450 t-path
|
|
|
9451 (or gatename newname))
|
|
|
9452 xfer-type)
|
|
|
9453 (cond ((eq msg 0)
|
|
|
9454 (concat "Copying "
|
|
|
9455 (efs-relativize-filename filename)
|
|
|
9456 " to "
|
|
|
9457 (efs-relativize-filename
|
|
|
9458 newname (file-name-directory filename) filename)))
|
|
|
9459 ((eq msg 2)
|
|
|
9460 (concat "Getting " (efs-relativize-filename filename)))
|
|
|
9461 ((eq msg 1)
|
|
|
9462 (concat "Getting " (efs-relativize-filename newname)))
|
|
|
9463 (t msg))
|
|
|
9464 ;; If the server emits a efs-xfer-size-msgs, it will over-ride this.
|
|
|
9465 ;; With no xfer msg, this is will do the job.
|
|
|
9466 (and size (list 'efs-set-xfer-size f-host f-user size))
|
|
|
9467 (efs-cont (result line cont-lines) (filename newname size
|
|
|
9468 t-host-type t-user
|
|
|
9469 cont keep-date)
|
|
|
9470 (if result
|
|
|
9471 (if cont
|
|
|
9472 (efs-call-cont cont result line cont-lines)
|
|
|
9473 (signal 'ftp-error
|
|
|
9474 (list "Opening input file"
|
|
|
9475 (format "FTP Error: \"%s\" " line) filename)))
|
|
|
9476 ;; Add a new file entry, if relevant.
|
|
|
9477 (if t-host-type
|
|
|
9478 ;; t-host will be equal to efs-gateway-host, if t-host-type
|
|
|
9479 ;; is non-nil.
|
|
|
9480 (efs-copy-add-file-entry newname t-host-type
|
|
|
9481 t-user size nil))
|
|
|
9482 (if (and (null t-host-type) (stringp keep-date))
|
|
|
9483 (efs-set-mdtm-of
|
|
|
9484 filename newname
|
|
|
9485 (and cont
|
|
|
9486 (efs-cont (result1 line1 cont-lines1) (result
|
|
|
9487 line cont-lines
|
|
|
9488 cont)
|
|
|
9489 (efs-call-cont cont result line cont-lines))))
|
|
|
9490 (if cont
|
|
|
9491 (efs-call-cont cont result line cont-lines)))))
|
|
|
9492 nowait)))
|
|
|
9493
|
|
|
9494 ;; Can we do a EXEC cp?
|
|
|
9495 ((and t-host f-host
|
|
|
9496 (string-equal (downcase t-host) (downcase f-host))
|
|
|
9497 (if (memq t-host-type efs-case-insensitive-host-types)
|
|
|
9498 (string-equal (downcase t-user) (downcase f-user))
|
|
|
9499 (string-equal t-user f-user)))
|
|
|
9500 (efs-copy-on-remote
|
|
|
9501 t-host t-user t-host-type filename newname filename-parsed
|
|
|
9502 newname-parsed keep-date append-p
|
|
|
9503 (cond ((eq msg 0)
|
|
|
9504 (concat "Copying "
|
|
|
9505 (efs-relativize-filename filename)
|
|
|
9506 " to "
|
|
|
9507 (efs-relativize-filename
|
|
|
9508 newname (file-name-directory filename) filename)))
|
|
|
9509 ((eq msg 1)
|
|
|
9510 (concat "Copying " (efs-relativize-filename newname)))
|
|
|
9511 ((eq msg 2)
|
|
|
9512 (concat "Copying " (efs-relativize-filename filename)))
|
|
|
9513 (t msg))
|
|
|
9514 cont nowait xfer-type))
|
|
|
9515
|
|
|
9516 ;; Try for a copy with PASV
|
|
|
9517 ((and t-host f-host
|
|
|
9518 (not (and (string-equal (downcase t-host) (downcase f-host))
|
|
|
9519 (if (memq t-host-type efs-case-insensitive-host-types)
|
|
|
9520 (string-equal (downcase t-user) (downcase f-user))
|
|
|
9521 (string-equal t-user f-user))))
|
|
|
9522 (or
|
|
|
9523 (and efs-gateway-host
|
|
|
9524 ;; The gateway should be able to talk to anything.
|
|
|
9525 (let ((gh (downcase efs-gateway-host)))
|
|
|
9526 (or (string-equal (downcase t-host) gh)
|
|
|
9527 (string-equal (downcase f-host) gh))))
|
|
|
9528 (efs-save-match-data
|
|
|
9529 (eq (null (string-match efs-local-host-regexp t-host))
|
|
|
9530 (null (string-match efs-local-host-regexp f-host))))))
|
|
|
9531 (efs-copy-remote-to-remote
|
|
|
9532 f-host-type f-host f-user f-path filename
|
|
|
9533 t-host-type t-host t-user t-path newname
|
|
|
9534 append-p
|
|
|
9535 (cond ((eq msg 0)
|
|
|
9536 (concat "Copying "
|
|
|
9537 (efs-relativize-filename filename)
|
|
|
9538 " to "
|
|
|
9539 (efs-relativize-filename
|
|
|
9540 newname (file-name-directory filename) filename)))
|
|
|
9541 ((eq msg 1)
|
|
|
9542 (concat "Copying " (efs-relativize-filename newname)))
|
|
|
9543 ((eq msg 2)
|
|
|
9544 (concat "Copying " (efs-relativize-filename filename)))
|
|
|
9545 (t msg))
|
|
|
9546 (efs-cont (result line cont-lines)
|
|
|
9547 (filename filename-parsed newname newname-parsed
|
|
|
9548 append-p keep-date msg cont nowait xfer-type)
|
|
|
9549 (if result
|
|
|
9550 ;; PASV didn't work. Do things the old-fashioned
|
|
|
9551 ;; way.
|
|
|
9552 (efs-copy-via-temp
|
|
|
9553 filename filename-parsed newname newname-parsed
|
|
|
9554 append-p keep-date msg cont nowait xfer-type)
|
|
|
9555 (if cont
|
|
|
9556 (efs-call-cont cont result line cont-lines))))
|
|
|
9557 nowait xfer-type))
|
|
|
9558
|
|
|
9559 ;; Can't do anything direct. Divide and conquer.
|
|
|
9560 (t
|
|
|
9561 (efs-copy-via-temp filename filename-parsed newname newname-parsed
|
|
|
9562 append-p keep-date msg cont nowait xfer-type))))))
|
|
|
9563
|
|
|
9564 (defun efs-copy-file (filename newname &optional ok-if-already-exists
|
|
|
9565 keep-date nowait)
|
|
|
9566 ;; Version of copy file for remote files. Actually, will also work
|
|
|
9567 ;; for local files too, since efs-copy-file-internal can copy anything.
|
|
|
9568 ;; If called interactively, copies asynchronously.
|
|
|
9569 (setq filename (expand-file-name filename)
|
|
|
9570 newname (expand-file-name newname))
|
|
|
9571 (if (eq ok-if-already-exists 'append)
|
|
|
9572 (setq ok-if-already-exists t))
|
|
|
9573 (efs-copy-file-internal filename (efs-ftp-path filename)
|
|
|
9574 newname (efs-ftp-path newname)
|
|
|
9575 ok-if-already-exists keep-date 0 nil nowait))
|
|
|
9576
|
|
|
9577 ;;;; ------------------------------------------------------------
|
|
|
9578 ;;;; File renaming support.
|
|
|
9579 ;;;; ------------------------------------------------------------
|
|
|
9580
|
|
|
9581 (defun efs-rename-get-file-list (dir ent)
|
|
|
9582 ;; From hashtable ENT for DIR returns a list of all files except "."
|
|
|
9583 ;; and "..".
|
|
|
9584 (let (list)
|
|
|
9585 (efs-map-hashtable
|
|
|
9586 (function
|
|
|
9587 (lambda (key val)
|
|
|
9588 (or (string-equal "." key) (string-equal ".." key)
|
|
|
9589 (setq list
|
|
|
9590 (cons (expand-file-name key dir) list)))))
|
|
|
9591 ent)
|
|
|
9592 list))
|
|
|
9593
|
|
|
9594 (defun efs-rename-get-files (dir cont nowait)
|
|
|
9595 ;; Obtains a list of files in directory DIR (except . and ..), and applies
|
|
|
9596 ;; CONT to the list. Doesn't return anything useful.
|
|
|
9597 (let* ((dir (file-name-as-directory dir))
|
|
|
9598 (ent (efs-get-files-hashtable-entry dir)))
|
|
|
9599 (if ent
|
|
|
9600 (efs-call-cont cont (efs-rename-get-file-list dir ent))
|
|
|
9601 (efs-ls
|
|
|
9602 dir (efs-ls-guess-switches) t nil t nowait
|
|
|
9603 (efs-cont (listing) (dir cont)
|
|
|
9604 (efs-call-cont
|
|
|
9605 cont (and listing
|
|
|
9606 (efs-rename-get-file-list
|
|
|
9607 dir (efs-get-files-hashtable-entry dir)))))))))
|
|
|
9608
|
|
|
9609 (defun efs-rename-get-local-file-tree (dir)
|
|
|
9610 ;; Returns a list of the full directory tree under DIR, for DIR on the
|
|
|
9611 ;; local host. The list is in tree order.
|
|
|
9612 (let ((res (list dir)))
|
|
|
9613 (mapcar
|
|
|
9614 (function
|
|
|
9615 (lambda (file)
|
|
|
9616 (if (file-directory-p file)
|
|
|
9617 (nconc res (delq nil (mapcar
|
|
|
9618 (function
|
|
|
9619 (lambda (f)
|
|
|
9620 (and (not (string-equal "." f))
|
|
|
9621 (not (string-equal ".." f))
|
|
|
9622 (expand-file-name f file))))
|
|
|
9623 (directory-files file)))))))
|
|
|
9624 res)
|
|
|
9625 res))
|
|
|
9626
|
|
|
9627 (defun efs-rename-get-remote-file-tree (next curr total cont nowait)
|
|
|
9628 ;; Builds a hierarchy of files.
|
|
|
9629 ;; NEXT is the next level so far.
|
|
|
9630 ;; CURR are unprocessed files in the current level.
|
|
|
9631 ;; TOTAL is the processed files so far.
|
|
|
9632 ;; CONT is a cont. function called on the total list after all files
|
|
|
9633 ;; are processed.
|
|
|
9634 ;; NOWAIT non-nil means run asynch.
|
|
|
9635 (or curr (setq curr next
|
|
|
9636 next nil))
|
|
|
9637 (if curr
|
|
|
9638 (let ((file (car curr)))
|
|
|
9639 (setq curr (cdr curr)
|
|
|
9640 total (cons file total))
|
|
|
9641 (if (file-directory-p file)
|
|
|
9642 (efs-rename-get-files
|
|
|
9643 file
|
|
|
9644 (efs-cont (list) (next curr total cont nowait)
|
|
|
9645 (efs-rename-get-remote-file-tree (nconc next list)
|
|
|
9646 curr total cont nowait))
|
|
|
9647 nowait)
|
|
|
9648 (efs-rename-get-remote-file-tree next curr total cont nowait)))
|
|
|
9649 (efs-call-cont cont (nreverse total))))
|
|
|
9650
|
|
|
9651 (defun efs-rename-make-targets (files from-dir-len to-dir host user host-type
|
|
|
9652 cont nowait)
|
|
|
9653 ;; Make targets (copy a file or make a subdir) on local or host
|
|
|
9654 ;; for the files in list. Afterwhich, call CONT.
|
|
|
9655 (if files
|
|
|
9656 (let* ((from (car files))
|
|
|
9657 (files (cdr files))
|
|
|
9658 (to (concat to-dir (substring from from-dir-len))))
|
|
|
9659 (if (file-directory-p from)
|
|
|
9660 (if host-type
|
|
|
9661 (let ((dir (nth 2 (efs-ftp-path to))))
|
|
|
9662 (or (memq host-type efs-unix-host-types)
|
|
|
9663 (memq host-type '(dos os2))
|
|
|
9664 (setq dir (efs-internal-file-name-as-directory nil dir)))
|
|
|
9665 (efs-send-cmd
|
|
|
9666 host user (list 'mkdir dir)
|
|
|
9667 (format "Making directory %s" (efs-relativize-filename to))
|
|
|
9668 nil
|
|
|
9669 (efs-cont (res line cont-lines) (to files from-dir-len
|
|
|
9670 to-dir host user
|
|
|
9671 host-type cont nowait)
|
|
|
9672 (if res
|
|
|
9673 (if cont
|
|
|
9674 (efs-call-cont cont res line cont-lines)
|
|
|
9675 (signal 'ftp-error
|
|
|
9676 (list "Making directory"
|
|
|
9677 (format "FTP Error: \"%s\"" line)
|
|
|
9678 to)))
|
|
|
9679 (efs-rename-make-targets
|
|
|
9680 files from-dir-len to-dir host user
|
|
|
9681 host-type cont nowait)))
|
|
|
9682 nowait))
|
|
|
9683 (condition-case nil
|
|
|
9684 (make-directory-internal to)
|
|
|
9685 (error (efs-call-cont
|
|
|
9686 cont 'failed (format "Failed to mkdir %s" to) "")))
|
|
|
9687 (efs-rename-make-targets
|
|
|
9688 files from-dir-len to-dir host user host-type cont nowait))
|
|
|
9689 (efs-copy-file-internal
|
|
|
9690 from (efs-ftp-path from) to (and host-type (efs-ftp-path to)) nil t
|
|
|
9691 (format "Renaming %s to %s" (efs-relativize-filename from)
|
|
|
9692 (efs-relativize-filename to))
|
|
|
9693 (efs-cont (res line cont-lines) (from to files from-dir-len to-dir
|
|
|
9694 host user host-type cont
|
|
|
9695 nowait)
|
|
|
9696 (if res
|
|
|
9697 (if cont
|
|
|
9698 (efs-call-cont cont res line cont-lines)
|
|
|
9699 (signal 'ftp-error
|
|
|
9700 (list "Renaming"
|
|
|
9701 (format "FTP Error: \"%s\"" line) from to)))
|
|
|
9702 (efs-rename-make-targets
|
|
|
9703 files from-dir-len to-dir host user host-type cont nowait)))
|
|
|
9704 nowait)))
|
|
|
9705 (if cont (efs-call-cont cont nil "" ""))))
|
|
|
9706
|
|
|
9707 (defun efs-rename-delete-on-local (files)
|
|
|
9708 ;; Delete the files FILES, and then run CONT.
|
|
|
9709 ;; FILES are assumed to be in inverse tree order.
|
|
|
9710 (message "Deleting files...")
|
|
|
9711 (mapcar
|
|
|
9712 (function
|
|
|
9713 (lambda (f)
|
|
|
9714 (condition-case nil
|
|
|
9715 (if (file-directory-p f)
|
|
|
9716 (delete-directory f)
|
|
|
9717 (delete-file f))
|
|
|
9718 (file-error nil)))) ; don't complain if the file is already gone.
|
|
|
9719 files)
|
|
|
9720 (message "Deleting files...done"))
|
|
|
9721
|
|
|
9722 (defun efs-rename-delete-on-remote (files host user host-type cont nowait)
|
|
|
9723 ;; Deletes the list FILES on a remote host. When done calls CONT.
|
|
|
9724 ;; FILES is assumed to be in reverse tree order.
|
|
|
9725 (if files
|
|
|
9726 (let* ((f (car files))
|
|
|
9727 (rf (nth 2 (efs-ftp-path f))))
|
|
|
9728 (progn
|
|
|
9729 (setq files (cdr files))
|
|
|
9730 (if (file-directory-p f)
|
|
|
9731 (let ((rf (if (memq host-type (append efs-unix-host-types
|
|
|
9732 '(dos os2)))
|
|
|
9733 (efs-internal-directory-file-name f)
|
|
|
9734 (efs-internal-file-name-as-directory nil f))))
|
|
|
9735
|
|
|
9736 (efs-send-cmd
|
|
|
9737 host user (list 'rmdir rf)
|
|
|
9738 (concat "Deleting directory " (efs-relativize-filename f))
|
|
|
9739 nil
|
|
|
9740 (efs-cont (res line cont-lines) (f files host user host-type
|
|
|
9741 cont nowait)
|
|
|
9742 (if (and res
|
|
|
9743 (efs-save-match-data
|
|
|
9744 (not (string-match "^550 " line))))
|
|
|
9745 (if cont
|
|
|
9746 (efs-call-cont cont res line cont-lines)
|
|
|
9747 (signal 'ftp-error
|
|
|
9748 (list "Deleting directory"
|
|
|
9749 (format "FTP Error: \"%s\"" line)
|
|
|
9750 f)))
|
|
|
9751 (efs-rename-delete-on-remote
|
|
|
9752 files host user host-type cont nowait)))
|
|
|
9753 nowait))
|
|
|
9754 (efs-send-cmd
|
|
|
9755 host user (list 'delete rf)
|
|
|
9756 (concat "Deleting " rf)
|
|
|
9757 nil
|
|
|
9758 (efs-cont (res line cont-lines) (f files host user host-type
|
|
|
9759 cont nowait)
|
|
|
9760 (if (and res
|
|
|
9761 (efs-save-match-data
|
|
|
9762 (not (string-match "^550 " line))))
|
|
|
9763 (if cont
|
|
|
9764 (efs-call-cont cont res line cont-lines)
|
|
|
9765 (signal 'ftp-error
|
|
|
9766 (list "Deleting"
|
|
|
9767 (format "FTP Error: \"%s\"" line)
|
|
|
9768 f)))
|
|
|
9769 (efs-rename-delete-on-remote
|
|
|
9770 files host user host-type cont nowait)))
|
|
|
9771 nowait))))
|
|
|
9772 (if cont (efs-call-cont cont nil "" ""))))
|
|
|
9773
|
|
|
9774 (defun efs-rename-on-remote (host user old-path new-path old-file new-file
|
|
|
9775 msg nowait cont)
|
|
|
9776 ;; Run a rename command on the remote server.
|
|
|
9777 ;; OLD-PATH and NEW-PATH are in full efs syntax.
|
|
|
9778 ;; OLD-FILE and NEW-FILE are the remote full pathnames, not in efs syntax.
|
|
|
9779 (efs-send-cmd
|
|
|
9780 host user (list 'rename old-file new-file) msg nil
|
|
|
9781 (efs-cont (result line cont-lines) (cont old-path new-path host)
|
|
|
9782 (if result
|
|
|
9783 (progn
|
|
|
9784 (or (and (>= (length line) 4)
|
|
|
9785 (string-equal "550 " (substring line 0 4)))
|
|
|
9786 (efs-set-host-property host 'rnfr-failed t))
|
|
|
9787 (if cont
|
|
|
9788 (efs-call-cont cont result line cont-lines)
|
|
|
9789 (signal 'ftp-error
|
|
|
9790 (list "Renaming"
|
|
|
9791 (format "FTP Error: \"%s\"" line)
|
|
|
9792 old-path new-path))))
|
|
|
9793 (let ((entry (efs-get-file-entry old-path))
|
|
|
9794 (host-type (efs-host-type host))
|
|
|
9795 ;; If no file entry, do extra work on the hashtable,
|
|
|
9796 ;; rather than force a listing.
|
|
|
9797 (dir-p (or (not (efs-file-entry-p old-path))
|
|
|
9798 (file-directory-p old-path))))
|
|
|
9799 (apply 'efs-add-file-entry host-type new-path
|
|
|
9800 (eq (car entry) t) (cdr entry))
|
|
|
9801 (efs-delete-file-entry host-type old-path)
|
|
|
9802 (if dir-p
|
|
|
9803 (let* ((old (efs-canonize-file-name
|
|
|
9804 (file-name-as-directory old-path)))
|
|
|
9805 (new (efs-canonize-file-name
|
|
|
9806 (file-name-as-directory new-path)))
|
|
|
9807 (old-len (length old))
|
|
|
9808 (new-tbl (efs-make-hashtable
|
|
|
9809 (length efs-files-hashtable))))
|
|
|
9810 (efs-map-hashtable
|
|
|
9811 (function
|
|
|
9812 (lambda (key val)
|
|
|
9813 (if (and (>= (length key) old-len)
|
|
|
9814 (string-equal (substring key 0 old-len)
|
|
|
9815 old))
|
|
|
9816 (efs-put-hash-entry
|
|
|
9817 (concat new (substring key old-len)) val new-tbl)
|
|
|
9818 (efs-put-hash-entry key val new-tbl))))
|
|
|
9819 efs-files-hashtable)
|
|
|
9820 (setq efs-files-hashtable new-tbl)))
|
|
|
9821 (if cont (efs-call-cont cont result line cont-lines)))))
|
|
|
9822 nowait))
|
|
|
9823
|
|
|
9824 (defun efs-rename-local-to-remote (filename newname newname-parsed
|
|
|
9825 msg cont nowait)
|
|
|
9826 ;; Renames a file from the local host to a remote host.
|
|
|
9827 (if (file-directory-p filename)
|
|
|
9828 (let* ((files (efs-rename-get-local-file-tree filename))
|
|
|
9829 (to-dir (directory-file-name newname))
|
|
|
9830 (filename (directory-file-name filename))
|
|
|
9831 (len (length filename))
|
|
|
9832 (t-parsed (efs-ftp-path to-dir))
|
|
|
9833 (host (car t-parsed))
|
|
|
9834 (user (nth 1 t-parsed))
|
|
|
9835 (host-type (efs-host-type host)))
|
|
|
9836 ;; MSG is never passed here, instead messages are constructed
|
|
|
9837 ;; internally. I don't know how to use a single message
|
|
|
9838 ;; in a function which sends so many FTP commands.
|
|
|
9839 (efs-rename-make-targets
|
|
|
9840 files len to-dir host user host-type
|
|
|
9841 (efs-cont (result line cont-lines) (files filename newname cont)
|
|
|
9842 (if result
|
|
|
9843 (if cont
|
|
|
9844 (efs-call-cont cont result line cont-lines)
|
|
|
9845 (signal 'ftp-error
|
|
|
9846 (list "Renaming" (format "FTP Error: \"%s\"" line)
|
|
|
9847 filename newname)))
|
|
|
9848 (efs-rename-delete-on-local (nreverse files))
|
|
|
9849 (if cont (efs-call-cont cont result line cont-lines))))
|
|
|
9850 nowait))
|
|
|
9851 (efs-copy-file-internal
|
|
|
9852 filename nil newname newname-parsed t t msg
|
|
|
9853 (efs-cont (result line cont-lines) (filename cont)
|
|
|
9854 (if result
|
|
|
9855 (if cont
|
|
|
9856 (efs-call-cont cont result line cont-lines)
|
|
|
9857 (signal 'ftp-error
|
|
|
9858 (list "Renaming"
|
|
|
9859 (format "FTP Error: \"%s\"" line)
|
|
|
9860 filename newname)))
|
|
|
9861 (condition-case nil
|
|
|
9862 (delete-file filename)
|
|
|
9863 (error nil))
|
|
|
9864 (if cont (efs-call-cont cont result line cont-lines))))
|
|
|
9865 nowait)))
|
|
|
9866
|
|
|
9867 (defun efs-rename-from-remote (filename filename-parsed newname newname-parsed
|
|
|
9868 msg cont nowait)
|
|
|
9869 (let ((f-host (car filename-parsed))
|
|
|
9870 (f-user (nth 1 filename-parsed))
|
|
|
9871 (fast-nowait (if (eq nowait t) 1 nowait)))
|
|
|
9872 (if (file-directory-p filename)
|
|
|
9873 (let* ((t-host (car newname-parsed))
|
|
|
9874 (t-user (nth 1 newname-parsed))
|
|
|
9875 (t-host-type (and t-host (efs-host-type t-host)))
|
|
|
9876 (f-host-type (efs-host-type f-host)))
|
|
|
9877 (efs-rename-get-remote-file-tree
|
|
|
9878 nil (list filename) nil
|
|
|
9879 (efs-cont (list) (filename filename-parsed newname t-host t-user
|
|
|
9880 t-host-type f-host f-user f-host-type
|
|
|
9881 cont fast-nowait)
|
|
|
9882 (efs-rename-make-targets
|
|
|
9883 list (length filename) newname t-host t-user t-host-type
|
|
|
9884 (efs-cont (res line cont-lines) (filename newname f-host f-user
|
|
|
9885 f-host-type list cont
|
|
|
9886 fast-nowait)
|
|
|
9887 (if res
|
|
|
9888 (if cont
|
|
|
9889 (efs-call-cont cont res line cont-lines)
|
|
|
9890 (signal 'ftp-error
|
|
|
9891 (list "Renaming"
|
|
|
9892 (format "FTP Error: \"%s\"" line)
|
|
|
9893 filename newname)))
|
|
|
9894 (efs-rename-delete-on-remote
|
|
|
9895 (nreverse list) f-host f-user f-host-type cont
|
|
|
9896 fast-nowait)))
|
|
|
9897 fast-nowait)) nowait))
|
|
|
9898 ;; Do things the simple way.
|
|
|
9899 (let ((f-path (nth 2 filename-parsed))
|
|
|
9900 (f-abbr (efs-relativize-filename filename)))
|
|
|
9901 (efs-copy-file-internal
|
|
|
9902 filename filename-parsed newname newname-parsed t t msg
|
|
|
9903 (efs-cont (result line cont-lines) (filename newname f-host f-user
|
|
|
9904 f-path f-abbr
|
|
|
9905 cont fast-nowait)
|
|
|
9906 (if result
|
|
|
9907 (if cont
|
|
|
9908 (efs-call-cont cont result line cont-lines)
|
|
|
9909 (signal 'ftp-error
|
|
|
9910 (list "Renaming"
|
|
|
9911 (format "FTP Error: \"%s\"" line)
|
|
|
9912 filename newname)))
|
|
|
9913 (efs-send-cmd
|
|
|
9914 f-host f-user (list 'delete f-path)
|
|
|
9915 (format "Removing %s" f-abbr) nil
|
|
|
9916 (efs-cont (result line cont-lines) (filename f-host cont)
|
|
|
9917 (if result
|
|
|
9918 (if cont
|
|
|
9919 (efs-call-cont cont result line cont-lines)
|
|
|
9920 (signal 'ftp-error
|
|
|
9921 (list "Renaming"
|
|
|
9922 (format "Failed to remove %s"
|
|
|
9923 filename)
|
|
|
9924 "FTP Error: \"%s\"" line)))
|
|
|
9925 (efs-delete-file-entry (efs-host-type f-host)
|
|
|
9926 filename)
|
|
|
9927 (if cont
|
|
|
9928 (efs-call-cont cont result line cont-lines))))
|
|
|
9929 fast-nowait))) nowait)))))
|
|
|
9930
|
|
|
9931 (defun efs-rename-file-internal (filename newname ok-if-already-exists
|
|
|
9932 &optional msg cont nowait)
|
|
|
9933 ;; Internal version of rename-file for remote files.
|
|
|
9934 ;; Takes CONT and NOWAIT args.
|
|
|
9935 (let ((filename (expand-file-name filename))
|
|
|
9936 (newname (expand-file-name newname)))
|
|
|
9937 (let ((f-parsed (efs-ftp-path filename))
|
|
|
9938 (t-parsed (efs-ftp-path newname)))
|
|
|
9939 (if (null (or f-parsed t-parsed))
|
|
|
9940 (progn
|
|
|
9941 ;; local rename
|
|
|
9942 (rename-file filename newname ok-if-already-exists)
|
|
|
9943 (if cont
|
|
|
9944 (efs-call-cont cont nil "Renamed locally" "")))
|
|
|
9945
|
|
|
9946 ;; check to see if we can overwrite
|
|
|
9947 (if (or (not ok-if-already-exists)
|
|
|
9948 (numberp ok-if-already-exists))
|
|
|
9949 (efs-barf-or-query-if-file-exists
|
|
|
9950 newname "rename to it" (numberp ok-if-already-exists)))
|
|
|
9951
|
|
|
9952 (let ((f-abbr (efs-relativize-filename filename))
|
|
|
9953 (t-abbr (efs-relativize-filename newname
|
|
|
9954 (file-name-directory filename)
|
|
|
9955 filename)))
|
|
|
9956 (or msg (setq msg (format "Renaming %s to %s" f-abbr t-abbr)))
|
|
|
9957 (if f-parsed
|
|
|
9958 (let* ((f-host (car f-parsed))
|
|
|
9959 (f-user (nth 1 f-parsed))
|
|
|
9960 (f-path (nth 2 f-parsed))
|
|
|
9961 (f-host-type (efs-host-type f-host)))
|
|
|
9962 (if (and t-parsed
|
|
|
9963 (string-equal (downcase f-host)
|
|
|
9964 (downcase (car t-parsed)))
|
|
|
9965 (not (efs-get-host-property f-host 'rnfr-failed))
|
|
|
9966 (if (memq f-host-type efs-case-insensitive-host-types)
|
|
|
9967 (string-equal (downcase f-user)
|
|
|
9968 (downcase (nth 1 t-parsed)))
|
|
|
9969 (string-equal f-user (nth 1 t-parsed))))
|
|
|
9970 ;; Can run a RENAME command on the server.
|
|
|
9971 (efs-rename-on-remote
|
|
|
9972 f-host f-user filename newname f-path (nth 2 t-parsed)
|
|
|
9973 msg nowait
|
|
|
9974 (efs-cont (result line cont-lines) (f-host
|
|
|
9975 filename
|
|
|
9976 newname
|
|
|
9977 ok-if-already-exists
|
|
|
9978 msg cont nowait)
|
|
|
9979 (if result
|
|
|
9980 (progn
|
|
|
9981 (efs-set-host-property f-host 'rnfr-failed t)
|
|
|
9982 (efs-rename-file-internal
|
|
|
9983 filename newname ok-if-already-exists msg cont
|
|
|
9984 (if (eq nowait t) 1 nowait)))
|
|
|
9985 (if cont
|
|
|
9986 (efs-call-cont cont result line cont-lines)))))
|
|
|
9987 ;; remote to remote
|
|
|
9988 (efs-rename-from-remote filename f-parsed newname t-parsed
|
|
|
9989 msg cont nowait)))
|
|
|
9990 ;; local to remote
|
|
|
9991 (efs-rename-local-to-remote
|
|
|
9992 filename newname t-parsed msg cont nowait)))))))
|
|
|
9993
|
|
|
9994 (defun efs-rename-file (filename newname &optional ok-if-already-exists nowait)
|
|
|
9995 ;; Does file renaming for remote files.
|
|
|
9996 (efs-rename-file-internal filename newname ok-if-already-exists
|
|
|
9997 nil nil nowait))
|
|
|
9998
|
|
|
9999 ;;;; ------------------------------------------------------------
|
|
|
10000 ;;;; Making symbolic and hard links.
|
|
|
10001 ;;;; ------------------------------------------------------------
|
|
|
10002
|
|
|
10003 ;;; These functions require that the remote FTP server understand
|
|
|
10004 ;;; SITE EXEC and that ln is in its the ftp-exec path.
|
|
|
10005
|
|
|
10006 (defun efs-try-ln (host user cont nowait)
|
|
|
10007 ;; Do some preemptive testing to see if exec ln works
|
|
|
10008 (if (efs-get-host-property host 'exec-failed)
|
|
|
10009 (signal 'ftp-error (list "Unable to exec ln on host" host)))
|
|
|
10010 (let ((exec-ln (efs-get-host-property host 'exec-ln)))
|
|
|
10011 (cond
|
|
|
10012 ((eq exec-ln 'failed)
|
|
|
10013 (signal 'ftp-error (list "ln is not in FTP exec path on host" host)))
|
|
|
10014 ((eq exec-ln 'works)
|
|
|
10015 (efs-call-cont cont))
|
|
|
10016 (t
|
|
|
10017 (message "Checking for ln executable on %s..." host)
|
|
|
10018 (efs-send-cmd
|
|
|
10019 host user '(quote site exec "ln / /")
|
|
|
10020 nil nil
|
|
|
10021 (efs-cont (result line cont-lines) (host user cont)
|
|
|
10022 (if result
|
|
|
10023 (progn
|
|
|
10024 (efs-set-host-property host 'exec-failed t)
|
|
|
10025 (efs-error host user (format "exec: %s" line)))
|
|
|
10026 ;; Look for an error message
|
|
|
10027 (if (efs-save-match-data
|
|
|
10028 (string-match "\n200-" cont-lines))
|
|
|
10029 (progn
|
|
|
10030 (efs-set-host-property host 'exec-ln 'works)
|
|
|
10031 (efs-call-cont cont))
|
|
|
10032 (efs-set-host-property host 'exec-ln 'failed)
|
|
|
10033 (efs-error host user
|
|
|
10034 (format "ln not in FTP exec path on host %s" host)))))
|
|
|
10035 nowait)))))
|
|
|
10036
|
|
|
10037 (defun efs-make-symbolic-link-internal
|
|
|
10038 (target linkname &optional ok-if-already-exists cont nowait)
|
|
|
10039 ;; Makes remote symbolic links. Assumes that linkname is already expanded.
|
|
|
10040 (let* ((parsed (efs-ftp-path linkname))
|
|
|
10041 (host (car parsed))
|
|
|
10042 (user (nth 1 parsed))
|
|
|
10043 (linkpath (nth 2 parsed))
|
|
|
10044 (abbr (efs-relativize-filename linkname
|
|
|
10045 (file-name-directory target) target))
|
|
|
10046 (tparsed (efs-ftp-path target))
|
|
|
10047 (com-target target)
|
|
|
10048 cmd-string)
|
|
|
10049 (if (null (file-directory-p
|
|
|
10050 (file-name-directory linkname)))
|
|
|
10051 (if cont
|
|
|
10052 (efs-call-cont cont 'failed
|
|
|
10053 (format "no such file or directory, %s" linkname)
|
|
|
10054 "")
|
|
|
10055 (signal 'file-error (list "no such file or directory" linkname)))
|
|
|
10056 (if (or (not ok-if-already-exists)
|
|
|
10057 (numberp ok-if-already-exists))
|
|
|
10058 (efs-barf-or-query-if-file-exists
|
|
|
10059 linkname "make symbolic link" (numberp ok-if-already-exists)))
|
|
|
10060 ;; Do this after above, so that hopefully the host type is sorted out
|
|
|
10061 ;; by now.
|
|
|
10062 (let ((host-type (efs-host-type host)))
|
|
|
10063 (if (or (not (memq host-type efs-unix-host-types))
|
|
|
10064 (memq host-type efs-dumb-host-types)
|
|
|
10065 (efs-get-host-property host 'exec-failed))
|
|
|
10066 (error "Unable to make symbolic links on %s." host)))
|
|
|
10067 ;; Be careful not to spoil relative links, or symlinks to other
|
|
|
10068 ;; machines, which maybe symlink-fix.el can sort out.
|
|
|
10069 (if (and tparsed
|
|
|
10070 (string-equal (downcase (car tparsed)) (downcase host))
|
|
|
10071 (string-equal (nth 1 tparsed) user))
|
|
|
10072 (setq com-target (nth 2 tparsed)))
|
|
|
10073 ;; symlinks only work for unix, so don't need to
|
|
|
10074 ;; convert pathnames. What about VOS?
|
|
|
10075 (setq cmd-string (concat "ln -sf " com-target " " linkpath))
|
|
|
10076 (efs-try-ln
|
|
|
10077 host user
|
|
|
10078 (efs-cont () (host user cmd-string target linkname com-target
|
|
|
10079 abbr cont nowait)
|
|
|
10080 (efs-send-cmd
|
|
|
10081 host user (list 'quote 'site 'exec cmd-string)
|
|
|
10082 (format "Symlinking %s to %s" target abbr)
|
|
|
10083 nil
|
|
|
10084 (efs-cont (result line cont-lines) (host user com-target linkname
|
|
|
10085 cont)
|
|
|
10086 (if result
|
|
|
10087 (progn
|
|
|
10088 (efs-set-host-property host 'exec-failed t)
|
|
|
10089 (efs-error host user (format "exec: %s" line)))
|
|
|
10090 (efs-save-match-data
|
|
|
10091 (if (string-match "\n200-\\([^\n]*\\)" cont-lines)
|
|
|
10092 (let ((err (substring cont-lines (match-beginning 1)
|
|
|
10093 (match-end 1))))
|
|
|
10094 (if cont
|
|
|
10095 (efs-call-cont cont 'failed err cont-lines)
|
|
|
10096 (efs-error host user err)))
|
|
|
10097 (efs-add-file-entry nil linkname com-target nil user)
|
|
|
10098 (if cont (efs-call-cont cont nil line cont-lines))))))
|
|
|
10099 nowait))
|
|
|
10100 nowait))))
|
|
|
10101
|
|
|
10102 (defun efs-make-symbolic-link (target linkname &optional ok-if-already-exists)
|
|
|
10103 ;; efs version of make-symbolic-link
|
|
|
10104 (let* ((linkname (expand-file-name linkname))
|
|
|
10105 (parsed (efs-ftp-path linkname)))
|
|
|
10106 (if parsed
|
|
|
10107 (efs-make-symbolic-link-internal target linkname ok-if-already-exists)
|
|
|
10108 ;; Handler will match on either target or linkname. We are only
|
|
|
10109 ;; interested in the linkname.
|
|
|
10110 (let ((file-name-handler-alist (efs-file-name-handler-alist-sans-fn
|
|
|
10111 'efs-file-handler-function)))
|
|
|
10112 (make-symbolic-link target linkname ok-if-already-exists)))))
|
|
|
10113
|
|
|
10114 (defun efs-add-name-to-file-internal
|
|
|
10115 (file newname &optional ok-if-already-exists cont nowait)
|
|
|
10116 ;; Makes remote symbolic links. Assumes that linkname is already expanded.
|
|
|
10117 (let* ((parsed (efs-ftp-path file))
|
|
|
10118 (host (car parsed))
|
|
|
10119 (user (nth 1 parsed))
|
|
|
10120 (path (nth 2 parsed))
|
|
|
10121 (nparsed (efs-ftp-path newname))
|
|
|
10122 (nhost (car nparsed))
|
|
|
10123 (nuser (nth 1 nparsed))
|
|
|
10124 (npath (nth 2 nparsed))
|
|
|
10125 (abbr (efs-relativize-filename newname
|
|
|
10126 (file-name-directory file)))
|
|
|
10127 (ent (efs-get-file-entry file))
|
|
|
10128 cmd-string)
|
|
|
10129 (or (and (string-equal (downcase host) (downcase nhost))
|
|
|
10130 (string-equal user nuser))
|
|
|
10131 (error "Cannot create hard links between different host user pairs."))
|
|
|
10132 (if (or (null ent) (stringp (car ent))
|
|
|
10133 (not (file-directory-p
|
|
|
10134 (file-name-directory newname))))
|
|
|
10135 (if cont
|
|
|
10136 (efs-call-cont cont 'failed
|
|
|
10137 (format "no such file or directory, %s %s"
|
|
|
10138 file newname) "")
|
|
|
10139 (signal 'file-error
|
|
|
10140 (list "no such file or directory"
|
|
|
10141 file newname)))
|
|
|
10142 (if (or (not ok-if-already-exists)
|
|
|
10143 (numberp ok-if-already-exists))
|
|
|
10144 (efs-barf-or-query-if-file-exists
|
|
|
10145 newname "make hard link" (numberp ok-if-already-exists)))
|
|
|
10146 ;; Do this last, so that hopefully the host type is known.
|
|
|
10147 (let ((host-type (efs-host-type host)))
|
|
|
10148 (if (or (not (memq host-type efs-unix-host-types))
|
|
|
10149 (memq host-type efs-dumb-host-types)
|
|
|
10150 (efs-get-host-property host 'exec-failed))
|
|
|
10151 (error "Unable to make hard links on %s." host)))
|
|
|
10152 (setq cmd-string (concat "ln -f " path " " npath))
|
|
|
10153 (efs-try-ln
|
|
|
10154 host user
|
|
|
10155 (efs-cont () (host user cmd-string file newname abbr cont nowait)
|
|
|
10156 (efs-send-cmd
|
|
|
10157 host user (list 'quote 'site 'exec cmd-string)
|
|
|
10158 (format "Adding to %s name %s" file abbr)
|
|
|
10159 nil
|
|
|
10160 (efs-cont (result line cont-lines) (host user file newname cont)
|
|
|
10161 (if result
|
|
|
10162 (progn
|
|
|
10163 (efs-set-host-property host 'exec-failed t)
|
|
|
10164 (efs-error host user (format "exec: %s" line)))
|
|
|
10165 (efs-save-match-data
|
|
|
10166 (if (string-match "\n200-\\([^\n]*\\)" cont-lines)
|
|
|
10167 (let ((err (substring cont-lines (match-beginning 1)
|
|
|
10168 (match-end 1))))
|
|
|
10169 (if cont
|
|
|
10170 (efs-call-cont cont 'failed err cont-lines)
|
|
|
10171 (efs-error host user err)))
|
|
|
10172 (let ((ent (efs-get-file-entry file)))
|
|
|
10173 (if ent
|
|
|
10174 (let ((nlinks (nthcdr 4 ent))
|
|
|
10175 new-nlinks)
|
|
|
10176 (and (integerp (car nlinks))
|
|
|
10177 (setq new-nlinks (1+ (car nlinks)))
|
|
|
10178 (setcar nlinks new-nlinks))
|
|
|
10179 (apply 'efs-add-file-entry nil newname ent)
|
|
|
10180 (if cont (efs-call-cont cont nil line cont-lines)))
|
|
|
10181 (let ((tbl (efs-get-files-hashtable-entry
|
|
|
10182 (file-name-directory
|
|
|
10183 (directory-file-name newname)))))
|
|
|
10184 (if tbl
|
|
|
10185 (efs-ls
|
|
|
10186 newname
|
|
|
10187 (concat (efs-ls-guess-switches) "d") t t nil
|
|
|
10188 nowait
|
|
|
10189 (efs-cont (listing) (newname cont line cont-lines)
|
|
|
10190 (efs-update-file-info
|
|
|
10191 newname efs-data-buffer-name)
|
|
|
10192 (if cont
|
|
|
10193 (efs-call-cont cont nil line cont-lines))))
|
|
|
10194 (if cont
|
|
|
10195 (efs-call-cont cont nil line cont-lines))))))))))
|
|
|
10196 nowait))
|
|
|
10197 nowait))))
|
|
|
10198
|
|
|
10199 (defun efs-add-name-to-file (file newname &optional ok-if-already-exists)
|
|
|
10200 ;; efs version of add-name-to-file
|
|
|
10201 (efs-add-name-to-file-internal file newname ok-if-already-exists))
|
|
|
10202
|
|
|
10203
|
|
|
10204 ;;;; ==============================================================
|
|
|
10205 ;;;; >9
|
|
|
10206 ;;;; Multiple Host Type Support.
|
|
|
10207 ;;;; The initial host type guessing is done in the PWD code below.
|
|
|
10208 ;;;; If necessary, further guessing is done in the listing parser.
|
|
|
10209 ;;;; ==============================================================
|
|
|
10210
|
|
|
10211
|
|
|
10212 ;;;; --------------------------------------------------------------
|
|
|
10213 ;;;; Functions for setting and retrieving host types.
|
|
|
10214 ;;;; --------------------------------------------------------------
|
|
|
10215
|
|
|
10216 (defun efs-add-host (type host)
|
|
|
10217 "Sets the TYPE of the remote host HOST.
|
|
|
10218 The host type is read with completion so this can be used to obtain a
|
|
|
10219 list of supported host types. HOST must be a string, giving the name of
|
|
|
10220 the host, exactly as given in file names. Setting the host type with
|
|
|
10221 this function is preferable to setting the efs-TYPE-host-regexp, as look up
|
|
|
10222 will be faster. Returns TYPE."
|
|
|
10223 ;; Since internet host names are always case-insensitive, we will cache
|
|
|
10224 ;; them in lower case.
|
|
|
10225 (interactive
|
|
|
10226 (list
|
|
|
10227 (intern
|
|
|
10228 (completing-read "Host type: "
|
|
|
10229 (mapcar
|
|
|
10230 (function (lambda (elt)
|
|
|
10231 (list (symbol-name (car elt)))))
|
|
|
10232 efs-host-type-alist)
|
|
|
10233 nil t))
|
|
|
10234 (read-string "Host: "
|
|
|
10235 (let ((name (or (buffer-file-name)
|
|
|
10236 (and (eq major-mode 'dired-mode)
|
|
|
10237 dired-directory))))
|
|
|
10238 (and name (car (efs-ftp-path name)))))))
|
|
|
10239 (setq host (downcase host))
|
|
|
10240 (efs-set-host-property host 'host-type type)
|
|
|
10241 (prog1
|
|
|
10242 (setq efs-host-cache host
|
|
|
10243 efs-host-type-cache type)
|
|
|
10244 (efs-set-process-host-type host)))
|
|
|
10245
|
|
|
10246 (defun efs-set-process-host-type (host &optional user)
|
|
|
10247 ;; Sets the value of efs-process-host-type so that it is shown
|
|
|
10248 ;; on the mode-line.
|
|
|
10249 (let ((buff-list (buffer-list)))
|
|
|
10250 (save-excursion
|
|
|
10251 (while buff-list
|
|
|
10252 (set-buffer (car buff-list))
|
|
|
10253 (if (equal efs-process-host host)
|
|
|
10254 (setq efs-process-host-type (concat " " (symbol-name
|
|
|
10255 (efs-host-type host))))
|
|
|
10256 (and efs-show-host-type-in-dired
|
|
|
10257 (eq major-mode 'dired-mode)
|
|
|
10258 efs-dired-host-type
|
|
|
10259 (string-equal (downcase
|
|
|
10260 (car (efs-ftp-path default-directory)))
|
|
|
10261 (downcase host))
|
|
|
10262 (if user
|
|
|
10263 (setq efs-dired-listing-type-string
|
|
|
10264 (concat
|
|
|
10265 " "
|
|
|
10266 (symbol-name (efs-listing-type host user))))
|
|
|
10267 (or efs-dired-listing-type-string
|
|
|
10268 (setq efs-dired-listing-type-string
|
|
|
10269 (concat " " (symbol-name (efs-host-type host))))))))
|
|
|
10270 (setq buff-list (cdr buff-list))))))
|
|
|
10271
|
|
|
10272 ;;;; ----------------------------------------------------------------
|
|
|
10273 ;;;; Functions for setting and retrieving listings types.
|
|
|
10274 ;;;; ----------------------------------------------------------------
|
|
|
10275
|
|
|
10276 ;;; listing types??
|
|
|
10277 ;;; These are distinguished from host types, in case some OS's have two
|
|
|
10278 ;;; breeds of listings. e.g. Unix descriptive listings.
|
|
|
10279 ;;; We also use this to support the myriad of DOS ftp servers.
|
|
|
10280
|
|
|
10281
|
|
|
10282 (defun efs-listing-type (host user)
|
|
|
10283 "Returns the type of listing used on HOST by USER.
|
|
|
10284 If there is no entry for a specialized listing, returns the host type."
|
|
|
10285 (or
|
|
|
10286 (efs-get-host-user-property host user 'listing-type)
|
|
|
10287 (efs-host-type host user)))
|
|
|
10288
|
|
|
10289 (defun efs-add-listing-type (type host user)
|
|
|
10290 "Interactively adds the specialized listing type TYPE for HOST and USER
|
|
|
10291 to the listing type cache."
|
|
|
10292 (interactive
|
|
|
10293 (let ((name (or (buffer-file-name)
|
|
|
10294 (and (eq major-mode 'dired-mode)
|
|
|
10295 dired-directory))))
|
|
|
10296 (list
|
|
|
10297 (intern
|
|
|
10298 (completing-read "Listing type: "
|
|
|
10299 (mapcar
|
|
|
10300 (function (lambda (elt)
|
|
|
10301 (list (symbol-name elt))))
|
|
|
10302 efs-listing-types)
|
|
|
10303 nil t))
|
|
|
10304 (read-string "Host: "
|
|
|
10305 (and name (car (efs-ftp-path name))))
|
|
|
10306 (read-string "User: "
|
|
|
10307 (and name (nth 1 (efs-ftp-path name)))))))
|
|
|
10308 (efs-set-host-user-property host user 'listing-type type)
|
|
|
10309 (efs-set-process-host-type host user))
|
|
|
10310
|
|
|
10311 ;;;; --------------------------------------------------------------
|
|
|
10312 ;;;; Auotomagic bug reporting for unrecognized host types.
|
|
|
10313 ;;;; --------------------------------------------------------------
|
|
|
10314
|
|
|
10315 (defun efs-scream-and-yell-1 (host user)
|
|
|
10316 ;; Internal for efs-scream-and-yell.
|
|
|
10317 (with-output-to-temp-buffer "*Help*"
|
|
|
10318 (princ
|
|
|
10319 (format
|
|
|
10320 "efs is unable to identify the remote host type of %s.
|
|
|
10321
|
|
|
10322 Please report this as a bug. It would be very helpful
|
|
|
10323 if your bug report contained at least the PWD command
|
|
|
10324 within the *ftp %s@%s* buffer.
|
|
|
10325 If you know them, also send the operating system
|
|
|
10326 and ftp server types of the remote host." host user host)))
|
|
|
10327 (if (y-or-n-p "Would you like to submit a bug report now? ")
|
|
|
10328 (efs-report-bug host user
|
|
|
10329 "Bug occurred during efs-guess-host-type." t)))
|
|
|
10330
|
|
|
10331 (defun efs-scream-and-yell (host user)
|
|
|
10332 ;; Advertises that something has gone wrong in identifying the host type.
|
|
|
10333 (if (eq (selected-window) (minibuffer-window))
|
|
|
10334 (efs-abort-recursive-edit-and-then 'efs-scream-and-yell-1 host user)
|
|
|
10335 (efs-scream-and-yell-1 host user)
|
|
|
10336 (error "Unable to identify remote host type")))
|
|
|
10337
|
|
|
10338 ;;;; --------------------------------------------------------
|
|
|
10339 ;;;; Guess at the host type using PWD syntax.
|
|
|
10340 ;;;; --------------------------------------------------------
|
|
|
10341
|
|
|
10342 ;; host-type path templates. These should match a pwd performed
|
|
|
10343 ;; as the first command after connecting. They should be as tight
|
|
|
10344 ;; as possible
|
|
|
10345
|
|
|
10346 (defconst efs-unix-path-template "^/")
|
|
|
10347 (defconst efs-apollo-unix-path-template "^//")
|
|
|
10348 (defconst efs-cms-path-template
|
|
|
10349 (concat
|
|
|
10350 "^[-A-Z0-9$*][-A-Z0-9$*]?[-A-Z0-9$*]?[-A-Z0-9$*]?[-A-Z0-9$*]?"
|
|
|
10351 "[-A-Z0-9$*]?[-A-Z0-9$*]?[-A-Z0-9$*]?\\.[0-9][0-9][0-9A-Z]$\\|"
|
|
|
10352 ;; For the SFS version of CMS
|
|
|
10353 "^[-A-Z0-9]+:[-A-Z0-9$*]+\\.$"))
|
|
|
10354
|
|
|
10355 (defconst efs-mvs-path-template "^'?[A-Z][0-9][0-9]?[0-9]?[0-9]?[0-9]?\\.'?")
|
|
|
10356
|
|
|
10357 (defconst efs-guardian-path-template
|
|
|
10358 (concat
|
|
|
10359 "^\\("
|
|
|
10360 "\\\\[A-Z0-9][A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?\\."
|
|
|
10361 "\\)?"
|
|
|
10362 "\\$[A-Z0-9][A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?\\."
|
|
|
10363 "[A-Z][A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?$"))
|
|
|
10364 ;; guardian and cms are very close to overlapping (they don't). Be careful.
|
|
|
10365 (defconst efs-vms-path-template
|
|
|
10366 "^[-A-Z0-9_$]+:\\[[-A-Z0-9_$]+\\(\\.[-A-Z0-9_$]+\\)*\\]$")
|
|
|
10367 (defconst efs-mts-path-template
|
|
|
10368 "^[A-Z0-9._][A-Z0-9._][A-Z0-9._][A-Z0-9._]:$")
|
|
|
10369 (defconst efs-ms-unix-path-template "^[A-Za-z0-9]:/")
|
|
|
10370
|
|
|
10371 ;; Following two are for TI lisp machines. Note that lisp machines
|
|
|
10372 ;; do not have a default directory, but only a default pathname against
|
|
|
10373 ;; which relative pathnames are merged (Jamie tells me).
|
|
|
10374 (defconst efs-ti-explorer-pwd-line-template
|
|
|
10375 (let* ((excluded-chars ":;<>.#\n\r\t\\/a-z ")
|
|
|
10376 (token (concat "[^" excluded-chars "]+")))
|
|
|
10377 (concat "^250 "
|
|
|
10378 token ": " ; host name
|
|
|
10379 token "\\(\\." token "\\)*; " ; directory
|
|
|
10380 "\\(\\*.\\*\\|\\*\\)#\\(\\*\\|>\\)" ; name, ext, version
|
|
|
10381 "$"))) ; "*.*#*" or "*.*#>" or "*#*" or "*#>" or "#*" ...
|
|
|
10382 (defconst efs-ti-twenex-path-template
|
|
|
10383 (let* ((excluded-chars ":;<>.#\n\r\t\\/a-z ")
|
|
|
10384 (token (concat "[^" excluded-chars "]+")))
|
|
|
10385 (concat "^"
|
|
|
10386 token ":" ; host name
|
|
|
10387 "<\\(" token "\\)?\\(\\." token "\\)*>" ; directory
|
|
|
10388 "\\(\\*.\\*\\|\\*\\)" ; name and extension
|
|
|
10389 "$")))
|
|
|
10390
|
|
|
10391 (defconst efs-tops-20-path-template
|
|
|
10392 "^[-A-Z0-9_$]+:<[-A-Z0-9_$]\\(.[-A-Z0-9_$]+\\)*>$")
|
|
|
10393 (defconst efs-pc-path-template
|
|
|
10394 "^[a-zA-Z0-9]:\\\\\\([-_+=a-zA-Z0-9.]+\\\\\\)*[-_+=a-zA-Z0-9.]*$")
|
|
|
10395 (defconst efs-mpe-path-template
|
|
|
10396 (let ((token (concat "[A-Z][A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?"
|
|
|
10397 "[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?")))
|
|
|
10398 (concat
|
|
|
10399 ;; optional session name
|
|
|
10400 "^\\(" token "\\)?,"
|
|
|
10401 ;; username
|
|
|
10402 token "."
|
|
|
10403 ;; account
|
|
|
10404 token ","
|
|
|
10405 ;; group
|
|
|
10406 token "$")))
|
|
|
10407 (defconst efs-vos-path-template
|
|
|
10408 (let ((token "[][@\\^`{}|~\"$+,---./:_a-zA-Z0-9]+"))
|
|
|
10409 (concat
|
|
|
10410 "%" token ; host
|
|
|
10411 "#" token ; disk
|
|
|
10412 "\\(>" token "\\)+" ; directories
|
|
|
10413 )))
|
|
|
10414 (defconst efs-netware-path-template "^[-A-Z0-9_][-A-Z0-9_/]*:/")
|
|
|
10415 ;; Sometimes netware doesn't return a device to a PWD. Then it will be
|
|
|
10416 ;; recognized by the listing parser.
|
|
|
10417
|
|
|
10418 (defconst efs-nos-ve-path-template "^:[A-Z0-9]")
|
|
|
10419 ;; Matches the path for NOS/VE
|
|
|
10420
|
|
|
10421 (defconst efs-mvs-pwd-line-template
|
|
|
10422 ;; Not sure how the PWD parser will do with empty strings, so treate
|
|
|
10423 ;; this as a line regexp.
|
|
|
10424 "^257 \\([Nn]o prefix defined\\|\"\" is working directory\\)")
|
|
|
10425 (defconst efs-cms-pwd-line-template
|
|
|
10426 "^450 No current working directory defined$")
|
|
|
10427 (defconst efs-tops-20-pwd-line-template
|
|
|
10428 "^500 I never heard of the \\(XPWD\\|PWD\\) command\\. Try HELP\\.$")
|
|
|
10429 (defconst efs-dos:ftp-pwd-line-template
|
|
|
10430 "^250 Current working directory is +")
|
|
|
10431 (defconst efs-coke-pwd-line-template "^257 Current balance \\$[0-9]")
|
|
|
10432
|
|
|
10433 (defconst efs-super-dumb-unix-tilde-regexp
|
|
|
10434 "^550 /.*: No such file or directory\\.?$")
|
|
|
10435 (defconst efs-cms-knet-tilde-regexp
|
|
|
10436 "^501 Invalid CMS fileid: ~$")
|
|
|
10437
|
|
|
10438
|
|
|
10439 ;; It might be nice to message users about the host type identified,
|
|
|
10440 ;; but there is so much other messaging going on, it would not be
|
|
|
10441 ;; seen. No point in slowing things down just so users can read
|
|
|
10442 ;; a host type message.
|
|
|
10443
|
|
|
10444 (defun efs-guess-host-type (host user)
|
|
|
10445 "Guess the host type of HOST.
|
|
|
10446 Does a PWD and examines the directory syntax. The PWD is then cached for use
|
|
|
10447 in file name expansion."
|
|
|
10448 (let ((host-type (efs-host-type host))
|
|
|
10449 (key (concat host "/" user "/~"))
|
|
|
10450 syst)
|
|
|
10451 (efs-save-match-data
|
|
|
10452 (if (eq host-type 'unknown)
|
|
|
10453 ;; Note that efs-host-type returns unknown as the default.
|
|
|
10454 ;; Since we don't yet know the host-type, we use the default
|
|
|
10455 ;; version of efs-send-pwd. We compensate if necessary
|
|
|
10456 ;; by looking at the entire line of output.
|
|
|
10457 (let* ((result (efs-send-pwd nil host user))
|
|
|
10458 (dir (car result))
|
|
|
10459 (line (cdr result)))
|
|
|
10460 (cond
|
|
|
10461
|
|
|
10462 ;; First sift through process lines to see if we recognize
|
|
|
10463 ;; any pwd errors, or full line messages.
|
|
|
10464
|
|
|
10465 ;; CMS
|
|
|
10466 ((string-match efs-cms-pwd-line-template line)
|
|
|
10467 (setq host-type (efs-add-host 'cms host)
|
|
|
10468 dir (concat "/" (if (> (length user) 8)
|
|
|
10469 (substring user 0 8)
|
|
|
10470 user)
|
|
|
10471 ".191"))
|
|
|
10472 (message
|
|
|
10473 "Unable to determine a \"home\" CMS minidisk. Assuming %s"
|
|
|
10474 dir)
|
|
|
10475 (sit-for 1))
|
|
|
10476
|
|
|
10477 ;; TOPS-20
|
|
|
10478 ((string-match efs-tops-20-pwd-line-template line)
|
|
|
10479 (setq host-type (efs-add-host 'tops-20 host)
|
|
|
10480 dir (car (efs-send-pwd 'tops-20 host user))))
|
|
|
10481
|
|
|
10482 ;; TI-EXPLORER lisp machine. pwd works here, but the output
|
|
|
10483 ;; needs to be specially parsed since spaces separate
|
|
|
10484 ;; hostnames from dirs from filenames.
|
|
|
10485 ((string-match efs-ti-explorer-pwd-line-template line)
|
|
|
10486 (setq host-type (efs-add-host 'ti-explorer host)
|
|
|
10487 dir (substring line 4)))
|
|
|
10488
|
|
|
10489 ;; FTP Software's DOS Server
|
|
|
10490 ((string-match efs-dos:ftp-pwd-line-template line)
|
|
|
10491 (setq host-type (efs-add-host 'dos host)
|
|
|
10492 dir (substring line (match-end 0)))
|
|
|
10493 (efs-add-listing-type 'dos:ftp host user))
|
|
|
10494
|
|
|
10495 ;; MVS
|
|
|
10496 ((string-match efs-mvs-pwd-line-template line)
|
|
|
10497 (setq host-type (efs-add-host 'mvs host)
|
|
|
10498 dir "")) ; "" will convert to /, which is always
|
|
|
10499 ; the mvs home dir.
|
|
|
10500
|
|
|
10501 ;; COKE
|
|
|
10502 ((string-match efs-coke-pwd-line-template line)
|
|
|
10503 (setq host-type (efs-add-host 'coke host)
|
|
|
10504 dir "/"))
|
|
|
10505
|
|
|
10506 ;; Try to get tilde.
|
|
|
10507 ((null dir)
|
|
|
10508 (let ((tilde (nth 1 (efs-send-cmd
|
|
|
10509 host user (list 'get "~" "/dev/null")))))
|
|
|
10510 (cond
|
|
|
10511 ;; super dumb unix
|
|
|
10512 ((string-match efs-super-dumb-unix-tilde-regexp tilde)
|
|
|
10513 (setq dir (car (efs-send-pwd 'super-dumb-unix host user))
|
|
|
10514 host-type (efs-add-host 'super-dumb-unix host)))
|
|
|
10515
|
|
|
10516 ;; Try for cms-knet
|
|
|
10517 ((string-match efs-cms-knet-tilde-regexp tilde)
|
|
|
10518 (setq dir (car (efs-send-pwd 'cms-knet host user))
|
|
|
10519 host-type (efs-add-host 'cms-knet host)))
|
|
|
10520
|
|
|
10521 ;; We don't know. Scream and yell.
|
|
|
10522 (efs-scream-and-yell host user))))
|
|
|
10523
|
|
|
10524 ;; Now look at dir to determine host type
|
|
|
10525
|
|
|
10526 ;; try for UN*X-y type stuff
|
|
|
10527 ((string-match efs-unix-path-template dir)
|
|
|
10528 (if
|
|
|
10529 ;; Check for apollo, so we know not to short-circuit //.
|
|
|
10530 (string-match efs-apollo-unix-path-template dir)
|
|
|
10531 (progn
|
|
|
10532 (setq host-type (efs-add-host 'apollo-unix host))
|
|
|
10533 (efs-add-listing-type 'unix:unknown host user))
|
|
|
10534 ;; could be ka9q, dos-distinct, plus any of the unix breeds,
|
|
|
10535 ;; except apollo.
|
|
|
10536 (if (setq syst (efs-get-syst host user))
|
|
|
10537 (let ((case-fold-search t))
|
|
|
10538 (cond
|
|
|
10539 ((string-match "\\bNetware\\b" syst)
|
|
|
10540 (setq host-type (efs-add-host 'netware host)))
|
|
|
10541 ((string-match "^Plan 9" syst)
|
|
|
10542 (setq host-type (efs-add-host 'plan9 host)))
|
|
|
10543 ((string-match "^UNIX" syst)
|
|
|
10544 (setq host-type (efs-add-host 'unix host))
|
|
|
10545 (efs-add-listing-type 'unix:unknown host user)))))))
|
|
|
10546
|
|
|
10547 ;; try for VMS
|
|
|
10548 ((string-match efs-vms-path-template dir)
|
|
|
10549 (setq host-type (efs-add-host 'vms host)))
|
|
|
10550
|
|
|
10551 ;; try for MTS
|
|
|
10552 ((string-match efs-mts-path-template dir)
|
|
|
10553 (setq host-type (efs-add-host 'mts host)))
|
|
|
10554
|
|
|
10555 ;; try for CMS
|
|
|
10556 ((string-match efs-cms-path-template dir)
|
|
|
10557 (setq host-type (efs-add-host 'cms host)))
|
|
|
10558
|
|
|
10559 ;; try for Tandem's guardian OS
|
|
|
10560 ((string-match efs-guardian-path-template dir)
|
|
|
10561 (setq host-type (efs-add-host 'guardian host)))
|
|
|
10562
|
|
|
10563 ;; Try for TOPS-20. pwd doesn't usually work for tops-20
|
|
|
10564 ;; But who knows???
|
|
|
10565 ((string-match efs-tops-20-path-template dir)
|
|
|
10566 (setq host-type (efs-add-host 'tops-20 host)))
|
|
|
10567
|
|
|
10568 ;; Try for DOS or OS/2.
|
|
|
10569 ((string-match efs-pc-path-template dir)
|
|
|
10570 (let ((syst (efs-get-syst host user))
|
|
|
10571 (case-fold-search t))
|
|
|
10572 (if (and syst (string-match "^OS/2 " syst))
|
|
|
10573 (setq host-type (efs-add-host 'os2 host))
|
|
|
10574 (setq host-type (efs-add-host 'dos host)))))
|
|
|
10575
|
|
|
10576 ;; try for TI-TWENEX lisp machine
|
|
|
10577 ((string-match efs-ti-twenex-path-template dir)
|
|
|
10578 (setq host-type (efs-add-host 'ti-twenex host)))
|
|
|
10579
|
|
|
10580 ;; try for MPE
|
|
|
10581 ((string-match efs-mpe-path-template dir)
|
|
|
10582 (setq host-type (efs-add-host 'mpe host)))
|
|
|
10583
|
|
|
10584 ;; try for VOS
|
|
|
10585 ((string-match efs-vos-path-template dir)
|
|
|
10586 (setq host-type (efs-add-host 'vos host)))
|
|
|
10587
|
|
|
10588 ;; try for the microsoft server in unix mode
|
|
|
10589 ((string-match efs-ms-unix-path-template dir)
|
|
|
10590 (setq host-type (efs-add-host 'ms-unix host)))
|
|
|
10591
|
|
|
10592 ;; Netware?
|
|
|
10593 ((string-match efs-netware-path-template dir)
|
|
|
10594 (setq host-type (efs-add-host 'netware host)))
|
|
|
10595
|
|
|
10596 ;; Try for MVS
|
|
|
10597 ((string-match efs-mvs-path-template dir)
|
|
|
10598 (if (string-match "^'.+'$" dir)
|
|
|
10599 ;; broken MVS PWD quoting
|
|
|
10600 (setq dir (substring dir 1 -1)))
|
|
|
10601 (setq host-type (efs-add-host 'mvs host)))
|
|
|
10602
|
|
|
10603 ;; Try for NOS/VE
|
|
|
10604 ((string-match efs-nos-ve-path-template dir)
|
|
|
10605 (setq host-type (efs-add-host 'nos-ve host)))
|
|
|
10606
|
|
|
10607 ;; We don't know. Scream and yell.
|
|
|
10608 (t
|
|
|
10609 (efs-scream-and-yell host user)))
|
|
|
10610
|
|
|
10611 ;; Now that we have done a pwd, might as well put it in
|
|
|
10612 ;; the expand-dir hashtable.
|
|
|
10613 (if dir
|
|
|
10614 (efs-put-hash-entry
|
|
|
10615 key
|
|
|
10616 (efs-internal-directory-file-name
|
|
|
10617 (efs-fix-path host-type dir 'reverse))
|
|
|
10618 efs-expand-dir-hashtable
|
|
|
10619 (memq host-type efs-case-insensitive-host-types))))
|
|
|
10620
|
|
|
10621 ;; host-type has been identified by regexp, set the mode-line.
|
|
|
10622 (efs-set-process-host-type host user)
|
|
|
10623
|
|
|
10624 ;; Some special cases, where we need to store the cwd on login.
|
|
|
10625 (if (not (efs-hash-entry-exists-p
|
|
|
10626 key efs-expand-dir-hashtable))
|
|
|
10627 (cond
|
|
|
10628 ;; CMS: We will be doing cd's, so we'd better make sure that
|
|
|
10629 ;; we know where home is.
|
|
|
10630 ((eq host-type 'cms)
|
|
|
10631 (let* ((res (efs-send-pwd 'cms host user))
|
|
|
10632 (dir (car res))
|
|
|
10633 (line (cdr res)))
|
|
|
10634 (if (and dir (not (string-match
|
|
|
10635 efs-cms-pwd-line-template line)))
|
|
|
10636 (setq dir (concat "/" dir))
|
|
|
10637 (setq dir (concat "/" (if (> (length user) 8)
|
|
|
10638 (substring user 0 8)
|
|
|
10639 user)
|
|
|
10640 ".191"))
|
|
|
10641 (message
|
|
|
10642 "Unable to determine a \"home\" CMS minidisk. Assuming %s"
|
|
|
10643 dir))
|
|
|
10644 (efs-put-hash-entry
|
|
|
10645 key dir efs-expand-dir-hashtable
|
|
|
10646 (memq 'cms efs-case-insensitive-host-types))))
|
|
|
10647 ;; MVS: pwd doesn't work in the root directory, so we stuff this
|
|
|
10648 ;; into the hashtable manually.
|
|
|
10649 ((eq host-type 'mvs)
|
|
|
10650 (efs-put-hash-entry key "/" efs-expand-dir-hashtable))
|
|
|
10651 ))))))
|
|
|
10652
|
|
|
10653
|
|
|
10654 ;;;; -----------------------------------------------------------
|
|
|
10655 ;;;; efs-autoloads
|
|
|
10656 ;;;; These provide the entry points for the non-unix packages.
|
|
|
10657 ;;;; -----------------------------------------------------------
|
|
|
10658
|
|
|
10659 (efs-autoload 'efs-fix-path vms "efs-vms")
|
|
|
10660 (efs-autoload 'efs-fix-path mts "efs-mts")
|
|
|
10661 (efs-autoload 'efs-fix-path cms "efs-cms")
|
|
|
10662 (efs-autoload 'efs-fix-path ti-explorer "efs-ti-explorer")
|
|
|
10663 (efs-autoload 'efs-fix-path ti-twenex "efs-ti-twenex")
|
|
|
10664 (efs-autoload 'efs-fix-path dos "efs-pc")
|
|
|
10665 (efs-autoload 'efs-fix-path mvs "efs-mvs")
|
|
|
10666 (efs-autoload 'efs-fix-path tops-20 "efs-tops-20")
|
|
|
10667 (efs-autoload 'efs-fix-path mpe "efs-mpe")
|
|
|
10668 (efs-autoload 'efs-fix-path os2 "efs-pc")
|
|
|
10669 (efs-autoload 'efs-fix-path vos "efs-vos")
|
|
|
10670 (efs-autoload 'efs-fix-path ms-unix "efs-ms-unix")
|
|
|
10671 (efs-autoload 'efs-fix-path netware "efs-netware")
|
|
|
10672 (efs-autoload 'efs-fix-path cms-knet "efs-cms-knet")
|
|
|
10673 (efs-autoload 'efs-fix-path guardian "efs-guardian")
|
|
|
10674 (efs-autoload 'efs-fix-path nos-ve "efs-nos-ve")
|
|
|
10675
|
|
|
10676 (efs-autoload 'efs-fix-dir-path vms "efs-vms")
|
|
|
10677 (efs-autoload 'efs-fix-dir-path mts "efs-mts")
|
|
|
10678 (efs-autoload 'efs-fix-dir-path cms "efs-cms")
|
|
|
10679 (efs-autoload 'efs-fix-dir-path ti-explorer "efs-ti-explorer")
|
|
|
10680 (efs-autoload 'efs-fix-dir-path ti-twenex "efs-ti-twenex")
|
|
|
10681 (efs-autoload 'efs-fix-dir-path dos "efs-pc")
|
|
|
10682 (efs-autoload 'efs-fix-dir-path mvs "efs-mvs")
|
|
|
10683 (efs-autoload 'efs-fix-dir-path tops-20 "efs-tops-20")
|
|
|
10684 (efs-autoload 'efs-fix-dir-path mpe "efs-mpe")
|
|
|
10685 (efs-autoload 'efs-fix-dir-path os2 "efs-pc")
|
|
|
10686 (efs-autoload 'efs-fix-dir-path vos "efs-vos")
|
|
|
10687 (efs-autoload 'efs-fix-dir-path hell "efs-hell")
|
|
|
10688 (efs-autoload 'efs-fix-dir-path ms-unix "efs-ms-unix")
|
|
|
10689 (efs-autoload 'efs-fix-dir-path netware "efs-netware")
|
|
|
10690 (efs-autoload 'efs-fix-dir-path plan9 "efs-plan9")
|
|
|
10691 (efs-autoload 'efs-fix-dir-path cms-knet "efs-cms-knet")
|
|
|
10692 (efs-autoload 'efs-fix-dir-path guardian "efs-guardian")
|
|
|
10693 (efs-autoload 'efs-fix-dir-path nos-ve "efs-nos-ve")
|
|
|
10694 (efs-autoload 'efs-fix-dir-path coke "efs-coke")
|
|
|
10695
|
|
|
10696 ;; A few need to autoload a pwd function
|
|
|
10697 (efs-autoload 'efs-send-pwd tops-20 "efs-tops-20")
|
|
|
10698 (efs-autoload 'efs-send-pwd cms-knet "efs-cms-knet")
|
|
|
10699 (efs-autoload 'efs-send-pwd ti-explorer "efs-ti-explorer")
|
|
|
10700 (efs-autoload 'efs-send-pwd hell "efs-hell")
|
|
|
10701 (efs-autoload 'efs-send-pwd mvs "efs-mvs")
|
|
|
10702 (efs-autoload 'efs-send-pwd coke "efs-coke")
|
|
|
10703
|
|
|
10704 ;; A few packages are loaded by the listing parser.
|
|
|
10705 (efs-autoload 'efs-parse-listing ka9q "efs-ka9q")
|
|
|
10706 (efs-autoload 'efs-parse-listing unix:dl "efs-dl")
|
|
|
10707 (efs-autoload 'efs-parse-listing dos-distinct "efs-dos-distinct")
|
|
|
10708 (efs-autoload 'efs-parse-listing hell "efs-hell")
|
|
|
10709 (efs-autoload 'efs-parse-listing netware "efs-netware")
|
|
|
10710
|
|
|
10711 ;; Packages that need to autoload for child-lookup
|
|
|
10712 (efs-autoload 'efs-allow-child-lookup plan9 "efs-plan9")
|
|
|
10713 (efs-autoload 'efs-allow-child-lookup coke "efs-coke")
|
|
|
10714
|
|
|
10715 ;; Packages that need to autoload for file-exists-p and file-directory-p
|
|
|
10716 (efs-autoload 'efs-internal-file-exists-p guardian "efs-guardian")
|
|
|
10717 (efs-autoload 'efs-internal-file-directory-p guardian "efs-guardian")
|
|
|
10718
|
|
|
10719
|
|
|
10720
|
|
|
10721 ;;;; ============================================================
|
|
|
10722 ;;;; >10
|
|
|
10723 ;;;; Attaching onto the appropriate Emacs version
|
|
|
10724 ;;;; ============================================================
|
|
|
10725
|
|
|
10726 ;;;; -------------------------------------------------------------------
|
|
|
10727 ;;;; Connect to various hooks.
|
|
|
10728 ;;;; -------------------------------------------------------------------
|
|
|
10729
|
|
|
10730 (or (memq 'efs-set-buffer-mode find-file-hooks)
|
|
|
10731 (setq find-file-hooks
|
|
|
10732 (cons 'efs-set-buffer-mode find-file-hooks)))
|
|
|
10733
|
|
|
10734 ;;; We are using our own dired.el, so this doesn't depend on Emacs flavour.
|
|
|
10735
|
|
|
10736 (if (featurep 'dired)
|
|
|
10737 (require 'efs-dired)
|
|
|
10738 (add-hook 'dired-load-hook (function
|
|
|
10739 (lambda ()
|
|
|
10740 (require 'efs-dired)))))
|
|
|
10741
|
|
|
10742 ;;;; ------------------------------------------------------------
|
|
|
10743 ;;;; Add to minor-mode-alist.
|
|
|
10744 ;;;; ------------------------------------------------------------
|
|
|
10745
|
|
|
10746 (or (assq 'efs-process-host-type minor-mode-alist)
|
|
|
10747 (if (assq 'dired-sort-mode minor-mode-alist)
|
|
|
10748 (let ((our-list
|
|
|
10749 (nconc
|
|
|
10750 (delq nil
|
|
|
10751 (list (assq 'dired-sort-mode minor-mode-alist)
|
|
|
10752 (assq 'dired-subdir-omit minor-mode-alist)
|
|
|
10753 (assq 'dired-marker-stack minor-mode-alist)))
|
|
|
10754 (list '(efs-process-host-type efs-process-host-type)
|
|
|
10755 '(efs-dired-listing-type
|
|
|
10756 efs-dired-listing-type-string))))
|
|
|
10757 (old-list (delq
|
|
|
10758 (assq 'efs-process-host-type minor-mode-alist)
|
|
|
10759 (delq
|
|
|
10760 (assq 'efs-dired-listing-type minor-mode-alist)
|
|
|
10761 minor-mode-alist))))
|
|
|
10762 (setq minor-mode-alist nil)
|
|
|
10763 (while old-list
|
|
|
10764 (or (assq (car (car old-list)) our-list)
|
|
|
10765 (setq minor-mode-alist (nconc minor-mode-alist
|
|
|
10766 (list (car old-list)))))
|
|
|
10767 (setq old-list (cdr old-list)))
|
|
|
10768 (setq minor-mode-alist (nconc our-list minor-mode-alist)))
|
|
|
10769 (setq minor-mode-alist
|
|
|
10770 (nconc
|
|
|
10771 (list '(efs-process-host-type efs-process-host-type)
|
|
|
10772 '(efs-dired-listing-type efs-dired-listing-type-string))
|
|
|
10773 minor-mode-alist))))
|
|
|
10774
|
|
|
10775 ;;;; ------------------------------------------------------------
|
|
|
10776 ;;;; File name handlers
|
|
|
10777 ;;;; ------------------------------------------------------------
|
|
|
10778
|
|
114
|
10779 ;;;###autoload
|
|
98
|
10780 (defun efs-file-handler-function (operation &rest args)
|
|
|
10781 "Function to call special file handlers for remote files."
|
|
116
|
10782 (let ((handler (and (if (boundp 'allow-remote-paths)
|
|
|
10783 allow-remote-paths
|
|
|
10784 t)
|
|
|
10785 (get operation 'efs))))
|
|
98
|
10786 (if handler
|
|
|
10787 (apply handler args)
|
|
|
10788 (let ((inhibit-file-name-handlers
|
|
|
10789 (cons 'efs-file-handler-function
|
|
|
10790 (and (eq inhibit-file-name-operation operation)
|
|
|
10791 inhibit-file-name-handlers)))
|
|
|
10792 (inhibit-file-name-operation operation))
|
|
|
10793 (apply operation args)))))
|
|
|
10794
|
|
|
10795 (defun efs-sifn-handler-function (operation &rest args)
|
|
|
10796 ;; Handler function for substitute-in-file-name
|
|
116
|
10797 (if (and (if (boundp 'allow-remote-paths)
|
|
|
10798 allow-remote-paths
|
|
|
10799 t)
|
|
|
10800 (eq operation 'substitute-in-file-name))
|
|
98
|
10801 (apply 'efs-substitute-in-file-name args)
|
|
|
10802 (let ((inhibit-file-name-handlers
|
|
|
10803 (cons 'efs-sifn-handler-function
|
|
|
10804 (and (eq operation inhibit-file-name-operation)
|
|
|
10805 inhibit-file-name-handlers)))
|
|
|
10806 (inhibit-file-name-operation operation))
|
|
|
10807 (apply operation args))))
|
|
|
10808
|
|
|
10809 ;; Yes, this is what it looks like. I'm defining the handler to run our
|
|
|
10810 ;; version whenever there is an environment variable.
|
|
|
10811
|
|
118
|
10812 (defvar efs-path-sifn-regexp "\\(^\\|[^$]\\)\\(\\$\\$\\)*\\$[{a-zA-Z0-9]"
|
|
|
10813 "Regexp to match environment variables in file names.")
|
|
|
10814
|
|
|
10815 (or (assoc efs-path-sifn-regexp file-name-handler-alist)
|
|
|
10816 (nconc file-name-handler-alist
|
|
|
10817 (list
|
|
|
10818 (cons efs-path-sifn-regexp
|
|
|
10819 'efs-sifn-handler-function))))
|
|
98
|
10820
|
|
|
10821 ;;;; ------------------------------------------------------------
|
|
|
10822 ;;;; Necessary overloads.
|
|
|
10823 ;;;; ------------------------------------------------------------
|
|
|
10824
|
|
|
10825 ;;; The following functions are overloaded, instead of extended via
|
|
|
10826 ;;; the file-name-handler-alist. For various reasons, the
|
|
|
10827 ;;; file-name-handler-alist doesn't work for them. It would be nice if
|
|
|
10828 ;;; this list could be shortened in the future.
|
|
|
10829
|
|
|
10830 ;; File name exansion. It is not until _after_ a file name has been
|
|
|
10831 ;; expanded that it is reasonable to test it for a file name handler.
|
|
|
10832 (efs-overwrite-fn "efs" 'expand-file-name)
|
|
|
10833
|
|
|
10834 ;; Loading lisp files. The problem with using the file-name-handler-alist
|
|
|
10835 ;; here is that we don't know what is to be handled, until after searching
|
|
|
10836 ;; the load-path. The solution is to change the C code for Fload.
|
|
|
10837 ;; A patch to do this has been written by Jay Adams <jka@ece.cmu.edu>.
|
|
|
10838 (efs-overwrite-fn "efs" 'load)
|
|
|
10839 (efs-overwrite-fn "efs" 'require)
|
|
|
10840
|
|
|
10841 ;;;; ------------------------------------------------------------
|
|
|
10842 ;;;; Install the file handlers for efs-file-handler-function.
|
|
|
10843 ;;;; ------------------------------------------------------------
|
|
|
10844
|
|
|
10845 ;; I/O
|
|
|
10846 (put 'insert-file-contents 'efs 'efs-insert-file-contents)
|
|
|
10847 (put 'write-region 'efs 'efs-write-region)
|
|
|
10848 (put 'directory-files 'efs 'efs-directory-files)
|
|
|
10849 (put 'list-directory 'efs 'efs-list-directory)
|
|
|
10850 (put 'insert-directory 'efs 'efs-insert-directory)
|
|
|
10851 (put 'recover-file 'efs 'efs-recover-file)
|
|
|
10852 ;; file properties
|
|
|
10853 (put 'file-directory-p 'efs 'efs-file-directory-p)
|
|
|
10854 (put 'file-writable-p 'efs 'efs-file-writable-p)
|
|
|
10855 (put 'file-readable-p 'efs 'efs-file-readable-p)
|
|
|
10856 (put 'file-executable-p 'efs 'efs-file-executable-p)
|
|
|
10857 (put 'file-symlink-p 'efs 'efs-file-symlink-p)
|
|
|
10858 (put 'file-attributes 'efs 'efs-file-attributes)
|
|
|
10859 (put 'file-exists-p 'efs 'efs-file-exists-p)
|
|
|
10860 (put 'file-accessible-directory-p 'efs 'efs-file-accessible-directory-p)
|
|
|
10861 ;; manipulating file names
|
|
|
10862 (put 'file-name-directory 'efs 'efs-file-name-directory)
|
|
|
10863 (put 'file-name-nondirectory 'efs 'efs-file-name-nondirectory)
|
|
|
10864 (put 'file-name-as-directory 'efs 'efs-file-name-as-directory)
|
|
|
10865 (put 'directory-file-name 'efs 'efs-directory-file-name)
|
|
|
10866 (put 'abbreviate-file-name 'efs 'efs-abbreviate-file-name)
|
|
|
10867 (put 'file-name-sans-versions 'efs 'efs-file-name-sans-versions)
|
|
|
10868 (put 'unhandled-file-name-directory 'efs 'efs-unhandled-file-name-directory)
|
|
|
10869 (put 'diff-latest-backup-file 'efs 'efs-diff-latest-backup-file)
|
|
|
10870 (put 'file-truename 'efs 'efs-file-truename)
|
|
|
10871 ;; modtimes
|
|
|
10872 (put 'verify-visited-file-modtime 'efs 'efs-verify-visited-file-modtime)
|
|
|
10873 (put 'file-newer-than-file-p 'efs 'efs-file-newer-than-file-p)
|
|
|
10874 (put 'set-visited-file-modtime 'efs 'efs-set-visited-file-modtime)
|
|
|
10875 ;; file modes
|
|
|
10876 (put 'set-file-modes 'efs 'efs-set-file-modes)
|
|
|
10877 (put 'file-modes 'efs 'efs-file-modes)
|
|
|
10878 ;; buffers
|
|
|
10879 (put 'backup-buffer 'efs 'efs-backup-buffer)
|
|
|
10880 (put 'get-file-buffer 'efs 'efs-get-file-buffer)
|
|
|
10881 (put 'create-file-buffer 'efs 'efs-create-file-buffer)
|
|
|
10882 ;; creating and removing files
|
|
|
10883 (put 'delete-file 'efs 'efs-delete-file)
|
|
|
10884 (put 'copy-file 'efs 'efs-copy-file)
|
|
|
10885 (put 'rename-file 'efs 'efs-rename-file)
|
|
|
10886 (put 'file-local-copy 'efs 'efs-file-local-copy)
|
|
|
10887 (put 'make-directory-internal 'efs 'efs-make-directory-internal)
|
|
|
10888 (put 'delete-directory 'efs 'efs-delete-directory)
|
|
|
10889 (put 'add-name-to-file 'efs 'efs-add-name-to-file)
|
|
|
10890 (put 'make-symbolic-link 'efs 'efs-make-symbolic-link)
|
|
|
10891 ;; file name completion
|
|
|
10892 (put 'file-name-completion 'efs 'efs-file-name-completion)
|
|
|
10893 (put 'file-name-all-completions 'efs 'efs-file-name-all-completions)
|
|
|
10894
|
|
|
10895 ;;;; ------------------------------------------------------------
|
|
|
10896 ;;;; Finally run any load-hooks.
|
|
|
10897 ;;;; ------------------------------------------------------------
|
|
|
10898
|
|
|
10899 (run-hooks 'efs-load-hook)
|
|
|
10900
|
|
|
10901 ;;; end of efs.el
|
